From 1ad8ac2d33376723e817d7dc93436b671177b055 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 2 Dec 2013 23:23:11 -0500 Subject: Save ordering information and public/private flag in origin slot of the key database. --- kiki.hs | 80 +++++++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 48 insertions(+), 32 deletions(-) diff --git a/kiki.hs b/kiki.hs index 7f55426..99ca2a6 100644 --- a/kiki.hs +++ b/kiki.hs @@ -825,8 +825,16 @@ scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret Ma updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret -type OriginFlags = () -originNil = () +data OriginFlags = OriginFlags { + originallyPublic :: Bool, + originalNum :: Int + } +origin :: Packet -> Int -> OriginFlags +origin p n = OriginFlags ispub n + where + ispub = case p of + SecretKeyPacket {} -> False + _ -> True type OriginMap = Map.Map FilePath OriginFlags data MappedPacket = MappedPacket @@ -874,55 +882,63 @@ subcomp a b = error $ unlines ["Unable to merge subs:" subcomp_m a b = subcomp (packet a) (packet b) merge :: KeyDB -> FilePath -> Message -> KeyDB -merge db filename (Message ps) = foldl mergeit db qs +merge db filename (Message ps) = foldl mergeit db (zip [0..] qs) where qs = scanPackets filename ps - asMapped p = MappedPacket p (Map.singleton filename originNil) - asSigAndTrust (p,tm) = (asMapped p,tm) + asMapped n p = MappedPacket p (Map.singleton filename (origin p n)) + asSigAndTrust n (p,tm) = (asMapped n p,tm) emptyUids = (Map.empty,Map.empty) -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets - mergeit :: KeyDB -> (Packet,Packet,(Packet,Map.Map FilePath Packet)) -> KeyDB - mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db + 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 v | isKey p && not (is_subkey p) = case v of - Nothing -> Just $ KeyData (asMapped p) [] emptyUids Map.empty + Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p]) - (Map.insert filename originNil (locations key)) ) + (Map.insert filename (origin p n) (locations key)) ) sigs uids 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 - = Just $ KeyData key sigs uids (Map.alter (mergeSubkey p) (keykey p) subkeys) + = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys) update (Just (KeyData key sigs (uids,locs) subkeys)) | isUserID p = Just $ KeyData key sigs ( Map.alter (mergeUid ptt) (uidkey p) uids - , Map.insert filename originNil locs ) + , Map.insert filename (origin p n) locs ) subkeys update (Just (KeyData key sigs uids subkeys)) = case sub of - MarkerPacket -> Just $ KeyData key (mergeSig ptt sigs) uids subkeys + MarkerPacket -> Just $ KeyData key (mergeSig n ptt sigs) uids subkeys UserIDPacket {} -> Just $ KeyData key sigs - (Map.alter (mergeUidSig ptt) (uidkey sub) (fst uids) - ,Map.insert filename originNil (snd uids)) + (Map.alter (mergeUidSig n ptt) (uidkey sub) (fst uids) + ,Map.insert filename (origin p n) (snd uids)) subkeys _ | isKey sub -> Just $ KeyData key sigs uids - (Map.alter (mergeSubSig ptt) (keykey sub) subkeys) + (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 + mergeit _ (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p - mergeSubkey :: Packet -> Maybe SubKey -> Maybe SubKey - mergeSubkey p Nothing = Just $ SubKey (asMapped p) [] - mergeSubkey p (Just (SubKey key sigs)) = Just $ + mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey + mergeSubkey n p Nothing = Just $ SubKey (asMapped n p) [] + mergeSubkey n p (Just (SubKey key sigs)) = Just $ SubKey (MappedPacket (minimumBy subcomp [packet key,p]) - (Map.insert filename originNil (locations key))) + (Map.insert filename (origin p n) (locations key))) sigs mergeUid (UserIDPacket s,_) Nothing = Just [] @@ -932,37 +948,37 @@ merge db filename (Message ps) = foldl mergeit db qs whatP (a,_) = concat . take 1 . words . show $ a - mergeSig :: (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust] - mergeSig sig sigs = + mergeSig :: Int -> (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust] + mergeSig n sig sigs = let (xs,ys) = break (isSameSig sig) sigs first f (x,y) = (f x,y) in if null ys - then sigs++[first asMapped sig] + then sigs++[first (asMapped n) sig] else let y:ys'=ys - in xs ++ (mergeSameSig sig y : ys') + in xs ++ (mergeSameSig n sig y : ys') isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b = a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] } isSameSig (a,_) (MappedPacket b _,_) = a==b - mergeSameSig :: (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap) - mergeSameSig (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b = + mergeSameSig :: Int -> (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap) + mergeSameSig n (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b = ( MappedPacket (b { unhashed_subpackets = foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) }) - (Map.insert filename originNil locs) + (Map.insert filename (origin a n) locs) , tb `Map.union` ta ) where mergeItem ys x = if x `elem` ys then ys else ys++[x] - mergeSameSig a b = trace ("discarding dup "++show a) b + mergeSameSig n a b = trace ("discarding dup "++show a) b - mergeUidSig sig (Just sigs) = Just $ mergeSig sig sigs - mergeUidSig sig Nothing = Just [asSigAndTrust sig] + mergeUidSig n sig (Just sigs) = Just $ mergeSig n sig sigs + mergeUidSig n sig Nothing = Just [asSigAndTrust n sig] - mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs) - mergeSubSig sig Nothing = error $ + 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) flattenKeys :: Bool -> KeyDB -> Message -- cgit v1.2.3