diff options
-rw-r--r-- | KeyRing.hs | 32 |
1 files changed, 22 insertions, 10 deletions
@@ -106,7 +106,7 @@ import Foreign.C.Error ( throwErrnoIfMinus1_ ) | |||
106 | import Foreign.Storable | 106 | import Foreign.Storable |
107 | #endif | 107 | #endif |
108 | import System.FilePath ( takeDirectory ) | 108 | import System.FilePath ( takeDirectory ) |
109 | import System.IO (hPutStrLn,withFile,IOMode(..)) | 109 | import System.IO (hPutStrLn,withFile,IOMode(..), Handle, hPutStr) |
110 | import Foreign.C.Types ( CTime ) | 110 | import Foreign.C.Types ( CTime ) |
111 | import Data.IORef | 111 | import Data.IORef |
112 | import System.Posix.IO ( fdToHandle ) | 112 | import System.Posix.IO ( fdToHandle ) |
@@ -861,19 +861,32 @@ writeInputFileL ctx (FileDesc fd) bs = fdToHandle fd >>= (`L.hPut` bs) | |||
861 | writeInputFileL ctx inp bs = do | 861 | writeInputFileL ctx inp bs = do |
862 | let fname = resolveInputFile ctx inp | 862 | let fname = resolveInputFile ctx inp |
863 | mapM_ (`L.writeFile` bs) fname | 863 | mapM_ (`L.writeFile` bs) fname |
864 | 864 | ||
865 | writeStampedL :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO () | 865 | -- writeStamped0 :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO () |
866 | writeStampedL ctx (FileDesc fd) stamp bs = do | 866 | -- writeStamped0 :: InputFileContext -> InputFile |
867 | |||
868 | writeStamped0 :: InputFileContext | ||
869 | -> InputFile | ||
870 | -> Posix.EpochTime | ||
871 | -> (Either Handle FilePath -> t -> IO ()) | ||
872 | -> t | ||
873 | -> IO () | ||
874 | writeStamped0 ctx (FileDesc fd) stamp dowrite bs = do | ||
867 | h <- fdToHandle fd | 875 | h <- fdToHandle fd |
868 | L.hPut h bs | 876 | dowrite (Left h) bs |
869 | handleIO_ (return ()) | 877 | handleIO_ (return ()) |
870 | $ setFdTimesHiRes fd (realToFrac stamp) (realToFrac stamp) | 878 | $ setFdTimesHiRes fd (realToFrac stamp) (realToFrac stamp) |
871 | writeStampedL ctx inp stamp bs = do | 879 | writeStamped0 ctx inp stamp dowrite bs = do |
872 | let fname = resolveInputFile ctx inp | 880 | let fname = resolveInputFile ctx inp |
873 | forM_ fname $ \fname -> do | 881 | forM_ fname $ \fname -> do |
874 | L.writeFile fname bs | 882 | dowrite (Right fname) bs |
875 | setFileTimes fname stamp stamp | 883 | setFileTimes fname stamp stamp |
876 | 884 | ||
885 | writeStampedL :: InputFileContext -> InputFile -> Posix.EpochTime -> L.ByteString -> IO () | ||
886 | writeStampedL ctx f stamp bs = writeStamped0 ctx f stamp (either L.hPut L.writeFile) bs | ||
887 | |||
888 | writeStamped :: InputFileContext -> InputFile -> Posix.EpochTime -> String -> IO () | ||
889 | writeStamped ctx f stamp str = writeStamped0 ctx f stamp (either hPutStr writeFile) str | ||
877 | 890 | ||
878 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime | 891 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime |
879 | getInputFileTime ctx (FileDesc fd) = do | 892 | getInputFileTime ctx (FileDesc fd) = do |
@@ -1558,10 +1571,9 @@ writeKeyToFile False "PEM" fname packet = | |||
1558 | createDirectoryIfMissing True (takeDirectory fname) | 1571 | createDirectoryIfMissing True (takeDirectory fname) |
1559 | handleIO_ (return [(fname, FailedFileWrite)]) $ do | 1572 | handleIO_ (return [(fname, FailedFileWrite)]) $ do |
1560 | saved_mask <- setFileCreationMask 0o077 | 1573 | saved_mask <- setFileCreationMask 0o077 |
1561 | writeFile fname output | ||
1562 | -- Note: The key's timestamp is included in it's fingerprint. | 1574 | -- Note: The key's timestamp is included in it's fingerprint. |
1563 | -- Therefore, we should attempt to preserve it. | 1575 | -- Therefore, we should attempt to preserve it. |
1564 | setFileTimes fname stamp stamp | 1576 | writeStamped (InputFileContext "" "") (ArgFile fname) stamp output |
1565 | setFileCreationMask saved_mask | 1577 | setFileCreationMask saved_mask |
1566 | return [(fname, ExportedSubkey)] | 1578 | return [(fname, ExportedSubkey)] |
1567 | algo -> return [(fname, UnableToExport algo $ fingerprint packet)] | 1579 | algo -> return [(fname, UnableToExport algo $ fingerprint packet)] |