writeStampedL (including compatibility cold for older unix package)

1 files changed, 51 insertions, 1 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index c6b592f..ee3e139 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE NoPatternGuards #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
 module KeyRing
     ( runKeyRing
     , StreamInfo(..)
@@ -81,7 +82,7 @@ import Data.ASN1.Types ( toASN1, ASN1Object, fromASN1
 import Data.ASN1.BitArray ( BitArray(..), toBitArray )
 import Data.ASN1.Encoding ( encodeASN1, encodeASN1', decodeASN1, decodeASN1' )
 import Data.ASN1.BinaryEncoding ( DER(..) )
-import Data.Time.Clock.POSIX ( getPOSIXTime )
+import Data.Time.Clock.POSIX ( getPOSIXTime, POSIXTime )
 import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile
         , ByteString, toChunks, hGetContents, hPut, concat )
@@ -95,6 +96,15 @@ import qualified Data.Text as T ( Text, unpack, pack,
 import qualified System.Posix.Types as Posix
 import System.Posix.Files ( modificationTime, getFileStatus, getFdStatus
         , setFileCreationMask, setFileTimes )
+#if MIN_VERSION_unix(2,7,0)
+import System.Posix.Files ( setFdTimesHiRes )
+#else
+import Foreign.C.Types ( CTime(..), CLong, CInt(..) )
+import Foreign.Marshal.Array ( withArray )
+import Foreign.Ptr
+import Foreign.C.Error ( throwErrnoIfMinus1_ )
+import Foreign.Storable
+#endif
 import System.FilePath ( takeDirectory )
 import System.IO (hPutStrLn,withFile,IOMode(..))
 import Foreign.C.Types ( CTime )
@@ -852,6 +862,18 @@ 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
+    h <- fdToHandle fd
+    L.hPut h bs
+    handleIO_ (return ())
+     $ setFdTimesHiRes fd (realToFrac stamp) (realToFrac stamp)
+writeStampedL ctx inp stamp bs = do
+    let fname = resolveInputFile ctx inp
+    forM_ fname $ \fname -> do
+    L.writeFile fname bs
+    setFileTimes fname stamp stamp
+    
 
 getInputFileTime :: InputFileContext -> InputFile -> IO CTime
 getInputFileTime ctx (FileDesc fd) = do
@@ -2573,3 +2595,31 @@ socketFamily :: SockAddr -> Family
 socketFamily (SockAddrInet _ _)      = AF_INET
 socketFamily (SockAddrInet6 {}) = AF_INET6
 socketFamily (SockAddrUnix _)        = AF_UNIX
+
+#if ! MIN_VERSION_unix(2,7,0)
+setFdTimesHiRes :: Posix.Fd -> POSIXTime -> POSIXTime -> IO ()
+setFdTimesHiRes (Posix.Fd fd) atime mtime =
+  withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
+    throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times)
+
+data CTimeSpec = CTimeSpec Posix.EpochTime CLong
+instance Storable CTimeSpec where
+    sizeOf    _ = (16)
+    alignment _ = alignment (undefined :: CInt)
+    poke p (CTimeSpec sec nsec) = do
+        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p sec
+        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p nsec
+    peek p = do
+        sec  <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
+        nsec <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
+        return $ CTimeSpec sec nsec
+
+toCTimeSpec :: POSIXTime -> CTimeSpec
+toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10^(9::Int) * frac)
+  where
+    (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac')
+    (sec', frac') = properFraction $ toRational t
+
+foreign import ccall unsafe "futimens"
+    c_futimens :: CInt -> Ptr CTimeSpec -> IO CInt
+#endif