Fixed per-file autosign.

1 files changed, 80 insertions, 42 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index 04ac7c6..bb8b598 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -1469,6 +1469,7 @@ buildKeyDB ctx grip0 keyring = do
                 isgen (Generate _ _) _ = True
                 isgen _              _ = False
 
+        readp :: InputFile -> StreamInfo -> IO (StreamInfo, Message)
         readp f stream = fmap readp0 $ readPacketsFromFile ctx f
          where
           readp0 ps = (stream { access = acc' }, ps)
@@ -1533,7 +1534,7 @@ buildKeyDB ctx grip0 keyring = do
                     acc = Just Sec /= Map.lookup f accs
                 r <- performManipulations doDecrypt rt1 mwk manip
                 try r $ \(rt2,report) -> do
-                return $ KikiSuccess (report,(info,flattenKeys acc $ rtKeyDB rt2))
+                return $ KikiSuccess (report,rtKeyDB rt2)
 #if MIN_VERSION_containers(0,5,0)
         in fmap sequenceA $ Map.traverseWithKey trans spilled
 #else
@@ -1542,7 +1543,7 @@ buildKeyDB ctx grip0 keyring = do
     try transformed0 $ \transformed -> do
     let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
                     where
-                      mergeIt db f (_,(info,ps)) = merge db f ps
+                      mergeIt db f (_,dbtrans) = Map.unionWith mergeKeyData  db dbtrans
         reportTrans = concat $ Map.elems $ fmap fst transformed
 
     -- Wallets
@@ -3288,25 +3289,63 @@ merge_ :: KeyDB -> FilePath -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))
                 -> KeyDB
 merge_ db filename qs = foldl mergeit db (zip [0..] qs)
  where
-    asMapped n p = mappedPacketWithHint filename p n
-    asSigAndTrust n (p,tm) = (asMapped n p,tm)
-    emptyUids = Map.empty
     -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets
     mergeit :: KeyDB -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> KeyDB
-    mergeit db (n,(top,sub,ptt@(p,trustmap))) | isKey top = Map.alter update (keykey top) db
-     where
-        -- NOTE:
-        --  if a keyring file has both a public key packet and a secret key packet
-        --  for the same key, then only one of them will survive, which ever is
-        --  later in the file.
-        --
-        --  This is due to the use of statements like
-        --      (Map.insert filename (origin p n) (locations key))
-        --
-        update :: Maybe KeyData -> Maybe KeyData
-        update v | isKey p && not (is_subkey p)
+    mergeit db adding@(n,(top,sub,ptt@(p,trustmap))) | isKey top = Map.alter update (keykey top) db
+      where
+        update Nothing   = Just $ KeyData (mappedPacketWithHint filename p n) [] Map.empty Map.empty
+        update (Just kd) = dbInsertPacket kd filename adding
+    mergeit _  (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p
+
+    whatP (a,_) = concat . take 1 . words . show $ a
+
+
+
+mergeKeyData :: KeyData -> KeyData -> KeyData
+mergeKeyData (KeyData atop asigs auids asubs)
+             (KeyData btop  bsigs buids bsubs)
+    = KeyData top sigs uids subs
+ where
+    mergeMapped a b =
+        MappedPacket { packet = packet a
+                     , locations = Map.union (locations a) (locations b)
+                     }
+
+    top = mergeMapped atop btop
+
+    sigs = foldl' (flip mergeSig) asigs bsigs
+
+    uids = Map.unionWith mergeUIDSigs auids buids
+    subs = Map.unionWith mergeSub asubs bsubs
+
+    mergeSub :: SubKey -> SubKey -> SubKey
+    mergeSub (SubKey a as) (SubKey b bs) =
+        SubKey (mergeMapped a b)
+               (foldl' (flip mergeSig) as bs)
+
+    mergeUIDSigs :: ([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap)
+                    -> ([SigAndTrust],OriginMap)
+    mergeUIDSigs (as,am) (bs,bm) = (foldl' (flip mergeSig) as bs, Map.union am bm)
+
+
+dbInsertPacket :: KeyData -> FilePath -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> Maybe KeyData
+dbInsertPacket kd filename (n,(top,sub,ptt@(p,trustmap))) = update (Just kd)
+ where
+    asMapped n p = mappedPacketWithHint filename p n
+    asSigAndTrust n (p,tm) = (asMapped n p,tm)
+
+    -- NOTE:
+    --  if a keyring file has both a public key packet and a secret key packet
+    --  for the same key, then only one of them will survive, which ever is
+    --  later in the file.
+    --
+    --  This is due to the use of statements like
+    --      (Map.insert filename (origin p n) (locations key))
+    --
+    update :: Maybe KeyData -> Maybe KeyData
+    update v | isKey p && not (is_subkey p)
           = case v of
-             Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty
+             Nothing -> Just $ KeyData (asMapped n p) [] Map.empty Map.empty
              Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p
                      -> Just $ KeyData (mergeKeyPacket "master keys" key $ asMapped n p)
                                        sigs
@@ -3314,14 +3353,14 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
                                        subkeys
              _       -> error . concat $ ["Unexpected master key merge error: "
                                          ,show (fingerprint top, fingerprint p)]
-        update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
+    update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
           = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys)
-        update (Just (KeyData key sigs uids subkeys)) | isUserID p
+    update (Just (KeyData key sigs uids subkeys)) | isUserID p
           = Just $ KeyData key sigs (Map.alter (mergeUid n ptt) (uidkey p) uids)
                                     subkeys
-        update (Just (KeyData key sigs uids subkeys))
+    update (Just (KeyData key sigs uids subkeys))
           = case sub of
-             MarkerPacket    -> Just $ KeyData key (mergeSig n ptt sigs) uids subkeys
+             MarkerPacket    -> Just $ KeyData key (mergeSig (first (flip (mappedPacketWithHint filename) n) ptt) sigs) uids subkeys
              UserIDPacket {} -> Just $ KeyData key
                                                sigs
                                                (Map.alter (mergeUidSig n ptt) (uidkey sub) uids)
@@ -3331,9 +3370,7 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
                                                uids
                                                (Map.alter (mergeSubSig n ptt) (keykey sub) subkeys)
              _ -> error $ "Unexpected PGP packet 1: "++(words (show p) >>= take 1)
-        update _ = error $ "Unexpected PGP packet 2: "++(words (show p) >>= take 1)
-
-    mergeit _  (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p
+    update _ = error $ "Unexpected PGP packet 2: "++(words (show p) >>= take 1)
 
     mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey
     mergeSubkey n p Nothing                  = Just $ SubKey (asMapped n p) []
@@ -3349,37 +3386,38 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs)
     whatP (a,_) = concat . take 1 . words . show $ a
 
 
-    mergeSig :: Int -> (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust]
-    mergeSig n sig sigs =
-      let (xs,ys) = break (isSameSig sig) sigs
+    mergeUidSig n sig (Just (sigs,m)) = Just (mergeSig (first (flip (mappedPacketWithHint filename) n) sig) sigs, m)
+    mergeUidSig n sig Nothing     = Just ([asSigAndTrust n sig],Map.empty)
+
+    mergeSubSig n sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig (first (flip (mappedPacketWithHint filename) n) sig) sigs)
+    mergeSubSig n sig Nothing = error $
+        "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
+
+mergeSig :: SigAndTrust -> [SigAndTrust] -> [SigAndTrust]
+mergeSig sig sigs =
+      let (xs,ys) = break (isSameSig (first packet sig)) sigs
       in if null ys
-          then sigs++[first (asMapped n) sig]
+          then sigs++[sig] -- [first (flip (mappedPacketWithHint fname) n) sig]
           else let y:ys'=ys
-               in xs ++ (mergeSameSig n sig y : ys')
+               in xs ++ (mergeSameSig sig y : ys')
      where
         isSameSig (a,_) (MappedPacket {packet=b},_) | isSignaturePacket a && isSignaturePacket b =
             a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] }
         isSameSig (a,_) (MappedPacket {packet=b},_) = a==b
 
-        mergeSameSig :: Int -> (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap)
-        mergeSameSig n (a,ta) (m@(MappedPacket{packet=b,locations=locs}),tb)
-          | isSignaturePacket a && isSignaturePacket b =
+        mergeSameSig :: (MappedPacket,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap)
+        mergeSameSig (a,ta) (m@(MappedPacket{packet=b,locations=locs}),tb)
+          | isSignaturePacket (packet a) && isSignaturePacket b =
                 ( m { packet = b { unhashed_subpackets =
-                                      union (unhashed_subpackets b) (unhashed_subpackets a)
+                                      union (unhashed_subpackets b) (unhashed_subpackets $ packet a)
                                  }
-                   , locations = Map.insert filename (origin a n) locs }
+                   , locations = Map.union (locations a) locs } -- Map.insert fname (origin a n) locs }
                 -- TODO: when merging items, we should delete invalidated origins
                 -- from the orgin map.
                 , tb `Map.union` ta )
 
-        mergeSameSig n a b = b -- trace ("discarding dup "++show a) b
+        mergeSameSig a b = b -- trace ("discarding dup "++show a) b
 
-    mergeUidSig n sig (Just (sigs,m)) = Just (mergeSig n sig sigs, m)
-    mergeUidSig n sig Nothing     = Just ([asSigAndTrust n sig],Map.empty)
-
-    mergeSubSig n sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig n sig sigs)
-    mergeSubSig n sig Nothing = error $
-        "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
 
 unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket]
 unsig fname isPublic (sig,trustmap) =