emacs: Add support for PGP/MIME verification/decryption
authorJameson Graef Rollins <jrollins@finestructure.net>
Thu, 26 May 2011 01:01:19 +0000 (18:01 -0700)
committerCarl Worth <cworth@cworth.org>
Fri, 27 May 2011 23:22:00 +0000 (16:22 -0700)
A new emacs configuration variable "notmuch-crypto-process-mime"
controls the processing of PGP/MIME signatures and encrypted parts.
When this is set true, notmuch-query will use the notmuch show
--decrypt flag to decrypt encrypted messages and/or calculate the
sigstatus of signed messages.  If sigstatus is available, notmuch-show
will place a specially color-coded header at the begining of the
signed message.

Also included is the ability to switch decryption/verification on/off
on the fly, which is bound to M-RET in notmuch-search-mode.

emacs/Makefile.local
emacs/notmuch-crypto.el [new file with mode: 0644]
emacs/notmuch-lib.el
emacs/notmuch-mua.el
emacs/notmuch-query.el
emacs/notmuch-show.el
emacs/notmuch.el

index 1c09d87aa8f33c2dd453392c2b7a15a346ae29d2..102277778a9902e4f1b978fdc541b3c00b5b4be5 100644 (file)
@@ -12,6 +12,7 @@ emacs_sources := \
        $(dir)/notmuch-address.el \
        $(dir)/notmuch-maildir-fcc.el \
        $(dir)/notmuch-message.el \
+       $(dir)/notmuch-crypto.el \
        $(dir)/coolj.el
 
 emacs_images := \
diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el
new file mode 100644 (file)
index 0000000..944452b
--- /dev/null
@@ -0,0 +1,104 @@
+;; notmuch-crypto.el --- functions for handling display of cryptographic metadata.
+;;
+;; Copyright © Jameson Rollins
+;;
+;; This file is part of Notmuch.
+;;
+;; Notmuch is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Notmuch is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; Authors: Jameson Rollins <jrollins@finestructure.net>
+
+(defcustom notmuch-crypto-process-mime nil
+  "Should cryptographic MIME parts be processed?
+
+If this variable is non-nil signatures in multipart/signed
+messages will be verified and multipart/encrypted parts will be
+decrypted.  The result of the crypto operation will be displayed
+in a specially colored header button at the top of the processed
+part.  Signed parts will have variously colored headers depending
+on the success or failure of the verification process and on the
+validity of user ID of the signer.
+
+The effect of setting this variable can be seen temporarily by
+viewing a signed or encrypted message with M-RET in notmuch
+search."
+  :group 'notmuch
+  :type 'boolean)
+
+(define-button-type 'notmuch-crypto-status-button-type
+  'action '(lambda (button) (message (button-get button 'help-echo)))
+  'follow-link t
+  'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts."
+  'face '(:foreground "blue")
+  'mouse-face '(:foreground "blue"))
+
+(defun notmuch-crypto-insert-sigstatus-button (sigstatus from)
+  (let* ((status (plist-get sigstatus :status))
+        (help-msg nil)
+        (label "multipart/signed: signature not processed")
+        (face '(:background "red" :foreground "black")))
+    (cond
+     ((string= status "good")
+      ; 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 '(:background "green" :foreground "black")))
+       (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))))
+         (setq label (concat "Good signature by key: " fingerprint))
+         (setq face '(:background "orange" :foreground "black")))))
+     ((string= status "error")
+      (let ((keyid (concat "0x" (plist-get sigstatus :keyid))))
+       (setq label (concat "Unknown key ID " keyid " or unsupported algorithm"))
+       (setq face '(:background "red" :foreground "black"))))
+     ((string= status "bad")
+      (let ((keyid (concat "0x" (plist-get sigstatus :keyid))))
+       (setq label (concat "Bad signature (claimed key ID " keyid ")"))
+       (setq face '(:background "red" :foreground "black"))))
+     (t
+      (setq label "Unknown signature status")
+      (if status (setq label (concat label " \"" status "\"")))))
+    (insert-button
+     (concat "[ " label " ]")
+     :type 'notmuch-crypto-status-button-type
+     'help-echo help-msg
+     'face face
+     'mouse-face face
+     :notmuch-sigstatus sigstatus
+     :notmuch-from from)
+    (insert "\n")))
+
+(defun notmuch-crypto-insert-encstatus-button (encstatus)
+  (let* ((status (plist-get encstatus :status))
+        (help-msg nil)
+        (label "multipart/encrypted: decryption not attempted")
+        (face '(:background "purple" :foreground "black")))
+    (cond
+     ((string= status "good")
+      (setq label "decryption successful"))
+     ((string= status "bad")
+      (setq label "decryption error"))
+     (t
+      (setq label (concat "unknown encstatus \"" status "\""))))
+    (insert-button
+     (concat "[ multipart/encrypted: " label " ]")
+     :type 'notmuch-crypto-status-button-type
+     'help-echo help-msg
+     'face face
+     'mouse-face face)
+    (insert "\n")))
+
+;;
+
+(provide 'notmuch-crypto)
index d5ca0f404ff5de3d529c946c0e05e0927186a7f4..a21dc14558ffa0d982960a80e61cbcaeabc55b13 100644 (file)
@@ -165,5 +165,10 @@ was called."
    "Return non-nil if OBJECT is a mouse click event."
    (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))))
 
+;; This variable is used only buffer local, but it needs to be
+;; declared globally first to avoid compiler warnings.
+(defvar notmuch-show-process-crypto nil)
+(make-variable-buffer-local 'notmuch-show-process-crypto)
+
 (provide 'notmuch-lib)
 
index 61a723b761efed3052d1f4cdd07b67efd29bae49..7c05a81f2f9acb855fe1eff2bfd175eb3347507a 100644 (file)
@@ -70,12 +70,17 @@ list."
        notmuch-mua-hidden-headers))
 
 (defun notmuch-mua-reply (query-string &optional sender)
-  (let (headers body)
+  (let (headers
+       body
+       (args '("reply")))
+    (if notmuch-show-process-crypto
+       (setq args (append args '("--decrypt"))))
+    (setq args (append args (list query-string)))
     ;; This make assumptions about the output of `notmuch reply', but
     ;; really only that the headers come first followed by a blank
     ;; line and then the body.
     (with-temp-buffer
-      (call-process notmuch-command nil t nil "reply" query-string)
+      (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))
       (goto-char (point-min))
       (if (re-search-forward "^$" nil t)
          (save-excursion
index 921f62461760d51a3085cacfeda42f984e13dd48..d66baeab983b06a6be96abd7ae4bd75c945718a9 100644 (file)
 (require 'notmuch-lib)
 (require 'json)
 
-(defun notmuch-query-get-threads (search-terms &rest options)
+(defun notmuch-query-get-threads (search-terms)
   "Return a list of threads of messages matching SEARCH-TERMS.
 
 A thread is a forest or list of trees. A tree is a two element
 list where the first element is a message, and the second element
 is a possibly empty forest of replies.
 "
-  (let  ((args (append '("show" "--format=json") search-terms))
+  (let  ((args '("show" "--format=json"))
         (json-object-type 'plist)
         (json-array-type 'list)
         (json-false 'nil))
+    (if notmuch-show-process-crypto
+       (setq args (append args '("--decrypt"))))
+    (setq args (append args search-terms))
     (with-temp-buffer
       (progn
        (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
index 2ba151edfc81059ad8a69f79ab6e61d860052dab..2f6be597b410eb61cf34764f31b82509d0d204d8 100644 (file)
@@ -32,6 +32,7 @@
 (require 'notmuch-query)
 (require 'notmuch-wash)
 (require 'notmuch-mua)
+(require 'notmuch-crypto)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
 (declare-function notmuch-fontify-headers "notmuch" nil)
@@ -295,18 +296,20 @@ message at DEPTH in the current thread."
 ;; Functions handling particular MIME parts.
 
 (defun notmuch-show-save-part (message-id nth &optional filename)
-  (with-temp-buffer
-    ;; Always acquires the part via `notmuch part', even if it is
-    ;; available in the JSON output.
-    (insert (notmuch-show-get-bodypart-internal message-id nth))
-    (let ((file (read-file-name
-                "Filename to save as: "
-                (or mailcap-download-directory "~/")
-                nil nil
-                filename))
-         (require-final-newline nil)
-          (coding-system-for-write 'no-conversion))
-      (write-region (point-min) (point-max) file))))
+  (let ((process-crypto notmuch-show-process-crypto))
+    (with-temp-buffer
+      (setq notmuch-show-process-crypto process-crypto)
+      ;; Always acquires the part via `notmuch part', even if it is
+      ;; available in the JSON output.
+      (insert (notmuch-show-get-bodypart-internal message-id nth))
+      (let ((file (read-file-name
+                  "Filename to save as: "
+                  (or mailcap-download-directory "~/")
+                  nil nil
+                  filename))
+           (require-final-newline nil)
+           (coding-system-for-write 'no-conversion))
+       (write-region (point-min) (point-max) file)))))
 
 (defun notmuch-show-mm-display-part-inline (msg part content-type content)
   "Use the mm-decode/mm-view functions to display a part in the
@@ -551,13 +554,20 @@ current buffer, if possible."
 
 ;; Helper for parts which are generally not included in the default
 ;; JSON output.
-
+;; Uses the buffer-local variable notmuch-show-process-crypto to
+;; determine if parts should be decrypted first.
 (defun notmuch-show-get-bodypart-internal (message-id part-number)
-  (with-temp-buffer
-    (let ((coding-system-for-read 'no-conversion))
-      (call-process notmuch-command nil t nil
-                   "show" "--format=raw" (format "--part=%s" part-number) message-id)
-      (buffer-string))))
+  (let ((args '("show" "--format=raw"))
+       (part-arg (format "--part=%s" part-number)))
+    (setq args (append args (list part-arg)))
+    (if notmuch-show-process-crypto
+       (setq args (append args '("--decrypt"))))
+    (setq args (append args (list message-id)))
+    (with-temp-buffer
+      (let ((coding-system-for-read 'no-conversion))
+       (progn
+         (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
+         (buffer-string))))))
 
 (defun notmuch-show-get-bodypart-content (msg part nth)
   (or (plist-get part :content)
@@ -578,6 +588,16 @@ current buffer, if possible."
   "Insert the body part PART at depth DEPTH in the current thread."
   (let ((content-type (downcase (plist-get part :content-type)))
        (nth (plist-get part :id)))
+    ;; add encryption status button if encstatus specified
+    (if (plist-member part :encstatus)
+       (let* ((encstatus (car (plist-get part :encstatus))))
+         (notmuch-crypto-insert-encstatus-button encstatus)))
+    ;; add signature status button if sigstatus specified
+    (if (plist-member part :sigstatus)
+       (let* ((headers (plist-get msg :headers))
+              (from (plist-get headers :From))
+              (sigstatus (car (plist-get part :sigstatus))))
+         (notmuch-crypto-insert-sigstatus-button sigstatus from)))
     (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
   ;; Some of the body part handlers leave point somewhere up in the
   ;; part, so we make sure that we're down at the end.
@@ -711,9 +731,10 @@ current buffer, if possible."
   (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
 (defvar notmuch-show-parent-buffer nil)
+(make-variable-buffer-local 'notmuch-show-parent-buffer)
 
 ;;;###autoload
-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
+(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
   "Run \"notmuch show\" with the given thread ID and display results.
 
 The optional PARENT-BUFFER is the notmuch-search buffer from
@@ -733,10 +754,14 @@ function is used. "
   (let ((buffer (get-buffer-create (generate-new-buffer-name
                                    (or buffer-name
                                        (concat "*notmuch-" thread-id "*")))))
+       (process-crypto (if crypto-switch
+                           (not notmuch-crypto-process-mime)
+                         notmuch-crypto-process-mime))
        (inhibit-read-only t))
     (switch-to-buffer buffer)
     (notmuch-show-mode)
-    (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)
+    (setq notmuch-show-parent-buffer parent-buffer)
+    (setq notmuch-show-process-crypto process-crypto)
     (erase-buffer)
     (goto-char (point-min))
     (save-excursion
index c22add7aa97f4a001100bc289c9fbfca6e13e4cb..3311fe8b2c9b8b980a93425dacfb8f65a5f9fc90 100644 (file)
@@ -218,6 +218,7 @@ For a mouse binding, return nil."
     (define-key map "-" 'notmuch-search-remove-tag)
     (define-key map "+" 'notmuch-search-add-tag)
     (define-key map (kbd "RET") 'notmuch-search-show-thread)
+    (define-key map (kbd "M-RET") 'notmuch-search-show-thread-crypto-switch)
     map)
   "Keymap for \"notmuch search\" buffers.")
 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
@@ -417,7 +418,11 @@ Complete list of currently available key bindings:
   "Return a list of authors for the current region"
   (notmuch-search-properties-in-region 'notmuch-search-subject beg end))
 
-(defun notmuch-search-show-thread ()
+(defun notmuch-search-show-thread-crypto-switch ()
+  (interactive)
+  (notmuch-search-show-thread t))
+
+(defun notmuch-search-show-thread (&optional crypto-switch)
   "Display the currently selected thread."
   (interactive)
   (let ((thread-id (notmuch-search-find-thread-id))
@@ -433,7 +438,8 @@ Complete list of currently available key bindings:
                         (concat "*"
                                 (truncate-string-to-width subject 32 nil nil t)
                                 "*")
-                        32 nil nil t)))
+                        32 nil nil t))
+                     crypto-switch)
       (error "End of search results"))))
 
 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)