;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; Created: 11 April 2019
-;; Version: 2.1.1
+;; Version: 2.3.4
;; Keywords: comm gopher
;; Homepage: https://github.com/tgvaughan/elpher
;; Package-Requires: ((emacs "26"))
;;; Global constants
;;
-(defconst elpher-version "2.1.1"
+(defconst elpher-version "2.3.4"
"Current version of elpher.")
(defconst elpher-margin-width 6
"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)."
(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."
(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.")))
;; 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)
(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")))))
+ (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)
+ (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))))
(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" "")
(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)))
(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)
" - 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"
(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."