From 653592eef75bea6101dc94d4a35d23a9e1175c71 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 30 Jul 2001 23:13:13 +0000 Subject: [PATCH] Synch with Oort Gnus. --- contrib/ChangeLog | 6 +++++ contrib/gpg.el | 12 +++++++-- lisp/ChangeLog | 10 +++++++ lisp/lpath.el | 1 + lisp/mml2015.el | 76 ++++++++++++++++++++++++++++++++++++++++++++++------- 5 files changed, 94 insertions(+), 11 deletions(-) diff --git a/contrib/ChangeLog b/contrib/ChangeLog index a394ef8..5c2a4fa 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,9 @@ +2001-07-30 16:00:00 ShengHuo ZHU + From Andreas Fuchs + + * gpg.el (gpg-command-verify): --status-fd 1 + (gpg-unabbrev-trust-alist): New. + 2001-01-18 Colin Marquardt * gpg.el (gpg-make-temp-file): Error info. diff --git a/contrib/gpg.el b/contrib/gpg.el index 66fa01a..02ccf34 100644 --- 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 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2001-07-30 15:00:00 ShengHuo ZHU + Originally from Andreas Fuchs + + * 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 * 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 --- 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 --- 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"))) -- 1.7.10.4