diff options
-rw-r--r-- | KeyRing.hs | 41 | ||||
-rw-r--r-- | kiki.hs | 2 |
2 files changed, 26 insertions, 17 deletions
@@ -95,8 +95,11 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a) | |||
95 | 95 | ||
96 | data KeyRingData = KeyRingData | 96 | data KeyRingData = KeyRingData |
97 | { kFiles :: Map.Map InputFile (RefType,FileType) | 97 | { kFiles :: Map.Map InputFile (RefType,FileType) |
98 | , kImports :: Map.Map FilePath (KeyData -> Bool) | 98 | , kImports :: Map.Map FilePath (KeyData -> Maybe Bool) |
99 | -- ^ indicates what pgp packets get written to which keyring files | 99 | -- ^ Indicates what pgp packets get written to which keyring files. |
100 | -- Just True = import public key | ||
101 | -- Just False = import secret key | ||
102 | -- Nothing = do not import | ||
100 | , homeSpec :: Maybe String | 103 | , homeSpec :: Maybe String |
101 | } | 104 | } |
102 | 105 | ||
@@ -864,29 +867,35 @@ writeRingKeys krd db wk secring pubring = do | |||
864 | guard (isring ftyp) | 867 | guard (isring ftyp) |
865 | n <- resolveInputFile secring pubring f | 868 | n <- resolveInputFile secring pubring f |
866 | return (n,isMutable rtyp) | 869 | return (n,isMutable rtyp) |
867 | fromfile f (KeyData p _ _ _) = Map.member f $ locations p | 870 | fromfile f kd@(KeyData p _ _ _) = |
871 | Map.member f $ locations p | ||
872 | {- maybe (Map.member f $ locations p) | ||
873 | (\pred -> pred kd) | ||
874 | (Map.lookup f $ kImports krd) -} | ||
868 | let s = do | 875 | let s = do |
869 | (f,mutable) <- fs | 876 | (f,mutable) <- fs |
870 | let x = do | 877 | let x = do |
871 | d@(KeyData p _ _ _) <- filter (fromfile f) (sortByHint f keyMappedPacket ks) | 878 | let wanted kd@(KeyData p _ _ _) |
872 | n <- maybeToList $ Map.lookup f (locations p) | 879 | = maybe (fmap originallyPublic $ Map.lookup f $ locations p) |
873 | flattenTop f (originallyPublic n) d | 880 | (\pred -> pred kd) |
874 | changes = filter isnew x | 881 | (Map.lookup f $ kImports krd) |
882 | d <- sortByHint f keyMappedPacket ks | ||
883 | only_public <- maybeToList $ wanted d | ||
884 | flattenTop f only_public d | ||
885 | new_packets = filter isnew x | ||
875 | where isnew p = isNothing (Map.lookup f $ locations p) | 886 | where isnew p = isNothing (Map.lookup f $ locations p) |
876 | {- | 887 | guard (not $ null new_packets) |
877 | trace (unlines $ ( (f ++ ":") : map (showPacket . packet) x) ++ | 888 | return ((f,mutable),(new_packets,x)) |
878 | ( "CHANGES: " : map ((" "++) . showPacket . packet) changes)) $ do | ||
879 | -} | ||
880 | guard (not $ null changes) | ||
881 | return ((f,mutable),(changes,x)) | ||
882 | let (towrites,report) = (\f -> foldl f ([],[]) s) $ | 889 | let (towrites,report) = (\f -> foldl f ([],[]) s) $ |
883 | \(ws,report) ((f,mutable),(changes,x)) -> | 890 | \(ws,report) ((f,mutable),(new_packets,x)) -> |
884 | if mutable | 891 | if mutable |
885 | then | 892 | then |
886 | let rs = flip map changes $ \c -> (f, NewPacket $ showPacket (packet c)) | 893 | let rs = flip map new_packets |
894 | $ \c -> (f, NewPacket $ showPacket (packet c)) | ||
887 | in (ws++[(f,x)],report++rs) | 895 | in (ws++[(f,x)],report++rs) |
888 | else | 896 | else |
889 | let rs = flip map changes $ \c -> (f,MissingPacket (showPacket (packet c))) | 897 | let rs = flip map new_packets |
898 | $ \c -> (f,MissingPacket (showPacket (packet c))) | ||
890 | in (ws,report++rs) | 899 | in (ws,report++rs) |
891 | forM_ towrites $ \(f,x) -> do | 900 | forM_ towrites $ \(f,x) -> do |
892 | let m = Message $ map packet x | 901 | let m = Message $ map packet x |
@@ -1210,7 +1210,7 @@ markForImport | |||
1210 | :: Ord d => | 1210 | :: Ord d => |
1211 | Map.Map String a | 1211 | Map.Map String a |
1212 | -> Maybe String | 1212 | -> Maybe String |
1213 | -> [Char] | 1213 | -> FilePath |
1214 | -> Map.Map d KeyData | 1214 | -> Map.Map d KeyData |
1215 | -> IO (Map.Map d KeyData) | 1215 | -> IO (Map.Map d KeyData) |
1216 | markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport | 1216 | markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport |