From acdda18dfd2357f8bf6d7a12d793ca46f22a89c6 Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 3 Dec 2013 19:18:37 -0500 Subject: Progress toward writting out keyring files. --- kiki.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 62 insertions(+), 21 deletions(-) diff --git a/kiki.hs b/kiki.hs index 99ca2a6..dd487da 100644 --- a/kiki.hs +++ b/kiki.hs @@ -243,8 +243,8 @@ backsig _ = Nothing isSubkeySignature (SubkeySignature {}) = True isSubkeySignature _ = False -isMasterKey k@(PublicKeyPacket {}) = not $ is_subkey k -isMasterKey _ = False +isPublicMaster k@(PublicKeyPacket {}) = not $ is_subkey k +isPublicMaster _ = False now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime @@ -829,6 +829,7 @@ data OriginFlags = OriginFlags { originallyPublic :: Bool, originalNum :: Int } + deriving Show origin :: Packet -> Int -> OriginFlags origin p n = OriginFlags ispub n where @@ -970,6 +971,8 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs) , tb `Map.union` ta ) where + -- TODO: when merging items, we should delete invalidated origins + -- from the orgin map. mergeItem ys x = if x `elem` ys then ys else ys++[x] mergeSameSig n a b = trace ("discarding dup "++show a) b @@ -982,22 +985,8 @@ merge db filename (Message ps) = foldl mergeit db (zip [0..] qs) "Unable to merge subkey signature: "++(words (show sig) >>= take 1) flattenKeys :: Bool -> KeyDB -> Message -flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db) +flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop isPublic . snd) (prefilter . Map.assocs $ db) where - flattenTop (_,(KeyData key sigs uids subkeys)) = - unk key : ( concatMap flattenUid (Map.assocs (fst uids)) - ++ concatMap flattenSub (Map.assocs subkeys)) - - flattenUid (str,sigs) = UserIDPacket str : concatMap unsig sigs - - flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs - - 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 @@ -1007,7 +996,58 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs _)) = True isSecret _ = False -writeOutKeyrings db = return () -- TODO + +flattenTop :: Bool -> KeyData -> [MappedPacket] +flattenTop ispub (KeyData key sigs uids subkeys) = + unk ispub key : ( concatMap (flattenUid ispub (snd uids)) (Map.assocs (fst uids)) + ++ concatMap (flattenSub ispub) (Map.elems subkeys)) + +flattenUid :: Bool -> OriginMap -> (String,[SigAndTrust]) -> [MappedPacket] +flattenUid ispub om (str,sigs) = MappedPacket (UserIDPacket str) om : concatMap (unsig ispub) sigs + +flattenSub :: Bool -> SubKey -> [MappedPacket] +flattenSub ispub (SubKey key sigs) = unk ispub key: concatMap (unsig ispub) sigs + +unk :: Bool -> MappedPacket -> MappedPacket +unk isPublic = if isPublic then toPacket secretToPublic else id + where toPacket f (MappedPacket p m) = MappedPacket (f p) m +unsig :: Bool -> SigAndTrust -> [MappedPacket] +unsig isPublic (sig,trustmap) = [sig]++ map (flip MappedPacket Map.empty) ( take 1 . Map.elems $ Map.filterWithKey f trustmap) + where + f "%secring" _ = not isPublic + f _ _ = isPublic + +ifSecret (SecretKeyPacket {}) t f = t +ifSecret _ t f = f + +showPacket :: Packet -> String +showPacket p | isKey p = (if is_subkey p + then showPacket0 p + else ifSecret p "----Secret-----" "----Public-----") + ++ " "++ fingerprint p + | isUserID p = showPacket0 p ++ " " ++ show (uidkey p) + | otherwise = showPacket0 p +showPacket0 p = concat . take 1 $ words (show p) + +writeOutKeyrings db = do + let ks = Map.elems db + fs = Map.keys (foldr unionfiles Map.empty ks) + where unionfiles (KeyData p _ _ _) m = + Map.union m (locations p) + fromfile f (KeyData p _ _ _) = Map.member f $ locations p + let s = do + f <- fs + let x = do + d@(KeyData p _ _ _) <- filter (fromfile f) ks + n <- maybeToList $ Map.lookup f (locations p) + flattenTop (originallyPublic n) d + changes = filter notnew x + where notnew p = isNothing (Map.lookup f $ locations p) + unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++ + ( "CHANGES: " : map ((" "++) . showPacket . packet) changes) + putStrLn s + -- putStrLn $ "fs = " ++ show fs + return () -- TODO data Arguments = Cross_Merge { homedir :: Maybe FilePath @@ -1091,7 +1131,7 @@ main = do uidScan pub = scanl (\(mkey,u) w -> case () of - _ | isMasterKey w -> (w,u) + _ | isPublicMaster w -> (w,u) _ | isUserID w -> (mkey,w) _ | otherwise -> (mkey,u) ) @@ -1222,7 +1262,7 @@ main = do cleanup (_,(topkey,_,pkt)) = (topkey,pkt) putStrLn $ "-------- signed ------> " -- ++ show (length pub, length pub') putStrLn "" - putStrLn $ listKeysFiltered (map fingerprint (filter isMasterKey pub')) (sec++pub') + putStrLn $ listKeysFiltered (map fingerprint (filter isPublicMaster pub')) (sec++pub') let signed_bs = encode (Message pub') L.writeFile (output cmd) signed_bs @@ -1435,7 +1475,8 @@ existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_ putStrLn "Adding valid signature to existing key..." newKey wkun wk [pk] tag pre uids (trail++prepk++remainder) output_file grip (sig,ov):vs -> do - -- TODO: update sig to contain usage@ = tag + -- sig exists. + -- update sig to contain usage@ = tag let hs = filter (\p->isNotation p && notation_name p=="usage@") (hashed_subpackets sig) ks = map notation_value hs isNotation (NotationDataPacket {}) = True -- cgit v1.2.3