--- /dev/null
+Return-Path: <jrollins@servo.finestructure.net>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 64DFD421173\r
+ for <notmuch@notmuchmail.org>; Wed, 25 May 2011 18:01:51 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.921\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.921 tagged_above=-999 required=5\r
+ tests=[NO_DNS_FOR_FROM=0.379, RCVD_IN_DNSWL_MED=-2.3]\r
+ autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id uABwAM6WlIrA for <notmuch@notmuchmail.org>;\r
+ Wed, 25 May 2011 18:01:46 -0700 (PDT)\r
+Received: from outgoing-mail.its.caltech.edu (outgoing-mail.its.caltech.edu\r
+ [131.215.239.19])\r
+ by olra.theworths.org (Postfix) with ESMTP id 6799E429E32\r
+ for <notmuch@notmuchmail.org>; Wed, 25 May 2011 18:01:37 -0700 (PDT)\r
+Received: from earth-doxen.imss.caltech.edu (localhost [127.0.0.1])\r
+ by earth-doxen-postvirus (Postfix) with ESMTP id F097166E04A3;\r
+ Wed, 25 May 2011 18:01:35 -0700 (PDT)\r
+X-Spam-Scanned: at Caltech-IMSS on earth-doxen by amavisd-new\r
+Received: from servo.finestructure.net (gwave-104.ligo.caltech.edu\r
+ [131.215.114.104]) (Authenticated sender: jrollins)\r
+ by earth-doxen-submit (Postfix) with ESMTP id BC51266E04AE;\r
+ Wed, 25 May 2011 18:01:27 -0700 (PDT)\r
+Received: by servo.finestructure.net (Postfix, from userid 1000)\r
+ id 8610D7CD; Wed, 25 May 2011 18:01:26 -0700 (PDT)\r
+From: Jameson Graef Rollins <jrollins@finestructure.net>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH 10/11] emacs: Add support for PGP/MIME verification/decryption\r
+Date: Wed, 25 May 2011 18:01:19 -0700\r
+Message-Id: <1306371680-19441-11-git-send-email-jrollins@finestructure.net>\r
+X-Mailer: git-send-email 1.7.4.4\r
+In-Reply-To: <1306371680-19441-1-git-send-email-jrollins@finestructure.net>\r
+References: <1306371680-19441-1-git-send-email-jrollins@finestructure.net>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=UTF-8\r
+Content-Transfer-Encoding: 8bit\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Thu, 26 May 2011 01:01:52 -0000\r
+\r
+A new emacs configuration variable "notmuch-crypto-process-mime"\r
+controls the processing of PGP/MIME signatures and encrypted parts.\r
+When this is set true, notmuch-query will use the notmuch show\r
+--decrypt flag to decrypt encrypted messages and/or calculate the\r
+sigstatus of signed messages. If sigstatus is available, notmuch-show\r
+will place a specially color-coded header at the begining of the\r
+signed message.\r
+\r
+Also included is the ability to switch decryption/verification on/off\r
+on the fly, which is bound to M-RET in notmuch-search-mode.\r
+---\r
+ emacs/Makefile.local | 1 +\r
+ emacs/notmuch-crypto.el | 104 +++++++++++++++++++++++++++++++++++++++++++++++\r
+ emacs/notmuch-lib.el | 5 ++\r
+ emacs/notmuch-mua.el | 9 +++-\r
+ emacs/notmuch-query.el | 7 ++-\r
+ emacs/notmuch-show.el | 65 ++++++++++++++++++++---------\r
+ emacs/notmuch.el | 10 ++++-\r
+ 7 files changed, 175 insertions(+), 26 deletions(-)\r
+ create mode 100644 emacs/notmuch-crypto.el\r
+\r
+diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
+index 1c09d87..1022777 100644\r
+--- a/emacs/Makefile.local\r
++++ b/emacs/Makefile.local\r
+@@ -12,6 +12,7 @@ emacs_sources := \\r
+ $(dir)/notmuch-address.el \\r
+ $(dir)/notmuch-maildir-fcc.el \\r
+ $(dir)/notmuch-message.el \\r
++ $(dir)/notmuch-crypto.el \\r
+ $(dir)/coolj.el\r
+ \r
+ emacs_images := \\r
+diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el\r
+new file mode 100644\r
+index 0000000..944452b\r
+--- /dev/null\r
++++ b/emacs/notmuch-crypto.el\r
+@@ -0,0 +1,104 @@\r
++;; notmuch-crypto.el --- functions for handling display of cryptographic metadata.\r
++;;\r
++;; Copyright © Jameson Rollins\r
++;;\r
++;; This file is part of Notmuch.\r
++;;\r
++;; Notmuch is free software: you can redistribute it and/or modify it\r
++;; under the terms of the GNU General Public License as published by\r
++;; the Free Software Foundation, either version 3 of the License, or\r
++;; (at your option) any later version.\r
++;;\r
++;; Notmuch is distributed in the hope that it will be useful, but\r
++;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\r
++;; General Public License for more details.\r
++;;\r
++;; You should have received a copy of the GNU General Public License\r
++;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.\r
++;;\r
++;; Authors: Jameson Rollins <jrollins@finestructure.net>\r
++\r
++(defcustom notmuch-crypto-process-mime nil\r
++ "Should cryptographic MIME parts be processed?\r
++\r
++If this variable is non-nil signatures in multipart/signed\r
++messages will be verified and multipart/encrypted parts will be\r
++decrypted. The result of the crypto operation will be displayed\r
++in a specially colored header button at the top of the processed\r
++part. Signed parts will have variously colored headers depending\r
++on the success or failure of the verification process and on the\r
++validity of user ID of the signer.\r
++\r
++The effect of setting this variable can be seen temporarily by\r
++viewing a signed or encrypted message with M-RET in notmuch\r
++search."\r
++ :group 'notmuch\r
++ :type 'boolean)\r
++\r
++(define-button-type 'notmuch-crypto-status-button-type\r
++ 'action '(lambda (button) (message (button-get button 'help-echo)))\r
++ 'follow-link t\r
++ 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts."\r
++ 'face '(:foreground "blue")\r
++ 'mouse-face '(:foreground "blue"))\r
++\r
++(defun notmuch-crypto-insert-sigstatus-button (sigstatus from)\r
++ (let* ((status (plist-get sigstatus :status))\r
++ (help-msg nil)\r
++ (label "multipart/signed: signature not processed")\r
++ (face '(:background "red" :foreground "black")))\r
++ (cond\r
++ ((string= status "good")\r
++ ; if userid present, userid has full or greater validity\r
++ (if (plist-member sigstatus :userid)\r
++ (let ((userid (plist-get sigstatus :userid)))\r
++ (setq label (concat "Good signature by: " userid))\r
++ (setq face '(:background "green" :foreground "black")))\r
++ (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))))\r
++ (setq label (concat "Good signature by key: " fingerprint))\r
++ (setq face '(:background "orange" :foreground "black")))))\r
++ ((string= status "error")\r
++ (let ((keyid (concat "0x" (plist-get sigstatus :keyid))))\r
++ (setq label (concat "Unknown key ID " keyid " or unsupported algorithm"))\r
++ (setq face '(:background "red" :foreground "black"))))\r
++ ((string= status "bad")\r
++ (let ((keyid (concat "0x" (plist-get sigstatus :keyid))))\r
++ (setq label (concat "Bad signature (claimed key ID " keyid ")"))\r
++ (setq face '(:background "red" :foreground "black"))))\r
++ (t\r
++ (setq label "Unknown signature status")\r
++ (if status (setq label (concat label " \"" status "\"")))))\r
++ (insert-button\r
++ (concat "[ " label " ]")\r
++ :type 'notmuch-crypto-status-button-type\r
++ 'help-echo help-msg\r
++ 'face face\r
++ 'mouse-face face\r
++ :notmuch-sigstatus sigstatus\r
++ :notmuch-from from)\r
++ (insert "\n")))\r
++\r
++(defun notmuch-crypto-insert-encstatus-button (encstatus)\r
++ (let* ((status (plist-get encstatus :status))\r
++ (help-msg nil)\r
++ (label "multipart/encrypted: decryption not attempted")\r
++ (face '(:background "purple" :foreground "black")))\r
++ (cond\r
++ ((string= status "good")\r
++ (setq label "decryption successful"))\r
++ ((string= status "bad")\r
++ (setq label "decryption error"))\r
++ (t\r
++ (setq label (concat "unknown encstatus \"" status "\""))))\r
++ (insert-button\r
++ (concat "[ multipart/encrypted: " label " ]")\r
++ :type 'notmuch-crypto-status-button-type\r
++ 'help-echo help-msg\r
++ 'face face\r
++ 'mouse-face face)\r
++ (insert "\n")))\r
++\r
++;;\r
++\r
++(provide 'notmuch-crypto)\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index cc80fb2..1ced0f1 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -156,5 +156,10 @@ was called."\r
+ "Return non-nil if OBJECT is a mouse click event."\r
+ (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))))\r
+ \r
++;; This variable is used only buffer local, but it needs to be\r
++;; declared globally first to avoid compiler warnings.\r
++(defvar notmuch-show-process-crypto nil)\r
++(make-variable-buffer-local 'notmuch-show-process-crypto)\r
++\r
+ (provide 'notmuch-lib)\r
+ \r
+diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
+index dc7b386..003b313 100644\r
+--- a/emacs/notmuch-mua.el\r
++++ b/emacs/notmuch-mua.el\r
+@@ -70,12 +70,17 @@ list."\r
+ notmuch-mua-hidden-headers))\r
+ \r
+ (defun notmuch-mua-reply (query-string)\r
+- (let (headers body)\r
++ (let (headers\r
++ body\r
++ (args '("reply")))\r
++ (if notmuch-show-process-crypto\r
++ (setq args (append args '("--decrypt"))))\r
++ (setq args (append args (list query-string)))\r
+ ;; This make assumptions about the output of `notmuch reply', but\r
+ ;; really only that the headers come first followed by a blank\r
+ ;; line and then the body.\r
+ (with-temp-buffer\r
+- (call-process notmuch-command nil t nil "reply" query-string)\r
++ (apply 'call-process (append (list notmuch-command nil (list t t) nil) args))\r
+ (goto-char (point-min))\r
+ (if (re-search-forward "^$" nil t)\r
+ (save-excursion\r
+diff --git a/emacs/notmuch-query.el b/emacs/notmuch-query.el\r
+index 921f624..d66baea 100644\r
+--- a/emacs/notmuch-query.el\r
++++ b/emacs/notmuch-query.el\r
+@@ -22,17 +22,20 @@\r
+ (require 'notmuch-lib)\r
+ (require 'json)\r
+ \r
+-(defun notmuch-query-get-threads (search-terms &rest options)\r
++(defun notmuch-query-get-threads (search-terms)\r
+ "Return a list of threads of messages matching SEARCH-TERMS.\r
+ \r
+ A thread is a forest or list of trees. A tree is a two element\r
+ list where the first element is a message, and the second element\r
+ is a possibly empty forest of replies.\r
+ "\r
+- (let ((args (append '("show" "--format=json") search-terms))\r
++ (let ((args '("show" "--format=json"))\r
+ (json-object-type 'plist)\r
+ (json-array-type 'list)\r
+ (json-false 'nil))\r
++ (if notmuch-show-process-crypto\r
++ (setq args (append args '("--decrypt"))))\r
++ (setq args (append args search-terms))\r
+ (with-temp-buffer\r
+ (progn\r
+ (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index 9a38d9c..e0cd41f 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -32,6 +32,7 @@\r
+ (require 'notmuch-query)\r
+ (require 'notmuch-wash)\r
+ (require 'notmuch-mua)\r
++(require 'notmuch-crypto)\r
+ \r
+ (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
+ (declare-function notmuch-fontify-headers "notmuch" nil)\r
+@@ -295,18 +296,20 @@ message at DEPTH in the current thread."\r
+ ;; Functions handling particular MIME parts.\r
+ \r
+ (defun notmuch-show-save-part (message-id nth &optional filename)\r
+- (with-temp-buffer\r
+- ;; Always acquires the part via `notmuch part', even if it is\r
+- ;; available in the JSON output.\r
+- (insert (notmuch-show-get-bodypart-internal message-id nth))\r
+- (let ((file (read-file-name\r
+- "Filename to save as: "\r
+- (or mailcap-download-directory "~/")\r
+- nil nil\r
+- filename))\r
+- (require-final-newline nil)\r
+- (coding-system-for-write 'no-conversion))\r
+- (write-region (point-min) (point-max) file))))\r
++ (let ((process-crypto notmuch-show-process-crypto))\r
++ (with-temp-buffer\r
++ (setq notmuch-show-process-crypto process-crypto)\r
++ ;; Always acquires the part via `notmuch part', even if it is\r
++ ;; available in the JSON output.\r
++ (insert (notmuch-show-get-bodypart-internal message-id nth))\r
++ (let ((file (read-file-name\r
++ "Filename to save as: "\r
++ (or mailcap-download-directory "~/")\r
++ nil nil\r
++ filename))\r
++ (require-final-newline nil)\r
++ (coding-system-for-write 'no-conversion))\r
++ (write-region (point-min) (point-max) file)))))\r
+ \r
+ (defun notmuch-show-mm-display-part-inline (msg part content-type content)\r
+ "Use the mm-decode/mm-view functions to display a part in the\r
+@@ -551,13 +554,20 @@ current buffer, if possible."\r
+ \r
+ ;; Helper for parts which are generally not included in the default\r
+ ;; JSON output.\r
+-\r
++;; Uses the buffer-local variable notmuch-show-process-crypto to\r
++;; determine if parts should be decrypted first.\r
+ (defun notmuch-show-get-bodypart-internal (message-id part-number)\r
+- (with-temp-buffer\r
+- (let ((coding-system-for-read 'no-conversion))\r
+- (call-process notmuch-command nil t nil\r
+- "show" "--format=raw" (format "--part=%s" part-number) message-id)\r
+- (buffer-string))))\r
++ (let ((args '("show" "--format=raw"))\r
++ (part-arg (format "--part=%s" part-number)))\r
++ (setq args (append args (list part-arg)))\r
++ (if notmuch-show-process-crypto\r
++ (setq args (append args '("--decrypt"))))\r
++ (setq args (append args (list message-id)))\r
++ (with-temp-buffer\r
++ (let ((coding-system-for-read 'no-conversion))\r
++ (progn\r
++ (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))\r
++ (buffer-string))))))\r
+ \r
+ (defun notmuch-show-get-bodypart-content (msg part nth)\r
+ (or (plist-get part :content)\r
+@@ -578,6 +588,16 @@ current buffer, if possible."\r
+ "Insert the body part PART at depth DEPTH in the current thread."\r
+ (let ((content-type (downcase (plist-get part :content-type)))\r
+ (nth (plist-get part :id)))\r
++ ;; add encryption status button if encstatus specified\r
++ (if (plist-member part :encstatus)\r
++ (let* ((encstatus (car (plist-get part :encstatus))))\r
++ (notmuch-crypto-insert-encstatus-button encstatus)))\r
++ ;; add signature status button if sigstatus specified\r
++ (if (plist-member part :sigstatus)\r
++ (let* ((headers (plist-get msg :headers))\r
++ (from (plist-get headers :From))\r
++ (sigstatus (car (plist-get part :sigstatus))))\r
++ (notmuch-crypto-insert-sigstatus-button sigstatus from)))\r
+ (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))\r
+ ;; Some of the body part handlers leave point somewhere up in the\r
+ ;; part, so we make sure that we're down at the end.\r
+@@ -711,9 +731,10 @@ current buffer, if possible."\r
+ (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))\r
+ \r
+ (defvar notmuch-show-parent-buffer nil)\r
++(make-variable-buffer-local 'notmuch-show-parent-buffer)\r
+ \r
+ ;;;###autoload\r
+-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)\r
++(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)\r
+ "Run \"notmuch show\" with the given thread ID and display results.\r
+ \r
+ The optional PARENT-BUFFER is the notmuch-search buffer from\r
+@@ -733,10 +754,14 @@ function is used. "\r
+ (let ((buffer (get-buffer-create (generate-new-buffer-name\r
+ (or buffer-name\r
+ (concat "*notmuch-" thread-id "*")))))\r
++ (process-crypto (if crypto-switch\r
++ (not notmuch-crypto-process-mime)\r
++ notmuch-crypto-process-mime))\r
+ (inhibit-read-only t))\r
+ (switch-to-buffer buffer)\r
+ (notmuch-show-mode)\r
+- (set (make-local-variable 'notmuch-show-parent-buffer) parent-buffer)\r
++ (setq notmuch-show-parent-buffer parent-buffer)\r
++ (setq notmuch-show-process-crypto process-crypto)\r
+ (erase-buffer)\r
+ (goto-char (point-min))\r
+ (save-excursion\r
+diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
+index 64f72a0..837136d 100644\r
+--- a/emacs/notmuch.el\r
++++ b/emacs/notmuch.el\r
+@@ -218,6 +218,7 @@ For a mouse binding, return nil."\r
+ (define-key map "-" 'notmuch-search-remove-tag)\r
+ (define-key map "+" 'notmuch-search-add-tag)\r
+ (define-key map (kbd "RET") 'notmuch-search-show-thread)\r
++ (define-key map (kbd "M-RET") 'notmuch-search-show-thread-crypto-switch)\r
+ map)\r
+ "Keymap for \"notmuch search\" buffers.")\r
+ (fset 'notmuch-search-mode-map notmuch-search-mode-map)\r
+@@ -417,7 +418,11 @@ Complete list of currently available key bindings:\r
+ "Return a list of authors for the current region"\r
+ (notmuch-search-properties-in-region 'notmuch-search-subject beg end))\r
+ \r
+-(defun notmuch-search-show-thread ()\r
++(defun notmuch-search-show-thread-crypto-switch ()\r
++ (interactive)\r
++ (notmuch-search-show-thread t))\r
++\r
++(defun notmuch-search-show-thread (&optional crypto-switch)\r
+ "Display the currently selected thread."\r
+ (interactive)\r
+ (let ((thread-id (notmuch-search-find-thread-id))\r
+@@ -433,7 +438,8 @@ Complete list of currently available key bindings:\r
+ (concat "*"\r
+ (truncate-string-to-width subject 32 nil nil t)\r
+ "*")\r
+- 32 nil nil t)))\r
++ 32 nil nil t))\r
++ crypto-switch)\r
+ (error "End of search results"))))\r
+ \r
+ (defun notmuch-search-reply-to-thread ()\r
+-- \r
+1.7.4.4\r
+\r
projects / notmuch-archives.git / commitdiff