X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=06da04e8e5b7afb1418a4f47cb936a9793c0818e;hb=41161f02d39d300ea7873164262481a440dfbbb4;hp=89dcf208b0794a5100b23dbdd9d23be01f52ab4c;hpb=6936e00c3011edcde7ce0b4c8dcf1fb9ee1ec514;p=elpher.git

diff --git a/elpher.el b/elpher.el
index 89dcf20..06da04e 100644
--- a/elpher.el
+++ b/elpher.el
@@ -4,7 +4,7 @@
 
 ;; Author: Tim Vaughan <tgvaughan@gmail.com>
 ;; Created: 11 April 2019
-;; Version: 1.4.7
+;; Version: 2.0.0
 ;; Keywords: comm gopher
 ;; Homepage: https://github.com/tgvaughan/elpher
 ;; Package-Requires: ((emacs "26"))
@@ -204,12 +204,7 @@ allows switching from an encrypted channel back to plain text without user input
                 (setf (url-filename url) ""))
               (when (or (equal (url-filename url) "")
                         (equal (url-filename url) "/"))
-                (setf (url-filename url) "/1"))
-              (unless (> (url-port url) 0)
-                (setf (url-port url) 70)))
-            (when is-gemini
-              (unless (> (url-port url) 0)
-                (setf (url-port url) 1965))))
+                (setf (url-filename url) "/1"))))
           url)
       (set-match-data data))))
 
@@ -243,7 +238,10 @@ attributes: TYPE, SELECTOR, HOST and PORT."
     (let ((protocol (url-type address)))
       (cond ((or (equal protocol "gopher")
                  (equal protocol "gophers"))
-             (list 'gopher (string-to-char (substring (url-filename address) 1))))
+             (list 'gopher
+                   (if (member (url-filename address) '("" "/"))
+                       ?1
+                     (string-to-char (substring (url-filename address) 1)))))
             ((equal protocol "gemini")
              'gemini)
             (t 'other-url)))))
@@ -272,11 +270,14 @@ attributes: TYPE, SELECTOR, HOST and PORT."
 
 (defun elpher-address-gopher-p (address)
   "Return non-nill if ADDRESS object is a gopher address."
-  (memq (elpher-address-protocol address) '("gopher gophers")))
+  (and (not (elpher-address-special-p address))
+       (member (elpher-address-protocol address) '("gopher gophers"))))
 
 (defun elpher-gopher-address-selector (address)
   "Retrieve gopher selector from ADDRESS object."
-  (substring (url-filename address) 2))
+  (if (member (url-filename address) '("" "/"))
+      ""
+    (substring (url-filename address) 2)))
 
 ;; Node
 
@@ -464,10 +465,12 @@ away CRs and any terminating period."
   (let ((address (elpher-node-address node)))
     (format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
 
-(defun elpher-insert-index-record (display-string address)
+(defun elpher-insert-index-record (display-string &optional address)
   "Function to insert an index record into the current buffer.
-The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
-  (let* ((type (elpher-address-type address))
+The contents of the record are dictated by DISPLAY-STRING and ADDRESS.
+If ADDRESS is not supplied or nil the record is rendered as an
+'information' line."
+  (let* ((type (if address (elpher-address-type address) nil))
          (type-map-entry (cdr (assoc type elpher-type-map))))
     (if type-map-entry
         (let* ((margin-code (elt type-map-entry 1))
@@ -481,7 +484,7 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
                               'follow-link t
                               'help-echo (elpher-node-button-help node)))
       (pcase type
-        ('(gopher ?i) ;; Information
+        ((or '(gopher ?i) 'nil) ;; Information
          (elpher-insert-margin)
          (insert (propertize
                   (if elpher-buttonify-urls-in-directories
@@ -500,6 +503,18 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS."
     (elpher-visit-node node)))
 
 
+;;; Network error reporting
+;;
+
+(defun elpher-network-error (address error)
+  (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 the-error) ".\n"
+           (propertize "\n----------------\n\n" 'face 'error)
+           "Press 'u' to return to the previous page.")))
+
+
 ;;; Gopher selector retrieval (all kinds)
 ;;
 
@@ -533,7 +548,9 @@ up to the calling function."
              (proc (open-network-stream "elpher-process"
                                        nil
                                        (elpher-address-host address)
-                                       (elpher-address-port address)
+                                       (if (> (elpher-address-port address) 0)
+                                           (elpher-address-port address)
+                                         70)
                                        :type (if elpher-use-tls 'tls 'plain))))
         (set-process-coding-system proc 'binary)
         (set-process-filter proc
@@ -588,7 +605,7 @@ up to the calling function."
 ;; Text retrieval
 
 (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:]+\]\\)\\(?3::[0-9]+\\)?\\(?4:/[^<> \r\n\t(),]*\\)?"
   "Regexp used to locate and buttinofy URLs in text files loaded by elpher.")
 
 (defun elpher-buttonify-urls (string)
@@ -764,65 +781,188 @@ up to the calling function."
 ;; Gemini node retrieval
 
 (defvar elpher-gemini-response)
+(defvar elpher-gemini-response-header)
+(defvar elpher-gemini-in-header)
 
-(defun elpher-get-gemini (address after &optional propagate-error)
+(defun elpher-get-gemini (address after)
   "Retrieve gemini ADDRESS, then execute AFTER.
-The result is stored as a string in the variable ‘elpher-selector-string’.
+The response header is stored in the variable ‘elpher-gemini-response-header’.
+If available, the response is stored in the variable ‘elpher-gemini-response’.
 
 Usually errors result in an error page being displayed.  This is only
 appropriate if the selector is to be directly viewed.  If PROPAGATE-ERROR
 is non-nil, this message is not displayed.  Instead, the error propagates
 up to the calling function."
   (setq elpher-gemini-response "")
+  (setq elpher-gemini-response-header "")
+  (setq elpher-gemini-in-header t)
   (if (not (gnutls-available-p))
-      (error "Cannot retrieve TLS selector: 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)
+      (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)
+                                      (if (> (elpher-address-port address) 0)
+                                          (elpher-address-port address)
+                                        1965)
+                                      :type 'tls)))
+      (set-process-coding-system proc 'binary)
+      (set-process-filter proc
+                          (lambda (proc string)
+                            (if elpher-gemini-in-header
+                                (progn
+                                  (setq elpher-gemini-response-header
+                                        (concat elpher-gemini-response-header
+                                                (elt (split-string string "\r\n") 0)))
+                                  (let ((idx (string-match "\r\n" string)))
+                                    (setq elpher-gemini-response
+                                          (substring string (+ idx 2)))
+                                    (setq elpher-gemini-in-header nil)))
                               (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")))
+                                    (concat elpher-gemini-response string)))))
+      (set-process-sentinel proc after)
+      (process-send-string proc
+                           (concat (elpher-address-to-url address) "\r\n")))))
+
+
+(defun elpher-render-gemini-response (mime-type-string)
+  (let* ((mime-type-string* (if (string-empty-p mime-type-string)
+                                "text/gemini; charset=utf-8"
+                              mime-type-string))
+         (mime-type-split (split-string mime-type-string* ";"))
+         (mime-type (string-trim (car mime-type-split)))
+         (parameters (mapcar (lambda (s)
+                               (let ((key-val (split-string s "=")))
+                                 (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 elpher-gemini-response
+                (decode-coding-string elpher-gemini-response
+                                      (intern (cadr (assoc "charset" parameters))))))
+      (setq elpher-gemini-response
+            (replace-regexp-in-string "\r" "" elpher-gemini-response)))
+    (pcase mime-type
+      ((or "text/gemini" "")
+       (elpher-render--mimetype-text/gemini elpher-gemini-response parameters))
+      ((pred (string-prefix-p "text/"))
+       (elpher-render--mimetype-text/plain elpher-gemini-response parameters))
+      ((pred (string-prefix-p "image/"))
+       (elpher-render--mimetype-image/* elpher-gemini-response parameters))
+      (other
+       (error "Unsupported MIME type %S" mime-type)))))
+
+(defun elpher-gemini-get-link-url (line)
+  (string-trim (elt (split-string (substring line 2)) 0)))
+
+(defun elpher-gemini-get-link-display-string (line)
+  (let* ((rest (string-trim (elt (split-string line "=>") 1)))
+         (idx (string-match "[ \t]" rest)))
+    (if idx
+        (string-trim (substring rest (+ idx 1)))
+      "")))
+
+(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)))
+    (unless (and (url-type address) (not (url-fullness address))) ;avoid mangling mailto: urls
+      (setf (url-fullness address) t)
+      (unless (url-host address) ;if there is an explicit host, filenames are explicit
+        (setf (url-host address) (url-host (elpher-node-address elpher-current-node)))
+        (unless (string-prefix-p "/" (url-filename address)) ;deal with relative links
+          (setf (url-filename address)
+                (concat (file-name-directory 
+                         (url-filename (elpher-node-address elpher-current-node)))
+                        (url-filename address)))))
+      (unless (url-type address)
+        (setf (url-type address) "gemini")))
+    address))
+
+(defun elpher-render--mimetype-text/gemini (data parameters)
+  (elpher-with-clean-buffer
+   (dolist (line (split-string data "\n"))
+     (if (string-prefix-p "=>" line)
+         (let* ((url (elpher-gemini-get-link-url line))
+                (display-string (elpher-gemini-get-link-display-string line))
+                (address (elpher-address-from-gemini-url url)))
+           (if (> (length display-string) 0)
+               (elpher-insert-index-record display-string address)
+             (elpher-insert-index-record url address)))
+       (elpher-insert-index-record line)))
+   (elpher-restore-pos)
+   (elpher-cache-content
+    (elpher-node-address elpher-current-node)
+    (buffer-string))))
+
+(defun elpher-render--mimetype-text/plain (data parameters)
+  (elpher-with-clean-buffer
+   (insert (elpher-buttonify-urls (elpher-preprocess-text-response data)))
+   (elpher-restore-pos)
+   (elpher-cache-content
+    (elpher-node-address elpher-current-node)
+    (buffer-string))))
+
+(defun elpher-render--mimetype-image/* (data parameters)
+  (let ((image (create-image data nil t)))
+    (elpher-with-clean-buffer
+     (insert-image image)
+     (elpher-restore-pos))))
+
+(defun elpher-process-gemini-response (proc event)
+  (condition-case the-error
+      (unless (string-prefix-p "deleted" event)
+        (let ((response-code (car (split-string elpher-gemini-response-header)))
+              (meta (string-trim
+                     (substring elpher-gemini-response-header
+                                (string-match "[ \t]+"
+                                              elpher-gemini-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 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 query-address #'elpher-process-gemini-response)))
+            (?2 ; Normal response
+             (message elpher-gemini-response-header)
+             (elpher-render-gemini-response meta))
+            (?3 ; Redirect
+             (message "Following redirect to %s" meta)
+             (let ((redirect-address (elpher-address-from-gemini-url meta)))
+               (elpher-get-gemini redirect-address #'elpher-process-gemini-response)))
+            (?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)))))
     (error
-     (elpher-process-cleanup)
-     (if propagate-error
-         (error the-error)
-       (elpher-with-clean-buffer
-        (insert (propertize "\n---- ERROR -----\n\n" 'face 'error)
-                "Failed to connect to " (elpher-address-to-url address) ".\n"
-                (propertize "\n----------------\n\n" 'face 'error)
-                "Press 'u' to return to the previous page."))))))
+     (elpher-network-error (elpher-node-address elpher-current-node) the-error))))
+
 
 (defun elpher-get-gemini-node ()
   "Getter which retrieves and renders a Gemini node."
   (let* ((address (elpher-node-address elpher-current-node))
          (content (elpher-get-cached-content address)))
-    (if content
-        (progn
+    (condition-case the-error
+        (if content
+            (progn
+              (elpher-with-clean-buffer
+               (insert content)
+               (elpher-restore-pos)))
           (elpher-with-clean-buffer
-           (insert content)
-           (elpher-restore-pos)))
-      (elpher-with-clean-buffer
-       (insert "LOADING GEMINI... (use 'u' to cancel)"))
-      (elpher-get-gemini address
-                           (lambda (proc event)
-                             (unless (string-prefix-p "deleted" event)
-                               (elpher-with-clean-buffer
-                                (insert (elpher-buttonify-urls
-                                         (elpher-preprocess-text-response
-                                          elpher-gemini-response)))
-                                (elpher-restore-pos)
-                                (elpher-cache-content
-                                 (elpher-node-address elpher-current-node)
-                                 (buffer-string)))))))))
+           (insert "LOADING GEMINI... (use 'u' to cancel)"))
+          (elpher-get-gemini address #'elpher-process-gemini-response))
+      (error
+       (elpher-network-error address the-error)))))
 
 
 ;; Other URL node opening
@@ -1003,12 +1143,10 @@ If ADDRESS is already bookmarked, update the label only."
   (push-button))
 
 (defun elpher-go ()
-  "Go to a particular gopher site read from the minibuffer.
-The site may be specified via a URL or explicitly in terms of
-host, selector and port."
+  "Go to a particular gopher site read from the minibuffer."
   (interactive)
   (let ((node
-         (let ((host-or-url (read-string "Gopher host or URL: ")))
+         (let ((host-or-url (read-string "Gopher or Gemini URL: ")))
            (elpher-make-node host-or-url
                              (elpher-address-from-url host-or-url)))))
     (switch-to-buffer "*elpher*")
@@ -1020,7 +1158,7 @@ host, selector and port."
   (let ((address (elpher-node-address elpher-current-node)))
     (if (elpher-address-special-p address)
         (error "Command not valid for this page")
-      (let ((url (read-string "URL: " (elpher-address-to-url address))))
+      (let ((url (read-string "Gopher or Gemini URL: " (elpher-address-to-url address))))
         (elpher-visit-node (elpher-make-node url (elpher-address-from-url url)))))))
 
 (defun elpher-redraw ()
@@ -1114,17 +1252,18 @@ host, selector and port."
 (defun elpher-root-dir ()
   "Visit root of current server."
   (interactive)
-  (let* ((address (elpher-node-address elpher-current-node))
-         (host (elpher-address-host address)))
-    (if host
-        (let ((host (elpher-address-host address))
-              (selector (elpher-gopher-address-selector address))
-              (port (elpher-address-port address)))
-          (if (> (length selector) 0)
-              (let ((root-address (elpher-make-gopher-address ?1 "" host port)))
-                (elpher-visit-node
-                 (elpher-make-node (elpher-address-to-url root-address))))
-            (error "Already at root directory of current server")))
+  (let ((address (elpher-node-address elpher-current-node)))
+    (if (not (elpher-address-special-p address))
+        (if (or (member (url-filename address) '("/" ""))
+                (and (elpher-address-gopher-p address)
+                     (= (length (elpher-gopher-address-selector address)) 0)))
+            (error "Already at root directory of current server")
+          (let ((address-copy (elpher-address-from-url
+                               (elpher-address-to-url address))))
+            (setf (url-filename address-copy) "")
+            (elpher-visit-node
+             (elpher-make-node (elpher-address-to-url address-copy)
+                               address-copy))))
       (error "Command invalid for this page"))))
 
 (defun elpher-bookmarks-current-p ()
@@ -1279,7 +1418,6 @@ host, selector and port."
         (kbd "C-") 'elpher-follow-current-link
         (kbd "C-t") 'elpher-back
         (kbd "u") 'elpher-back
-        (kbd "O") 'elpher-root-dir
         (kbd "g") 'elpher-go
         (kbd "o") 'elpher-go-current
         (kbd "r") 'elpher-redraw
@@ -1303,7 +1441,7 @@ host, selector and port."
   "Keymap for gopher client.")
 
 (define-derived-mode elpher-mode special-mode "elpher"
-  "Major mode for elpher, an elisp gopher client.
+  "Major mode for elpher, an elisp gopher client.)
 
 This mode is automatically enabled by the interactive
 functions which initialize the gopher client, namely