Added signature checks to --show-whose-key

1 files changed, 16 insertions, 4 deletions

diff --git a/kiki.hs b/kiki.hs
index e79c9f3..a71ed28 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -2141,10 +2141,22 @@ whoseKey :: RSAPublicKey -> KeyDB -> [KeyData]
 whoseKey rsakey db = filter matchkey (Map.elems db)
  where
     matchkey (KeyData k _ _ subs) =
-        not . null .  filter ismatch $ Map.elems subs
-
-    ismatch (SubKey mp sigs) = 
-       Just rsakey == rsaKeyFromPacket (packet mp)
+        not . null .  filter (ismatch k) $ Map.elems subs
+
+    ismatch k (SubKey mp sigs) = 
+          Just rsakey == rsaKeyFromPacket (packet mp)
+       && any (check (packet k) (packet mp)) sigs
+
+    check k sub (sig,_) = not . null $ do
+        s <- signatures . Message $ [k,sub,packet sig]
+        fw <- signatures_over $ verify (Message [k]) s
+        subsig <- mapMaybe backsig (unhashed_subpackets sub)
+        subsig_so <- signatures (Message [k,sub,subsig])
+        guard (  isSubkeySignature subsig_so
+              && isSameKey (topkey subsig_so) k
+              && isSameKey (subkey subsig_so) sub )
+        s2 <- signatures . Message $ [k,sub,subsig]
+        signatures_over $ verify (Message [sub]) s2
 
 kiki_usage = do
     putStr . unlines $