Merged Alex's IRI support, with tiny changes.

diff --git a/ISSUES.org b/ISSUES.org
index 9923820..b1556a0 100644 (file)
--- a/ISSUES.org
+++ b/ISSUES.org
@@ -24,6 +24,33 @@ user interaction that may appear during the initial connection setup.
 E.g., asking for approval of uknown TLS certificates.
 
 * Closed Bugs
+
+** CLOSED Relative Gemini links processed improperly
+:LOGBOOK:
+- State "CLOSED"     from "OPEN"       [2021-08-04 Wed 15:54]
+- State "OPEN"       from              [2021-08-04 Wed 13:53]
+:END:
+
+Skyjake's gemlog at gemini://skyjake.fi/gemlog/ demonstrate's the
+issue.  The link back to the root selector in the footer of that page
+is a relative link to the parent directory, i.e. "..".  For some
+reason elpher combines this with the current URL and produces
+"gemini://skyjake.fi" as the destination of the link.  Such URLs
+(i.e. without a filename) are allowed as input, but are assumed
+to not appear internally.
+
+To see why the internal distinction is important, consider a page
+where the current URL is gemini://example.com/a_page.  The current
+directory in this case is "/", meaning a relative link to
+"another_page" results in a destination link of
+"gemini://example.com/another_page.  On the other hand, if the current
+URL is gemini://example.com/a_page/, the same relative link is
+interpreted as refering to gemini://example.com/a_page/another_page.
+
+The fix will be to ensure gemini://skyjake.fi/gemlog/.. collapses to
+gemini://skyjake.fi/ rather than gemini://skyjake.fi.
+
+
   
 ** CLOSED Org mode faces are not present in recent emacs versions
 Even 26.1 doesn't seem to have these.  This means that, for many

diff --git a/elpher.el b/elpher.el
index 925afa3..9bdc49e 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -332,7 +332,7 @@ the start page."
           (unless (and (not (url-fullness url)) (url-type url))
             (setf (url-fullness url) t)
             (unless (url-type url)
-              (setf (url-type url) (elpher-get-default-url-type)))
+              (setf (url-type url) elpher-default-url-type))
             (unless (url-host url)
               (let ((p (split-string (url-filename url) "/" nil nil)))
                 (setf (url-host url) (car p))
@@ -340,6 +340,8 @@ the start page."
                       (if (cdr p)
                           (concat "/" (mapconcat #'identity (cdr p) "/"))
                         ""))))
+            (when (url-host url)
+              (setf (url-host url) (puny-encode-domain (url-host url))))
             (when (or (equal "gopher" (url-type url))
                       (equal "gophers" (url-type url)))
               ;; Gopher defaults
@@ -353,18 +355,6 @@ the start page."
           (elpher-remove-redundant-ports url))
       (set-match-data data))))
 
-(defun elpher-get-default-url-type ()
-  "Get the current URL type or `elpher-default-url-type'.
-If no scheme is provided for a URL, the current context specifies
-the scheme to use, so if we're looking at a gemini page, then the
-default type is \"gemini\" even if `elpher-default-url-type' is
-\"gopher\"."
-  (or (and elpher-current-page
-          (symbol-name
-           (elpher-address-type
-            (elpher-page-address elpher-current-page))))
-      elpher-default-url-type))
-
 (defun elpher-remove-redundant-ports (address)
   "Remove redundant port specifiers from ADDRESS.
 Here 'redundant' means that the specified port matches the default
@@ -530,16 +520,6 @@ Drop the password, if any."
       (setf (url-password address) nil)) ; the password as clear text
     (url-recreate-url address)))
 
-(defun elpher-encode-url (iri)
-  "Return an URL for the IRI.
-Encode and use percent-escapes, use punycode for the domain name
-if necessary."
-  (let* ((address (url-generic-parse-url iri))
-        (host (url-host address)))
-    (when host
-      (setf (url-host address) (puny-encode-domain host)))
-    (url-recreate-url address)))
-
 (defvar elpher-current-page nil
   "The current page for this Elpher buffer.")
 
@@ -1451,7 +1431,7 @@ Returns nil in the event that the contents of the line following the
 => prefix are empty."
   (let ((l (split-string (substring link-line 2))))
     (if l
-        (elpher-encode-url (string-trim (elt l 0)))
+        (string-trim (elt l 0))
       nil)))
 
 (defun elpher-gemini-get-link-display-string (link-line)
@@ -1461,20 +1441,23 @@ Returns the url portion in the event that the display-string portion is empty."
          (idx (string-match "[ \t]" rest)))
     (string-trim (if idx
                      (substring rest (+ idx 1))
-                   (elpher-url-to-iri rest)))))
+                   rest))))
 
 (defun elpher-collapse-dot-sequences (filename)
-  "Collapse dot sequences in FILENAME.
-For instance, the filename /a/b/../c/./d will reduce to /a/c/d"
-  (let* ((path (split-string filename "/"))
+  "Collapse dot sequences in the (absolute) FILENAME.
+For instance, the filename \"/a/b/../c/./d\" will reduce to \"/a/c/d\""
+  (let* ((path (split-string filename "/" t))
+         (is-directory (string-match-p (rx (: (or "." ".." "/") line-end)) filename))
          (path-reversed-normalized
           (seq-reduce (lambda (a b)
-                        (cond ((and a (equal b "..") (cdr a)))
-                              ((and (not a) (equal b "..")) a) ;leading .. are dropped
+                        (cond ((equal b "..") (cdr a))
                               ((equal b ".") a)
                               (t (cons b a))))
-                      path nil)))
-    (string-join (reverse path-reversed-normalized) "/")))
+                      path nil))
+         (path-normalized (reverse path-reversed-normalized)))
+    (if path-normalized
+        (concat "/" (string-join path-normalized "/") (and is-directory "/"))
+      "/")))
 
 (defun elpher-address-from-gemini-url (url)
   "Extract address from URL with defaults as per gemini map files.
@@ -1494,6 +1477,8 @@ treatment that a separate function is warranted."
           (setf (url-filename address)
                 (concat (file-name-directory (url-filename current-address))
                         (url-filename address)))))
+      (when (url-host address)
+        (setf (url-host address) (puny-encode-domain (url-host address))))
       (unless (url-type address)
         (setf (url-type address) (url-type current-address)))
       (when (equal (url-type address) "gemini")