From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/68227 Path: news.gmane.org!not-for-mail From: Daniel Dehennin Newsgroups: gmane.emacs.gnus.general Subject: [PATCH] Permit to select a key if more than one match a mail address. Date: Wed, 28 Jan 2009 13:03:03 +0100 Message-ID: <874ozj3afc.fsf@hati.baby-gnu.org> References: <87d4e7skx6.fsf@hati.baby-gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1233144215 10566 80.91.229.12 (28 Jan 2009 12:03:35 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 28 Jan 2009 12:03:35 +0000 (UTC) To: ding@gnus.org Original-X-From: ding-owner+M16668@lists.math.uh.edu Wed Jan 28 13:04:49 2009 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by lo.gmane.org with esmtp (Exim 4.50) id 1LS99q-0000nP-4d for ding-account@gmane.org; Wed, 28 Jan 2009 13:04:38 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1LS98U-0006TM-7q; Wed, 28 Jan 2009 06:03:14 -0600 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1LS98S-0006T3-OC for ding@lists.math.uh.edu; Wed, 28 Jan 2009 06:03:12 -0600 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx1.math.uh.edu with esmtp (Exim 4.69) (envelope-from ) id 1LS98P-0001jM-2f for ding@lists.math.uh.edu; Wed, 28 Jan 2009 06:03:12 -0600 Original-Received: from zion.asgardr.info ([82.233.222.74]) by quimby.gnus.org with esmtp (Exim 3.36 #1 (Debian)) id 1LS98h-0006fR-00 for ; Wed, 28 Jan 2009 13:03:27 +0100 Original-Received: from hati.asgardr.info ([192.168.1.2] helo=hati.baby-gnu.org) by zion.asgardr.info with esmtp (Exim 4.69) (envelope-from ) id 1LS98J-0006CK-Fq for ding@gnus.org; Wed, 28 Jan 2009 13:03:03 +0100 Original-Received: from dad by hati.baby-gnu.org with local (Exim 4.69) (envelope-from ) id 1LS98J-000343-EP for ding@gnus.org; Wed, 28 Jan 2009 13:03:03 +0100 Organisation: Dark Church of Emacs User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.0.60 (gnu/linux) X-Spam-Score: -1.6 (-) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:68227 Archived-At: --=-=-= ------------------------------------------------------------ revno: 123 committer: Daniel Dehennin branch nick: gnus.mml2015 timestamp: Wed 2009-01-28 02:09:27 +0100 message: Permit to select a key if more than one match a mail address. * lisp/mml2015.el (mml2015-epg-prompt-if-mutli-keys): New variable. (mml2015-epg-choose-keys): If a name has more than one key and if the user want it, prompt to select the one to use. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=Gnus123.patch # Bazaar merge directive format 2 (Bazaar 0.90) # revision_id: daniel.dehennin@baby-gnu.org-20090128010927-\ # 26t6dicbleuq378h # target_branch: ../../gnus.head # testament_sha1: 8f60d6ad2c8071a47704d48d5223b7dad88f9dcd # timestamp: 2009-01-28 13:02:57 +0100 # source_branch: . # base_revision_id: daniel.dehennin@baby-gnu.org-20090126152327-\ # ccpvwbbxys1zto9f # # Begin patch === modified file 'lisp/mml2015.el' --- lisp/mml2015.el 2009-01-22 07:02:15 +0000 +++ lisp/mml2015.el 2009-01-28 01:09:27 +0000 @@ -990,6 +990,11 @@ (defvar mml2015-epg-secret-key-id-list nil) +(defvar mml2015-epg-prompt-if-mutli-keys t + "If t, the default, and there is more than one key to sign or encrypt a +message, call mml2015-epg-prompt-select-key to select which one to choose. +If nil, do not prompt for a key, usually, the first one will be used.") + (defun mml2015-epg-passphrase-callback (context key-id ignore) (if (eq key-id 'SYM) (epg-passphrase-callback-function context key-id nil) @@ -1025,6 +1030,87 @@ (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,]+." + (apply #'nconc + (mapcar + (lambda (recipient) + (or (epg-expand-group config recipient) + (list (concat "<" recipient ">")))) + (split-string + (or addresses + (read-string "Addresses: ")) + "[ \f\t\n\r\v,]+")))) + +(defun mml2015-epg-prompt-select-keys (context &optional names 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) + names key-type))) + +(defun mml2015-epg-choose-keys (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"))) + key) + (if names + (delq t + (delq nil + (mapcar + (lambda (name) + (if (and + ;; Fail to fetch a key + (not (setq key + ;; Does name have any key ? + (and (epg-list-keys context name key-type) + (or (and (not mml2015-verbose) + ;; prompt if more than one key ? + (or (= 1 + (length (epg-list-keys context name key-type))) + (not mml2015-epg-prompt-if-multi-keys)) + (mml2015-epg-find-usable-key + (epg-list-keys context name key-type) + usage)) + (mml2015-epg-find-usable-key + (mml2015-epg-prompt-select-keys context name usage) + usage) + ;; Avoid error if the user don't select a + ;; key because epa-select-keys returns nil + t)))) + ;; No key, ask to abord + (y-or-n-p + (format + "No %s key for %s; abort? " + key-type-name name))) + (error "No %s key for %s: aborted" key-type-name name)) + key) + names)))))) + (defun mml2015-epg-decrypt (handle ctl) (catch 'error (let ((inhibit-redisplay t) @@ -1182,35 +1268,20 @@ (let* ((inhibit-redisplay t) (context (epg-make-context)) (boundary (mml-compute-boundary cont)) - signer-key - (signers - (or (message-options-get 'mml2015-epg-signers) + (config (epg-configuration)) + (sender (list (car + (mml2015-epg-split-addresses + config + (message-options-get 'message-sender))))) + (signer + (or (message-options-get 'mml2015-epg-signer) (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))))))) + 'mml2015-epg-signer + (mml2015-epg-choose-keys context sender 'sign)))) signature micalg) (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 +1320,34 @@ (let ((inhibit-redisplay t) (context (epg-make-context)) (config (epg-configuration)) + (sender (list (car + (mml2015-epg-split-addresses + config + (message-options-get 'message-sender))))) (recipients (message-options-get 'mml2015-epg-recipients)) - cipher signers - (boundary (mml-compute-boundary cont)) - recipient-key signer-key) + cipher signer + (boundary (mml-compute-boundary cont))) (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,]+")))) + (mml2015-epg-split-addresses + config + (message-options-get 'message-recipients))) (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"))) + (unless sender + (error "Message sender not set")) + (setq recipients (nconc recipients sender))) + (setq recipients + (mml2015-epg-choose-keys context recipients 'encrypt)) + (unless recipients + (error "No recipient specified")) (message-options-set 'mml2015-epg-recipients recipients)) (when sign - (setq signers - (or (message-options-get 'mml2015-epg-signers) + (setq signer + (or (message-options-get 'mml2015-epg-signer) (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)) + 'mml2015-epg-signer + (mml2015-epg-choose-keys 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 --=-=-=--