;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; Created: 11 April 2019
-;; Version: 2.3.6
+;; Version: 2.4.4
;; Keywords: comm gopher
-;; Homepage: https://github.com/tgvaughan/elpher
+;; Homepage: http://thelambdalab.xyz/elpher
;; Package-Requires: ((emacs "26"))
;; This file is not part of GNU Emacs.
;; - direct visualisation of image files,
;; - a simple bookmark management system,
;; - connections using TLS encryption,
-;; - basic support for the fledgling Gemini protocol.
+;; - support for the fledgling Gemini protocol.
;; To launch Elpher, simply use 'M-x elpher'. This will open a start
;; page containing information on key bindings and suggested starting
;; Full instructions can be found in the Elpher info manual.
;; Elpher is under active development. Any suggestions for
-;; improvements are welcome!
+;; improvements are welcome, and can be made on the official
+;; project page, gopher://thelambdalab.xyz/1/projects/elpher/.
;;; Code:
;;; Global constants
;;
-(defconst elpher-version "2.3.6"
+(defconst elpher-version "2.4.4"
"Current version of elpher.")
(defconst elpher-margin-width 6
allows switching from an encrypted channel back to plain text without user input."
:type '(boolean))
+(defcustom elpher-connection-timeout 5
+ "Specifies the number of seconds to wait for a network connection to time out."
+ :type '(integer))
;;; Model
;;
""
(substring (url-filename address) 2)))
-;; Node
+;; Page
-(defun elpher-make-node (display-string address &optional parent)
- "Create a node in the page hierarchy.
-
-DISPLAY-STRING records the display string used for the page.
-
-ADDRESS specifies the address object of the page.
-
-The optional PARENT specifies the parent node in the hierarchy.
-This is set every time the node is visited, so while it forms
-an important part of the node data there is no need to set it
-initially."
- (list display-string address parent))
-
-(defun elpher-node-display-string (node)
- "Retrieve the display string of NODE."
- (elt node 0))
-
-(defun elpher-node-address (node)
- "Retrieve the ADDRESS object of NODE."
- (elt node 1))
-
-(defun elpher-node-parent (node)
- "Retrieve the parent node of NODE."
- (elt node 2))
-
-(defun elpher-set-node-parent (node parent)
- "Set the parent node of NODE to be PARENT."
- (setcar (cdr (cdr node)) parent))
;; Cache
"Set the cursor position cache for ADDRESS to POS."
(puthash address pos elpher-pos-cache))
-;; Node graph traversal
+;; Page
+
+(defun elpher-make-page (address display-string)
+ (list address display-string))
-(defvar elpher-current-node nil)
+(defun elpher-page-address (page)
+ (elt page 0))
-(defun elpher-visit-node (node &optional renderer preserve-parent)
- "Visit NODE using its own renderer or RENDERER, if non-nil.
-Additionally, set the parent of NODE to `elpher-current-node',
-unless PRESERVE-PARENT is non-nil."
+(defun elpher-page-display-string (page)
+ (elt page 1))
+
+
+(defvar elpher-current-page nil)
+(defvar elpher-history nil)
+
+(defun elpher-visit-page (page &optional renderer no-history)
+ "Visit PAGE using its own renderer or RENDERER, if non-nil.
+Additionally, push PAGE onto the stack of previously-visited pages,
+unless NO-HISTORY is non-nil."
(elpher-save-pos)
(elpher-process-cleanup)
- (unless preserve-parent
- (if (and (elpher-node-parent elpher-current-node)
- (equal (elpher-node-address elpher-current-node)
- (elpher-node-address node)))
- (elpher-set-node-parent node (elpher-node-parent elpher-current-node))
- (elpher-set-node-parent node elpher-current-node)))
- (setq elpher-current-node node)
- (let* ((address (elpher-node-address node))
+ (unless no-history
+ (push page elpher-history))
+ (setq elpher-current-page page)
+ (let* ((address (elpher-page-address node))
(type (elpher-address-type address))
(type-record (cdr (assoc type elpher-type-map))))
(if type-record
(if renderer
renderer
(cadr type-record)))
- (elpher-visit-parent-node)
+ (elpher-visit-previous-page)
(pcase type
(`(gopher ,type-char)
(error "Unsupported gopher selector type '%c' for '%s'"
(error "Unsupported address type '%S' for '%s'"
other (elpher-address-to-url address)))))))
-(defun elpher-visit-parent-node ()
+(defun elpher-visit-previous-page ()
"Visit the parent of the current node."
- (let ((parent-node (elpher-node-parent elpher-current-node)))
- (when parent-node
- (elpher-visit-node parent-node nil t))))
+ (let ((previous-page (pop elpher-history)))
+ (when previous-page
+ (elpher-visit-node previous-page nil t))))
-(defun elpher-reload-current-node ()
+(defun elpher-reload-current-page ()
"Reload the current node, discarding any existing cached content."
(elpher-cache-content (elpher-node-address elpher-current-node) nil)
(elpher-visit-node elpher-current-node))
;;
(defun elpher-network-error (address error)
- "Display ERROR message following unsuccessful negotiation with ADDRESS."
+ "Display ERROR message following unsuccessful negotiation with ADDRESS.
+ERROR can be either an error object or a string."
(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"
+ (if (stringp error) error (error-message-string error)) "\n"
(propertize "\n----------------\n\n" 'face 'error)
"Press 'u' to return to the previous page.")))
;;; Gopher selector retrieval
;;
+(defvar elpher-network-timer nil
+ "Timer used for network connections.")
+
(defun elpher-process-cleanup ()
- "Immediately shut down any extant elpher process."
+ "Immediately shut down any extant elpher process and timers."
(let ((p (get-process "elpher-process")))
- (if p (delete-process p))))
+ (if p (delete-process p)))
+ (if (timerp elpher-network-timer)
+ (cancel-timer elpher-network-timer)))
(defvar elpher-use-tls nil
"If non-nil, use TLS to communicate with gopher servers.")
-(defvar elpher-selector-string)
-
-(defun elpher-get-selector (address after &optional propagate-error)
- "Retrieve selector specified by ADDRESS, then execute AFTER.
-The result is stored as a string in the variable ‘elpher-selector-string’.
-
-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-selector-string "")
+(defun elpher-get-selector (address renderer &optional force-ipv4)
+ "Retrieve selector specified by ADDRESS, then render it using RENDERER.
+If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
+to ADDRESS."
(when (equal (elpher-address-protocol address) "gophers")
- (if (gnutls-available-p)
- (when (not elpher-use-tls)
- (setq elpher-use-tls t)
- (message "Engaging TLS gopher mode."))
- (error "Cannot retrieve TLS gopher selector: GnuTLS not available")))
- (condition-case the-error
+ (if (gnutls-available-p)
+ (when (not elpher-use-tls)
+ (setq elpher-use-tls t)
+ (message "Engaging TLS gopher mode."))
+ (error "Cannot retrieve TLS gopher selector: GnuTLS not available")))
+ (unless (< (elpher-address-port address) 65536)
+ (error "Cannot retrieve gopher selector: port number > 65536"))
+ (condition-case nil
(let* ((kill-buffer-query-functions nil)
(port (elpher-address-port address))
(host (elpher-address-host address))
+ (selector-string "")
(proc (open-network-stream "elpher-process"
- nil
- host
- (if (> port 0) port 70)
- :type (if elpher-use-tls 'tls 'plain)
- :nowait t)))
+ nil
+ (if force-ipv4 (dns-query host) host)
+ (if (> port 0) port 70)
+ :type (if elpher-use-tls 'tls 'plain)
+ :nowait t))
+ (timer (run-at-time elpher-connection-timeout
+ nil
+ (lambda ()
+ (pcase (process-status proc)
+ ('failed
+ (if (and (not (equal (elpher-address-protocol address)
+ "gophers"))
+ elpher-use-tls
+ (or elpher-auto-disengage-TLS
+ (yes-or-no-p "Could not establish encrypted connection. Disable TLS mode?")))
+ (progn
+ (message "Disabling TLS mode.")
+ (setq elpher-use-tls nil)
+ (elpher-get-selector address renderer))
+ (elpher-network-error address "Could not establish encrypted connection")))
+ ('connect
+ (elpher-process-cleanup)
+ (unless force-ipv4
+ (message "Connection timed out. Retrying with IPv4 address.")
+ (elpher-get-selector address renderer t))))))))
+ (setq elpher-network-timer timer)
(set-process-coding-system proc 'binary)
(set-process-filter proc
(lambda (_proc string)
- (setq elpher-selector-string
- (concat elpher-selector-string string))))
- (set-process-sentinel proc after)
- (let ((inhibit-eol-conversion t))
- (process-send-string proc
- (concat (elpher-gopher-address-selector address) "\r\n"))))
+ (cancel-timer timer)
+ (setq selector-string
+ (concat selector-string string))))
+ (set-process-sentinel proc
+ (lambda (_proc event)
+ (condition-case the-error
+ (cond
+ ((string-prefix-p "deleted" event))
+ ((string-prefix-p "open" event)
+ (let ((inhibit-eol-conversion t))
+ (process-send-string
+ proc
+ (concat (elpher-gopher-address-selector address)
+ "\r\n"))))
+ (t
+ (cancel-timer timer)
+ (funcall renderer selector-string)
+ (elpher-restore-pos)))
+ (error
+ (elpher-network-error address the-error))))))
(error
- (if (and (consp the-error)
- (eq (car the-error) 'gnutls-error)
- (not (equal (elpher-address-protocol address) "gophers"))
- (or elpher-auto-disengage-TLS
- (yes-or-no-p "Could not establish encrypted connection. Disable TLS mode? ")))
- (progn
- (message "Disengaging TLS gopher mode.")
- (setq elpher-use-tls nil)
- (elpher-get-selector address after))
- (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.")))))))
+ (error "Error initiating connection to server"))))
(defun elpher-get-gopher-node (renderer)
"Getter function for gopher nodes.
(elpher-restore-pos))
(elpher-with-clean-buffer
(insert "LOADING... (use 'u' to cancel)"))
- (elpher-get-selector address
- (lambda (_proc event)
- (unless (or (string-prefix-p "deleted" event)
- (string-prefix-p "open" event))
- (funcall renderer elpher-selector-string)
- (elpher-restore-pos)))))))
+ (condition-case the-error
+ (elpher-get-selector address renderer)
+ (error
+ (elpher-network-error address the-error))))))
;; Index rendering
;; Text rendering
(defconst elpher-url-regex
- "\\([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\-_~?/@|]\\)?\\)?"
+ "\\([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)
(elpher-with-clean-buffer
(insert "LOADING RESULTS... (use 'u' to cancel)"))
- (elpher-get-selector search-address
- (lambda (_proc event)
- (unless (string-prefix-p "deleted" event)
- (funcall renderer elpher-selector-string)
- (elpher-restore-pos)))))
+ (elpher-get-selector search-address renderer))
(if aborted
(elpher-visit-parent-node))))))
;; Raw server response rendering
-(defun elpher-render-raw (data &optional _mime-type-string)
- "Display raw DATA in buffer. MIME-TYPE-STRING is unused."
+(defun elpher-render-raw (data &optional mime-type-string)
+ "Display raw DATA in buffer. MIME-TYPE-STRING is also displayed if provided."
(if (not data)
nil
(elpher-with-clean-buffer
+ (when mime-type-string
+ (insert "MIME type specified by server: '" mime-type-string "'\n"))
(insert data)
(goto-char (point-min)))
(message "Displaying raw server response. Reload or redraw to return to standard view.")))
;; Gemini node retrieval
-(defvar elpher-gemini-response)
(defvar elpher-gemini-redirect-chain)
-(defun elpher-get-gemini-response (address after)
- "Retrieve gemini ADDRESS, then execute AFTER.
-The response is stored in the variable ‘elpher-gemini-response’."
- (setq elpher-gemini-response "")
+(defun elpher-get-gemini-response (address renderer &optional force-ipv4)
+ "Retrieve gemini ADDRESS, then render using RENDERER.
+If FORCE-IPV4 is non-nil, explicitly look up and use IPv4 address corresponding
+to ADDRESS."
(if (not (gnutls-available-p))
(error "Cannot establish gemini connection: GnuTLS not available")
- (condition-case the-error
+ (unless (< (elpher-address-port address) 65536)
+ (error "Cannot establish gemini connection: port number > 65536"))
+ (condition-case nil
(let* ((kill-buffer-query-functions nil)
- (network-security-level 'medium)
(port (elpher-address-port address))
(host (elpher-address-host address))
+ (response-string "")
(proc (open-network-stream "elpher-process"
nil
- host
+ (if force-ipv4 (dns-query host) host)
(if (> port 0) port 1965)
:type 'tls
- :nowait t)))
+ :nowait t))
+ (timer (run-at-time elpher-connection-timeout nil
+ (lambda ()
+ (elpher-process-cleanup)
+ (unless force-ipv4
+ ; Try again with IPv4
+ (message "Connection timed out. Retrying with IPv4.")
+ (elpher-get-gemini-response address renderer t))))))
+ (setq elpher-network-timer timer)
(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"))))
+ (cancel-timer timer)
+ (setq response-string
+ (concat response-string string))))
+ (set-process-sentinel proc
+ (lambda (proc event)
+ (condition-case the-error
+ (cond
+ ((string-prefix-p "open" event) ; request URL
+ (let ((inhibit-eol-conversion t))
+ (process-send-string
+ proc
+ (concat (elpher-address-to-url address)
+ "\r\n"))))
+ ((string-prefix-p "deleted" event)) ; do nothing
+ ((and (string-empty-p response-string)
+ (not force-ipv4))
+ ; Try again with IPv4
+ (message "Connection failed. Retrying with IPv4.")
+ (cancel-timer timer)
+ (elpher-get-gemini-response address renderer t))
+ (t
+ (funcall #'elpher-process-gemini-response
+ response-string
+ renderer)
+ (elpher-restore-pos)))
+ (error
+ (elpher-network-error address the-error))))))
(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
+ "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
(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-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 (or (string-prefix-p "deleted" event)
- (string-prefix-p "open" 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)
- (if (>= (length elpher-gemini-redirect-chain) 5)
- (error "More than 5 consecutive redirects followed"))
- (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
- (if (member redirect-address elpher-gemini-redirect-chain)
- (error "Redirect loop detected"))
- (if (not (string= (elpher-address-protocol redirect-address)
- "gemini"))
- (error "Server tried to automatically redirect to non-gemini URL: %s"
- response-meta))
- (add-to-list 'elpher-gemini-redirect-chain redirect-address)
- (elpher-get-gemini-response redirect-address
- (lambda (_proc event)
- (unless (or (string-prefix-p "deleted" event)
- (string-prefix-p "open" 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))))
+(defun elpher-process-gemini-response (response-string renderer)
+ "Process the gemini response RESPONSE-STRING and pass the result to RENDERER."
+ (let ((response-components (elpher-parse-gemini-response response-string)))
+ (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 renderer)))
+ (?2 ; Normal response
+ (funcall renderer response-body response-meta))
+ (?3 ; Redirect
+ (message "Following redirect to %s" response-meta)
+ (if (>= (length elpher-gemini-redirect-chain) 5)
+ (error "More than 5 consecutive redirects followed"))
+ (let ((redirect-address (elpher-address-from-gemini-url response-meta)))
+ (if (member redirect-address elpher-gemini-redirect-chain)
+ (error "Redirect loop detected"))
+ (if (not (string= (elpher-address-protocol redirect-address)
+ "gemini"))
+ (error "Server tried to automatically redirect to non-gemini URL: %s"
+ response-meta))
+ (add-to-list 'elpher-gemini-redirect-chain redirect-address)
+ (elpher-get-gemini-response redirect-address renderer)))
+ (?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))))))
(defun elpher-get-gemini-node (renderer)
"Getter which retrieves and renders a Gemini node and renders it using RENDERER."
(elpher-with-clean-buffer
(insert "LOADING GEMINI... (use 'u' to cancel)"))
(setq elpher-gemini-redirect-chain nil)
- (elpher-get-gemini-response address
- (lambda (_proc event)
- (unless (or (string-prefix-p "deleted" event)
- (string-prefix-p "open" event))
- (funcall #'elpher-process-gemini-response
- renderer)
- (elpher-restore-pos)))))
+ (elpher-get-gemini-response address renderer))
(error
(elpher-network-error address the-error)))))
(pcase mime-type
((or "text/gemini" "")
(elpher-render-gemini-map body parameters))
+ ("text/html"
+ (elpher-render-html body))
((pred (string-prefix-p "text/"))
(elpher-render-gemini-plain-text body parameters))
((pred (string-prefix-p "image/"))
(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 absolute
+ (if (url-host address) ;if there is an explicit host, filenames are absolute
+ (if (string-empty-p (url-filename address))
+ (setf (url-filename address) "/")) ;ensure empty filename is marked as absolute
(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)
(insert "\n"
"This page contains your bookmarked sites (also visit with B):\n")
(elpher-insert-index-record "Your Bookmarks" 'bookmarks)
+ (insert "\n"
+ "For Elpher release news or to leave feedback, visit:\n")
+ (elpher-insert-index-record "The Elpher Project Page"
+ (elpher-make-gopher-address ?1
+ "/projects/elpher/"
+ "thelambdalab.xyz"
+ 70))
(insert "\n"
"** Refer to the ")
(let ((help-string "RET,mouse-1: Open Elpher info manual (if available)"))
(insert " for the full documentation. **\n")
(insert (propertize
(concat " (This should be available if you have installed Elpher using\n"
- " MELPA. Otherwise you will have to install the manual yourself.)")
+ " MELPA. Otherwise you will have to install the manual yourself.)\n")
'face 'shadow))
(elpher-restore-pos)))
(address (elpher-address-from-url (elpher-bookmark-url bookmark))))
(elpher-insert-index-record display-string address)))
(insert "No bookmarks found.\n")))
- (insert "\n-----------------------\n\n"
+ (insert "\n-----------------------\n"
+ "\n"
"- u: return to previous page\n"
"- x: delete selected bookmark\n"
- "- a: rename selected bookmark\n\n"
- "Bookmarks are stored in the file "
- (locate-user-emacs-file "elpher-bookmarks"))
+ "- a: rename selected bookmark\n"
+ "\n"
+ "Bookmarks are stored in the file ")
+ (let ((filename (locate-user-emacs-file "elpher-bookmarks"))
+ (help-string "RET,mouse-1: Open bookmarks file in new buffer for editing."))
+ (insert-text-button filename
+ 'face 'link
+ 'action (lambda (_)
+ (interactive)
+ (find-file filename))
+ 'follow-link t
+ 'help-echo help-string))
+ (insert "\n")
(elpher-restore-pos)))
The Lambda Lab / projects / elpher.git / blobdiff