notmuch-crypto.el (9965B)
1 ;;; notmuch-crypto.el --- functions for handling display of cryptographic metadata -*- lexical-binding: t -*- 2 ;; 3 ;; Copyright © Jameson Rollins 4 ;; 5 ;; This file is part of Notmuch. 6 ;; 7 ;; Notmuch is free software: you can redistribute it and/or modify it 8 ;; under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 ;; 12 ;; Notmuch is distributed in the hope that it will be useful, but 13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; General Public License for more details. 16 ;; 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>. 19 ;; 20 ;; Authors: Jameson Rollins <jrollins@finestructure.net> 21 22 ;;; Code: 23 24 (require 'epg) 25 (require 'notmuch-lib) 26 27 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare)) 28 29 ;;; Options 30 31 (defcustom notmuch-crypto-process-mime t 32 "Whether to process cryptographic MIME parts. 33 34 If this variable is non-nil signatures in multipart/signed 35 messages will be verified and multipart/encrypted parts will be 36 decrypted. The result of the crypto operation will be displayed 37 in a specially colored header button at the top of the processed 38 part. Signed parts will have variously colored headers depending 39 on the success or failure of the verification process and on the 40 validity of user ID of the signer. 41 42 The effect of setting this variable can be seen temporarily by 43 providing a prefix when viewing a signed or encrypted message, or 44 by providing a prefix when reloading the message in notmuch-show 45 mode." 46 :type 'boolean 47 :package-version '(notmuch . "0.25") 48 :group 'notmuch-crypto) 49 50 (defcustom notmuch-crypto-get-keys-asynchronously t 51 "Whether to retrieve openpgp keys asynchronously." 52 :type 'boolean 53 :group 'notmuch-crypto) 54 55 (defcustom notmuch-crypto-gpg-program epg-gpg-program 56 "The gpg executable." 57 :type 'string 58 :group 'notmuch-crypto) 59 60 ;;; Faces 61 62 (defface notmuch-crypto-part-header 63 '((((class color) 64 (background dark)) 65 (:foreground "LightBlue1")) 66 (((class color) 67 (background light)) 68 (:foreground "blue"))) 69 "Face used for crypto parts headers." 70 :group 'notmuch-crypto 71 :group 'notmuch-faces) 72 73 (defface notmuch-crypto-signature-good 74 '((t (:background "green" :foreground "black"))) 75 "Face used for good signatures." 76 :group 'notmuch-crypto 77 :group 'notmuch-faces) 78 79 (defface notmuch-crypto-signature-good-key 80 '((t (:background "orange" :foreground "black"))) 81 "Face used for good signatures." 82 :group 'notmuch-crypto 83 :group 'notmuch-faces) 84 85 (defface notmuch-crypto-signature-bad 86 '((t (:background "red" :foreground "black"))) 87 "Face used for bad signatures." 88 :group 'notmuch-crypto 89 :group 'notmuch-faces) 90 91 (defface notmuch-crypto-signature-unknown 92 '((t (:background "red" :foreground "black"))) 93 "Face used for signatures of unknown status." 94 :group 'notmuch-crypto 95 :group 'notmuch-faces) 96 97 (defface notmuch-crypto-decryption 98 '((t (:background "purple" :foreground "black"))) 99 "Face used for encryption/decryption status messages." 100 :group 'notmuch-crypto 101 :group 'notmuch-faces) 102 103 ;;; Functions 104 105 (define-button-type 'notmuch-crypto-status-button-type 106 'action (lambda (button) (message "%s" (button-get button 'help-echo))) 107 'follow-link t 108 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts." 109 :supertype 'notmuch-button-type) 110 111 (defun notmuch-crypto-insert-sigstatus-button (sigstatus from) 112 "Insert a button describing the signature status SIGSTATUS sent by user FROM." 113 (let* ((status (plist-get sigstatus :status)) 114 (show-button t) 115 (face 'notmuch-crypto-signature-unknown) 116 (button-action (lambda (button) (message (button-get button 'help-echo)))) 117 (keyid (concat "0x" (plist-get sigstatus :keyid))) 118 label help-msg) 119 (cond 120 ((string= status "good") 121 (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))) 122 (email-or-userid (or (plist-get sigstatus :email) 123 (plist-get sigstatus :userid)))) 124 ;; If email or userid are present, they have full or greater validity. 125 (setq label (concat "Good signature by key: " fingerprint)) 126 (setq face 'notmuch-crypto-signature-good-key) 127 (when email-or-userid 128 (setq label (concat "Good signature by: " email-or-userid)) 129 (setq face 'notmuch-crypto-signature-good)) 130 (setq button-action 'notmuch-crypto-sigstatus-good-callback) 131 (setq help-msg (concat "Click to list key ID 0x" fingerprint ".")))) 132 ((string= status "error") 133 (setq label (concat "Unknown key ID " keyid " or unsupported algorithm")) 134 (setq button-action 'notmuch-crypto-sigstatus-error-callback) 135 (setq help-msg (concat "Click to retrieve key ID " keyid 136 " from key server."))) 137 ((string= status "bad") 138 (setq label (concat "Bad signature (claimed key ID " keyid ")")) 139 (setq face 'notmuch-crypto-signature-bad)) 140 (status 141 (setq label (concat "Unknown signature status: " status))) 142 (t 143 (setq show-button nil))) 144 (when show-button 145 (insert-button 146 (concat "[ " label " ]") 147 :type 'notmuch-crypto-status-button-type 148 'help-echo help-msg 149 'face face 150 'mouse-face face 151 'action button-action 152 :notmuch-sigstatus sigstatus 153 :notmuch-from from) 154 (insert "\n")))) 155 156 (defun notmuch-crypto-sigstatus-good-callback (button) 157 (let* ((id (notmuch-show-get-message-id)) 158 (sigstatus (button-get button :notmuch-sigstatus)) 159 (fingerprint (concat "0x" (plist-get sigstatus :fingerprint))) 160 (buffer (get-buffer-create "*notmuch-crypto-gpg-out*")) 161 (window (display-buffer buffer))) 162 (with-selected-window window 163 (with-current-buffer buffer 164 (goto-char (point-max)) 165 (insert (format "-- Key %s in message %s:\n" 166 fingerprint id)) 167 (notmuch--call-process notmuch-crypto-gpg-program nil t t 168 "--batch" "--no-tty" "--list-keys" fingerprint)) 169 (recenter -1)))) 170 171 (declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state)) 172 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare)) 173 174 (defun notmuch-crypto--async-key-sentinel (process _event) 175 "When the user asks for a GPG key to be retrieved 176 asynchronously, handle completion of that task. 177 178 If the retrieval is successful, the thread where the retrieval 179 was initiated is still displayed and the cursor has not moved, 180 redisplay the thread." 181 (let ((status (process-status process)) 182 (exit-status (process-exit-status process)) 183 (keyid (process-get process :gpg-key-id))) 184 (when (memq status '(exit signal)) 185 (message "Getting the GPG key %s asynchronously...%s." 186 keyid 187 (if (= exit-status 0) 188 "completed" 189 "failed")) 190 ;; If the original buffer is still alive and point didn't move 191 ;; (i.e. the user didn't move on or away), refresh the buffer to 192 ;; show the updated signature status. 193 (let ((show-buffer (process-get process :notmuch-show-buffer)) 194 (show-point (process-get process :notmuch-show-point))) 195 (when (and (bufferp show-buffer) 196 (buffer-live-p show-buffer) 197 (= show-point 198 (with-current-buffer show-buffer 199 (point)))) 200 (with-current-buffer show-buffer 201 (notmuch-show-refresh-view))))))) 202 203 (defun notmuch-crypto--set-button-label (button label) 204 "Set the text displayed in BUTTON to LABEL." 205 (save-excursion 206 (let ((inhibit-read-only t)) 207 ;; This knows rather too much about how we typically format 208 ;; buttons. 209 (goto-char (button-start button)) 210 (forward-char 2) 211 (delete-region (point) (- (button-end button) 2)) 212 (insert label)))) 213 214 (defun notmuch-crypto-sigstatus-error-callback (button) 215 "When signature validation has failed, try to retrieve the 216 corresponding key when the status button is pressed." 217 (let* ((sigstatus (button-get button :notmuch-sigstatus)) 218 (keyid (concat "0x" (plist-get sigstatus :keyid))) 219 (buffer (get-buffer-create "*notmuch-crypto-gpg-out*"))) 220 (if notmuch-crypto-get-keys-asynchronously 221 (progn 222 (notmuch-crypto--set-button-label 223 button (format "Retrieving key %s asynchronously..." keyid)) 224 (with-current-buffer buffer 225 (goto-char (point-max)) 226 (insert (format "--- Retrieving key %s:\n" keyid))) 227 (let ((p (notmuch--make-process 228 :name "notmuch GPG key retrieval" 229 :connection-type 'pipe 230 :buffer buffer 231 :stderr buffer 232 :command (list notmuch-crypto-gpg-program "--recv-keys" keyid) 233 :sentinel #'notmuch-crypto--async-key-sentinel))) 234 (process-put p :gpg-key-id keyid) 235 (process-put p :notmuch-show-buffer (current-buffer)) 236 (process-put p :notmuch-show-point (point)) 237 (message "Getting the GPG key %s asynchronously..." keyid))) 238 (let ((window (display-buffer buffer))) 239 (with-selected-window window 240 (with-current-buffer buffer 241 (goto-char (point-max)) 242 (insert (format "--- Retrieving key %s:\n" keyid)) 243 (notmuch--call-process notmuch-crypto-gpg-program nil t t "--recv-keys" keyid) 244 (insert "\n") 245 (notmuch--call-process notmuch-crypto-gpg-program nil t t "--list-keys" keyid)) 246 (recenter -1)) 247 (notmuch-show-refresh-view))))) 248 249 (defun notmuch-crypto-insert-encstatus-button (encstatus) 250 "Insert a button describing the encryption status ENCSTATUS." 251 (insert-button 252 (concat "[ " 253 (let ((status (plist-get encstatus :status))) 254 (cond 255 ((string= status "good") 256 "Decryption successful") 257 ((string= status "bad") 258 "Decryption error") 259 (t 260 (concat "Unknown encryption status" 261 (and status (concat ": " status)))))) 262 " ]") 263 :type 'notmuch-crypto-status-button-type 264 'face 'notmuch-crypto-decryption 265 'mouse-face 'notmuch-crypto-decryption) 266 (insert "\n")) 267 268 ;;; _ 269 270 (provide 'notmuch-crypto) 271 272 ;;; notmuch-crypto.el ends here