Handle gpg errors better when trying to display PGP key image.

[gnus] / lisp / mml2015.el

diff --git a/lisp/mml2015.el b/lisp/mml2015.el
index df106bb..f8f0a56 100644 (file)
--- a/lisp/mml2015.el
+++ b/lisp/mml2015.el
@@ -1,6 +1,6 @@
 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
 
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: PGP MIME MML
@@ -55,9 +55,15 @@
                           'epg)
                       (error))
                     (progn
-                      (ignore-errors (require 'pgg))
-                      (and (fboundp 'pgg-sign-region)
-                           'pgg))
+                      (let ((abs-file (locate-library "pgg")))
+                        ;; Don't load PGG if it is marked as obsolete
+                        ;; (Emacs 24).
+                        (when (and abs-file
+                                   (not (string-match "/obsolete/[^/]*\\'"
+                                                      abs-file)))
+                          (ignore-errors (require 'pgg))
+                          (and (fboundp 'pgg-sign-region)
+                               'pgg))))
                     (progn (ignore-errors
                              (load "mc-toplev"))
                            (and (fboundp 'mc-encrypt-generic)
@@ -729,6 +735,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
 
 (defvar epg-user-id-alist)
 (defvar epg-digest-algorithm-alist)
+(defvar epg-gpg-program)
 (defvar inhibit-redisplay)
 
 (autoload 'epg-make-context "epg")
@@ -737,7 +744,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
 (autoload 'epg-context-set-signers "epg")
 (autoload 'epg-context-result-for "epg")
 (autoload 'epg-new-signature-digest-algorithm "epg")
-(autoload 'epg-verify-result-to-string "epg")
 (autoload 'epg-list-keys "epg")
 (autoload 'epg-decrypt-string "epg")
 (autoload 'epg-verify-string "epg")
@@ -749,6 +755,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
 (autoload 'epg-sub-key-capability "epg")
 (autoload 'epg-sub-key-validity "epg")
 (autoload 'epg-sub-key-fingerprint "epg")
+(autoload 'epg-signature-key-id "epg")
+(autoload 'epg-signature-to-string "epg")
 (autoload 'epg-configuration "epg-config")
 (autoload 'epg-expand-group "epg-config")
 (autoload 'epa-select-keys "epa")
@@ -782,13 +790,16 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
   (catch 'found
     (while keys
       (let ((pointer (epg-key-sub-key-list (car keys))))
-       (while pointer
-         (if (and (memq usage (epg-sub-key-capability (car pointer)))
-                  (not (memq 'disabled (epg-sub-key-capability (car pointer))))
-                  (not (memq (epg-sub-key-validity (car pointer))
-                             '(revoked expired))))
-             (throw 'found (car keys)))
-         (setq pointer (cdr pointer))))
+       ;; The primary key will be marked as disabled, when the entire
+       ;; key is disabled (see 12 Field, Format of colon listings, in
+       ;; gnupg/doc/DETAILS)
+       (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+         (while pointer
+           (if (and (memq usage (epg-sub-key-capability (car pointer)))
+                    (not (memq (epg-sub-key-validity (car pointer))
+                               '(revoked expired))))
+               (throw 'found (car keys)))
+           (setq pointer (cdr pointer)))))
       (setq keys (cdr keys)))))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
@@ -809,6 +820,35 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
        (setq secret-keys (cdr secret-keys))))
     secret-key))
 
+(defun mml2015-epg-key-image (key-id)
+  "Return the image of a key, if any"
+  (with-temp-buffer
+    (mm-set-buffer-multibyte nil)
+    (let* ((coding-system-for-write 'binary)
+           (coding-system-for-read 'binary)
+           (data (shell-command-to-string
+                  (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >/dev/null 2>&1"
+                          epg-gpg-program key-id))))
+      (when (> (length data) 0)
+        (insert (substring data 16))
+        (create-image (buffer-string) nil t)))))
+
+(defun mml2015-epg-key-image-to-string (key-id)
+  "Return a string with the image of a key, if any"
+  (let* ((result "")
+         (key-image (mml2015-epg-key-image key-id)))
+    (when key-image
+      (setq result "  ")
+      (put-text-property 1 2 'display key-image result))
+    result))
+
+(defun mml2015-epg-signature-to-string (signature)
+  (concat (epg-signature-to-string signature)
+         (mml2015-epg-key-image-to-string (epg-signature-key-id signature))))
+
+(defun mml2015-epg-verify-result-to-string (verify-result)
+  (mapconcat #'mml2015-epg-signature-to-string verify-result "\n"))
+
 (defun mml2015-epg-decrypt (handle ctl)
   (catch 'error
     (let ((inhibit-redisplay t)
@@ -851,7 +891,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
            (mm-set-handle-multipart-parameter
             mm-security-handle 'gnus-info
             (concat "OK\n"
-                    (epg-verify-result-to-string
+                    (mml2015-epg-verify-result-to-string
                      (epg-context-result-for context 'verify))))
          (mm-set-handle-multipart-parameter
           mm-security-handle 'gnus-info "OK"))
@@ -899,7 +939,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
       (if (epg-context-result-for context 'verify)
          (mm-set-handle-multipart-parameter
           mm-security-handle 'gnus-details
-          (epg-verify-result-to-string
+          (mml2015-epg-verify-result-to-string
            (epg-context-result-for context 'verify)))))))
 
 (defun mml2015-epg-verify (handle ctl)
@@ -917,7 +957,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
        (mm-set-handle-multipart-parameter
         mm-security-handle 'gnus-info "Corrupted")
        (throw 'error handle))
-      (setq part (mm-replace-in-string part "\n" "\r\n" t)
+      (setq part (mm-replace-in-string part "\n" "\r\n")
            signature (mm-get-part signature)
            context (epg-make-context))
       (condition-case error
@@ -933,7 +973,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
         (throw 'error handle)))
       (mm-set-handle-multipart-parameter
        mm-security-handle 'gnus-info
-       (epg-verify-result-to-string (epg-context-result-for context 'verify)))
+       (mml2015-epg-verify-result-to-string
+       (epg-context-result-for context 'verify)))
       handle)))
 
 (defun mml2015-epg-clear-verify ()
@@ -956,7 +997,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
        (progn
          (mm-set-handle-multipart-parameter
           mm-security-handle 'gnus-info
-          (epg-verify-result-to-string
+          (mml2015-epg-verify-result-to-string
            (epg-context-result-for context 'verify)))
          (delete-region (point-min) (point-max))
          (insert (mm-decode-coding-string plain coding-system-for-read)))