X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=blobdiff_plain;f=elpher.el;h=8e2e48ec78d4860f8b605799081eeb13ae4ff6fc;hp=a4a1295809ebfebcd5f6c9dc3b3da33f939e0f90;hb=2e5c279c70ca6c6fbe510fc3b8332b3fc43eb60f;hpb=64431f3bb48b382240115a629923150770060574 diff --git a/elpher.el b/elpher.el index a4a1295..8e2e48e 100644 --- a/elpher.el +++ b/elpher.el @@ -4,7 +4,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 -;; Version: 1.2.4 +;; Version: 1.4.3 ;; Keywords: comm gopher ;; Homepage: https://github.com/tgvaughan/elpher ;; Package-Requires: ((emacs "25")) @@ -26,26 +26,26 @@ ;;; Commentary: -;; Elpher aims to provide a practical gopher client for GNU Emacs. -;; It supports: +;; Elpher aims to provide a practical and friendly gopher client +;; for GNU Emacs. It supports: -;; - intuitive keyboard and mouse-driven interface, +;; - an intuitive keyboard and mouse-driven interface, +;; - followable web and gopher links in plain text, ;; - caching of visited sites (both content and cursor position), ;; - pleasant and configurable colouring of Gopher directories, ;; - direct visualisation of image files, ;; - (m)enu key support, similar to Emacs' info browser, -;; - clickable web and gopher links in plain text, -;; - a simple bookmark management system. - -;; Visited pages are stored as a hierarchy rather than a linear history, -;; meaning that navigation between these pages is quick and easy. +;; - a simple bookmark management system, +;; - support for TLS. ;; To launch Elpher, simply use 'M-x elpher'. This will open a start ;; page containing information on key bindings and suggested starting ;; points for your gopher exploration. -;; Faces, caching and other options can be configured via -;; the Elpher customization group in Applications. +;; Further instructions can be found in the Elpher info manual. + +;; Elpher is under active development, and any suggestions for +;; improvements are welcome! ;;; Code: @@ -57,7 +57,7 @@ ;;; Global constants ;; -(defconst elpher-version "1.2.4" +(defconst elpher-version "1.4.3" "Current version of elpher.") (defconst elpher-margin-width 6 @@ -87,7 +87,8 @@ "i - B: visit the bookmarks page\tfake\tfake\t1" "i - r: redraw current page (using cached contents if available)\tfake\tfake\t1" "i - R: reload current page (regenerates cache)\tfake\tfake\t1" - "i - d: download directory entry under cursor\tfake\tfake\t1" + "i - T: toggle TLS mode\tfake\tfake\t1" + "i - d/D: download item under cursor or current page\tfake\tfake\t1" "i - w: display the raw server response for the current page\tfake\tfake\t1" "i - S: set an explicit character coding system (default is to autodetect)\tfake\tfake\t1" "i\tfake\tfake\t1" @@ -193,16 +194,28 @@ Otherwise, use the system browser via the BROWSE-URL function." "If non-nil, display current node information in buffer header." :type '(boolean)) +(defcustom elpher-auto-disengage-TLS nil + "If non-nil, automatically disengage TLS following an unsuccessful connection. +While enabling this may seem convenient, it is also potentially dangerous as it +allows switching from an encrypted channel back to plain text without user input." + :type '(boolean)) + + ;;; Model ;; ;; Address -(defun elpher-make-address (type &optional selector host port) +(defun elpher-make-address (type &optional selector host port use-tls) "Create an address of a gopher object with TYPE, SELECTOR, HOST and PORT. Although selector host and port are optional, they are only omitted for -special address types, such as 'start for the start page." - (list type selector host port)) +special address types, such as 'start for the start page. + +Setting the USE-TLS parameter to non-nil causes Elpher to engage TLS mode +before attempting to connect to the server." + (if use-tls + (list type selector host port 'tls) + (list type selector host port))) (defun elpher-address-type (address) "Retrieve type from ADDRESS." @@ -220,6 +233,10 @@ special address types, such as 'start for the start page." "Retrieve port from ADDRESS." (elt address 3)) +(defun elpher-address-use-tls-p (address) + "Return non-nil if ADDRESS is marked as needing TLS." + (elt address 4)) + (defun elpher-address-special-p (address) "Return non-nil if ADDRESS is special (e.g. start page, bookmarks page)." (not (elpher-address-host address))) @@ -378,8 +395,9 @@ away CRs and any terminating period." (host (elt fields 2)) (port (if (elt fields 3) (string-to-number (elt fields 3)) - nil))) - (elpher-insert-index-record display-string type selector host port)))))) + nil)) + (address (elpher-make-address type selector host port))) + (elpher-insert-index-record display-string address)))))) (defun elpher-insert-margin (&optional type-name) "Insert index margin, optionally containing the TYPE-NAME, into the current buffer." @@ -405,12 +423,11 @@ away CRs and any terminating period." (elpher-address-port address))))) -(defun elpher-insert-index-record (display-string type selector host port) +(defun elpher-insert-index-record (display-string address) "Function to insert an index record into the current buffer. -The contents of the record are dictated by TYPE, DISPLAY-STRING, SELECTOR, HOST -and PORT." - (let ((address (elpher-make-address type selector host port)) - (type-map-entry (alist-get type elpher-type-map))) +The contents of the record are dictated by DISPLAY-STRING and ADDRESS." + (let* ((type (elpher-address-type address)) + (type-map-entry (alist-get type elpher-type-map))) (if type-map-entry (let* ((margin-code (elt type-map-entry 1)) (face (elt type-map-entry 2)) @@ -450,31 +467,59 @@ and PORT." (let ((p (get-process "elpher-process"))) (if p (delete-process p)))) +(defvar elpher-use-tls nil + "If non-nil, use TLS to communicate with gopher servers.") + (defvar elpher-selector-string) -(defun elpher-get-selector (address after) +(defun elpher-get-selector (address after &optional propagate-error) "Retrieve selector specified by ADDRESS, then execute AFTER. -The result is stored as a string in the variable ‘elpher-selector-string’." +The result is stored as a string in the variable ‘elpher-selector-string’. + +Usually errors result in an error page being displayed. This is only +appropriate if the selector is to be directly viewed. If PROPAGATE-ERROR +is non-nil, this message is not displayed. Instead, the error propagates +up to the calling function." (setq elpher-selector-string "") - (condition-case nil - (progn - (make-network-process :name "elpher-process" - :host (elpher-address-host address) - :service (elpher-address-port address) - :coding 'no-conversion - :filter-multibyte nil - :filter (lambda (proc string) - (setq elpher-selector-string - (concat elpher-selector-string string))) - :sentinel after) - (process-send-string "elpher-process" + (when (elpher-address-use-tls-p address) + (if (gnutls-available-p) + (when (not elpher-use-tls) + (setq elpher-use-tls t) + (message "Engaging TLS mode.")) + (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 (if elpher-use-tls 'tls 'plain)))) + (set-process-coding-system proc 'binary) + (set-process-filter proc + (lambda (proc string) + (setq elpher-selector-string + (concat elpher-selector-string string)))) + (set-process-sentinel proc after) + (process-send-string proc (concat (elpher-address-selector address) "\n"))) (error - (elpher-with-clean-buffer - (insert (propertize "\n---- ERROR -----\n\n" 'face 'error) - "Failed to connect to " (elpher-get-address-url address) ".\n" - (propertize "\n----------------\n\n" 'face 'error) - "Press 'u' to return to the previous page."))))) + (if (and (consp the-error) + (eq (car the-error) 'gnutls-error) + (not (elpher-address-use-tls-p address)) + (or elpher-auto-disengage-TLS + (yes-or-no-p "Could not establish encrypted connection. Disable TLS mode? "))) + (progn + (message "Disengaging TLS mode.") + (setq elpher-use-tls nil) + (elpher-get-selector address after)) + (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-get-address-url address) ".\n" + (propertize "\n----------------\n\n" 'face 'error) + "Press 'u' to return to the previous page."))))))) ;; Index retrieval @@ -512,7 +557,8 @@ If STRING is non-nil, this is given as an argument to all `match-string' calls, as is necessary if the match is performed by `string-match'." (let ((url (match-string 0 string)) (protocol (downcase (match-string 1 string)))) - (if (string= protocol "gopher") + (if (or (string= protocol "gopher") + (string= protocol "gophers")) (let* ((host (match-string 2 string)) (port (if (> (length (match-string 3 string)) 1) (string-to-number (substring (match-string 3 string) 1)) @@ -524,7 +570,8 @@ calls, as is necessary if the match is performed by `string-match'." (selector (if (> (length type-and-selector) 1) (substring type-and-selector 2) "")) - (address (elpher-make-address type selector host port))) + (use-tls (string= protocol "gophers")) + (address (elpher-make-address type selector host port use-tls))) (elpher-make-node url address)) (let* ((host (match-string 2 string)) (port (if (> (length (match-string 3 string)) 1) @@ -676,13 +723,17 @@ calls, as is necessary if the match is performed by `string-match'." "gopher.file")))) (message "Downloading...") (setq elpher-download-filename filename) - (elpher-get-selector address - (lambda (proc event) - (let ((coding-system-for-write 'binary)) - (with-temp-file elpher-download-filename - (insert elpher-selector-string) - (message (format "Download complate, saved to file %s." - elpher-download-filename))))))))) + (condition-case the-error + (elpher-get-selector address + (lambda (proc event) + (let ((coding-system-for-write 'binary)) + (with-temp-file elpher-download-filename + (insert elpher-selector-string) + (message (format "Download complate, saved to file %s." + elpher-download-filename))))) + t) + (error + (error "Error downloading %s" elpher-download-filename)))))) ;; URL retrieval @@ -752,11 +803,7 @@ calls, as is necessary if the match is performed by `string-match'." (dolist (bookmark bookmarks) (let ((display-string (elpher-bookmark-display-string bookmark)) (address (elpher-bookmark-address bookmark))) - (elpher-insert-index-record display-string - (elpher-address-type address) - (elpher-address-selector address) - (elpher-address-host address) - (elpher-address-port address)))) + (elpher-insert-index-record display-string address))) (insert "No bookmarks found.\n"))) (insert "\n-----------------------\n\n" "- u: return to previous page\n" @@ -861,20 +908,31 @@ host, selector and port." (switch-to-buffer "*elpher*") (elpher-visit-node node))) -(defun elpher-redraw () +(defun elpher-redraw () "Redraw current page." (interactive) (if elpher-current-node (elpher-visit-node elpher-current-node) (message "No current site."))) -(defun elpher-reload () +(defun elpher-reload () "Reload current page." (interactive) (if elpher-current-node (elpher-reload-current-node) (message "No current site."))) +(defun elpher-toggle-tls () + "Toggle TLS encryption mode." + (interactive) + (setq elpher-use-tls (not elpher-use-tls)) + (if elpher-use-tls + (if (gnutls-available-p) + (message "TLS mode enabled. (Will not affect current page until reload.)") + (setq elpher-use-tls nil) + (error "Cannot enable TLS mode: GnuTLS not available")) + (message "TLS mode disabled. (Will not affect current page until reload.)"))) + (defun elpher-view-raw () "View raw server response for current page." (interactive) @@ -904,6 +962,18 @@ host, selector and port." #'elpher-get-node-download))) (error "No link selected")))) +(defun elpher-download-current () + "Download the current page." + (interactive) + (if (elpher-address-special-p (elpher-node-address elpher-current-node)) + (error "Cannot download this page") + (elpher-visit-node (elpher-make-node + (elpher-node-display-string elpher-current-node) + (elpher-node-address elpher-current-node) + elpher-current-node) + #'elpher-get-node-download + t))) + (defun elpher-build-link-map () "Build alist mapping link names to destination nodes in current buffer." (let ((link-map nil) @@ -1003,7 +1073,7 @@ host, selector and port." (error "No link selected")))) (defun elpher-bookmarks () - "Visit bookmarks." + "Visit bookmarks page." (interactive) (switch-to-buffer "*elpher*") (elpher-visit-node @@ -1042,7 +1112,9 @@ host, selector and port." (if (and (equal type ?h) (string-prefix-p "URL:" selector)) (elt (split-string selector "URL:") 1) - (concat "gopher://" + (concat "gopher" + (if (elpher-address-use-tls-p address) "s" "") + "://" host (if (equal port 70) "" @@ -1093,8 +1165,10 @@ host, selector and port." (define-key map (kbd "g") 'elpher-go) (define-key map (kbd "r") 'elpher-redraw) (define-key map (kbd "R") 'elpher-reload) + (define-key map (kbd "T") 'elpher-toggle-tls) (define-key map (kbd "w") 'elpher-view-raw) (define-key map (kbd "d") 'elpher-download) + (define-key map (kbd "D") 'elpher-download-current) (define-key map (kbd "m") 'elpher-jump) (define-key map (kbd "i") 'elpher-info-link) (define-key map (kbd "I") 'elpher-info-current) @@ -1116,8 +1190,10 @@ host, selector and port." (kbd "g") 'elpher-go (kbd "r") 'elpher-redraw (kbd "R") 'elpher-reload + (kbd "T") 'elpher-toggle-tls (kbd "w") 'elpher-view-raw (kbd "d") 'elpher-download + (kbd "D") 'elpher-download-current (kbd "m") 'elpher-jump (kbd "i") 'elpher-info-link (kbd "I") 'elpher-info-current @@ -1133,7 +1209,11 @@ host, selector and port." "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 +`elpher', `elpher-go' and `elpher-bookmarks'.") (when (fboundp 'evil-set-initial-state) (evil-set-initial-state 'elpher-mode 'motion))