;; Author: Tim Vaughan <tgvaughan@gmail.com>
;; 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"))
(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."
(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)
;;
(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’.
(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)
(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)))))
(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)))
+ (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-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
+ (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
(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 ()
The Lambda Lab / projects / elpher.git / commitdiff