X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-crypto.el;h=4216f58327a9fb0bef08670fa88f0b6e4723874a;hp=0ab85f4bde8da9d962392e963a901508fff63efa;hb=HEAD;hpb=a1d6e406f6f352c3d68a717b3f30a4f4011a945b diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el index 0ab85f4b..a1cf3ddd 100644 --- a/emacs/notmuch-crypto.el +++ b/emacs/notmuch-crypto.el @@ -1,4 +1,4 @@ -;;; notmuch-crypto.el --- functions for handling display of cryptographic metadata. +;;; notmuch-crypto.el --- functions for handling display of cryptographic metadata -*- lexical-binding: t -*- ;; ;; Copyright © Jameson Rollins ;; @@ -24,8 +24,12 @@ (require 'epg) (require 'notmuch-lib) +(declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare)) + +;;; Options + (defcustom notmuch-crypto-process-mime t - "Should cryptographic MIME parts be processed? + "Whether to process cryptographic MIME parts. If this variable is non-nil signatures in multipart/signed messages will be verified and multipart/encrypted parts will be @@ -44,10 +48,17 @@ mode." :group 'notmuch-crypto) (defcustom notmuch-crypto-get-keys-asynchronously t - "Retrieve gpg keys asynchronously." + "Whether to retrieve openpgp keys asynchronously." :type 'boolean :group 'notmuch-crypto) +(defcustom notmuch-crypto-gpg-program epg-gpg-program + "The gpg executable." + :type 'string + :group 'notmuch-crypto) + +;;; Faces + (defface notmuch-crypto-part-header '((((class color) (background dark)) @@ -89,41 +100,43 @@ mode." :group 'notmuch-crypto :group 'notmuch-faces) +;;; Functions + (define-button-type 'notmuch-crypto-status-button-type - 'action (lambda (button) (message (button-get button 'help-echo))) + 'action (lambda (button) (message "%s" (button-get button 'help-echo))) 'follow-link t 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts." :supertype 'notmuch-button-type) (defun notmuch-crypto-insert-sigstatus-button (sigstatus from) + "Insert a button describing the signature status SIGSTATUS sent by user FROM." (let* ((status (plist-get sigstatus :status)) - (help-msg nil) (show-button t) - (label nil) (face 'notmuch-crypto-signature-unknown) - (button-action (lambda (button) (message (button-get button 'help-echo))))) + (button-action (lambda (button) (message (button-get button 'help-echo)))) + (keyid (concat "0x" (plist-get sigstatus :keyid))) + label help-msg) (cond ((string= status "good") - (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint)))) - ;; if userid present, userid has full or greater validity - (if (plist-member sigstatus :userid) - (let ((userid (plist-get sigstatus :userid))) - (setq label (concat "Good signature by: " userid)) - (setq face 'notmuch-crypto-signature-good)) - (progn - (setq label (concat "Good signature by key: " fingerprint)) - (setq face 'notmuch-crypto-signature-good-key))) + (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))) + (email-or-userid (or (plist-get sigstatus :email) + (plist-get sigstatus :userid)))) + ;; If email or userid are present, they have full or greater validity. + (setq label (concat "Good signature by key: " fingerprint)) + (setq face 'notmuch-crypto-signature-good-key) + (when email-or-userid + (setq label (concat "Good signature by: " email-or-userid)) + (setq face 'notmuch-crypto-signature-good)) (setq button-action 'notmuch-crypto-sigstatus-good-callback) (setq help-msg (concat "Click to list key ID 0x" fingerprint ".")))) ((string= status "error") - (let ((keyid (concat "0x" (plist-get sigstatus :keyid)))) - (setq label (concat "Unknown key ID " keyid " or unsupported algorithm")) - (setq button-action 'notmuch-crypto-sigstatus-error-callback) - (setq help-msg (concat "Click to retrieve key ID " keyid " from keyserver.")))) + (setq label (concat "Unknown key ID " keyid " or unsupported algorithm")) + (setq button-action 'notmuch-crypto-sigstatus-error-callback) + (setq help-msg (concat "Click to retrieve key ID " keyid + " from key server."))) ((string= status "bad") - (let ((keyid (concat "0x" (plist-get sigstatus :keyid)))) - (setq label (concat "Bad signature (claimed key ID " keyid ")")) - (setq face 'notmuch-crypto-signature-bad))) + (setq label (concat "Bad signature (claimed key ID " keyid ")")) + (setq face 'notmuch-crypto-signature-bad)) (status (setq label (concat "Unknown signature status: " status))) (t @@ -140,20 +153,25 @@ mode." :notmuch-from from) (insert "\n")))) -(declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state)) - (defun notmuch-crypto-sigstatus-good-callback (button) - (let* ((sigstatus (button-get button :notmuch-sigstatus)) + (let* ((id (notmuch-show-get-message-id)) + (sigstatus (button-get button :notmuch-sigstatus)) (fingerprint (concat "0x" (plist-get sigstatus :fingerprint))) (buffer (get-buffer-create "*notmuch-crypto-gpg-out*")) - (window (display-buffer buffer t nil))) + (window (display-buffer buffer))) (with-selected-window window (with-current-buffer buffer (goto-char (point-max)) - (call-process epg-gpg-program nil t t "--batch" "--no-tty" "--list-keys" fingerprint)) + (insert (format "-- Key %s in message %s:\n" + fingerprint id)) + (notmuch--call-process notmuch-crypto-gpg-program nil t t + "--batch" "--no-tty" "--list-keys" fingerprint)) (recenter -1)))) -(defun notmuch-crypto--async-key-sentinel (process event) +(declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state)) +(declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare)) + +(defun notmuch-crypto--async-key-sentinel (process _event) "When the user asks for a GPG key to be retrieved asynchronously, handle completion of that task. @@ -194,6 +212,8 @@ redisplay the thread." (insert label)))) (defun notmuch-crypto-sigstatus-error-callback (button) + "When signature validation has failed, try to retrieve the +corresponding key when the status button is pressed." (let* ((sigstatus (button-get button :notmuch-sigstatus)) (keyid (concat "0x" (plist-get sigstatus :keyid))) (buffer (get-buffer-create "*notmuch-crypto-gpg-out*"))) @@ -201,52 +221,51 @@ redisplay the thread." (progn (notmuch-crypto--set-button-label button (format "Retrieving key %s asynchronously..." keyid)) - (let ((p (make-process :name "notmuch GPG key retrieval" - :buffer buffer - :command (list epg-gpg-program "--recv-keys" keyid) - :connection-type 'pipe - :sentinel #'notmuch-crypto--async-key-sentinel - ;; Create the process stopped so that - ;; we have time to store the key id, - ;; etc. on it. - :stop t))) + (with-current-buffer buffer + (goto-char (point-max)) + (insert (format "--- Retrieving key %s:\n" keyid))) + (let ((p (notmuch--make-process + :name "notmuch GPG key retrieval" + :connection-type 'pipe + :buffer buffer + :stderr buffer + :command (list notmuch-crypto-gpg-program "--recv-keys" keyid) + :sentinel #'notmuch-crypto--async-key-sentinel))) (process-put p :gpg-key-id keyid) (process-put p :notmuch-show-buffer (current-buffer)) (process-put p :notmuch-show-point (point)) - (message "Getting the GPG key %s asynchronously..." keyid) - (continue-process p))) - (let ((window (display-buffer buffer t nil))) + (message "Getting the GPG key %s asynchronously..." keyid))) + (let ((window (display-buffer buffer))) (with-selected-window window (with-current-buffer buffer (goto-char (point-max)) - (call-process epg-gpg-program nil t t "--recv-keys" keyid) + (insert (format "--- Retrieving key %s:\n" keyid)) + (notmuch--call-process notmuch-crypto-gpg-program nil t t "--recv-keys" keyid) (insert "\n") - (call-process epg-gpg-program nil t t "--list-keys" keyid)) + (notmuch--call-process notmuch-crypto-gpg-program nil t t "--list-keys" keyid)) (recenter -1)) (notmuch-show-refresh-view))))) (defun notmuch-crypto-insert-encstatus-button (encstatus) - (let* ((status (plist-get encstatus :status)) - (help-msg nil) - (label "Decryption not attempted") - (face 'notmuch-crypto-decryption)) - (cond - ((string= status "good") - (setq label "Decryption successful")) - ((string= status "bad") - (setq label "Decryption error")) - (t - (setq label (concat "Unknown encryption status" - (if status (concat ": " status)))))) - (insert-button - (concat "[ " label " ]") - :type 'notmuch-crypto-status-button-type - 'help-echo help-msg - 'face face - 'mouse-face face) - (insert "\n"))) + "Insert a button describing the encryption status ENCSTATUS." + (insert-button + (concat "[ " + (let ((status (plist-get encstatus :status))) + (cond + ((string= status "good") + "Decryption successful") + ((string= status "bad") + "Decryption error") + (t + (concat "Unknown encryption status" + (and status (concat ": " status)))))) + " ]") + :type 'notmuch-crypto-status-button-type + 'face 'notmuch-crypto-decryption + 'mouse-face 'notmuch-crypto-decryption) + (insert "\n")) -;; +;;; _ (provide 'notmuch-crypto)