mml2015-epg-sign do not use from header

[Daniel Dehennin <daniel.dehennin@baby-gnu.org>]

[-- Attachment #1.1: Type: text/plain, Size: 1251 bytes --]

Hello,

I'm using EasyPG backend to mml2015 and see that the from header is
not used for mail siging.

Looking at the code I see that the sender address is not used.

I create 3 new functions and use them to simplify/correct
mml2015-epg-sign and mml2015-epg-encrypt behavior.
 
Here is my changelog:

  * lisp/mml2015.el (mml2015-epg-split-addresses): Split a string of
    addresses delimited by "[ \f\t\n\r\v,]+".
    (mml2015-epg-prompt-select-key): Wrapper around epa-select-keys for
    prompting the keys to use.
    (mml2015-epg-choose-key): Choose keys for a certain usage for a list of
    names. Names are mail addresses used by epg to narrow selection.

  * lisp/mml2015.el (mml2015-epg-sign): Use sender for signing, get first
    address if From filed contains more that one.
    Change variable name to reflect the use of only one address for signin.
    Use mml2015-epg-choose-key.

  * lisp/mml2015.el (mml2015-epg-encrypt): Fetch one sender
    from (message-options-get 'message-sender).
    Fetch recipients from (message-options-get 'message-recipients).
    Use mml2015-epg-choose-key.


Regards.
-- 
Daniel Dehennin
Récupérer ma clef GPG:
gpg --keyserver pgp.mit.edu --recv-keys 0x6A2540D1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Use from header for signing with epg --]
[-- Type: text/x-diff, Size: 8230 bytes --]

=== 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


[-- Attachment #2: Type: application/pgp-signature, Size: 196 bytes --]