;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; Created: 11 April 2019
-;; Version: 2.1.0
+;; Version: 2.3.6
;; Keywords: comm gopher
;; Homepage: https://github.com/tgvaughan/elpher
;; Package-Requires: ((emacs "26"))
(require 'shr)
(require 'url-util)
(require 'subr-x)
+(require 'dns)
;;; Global constants
;;
-(defconst elpher-version "2.1.0"
+(defconst elpher-version "2.3.6"
"Current version of elpher.")
(defconst elpher-margin-width 6
(gemini elpher-get-gemini-node elpher-render-gemini "gem" elpher-gemini)
(telnet elpher-get-telnet-node nil "tel" elpher-telnet)
(other-url elpher-get-other-url-node nil "url" elpher-other-url)
- ((special bookmarks) elpher-get-bookmarks-node nil)
+ ((special bookmarks) elpher-get-bookmarks-node nil "/" elpher-index)
((special start) elpher-get-start-node nil))
"Association list from types to getters, renderers, margin codes and index faces.")
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
;;
(let ((data (match-data))) ; Prevent parsing clobbering match data
(unwind-protect
(let ((url (url-generic-parse-url url-string)))
- (setf (url-fullness url) t)
- (setf (url-filename url)
- (url-unhex-string (url-filename url)))
- (unless (url-type url)
- (setf (url-type url) "gopher"))
- (when (or (equal "gopher" (url-type url))
- (equal "gophers" (url-type url)))
+ (unless (and (not (url-fullness url)) (url-type url))
+ (setf (url-fullness url) t)
+ (setf (url-filename url)
+ (url-unhex-string (url-filename url)))
+ (unless (url-type url)
+ (setf (url-type url) "gopher"))
+ (when (or (equal "gopher" (url-type url))
+ (equal "gophers" (url-type url)))
;; Gopher defaults
(unless (url-host url)
(setf (url-host url) (url-filename url))
(when (or (equal (url-filename url) "")
(equal (url-filename url) "/"))
(setf (url-filename url) "/1")))
+ (when (equal "gemini" (url-type url))
+ ;; Gemini defaults
+ (if (equal (url-filename url) "")
+ (setf (url-filename url) "/"))))
url)
(set-match-data data))))
(url-host address))
(defun elpher-address-port (address)
- "Retrieve port from ADDRESS object."
- (url-port address))
+ "Retrieve port from ADDRESS object.
+If no address is defined, returns 0. (This is for compatibility with the URL library.)"
+ (if (symbolp address)
+ 0
+ (url-port address)))
(defun elpher-address-special-p (address)
"Return non-nil if ADDRESS object is special (e.g. start page, bookmarks page)."
(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))
+ (tls-string (if (and (not (elpher-address-special-p address))
+ (member (elpher-address-protocol address)
+ '("gophers" "gemini")))
+ " [TLS encryption]"
+ ""))
+ (header (concat display-string
+ (propertize tls-string 'face 'bold))))
+ (setq header-line-format header))))
(defmacro elpher-with-clean-buffer (&rest args)
"Evaluate ARGS with a clean *elpher* buffer as current."
(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.")))
(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."
+(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."
(setq elpher-selector-string "")
(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
- (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)
- 70)
- :type (if elpher-use-tls 'tls 'plain))))
- (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)
- (process-send-string proc
- (concat (elpher-gopher-address-selector address) "\n")))
- (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.")))))))
+ (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")))
+ (let* ((kill-buffer-query-functions nil)
+ (port (elpher-address-port address))
+ (host (elpher-address-host address))
+ (proc (open-network-stream "elpher-process"
+ 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 ()
+ (message "timeout (status %s)" (process-status proc))
+ (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))))
+ ('connect
+ (elpher-process-cleanup)
+ (unless force-ipv4
+ (elpher-get-selector address renderer t))))))))
+ (set-process-coding-system proc 'binary)
+ (set-process-filter proc
+ (lambda (_proc string)
+ (message "filter")
+ (cancel-timer timer)
+ (setq elpher-selector-string
+ (concat elpher-selector-string string))))
+ (set-process-sentinel proc
+ (lambda (_proc event)
+ (message "Event: %s" event)
+ (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)
+ (condition-case the-error
+ (progn
+ (funcall renderer elpher-selector-string)
+ (elpher-restore-pos))
+ (error
+ (message "sentinel %s" the-error)
+ (elpher-network-error address the-error)))))))))
(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 (string-prefix-p "deleted" event)
- (funcall renderer elpher-selector-string)
- (elpher-restore-pos)))))))
+ (elpher-get-selector address renderer))))
;; Index rendering
(defun elpher-node-button-help (node)
"Return a string containing the help text for a button corresponding to NODE."
(let ((address (elpher-node-address node)))
- (format "mouse-1, RET: open '%s'" (elpher-address-to-url address))))
+ (format "mouse-1, RET: open '%s'" (if (elpher-address-special-p address)
+ address
+ (elpher-address-to-url address)))))
(defun elpher-insert-index-record (display-string &optional address)
"Function to insert an index record into the current buffer.
;; 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)
(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)
(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’."
+(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."
(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)
- (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)
- (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)
+ (network-security-level 'medium)
+ (port (elpher-address-port address))
+ (host (elpher-address-host address))
+ (proc (open-network-stream "elpher-process"
+ nil
+ (if force-ipv4 (dns-query host) host)
+ (if (> port 0) port 1965)
+ :type 'tls
+ :nowait t))
+ (timer (run-at-time elpher-connection-timeout nil
+ (lambda ()
+ (elpher-process-cleanup)
+ (unless force-ipv4
+ ; Try again with IPv4
+ (elpher-get-gemini-response address renderer t))))))
+ (set-process-coding-system proc 'binary)
+ (set-process-filter proc
+ (lambda (_proc string)
+ (cancel-timer timer)
+ (setq elpher-gemini-response
+ (concat elpher-gemini-response string))))
+ (set-process-sentinel proc
+ (lambda (proc event)
+ (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 elpher-gemini-response)
+ (not force-ipv4))
+ ; Try again with IPv4
+ (cancel-timer timer)
+ (elpher-get-gemini-response address renderer t))
+ (t
+ (funcall #'elpher-process-gemini-response
+ renderer)
+ (elpher-restore-pos))))))
+ (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 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)))))
(error
(elpher-network-error (elpher-node-address elpher-current-node) the-error))))
(elpher-restore-pos))
(elpher-with-clean-buffer
(insert "LOADING GEMINI... (use 'u' to cancel)"))
- (elpher-get-gemini-response address
- (lambda (_proc event)
- (unless (string-prefix-p "deleted" event)
- (funcall #'elpher-process-gemini-response
- renderer)
- (elpher-restore-pos)))))
+ (setq elpher-gemini-redirect-chain nil)
+ (elpher-get-gemini-response address renderer))
(error
(elpher-network-error address the-error)))))
(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" "")
(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/"))
(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)))
(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
+ (unless (url-host address) ;if there is an explicit host, filenames are 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)
(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)
(host (elpher-address-host address))
(port (elpher-address-port address)))
(elpher-visit-parent-node)
- (telnet host port)))
+ (if (> port 0)
+ (telnet host port)
+ (telnet host))))
;; Start page node retrieval
" - 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"
"Alternatively, select the following item and enter some search terms:\n")
(elpher-insert-index-record "Veronica-2 Gopher Search Engine"
(elpher-make-gopher-address ?7 "/v2/vs" "gopher.floodgap.com" 70))
+ (insert "\n"
+ "This page contains your bookmarked sites (also visit with B):\n")
+ (elpher-insert-index-record "Your Bookmarks" 'bookmarks)
(insert "\n"
"** Refer to the ")
(let ((help-string "RET,mouse-1: Open Elpher info manual (if available)"))
(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
(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."