Re: [BUG] mml2015-epg-find-usable-key finds unusable key

[Daiki Ueno <ueno@gnu.org>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=iso-2022-jp-2, Size: 4850 bytes --]

^[$(D)(^[(Bukasz Stelmach <stlman@poczta.fm> writes:

> It looks like there is a sort of bug in mml2015-epg-encrypt at line
> 1117.
>
> http://git.gnus.org/cgit/gnus.git/tree/lisp/mml2015.el?id=6e422932976e94d6dbb7ad602c5be3eb481fe46c#n1117)
>
> The whole form that begins at line 1113 converts list of recipients
> provided as email addresses, key IDs or anything gpg can digest into epg
> "objects". Unfortunately there is one corner case that makes this code
> fail. That is when a key is valid but a uid on it has been revoked.

Thanks for the report.

> epg.el is a part of emacs, mml2015.el belongs to gnus. IMHO it is
> mml2015-epg-find-usable-key that should be fixed. The function should
> accept and additional (optional?) parameter with a recipient uid as
> passed to epg-list-keys and reject keys with all uids matching the
> recipient parameter revoked.

Sounds reasonable.  I plan to apply the attached patch.

Regards,
-- 
Daiki Ueno
From 9440de44c8dc03a5b77e662539d3d388f6718549 Mon Sep 17 00:00:00 2001
From: Daiki Ueno <ueno@gnu.org>
Date: Fri, 15 Feb 2013 12:58:09 +0900
Subject: [PATCH] mml2015.el (mml2015-epg-find-usable-key): handle revoked
 user-id

---
 lisp/ChangeLog  |  9 +++++++++
 lisp/mml2015.el | 57 +++++++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 50 insertions(+), 16 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5edf6f6..3fda767 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2013-02-15  Daiki Ueno  <ueno@gnu.org>
+
+	* mml2015.el (mml2015-epg-check-user-id): New function.
+	(mml2015-epg-check-sub-key): New function split from
+	mml2015-epg-find-usable-key.
+	(mml2015-epg-find-usable-key): Accept context, recipient, and usage, to
+	handle the case when user-id is unusable (all callers changed).
+	Reported by ^[$(D)(^[(Bukasz Stelmach <stlman@poczta.fm>.
+
 2013-02-14  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* gnus-util.el (gnus-define-keys): Convert [?\S-\ ] to [(shift space)]
diff --git a/lisp/mml2015.el b/lisp/mml2015.el
index 275a486..6310ff3 100644
--- a/lisp/mml2015.el
+++ b/lisp/mml2015.el
@@ -786,21 +786,47 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
 	      (cons password-cache-key-id mml2015-epg-secret-key-id-list))
 	(copy-sequence passphrase)))))
 
-(defun mml2015-epg-find-usable-key (keys usage)
-  (catch 'found
+(defun mml2015-epg-check-user-id (key recipient)
+  (let ((pointer (epg-key-user-id-list key))
+	result)
+    (while pointer
+      (if (and (equal (car (mail-header-parse-address
+			    (epg-user-id-string (car pointer))))
+		      (car (mail-header-parse-address
+			    recipient)))
+	       (not (memq (epg-user-id-validity (car pointer))
+			  '(revoked expired))))
+	  (setq result t
+		pointer nil)
+	(setq pointer (cdr pointer))))
+    result))
+
+(defun mml2015-epg-check-sub-key (key usage)
+  (let ((pointer (epg-key-sub-key-list key))
+	result)
+    ;; 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))))
+ 	    (setq result t
+		  pointer nil)
+	  (setq pointer (cdr pointer)))))
+    result))
+
+(defun mml2015-epg-find-usable-key (context recipient usage)
+  (let ((keys (epg-list-keys context recipient))
+	key)
     (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)))))
+      (if (and (mml2015-epg-check-user-id (car keys) recipient)
+	       (mml2015-epg-check-sub-key (car keys) usage))
+	  (setq key (car keys)
+		keys nil)
+	(setq keys (cdr keys))))
+    key))
 
 ;; XXX: since gpg --list-secret-keys does not return validity of each
 ;; key, `mml2015-epg-find-usable-key' defined above is not enough for
@@ -1115,8 +1141,7 @@ If no one is selected, symmetric encryption will be performed.  "
 		    (mapcar
 		     (lambda (recipient)
 		       (setq recipient-key (mml2015-epg-find-usable-key
-					    (epg-list-keys context recipient)
-					    'encrypt))
+					    context recipient 'encrypt))
 		       (unless (or recipient-key
 				   (y-or-n-p
 				    (format "No public key for %s; skip it? "
-- 
1.8.1.2