X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fmml2015.el;h=ff6c04dc5028612845ac2a8e3790ef425ffc6bca;hb=a3dceb5435f0e48f5b39a10508e3d7d14aa9e8c2;hp=a16a4e5244419d6f99874433a55cdf2127bd709f;hpb=3dd0d75daea81f18f28c1363db77a29627376882;p=elisp%2Fgnus.git- diff --git a/lisp/mml2015.el b/lisp/mml2015.el index a16a4e5..ff6c04d 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -1,5 +1,5 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: PGP MIME MML @@ -23,6 +23,9 @@ ;;; Commentary: +;; RFC 2015 is updated by RFC 3156, this file should be compatible +;; with both. + ;;; Code: (eval-when-compile (require 'cl)) @@ -124,7 +127,11 @@ by you.") (setq handles (mm-dissect-buffer t))) (mm-destroy-parts handle) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") + mm-security-handle 'gnus-info + (concat "OK" + (let ((sig (with-current-buffer mml2015-result-buffer + (mml2015-gpg-extract-signature-details)))) + (concat ", Signer: " sig)))) (if (listp (car handles)) handles (list handles))))) @@ -150,7 +157,8 @@ by you.") (defun mml2015-fix-micalg (alg) (and alg - (upcase (if (string-match "^pgp-" alg) + ;; Mutt/1.2.5i has seen sending micalg=php-sha1 + (upcase (if (string-match "^p[gh]p-" alg) (substring alg (match-end 0)) alg)))) @@ -302,9 +310,10 @@ by you.") (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) -(defun mml2015-mailcrypt-encrypt (cont) +(defun mml2015-mailcrypt-encrypt (cont &optional sign) (let ((mc-pgp-always-sign (or mc-pgp-always-sign + sign (eq t (or (message-options-get 'message-sign-encrypt) (message-options-set 'message-sign-encrypt @@ -344,6 +353,7 @@ by you.") (autoload 'gpg-verify-cleartext "gpg") (autoload 'gpg-sign-detached "gpg") (autoload 'gpg-sign-encrypt "gpg") + (autoload 'gpg-encrypt "gpg") (autoload 'gpg-passphrase-read "gpg")) (defun mml2015-gpg-passphrase () @@ -362,7 +372,10 @@ by you.") (buffer-string))) (set-buffer cipher) (erase-buffer) - (insert-buffer plain))) + (insert-buffer plain) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)))) '(t) ;; Some wrong with the return value, check plain text buffer. (if (> (point-max) (point-min)) @@ -384,9 +397,9 @@ by you.") (defun mml2015-gpg-pretty-print-fpr (fingerprint) (let* ((result "") - (fpr-length (string-width fingerprint)) - (n-slice 0) - slice) + (fpr-length (string-width fingerprint)) + (n-slice 0) + slice) (setq fingerprint (string-to-list fingerprint)) (while fingerprint (setq fpr-length (- fpr-length 4)) @@ -394,35 +407,42 @@ by you.") (setq fingerprint (nthcdr 4 fingerprint)) (setq n-slice (1+ n-slice)) (setq result - (concat - result - (case n-slice - (1 slice) - (otherwise (concat " " slice)))))) + (concat + result + (case n-slice + (1 slice) + (otherwise (concat " " slice)))))) result)) - + (defun mml2015-gpg-extract-signature-details () (goto-char (point-min)) (if (boundp 'gpg-unabbrev-trust-alist) - (let* ((signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG [0-9A-Za-z]* \\(.*\\)$" + (let* ((expired (re-search-forward + "^\\[GNUPG:\\] SIGEXPIRED$" + nil t)) + (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]*\\) " + (cons (match-string 1) (match-string 2)))) + (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)) + (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)))) - "From unknown user")) + (cond ((and signer fprint) + (concat (cdr signer) + (unless trust-good-enough-p + (concat "\nUntrusted, Fingerprint: " + (mml2015-gpg-pretty-print-fpr fprint))) + (when expired + (format "\nWARNING: Signature from expired key (%s)" + (car signer))))) + (t + "From unknown user"))) (if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t) (match-string 1) "From unknown user"))) @@ -441,6 +461,16 @@ by you.") (with-temp-buffer (setq message (current-buffer)) (insert part) + ;; Convert to in verify mode. Sign and + ;; clearsign use --textmode. The conversion is not necessary. + ;; In clearverify, the conversion is not necessary either. + (goto-char (point-min)) + (end-of-line) + (while (not (eobp)) + (unless (eq (char-before) ?\r) + (insert "\r")) + (forward-line) + (end-of-line)) (with-temp-buffer (setq signature (current-buffer)) (unless (setq part (mm-find-part-by-type @@ -459,20 +489,20 @@ by you.") (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) + (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) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Quit.") + (setq info-is-set-p t) nil)) - (unless info-is-set-p - (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 @@ -537,28 +567,42 @@ by you.") (insert (format "--%s--\n" boundary)) (goto-char (point-max))))) -(defun mml2015-gpg-encrypt (cont) +(defun mml2015-gpg-encrypt (cont &optional sign) (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) cipher) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer - (unless (gpg-sign-encrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error"))) + ;; set up a function to call the correct gpg encrypt routine + ;; with the right arguments. (FIXME: this should be done + ;; differently.) + (flet ((gpg-encrypt-func + (sign plaintext ciphertext result recipients &optional + passphrase sign-with-key armor textmode) + (if sign + (gpg-sign-encrypt + plaintext ciphertext result recipients passphrase + sign-with-key armor textmode) + (gpg-encrypt + plaintext ciphertext result recipients passphrase + armor textmode)))) + (unless (gpg-encrypt-func + sign ; passed in when using signencrypt + text (setq cipher (current-buffer)) + mml2015-result-buffer + (split-string + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+") + nil + (message-options-get 'message-sender) + t t) ; armor & textmode + (unless (> (point-max) (point-min)) + (pop-to-buffer mml2015-result-buffer) + (error "Encrypt error")))) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) @@ -619,11 +663,11 @@ by you.") mml2015-use) ;;;###autoload -(defun mml2015-encrypt (cont) +(defun mml2015-encrypt (cont &optional sign) (mml2015-clean-buffer) (let ((func (nth 2 (assq mml2015-use mml2015-function-alist)))) (if func - (funcall func cont) + (funcall func cont sign) (error "Cannot find encrypt function")))) ;;;###autoload