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

- taken into account the query of the original URI when combining it with a path.

This commit is contained in:
cage 2022-08-05 11:30:56 +02:00
parent 6e883ca21b
commit 008d5001a7
5 changed files with 39 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/gemini-viewer.lisp
View File

@ -313,10 +313,11 @@
(port port) (port port)
(path path) (path path)
(meta meta) (meta meta)
(query query)
(status-code status-code) (status-code status-code)
(status-code-description status-code-description)) stream-object (status-code-description status-code-description)) stream-object
(let* ((parsed (gemini-parser:parse-gemini-file src-data)) (let* ((parsed (gemini-parser:parse-gemini-file src-data))
(links (gemini-parser:sexp->links parsed host port path)) (links (gemini-parser:sexp->links parsed host port path query))
(response (gemini-client:make-gemini-file-response status-code (response (gemini-client:make-gemini-file-response status-code
status-code-description status-code-description
meta meta

32
src/gemini/gemini-parser.lisp
View File

@ -260,18 +260,29 @@
path path
(fs:parent-dir-path path))) (fs:parent-dir-path path)))
(defun absolutize-link (link-value original-host original-port original-path) (defun absolutize-link (link-value original-host original-port original-path original-query)
(let ((parsed (or (ignore-errors (iri:iri-parse link-value)) (let ((parsed (or (ignore-errors (iri:iri-parse link-value))
(iri:make-iri nil nil nil nil link-value nil nil)))) (iri:make-iri nil nil nil nil link-value nil nil))))
(cond (cond
((null (uri:host parsed)) ((null (uri:host parsed))
(let* ((absolute-path-p (string-starts-with-p "/" link-value)) (let* ((absolute-path-p (string-starts-with-p "/" link-value))
(path (if absolute-path-p (query-path-p (uri:query parsed))
(uri:path parsed) (path (cond
(strcat (if original-path (absolute-path-p
(path-last-dir original-path) (uri:path parsed))
"/") ((and query-path-p
(uri:path parsed))))) original-query)
(strcat (safe-all-but-last-elt original-path)
(uri:path parsed)))
((or query-path-p
original-query)
(strcat original-path
(uri:path parsed)))
(t
(strcat (if original-path
(path-last-dir original-path)
"/")
(uri:path parsed))))))
(make-gemini-iri original-host (make-gemini-iri original-host
(fs:normalize-path path) (fs:normalize-path path)
:query (uri:query parsed) :query (uri:query parsed)
@ -325,7 +336,7 @@
(setf iri (strcat iri "#" fragment))) (setf iri (strcat iri "#" fragment)))
iri)) iri))
(defun sexp->links (parsed-gemini original-host original-port original-path (defun sexp->links (parsed-gemini original-host original-port original-path original-query
&key (comes-from-local-file nil)) &key (comes-from-local-file nil))
(loop (loop
for node in parsed-gemini for node in parsed-gemini
@ -344,7 +355,8 @@
(absolutize-link link-value (absolutize-link link-value
original-host original-host
original-port original-port
original-path))))) original-path
original-query)))))
(make-instance 'gemini-link (make-instance 'gemini-link
:target rendered-link :target rendered-link
:name (tag-value node))))) :name (tag-value node)))))

7
src/gemini/subscription.lisp
View File

@ -73,9 +73,10 @@ be subscribed before (see: 'gemini-subscription:subcribe'"
(gemlog-iri (iri:iri-parse url))) (gemlog-iri (iri:iri-parse url)))
(let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a))) (let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))
(sexp->links parsed (sexp->links parsed
(uri:host gemlog-iri) (uri:host gemlog-iri)
(uri:port gemlog-iri) (uri:port gemlog-iri)
(uri:path gemlog-iri))))) (uri:path gemlog-iri)
(uri:query gemlog-iri)))))
(loop for link in links do (loop for link in links do
(when (not (db:find-gemlog-entry (to-s (target link)))) (when (not (db:find-gemlog-entry (to-s (target link))))
(let ((date (link-post-timestamp (name link)))) (let ((date (link-post-timestamp (name link))))

11
src/program-events.lisp
View File

@ -1100,6 +1100,7 @@
nil nil
nil nil
local-path local-path
nil
:comes-from-local-file local-path-p)) :comes-from-local-file local-path-p))
(ir-text (gemini-parser:sexp->text-rows parsed (ir-text (gemini-parser:sexp->text-rows parsed
gemini-client:*gemini-page-theme*))) gemini-client:*gemini-page-theme*)))
@ -1207,6 +1208,7 @@
nil nil
nil nil
parent-dir parent-dir
nil
:comes-from-local-file t)) :comes-from-local-file t))
(local-links (remove-if (lambda (link) (local-links (remove-if (lambda (link)
(let ((target (gemini-parser:target link))) (let ((target (gemini-parser:target link)))
@ -1403,10 +1405,11 @@
(url (iri:iri-parse gemlog-url)) (url (iri:iri-parse gemlog-url))
(parsed (gemini-parser:parse-gemini-file gemini-page)) (parsed (gemini-parser:parse-gemini-file gemini-page))
(links (gemini-parser:sexp->links parsed (links (gemini-parser:sexp->links parsed
(uri:host url) (uri:host url)
(uri:port url) (uri:port url)
(uri:path url))) (uri:path url)
(theme gemini-client:*gemini-page-theme*)) (uri:query url)))
(theme gemini-client:*gemini-page-theme*))
(gemini-viewer:maybe-initialize-metadata specials:*message-window*) (gemini-viewer:maybe-initialize-metadata specials:*message-window*)
(refresh-gemini-message-window links (refresh-gemini-message-window links
gemini-page gemini-page

7
src/ui-goodies.lisp
View File

@ -1411,9 +1411,10 @@ Browse and optionally open the links the text of the message window contains."
(iri:absolute-url-p uri)) (iri:absolute-url-p uri))
uri uri
(gemini-parser:absolutize-link uri (gemini-parser:absolutize-link uri
(uri:host current-url) (uri:host current-url)
(uri:port current-url) (uri:port current-url)
(uri:path current-url))))) (uri:path current-url)
(uri:query current-url)))))
(open-message-link-window:open-message-link absolute-uri nil))))) (open-message-link-window:open-message-link absolute-uri nil)))))
(defun open-previous-link () (defun open-previous-link ()