writeKeyRings now uses writeInputFileL instead of L.writeFile

1 files changed, 11 insertions, 5 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 0cdb36f..c6b592f 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -84,7 +84,7 @@ import Data.ASN1.BinaryEncoding ( DER(..) )
 import Data.Time.Clock.POSIX ( getPOSIXTime )
 import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile
-        , ByteString, toChunks, hGetContents, concat )
+        , ByteString, toChunks, hGetContents, hPut, concat )
 import qualified Data.ByteString      as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile)
 import qualified Crypto.Types.PubKey.ECC as ECC
 import qualified Codec.Binary.Base32 as Base32
@@ -847,6 +847,12 @@ readInputFileL ctx inp = do
     fmap L.concat $ mapM L.readFile fname
 
 
+writeInputFileL ctx (FileDesc fd) bs =  fdToHandle fd >>= (`L.hPut` bs)
+writeInputFileL ctx inp bs = do
+    let fname = resolveInputFile ctx inp
+    mapM_ (`L.writeFile` bs) fname
+    
+
 getInputFileTime :: InputFileContext -> InputFile -> IO CTime
 getInputFileTime ctx (FileDesc fd) = do
     handleIO_ (error $ "&"++show fd++": modificaiton time?") $
@@ -1432,22 +1438,22 @@ writeRingKeys krd rt {- db wk secring pubring -} = do
             new_packets = filter isnew x
                 where isnew p = isNothing (Map.lookup f $ locations p)
         guard (not $ null new_packets)
-        return ((f,isMutable stream),(new_packets,x))
+        return ((f0,isMutable stream),(new_packets,x))
     let (towrites,report) = (\f -> foldl f ([],[]) s) $
          \(ws,report) ((f,mutable),(new_packets,x)) ->
             if mutable
                 then
                      let rs = flip map new_packets
-                                $ \c -> (f, NewPacket $ showPacket (packet c))
+                                $ \c -> (concat $ resolveInputFile ctx f, NewPacket $ showPacket (packet c))
                      in (ws++[(f,x)],report++rs)
                 else
                      let rs = flip map new_packets
-                                $ \c -> (f,MissingPacket (showPacket (packet c)))
+                                $ \c -> (concat $ resolveInputFile ctx f,MissingPacket (showPacket (packet c)))
                      in (ws,report++rs)
     forM_ towrites $ \(f,x) -> do
         let m = Message $ map packet x
         -- warn $ "writing "++f
-        L.writeFile f (encode m)
+        writeInputFileL ctx f (encode m)
     return $ KikiSuccess report