[Pgp-tools-commit] r865 - trunk/caff

[Guilhem Moulin]

Author: guilhem-guest
Date: 2016-07-12 15:15:11 +0000 (Tue, 12 Jul 2016)
New Revision: 865

Modified:
   trunk/caff/caff
Log:
caff: refactor key listing to detect collisions between a invalid and a valid key.

Modified: trunk/caff/caff
===================================================================
--- trunk/caff/caff	2016-07-11 22:36:21 UTC (rev 864)
+++ trunk/caff/caff	2016-07-12 15:15:11 UTC (rev 865)
@@ -1623,28 +1623,16 @@
     # process the keys one by one so we can detect collisions
     my $pid = $gpg->list_public_keys( handles => $handles, command_args => [$keyid] );
 
+    my @matching_keys;
     while (readline $handles->{stdout}) {
         if (/^pub:([^:]+):(?:[^:]*:){2}([0-9A-F]{16}):(?:[^:]*:){6}([^:]+)/) {
-            if (exists $KEYS{$keyid}) {
-                mywarn( "More than one key matched $keyid (assuming $KEYS{$keyid}->{fpr}).  "
-                      . "Try to specify the long keyid or full fingerprint to avoid collisions.");
-                last;
-            } elsif ($1 =~ /[eir]/ or $3 =~ /D/ ) {
-                mywarn("Ignoring unusable key $keyid");
-                last;
-            }
-            $KEYS{$keyid} = { longkeyid => $2, flags => $3, uids => [], subkeys => [] };
+            push @matching_keys, { validity => $1, longkeyid => $2, capability => $3, uids => [], subkeys => [] };
         }
-        elsif (/^fpr:(?:[^:]*:){8}([0-9A-F]{40})(?::.*)?$/) {
-            $KEYS{$keyid}->{fpr} = $1;
+        elsif (/^fpr:(?:[^:]*:){8}([0-9A-F]{40}|[0-9A-F]{32})(?::.*)?$/) {
+            $matching_keys[$#matching_keys]->{fpr} //= $1;
         }
-        elsif (/^fpr:(?:[^:]*:){8}([0-9A-F]{32})(?::.*)?$/) {
-            mywarn("Ignoring v3 key $keyid.  v3 keys are obsolete.");
-            delete $KEYS{$keyid};
-            last;
-        }
         elsif (/^sub:[^:]+:(?:[^:]*:){2}([0-9A-F]{16}):/) {
-            push @{$KEYS{$keyid}->{subkeys}}, $1;
+            push @{$matching_keys[$#matching_keys]->{subkeys}}, $1;
         }
         elsif (/^(uid|uat):([^:]+):(?:[^:]*:){5}([0-9A-F]{40}):[^:]*:([^:]+)/) {
             my $uid = { type => $1
@@ -1656,7 +1644,7 @@
             # --with-colons always outputs UTF-8
             $uid->{text} = Encode::decode_utf8($uid->{text});
             $uid->{address} = email_valid $uid->{text} if $uid->{type} eq 'uid';
-            push @{$KEYS{$keyid}->{uids}}, $uid;
+            push @{$matching_keys[$#matching_keys]->{uids}}, $uid;
         }
         elsif (!/^(?:rvk|tru):/) {
             chomp;
@@ -1665,10 +1653,31 @@
     }
     done_gpg($pid, $handles);
 
-    unless (defined $KEYS{$keyid}) {
+    unless (@matching_keys) {
         mywarn("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME)");
         next;
     }
+
+    my $key;
+    foreach (@matching_keys) {
+        my $reason = $_->{fpr}        =~ /^\p{AHex}{32}$/ ? 'obsolete v3'
+                   : $_->{validity}   =~ /e/ ? 'expired'
+                   : $_->{validity}   =~ /i/ ? 'invalid'
+                   : $_->{validity}   =~ /r/ ? 'revoked'
+                   : $_->{capability} =~ /D/ ? 'disabled'
+                   : do { $key = $_; last };
+        mywarn("Ignoring $reason key $_->{fpr}");
+    }
+    mywarn( "More than one key matched $keyid (assuming $key->{fpr}).  "
+          . "Try to specify the long keyid or full fingerprint to avoid collisions.")
+      if $#matching_keys > 0 and defined $key;
+
+    if (defined $key) {
+        $KEYS{$keyid} = $key;
+    } else {
+        my $msg = "public key found with list-key $keyid";
+        mywarn( @matching_keys ? "No valid $msg" : "No $msg  (note that caff uses its own keyring in $GNUPGHOME)" );
+    }
 }
 
 unless (keys %KEYS) {
@@ -1905,7 +1914,7 @@
 for my $keyid (@KEYIDS) {
     next unless exists $KEYS{$keyid};
     my $longkeyid = $KEYS{$keyid}->{longkeyid};
-    my $can_encrypt = $KEYS{$keyid}->{flags} =~ /E/;
+    my $can_encrypt = $KEYS{$keyid}->{capability} =~ /E/;
     my @uids = @{$KEYS{$keyid}->{uids}};
 
     unless (grep {$_->{last_signed_on}} @uids) {