1 files changed, 18 insertions, 6 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index c2e209c..c7ea5fb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -134,7 +134,7 @@ import System.FilePath ( takeDirectory )
 import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr)
 import Data.IORef
 import System.Posix.IO ( fdToHandle )
-import qualified Data.Traversable as Traversable ( mapM )
+import qualified Data.Traversable as Traversable
 import Data.Traversable ( sequenceA )
 #if ! MIN_VERSION_base(4,6,0)
 import GHC.Exts ( Down(..) )
@@ -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
@@ -1238,7 +1241,11 @@ buildKeyDB ctx grip0 keyring = do
 
     -- KeyRings (todo: KikiCondition reporting?)
     (spilled,mwk,grip,accs,keys,unspilled) <- do
+#if MIN_VERSION_containers(0,5,0)
         ringPackets <- Map.traverseWithKey readp ringMap
+#else
+        ringPackets <- Traversable.traverse (uncurry readp) $ Map.mapWithKey (,) ringMap
+#endif
         let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message)
 
         let grip = grip0 `mplus` (fingerprint <$> fstkey)
@@ -1250,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..]
@@ -1284,7 +1290,11 @@ buildKeyDB ctx grip0 keyring = do
                 r <- performManipulations doDecrypt rt1 mwk manip
                 try r $ \(rt2,report) -> do
                 return $ KikiSuccess (report,(info,flattenKeys acc $ rtKeyDB rt2))
+#if MIN_VERSION_containers(0,5,0)
         in fmap sequenceA $ Map.traverseWithKey trans spilled
+#else
+        in fmap sequenceA $ Traversable.traverse (uncurry trans) $ Map.mapWithKey (,) spilled
+#endif
     try transformed0 $ \transformed -> do
     let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
                     where
@@ -1670,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) $
@@ -2404,7 +2415,8 @@ readPacketsFromFile ctx fname = do
       case decodeOrFail input of
         Right (_,_,msg ) -> msg
         Left  (_,_,_)    ->
-        --trace (fname++": read fail") $
+          -- FIXME
+          -- trace (fname++": read fail") $
           Message []
 #else
     return $ decode input