bug fix: Do not import public key packets into a secret ring.

1 files changed, 7 insertions, 4 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 0957143..c7ea5fb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -204,7 +204,7 @@ data InputFile = HomeSec
                -- ^ Contents will be read from the first descriptor and updated
                -- content will be writen to the second. Note: Don't use Pipe
                -- for 'Wallet' files. (TODO: Wallet support)
- deriving (Eq,Ord)
+ deriving (Eq,Ord,Show)
 
 -- type UsageTag = String
 type Initializer = String
@@ -1199,6 +1199,9 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do
         return $ map (first $ resolveForReport $ Just ctx) rs
     return $ concat rss
 
+isSecretKey :: Packet -> Bool
+isSecretKey (SecretKeyPacket {}) = True
+isSecretKey _                    = False
 
 buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation
               -> IO (KikiCondition ((KeyDB
@@ -1254,8 +1257,7 @@ buildKeyDB ctx grip0 keyring = do
             keys :: Map.Map KeyKey MappedPacket
             keys = Map.foldl slurpkeys Map.empty
                         $ Map.mapWithKey filterSecrets ringPackets
-                    where isSecretKey (SecretKeyPacket {}) = True
-                          isSecretKey _                    = False
+                    where
                           filterSecrets f (_,Message ps) =
                             filter (isSecretKey . packet)
                                 $ zipWith (mappedPacketWithHint fname) ps [1..]
@@ -1678,13 +1680,14 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do
                 d <- sortByHint f keyMappedPacket (Map.elems db')
                 acc <- maybeToList $ Map.lookup f0 (rtRingAccess rt)
                 only_public <- maybeToList $ wantedForFill acc (fill stream) d
+                guard $ only_public || isSecretKey (keyPacket d)
                 case fill stream of
                     KF_Match usage -> do grip <- maybeToList $ rtGrip rt
                                          flattenTop f only_public
                                             $ filterNewSubs f (parseSpec grip usage) d
                     _              -> flattenTop f only_public d
             new_packets = filter isnew x
-                where isnew p = isNothing (Map.lookup f $ locations p)
+                where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p)
         guard (not $ null new_packets)
         return ((f0,isMutable stream),(new_packets,x))
     let (towrites,report) = (\f -> foldl f ([],[]) s) $