X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=bb1bc48b4ef898532a041d3feea64bc799024650;hb=25c0852cea9617041acb6a499c92d35b007a8370;hp=1fa5ed54ea7291bcd8cc8e12c60c5e93ed2168c0;hpb=5df0f96c23837284d585c8917744584f70a63c7f;p=elpher.git

diff --git a/elpher.el b/elpher.el
index 1fa5ed5..bb1bc48 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"))
@@ -84,6 +84,7 @@
     ((gopher ?P) elpher-get-node-download "doc" elpher-binary)
     ((gopher ?s) elpher-get-node-download "snd" elpher-binary)
     ((gopher ?h) elpher-get-html-node "htm" elpher-html)
+    (gemini elpher-get-gemini-node "gem" elpher-gemini)
     (other-url elpher-get-other-url-node "url" elpher-other-url)
     ((special bookmarks) elpher-get-bookmarks-node)
     ((special start) elpher-get-start-node))
@@ -121,11 +122,15 @@
 
 (defface elpher-html
   '((t :inherit font-lock-comment-face))
-  "Face used for url type directory records.")
+  "Face used for html type directory records.")
+
+(defface elpher-gemini
+  '((t :inherit font-lock-function-name-face))
+  "Face used for html type directory records.")
 
 (defface elpher-other-url
   '((t :inherit font-lock-comment-face))
-  "Face used for url type directory records.")
+  "Face used for other URL type links records.")
 
 (defface elpher-telnet
   '((t :inherit font-lock-function-name-face))
@@ -185,26 +190,27 @@ allows switching from an encrypted channel back to plain text without user input
     (unwind-protect
         (let ((url (url-generic-parse-url url-string)))
           (setf (url-fullness url) t)
-          (unless (url-host url)
-            (setf (url-host url) (url-filename url))
-            (setf (url-filename url) ""))
+          (setf (url-filename url)
+                (url-unhex-string (url-filename url)))
           (unless (url-type url)
             (setf (url-type url) "gopher"))
-          (if (and (url-type url)
-                   (url-host url))
-              (let ((is-gopher (or (equal "gopher" (url-type url))
-                                   (equal "gophers" (url-type url)))))
-                (setf (url-filename url)
-                      (url-unhex-string (url-filename url)))
-                (when (or (equal (url-filename url) "")
-                          (equal (url-filename url) "/"))
-                  (if is-gopher
-                      (setf (url-filename url) "/1")))
-                (unless (> (url-port url) 0)
-                  (if is-gopher
-                      (setf (url-port url) 70)))
-                url)
-            (error "Malformed URL" url)))
+          (let ((is-gopher (or (equal "gopher" (url-type url))
+                               (equal "gophers" (url-type url))))
+                (is-gemini (equal "gemini" (url-type url))))
+            (when is-gopher
+              ;; Gopher defaults
+              (unless (url-host url)
+                (setf (url-host url) (url-filename url))
+                (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))))
+          url)
       (set-match-data data))))
 
 (defun elpher-make-gopher-address (type selector host port &optional tls)
@@ -266,7 +272,8 @@ 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."
@@ -494,6 +501,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)
 ;;
 
@@ -755,6 +774,185 @@ up to the calling function."
                                    (elpher-node-address elpher-current-node)
                                    (buffer-string))))))))))
 
+;; Gemini node retrieval
+
+(defvar elpher-gemini-response)
+(defvar elpher-gemini-response-header)
+(defvar elpher-gemini-in-header)
+
+(defun elpher-gemini-response-code ()
+  (elt (split-string elpher-gemini-response-header) 0))
+
+(defun elpher-gemini-response-meta ()
+  (string-trim (substring elpher-gemini-response-header
+                          (string-match "[ \t]+" elpher-gemini-response-header))))
+
+(defun elpher-get-gemini (address after)
+  "Retrieve gemini ADDRESS, then execute AFTER.
+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")
+    (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)
+                            (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")))))
+
+(defun elpher-render-gemini-response (mime-type-raw)
+  (let* ((mime-type-full (if (string-empty-p mime-type-raw)
+                             "text/gemini; charset=utf-8"
+                           mime-type-raw))
+         (mime-type-split (split-string mime-type-full ";"))
+         (mime-type (string-trim (elt mime-type-split 0)))
+         (parameters (if (> (length mime-type-split) 1)
+                         (string-trim (elt mime-type-split 1))
+                       "")))
+    (message "MIME type %S" mime-type)
+    (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)
+  (let ((address (url-generic-parse-url url)))
+    (setf (url-fullness address) t)
+    (unless (url-host address)
+      (setf (url-host address) (url-host (elpher-node-address elpher-current-node)))
+      (unless (string-prefix-p "/" (url-filename address))
+        (setf (url-filename address)
+              (concat (file-name-as-directory 
+                       (url-filename (elpher-node-address elpher-current-node)))
+                      (url-filename address)))))
+    (unless (url-type address)
+      (setf (url-type address) "gemini"))
+    (unless (> (url-port address) 0)
+      (pcase (url-type address)
+        ("gemini" (setf (url-port address) 1965))
+        ("gopher" (setf (url-port address) 70))))
+    address))
+
+(defun elpher-render--mimetype-text/gemini (data parameters)
+  (elpher-with-clean-buffer
+   (dolist (line (split-string (elpher-preprocess-text-response 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)))
+       (insert (elpher-buttonify-urls line) "\n")))
+   (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 (elpher-gemini-response-code))
+              (meta (elpher-gemini-response-meta)))
+          (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
+             (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-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)))
+    (condition-case the-error
+        (if content
+            (progn
+              (elpher-with-clean-buffer
+               (insert content)
+               (elpher-restore-pos)))
+          (elpher-with-clean-buffer
+           (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
 
@@ -934,12 +1132,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*")
@@ -951,7 +1147,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 ()
@@ -1045,17 +1241,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 ()
@@ -1210,7 +1407,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
@@ -1234,7 +1430,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