summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs41
-rw-r--r--kiki.hs2
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)
95 95
96data KeyRingData = KeyRingData 96data 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
diff --git a/kiki.hs b/kiki.hs
index e901625..6cbf74d 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -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)
1216markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport 1216markForImport margs grip pubring db = maybe (return db) import_db $ wantToImport