From: plugd Date: Thu, 4 May 2023 11:23:00 +0000 (+0200) Subject: Prespecify client certs for certain URLs. X-Git-Tag: v3.5.0~1 X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=elpher.git;a=commitdiff_plain;h=82b66a5b91eb3a67a6e23b3d5fa0a518054cb6f8 Prespecify client certs for certain URLs. --- diff --git a/elpher.el b/elpher.el index 2ba5e8e..5f215db 100644 --- a/elpher.el +++ b/elpher.el @@ -6,7 +6,7 @@ ;; Author: Tim Vaughan ;; Created: 11 April 2019 ;; Version: 3.4.3 -;; Keywords: comm gopher +;; Keywords: comm gopher gemini ;; Homepage: https://thelambdalab.xyz/elpher ;; Package-Requires: ((emacs "27.1")) @@ -241,6 +241,13 @@ meaningfully." "Label of button used to toggle formatted text." :type '(string)) +(defcustom elpher-client-certificate-map nil + "An alist representing a mapping between gemini URLs and the names +of client certificates which will be automatically activated for those +URLs. Beware that the certificates will also be active for all +subdirectories of the given URLs." + :type '(alist :key-type string :value-type string)) + ;; Face customizations (defgroup elpher-faces nil @@ -951,7 +958,8 @@ the host operating system and the local network capabilities.)" ;;; Client-side TLS Certificate Management ;; -(defun elpher-generate-certificate (common-name key-file cert-file &optional temporary) +(defun elpher-generate-certificate (common-name key-file cert-file url-prefix + &optional temporary) "Generate a key and a self-signed client TLS certificate using openssl. The Common Name field of the certificate is set to COMMON-NAME. The @@ -979,22 +987,21 @@ by `gnutls-boot-parameters`." "-subj" (concat "/CN=" common-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)) + (list url-prefix temporary exp-key-file exp-cert-file)) (error (message "Check that openssl is installed, or customize `elpher-openssl-command`.") (error "Program 'openssl', required for certificate generation, not found"))))) -(defun elpher-generate-throwaway-certificate () +(defun elpher-generate-throwaway-certificate (url-prefix) "Generate and return details of a throwaway certificate. The key and certificate files will be deleted when they are no longer needed for this session." (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))) + (elpher-generate-certificate file-base key-file cert-file url-prefix t))) -(defun elpher-generate-persistent-certificate (file-base common-name) +(defun elpher-generate-persistent-certificate (file-base common-name url-prefix) "Generate and return details of a persistent certificate. The argument FILE-BASE is used as the base for the key and certificate files, while COMMON-NAME specifies the common name field of the @@ -1003,20 +1010,20 @@ certificate. The key and certificate files are written to in `elpher-certificate-directory'." (let* ((key-file (concat elpher-certificate-directory file-base ".key")) (cert-file (concat elpher-certificate-directory file-base ".crt"))) - (elpher-generate-certificate common-name key-file cert-file))) + (elpher-generate-certificate common-name key-file cert-file url-prefix))) -(defun elpher-get-existing-certificate (file-base) +(defun elpher-get-existing-certificate (file-base url-prefix) "Return a certificate object corresponding to an existing certificate. It is assumed that the key files FILE-BASE.key and FILE-BASE.crt exist in the directory `elpher-certificate-directory'." (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)) + (list (elpher-address-to-url (elpher-page-address elpher-current-page)) nil (expand-file-name key-file) (expand-file-name cert-file)))) -(defun elpher-install-and-use-existing-certificate (key-file-src cert-file-src file-base) +(defun elpher-install-certificate (key-file-src cert-file-src file-base) "Install a key+certificate file pair in `elpher-certificate-directory'. The strings KEY-FILE-SRC and CERT-FILE-SRC are the existing key and certificate files to install. The argument FILE-BASE is used as the @@ -1026,9 +1033,12 @@ base for the installed key and certificate files." (if (or (file-exists-p key-file) (file-exists-p cert-file)) (error "A certificate with base name %s is already installed" file-base)) + (unless (and (file-exists-p key-file-src) + (file-exists-p cert-file-src)) + (error "Either of the key or certificate files do not exist")) (copy-file key-file-src key-file) (copy-file cert-file-src cert-file) - (list (elpher-address-host (elpher-page-address elpher-current-page)) + (list (elpher-address-to-url (elpher-page-address elpher-current-page)) nil (expand-file-name key-file) (expand-file-name cert-file)))) @@ -1068,8 +1078,8 @@ that certificate matches the host in ADDRESS. If `elpher-current-certificate' is non-nil, and its host name doesn't match that of ADDRESS, the certificate is forgotten." (if elpher-client-certificate - (if (string= (car elpher-client-certificate) - (elpher-address-host address)) + (if (string-prefix-p (car elpher-client-certificate) + (elpher-address-to-url address)) (list (cddr elpher-client-certificate)) (elpher-forget-current-certificate) (message "Disabling client certificate for new host") @@ -1392,7 +1402,9 @@ that the response was malformed." (auto-fill-mode 1) (elpher-gemini-insert-text response-meta)) (let ((chosen-certificate - (with-local-quit (elpher-choose-client-certificate)))) + (with-local-quit + (elpher-acquire-client-certificate + (elpher-address-to-url (elpher-page-address elpher-current-page)))))) (unless chosen-certificate (error "Gemini server requires a client certificate and none was provided")) (setq elpher-client-certificate chosen-certificate)) @@ -1402,17 +1414,35 @@ that the response was malformed." (error "Gemini server response unknown: %s %s" response-code response-meta)))))) +(defun elpher-acquire-client-certificate (url-prefix) + "Select a pre-defined client certificate or prompt for one. +In this case, \"pre-defined\" means a certificate provided by +the `elpher-client-certificate-map' variable." + (let ((entry (assoc url-prefix + elpher-client-certificate-map + #'string-prefix-p))) + (if entry + (let ((cert-url-prefix (car entry)) + (cert-name (cadr entry))) + (message "Using certificate \"%s\" specified in elpher-client-certificate-map" + cert-name) + (elpher-get-existing-certificate cert-name cert-url-prefix)) + (elpher-prompt-for-client-certificate url-prefix)))) + (defun elpher--read-answer-polyfill (question answers) "Polyfill for `read-answer' in Emacs 26.1. QUESTION is a string containing a question, and ANSWERS -is a list of possible answers." - (completing-read question (mapcar 'identity answers))) +is a list of possible answers, or an alist whose keys +are the possible answers." + (completing-read question answers)) (if (fboundp 'read-answer) (defalias 'elpher-read-answer 'read-answer) (defalias 'elpher-read-answer 'elpher--read-answer-polyfill)) -(defun elpher-choose-client-certificate () + + +(defun elpher-prompt-for-client-certificate (url-prefix) "Prompt for a client certificate to use to establish a TLS connection." (let* ((read-answer-short t)) (pcase (read-answer "What do you want to do? " @@ -1433,7 +1463,7 @@ is a list of possible answers." nil (if (member file-base existing-certificates) (setq elpher-client-certificate - (elpher-get-existing-certificate file-base)) + (elpher-get-existing-certificate file-base url-prefix)) (pcase (read-answer "Generate new certificate or install externally-generated one? " '(("new" ?n "generate new certificate") @@ -1446,15 +1476,16 @@ is a list of possible answers." file-base))) (message "New key and self-signed certificate written to %s" elpher-certificate-directory) - (elpher-generate-persistent-certificate file-base common-name))) + (elpher-generate-persistent-certificate file-base + common-name + url-prefix))) ("install" (let* ((cert-file (read-file-name "Certificate file: " nil nil t)) (key-file (read-file-name "Key file: " nil nil t))) (message "Key and certificate installed in %s for future use" elpher-certificate-directory) - (elpher-install-and-use-existing-certificate key-file - cert-file - file-base))) + (elpher-install-certificate key-file cert-file file-base + url-prefix))) ("abort" nil)))))) ("abort" nil))))