From fb4df37348a4502407f6e3900648595ec7e231b8 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 1 May 2014 22:06:17 -0400 Subject: refactoring (preparing heigenic design of non-spilling keyrings) --- KeyRing.hs | 61 +++++++++++++++++++++++++++++++------------------------------ 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index c99a2f5..3eba3de 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -1089,16 +1089,12 @@ buildKeyDB doDecrypt ctx grip0 keyring = do guard (isring $ typ stream) resolveInputFile ctx f - filesAccs isring = do - (f,stream) <- Map.toList (kFiles keyring) - guard (isring $ typ stream) - -- n <- resolveInputFile ctx f - return (f, access stream) + (ringMap,nonRingMap) = Map.partition (isring . typ) $ kFiles keyring - readp (f,acc) = fmap readp0 $ readPacketsFromFile ctx f + readp f stream = fmap readp0 $ readPacketsFromFile ctx f where - readp0 ps = ((f,acc'),ps) - where acc' = case acc of + readp0 ps = (stream { access = acc' }, ps) + where acc' = case access stream of AutoAccess -> case ps of Message ((PublicKeyPacket {}):_) -> Pub @@ -1121,22 +1117,25 @@ buildKeyDB doDecrypt ctx grip0 keyring = do -- KeyRings (todo: KikiCondition reporting?) (db_rings,mwk,grip,accs) <- do - ms <- mapM readp (filesAccs isring) + ringPackets <- Map.traverseWithKey readp ringMap + let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message) + let grip = grip0 `mplus` (fingerprint <$> fstkey) where - fstkey = listToMaybe $ mapMaybe isSecringKey ms - where isSecringKey ((HomeSec,_),Message ps) - = listToMaybe ps - isSecringKey _ = Nothing - db_rings = foldl' mergeIt Map.empty ms - where mergeIt db ((f,_),ps) = merge db f ps + fstkey = do + (_,Message ps) <- Map.lookup HomeSec ringPackets + listToMaybe ps + (spilled,unspilled) = Map.partition (spillable . fst) ringPackets + db_rings = Map.foldlWithKey mergeIt Map.empty ringPackets + where mergeIt db f (_,ps) = merge db f ps wk = listToMaybe $ do fp <- maybeToList grip - elm <- Map.toList db_rings - guard $ matchSpec (KeyGrip fp) elm - return $ keyMappedPacket (snd elm) - accs = map (first (concat . resolveInputFile ctx) . fst) ms - return (db_rings,wk,grip,Map.fromList accs) + (kk,kd) <- Map.toList db_rings + guard $ matchSpec (KeyGrip fp) (kk,kd) + return $ keyMappedPacket kd + accs = Map.mapKeys (concat . resolveInputFile ctx) + $ fmap (access . fst) ringPackets + return (db_rings,wk,grip,accs) let wk = fmap packet mwk @@ -1740,7 +1739,7 @@ performManipulations doDecrypt operation rt wk = do , Packet ) -- key who signed ] vs = do - x <- maybeToList $ Map.lookup uid (rentryUids kd) + x <- maybeToList $ Map.lookup uid (keyUids kd) sig <- map (packet . fst) (fst x) o <- overs sig k <- keys @@ -1755,7 +1754,7 @@ performManipulations doDecrypt operation rt wk = do let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x , om `Map.union` snd x ) - return $ KikiSuccess $ kd { rentryUids = Map.adjust f uid (rentryUids kd) } + return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) } initializeMissingPEMFiles :: KeyRingOperation @@ -2297,14 +2296,14 @@ type SigAndTrust = ( MappedPacket type KeyKey = [ByteString] data SubKey = SubKey MappedPacket [SigAndTrust] --- | This is a roster entry, it's poorly named +-- | This is a GPG Identity. It's poorly named -- but we are keeping the name around until -- we're sure we wont be cutting and pasting --- code with master any more +-- code with master any more. data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key - , rentrySigAndTrusts :: [SigAndTrust] -- sigs on main key - , rentryUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids - , rentrySubKeys :: (Map.Map KeyKey SubKey) -- subkeys + , keySigAndTrusts :: [SigAndTrust] -- sigs on main key + , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids + , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys } type KeyDB = Map.Map KeyKey KeyData @@ -2324,9 +2323,11 @@ mappedPacket filename p = MappedPacket keykey :: Packet -> KeyKey keykey key = - -- Note: The key's timestamp is included in it's fingerprint. - -- Therefore, the same key with a different timestamp is - -- considered distinct using this keykey implementation. + -- Note: The key's timestamp is normally included in it's fingerprint. + -- This is undesirable for kiki because it causes the same + -- key to be imported multiple times and show as apparently + -- distinct keys with different fingerprints. + -- Thus, we will remove the timestamp. fingerprint_material (key {timestamp=0}) -- TODO: smaller key? uidkey :: Packet -> String -- cgit v1.2.3