From a3f17512375314f1548dcbb48429bd492b88c511 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 2 Dec 2013 18:15:24 -0500 Subject: Remember packet origins in key database. --- kiki.hs | 74 +++++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 52 insertions(+), 22 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 1ea014d..bc45991 100644 --- a/kiki.hs +++ b/kiki.hs @@ -807,6 +807,7 @@ is40digitHex xs = ys == xs && length ys==40 | 'a' <= c && c <= 'f' = True ishex c = False +scanPackets :: FilePath -> [Packet] -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))] scanPackets filename [] = [] scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacket) p) ps where @@ -824,12 +825,21 @@ scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret Ma updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret -type SigAndTrust = ( Packet - , Map.Map FilePath Packet ) -- trust packets +type OriginFlags = () +originNil = () + +data MappedPacket = MappedPacket + { packet :: Packet + , locations :: Map.Map FilePath OriginFlags + } + +type TrustMap = Map.Map FilePath Packet +type SigAndTrust = ( MappedPacket + , TrustMap ) -- trust packets type KeyKey = [Char8.ByteString] -data SubKey = SubKey Packet [SigAndTrust] -data KeyData = KeyData Packet -- main key +data SubKey = SubKey MappedPacket [SigAndTrust] +data KeyData = KeyData MappedPacket -- main key [SigAndTrust] -- sigs on main key (Map.Map String [SigAndTrust]) -- uids (Map.Map KeyKey SubKey) -- subkeys @@ -860,19 +870,27 @@ subcomp a b = error $ unlines ["Unable to merge subs:" , fingerprint b , PP.ppShow b ] +subcomp_m a b = subcomp (packet a) (packet b) -merge :: Map.Map KeyKey KeyData -> FilePath -> Message -> Map.Map KeyKey KeyData +merge :: KeyDB -> FilePath -> Message -> KeyDB merge db filename (Message ps) = foldl mergeit db qs where qs = scanPackets filename ps + asMapped p = MappedPacket p (Map.singleton filename originNil) + asSigAndTrust (p,tm) = (asMapped p,tm) -- 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 where update v | isKey p && not (is_subkey p) = case v of - Nothing -> Just $ KeyData p [] Map.empty Map.empty - Just (KeyData key sigs uids subkeys) | keykey key == keykey p - -> Just $ KeyData (minimumBy keycomp [key,p]) sigs uids subkeys + Nothing -> Just $ KeyData (asMapped p) [] Map.empty 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)) ) + 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 @@ -895,9 +913,12 @@ merge db filename (Message ps) = foldl mergeit db qs mergeit _ (_,_,p) = error $ "Unexpected PGP packet 3: "++whatP p - mergeSubkey p Nothing = Just $ SubKey p [] + mergeSubkey :: Packet -> Maybe SubKey -> Maybe SubKey + mergeSubkey p Nothing = Just $ SubKey (asMapped p) [] mergeSubkey p (Just (SubKey key sigs)) = Just $ - SubKey (minimumBy subcomp [key,p]) sigs + SubKey (MappedPacket (minimumBy subcomp [packet key,p]) + (Map.insert filename originNil (locations key))) + sigs mergeUid (UserIDPacket s,_) Nothing = Just [] mergeUid (UserIDPacket s,_) (Just sigs) = Just sigs @@ -906,21 +927,25 @@ 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 = let (xs,ys) = break (isSameSig sig) sigs + first f (x,y) = (f x,y) in if null ys - then sigs++[sig] + then sigs++[first asMapped sig] else let y:ys'=ys in xs ++ (mergeSameSig sig y : ys') - isSameSig (a,_) (b,_) | isSignaturePacket a && isSignaturePacket b = + isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b = a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] } - isSameSig (a,_) (b,_) = a==b + isSameSig (a,_) (MappedPacket b _,_) = a==b - mergeSameSig (a,ta) (b,tb) | isSignaturePacket a && isSignaturePacket b = - ( b { unhashed_subpackets = - foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) } + mergeSameSig :: (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap) + mergeSameSig (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) , tb `Map.union` ta ) where @@ -929,13 +954,13 @@ merge db filename (Message ps) = foldl mergeit db qs mergeSameSig a b = trace ("discarding dup "++show a) b mergeUidSig sig (Just sigs) = Just $ mergeSig sig sigs - mergeUidSig sig Nothing = Just [sig] + mergeUidSig sig Nothing = Just [asSigAndTrust sig] mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs) mergeSubSig sig Nothing = error $ "Unable to merge subkey signature: "++(words (show sig) >>= take 1) -flattenKeys :: Bool -> Map.Map KeyKey KeyData -> Message +flattenKeys :: Bool -> KeyDB -> Message flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db) where flattenTop (_,(KeyData key sigs uids subkeys)) = @@ -946,15 +971,20 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs - unk k = if isPublic then secretToPublic k else k - unsig (sig,trustmap) = [sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) + unk = (if isPublic then secretToPublic else id) . packet + unsig (sig,trustmap) = [packet sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) where f "%secring" _ = not isPublic f _ _ = isPublic prefilter = if isPublic then id else filter isSecret - where isSecret (_,(KeyData (SecretKeyPacket {}) _ _ _)) = True - isSecret _ = False + where + isSecret (_,(KeyData + (MappedPacket { packet=(SecretKeyPacket {})}) + _ + _ + _)) = True + isSecret _ = False writeOutKeyrings db = return () -- TODO -- cgit v1.2.3