Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-23 05:17:35 +00:00
Code Issues Projects Releases Packages Wiki Activity

lisp/gnus/mml-smime.el: Support signing by sender.

Browse source
This commit is contained in:
Daiki Ueno 2013-01-07 12:59:02 +09:00
parent 84f6744ab7
commit 38eba8dfc4
2 changed files with 56 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lisp/gnus/ChangeLog
View file

@ -1,3 +1,13 @@
2013-01-07 Daiki Ueno <ueno@gnu.org>
* mml-smime.el: Support signing by sender.
Requested by Uwe Brauer.
(mml-smime-sign-with-sender): New user option analogous
to mml2015-sign-with-sender.
(mml-smime-epg-sign): Respect mml-smime-sign-with-sender.
(mml-smime-epg-find-usable-secret-key): New helper function copied from
mml2015.el.
2012-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-msg.el (gnus-inews-insert-gcc): Don't insert Gcc headers if Gnus

62
lisp/gnus/mml-smime.el
View file

@ -74,6 +74,11 @@ Whether the passphrase is cached at all is controlled by
:group 'mime-security
:type '(repeat (string :tag "Key ID")))
(defcustom mml-smime-sign-with-sender nil
"If t, use message sender so find a key to sign with."
:group 'mime-security
:type 'boolean)
(defun mml-smime-sign (cont)
(let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))
(if func
@ -366,6 +371,24 @@ Whether the passphrase is cached at all is controlled by
(setq pointer (cdr pointer))))
(setq keys (cdr keys)))))
;; XXX: since gpg --list-secret-keys does not return validity of each
;; key, `mml-smime-epg-find-usable-key' defined above is not enough for
;; secret keys. The function `mml-smime-epg-find-usable-secret-key'
;; below looks at appropriate public keys to check usability.
(defun mml-smime-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 (mml-smime-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))
(autoload 'mml-compute-boundary "mml")
;; We require mm-decode, which requires mm-bodies, which autoloads
@ -376,29 +399,36 @@ Whether the passphrase is cached at all is controlled by
(let* ((inhibit-redisplay t)
(context (epg-make-context 'CMS))
(boundary (mml-compute-boundary cont))
(sender (message-options-get 'message-sender))
(signer-names (or mml-smime-signers
(if (and mml-smime-sign-with-sender sender)
(list (concat "<" sender ">")))))
signer-key
(signers
(or (message-options-get 'mml-smime-epg-signers)
(message-options-set
'mml-smime-epg-signers
(if (eq mm-sign-option 'guided)
(epa-select-keys context "\
'mml-smime-epg-signers
(if (eq mm-sign-option 'guided)
(epa-select-keys context "\
Select keys for signing.
If no one is selected, default secret key is used. "
mml-smime-signers t)
(if mml-smime-signers
(mapcar
(lambda (signer)
(setq signer-key (mml-smime-epg-find-usable-key
(epg-list-keys context signer t)
'sign))
(unless (or signer-key
(y-or-n-p
(format "No secret key for %s; skip it? "
signer-names
t)
(if (or sender mml-smime-signers)
(delq nil
(mapcar
(lambda (signer)
(setq signer-key
(mml-smime-epg-find-usable-secret-key
context signer 'sign))
(unless (or signer-key
(y-or-n-p
(format
"No secret key for %s; skip it? "
signer)))
(error "No secret key for %s" signer))
signer-key)
mml-smime-signers))))))
(error "No secret key for %s" signer))
signer-key)
signer-names)))))))
signature micalg)
(epg-context-set-signers context signers)
(if mml-smime-cache-passphrase