Prevent adding properties to node display strings.
[elpher.git] / elpher.el
index 55161c3..fcdd9f4 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
 ;; Created: 11 April 2019
-;; Version: 2.1.1
+;; Version: 2.3.5
 ;; Keywords: comm gopher
 ;; Homepage: https://github.com/tgvaughan/elpher
 ;; Package-Requires: ((emacs "26"))
@@ -65,7 +65,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.1.1"
+(defconst elpher-version "2.3.5"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -285,12 +285,13 @@ For gopher addresses this is a combination of the selector type and selector."
   "Retrieve port from ADDRESS object."
   (if (symbolp address)
       nil)
-  (or (> (url-port address) 0)
-      (and (or (equal (url-type address) "gopher")
-               (equal (url-type address) "gophers"))
-           70)
-      (and (equal (url-type address) "gemini")
-           1965)))
+  (if (> (url-port address) 0)
+      (url-port address)
+    (or (and (or (equal (url-type address) "gopher")
+                 (equal (url-type address) "gophers"))
+             70)
+        (and (equal (url-type address) "gemini")
+             1965))))
 
 (defun elpher-address-special-p (address)
   "Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
@@ -423,7 +424,14 @@ unless PRESERVE-PARENT is non-nil."
 (defun elpher-update-header ()
   "If `elpher-use-header' is true, display current node info in window header."
   (if elpher-use-header
-      (setq header-line-format (elpher-node-display-string elpher-current-node))))
+      (let* ((display-string (elpher-node-display-string elpher-current-node))
+             (address (elpher-node-address elpher-current-node))
+             (url-string (if (elpher-address-special-p address)
+                             ""
+                           (concat "  -  " (elpher-address-to-url address) "")))
+             (header (replace-regexp-in-string "%" "%%" (concat display-string
+                                                                url-string))))
+        (setq header-line-format header))))
 
 (defmacro elpher-with-clean-buffer (&rest args)
   "Evaluate ARGS with a clean *elpher* buffer as current."
@@ -464,7 +472,7 @@ away CRs and any terminating period."
   (elpher-with-clean-buffer
    (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
            "When attempting to retrieve " (elpher-address-to-url address) ":\n"
-           (error-message-string error) ".\n"
+           (error-message-string error) "\n"
            (propertize "\n----------------\n\n" 'face 'error)
            "Press 'u' to return to the previous page.")))
 
@@ -510,8 +518,9 @@ up to the calling function."
                               (setq elpher-selector-string
                                     (concat elpher-selector-string string))))
         (set-process-sentinel proc after)
-        (process-send-string proc
-                             (concat (elpher-gopher-address-selector address) "\n")))
+        (let ((inhibit-eol-conversion t))
+          (process-send-string proc
+                               (concat (elpher-gopher-address-selector address) "\r\n"))))
     (error
      (if (and (consp the-error)
               (eq (car the-error) 'gnutls-error)
@@ -636,7 +645,7 @@ If ADDRESS is not supplied or nil the record is rendered as an
 ;; Text rendering
 
 (defconst elpher-url-regex
-  "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]+\\|\[[a-zA-Z0-9:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^<> \r\n\t(),]*\\)?"
+  "\\([a-zA-Z]+\\)://\\([a-zA-Z0-9.\-]*[a-zA-Z0-9\-]\\|\[[a-zA-Z0-9:]+\]\\)\\(:[0-9]+\\)?\\(/\\([0-9a-zA-Z\-_~?/@|:.]*[0-9a-zA-Z\-_~?/@|]\\)?\\)?"
   "Regexp used to locate and buttniofy URLs in text files loaded by elpher.")
 
 (defun elpher-buttonify-urls (string)
@@ -645,7 +654,7 @@ If ADDRESS is not supplied or nil the record is rendered as an
     (insert string)
     (goto-char (point-min))
     (while (re-search-forward elpher-url-regex nil t)
-      (let ((node (elpher-make-node (match-string 0)
+      (let ((node (elpher-make-node (substring-no-properties (match-string 0))
                                     (elpher-address-from-url (match-string 0)))))
           (make-text-button (match-beginning 0)
                             (match-end 0)
@@ -767,68 +776,86 @@ The response is rendered using the rendering function RENDERER."
 The response is stored in the variable ‘elpher-gemini-response’."
   (setq elpher-gemini-response "")
   (if (not (gnutls-available-p))
-      (error "Cannot retrieve TLS selector: GnuTLS not available")
-    (let* ((kill-buffer-query-functions nil)
-           (proc (open-network-stream "elpher-process"
-                                      nil
-                                      (elpher-address-host address)
-                                      (elpher-address-port address)
-                                      :type 'tls)))
-      (set-process-coding-system proc 'binary)
-      (set-process-filter proc
-                          (lambda (_proc string)
-                            (setq elpher-gemini-response
-                                  (concat elpher-gemini-response string))))
-      (set-process-sentinel proc after)
-      (process-send-string proc
-                           (concat (elpher-address-to-url address) "\r\n")))))
+      (error "Cannot establish gemini connection: GnuTLS not available")
+    (condition-case the-error
+        (let* ((kill-buffer-query-functions nil)
+               (proc (open-network-stream "elpher-process"
+                                          nil
+                                          (elpher-address-host address)
+                                          (elpher-address-port address)
+                                          :type 'tls)))
+          (set-process-coding-system proc 'binary)
+          (set-process-filter proc
+                              (lambda (_proc string)
+                                (setq elpher-gemini-response
+                                      (concat elpher-gemini-response string))))
+          (set-process-sentinel proc after)
+          (let ((inhibit-eol-conversion t))
+            (process-send-string proc
+                                 (concat (elpher-address-to-url address) "\r\n"))))
+      (error
+       (error "Error initiating connection to server")))))
+
+(defun elpher-parse-gemini-response (response)
+  "Parse the RESPONSE string and return a list of components
+The list is of the form (code meta body). A response of nil implies
+that the response was malformed."
+  (let ((header-end-idx (string-match "\r\n" response)))
+    (if header-end-idx
+        (let ((header (string-trim (substring response 0 header-end-idx)))
+              (body (substring response (+ header-end-idx 2))))
+          (if (>= (length header) 2)
+              (let ((code (substring header 0 2))
+                    (meta (string-trim (substring header 2))))
+                (list code meta body))
+            (error "Malformed response: No response status found in header %s" header)))
+      (error "Malformed response: No CRLF-delimited header found"))))
 
 
 (defun elpher-process-gemini-response (renderer)
   "Process the gemini response and pass the result to RENDERER.
 The response is assumed to be in the variable `elpher-gemini-response'."
   (condition-case the-error
-      (let* ((response-header (car (split-string elpher-gemini-response "\r\n")))
-             (response-body (substring elpher-gemini-response
-                                       (+ (string-match "\r\n" elpher-gemini-response) 2)))
-             (response-code (car (split-string response-header)))
-             (response-meta (string-trim
-                             (substring response-header
-                                        (string-match "[ \t]+" response-header)))))
-        (pcase (elt response-code 0)
-          (?1 ; Input required
-           (elpher-with-clean-buffer
-            (insert "Gemini server is requesting input."))
-           (let* ((query-string (read-string (concat response-meta ": ")))
-                  (url (elpher-address-to-url (elpher-node-address elpher-current-node)))
-                  (query-address (elpher-address-from-url (concat url "?" query-string))))
-             (elpher-get-gemini-response query-address
-                                         (lambda (_proc event)
-                                           (unless (string-prefix-p "deleted" event)
-                                             (funcall #'elpher-process-gemini-response
-                                                      renderer)
-                                             (elpher-restore-pos))))))
-          (?2 ; Normal response
-           ;; (message response-header)
-           (funcall renderer response-body response-meta))
-          (?3 ; Redirect
-           (message "Following redirect to %s" response-meta)
-           (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
-             (elpher-get-gemini-response redirect-address
-                                         (lambda (_proc event)
-                                           (unless (string-prefix-p "deleted" event)
-                                             (funcall #'elpher-process-gemini-response
-                                                      renderer)
-                                             (elpher-restore-pos))))))
-          (?4 ; Temporary failure
-           (error "Gemini server reports TEMPORARY FAILURE for this request"))
-          (?5 ; Permanent failure
-           (error "Gemini server reports PERMANENT FAILURE for this request"))
-          (?6 ; Client certificate required
-           (error "Gemini server requires client certificate (unsupported at this time)"))
-          (_other
-           (error "Gemini server responded with unknown response code %S"
-                  response-code))))
+      (let ((response-components (elpher-parse-gemini-response elpher-gemini-response)))
+        (let ((response-code (elt response-components 0))
+              (response-meta (elt response-components 1))
+              (response-body (elt response-components 2)))
+          (pcase (elt response-code 0)
+            (?1 ; Input required
+             (elpher-with-clean-buffer
+              (insert "Gemini server is requesting input."))
+             (let* ((query-string (read-string (concat response-meta ": ")))
+                    (url (elpher-address-to-url (elpher-node-address elpher-current-node)))
+                    (query-address (elpher-address-from-url (concat url "?" query-string))))
+               (elpher-get-gemini-response query-address
+                                           (lambda (_proc event)
+                                             (unless (string-prefix-p "deleted" event)
+                                               (funcall #'elpher-process-gemini-response
+                                                        renderer)
+                                               (elpher-restore-pos))))))
+            (?2 ; Normal response
+             ;; (message response-header)
+             (funcall renderer response-body response-meta))
+            (?3 ; Redirect
+             (message "Following redirect to %s" response-meta)
+             (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
+               (elpher-get-gemini-response redirect-address
+                                           (lambda (_proc event)
+                                             (unless (string-prefix-p "deleted" event)
+                                               (funcall #'elpher-process-gemini-response
+                                                        renderer)
+                                               (elpher-restore-pos))))))
+            (?4 ; Temporary failure
+             (error "Gemini server reports TEMPORARY FAILURE for this request: %s %s"
+                    response-code response-meta))
+            (?5 ; Permanent failure
+             (error "Gemini server reports PERMANENT FAILURE for this request: %s %s"
+                    response-code response-meta))
+            (?6 ; Client certificate required
+             (error "Gemini server requires client certificate (unsupported at this time)"))
+            (_other
+             (error "Gemini server response unknown: %s %s"
+                    response-code response-meta)))))
     (error
      (elpher-network-error (elpher-node-address elpher-current-node) the-error))))
 
@@ -868,13 +895,12 @@ The response is assumed to be in the variable `elpher-gemini-response'."
                                    (list (downcase (string-trim (car key-val)))
                                          (downcase (string-trim (cadr key-val))))))
                                (cdr mime-type-split))))
-      (if (and (equal "text/gemini" mime-type)
-               (not (assoc "charset" parameters)))
-          (setq parameters (cons (list "charset" "utf-8") parameters)))
       (when (string-prefix-p "text/" mime-type)
-        (if (assoc "charset" parameters)
-            (setq body (decode-coding-string body
-                                             (intern (cadr (assoc "charset" parameters))))))
+        (setq body (decode-coding-string
+                    body
+                    (if (assoc "charset" parameters)
+                        (intern (cadr (assoc "charset" parameters)))
+                      'utf-8)))
         (setq body (replace-regexp-in-string "\r" "" body)))
       (pcase mime-type
         ((or "text/gemini" "")
@@ -898,6 +924,19 @@ The response is assumed to be in the variable `elpher-gemini-response'."
         (string-trim (substring rest (+ idx 1)))
       "")))
 
+(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 "/"))
+         (path-reversed-normalized
+          (seq-reduce (lambda (a b)
+                        (cond ((and a (equal b "..") (cdr a)))
+                              ((and (not a) (equal b "..")) a) ;leading .. are dropped
+                              ((equal b ".") a)
+                              (t (cons b a))))
+                      path nil)))
+    (string-join (reverse path-reversed-normalized) "/")))
+
 (defun elpher-address-from-gemini-url (url)
   "Extract address from URL with defaults as per gemini map files."
   (let ((address (url-generic-parse-url url)))
@@ -911,7 +950,10 @@ The response is assumed to be in the variable `elpher-gemini-response'."
                          (url-filename (elpher-node-address elpher-current-node)))
                         (url-filename address)))))
       (unless (url-type address)
-        (setf (url-type address) "gemini")))
+        (setf (url-type address) "gemini"))
+      (if (equal (url-type address) "gemini")
+          (setf (url-filename address)
+                (elpher-collapse-dot-sequences (url-filename address)))))
     address))
 
 (defun elpher-render-gemini-map (data _parameters)
@@ -985,7 +1027,7 @@ The response is assumed to be in the variable `elpher-gemini-response'."
            " - TAB/Shift-TAB: next/prev item on current page\n"
            " - RET/mouse-1: open item under cursor\n"
            " - m: select an item on current page by name (autocompletes)\n"
-           " - u: return to previous page\n"
+           " - u/mouse-3: return to previous page\n"
            " - o/O: visit different selector or the root menu of the current server\n"
            " - g: go to a particular gopher address\n"
            " - d/D: download item under cursor or current page\n"
@@ -1170,7 +1212,7 @@ If ADDRESS is already bookmarked, update the label only."
     (message "No current site.")))
 
 (defun elpher-toggle-tls ()
-  "Toggle TLS encryption mode."
+  "Toggle TLS encryption mode for gopher."
   (interactive)
   (setq elpher-use-tls (not elpher-use-tls))
   (if elpher-use-tls
@@ -1333,7 +1375,7 @@ If ADDRESS is already bookmarked, update the label only."
         (address (elpher-node-address node)))
     (if (elpher-address-special-p address)
         (message "Special page: %s" display-string)
-      (message (elpher-address-to-url address)))))
+      (message "%s" (elpher-address-to-url address)))))
 
 (defun elpher-info-link ()
   "Display information on node corresponding to link at point."