X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=elpher.el;h=669ed555fd4349c1aea2b45b3705a251d11bbeb5;hb=7d4366492bd03a03331b94abbbb935349d28467a;hp=4787dee1a14195993ffb822546f6a4b2ffd60f0d;hpb=a0a57bc32eda851b304c4bac3fa31ab64997a82e;p=elpher.git diff --git a/elpher.el b/elpher.el index 4787dee..669ed55 100644 --- a/elpher.el +++ b/elpher.el @@ -4,7 +4,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 1.4.7 +;; Version: 2.0.0 ;; Keywords: comm gopher ;; Homepage: https://github.com/tgvaughan/elpher ;; Package-Requires: ((emacs "26")) @@ -272,7 +272,8 @@ attributes: TYPE, SELECTOR, HOST and PORT." (defun elpher-address-gopher-p (address) "Return non-nill if ADDRESS object is a gopher address." - (memq (elpher-address-protocol address) '("gopher gophers"))) + (and (not (elpher-address-special-p address)) + (member (elpher-address-protocol address) '("gopher gophers")))) (defun elpher-gopher-address-selector (address) "Retrieve gopher selector from ADDRESS object." @@ -464,10 +465,12 @@ away CRs and any terminating period." (let ((address (elpher-node-address node))) (format "mouse-1, RET: open '%s'" (elpher-address-to-url address)))) -(defun elpher-insert-index-record (display-string address) +(defun elpher-insert-index-record (display-string &optional address) "Function to insert an index record into the current buffer. -The contents of the record are dictated by DISPLAY-STRING and ADDRESS." - (let* ((type (elpher-address-type address)) +The contents of the record are dictated by DISPLAY-STRING and ADDRESS. +If ADDRESS is not supplied or nil the record is rendered as an +'information' line." + (let* ((type (if address (elpher-address-type address) nil)) (type-map-entry (cdr (assoc type elpher-type-map)))) (if type-map-entry (let* ((margin-code (elt type-map-entry 1)) @@ -481,7 +484,7 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS." 'follow-link t 'help-echo (elpher-node-button-help node))) (pcase type - ('(gopher ?i) ;; Information + ((or '(gopher ?i) 'nil) ;; Information (elpher-insert-margin) (insert (propertize (if elpher-buttonify-urls-in-directories @@ -500,6 +503,18 @@ The contents of the record are dictated by DISPLAY-STRING and ADDRESS." (elpher-visit-node node))) +;;; Network error reporting +;; + +(defun elpher-network-error (address error) + (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 the-error) ".\n" + (propertize "\n----------------\n\n" 'face 'error) + "Press 'u' to return to the previous page."))) + + ;;; Gopher selector retrieval (all kinds) ;; @@ -767,7 +782,14 @@ up to the calling function." (defvar elpher-gemini-response-header) (defvar elpher-gemini-in-header) -(defun elpher-get-gemini (address after &optional propagate-error) +(defun elpher-gemini-response-code () + (elt (split-string elpher-gemini-response-header) 0)) + +(defun elpher-gemini-response-meta () + (string-trim (substring elpher-gemini-response-header + (string-match "[ \t]+" elpher-gemini-response-header)))) + +(defun elpher-get-gemini (address after) "Retrieve gemini ADDRESS, then execute AFTER. The response header is stored in the variable ‘elpher-gemini-response-header’. If available, the response is stored in the variable ‘elpher-gemini-response’. @@ -780,47 +802,30 @@ up to the calling function." (setq elpher-gemini-response-header "") (setq elpher-gemini-in-header t) (if (not (gnutls-available-p)) - (error "Cannot retrieve TLS 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) - (elpher-address-port address) - :type 'tls))) - (set-process-coding-system proc 'binary) - (set-process-filter proc - (lambda (proc string) - (if elpher-gemini-in-header - (progn - (setq elpher-gemini-response-header - (concat elpher-gemini-response-header - (elt (split-string string "\r\n") 0))) - (let ((idx (string-match "\r\n" string))) - (setq elpher-gemini-response - (substring string (+ idx 2))) - (setq elpher-gemini-in-header nil))) - (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 - (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.")))))) - -(defun elpher-gemini-response-code () - (elt (split-string elpher-gemini-response-header) 0)) - -(defun elpher-gemini-response-meta () - (string-trim (substring elpher-gemini-response-header - (string-match "[ \t]+" elpher-gemini-response-header)))) + (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) + (if elpher-gemini-in-header + (progn + (setq elpher-gemini-response-header + (concat elpher-gemini-response-header + (elt (split-string string "\r\n") 0))) + (let ((idx (string-match "\r\n" string))) + (setq elpher-gemini-response + (substring string (+ idx 2))) + (setq elpher-gemini-in-header nil))) + (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"))))) (defun elpher-render-gemini-response (mime-type-raw) (let* ((mime-type-full (if (string-empty-p mime-type-raw) @@ -831,12 +836,14 @@ up to the calling function." (parameters (if (> (length mime-type-split) 1) (string-trim (elt mime-type-split 1)) ""))) - (message "MIME type %S" mime-type) + ;; (message "MIME type %S with parameters %S" mime-type parameters) (pcase mime-type ((or "text/gemini" "") (elpher-render--mimetype-text/gemini elpher-gemini-response parameters)) - ("text/plain" + ((pred (string-prefix-p "text/")) (elpher-render--mimetype-text/plain elpher-gemini-response parameters)) + ((pred (string-prefix-p "image/")) + (elpher-render--mimetype-image/* elpher-gemini-response parameters)) (other (error "Unsupported MIME type %S" mime-type))))) @@ -847,34 +854,39 @@ up to the calling function." (let* ((rest (string-trim (elt (split-string line "=>") 1))) (idx (string-match "[ \t]" rest))) (if idx - (substring rest (+ idx 1)) + (string-trim (substring rest (+ idx 1))) ""))) +(defun elpher-address-from-gemini-url (url) + (let ((address (url-generic-parse-url url))) + (unless (equal (url-type address) "mailto") + (setf (url-fullness address) t) + (unless (url-host address) + (setf (url-host address) (url-host (elpher-node-address elpher-current-node))) + (unless (string-prefix-p "/" (url-filename address)) + (setf (url-filename address) + (concat (file-name-as-directory + (url-filename (elpher-node-address elpher-current-node))) + (url-filename address))))) + (unless (url-type address) + (setf (url-type address) "gemini")) + (unless (> (url-port address) 0) + (pcase (url-type address) + ("gemini" (setf (url-port address) 1965)) + ("gopher" (setf (url-port address) 70))))) + address)) + (defun elpher-render--mimetype-text/gemini (data parameters) (elpher-with-clean-buffer (dolist (line (split-string (elpher-preprocess-text-response data) "\n")) (if (string-prefix-p "=>" line) (let* ((url (elpher-gemini-get-link-url line)) - (address (url-generic-parse-url url)) - (display-string (elpher-gemini-get-link-display-string line))) - (setf (url-fullness address) t) - (unless (url-host address) - (setf (url-host address) (url-host (elpher-node-address elpher-current-node))) - (unless (string-prefix-p "/" (url-filename address)) - (setf (url-filename address) - (concat (file-name-as-directory - (url-filename (elpher-node-address elpher-current-node))) - (url-filename address))))) - (unless (url-type address) - (setf (url-type address) "gemini")) - (unless (> (url-port address) 0) - (pcase (url-type address) - ("gemini" (setf (url-port address) 1965)) - ("gopher" (setf (url-port address) 70)))) - (if display-string + (display-string (elpher-gemini-get-link-display-string line)) + (address (elpher-address-from-gemini-url url))) + (if (> (length display-string) 0) (elpher-insert-index-record display-string address) (elpher-insert-index-record url address))) - (insert (elpher-buttonify-urls line) "\n"))) + (elpher-insert-index-record line))) (elpher-restore-pos) (elpher-cache-content (elpher-node-address elpher-current-node) @@ -888,29 +900,62 @@ up to the calling function." (elpher-node-address elpher-current-node) (buffer-string)))) +(defun elpher-render--mimetype-image/* (data parameters) + (let ((image (create-image data nil t))) + (elpher-with-clean-buffer + (insert-image image) + (elpher-restore-pos)))) + +(defun elpher-process-gemini-response (proc event) + (condition-case the-error + (unless (string-prefix-p "deleted" event) + (let ((response-code (elpher-gemini-response-code)) + (meta (elpher-gemini-response-meta))) + (pcase (elt response-code 0) + (?1 ; Input required + (elpher-with-clean-buffer + (insert "Gemini server is requesting input.")) + (let* ((query-string (read-string (concat 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 query-address #'elpher-process-gemini-response))) + (?2 ; Normal response + (message elpher-gemini-response-header) + (elpher-render-gemini-response meta)) + (?3 ; Redirect + (message "Following redirect to %s" meta) + (let ((redirect-address (elpher-address-from-gemini-url meta))) + (elpher-get-gemini redirect-address #'elpher-process-gemini-response))) + (?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))))) + (error + (elpher-network-error (elpher-node-address elpher-current-node) the-error)))) + (defun elpher-get-gemini-node () "Getter which retrieves and renders a Gemini node." (let* ((address (elpher-node-address elpher-current-node)) (content (elpher-get-cached-content address))) - (if content - (progn + (condition-case the-error + (if content + (progn + (elpher-with-clean-buffer + (insert content) + (elpher-restore-pos))) (elpher-with-clean-buffer - (insert content) - (elpher-restore-pos))) - (elpher-with-clean-buffer - (insert "LOADING GEMINI... (use 'u' to cancel)")) - (elpher-get-gemini address - (lambda (proc event) - (unless (string-prefix-p "deleted" event) - (let ((response-code (elpher-gemini-response-code)) - (meta (elpher-gemini-response-meta))) - (pcase (elt response-code 0) - (?2 - (elpher-render-gemini-response meta)) - (other - (error "Gemini server responded with response code %S" - response-code)))))))))) + (insert "LOADING GEMINI... (use 'u' to cancel)")) + (elpher-get-gemini address #'elpher-process-gemini-response)) + (error + (elpher-network-error address the-error))))) + + ;; Other URL node opening @@ -1200,17 +1245,18 @@ If ADDRESS is already bookmarked, update the label only." (defun elpher-root-dir () "Visit root of current server." (interactive) - (let* ((address (elpher-node-address elpher-current-node)) - (host (elpher-address-host address))) - (if host - (let ((host (elpher-address-host address)) - (selector (elpher-gopher-address-selector address)) - (port (elpher-address-port address))) - (if (> (length selector) 0) - (let ((root-address (elpher-make-gopher-address ?1 "" host port))) - (elpher-visit-node - (elpher-make-node (elpher-address-to-url root-address)))) - (error "Already at root directory of current server"))) + (let ((address (elpher-node-address elpher-current-node))) + (if (not (elpher-address-special-p address)) + (if (or (member (url-filename address) '("/" "")) + (and (elpher-address-gopher-p address) + (= (length (elpher-gopher-address-selector address)) 0))) + (error "Already at root directory of current server") + (let ((address-copy (elpher-address-from-url + (elpher-address-to-url address)))) + (setf (url-filename address-copy) "") + (elpher-visit-node + (elpher-make-node (elpher-address-to-url address-copy) + address-copy)))) (error "Command invalid for this page")))) (defun elpher-bookmarks-current-p ()