From 7761528025b4288527c34d0bb68c71ef2e90a51a Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 15 Apr 2014 22:41:22 -0400 Subject: Use kImports for finer control of key propagation --- KeyRing.hs | 41 +++++++++++++++++++++++++---------------- kiki.hs | 2 +- 2 files changed, 26 insertions(+), 17 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 52e8f67..d5eb9ea 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -95,8 +95,11 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a) data KeyRingData = KeyRingData { kFiles :: Map.Map InputFile (RefType,FileType) - , kImports :: Map.Map FilePath (KeyData -> Bool) - -- ^ indicates what pgp packets get written to which keyring files + , kImports :: Map.Map FilePath (KeyData -> Maybe Bool) + -- ^ Indicates what pgp packets get written to which keyring files. + -- Just True = import public key + -- Just False = import secret key + -- Nothing = do not import , homeSpec :: Maybe String } @@ -864,29 +867,35 @@ writeRingKeys krd db wk secring pubring = do guard (isring ftyp) n <- resolveInputFile secring pubring f return (n,isMutable rtyp) - fromfile f (KeyData p _ _ _) = Map.member f $ locations p + fromfile f kd@(KeyData p _ _ _) = + Map.member f $ locations p + {- maybe (Map.member f $ locations p) + (\pred -> pred kd) + (Map.lookup f $ kImports krd) -} let s = do (f,mutable) <- fs let x = do - d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyMappedPacket ks) - n <- maybeToList $ Map.lookup f (locations p) - flattenTop f (originallyPublic n) d - changes = filter isnew x + let wanted kd@(KeyData p _ _ _) + = maybe (fmap originallyPublic $ Map.lookup f $ locations p) + (\pred -> pred kd) + (Map.lookup f $ kImports krd) + d <- sortByHint f keyMappedPacket ks + only_public <- maybeToList $ wanted d + flattenTop f only_public d + new_packets = filter isnew x where isnew p = isNothing (Map.lookup f $ locations p) - {- - trace (unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++ - ( "CHANGES: " : map ((" "++) . showPacket . packet) changes)) $ do - -} - guard (not $ null changes) - return ((f,mutable),(changes,x)) + guard (not $ null new_packets) + return ((f,mutable),(new_packets,x)) let (towrites,report) = (\f -> foldl f ([],[]) s) $ - \(ws,report) ((f,mutable),(changes,x)) -> + \(ws,report) ((f,mutable),(new_packets,x)) -> if mutable then - let rs = flip map changes $ \c -> (f, NewPacket $ showPacket (packet c)) + let rs = flip map new_packets + $ \c -> (f, NewPacket $ showPacket (packet c)) in (ws++[(f,x)],report++rs) else - let rs = flip map changes $ \c -> (f,MissingPacket (showPacket (packet c))) + let rs = flip map new_packets + $ \c -> (f,MissingPacket (showPacket (packet c))) in (ws,report++rs) forM_ towrites $ \(f,x) -> do let m = Message $ map packet x diff --git a/kiki.hs b/kiki.hs index e901625..6cbf74d 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1210,7 +1210,7 @@ markForImport :: Ord d => Map.Map String a -> Maybe String - -> [Char] + -> FilePath -> Map.Map d KeyData -> IO (Map.Map d KeyData) markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport -- cgit v1.2.3