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

28
src/gemini/client.lisp
View File

@ -320,19 +320,22 @@
(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
:query query
:port port
:fragment fragment
:scheme scheme)))
:user-info user-info
:query query
:port port
:fragment fragment
:scheme scheme)))
(values actual-iri
host
path
query
port
fragment
scheme)))
scheme
user-info)))
(defun debug-gemini (&rest data)
(declare (ignorable data))
@ -474,19 +477,20 @@
(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)
(= request-port port)
(text-utils:string-starts-with-p (gemini-parser:path-last-dir path)
request-path))
(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))
(return-from tls-cert-find
(values (strcat (os-utils:cached-file-path (to-s id))
fs:*directory-sep* os-utils:+ssl-cert-name+)

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

@ -288,27 +288,35 @@
(fragment nil)
(scheme +gemini-scheme+)
(omit-default-port t)
(default-port *omitted-port*))
(let* ((actual-path (if (string-starts-with-p "/" path)
(subseq path 1)
path))
(actual-port (cond
((null port)
"")
((and omit-default-port
(= port default-port))
"")
(t
(to-s port))))
(domain-port-separator (if (string-not-empty-p actual-port)
":"
""))
(actual-host (if (iri:ipv6-address-p host)
(strcat "[" host "]")
host))
(default-port *omitted-port*)
(user-info nil))
(let* ((actual-path (if (string-starts-with-p "/" path)
(subseq path 1)
path))
(actual-port (cond
((null port)
"")
((and omit-default-port
(= port default-port))
"")
(t
(to-s port))))
(domain-port-separator (if (string-not-empty-p actual-port)
":"
""))
(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)))