diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp index 9e627a3..0479de2 100644 --- a/src/gemini/gemini-parser.lisp +++ b/src/gemini/gemini-parser.lisp @@ -285,6 +285,8 @@ (let ((parsed (or (ignore-errors (iri:iri-parse link-value)) (iri:make-iri nil nil nil nil link-value nil nil)))) (cond + ((iri:absolute-url-p link-value) + link-value) ((null original-host) (if (fs:extension-dir-p original-path) (normalize-path (strcat original-path @@ -293,7 +295,7 @@ (normalize-path (strcat path-to-last-dir fs:*directory-sep* link-value))))) - ((null (iri:host parsed)) + ((iri:relative-url-p link-value) (let* ((absolute-path-p (string-starts-with-p "/" link-value)) (query-path-p (iri:query parsed)) (path (cond @@ -317,9 +319,16 @@ :query (iri:query parsed) :port original-port :fragment (iri:fragment parsed)))) + ((and (null (iri:host parsed)) + (not (null (iri:scheme parsed)))) + link-value) ((null (iri:scheme parsed)) - (strcat +gemini-scheme+ ":" - (to-s (fs:normalize-path parsed)))) + (make-gemini-iri (iri:host parsed) + (fs:normalize-path (iri:path parsed)) + :scheme gemini-constants:+gemini-scheme+ + :query (iri:query parsed) + :port (iri:port parsed) + :fragment (iri:fragment parsed))) (t (to-s (fs:normalize-path parsed)))))) diff --git a/src/iri-parser.lisp b/src/iri-parser.lisp index 5308afb..31e693a 100644 --- a/src/iri-parser.lisp +++ b/src/iri-parser.lisp @@ -399,10 +399,13 @@ (with-output-to-string (stream) (render-iri object stream))) -(defun absolute-url-p (url) +(defun relative-url-p (url) (when-let ((iri (iri:iri-parse url :null-on-error t))) - (not (or (null (iri:scheme iri)) - (null (iri:host iri)))))) + (and (null (iri:scheme iri)) + (null (iri:host iri))))) + +(defun absolute-url-p (url) + (not (relative-url-p url))) (defun absolute-url-scheme-p (url expected-scheme) (when-let ((parsed-iri (iri:iri-parse url :null-on-error t))) diff --git a/src/package.lisp b/src/package.lisp index 090a53f..8391735 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -813,6 +813,7 @@ :iri= :remove-fragment :normalize-path + :relative-url-p :absolute-url-p :absolute-url-scheme-p :ipv4-address-p