From 2dd2a738a7fc21dc2301873dbd777c6674998212 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 15 Jan 2022 17:50:53 +0100 Subject: [PATCH] - adding user info in uri related functions. --- src/gemini/client.lisp | 28 +++++++++++--------- src/gemini/gemini-parser.lisp | 48 ++++++++++++++++++++--------------- 2 files changed, 44 insertions(+), 32 deletions(-) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index e5b46ba..2a4c926 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -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+) diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index a064d12..f11adac 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -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)))