Commit 5213ded9 authored by Jens Lechtenboerger's avatar Jens Lechtenboerger Committed by Katsumi Yamaoka

Refactor mml-smime.el, mml1991.el, mml2015.el

(Maybe this is the last merge from Gnus git to Emacs git)

Cf. discussion on ding mailing list, messages in
<http://thread.gmane.org/gmane.emacs.gnus.general/86228>.
Common code from the three files mml-smime.el, mml1991.el, and
mml2015.el is moved to mml-sec.el.  Auxiliary functions are added
to gnus-util.el.

The code is supported by test cases with necessary test keys.

Documentation in message.texi is updated.

* doc/misc/message.texi (Security, Using S/MIME):
Update for refactoring mml-smime.el, mml1991.el, mml2015.el.
(Using OpenPGP): Rename from "Using PGP/MIME"; update contents.
(Passphrase caching, Encrypt-to-self, Bcc Warning): New sections.

* lisp/gnus/gnus-util.el (gnus-test-list, gnus-subsetp, gnus-setdiff):
New functions.

* lisp/gnus/mml-sec.el: Require gnus-util and epg.
(epa--select-keys): Autoload.
(mml-signencrypt-style-alist, mml-secure-cache-passphrase): Doc fix.
(mml-secure-openpgp-signers): New user option;
make mml1991-signers and mml2015-signers obsolete aliases to it.
(mml-secure-smime-signers): New user option;
make mml-smime-signers an obsolete alias to it.
(mml-secure-openpgp-encrypt-to-self): New user option;
make mml1991-encrypt-to-self and mml2015-encrypt-to-self obsolete
aliases to it.
(mml-secure-smime-encrypt-to-self): New user option;
make mml-smime-encrypt-to-self an obsolete alias to it.
(mml-secure-openpgp-sign-with-sender): New user option;
make mml2015-sign-with-sender an obsolete alias to it.
(mml-secure-smime-sign-with-sender): New user option;
make mml-smime-sign-with-sender an obsolete alias to it.
(mml-secure-openpgp-always-trust): New user option;
make mml2015-always-trust an obsolete alias to it.
(mml-secure-fail-when-key-problem, mml-secure-key-preferences):
New user options.
(mml-secure-cust-usage-lookup, mml-secure-cust-fpr-lookup)
(mml-secure-cust-record-keys, mml-secure-cust-remove-keys)
(mml-secure-add-secret-key-id, mml-secure-clear-secret-key-id-list)
(mml-secure-cache-passphrase-p, mml-secure-cache-expiry-interval)
(mml-secure-passphrase-callback, mml-secure-check-user-id)
(mml-secure-secret-key-exists-p, mml-secure-check-sub-key)
(mml-secure-find-usable-keys, mml-secure-select-preferred-keys)
(mml-secure-fingerprint, mml-secure-filter-keys)
(mml-secure-normalize-cust-name, mml-secure-select-keys)
(mml-secure-select-keys-1, mml-secure-signer-names, mml-secure-signers)
(mml-secure-self-recipients, mml-secure-recipients)
(mml-secure-epg-encrypt, mml-secure-epg-sign): New functions.

* lisp/gnus/mml-smime.el: Require epg;
refactor declaration and autoloading of epg functions.
(mml-smime-use): Doc fix.
(mml-smime-cache-passphrase, mml-smime-passphrase-cache-expiry):
Obsolete.
(mml-smime-get-dns-cert, mml-smime-get-ldap-cert):
Use format instead of gnus-format-message.
(mml-smime-epg-secret-key-id-list): Remove variable.
(mml-smime-epg-passphrase-callback, mml-smime-epg-find-usable-key)
(mml-smime-epg-find-usable-secret-key): Remove functions.
(mml-smime-epg-sign, mml-smime-epg-encrypt): Refactor.

* lisp/gnus/mml1991.el (mml1991-cache-passphrase)
(mml1991-passphrase-cache-expiry): Obsolete.
(mml1991-epg-secret-key-id-list): Remove variable.
(mml1991-epg-passphrase-callback, mml1991-epg-find-usable-key)
(mml1991-epg-find-usable-secret-key): Remove functions.
(mml1991-epg-sign, mml1991-epg-encrypt): Refactor.

* lisp/gnus/mml2015.el (mml2015-cache-passphrase)
(mml2015-passphrase-cache-expiry): Obsolete.
(mml2015-epg-secret-key-id-list): Remove variable.
(mml2015-epg-passphrase-callback, mml2015-epg-check-user-id)
(mml2015-epg-check-sub-key, mml2015-epg-find-usable-key)
(mml2015-epg-find-usable-secret-key): Remove functions.
(mml2015-epg-decrypt, mml2015-epg-clear-decrypt, mml2015-epg-sign)
(mml2015-epg-encrypt): Refactor.
parent 43662a24
This diff is collapsed.
......@@ -1996,6 +1996,31 @@ to case differences."
(defun gnus-timer--function (timer)
(elt timer 5)))
(defun gnus-test-list (list predicate)
"To each element of LIST apply PREDICATE.
Return nil if LIST is no list or is empty or some test returns nil;
otherwise, return t."
(when (and list (listp list))
(let ((result (mapcar predicate list)))
(not (memq nil result)))))
(defun gnus-subsetp (list1 list2)
"Return t if LIST1 is a subset of LIST2.
Similar to `subsetp' but use member for element test so that this works for
lists of strings."
(when (and (listp list1) (listp list2))
(if list1
(and (member (car list1) list2)
(gnus-subsetp (cdr list1) list2))
t)))
(defun gnus-setdiff (list1 list2)
"Return member-based set difference of LIST1 and LIST2."
(when (and list1 (listp list1) (listp list2))
(if (member (car list1) list2)
(gnus-setdiff (cdr list1) list2)
(cons (car list1) (gnus-setdiff (cdr list1) list2)))))
(provide 'gnus-util)
;;; gnus-util.el ends here
This diff is collapsed.
This diff is collapsed.
......@@ -63,11 +63,17 @@
(defvar mml1991-cache-passphrase mml-secure-cache-passphrase
"If t, cache passphrase.")
(make-obsolete-variable 'mml1991-cache-passphrase
'mml-secure-cache-passphrase
"25.1")
(defvar mml1991-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
"How many seconds the passphrase is cached.
Whether the passphrase is cached at all is controlled by
`mml1991-cache-passphrase'.")
(make-obsolete-variable 'mml1991-passphrase-cache-expiry
'mml-secure-passphrase-cache-expiry
"25.1")
(defvar mml1991-signers nil
"A list of your own key ID which will be used to sign a message.")
......@@ -75,6 +81,7 @@ Whether the passphrase is cached at all is controlled by
(defvar mml1991-encrypt-to-self nil
"If t, add your own key ID to recipient list when encryption.")
;;; mailcrypt wrapper
(autoload 'mc-sign-generic "mc-toplev")
......@@ -255,91 +262,9 @@ Whether the passphrase is cached at all is controlled by
(autoload 'epg-configuration "epg-config")
(autoload 'epg-expand-group "epg-config")
(defvar mml1991-epg-secret-key-id-list nil)
(defun mml1991-epg-passphrase-callback (context key-id ignore)
(if (eq key-id 'SYM)
(epg-passphrase-callback-function context key-id nil)
(let* ((entry (assoc key-id epg-user-id-alist))
(passphrase
(password-read
(format "GnuPG passphrase for %s: "
(if entry
(cdr entry)
key-id))
(if (eq key-id 'PIN)
"PIN"
key-id))))
(when passphrase
(let ((password-cache-expiry mml1991-passphrase-cache-expiry))
(password-cache-add key-id passphrase))
(setq mml1991-epg-secret-key-id-list
(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 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 (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)
(if mml1991-cache-passphrase
(epg-context-set-passphrase-callback
context
#'mml1991-epg-passphrase-callback))
(let ((inhibit-redisplay t)
headers cte)
;; Don't sign headers.
(goto-char (point-min))
(when (re-search-forward "^$" nil t)
......@@ -352,28 +277,21 @@ If no one is selected, default secret key is used. "
(when cte
(setq cte (intern (downcase cte)))
(mm-decode-content-transfer-encoding cte)))
(condition-case error
(setq signature (epg-sign-string context (buffer-string) 'clear)
mml1991-epg-secret-key-id-list nil)
(error
(while mml1991-epg-secret-key-id-list
(password-cache-remove (car mml1991-epg-secret-key-id-list))
(setq mml1991-epg-secret-key-id-list
(cdr mml1991-epg-secret-key-id-list)))
(signal (car error) (cdr error))))
(delete-region (point-min) (point-max))
(mm-with-unibyte-current-buffer
(insert signature)
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
(replace-match "" t t))
(when cte
(mm-encode-content-transfer-encoding cte))
(goto-char (point-min))
(when headers
(insert headers))
(insert "\n"))
t))
(let* ((pair (mml-secure-epg-sign 'OpenPGP 'clear))
(signature (car pair)))
(delete-region (point-min) (point-max))
(mm-with-unibyte-current-buffer
(insert signature)
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
(replace-match "" t t))
(when cte
(mm-encode-content-transfer-encoding cte))
(goto-char (point-min))
(when headers
(insert headers))
(insert "\n"))
t)))
(defun mml1991-epg-encrypt (cont &optional sign)
(goto-char (point-min))
......@@ -386,78 +304,7 @@ If no one is selected, default secret key is used. "
(delete-region (point-min) (point))
(when cte
(mm-decode-content-transfer-encoding (intern (downcase cte))))))
(let ((context (epg-make-context))
(recipients
(if (message-options-get 'message-recipients)
(split-string
(message-options-get 'message-recipients)
"[ \f\t\n\r\v,]+")))
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)
(error))
(functionp #'epg-expand-group))
(setq config (epg-configuration)
recipients
(apply #'nconc
(mapcar (lambda (recipient)
(or (epg-expand-group config recipient)
(list recipient)))
recipients))))
(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)
(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 (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 (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)
(if mml1991-cache-passphrase
(epg-context-set-passphrase-callback
context
#'mml1991-epg-passphrase-callback))
(condition-case error
(setq cipher
(epg-encrypt-string context (buffer-string) recipients sign)
mml1991-epg-secret-key-id-list nil)
(error
(while mml1991-epg-secret-key-id-list
(password-cache-remove (car mml1991-epg-secret-key-id-list))
(setq mml1991-epg-secret-key-id-list
(cdr mml1991-epg-secret-key-id-list)))
(signal (car error) (cdr error))))
(let ((cipher (mml-secure-epg-encrypt 'OpenPGP cont sign)))
(delete-region (point-min) (point-max))
(insert "\n" cipher))
t)
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment