;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
;;; Commentary:
-;; Installation: put the following statements in ~/.gnus:
-;; (require 'mml2015)
-;; (require 'gnus-art)
-;; (mml2015-setup)
-;; You may have to make sure that the directory where this file lives
-;; is mentioned in `load-path'.
-;;
-;; Insert an attribute, postprocess=pgp-sign (or pgp-encrypt), into
-;; the mml tag to be signed (or encrypted).
+;; RFC 2015 is updated by RFC 3156, this file should be compatible
+;; with both.
;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-decode)
-(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
-(defvar mml2015-verify-function 'mailcrypt-verify)
-(defvar mml2015-encrypt-function 'mml2015-mailcrypt-encrypt)
-(defvar mml2015-sign-function 'mml2015-mailcrypt-sign)
+(defvar mml2015-use (or
+ (progn
+ (ignore-errors
+ (require 'gpg))
+ (and (fboundp 'gpg-sign-detached)
+ 'gpg))
+ (progn (ignore-errors
+ (load "mc-toplev"))
+ (and (fboundp 'mc-encrypt-generic)
+ (fboundp 'mc-sign-generic)
+ (fboundp 'mc-cleanup-recipient-headers)
+ 'mailcrypt)))
+ "The package used for PGP/MIME.")
-;;;###autoload
-(defun mml2015-decrypt (handle ctl)
- (let (child handles result)
- (unless (setq child (mm-find-part-by-type (cdr handle)
- "application/octet-stream"))
- (error "Corrupted pgp-encrypted part."))
- (with-temp-buffer
- (mm-insert-part child)
- (setq result (funcall mml2015-decrypt-function))
- (unless (car result)
- (error "Decrypting error."))
- (setq handles (mm-dissect-buffer t)))
- (mm-destroy-parts handle)
- (if (listp (car handles))
- handles
- (list handles))))
+;; Something is not RFC2015.
+(defvar mml2015-function-alist
+ '((mailcrypt mml2015-mailcrypt-sign
+ mml2015-mailcrypt-encrypt
+ mml2015-mailcrypt-verify
+ mml2015-mailcrypt-decrypt
+ mml2015-mailcrypt-clear-verify
+ mml2015-mailcrypt-clear-decrypt)
+ (gpg mml2015-gpg-sign
+ mml2015-gpg-encrypt
+ mml2015-gpg-verify
+ mml2015-gpg-decrypt
+ mml2015-gpg-clear-verify
+ mml2015-gpg-clear-decrypt))
+ "Alist of PGP/MIME functions.")
-(defun mml2015-fix-micalg (alg)
- (upcase
- (if (and alg (string-match "^pgp-" alg))
- (substring alg (match-end 0))
- alg)))
+(defvar mml2015-result-buffer nil)
-;;;###autoload
-(defun mml2015-verify (handle ctl)
- (let (part)
- (unless (setq part (mm-find-raw-part-by-type
- ctl "application/pgp-signature" t))
- (error "Corrupted pgp-signature part."))
- (with-temp-buffer
- (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
- (insert (format "Hash: %s\n\n"
- (or (mml2015-fix-micalg
- (mail-content-type-get ctl 'micalg))
- "SHA1")))
- (insert part "\n")
- (goto-char (point-max))
- (unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature"))
- (error "Corrupted pgp-signature part."))
- (mm-insert-part part)
- (unless (funcall mml2015-verify-function)
- (error "Verify error.")))))
+(defvar mml2015-trust-boundaries-alist
+ '((trust-undefined . nil)
+ (trust-none . nil)
+ (trust-marginal . t)
+ (trust-full . 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
+ (autoload 'mailcrypt-decrypt "mailcrypt")
+ (autoload 'mailcrypt-verify "mailcrypt")
+ (autoload 'mc-pgp-always-sign "mailcrypt")
(autoload 'mc-encrypt-generic "mc-toplev")
(autoload 'mc-cleanup-recipient-headers "mc-toplev")
(autoload 'mc-sign-generic "mc-toplev"))
(defvar mc-default-scheme)
(defvar mc-schemes))
+(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
+(defvar mml2015-verify-function 'mailcrypt-verify)
+
+(defun mml2015-format-error (err)
+ (if (stringp (cadr err))
+ (cadr err)
+ (format "%S" (cdr err))))
+
+(defun mml2015-mailcrypt-decrypt (handle ctl)
+ (catch 'error
+ (let (child handles result)
+ (unless (setq child (mm-find-part-by-type
+ (cdr handle)
+ "application/octet-stream" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (mm-insert-part child)
+ (setq result
+ (condition-case err
+ (funcall mml2015-decrypt-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil)))
+ (unless (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))
+ (setq handles (mm-dissect-buffer t)))
+ (mm-destroy-parts handle)
+ (mm-set-handle-multipart-parameter
+ 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-mailcrypt-clear-decrypt ()
+ (let (result)
+ (setq result
+ (condition-case err
+ (funcall mml2015-decrypt-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil)))
+ (if (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-fix-micalg (alg)
+ (and 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-verify (handle ctl)
+ (catch 'error
+ (let (part)
+ (unless (setq part (mm-find-raw-part-by-type
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
+ "application/pgp-signature")
+ t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
+ (insert (format "Hash: %s\n\n"
+ (or (mml2015-fix-micalg
+ (mm-handle-multipart-ctl-parameter
+ ctl 'micalg))
+ "SHA1")))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert part "\n")
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at "^-")
+ (insert "- "))
+ (forward-line)))
+ (unless (setq part (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-insert-part part)
+ (goto-char (point-min))
+ (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
+ (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
+ (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
+ (replace-match "-----END PGP SIGNATURE-----" t t)))
+ (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (unless (condition-case err
+ (prog1
+ (funcall mml2015-verify-function)
+ (if (get-buffer " *mailcrypt stderr temp")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer " *mailcrypt stderr temp"
+ (buffer-string))))
+ (if (get-buffer " *mailcrypt stdout temp")
+ (kill-buffer " *mailcrypt stdout temp"))
+ (if (get-buffer " *mailcrypt stderr temp")
+ (kill-buffer " *mailcrypt stderr temp"))
+ (if (get-buffer " *mailcrypt status temp")
+ (kill-buffer " *mailcrypt status temp"))
+ (if (get-buffer mc-gpg-debug-buffer)
+ (kill-buffer mc-gpg-debug-buffer)))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ handle)))
+
+(defun mml2015-mailcrypt-clear-verify ()
+ (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (if (condition-case err
+ (prog1
+ (funcall mml2015-verify-function)
+ (if (get-buffer " *mailcrypt stderr temp")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer " *mailcrypt stderr temp"
+ (buffer-string))))
+ (if (get-buffer " *mailcrypt stdout temp")
+ (kill-buffer " *mailcrypt stdout temp"))
+ (if (get-buffer " *mailcrypt stderr temp")
+ (kill-buffer " *mailcrypt stderr temp"))
+ (if (get-buffer " *mailcrypt status temp")
+ (kill-buffer " *mailcrypt status temp"))
+ (if (get-buffer mc-gpg-debug-buffer)
+ (kill-buffer mc-gpg-debug-buffer)))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
(defun mml2015-mailcrypt-sign (cont)
(mc-sign-generic (message-options-get 'message-sender)
nil nil nil nil)
- (let ((boundary
+ (let ((boundary
(funcall mml-boundary-function (incf mml-multipart-number)))
- (scheme-alist (funcall (or mc-default-scheme
- (cdr (car mc-schemes)))))
- hash)
+ hash point)
(goto-char (point-min))
- (unless (re-search-forward (cdr (assq 'signed-begin-line scheme-alist)))
- (error "Cannot find signed begin line." ))
+ (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
+ (error "Cannot find signed begin line"))
(goto-char (match-beginning 0))
(forward-line 1)
(unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
- (error "Cannot not find PGP hash." ))
+ (error "Cannot not find PGP hash"))
(setq hash (match-string 1))
(unless (re-search-forward "^$" nil t)
- (error "Cannot not find PGP message." ))
+ (error "Cannot not find PGP message"))
(forward-line 1)
(delete-region (point-min) (point))
(insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
(insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
(downcase hash)))
(insert (format "\n--%s\n" boundary))
+ (setq point (point))
(goto-char (point-max))
- (unless (re-search-backward (cdr (assq 'signed-end-line scheme-alist)))
- (error "Cannot find signature part." ))
+ (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
+ (error "Cannot find signature part"))
+ (replace-match "-----END PGP MESSAGE-----" t t)
(goto-char (match-beginning 0))
- (unless (re-search-backward "^-+BEGIN" nil t)
- (error "Cannot find signature part." ))
+ (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
+ nil t)
+ (error "Cannot find signature part"))
+ (replace-match "-----BEGIN PGP MESSAGE-----" t t)
projects / gnus / blobdiff