1 files changed, 30 insertions, 8 deletions

diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index e7097ba..f3cd5e3 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -16,6 +16,7 @@ import Data.Ord
 import Data.OpenPGP
 import Data.OpenPGP.Util
 import Data.Word
+import qualified IntMapClass as I
 import KeyDB
 import KeyRing.Types
 import FunctorToMaybe
@@ -236,12 +237,19 @@ has_tag tag p = isSignaturePacket p
 
 
 
-verifyBindings :: [Packet] -> [Packet] -> ([SignatureOver], [SignatureOver])
-verifyBindings keys nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
+verifyBindings :: I.IMap KeyGrip [Packet] -> [Packet] -> ([SignatureOver], [SignatureOver])
+verifyBindings gmap nonkeys = (top ++ filter isSubkeySignature embedded,othersigs)
  where
     verified = do
-        sig <- signatures (Message nonkeys)
-        let v = verify (Message keys) sig
+        sigs <- signatures (Message nonkeys)
+        sig <- signatures_over sigs
+        let grip = issuerGrip sig
+            gks = concat [ ks | g <- maybeToList grip
+                              , ks <- maybeToList $ I.lookup g gmap ]
+            kmsg = Message
+                    $ if null gks then maybe (concat $ I.elems gmap) (const []) grip
+                                  else gks
+            v = verify kmsg (sigs { signatures_over = [sig] })
         guard (not . null $ signatures_over v)
         return v
     (top,othersigs) = partition isSubkeySignature verified
@@ -292,13 +300,15 @@ getBindings ::
 getBindings pkts = (sigs,bindings)
  where
     (sigs,concat->bindings) = unzip $ do
-        keys <- disjoint_fp (filter isKey pkts)
-        let (bs,sigs) = verifyBindings keys pkts
+        keys <- take 1 $ disjoint_fp (filter isKey pkts)
+        let gmap = buildGripMap keys
+            (bs,sigs) = verifyBindings gmap pkts
         return . ((keys,sigs),) $ do
             b <- bs -- trace ("sigs = "++show (map (map signature_issuer . signatures_over) sigs)) bs
             i <- map signature_issuer (signatures_over b)
             i <- maybeToList i
-            who <- maybeToList $ find_key (show . fingerprint) (Message keys) i
+            g <- maybeToList $ smallprGrip i
+            who <- take 1 $ concat $ maybeToList $ I.lookup g gmap
             let (code,claimants) =
                     case () of
                         _ | who == topkey b -> (1,[])
@@ -627,7 +637,19 @@ makeSig doDecrypt top fname subkey_p tags mbsig = do
 
 -- TODO: Use fingerprint to narrow candidates.
 candidateSignerKeys :: KeyDB -> Packet -> [Packet]
-candidateSignerKeys db sig = map keyPacket $ keyData db
+candidateSignerKeys db sig =
+    case issuerGrip sig of
+        Just g -> concatMap (map packet . associatedKeys) $ lookupByGrip g db
+        _      -> map keyPacket $ keyData db
+
+issuerGrip :: Packet -> Maybe KeyGrip
+issuerGrip sig = do
+    IssuerPacket hexfp <- find isIssuer (hashed_subpackets sig ++ unhashed_subpackets sig)
+    smallprGrip hexfp
+
+isIssuer :: SignatureSubpacket -> Bool
+isIssuer (IssuerPacket _) = True
+isIssuer _                = False
 
 performManipulations ::
                 (PacketDecrypter)