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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ba27305..25e9ad0 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 5171603..aab6cfd 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 53ed8d4..5af8aba 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")))