X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-crypto.el;h=e6bf8339e8a19fff161a70d8eaa437e678f5b03d;hp=68a7e9f3735a814ce70b55948c3cf6ade687aea9;hb=dfb1b8eb89e814f4bf6f6e62b700c72aa1b4659a;hpb=5de84d07526d330a46e50d955bdfeed8f629637d diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el index 68a7e9f3..e6bf8339 100644 --- a/emacs/notmuch-crypto.el +++ b/emacs/notmuch-crypto.el @@ -21,9 +21,12 @@ ;;; Code: +(require 'epg) (require 'notmuch-lib) -(defcustom notmuch-crypto-process-mime nil +(declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare)) + +(defcustom notmuch-crypto-process-mime t "Should cryptographic MIME parts be processed? If this variable is non-nil signatures in multipart/signed @@ -39,6 +42,17 @@ providing a prefix when viewing a signed or encrypted message, or by providing a prefix when reloading the message in notmuch-show mode." :type 'boolean + :package-version '(notmuch . "0.25") + :group 'notmuch-crypto) + +(defcustom notmuch-crypto-get-keys-asynchronously t + "Retrieve gpg keys asynchronously." + :type 'boolean + :group 'notmuch-crypto) + +(defcustom notmuch-crypto-gpg-program epg-gpg-program + "The gpg executable." + :type 'string :group 'notmuch-crypto) (defface notmuch-crypto-part-header @@ -89,94 +103,162 @@ mode." :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) - (label "Signature not processed") + (show-button t) (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))) + (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))) + (userid (plist-get sigstatus :userid))) + ;; If userid is present it has full or greater validity. + (if userid + (progn (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))) + (setq label (concat "Good signature by key: " fingerprint)) + (setq face 'notmuch-crypto-signature-good-key)) (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 and redisplay.")))) + (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."))) ((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 - (setq label (concat "Unknown signature status" - (if status (concat ": " status)))))) - (insert-button - (concat "[ " label " ]") - :type 'notmuch-crypto-status-button-type - 'help-echo help-msg - 'face face - 'mouse-face face - 'action button-action - :notmuch-sigstatus sigstatus - :notmuch-from from) - (insert "\n"))) - -(declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state)) + (setq show-button nil))) + (when show-button + (insert-button + (concat "[ " label " ]") + :type 'notmuch-crypto-status-button-type + 'help-echo help-msg + 'face face + 'mouse-face face + 'action button-action + :notmuch-sigstatus sigstatus + :notmuch-from from) + (insert "\n")))) (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 "gpg" nil t t "--list-keys" fingerprint)) + (insert (format "-- Key %s in message %s:\n" + fingerprint id)) + (call-process notmuch-crypto-gpg-program nil t t + "--batch" "--no-tty" "--list-keys" fingerprint)) (recenter -1)))) +(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. + +If the retrieval is successful, the thread where the retrieval +was initiated is still displayed and the cursor has not moved, +redisplay the thread." + (let ((status (process-status process)) + (exit-status (process-exit-status process)) + (keyid (process-get process :gpg-key-id))) + (when (memq status '(exit signal)) + (message "Getting the GPG key %s asynchronously...%s." + keyid + (if (= exit-status 0) + "completed" + "failed")) + ;; If the original buffer is still alive and point didn't move + ;; (i.e. the user didn't move on or away), refresh the buffer to + ;; show the updated signature status. + (let ((show-buffer (process-get process :notmuch-show-buffer)) + (show-point (process-get process :notmuch-show-point))) + (when (and (bufferp show-buffer) + (buffer-live-p show-buffer) + (= show-point + (with-current-buffer show-buffer + (point)))) + (with-current-buffer show-buffer + (notmuch-show-refresh-view))))))) + +(defun notmuch-crypto--set-button-label (button label) + "Set the text displayed in BUTTON to LABEL." + (save-excursion + (let ((inhibit-read-only t)) + ;; This knows rather too much about how we typically format + ;; buttons. + (goto-char (button-start button)) + (forward-char 2) + (delete-region (point) (- (button-end button) 2)) + (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*")) - (window (display-buffer buffer t nil))) - (with-selected-window window - (with-current-buffer buffer - (goto-char (point-max)) - (call-process "gpg" nil t t "--recv-keys" keyid) - (insert "\n") - (call-process "gpg" nil t t "--list-keys" keyid)) - (recenter -1)) - (notmuch-show-refresh-view))) + (buffer (get-buffer-create "*notmuch-crypto-gpg-out*"))) + (if notmuch-crypto-get-keys-asynchronously + (progn + (notmuch-crypto--set-button-label + button (format "Retrieving key %s asynchronously..." keyid)) + (with-current-buffer buffer + (goto-char (point-max)) + (insert (format "--- Retrieving key %s:\n" keyid))) + (let ((p (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))) + (let ((window (display-buffer buffer))) + (with-selected-window window + (with-current-buffer buffer + (goto-char (point-max)) + (insert (format "--- Retrieving key %s:\n" keyid)) + (call-process notmuch-crypto-gpg-program nil t t "--recv-keys" keyid) + (insert "\n") + (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")) ;;