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)
(path path)
(meta meta)
(query query)
(status-code status-code)
(status-code-description status-code-description)) stream-object
(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
status-code-description
meta

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

@ -260,18 +260,29 @@
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))
(iri:make-iri nil nil nil nil link-value nil nil))))
(cond
((null (uri:host parsed))
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
(path (if absolute-path-p
(uri:path parsed)
(strcat (if original-path
(path-last-dir original-path)
"/")
(uri:path parsed)))))
(let* ((absolute-path-p (string-starts-with-p "/" link-value))
(query-path-p (uri:query parsed))
(path (cond
(absolute-path-p
(uri:path parsed))
((and query-path-p
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
(fs:normalize-path path)
:query (uri:query parsed)
@ -325,7 +336,7 @@
(setf iri (strcat iri "#" fragment)))
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))
(loop
for node in parsed-gemini
@ -344,7 +355,8 @@
(absolutize-link link-value
original-host
original-port
original-path)))))
original-path
original-query)))))
(make-instance 'gemini-link
:target rendered-link
: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)))
(let ((links (remove-if-not (lambda (a) (link-post-timestamp-p (name a)))
(sexp->links parsed
(uri:host gemlog-iri)
(uri:port gemlog-iri)
(uri:path gemlog-iri)))))
(uri:host gemlog-iri)
(uri:port gemlog-iri)
(uri:path gemlog-iri)
(uri:query gemlog-iri)))))
(loop for link in links do
(when (not (db:find-gemlog-entry (to-s (target link))))
(let ((date (link-post-timestamp (name link))))

11
src/program-events.lisp
View File

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