writeKeyToFile now uses writeStamped

1 files changed, 22 insertions, 10 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index ee3e139..7392395 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -106,7 +106,7 @@ import Foreign.C.Error ( throwErrnoIfMinus1_ )
 import Foreign.Storable
 #endif
 import System.FilePath ( takeDirectory )
-import System.IO (hPutStrLn,withFile,IOMode(..))
+import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr)
 import Foreign.C.Types ( CTime )
 import Data.IORef
 import System.Posix.IO ( fdToHandle )
@@ -861,19 +861,32 @@ 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
-    
-writeStampedL :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO ()
-writeStampedL ctx (FileDesc fd) stamp bs = do
+
+-- writeStamped0 :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO ()
+-- writeStamped0 :: InputFileContext -> InputFile
+
+writeStamped0 :: InputFileContext
+    -> InputFile
+    -> Posix.EpochTime
+    -> (Either Handle FilePath -> t -> IO ())
+    -> t
+    -> IO ()
+writeStamped0 ctx (FileDesc fd) stamp dowrite bs = do
     h <- fdToHandle fd
-    L.hPut h bs
+    dowrite (Left h) bs
     handleIO_ (return ())
      $ setFdTimesHiRes fd (realToFrac stamp) (realToFrac stamp)
-writeStampedL ctx inp stamp bs = do
+writeStamped0 ctx inp stamp dowrite bs = do
     let fname = resolveInputFile ctx inp
     forM_ fname $ \fname -> do
-    L.writeFile fname bs
+    dowrite (Right fname) bs
     setFileTimes fname stamp stamp
-    
+
+writeStampedL :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO ()
+writeStampedL ctx f stamp bs = writeStamped0 ctx f stamp (either L.hPut L.writeFile) bs
+
+writeStamped :: InputFileContext -> InputFile -> Posix.EpochTime -> String -> IO ()
+writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str
 
 getInputFileTime :: InputFileContext -> InputFile -> IO CTime
 getInputFileTime ctx (FileDesc fd) = do
@@ -1558,10 +1571,9 @@ writeKeyToFile False "PEM" fname packet =
         createDirectoryIfMissing True (takeDirectory fname)
         handleIO_ (return [(fname, FailedFileWrite)]) $ do
             saved_mask <- setFileCreationMask 0o077
-            writeFile fname output
             -- Note: The key's timestamp is included in it's fingerprint.
             --       Therefore, we should attempt to preserve it.
-            setFileTimes fname stamp stamp
+            writeStamped (InputFileContext "" "") (ArgFile fname) stamp output
             setFileCreationMask saved_mask
             return [(fname, ExportedSubkey)]
     algo -> return [(fname, UnableToExport algo $ fingerprint packet)]