X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=eaabec59d00a4dbcabea3b47e7d07d93575001c2;hp=44369bae321211d9fa7285e5f35a9c16a1d76969;hb=021bacb32d0eb7a797c289097f3d348c0665e0bc;hpb=532a21c9018f60930ff38385f6b07809075f2ab9 diff --git a/elpher.el b/elpher.el index 44369ba..eaabec5 100644 --- a/elpher.el +++ b/elpher.el @@ -4,7 +4,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 2.3.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.3.0" +(defconst elpher-version "2.3.3" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -428,8 +428,10 @@ unless PRESERVE-PARENT is non-nil." (address (elpher-node-address elpher-current-node)) (url-string (if (elpher-address-special-p address) "" - (concat " - " (elpher-address-to-url address) "")))) - (setq header-line-format (list display-string url-string))))) + (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." @@ -642,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) @@ -774,70 +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) - (elpher-address-port address) - :type 'tls))) - (if (not (processp proc)) - (error "Error initiating network connection.") - (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: %S" - response-header)) - (?5 ; Permanent failure - (error "Gemini server reports PERMANENT FAILURE for this request: %S" - response-header)) - (?6 ; Client certificate required - (error "Gemini server requires client certificate (unsupported at this time)")) - (_other - (error "Gemini server responded with unknown response: %S" - response-header)))) + (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)))) @@ -877,13 +893,12 @@ The response is assumed to be in the variable `elpher-gemini-response'." (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" "") @@ -994,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"