Synch with Oort Gnus.

diff --git a/contrib/ChangeLog b/contrib/ChangeLog
index a394ef8..5c2a4fa 100644 (file)
--- a/contrib/ChangeLog
+++ b/contrib/ChangeLog
@@ -1,3 +1,9 @@
+2001-07-30 16:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
+       From Andreas Fuchs <asf@void.at>
+
+       * gpg.el (gpg-command-verify): --status-fd 1
+       (gpg-unabbrev-trust-alist): New.
+
 2001-01-18  Colin Marquardt <colin.marquardt@usa.alcatel.com>
 
        * gpg.el (gpg-make-temp-file): Error info.

diff --git a/contrib/gpg.el b/contrib/gpg.el
index 66fa01a..02ccf34 100644 (file)
--- a/contrib/gpg.el
+++ b/contrib/gpg.el
@@ -300,7 +300,7 @@ indicate that it should read the passphrase from standard input."
 ;;; Customization: Variables: GnuPG Commands:
 
 (defcustom gpg-command-verify
-  '(gpg . ("--batch" "--verbose" "--verify" signature-file message-file))
+  '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" signature-file message-file))
   "Command to verify a detached signature.
 The invoked program has to read the signed message and the signature
 from the given files.  It should write human-readable information to
@@ -321,7 +321,7 @@ charsets or line endings; the input data shall be treated as binary."
   :group 'gpg-commands)
 
 (defcustom gpg-command-verify-cleartext
-  '(gpg . ("--batch" "--verbose" "--verify" message-file))
+  '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" message-file))
   "Command to verify a message.
 The invoked program has to read the signed message from the given
 file.  It should write human-readable information to standard output
@@ -1173,6 +1173,14 @@ documentation for details)."
     (?u . trust-ultimate))
   "Alist mapping GnuPG trust value short forms to long symbols.")
 
+(defconst gpg-unabbrev-trust-alist
+  '(("TRUST_UNDEFINED" . trust-undefined)
+    ("TRUST_NEVER"     . trust-none)
+    ("TRUST_MARGINAL"  . trust-marginal)
+    ("TRUST_FULLY"     . trust-full)
+    ("TRUST_ULTIMATE"  . trust-ultimate))
+  "Alist mapping capitalized GnuPG trust values to long symbols.")
+
 (defmacro gpg-key-list-keys-in-buffer-store ()
   '(when primary-user-id
      (sort user-id 'string-lessp)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cbca832..6e252f4 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2001-07-30 15:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
+       Originally from Andreas Fuchs <asf@void.at>
+
+       * mml2015.el (mml2015-trust-boundaries-alist)
+       (mml2015-gpg-pretty-print-fpr): New.
+       (mml2015-gpg-extract-signature-details): More details, rename from
+       `m-g-e-from'.
+       (mml2015-gpg-verify): Use them.
+       (mml2015-gpg-clear-verify): Use them.
+
 2001-07-31  Simon Josefsson  <jas@extundo.com>
 
        * mml-smime.el (mml-smime-sign, mml-smime-encrypt): Goto end of

diff --git a/lisp/lpath.el b/lisp/lpath.el
index 49c4b54..eed863a 100644 (file)
--- a/lisp/lpath.el
+++ b/lisp/lpath.el
@@ -37,6 +37,7 @@
              display-time-mail-function imap-password mail-mode-hook
              filladapt-mode
              mc-pgp-always-sign
+             gpg-unabbrev-trust-alist
              nnoo-definition-alist
              url-current-callback-func url-be-asynchronous
              url-current-callback-data url-working-buffer

diff --git a/lisp/mml2015.el b/lisp/mml2015.el
index f9edf14..d183432 100644 (file)
--- a/lisp/mml2015.el
+++ b/lisp/mml2015.el
@@ -60,6 +60,18 @@
 
 (defvar mml2015-result-buffer nil)
 
+(defvar mml2015-trust-boundaries-alist
+  '((trust-undefined . nil)
+    (trust-none      . nil)
+    (trust-marginal  . t)
+    (trust-fully     . t)
+    (trust-ultimate  . t))
+  "Trust boundaries for a signer's GnuPG key.
+This alist contains pairs of the form (trust-symbol . boolean), with
+symbols that are contained in `gpg-unabbrev-trust-alist'. The boolean
+specifies whether the given trust value is good enough to be trusted
+by you.")
+
 ;;; mailcrypt wrapper
 
 (eval-and-compile
@@ -369,15 +381,54 @@
       (mm-set-handle-multipart-parameter
        mm-security-handle 'gnus-info "Failed"))))
 
-(defun mml2015-gpg-extract-from ()
+(defun mml2015-gpg-pretty-print-fpr (fingerprint)
+  (let* ((result "")
+         (fpr-length (string-width fingerprint))
+         (n-slice 0)
+         slice)
+    (setq fingerprint (string-to-list fingerprint))
+    (while fingerprint
+      (setq fpr-length (- fpr-length 4))
+      (setq slice (butlast fingerprint fpr-length))
+      (setq fingerprint (nthcdr 4 fingerprint))
+      (setq n-slice (1+ n-slice))
+      (setq result
+            (concat
+             result
+             (case n-slice
+               (1  slice)
+               (otherwise (concat " " slice))))))
+    result))
+          
+(defun mml2015-gpg-extract-signature-details ()
   (goto-char (point-min))
-  (if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t)
-      (match-string 1)
-    "From unknown user"))
+  (if (boundp 'gpg-unabbrev-trust-alist)
+      (let* ((signer (and (re-search-forward
+                          "^\\[GNUPG:\\] GOODSIG [0-9A-Za-z]* \\(.*\\)$"
+                          nil t)
+                         (match-string 1)))
+         (fprint (and (re-search-forward
+                      "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
+                      nil t)
+                      (match-string 1)))
+         (trust  (and (re-search-forward "^\\[GNUPG:\\] \\(TRUST_.*\\)$" nil t)
+                      (match-string 1)))
+         (trust-good-enough-p
+         (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist))
+                     mml2015-trust-boundaries-alist))))
+       (if (and signer trust fprint)
+           (concat signer
+                   (unless trust-good-enough-p
+                     (concat "\nUntrusted, Fingerprint: "
+                             (mml2015-gpg-pretty-print-fpr fprint))))
+         (error "From unknown user")))
+    (if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t)
+       (match-string 1)
+      "From unknown user")))
 
 (defun mml2015-gpg-verify (handle ctl)
   (catch 'error
-    (let (part message signature)
+    (let (part message signature info-is-set-p)
       (unless (setq part (mm-find-raw-part-by-type
                          ctl (or (mm-handle-multipart-ctl-parameter
                                   ctl 'protocol)
@@ -407,18 +458,25 @@
                    (error
                     (mm-set-handle-multipart-parameter
                      mm-security-handle 'gnus-details (mml2015-format-error err))
+                     (mm-set-handle-multipart-parameter
+                      mm-security-handle 'gnus-info "Error.")
+                     (setq info-is-set-p t)
                     nil)
                    (quit
                     (mm-set-handle-multipart-parameter
                      mm-security-handle 'gnus-details "Quit.")
+                     (mm-set-handle-multipart-parameter
+                      mm-security-handle 'gnus-info "Quit.")
+                     (setq info-is-set-p t)
                     nil))
-           (mm-set-handle-multipart-parameter
-            mm-security-handle 'gnus-info "Failed")
+            (unless info-is-set-p
+              (mm-set-handle-multipart-parameter
+               mm-security-handle 'gnus-info "Failed"))
            (throw 'error handle)))
        (mm-set-handle-multipart-parameter
         mm-security-handle 'gnus-info
         (with-current-buffer mml2015-result-buffer
-          (mml2015-gpg-extract-from))))
+          (mml2015-gpg-extract-signature-details))))
       handle)))
 
 (defun mml2015-gpg-clear-verify ()
@@ -440,7 +498,7 @@
       (mm-set-handle-multipart-parameter
        mm-security-handle 'gnus-info
        (with-current-buffer mml2015-result-buffer
-        (mml2015-gpg-extract-from)))
+        (mml2015-gpg-extract-signature-details)))
     (mm-set-handle-multipart-parameter
      mm-security-handle 'gnus-info "Failed")))