X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=eaabec59d00a4dbcabea3b47e7d07d93575001c2;hp=8fbc60e7a5ccd89731e1b61968303602337c5966;hb=021bacb32d0eb7a797c289097f3d348c0665e0bc;hpb=1025f7696c36af639ec2a2be4a19473fe4115a28 diff --git a/elpher.el b/elpher.el index 8fbc60e..eaabec5 100644 --- a/elpher.el +++ b/elpher.el @@ -4,7 +4,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 2.0.0 +;; Version: 2.3.3 ;; Keywords: comm gopher ;; Homepage: https://github.com/tgvaughan/elpher ;; Package-Requires: ((emacs "26")) @@ -65,7 +65,7 @@ ;;; Global constants ;; -(defconst elpher-version "2.0.0" +(defconst elpher-version "2.3.3" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -77,7 +77,7 @@ ((gopher ?4) elpher-get-gopher-node elpher-render-download "bin" elpher-binary) ((gopher ?5) elpher-get-gopher-node elpher-render-download "bin" elpher-binary) ((gopher ?7) elpher-get-gopher-query-node elpher-render-index "?" elpher-search) - ((gopher ?9) elpher-get-gopher-node elpher-render-node-download "bin" elpher-binary) + ((gopher ?9) elpher-get-gopher-node elpher-render-download "bin" elpher-binary) ((gopher ?g) elpher-get-gopher-node elpher-render-image "img" elpher-image) ((gopher ?p) elpher-get-gopher-node elpher-render-image "img" elpher-image) ((gopher ?I) elpher-get-gopher-node elpher-render-image "img" elpher-image) @@ -161,7 +161,7 @@ Otherwise, use the system browser via the BROWSE-URL function." :type '(boolean)) -(defcustom elpher-buttonify-urls-in-directories nil +(defcustom elpher-buttonify-urls-in-directories t "If non-nil, turns URLs matched in directories into clickable buttons." :type '(boolean)) @@ -191,13 +191,14 @@ allows switching from an encrypted channel back to plain text without user input (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)) @@ -205,6 +206,10 @@ allows switching from an encrypted channel back to plain text without user input (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)))) @@ -213,15 +218,22 @@ allows switching from an encrypted channel back to plain text without user input The basic attributes include: TYPE, SELECTOR, HOST and PORT. If the optional attribute TLS is non-nil, the address will be marked as requiring gopher-over-TLS." - (if (and (equal type ?h) - (string-prefix-p "URL:" selector)) - (elpher-address-from-url (elt (split-string selector "URL:") 1)) + (cond + ((and (equal type ?h) + (string-prefix-p "URL:" selector)) + (elpher-address-from-url (elt (split-string selector "URL:") 1))) + ((equal type ?8) + (elpher-address-from-url + (concat "telnet" + "://" host + ":" (number-to-string port)))) + (t (elpher-address-from-url (concat "gopher" (if tls "s" "") "://" host ":" (number-to-string port) "/" (string type) - selector)))) + selector))))) (defun elpher-make-special-address (type) "Create an ADDRESS object corresponding to the given special page symbol TYPE." @@ -234,7 +246,9 @@ requiring gopher-over-TLS." nil)) (defun elpher-address-type (address) - "Retrieve selector type from ADDRESS object." + "Retrieve type of ADDRESS object. +This is used to determine how to retrieve and render the document the +address refers to, via the table `elpher-type-map'." (if (symbolp address) (list 'special address) (let ((protocol (url-type address))) @@ -246,6 +260,8 @@ requiring gopher-over-TLS." (string-to-char (substring (url-filename address) 1))))) ((equal protocol "gemini") 'gemini) + ((equal protocol "telnet") + 'telnet) (t 'other-url))))) (defun elpher-address-protocol (address) @@ -267,7 +283,15 @@ For gopher addresses this is a combination of the selector type and selector." (defun elpher-address-port (address) "Retrieve port from ADDRESS object." - (url-port address)) + (if (symbolp address) + nil) + (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)." @@ -400,7 +424,14 @@ unless PRESERVE-PARENT is non-nil." (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." @@ -479,9 +510,7 @@ up to the calling function." (proc (open-network-stream "elpher-process" nil (elpher-address-host address) - (if (> (elpher-address-port address) 0) - (elpher-address-port address) - 70) + (elpher-address-port address) :type (if elpher-use-tls 'tls 'plain)))) (set-process-coding-system proc 'binary) (set-process-filter proc @@ -587,11 +616,11 @@ If ADDRESS is not supplied or nil the record is rendered as an (pcase type ((or '(gopher ?i) 'nil) ;; Information (elpher-insert-margin) - (insert (propertize - (if elpher-buttonify-urls-in-directories - (elpher-buttonify-urls display-string) - display-string) - 'face 'elpher-info))) + (let ((propertized-display-string + (propertize display-string 'face 'elpher-info))) + (insert (if elpher-buttonify-urls-in-directories + (elpher-buttonify-urls propertized-display-string) + propertized-display-string)))) (`(gopher ,selector-type) ;; Unknown (elpher-insert-margin (concat (char-to-string selector-type) "?")) (insert (propertize display-string @@ -604,7 +633,7 @@ If ADDRESS is not supplied or nil the record is rendered as an (elpher-visit-node node))) (defun elpher-render-index (data &optional _mime-type-string) - "Render DATA as an index." + "Render DATA as an index. MIME-TYPE-STRING is unused." (elpher-with-clean-buffer (if (not data) t @@ -615,7 +644,7 @@ If ADDRESS is not supplied or nil the record is rendered as an ;; 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) @@ -631,11 +660,12 @@ If ADDRESS is not supplied or nil the record is rendered as an 'elpher-node node 'action #'elpher-click-link 'follow-link t - 'help-echo (elpher-node-button-help node)))) + 'help-echo (elpher-node-button-help node) + 'face 'button))) (buffer-string))) (defun elpher-render-text (data &optional _mime-type-string) - "Render DATA as text." + "Render DATA as text. MIME-TYPE-STRING is unused." (elpher-with-clean-buffer (if (not data) t @@ -647,7 +677,7 @@ If ADDRESS is not supplied or nil the record is rendered as an ;; Image retrieval (defun elpher-render-image (data &optional _mime-type-string) - "Display DATA as image." + "Display DATA as image. MIME-TYPE-STRING is unused." (if (not data) nil (if (display-images-p) @@ -696,7 +726,7 @@ The response is rendered using the rendering function RENDERER." ;; Raw server response rendering (defun elpher-render-raw (data &optional _mime-type-string) - "Display raw DATA in buffer." + "Display raw DATA in buffer. MIME-TYPE-STRING is unused." (if (not data) nil (elpher-with-clean-buffer @@ -707,7 +737,7 @@ The response is rendered using the rendering function RENDERER." ;; File save "rendering" (defun elpher-render-download (data &optional _mime-type-string) - "Save DATA to file." + "Save DATA to file. MIME-TYPE-STRING is unused." (if (not data) nil (let* ((address (elpher-node-address elpher-current-node)) @@ -727,7 +757,7 @@ The response is rendered using the rendering function RENDERER." ;; HTML rendering (defun elpher-render-html (data &optional _mime-type-string) - "Render DATA as HTML using shr." + "Render DATA as HTML using shr. MIME-TYPE-STRING is unused." (elpher-with-clean-buffer (if (not data) t @@ -746,69 +776,84 @@ The response is stored in the variable ‘elpher-gemini-response’." (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) + (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) - 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"))))) + :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)))) @@ -841,20 +886,19 @@ The response is assumed to be in the variable `elpher-gemini-response'." (string-empty-p mime-type-string)) "text/gemini; charset=utf-8" mime-type-string)) - (mime-type-split (split-string mime-type-string* ";")) + (mime-type-split (split-string mime-type-string* ";" t)) (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 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" "") @@ -883,7 +927,7 @@ The response is assumed to be in the variable `elpher-gemini-response'." (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) @@ -911,7 +955,7 @@ The response is assumed to be in the variable `elpher-gemini-response'." (buffer-string)))) (defun elpher-render-gemini-plain-text (data _parameters) - "Render DATA as plain text file." + "Render DATA as plain text file. PARAMETERS is currently unused." (elpher-with-clean-buffer (insert (elpher-buttonify-urls data)) (elpher-cache-content @@ -965,7 +1009,7 @@ The response is assumed to be in the variable `elpher-gemini-response'." " - 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" @@ -1368,6 +1412,7 @@ If ADDRESS is already bookmarked, update the label only." (define-key map (kbd "TAB") 'elpher-next-link) (define-key map (kbd "") 'elpher-prev-link) (define-key map (kbd "u") 'elpher-back) + (define-key map [mouse-3] 'elpher-back) (define-key map (kbd "O") 'elpher-root-dir) (define-key map (kbd "g") 'elpher-go) (define-key map (kbd "o") 'elpher-go-current) @@ -1394,6 +1439,7 @@ If ADDRESS is already bookmarked, update the label only." (kbd "C-") 'elpher-follow-current-link (kbd "C-t") 'elpher-back (kbd "u") 'elpher-back + [mouse-3] 'elpher-back (kbd "g") 'elpher-go (kbd "o") 'elpher-go-current (kbd "r") 'elpher-redraw @@ -1417,7 +1463,7 @@ If ADDRESS is already bookmarked, update the label only." "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