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)
+gemini-default-port+))
(scheme (uri:scheme iri))
(user-info (uri:user-info iri))
(actual-iri (gemini-parser:make-gemini-iri host
path
:user-info user-info
:query query
:port port
:fragment fragment
@ -332,7 +334,8 @@
query
port
fragment
scheme)))
scheme
user-info)))
(defun debug-gemini (&rest data)
(declare (ignorable data))
@ -474,16 +477,17 @@
(when-let* ((all-rows (db:find-tls-certificates-rows))
(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
request-fragment request-scheme)
request-fragment request-scheme request-user-info)
(gemini-client:displace-iri parsed-request-iri)
(declare (ignore request-iri request-query request-fragment))
(loop for row in all-rows do
(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)))
(declare (ignore iri query fragment))
(when (and (string= request-host host)
(string= request-scheme scheme)
(string= request-user-info user-info)
(= request-port port)
(text-utils:string-starts-with-p (gemini-parser:path-last-dir path)
request-path))

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

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