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) (defun make-titan-query (mime-type size token)
(format nil (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-mime-key+ +titan-field-separator+ mime-type +titan-records-separator+
+titan-size-key+ +titan-field-separator+ size +titan-records-separator+ +titan-size-key+ +titan-field-separator+ size +titan-records-separator+
+titan-token-key+ +titan-field-separator+ token)) +titan-token-key+ +titan-field-separator+ token))
@ -104,10 +104,11 @@
(client-certificate nil) (client-certificate nil)
(certificate-key nil)) (certificate-key nil))
(let* ((iri (make-gemini-iri (idn:host-unicode->ascii host) (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
(percent-encode-path path) (strcat (percent-encode-path path)
:query (percent-encode-query (make-titan-query mime-type (make-titan-query mime-type
size size
token)) token))
:scheme +titan-scheme+
:port port :port port
:fragment (percent-encode-fragment fragment))) :fragment (percent-encode-fragment fragment)))
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
@ -146,13 +147,21 @@
(parse-response ssl-stream) (parse-response ssl-stream)
(close-ssl-socket socket) (close-ssl-socket socket)
(values status description meta response socket))) (values status description meta response socket)))
(error (e) (gemini-protocol-error (e)
(declare (ignore e)) (close-ssl-socket socket)
(values (error-code e)
(error-description e)
(meta e)
(meta e)
socket))
(error ()
(handler-case (handler-case
(multiple-value-bind (status description meta response) (multiple-value-bind (status description meta response)
(parse-response ssl-stream) (parse-response ssl-stream)
(close-ssl-socket socket)
(values status description meta response socket)) (values status description meta response socket))
(error (e) (error (e)
(close-ssl-socket socket)
(values 50 (values 50
(format nil (format nil
(_ "Connection prematurely closed from the server: ~a") (_ "Connection prematurely closed from the server: ~a")

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

@ -324,7 +324,18 @@
(lambda () (lambda ()
(set-address-bar-text main-window link-value) (set-address-bar-text main-window link-value)
(gui:focus (toc-frame main-window)) (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) (defun absolutize-link (request-iri link-value)
(let ((parsed-request-iri (iri:iri-parse request-iri))) (let ((parsed-request-iri (iri:iri-parse request-iri)))
@ -341,7 +352,7 @@
(if (not (iri:absolute-url-p iri)) (if (not (iri:absolute-url-p iri))
(if (fs:file-exists-p iri) (if (fs:file-exists-p iri)
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 (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
1 1
ev:+maximum-event-priority+ ev:+maximum-event-priority+
@ -410,7 +421,7 @@
:inline-image)) :inline-image))
(defun inline-image (main-window link-value line-index) (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)) (image (gui:make-image file-path))
(coordinates `(+ (:line ,line-index :char 0) 1 :lines))) (coordinates `(+ (:line ,line-index :char 0) 1 :lines)))
(with-accessors ((ir-lines ir-lines) (with-accessors ((ir-lines ir-lines)
@ -655,7 +666,8 @@ local file paths."
(multiple-value-bind (x link-name link-value) (multiple-value-bind (x link-name link-value)
(linkify line) (linkify line)
(declare (ignore x)) (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))) (new-text-line-start `(:line ,line-number :char 0)))
(gui:append-text gemtext-widget link-rendered-label) (gui:append-text gemtext-widget link-rendered-label)
(let ((tag-link (gui:make-link-button gemtext-widget (let ((tag-link (gui:make-link-button gemtext-widget
@ -847,30 +859,31 @@ local file paths."
iri))) iri)))
(defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+)) (defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
(handler-case (let ((actual-iri (remove-standard-port iri)))
(let ((parsed-iri (iri:iri-parse iri))) (handler-case
(cond (let ((parsed-iri (iri:iri-parse actual-iri)))
((iri:iri= iri (internal-iri-bookmark)) (cond
(initialize-ir-lines main-window) ((iri:iri= actual-iri (internal-iri-bookmark))
(funcall (menu:show-bookmarks-clsr main-window))) (initialize-ir-lines main-window)
((iri:iri= iri (internal-iri-gemlogs)) (funcall (menu:show-bookmarks-clsr main-window)))
(menu:manage-gemlogs)) ((iri:iri= actual-iri (internal-iri-gemlogs))
((gemini-client:absolute-titan-url-p iri) (menu:manage-gemlogs))
(client-titan-window:init-window main-window iri)) ((gemini-client:absolute-titan-url-p actual-iri)
((gemini-parser:gemini-iri-p iri) (client-titan-window:init-window main-window actual-iri))
(start-stream-iri (iri-ensure-path iri) ((gemini-parser:gemini-iri-p actual-iri)
main-window (start-stream-iri (iri-ensure-path actual-iri)
use-cache main-window
status)) use-cache
((or (null (uri:scheme parsed-iri)) status))
(string= (uri:scheme parsed-iri) ((or (null (uri:scheme parsed-iri))
constants:+file-scheme+)) (string= (uri:scheme parsed-iri)
(initialize-ir-lines main-window) constants:+file-scheme+))
(open-local-path (uri:path parsed-iri) main-window)) (initialize-ir-lines main-window)
(t (open-local-path (uri:path parsed-iri) main-window))
(client-os-utils:open-resource-with-external-program main-window iri)))) (t
(error (e) (client-os-utils:open-resource-with-external-program main-window actual-iri))))
(gui-goodies:notify-request-error e)))) (error (e)
(gui-goodies:notify-request-error e)))))
(defun get-user-request-query (iri meta main-window &key (sensitive nil)) (defun get-user-request-query (iri meta main-window &key (sensitive nil))
(let* ((parsed-iri (iri:iri-parse iri)) (let* ((parsed-iri (iri:iri-parse iri))

3
src/iri-parser.lisp
View File

@ -339,7 +339,8 @@
(fragment (uri:fragment iri))) (fragment (uri:fragment iri)))
(when scheme (when scheme
(format string-stream "~a:" scheme)) (format string-stream "~a:" scheme))
(write-string "//" string-stream) (when host
(write-string "//" string-stream))
(when user-info (when user-info
(format string-stream "~a@" user-info)) (format string-stream "~a@" user-info))
(when host (when host