;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
-;; Author: Sascha Lüdecke <sascha@meta-x.de>,
+;; Author: Sascha Lüdecke <sascha@meta-x.de>,
;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
-;; Keywords PGP
+;; Keywords: PGP
;; This file is part of GNU Emacs.
;;; Code:
-;; For Emacs < 22.2.
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (if (locate-library "password-cache")
+ (require 'password-cache)
+ (require 'password)))
(eval-when-compile
(require 'cl)
(require 'mm-util))
+(require 'mm-encode)
(require 'mml-sec)
(defvar mc-pgp-always-sign)
(autoload 'message-options-get "message")
(autoload 'message-options-set "message")
+(require 'mml2015)
+
(defvar mml1991-use mml2015-use
"The package used for PGP.")
(defvar mml1991-function-alist
'((mailcrypt mml1991-mailcrypt-sign
mml1991-mailcrypt-encrypt)
- (gpg mml1991-gpg-sign
- mml1991-gpg-encrypt)
(pgg mml1991-pgg-sign
mml1991-pgg-encrypt)
(epg mml1991-epg-sign
mml1991-epg-encrypt))
"Alist of PGP functions.")
-(defvar mml1991-verbose mml-secure-verbose
- "If non-nil, ask the user about the current operation more verbosely.")
-
(defvar mml1991-cache-passphrase mml-secure-cache-passphrase
"If t, cache passphrase.")
(while (looking-at "^Content[^ ]+:") (forward-line))
(unless (bobp)
(delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer
- (with-temp-buffer
- (setq cipher (current-buffer))
- (insert-buffer-substring text)
- (unless (mc-encrypt-generic
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- nil
- (point-min) (point-max)
- (message-options-get 'message-sender)
- 'sign)
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Encrypt error")))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- ;;(insert "Content-Type: application/pgp-encrypted\n\n")
- ;;(insert "Version: 1\n\n")
- (insert "\n")
- (insert-buffer-substring cipher)
- (goto-char (point-max))))))
-
-;;; gpg wrapper
-
-(autoload 'gpg-sign-cleartext "gpg")
-
-(declare-function gpg-sign-encrypt "ext:gpg"
- (plaintext ciphertext result recipients &optional
- passphrase sign-with-key armor textmode))
-(declare-function gpg-encrypt "ext:gpg"
- (plaintext ciphertext result recipients &optional
- passphrase armor textmode))
-
-(defun mml1991-gpg-sign (cont)
- (let ((text (current-buffer))
- headers signature
- (result-buffer (get-buffer-create "*GPG Result*")))
- ;; Save MIME Content[^ ]+: headers from signing
- (goto-char (point-min))
- (while (looking-at "^Content[^ ]+:") (forward-line))
- (unless (bobp)
- (setq headers (buffer-string))
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (quoted-printable-decode-region (point-min) (point-max))
(with-temp-buffer
- (unless (gpg-sign-cleartext text (setq signature (current-buffer))
- result-buffer
- nil
- (message-options-get 'message-sender))
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Sign error")))
+ (inline (mm-disable-multibyte))
+ (setq cipher (current-buffer))
+ (insert-buffer-substring text)
+ (unless (mc-encrypt-generic
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ nil
+ (point-min) (point-max)
+ (message-options-get 'message-sender)
+ 'sign)
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Encrypt error")))
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (quoted-printable-encode-region (point-min) (point-max))
+ (replace-match "" t t))
(set-buffer text)
(delete-region (point-min) (point-max))
- (if headers (insert headers))
+ ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+ ;;(insert "Version: 1\n\n")
(insert "\n")
- (insert-buffer-substring signature)
+ (insert-buffer-substring cipher)
(goto-char (point-max)))))
-(defun mml1991-gpg-encrypt (cont &optional sign)
- (let ((text (current-buffer))
- cipher
- (result-buffer (get-buffer-create "*GPG Result*")))
- ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMORED
- (goto-char (point-min))
- (while (looking-at "^Content[^ ]+:") (forward-line))
- (unless (bobp)
- (delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer
- (with-temp-buffer
- (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
- text (setq cipher (current-buffer))
- 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 result-buffer)
- (error "Encrypt error"))))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- ;;(insert "Content-Type: application/pgp-encrypted\n\n")
- ;;(insert "Version: 1\n\n")
- (insert "\n")
- (insert-buffer-substring cipher)
- (goto-char (point-max))))))
-
;; pgg wrapper
+(autoload 'pgg-sign-region "pgg")
+(autoload 'pgg-encrypt-region "pgg")
+
(defvar pgg-default-user-id)
(defvar pgg-errors-buffer)
(defvar pgg-output-buffer)
;; epg wrapper
(defvar epg-user-id-alist)
-(defvar password-cache-expiry)
(autoload 'epg-make-context "epg")
(autoload 'epg-passphrase-callback-function "epg")
(autoload 'epg-context-set-textmode "epg")
(autoload 'epg-context-set-signers "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
+(autoload 'epg-key-sub-key-list "epg")
+(autoload 'epg-sub-key-capability "epg")
+(autoload 'epg-sub-key-validity "epg")
+(autoload 'epg-sub-key-fingerprint "epg")
(autoload 'epg-sign-string "epg")
(autoload 'epg-encrypt-string "epg")
(autoload 'epg-configuration "epg-config")
(cons key-id mml1991-epg-secret-key-id-list))
(copy-sequence passphrase)))))
+(defun mml1991-epg-find-usable-key (keys usage)
+ (catch 'found
+ (while keys
+ (let ((pointer (epg-key-sub-key-list (car keys))))
+ ;; The primary key will be marked as disabled, when the entire
+ ;; key is disabled (see 12 Field, Format of colon listings, in
+ ;; gnupg/doc/DETAILS)
+ (unless (memq 'disabled (epg-sub-key-capability (car pointer)))
+ (while pointer
+ (if (and (memq usage (epg-sub-key-capability (car pointer)))
+ (not (memq (epg-sub-key-validity (car pointer))
+ '(revoked expired))))
+ (throw 'found (car keys)))
+ (setq pointer (cdr pointer)))))
+ (setq keys (cdr keys)))))
+
+;; XXX: since gpg --list-secret-keys does not return validity of each
+;; key, `mml1991-epg-find-usable-key' defined above is not enough for
+;; secret keys. The function `mml1991-epg-find-usable-secret-key'
+;; below looks at appropriate public keys to check usability.
+(defun mml1991-epg-find-usable-secret-key (context name usage)
+ (let ((secret-keys (epg-list-keys context name t))
+ secret-key)
+ (while (and (not secret-key) secret-keys)
+ (if (mml1991-epg-find-usable-key
+ (epg-list-keys context (epg-sub-key-fingerprint
+ (car (epg-key-sub-key-list
+ (car secret-keys)))))
+ usage)
+ (setq secret-key (car secret-keys)
+ secret-keys nil)
+ (setq secret-keys (cdr secret-keys))))
+ secret-key))
+
(defun mml1991-epg-sign (cont)
(let ((context (epg-make-context))
- headers cte signers signature)
- (if mml1991-verbose
+ headers cte signer-key signers signature)
+ (if (eq mm-sign-option 'guided)
(setq signers (epa-select-keys context "Select keys for signing.
If no one is selected, default secret key is used. "
mml1991-signers t))
(if mml1991-signers
- (setq signers (mapcar (lambda (name)
- (car (epg-list-keys context name t)))
- mml1991-signers))))
+ (setq signers (delq nil
+ (mapcar
+ (lambda (name)
+ (setq signer-key
+ (mml1991-epg-find-usable-secret-key
+ context name 'sign))
+ (unless (or signer-key
+ (y-or-n-p
+ (format
+ "No secret key for %s; skip it? "
+ name)))
+ (error "No secret key for %s" name))
+ signer-key)
+ mml1991-signers)))))
(epg-context-set-armor context t)
(epg-context-set-textmode context t)
(epg-context-set-signers context signers)
(split-string
(message-options-get 'message-recipients)
"[ \f\t\n\r\v,]+")))
- cipher signers config)
+ recipient-key signer-key cipher signers config)
+ (when mml1991-encrypt-to-self
+ (unless mml1991-signers
+ (error "mml1991-signers is not set"))
+ (setq recipients (nconc recipients mml1991-signers)))
;; We should remove this check if epg-0.0.6 is released.
(if (and (condition-case nil
(require 'epg-config)
(or (epg-expand-group config recipient)
(list recipient)))
recipients))))
- (if mml1991-verbose
+ (if (eq mm-encrypt-option 'guided)
(setq recipients
(epa-select-keys context "Select recipients for encryption.
If no one is selected, symmetric encryption will be performed. "
recipients))
(setq recipients
- (delq nil (mapcar (lambda (name)
- (car (epg-list-keys context name)))
- recipients))))
- (if mml1991-encrypt-to-self
- (if mml1991-signers
- (setq recipients
- (nconc recipients
- (mapcar (lambda (name)
- (car (epg-list-keys context name)))
- mml1991-signers)))
- (error "mml1991-signers not set")))
+ (delq nil (mapcar
+ (lambda (name)
+ (setq recipient-key (mml1991-epg-find-usable-key
+ (epg-list-keys context name)
+ 'encrypt))
+ (unless (or recipient-key
+ (y-or-n-p
+ (format "No public key for %s; skip it? "
+ name)))
+ (error "No public key for %s" name))
+ recipient-key)
+ recipients)))
+ (unless recipients
+ (error "No recipient specified")))
(when sign
- (if mml1991-verbose
+ (if (eq mm-sign-option 'guided)
(setq signers (epa-select-keys context "Select keys for signing.
If no one is selected, default secret key is used. "
mml1991-signers t))
(if mml1991-signers
- (setq signers (mapcar (lambda (name)
- (car (epg-list-keys context name t)))
- mml1991-signers))))
+ (setq signers (delq nil
+ (mapcar
+ (lambda (name)
+ (mml1991-epg-find-usable-secret-key
+ context name 'sign))
+ mml1991-signers)))))
(epg-context-set-signers context signers))
(epg-context-set-armor context t)
(epg-context-set-textmode context t)
(provide 'mml1991)
;; Local Variables:
-;; coding: iso-8859-1
+;; coding: utf-8
;; End:
-;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706
;;; mml1991.el ends here
projects / gnus / blobdiff