;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
;;; Commentary:
+;; RFC 2015 is updated by RFC 3156, this file should be compatible
+;; with both.
+
;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-decode)
+(require 'mm-util)
+(require 'mml)
(defvar mml2015-use (or
+ (progn
+ (ignore-errors
+ ;; Avoid the "Recursive load suspected" error
+ ;; in Emacs 21.1.
+ (let ((recursive-load-depth-limit 100))
+ (require 'pgg)))
+ (and (fboundp 'pgg-sign-region)
+ 'pgg))
(progn
(ignore-errors
(require 'gpg))
(fboundp 'mc-sign-generic)
(fboundp 'mc-cleanup-recipient-headers)
'mailcrypt)))
- "The package used for PGP/MIME.")
+ "The package used for PGP/MIME.
+Valid packages include `pgg', `gpg' and `mailcrypt'.")
;; Something is not RFC2015.
(defvar mml2015-function-alist
mml2015-gpg-verify
mml2015-gpg-decrypt
mml2015-gpg-clear-verify
- mml2015-gpg-clear-decrypt))
+ mml2015-gpg-clear-decrypt)
+ (pgg mml2015-pgg-sign
+ mml2015-pgg-encrypt
+ mml2015-pgg-verify
+ mml2015-pgg-decrypt
+ mml2015-pgg-clear-verify
+ mml2015-pgg-clear-decrypt))
"Alist of PGP/MIME functions.")
(defvar mml2015-result-buffer nil)
+(defcustom mml2015-unabbrev-trust-alist
+ '(("TRUST_UNDEFINED" . nil)
+ ("TRUST_NEVER" . nil)
+ ("TRUST_MARGINAL" . t)
+ ("TRUST_FULLY" . t)
+ ("TRUST_ULTIMATE" . t))
+ "Map GnuPG trust output values to a boolean saying if you trust the key."
+ :type '(repeat (cons (regexp :tag "GnuPG output regexp")
+ (boolean :tag "Trust key"))))
+
;;; mailcrypt wrapper
(eval-and-compile
(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)))))
(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))))
(defun mml2015-mailcrypt-sign (cont)
(mc-sign-generic (message-options-get 'message-sender)
nil nil nil nil)
- (let ((boundary
- (funcall mml-boundary-function (incf mml-multipart-number)))
+ (let ((boundary (mml-compute-boundary cont))
hash point)
(goto-char (point-min))
(unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
(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
(or (y-or-n-p "Sign the message? ")
'not))))
'never)))
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(mc-encrypt-generic
(or (message-options-get 'message-recipients)
(message-options-set 'message-recipients
(goto-char (point-min))
(unless (looking-at "-----BEGIN PGP MESSAGE-----")
(error "Fail to encrypt the message"))
- (let ((boundary
- (funcall mml-boundary-function (incf mml-multipart-number))))
+ (let ((boundary (mml-compute-boundary cont)))
(insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
boundary))
(insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
(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 ()
(buffer-string)))
(set-buffer cipher)
(erase-buffer)
- (insert-buffer plain)))
+ (insert-buffer-substring 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))
(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"))
+ (let* ((expired (re-search-forward
+ "^\\[GNUPG:\\] SIGEXPIRED$"
+ nil t))
+ (signer (and (re-search-forward
+ "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
+ nil t)
+ (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 trust mml2015-unabbrev-trust-alist))))
+ (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)))))
+ ((re-search-forward
+ "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
+ (match-string 2))
+ (t
+ "From unknown user"))))
(defun mml2015-gpg-verify (handle ctl)
(catch 'error
- (let (part message signature)
+ &
projects / gnus / blobdiff