cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [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:
cage 2023-07-22 11:15:22 +02:00
parent e22b53e348
commit 4c99e6a8b2
3 changed files with 59 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/gemini/titan.lisp
View File

@ -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")

69
src/gui/client/main-window.lisp
View File

@ -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))

3
src/iri-parser.lisp
View File

@ -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