Added basic client cert functionality.
[elpher.git] / elpher.el
index 6827d0e..89e594b 100644 (file)
--- a/elpher.el
+++ b/elpher.el
@@ -1,13 +1,13 @@
 ;;; elpher.el --- A friendly gopher and gemini client  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2019 Tim Vaughan
+;; Copyright (C) 2019-2020 Tim Vaughan
 
 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
 ;; Created: 11 April 2019
-;; Version: 2.7.11
+;; Version: 2.8.0
 ;; Keywords: comm gopher
 ;; Homepage: http://thelambdalab.xyz/elpher
-;; Package-Requires: ((emacs "26"))
+;; Package-Requires: ((emacs "26.1"))
 
 ;; This file is not part of GNU Emacs.
 
@@ -71,7 +71,7 @@
 ;;; Global constants
 ;;
 
-(defconst elpher-version "2.7.11"
+(defconst elpher-version "2.8.0"
   "Current version of elpher.")
 
 (defconst elpher-margin-width 6
@@ -134,6 +134,12 @@ The default behaviour is to use the ansi-color package to interpret these
 sequences."
   :type '(boolean))
 
+(defcustom elpher-certificate-directory
+  (file-name-as-directory (locate-user-emacs-file "elpher-certificates"))
+  "Specify the name of the directory where client certificates will be stored.
+These certificates may be used for establishing authenticated TLS connections."
+  :type '(directory))
+
 (defcustom elpher-gemini-TLS-cert-checks nil
   "If non-nil, verify gemini server TLS certs using the default security level.
 Otherwise, certificate verification is disabled.
@@ -508,7 +514,7 @@ If LINE is non-nil, replace that line instead."
     (let ((inhibit-read-only t))
       (goto-char (point-min))
       (if line
-          (goto-line line))
+          (forward-line line))
       (let ((data (match-data)))
         (unwind-protect
             (progn
@@ -551,10 +557,42 @@ ERROR can be either an error object or a string."
            (propertize "\n----------------\n\n" 'face 'error)
            "Press 'u' to return to the previous page.")))
 
+
 ;;; General network communication
+;;
+
+(defvar elpher-network-timer nil
+  "Timer used for network connections.")
+
+(defvar elpher-use-tls nil
+  "If non-nil, use TLS to communicate with gopher servers.")
+
+(defvar elpher-client-certificate nil
+  "If non-nil, contains client certificate details to use for TLS connections.")
+
+(defun elpher-process-cleanup ()
+  "Immediately shut down any extant elpher process and timers."
+  (let ((p (get-process "elpher-process")))
+    (if p (delete-process p)))
+  (if (timerp elpher-network-timer)
+      (cancel-timer elpher-network-timer)))
 
 (defun elpher-get-host-response (address default-port query-string response-processor
                                          &optional use-tls force-ipv4)
+  "Generic function for retrieving data from ADDRESS.
+
+When ADDRESS lacks a specific port, DEFAULT-PORT is used instead.
+QUERY-STRING is a string sent to the host specified by ADDRESS to
+illicet a response.  This response is passed as an argument to the
+function RESPONSE-PROCESSOR.
+
+If non-nil, USE-TLS specifies that the connection is to be made over
+TLS.  If set to gemini, the certificate verification will be disabled
+unless `elpher-gemini-TLS-cert-checks' is non-nil.
+
+If non-nil, FORCE-IPV4 causes the network connection to be made over
+ipv4 only.  (The default behaviour when this is not set depends on
+the host operating system and the local network capabilities."
   (if (and use-tls (not (gnutls-available-p)))
       (error "Use of TLS requires Emacs to be compiled with GNU TLS support")
     (unless (< (elpher-address-port address) 65536)
@@ -581,7 +619,9 @@ ERROR can be either an error object or a string."
                                                 (cons 'gnutls-x509pki
                                                       (gnutls-boot-parameters
                                                        :type 'gnutls-x509pki
-                                                       :hostname host)))))
+                                                       :hostname host
+                                                       :keylist
+                                                       (elpher-get-current-keylist address))))))
                (timer (run-at-time elpher-connection-timeout nil
                                    (lambda ()
                                      (elpher-process-cleanup)
@@ -597,7 +637,7 @@ ERROR can be either an error object or a string."
                                             (not (eq use-tls 'gemini))
                                             (or elpher-auto-disengage-TLS
                                                 (y-or-n-p
-                                                 "TLS connetion failed. Disable TLS mode and retry? ")))
+                                                 "TLS connetion failed.  Disable TLS mode and retry? ")))
                                        (setq elpher-use-tls nil)
                                        (elpher-get-host-response address default-port
                                                                  query-string
@@ -616,11 +656,11 @@ ERROR can be either an error object or a string."
                                 (let ((new-hkbytes-received (/ bytes-received 102400)))
                                   (when (> new-hkbytes-received hkbytes-received)
                                     (setq hkbytes-received new-hkbytes-received)
-                                    (elpher-buffer-message 
+                                    (elpher-buffer-message
                                         (concat "("
                                                 (number-to-string (/ hkbytes-received 10.0))
                                                 " MB read)")
-                                        2)))
+                                        1)))
                                 (setq response-string-parts
                                       (cons string response-string-parts))))
           (set-process-sentinel proc
@@ -631,7 +671,7 @@ ERROR can be either an error object or a string."
                                       (cond
                                        ((string-prefix-p "open" event)    ; request URL
                                         (elpher-buffer-message
-                                         (concat "Connected to " host ". Receiving data...\n"))
+                                         (concat "Connected to " host ". Receiving data..."))
                                         (let ((inhibit-eol-conversion t))
                                           (process-send-string proc query-string)))
                                        ((string-prefix-p "deleted" event)) ; do nothing
@@ -650,31 +690,70 @@ ERROR can be either an error object or a string."
                                                  (apply #'concat (reverse response-string-parts)))
                                         (elpher-restore-pos))
                                        (t
-                                        (error "No response from server.")))
+                                        (error "No response from server")))
                                     (error
                                      (elpher-network-error address the-error))))))
       (error
        (error "Error initiating connection to server")))))
 
+(defun elpher-generate-certificate (name key-file cert-file &optional temporary)
+  (let ((exp-key-file (expand-file-name key-file))
+        (exp-cert-file (expand-file-name cert-file)))
+    (call-process "openssl" nil nil nil
+                  "req" "-x509" "-newkey" "rsa:2048"
+                  "-days" (if temporary "1" "36500")
+                  "-nodes"
+                  "-subj" (concat "/CN=" name)
+                  "-keyout" exp-key-file
+                  "-out" exp-cert-file)
+    (list (elpher-address-host (elpher-page-address elpher-current-page))
+          temporary exp-key-file exp-cert-file)))
+
+(defun elpher-generate-throwaway-certificate ()
+  (let* ((file-base (make-temp-name "elpher"))
+         (key-file (concat temporary-file-directory file-base ".key"))
+         (cert-file (concat temporary-file-directory file-base ".crt")))
+    (elpher-generate-certificate file-base key-file cert-file t)))
+
+(defun elpher-generate-permanent-certificate (file-base)
+  (let* ((key-file (concat elpher-certificate-directory file-base ".key"))
+         (cert-file (concat elpher-certificate-directory file-base ".crt")))
+    (elpher-generate-certificate file-base key-file cert-file)))
+
+(defun elpher-get-existing-certificate (file-base)
+  (let* ((key-file (concat elpher-certificate-directory file-base ".key"))
+         (cert-file (concat elpher-certificate-directory file-base ".crt")))
+    (list (elpher-address-host (elpher-page-address elpher-current-page))
+          nil
+          (expand-file-name key-file)
+          (expand-file-name cert-file))))
+
+(defun elpher-list-existing-certificates ()
+  (mapcar
+   (lambda (file)
+     (file-name-sans-extension file))
+   (directory-files elpher-certificate-directory nil "\.key$")))
+    
+
+(defun elpher-get-current-keylist (address)
+  (if elpher-client-certificate
+      (if (string= (car elpher-client-certificate)
+                   (elpher-address-host address))
+          (list (cddr elpher-client-certificate))
+        (when (cadr elpher-client-certificate)
+          (delete-file (elt elpher-client-certificate 2))
+          (delete-file (elt elpher-client-certificate 3)))
+        (setq elpher-client-certificate nil)
+        (message "Disabling client certificate for new host")
+        nil)
+    nil))
 
 
 ;;; Gopher selector retrieval
 ;;
 
-(defvar elpher-network-timer nil
-  "Timer used for network connections.")
-
-(defun elpher-process-cleanup ()
-  "Immediately shut down any extant elpher process and timers."
-  (let ((p (get-process "elpher-process")))
-    (if p (delete-process p)))
-  (if (timerp elpher-network-timer)
-      (cancel-timer elpher-network-timer)))
-
-(defvar elpher-use-tls nil
-  "If non-nil, use TLS to communicate with gopher servers.")
-
 (defun elpher-get-gopher-response (address renderer)
+  "Get response string from gopher server at ADDRESS and render using RENDERER."
   (elpher-get-host-response address 70
                             (concat (elpher-gopher-address-selector address) "\r\n")
                             renderer
@@ -930,6 +1009,7 @@ The response is rendered using the rendering function RENDERER."
 (defvar elpher-gemini-redirect-chain)
 
 (defun elpher-get-gemini-response (address renderer)
+  "Get response string from gemini server at ADDRESS and render using RENDERER."
   (elpher-get-host-response address 1965
                             (concat (elpher-address-to-url address) "\r\n")
                             (lambda (response-string)
@@ -990,7 +1070,38 @@ that the response was malformed."
          (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)"))
+         (elpher-with-clean-buffer
+          (if elpher-client-certificate
+              (insert "Gemini server does not recognise the provided TLS certificate:\n\n")
+            (insert "Gemini server is requesting a valid TLS certificate:\n\n"))
+          (auto-fill-mode 1)
+          (elpher-gemini-insert-text response-meta))
+         (let* ((read-answer-short t)
+                (res (read-answer "What do you want to do? "
+                                  '(("throwaway" ?t "generate and use throw-away certificate")
+                                    ("permanent" ?p "generate and use permanent certificate")
+                                    ("existing" ?e "use existing certificate")
+                                    ("abort" ?a "stop immediately")))))
+           (pcase res
+             ("throwaway"
+              (setq elpher-client-certificate (elpher-generate-throwaway-certificate)))
+             ("permanent"
+              (let ((file-base (read-string "Name for certificate: ")))
+                (setq elpher-client-certificate
+                      (elpher-generate-permanent-certificate file-base))))
+             ("existing"
+              (let ((file-base (completing-read "Name of existing certificate (autocompletes, empty response aborts): "
+                                                (elpher-list-existing-certificates)
+                                                nil t)))
+                (if (string-empty-p file-base)
+                    (error "Gemini server requires a client certificate and none was provided")
+                  (setq elpher-client-certificate
+                        (elpher-get-existing-certificate file-base)))))
+              ;; TODO
+             ("abort"
+              (error "Gemini server requires a client certificate and none was provided")))
+           (elpher-with-clean-buffer)
+           (elpher-get-gemini-response (elpher-page-address elpher-current-page) renderer)))
         (_other
          (error "Gemini server response unknown: %s %s"
                 response-code response-meta))))))
@@ -1186,12 +1297,9 @@ width defined by elpher-gemini-max-fill-width."
 
 ;; Finger page connection
 
-(defun elpher-get-finger-page (renderer &optional force-ipv4)
+(defun elpher-get-finger-page (renderer)
   "Opens a finger connection to the current page address.
-The result is rendered using RENDERER.  When the optional argument
-FORCE-IPV4 or the variable `elpher-ipv4-always' are non-nil, the
-IPv4 address returned by a DNS lookup will be used explicitly in
-making the connection."
+The result is rendered using RENDERER."
   (let* ((address (elpher-page-address elpher-current-page))
          (content (elpher-get-cached-content address)))
     (if (and content (funcall renderer nil))