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

- adding user info in uri related functions.

This commit is contained in:
cage 2022-01-15 17:50:53 +01:00
parent 38b74b782b
commit 2dd2a738a7
2 changed files with 44 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/gemini/client.lisp
View File

@ -320,8 +320,10 @@
(port (or (uri:port iri) (port (or (uri:port iri)
+gemini-default-port+)) +gemini-default-port+))
(scheme (uri:scheme iri)) (scheme (uri:scheme iri))
(user-info (uri:user-info iri))
(actual-iri (gemini-parser:make-gemini-iri host (actual-iri (gemini-parser:make-gemini-iri host
path path
:user-info user-info
:query query :query query
:port port :port port
:fragment fragment :fragment fragment
@ -332,7 +334,8 @@
query query
port port
fragment fragment
scheme))) scheme
user-info)))
(defun debug-gemini (&rest data) (defun debug-gemini (&rest data)
(declare (ignorable data)) (declare (ignorable data))
@ -474,16 +477,17 @@
(when-let* ((all-rows (db:find-tls-certificates-rows)) (when-let* ((all-rows (db:find-tls-certificates-rows))
(parsed-request-iri (iri:iri-parse request-iri :null-on-error t))) (parsed-request-iri (iri:iri-parse request-iri :null-on-error t)))
(multiple-value-bind (request-iri request-host request-path request-query request-port (multiple-value-bind (request-iri request-host request-path request-query request-port
request-fragment request-scheme) request-fragment request-scheme request-user-info)
(gemini-client:displace-iri parsed-request-iri) (gemini-client:displace-iri parsed-request-iri)
(declare (ignore request-iri request-query request-fragment)) (declare (ignore request-iri request-query request-fragment))
(loop for row in all-rows do (loop for row in all-rows do
(let ((id (db:row-id row))) (let ((id (db:row-id row)))
(multiple-value-bind (iri host path query port fragment scheme) (multiple-value-bind (iri host path query port fragment scheme user-info)
(gemini-client:displace-iri (iri:iri-parse (db:row-cache-key row))) (gemini-client:displace-iri (iri:iri-parse (db:row-cache-key row)))
(declare (ignore iri query fragment)) (declare (ignore iri query fragment))
(when (and (string= request-host host) (when (and (string= request-host host)
(string= request-scheme scheme) (string= request-scheme scheme)
(string= request-user-info user-info)
(= request-port port) (= request-port port)
(text-utils:string-starts-with-p (gemini-parser:path-last-dir path) (text-utils:string-starts-with-p (gemini-parser:path-last-dir path)
request-path)) request-path))

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

@ -288,7 +288,8 @@
(fragment nil) (fragment nil)
(scheme +gemini-scheme+) (scheme +gemini-scheme+)
(omit-default-port t) (omit-default-port t)
(default-port *omitted-port*)) (default-port *omitted-port*)
(user-info nil))
(let* ((actual-path (if (string-starts-with-p "/" path) (let* ((actual-path (if (string-starts-with-p "/" path)
(subseq path 1) (subseq path 1)
path)) path))
@ -306,9 +307,16 @@
(actual-host (if (iri:ipv6-address-p host) (actual-host (if (iri:ipv6-address-p host)
(strcat "[" host "]") (strcat "[" host "]")
host)) host))
(actual-user-info (if (string-not-empty-p user-info)
user-info
""))
(user-info-host-separator (if (string-not-empty-p user-info)
"@"
""))
(iri (strcat scheme "://" (iri (strcat scheme "://"
actual-host domain-port-separator actual-user-info user-info-host-separator actual-host
actual-port "/" domain-port-separator actual-port "/"
actual-path))) actual-path)))
(when query (when query
(setf iri (strcat iri "?" query))) (setf iri (strcat iri "?" query)))