=== modified file 'lisp/mml2015.el' --- lisp/mml2015.el 2009-01-22 07:02:15 +0000 +++ lisp/mml2015.el 2009-01-25 15:04:23 +0000 @@ -1025,6 +1025,82 @@ (setq pointer (cdr pointer)))) (setq keys (cdr keys))))) +(defun mml2015-epg-split-addresses (config addresses) +"Split a string of addresses delimited by [ \f\t\n\r\v,]+." + (mapcar + (lambda (address) + (or (epg-expand-group config address) + (concat "<" address ">"))) + (split-string + (or addresses + (read-string "Addresses: ")) + "[ \f\t\n\r\v,]+"))) + +(defun mml2015-epg-prompt-select-key (context &optional name usage) +"Return a key matching NAME. +USAGE is nil or encrypt to search private keyring. +USAGE is t or sign to search secret keyring. +Mostly a wrapper around epa-select-keys." + (let ((action (cond + ((memq usage '(t sign)) "signing") + ((memq usage '(nil encrypt)) "encryption") + (t "encryption"))) + (key-type (cond + ((memq usage '(t sign)) 'secret) + ((memq usage '(nil encrypt)) 'public) + (t 'public))) + (no-selection (cond + ((memq usage '(t sign)) "default secret key is used") + ((memq usage '(nil encrypt)) "symmetric encryption will be performed") + (t "symmetric encryption will be performed")))) + (epa-select-keys context + (format "\ +Select a key for %s. +If no one is selected, %s +If more than one is select, first one is used. " + action no-selection) + name key-type))) + +(defun mml2015-epg-choose-key (context &optional names usage) +"Return a list of keys for each NAMES matching USAGE." + (let ((key-type (cond + ((memq usage '(t sign)) 'secret) + ((memq usage '(nil encrypt)) 'public) + (t 'public))) + (key-type-name (cond + ((memq usage '(t sign)) "secret") + ((memq usage '(nil encrypt)) "public") + (t "public"))) + signer-key) + (if names + (delq nil + (mapcar + (lambda (name) + (if (and + ;; Fail to fetch a key + (not (setq signer-key (or + ;; Does sender has keys ? + (and (epg-list-keys context name key-type) + (or (and (not mml2015-verbose) + (mml2015-epg-find-usable-key + (epg-list-keys context name key-type) + usage)) + (mml2015-epg-find-usable-key + (mml2015-epg-prompt-select-key context name usage) + usage))) + ;; Ask for what ever secret key we have in keyring + (mml2015-epg-find-usable-key + (mml2015-epg-prompt-select-key context nil usage) + usage)))) + ;; No key, ask for abortion + (y-or-n-p + (format + "No %s key selected for %s; abort? " + key-type name))) + (error "No %s key for %s: aborted." key-type-name name)) + signer-key) + names))))) + (defun mml2015-epg-decrypt (handle ctl) (catch 'error (let ((inhibit-redisplay t) @@ -1179,38 +1255,23 @@ (mml2015-extract-cleartext-signature)))) (defun mml2015-epg-sign (cont) - (let* ((inhibit-redisplay t) + (let ((inhibit-redisplay t) (context (epg-make-context)) + (config (epg-configuration)) (boundary (mml-compute-boundary cont)) - signer-key - (signers - (or (message-options-get 'mml2015-epg-signers) - (message-options-set - 'mml2015-epg-signers - (if mml2015-verbose - (epa-select-keys context "\ -Select keys for signing. -If no one is selected, default secret key is used. " - mml2015-signers t) - (if mml2015-signers - (delq nil - (mapcar - (lambda (signer) - (setq signer-key (mml2015-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))) - (error "No secret key for %s" signer)) - signer-key) - mml2015-signers))))))) - signature micalg) + sender signer signer-key signature micalg) + ;; Only one sender address + (setq sender (list (car (mml2015-epg-split-addresses + config + (message-options-get 'message-sender))))) + (setq signer (or + (message-options-get 'mml2015-epg-signers) + (message-options-set + 'mml2015-epg-signers + (mml2015-epg-choose-key context sender 'sign)))) (epg-context-set-armor context t) (epg-context-set-textmode context t) - (epg-context-set-signers context signers) + (epg-context-set-signers context signer) (if mml2015-cache-passphrase (epg-context-set-passphrase-callback context @@ -1249,75 +1310,35 @@ (let ((inhibit-redisplay t) (context (epg-make-context)) (config (epg-configuration)) - (recipients (message-options-get 'mml2015-epg-recipients)) - cipher signers (boundary (mml-compute-boundary cont)) - recipient-key signer-key) + sender recipients signer cipher) + ;; Only one sender + (setq sender (list (car (mml2015-epg-split-addresses + config + (message-options-get 'message-sender))))) + ;; All recipients + (setq recipients (mml2015-epg-split-addresses + config + (message-options-get 'message-recipients))) + + (when mml2015-encrypt-to-self + (if (not sender) + (error "Message sender not set")) + (setq recipients (nconc recipients sender))) + (setq recipients (or + (message-options-get 'mml2015-epg-recipients) + (message-options-set + 'mml2015-epg-recipients + (mml2015-epg-choose-key context recipients 'encrypt)))) (unless recipients - (setq recipients - (apply #'nconc - (mapcar - (lambda (recipient) - (or (epg-expand-group config recipient) - (list (concat "<" recipient ">")))) - (split-string - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+")))) - (when mml2015-encrypt-to-self - (unless mml2015-signers - (error "mml2015-signers not set")) - (setq recipients (nconc recipients mml2015-signers))) - (if mml2015-verbose - (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 (recipient) - (setq recipient-key (mml2015-epg-find-usable-key - (epg-list-keys context recipient) - 'encrypt)) - (unless (or recipient-key - (y-or-n-p - (format "No public key for %s; skip it? " - recipient))) - (error "No public key for %s" recipient)) - recipient-key) - recipients))) - (unless recipients - (error "No recipient specified"))) - (message-options-set 'mml2015-epg-recipients recipients)) + (error "No recipient specified")) (when sign - (setq signers - (or (message-options-get 'mml2015-epg-signers) - (message-options-set - 'mml2015-epg-signers - (if mml2015-verbose - (epa-select-keys context "\ -Select keys for signing. -If no one is selected, default secret key is used. " - mml2015-signers t) - (if mml2015-signers - (delq nil - (mapcar - (lambda (signer) - (setq signer-key (mml2015-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))) - (error "No secret key for %s" signer)) - signer-key) - mml2015-signers))))))) - (epg-context-set-signers context signers)) + (setq signer (or + (message-options-get 'mml2015-epg-signers) + (message-options-set + 'mml2015-epg-signers + (mml2015-epg-choose-key context sender 'sign))))) + (epg-context-set-signers context signer) (epg-context-set-armor context t) (epg-context-set-textmode context t) (if mml2015-cache-passphrase