Use kImports for finer control of key propagation

1 files changed, 25 insertions, 16 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