mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-01 04:26:47 +01:00
- [TITAN] fixed building of request URL
Many thanks to Alex Schroeder for help and supporting! - fixed building of URL composed of only a path component in 'render-iri'; - [GUI] remove standard port value before requesting an URL.
This commit is contained in:
parent
e22b53e348
commit
4c99e6a8b2
@ -32,7 +32,7 @@
|
||||
|
||||
(defun make-titan-query (mime-type size token)
|
||||
(format nil
|
||||
"~a~a~a~a~a~a~a~3*~@[~3:*~a~a~a~a~]"
|
||||
";~a~a~a~a~a~a~a~3*~@[~3:*~a~a~a~a~]"
|
||||
+titan-mime-key+ +titan-field-separator+ mime-type +titan-records-separator+
|
||||
+titan-size-key+ +titan-field-separator+ size +titan-records-separator+
|
||||
+titan-token-key+ +titan-field-separator+ token))
|
||||
@ -104,10 +104,11 @@
|
||||
(client-certificate nil)
|
||||
(certificate-key nil))
|
||||
(let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
|
||||
(percent-encode-path path)
|
||||
:query (percent-encode-query (make-titan-query mime-type
|
||||
size
|
||||
token))
|
||||
(strcat (percent-encode-path path)
|
||||
(make-titan-query mime-type
|
||||
size
|
||||
token))
|
||||
:scheme +titan-scheme+
|
||||
:port port
|
||||
:fragment (percent-encode-fragment fragment)))
|
||||
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
|
||||
@ -146,13 +147,21 @@
|
||||
(parse-response ssl-stream)
|
||||
(close-ssl-socket socket)
|
||||
(values status description meta response socket)))
|
||||
(error (e)
|
||||
(declare (ignore e))
|
||||
(gemini-protocol-error (e)
|
||||
(close-ssl-socket socket)
|
||||
(values (error-code e)
|
||||
(error-description e)
|
||||
(meta e)
|
||||
(meta e)
|
||||
socket))
|
||||
(error ()
|
||||
(handler-case
|
||||
(multiple-value-bind (status description meta response)
|
||||
(parse-response ssl-stream)
|
||||
(close-ssl-socket socket)
|
||||
(values status description meta response socket))
|
||||
(error (e)
|
||||
(close-ssl-socket socket)
|
||||
(values 50
|
||||
(format nil
|
||||
(_ "Connection prematurely closed from the server: ~a")
|
||||
|
@ -324,7 +324,18 @@
|
||||
(lambda ()
|
||||
(set-address-bar-text main-window link-value)
|
||||
(gui:focus (toc-frame main-window))
|
||||
(open-iri link-value main-window use-cache :status status)))))
|
||||
(open-iri link-value
|
||||
main-window
|
||||
use-cache :status status)))))
|
||||
|
||||
(defun remove-standard-port (iri)
|
||||
(let ((copy (iri:copy-iri (iri:iri-parse iri))))
|
||||
(when (and (uri:port copy)
|
||||
(uri:host copy)
|
||||
(= (uri:port copy)
|
||||
gemini-constants:+gemini-default-port+))
|
||||
(setf (uri:port copy) nil))
|
||||
(to-s copy)))
|
||||
|
||||
(defun absolutize-link (request-iri link-value)
|
||||
(let ((parsed-request-iri (iri:iri-parse request-iri)))
|
||||
@ -341,7 +352,7 @@
|
||||
(if (not (iri:absolute-url-p iri))
|
||||
(if (fs:file-exists-p iri)
|
||||
iri
|
||||
(error (_ "file ~a not found" iri)))
|
||||
(error (_ "file ~a not found") iri))
|
||||
(let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
|
||||
1
|
||||
ev:+maximum-event-priority+
|
||||
@ -410,7 +421,7 @@
|
||||
:inline-image))
|
||||
|
||||
(defun inline-image (main-window link-value line-index)
|
||||
(let* ((file-path (slurp-iri main-window link-value))
|
||||
(let* ((file-path (slurp-iri main-window (remove-standard-port link-value)))
|
||||
(image (gui:make-image file-path))
|
||||
(coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
|
||||
(with-accessors ((ir-lines ir-lines)
|
||||
@ -655,7 +666,8 @@ local file paths."
|
||||
(multiple-value-bind (x link-name link-value)
|
||||
(linkify line)
|
||||
(declare (ignore x))
|
||||
(let ((target-iri (absolutize-link request-iri link-value))
|
||||
(let ((target-iri (remove-standard-port (absolutize-link request-iri
|
||||
link-value)))
|
||||
(new-text-line-start `(:line ,line-number :char 0)))
|
||||
(gui:append-text gemtext-widget link-rendered-label)
|
||||
(let ((tag-link (gui:make-link-button gemtext-widget
|
||||
@ -847,30 +859,31 @@ local file paths."
|
||||
iri)))
|
||||
|
||||
(defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
|
||||
(handler-case
|
||||
(let ((parsed-iri (iri:iri-parse iri)))
|
||||
(cond
|
||||
((iri:iri= iri (internal-iri-bookmark))
|
||||
(initialize-ir-lines main-window)
|
||||
(funcall (menu:show-bookmarks-clsr main-window)))
|
||||
((iri:iri= iri (internal-iri-gemlogs))
|
||||
(menu:manage-gemlogs))
|
||||
((gemini-client:absolute-titan-url-p iri)
|
||||
(client-titan-window:init-window main-window iri))
|
||||
((gemini-parser:gemini-iri-p iri)
|
||||
(start-stream-iri (iri-ensure-path iri)
|
||||
main-window
|
||||
use-cache
|
||||
status))
|
||||
((or (null (uri:scheme parsed-iri))
|
||||
(string= (uri:scheme parsed-iri)
|
||||
constants:+file-scheme+))
|
||||
(initialize-ir-lines main-window)
|
||||
(open-local-path (uri:path parsed-iri) main-window))
|
||||
(t
|
||||
(client-os-utils:open-resource-with-external-program main-window iri))))
|
||||
(error (e)
|
||||
(gui-goodies:notify-request-error e))))
|
||||
(let ((actual-iri (remove-standard-port iri)))
|
||||
(handler-case
|
||||
(let ((parsed-iri (iri:iri-parse actual-iri)))
|
||||
(cond
|
||||
((iri:iri= actual-iri (internal-iri-bookmark))
|
||||
(initialize-ir-lines main-window)
|
||||
(funcall (menu:show-bookmarks-clsr main-window)))
|
||||
((iri:iri= actual-iri (internal-iri-gemlogs))
|
||||
(menu:manage-gemlogs))
|
||||
((gemini-client:absolute-titan-url-p actual-iri)
|
||||
(client-titan-window:init-window main-window actual-iri))
|
||||
((gemini-parser:gemini-iri-p actual-iri)
|
||||
(start-stream-iri (iri-ensure-path actual-iri)
|
||||
main-window
|
||||
use-cache
|
||||
status))
|
||||
((or (null (uri:scheme parsed-iri))
|
||||
(string= (uri:scheme parsed-iri)
|
||||
constants:+file-scheme+))
|
||||
(initialize-ir-lines main-window)
|
||||
(open-local-path (uri:path parsed-iri) main-window))
|
||||
(t
|
||||
(client-os-utils:open-resource-with-external-program main-window actual-iri))))
|
||||
(error (e)
|
||||
(gui-goodies:notify-request-error e)))))
|
||||
|
||||
(defun get-user-request-query (iri meta main-window &key (sensitive nil))
|
||||
(let* ((parsed-iri (iri:iri-parse iri))
|
||||
|
@ -339,7 +339,8 @@
|
||||
(fragment (uri:fragment iri)))
|
||||
(when scheme
|
||||
(format string-stream "~a:" scheme))
|
||||
(write-string "//" string-stream)
|
||||
(when host
|
||||
(write-string "//" string-stream))
|
||||
(when user-info
|
||||
(format string-stream "~a@" user-info))
|
||||
(when host
|
||||
|
Loading…
x
Reference in New Issue
Block a user