diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # ChangeLog for unix-time +## v0.5.1 + +* Security: `formatUnixTime` and `formatUnixTimeGMT` read beyond a + heap buffer when the output exceeded 80 bytes. Now the buffer grows. +* Security: concurrent calls of the GMT functions could leave the + process-global `TZ` corrupted. Calls are now serialized and the old + `TZ` value is copied before being restored. +* Windows: fix a heap overflow in `_patch_unsetenv`, which also failed + to unset `TZ`. + ## v0.5.0 * Remove deprecated `old-time` dependency by dropping `fromClockTime` and `toClockTime` diff --git a/Data/UnixTime/Conv.hs b/Data/UnixTime/Conv.hs --- a/Data/UnixTime/Conv.hs +++ b/Data/UnixTime/Conv.hs @@ -13,6 +13,7 @@ ) where import Control.Applicative +import Control.Concurrent.MVar (MVar, newMVar, withMVar) import Data.ByteString.Char8 import Data.ByteString.Unsafe import Data.UnixTime.Types @@ -38,6 +39,15 @@ foreign import ccall unsafe "c_format_unix_time_gmt" c_format_unix_time_gmt :: CString -> CTime -> CString -> CInt -> IO CSize +-- The GMT functions temporarily change the process-global TZ. +-- Serialize all C calls so that concurrent calls cannot corrupt TZ. +tzLock :: MVar () +tzLock = unsafePerformIO $ newMVar () +{-# NOINLINE tzLock #-} + +withTZLock :: IO a -> IO a +withTZLock = withMVar tzLock . const + ---------------------------------------------------------------- -- | @@ -50,7 +60,7 @@ parseUnixTime fmt str = unsafePerformIO $ useAsCString fmt $ \cfmt -> useAsCString str $ \cstr -> do - sec <- c_parse_unix_time cfmt cstr + sec <- withTZLock $ c_parse_unix_time cfmt cstr return $ UnixTime sec 0 -- | @@ -64,7 +74,7 @@ parseUnixTimeGMT fmt str = unsafePerformIO $ useAsCString fmt $ \cfmt -> useAsCString str $ \cstr -> do - sec <- c_parse_unix_time_gmt cfmt cstr + sec <- withTZLock $ c_parse_unix_time_gmt cfmt cstr return $ UnixTime sec 0 ---------------------------------------------------------------- @@ -106,12 +116,19 @@ -> UnixTime -> IO ByteString formatUnixTimeHelper formatFun fmt (UnixTime sec _) = - useAsCString fmt $ \cfmt -> do - let siz = 80 + useAsCString fmt $ \cfmt -> loop cfmt 80 + where + -- strftime() returns 0 if the result does not fit in the buffer. + -- Retry with a larger buffer but give up at a bound. + limit = 80 + 64 * Data.ByteString.Char8.length fmt + loop cfmt siz = do ptr <- mallocBytes siz - len <- fromIntegral <$> formatFun cfmt sec ptr (fromIntegral siz) - ptr' <- reallocBytes ptr (len + 1) - unsafePackMallocCString ptr' -- FIXME: Use unsafePackMallocCStringLen from bytestring-0.10.2.0 + len <- withTZLock $ fromIntegral <$> formatFun cfmt sec ptr (fromIntegral siz) + if len == 0 && siz < limit + then free ptr >> loop cfmt (siz * 2) + else do + ptr' <- reallocBytes ptr (max 1 len) + unsafePackMallocCStringLen (ptr', len) ---------------------------------------------------------------- diff --git a/cbits/conv.c b/cbits/conv.c --- a/cbits/conv.c +++ b/cbits/conv.c @@ -50,6 +50,8 @@ char *set_tz_utc() { char *tz; tz = getenv("TZ"); + /* setenv() may free the old string, so keep a copy. */ + if (tz) tz = strdup(tz); #if defined(_WIN32) _patch_setenv("TZ", "UTC", 1); #else @@ -72,6 +74,7 @@ #else setenv("TZ", local_tz, 1); #endif + free(local_tz); } else { #if defined(_WIN32) _patch_unsetenv("TZ"); diff --git a/cbits/win_patch.c b/cbits/win_patch.c --- a/cbits/win_patch.c +++ b/cbits/win_patch.c @@ -121,8 +121,8 @@ int len = strlen(name) + 2; char *sname = (char *)malloc(len); strcpy(sname, name); - sname[len] = '='; - sname[len + 1] = '\0'; + sname[len - 2] = '='; + sname[len - 1] = '\0'; int r = _putenv(sname); free(sname); return r; diff --git a/test/UnixTimeSpec.hs b/test/UnixTimeSpec.hs --- a/test/UnixTimeSpec.hs +++ b/test/UnixTimeSpec.hs @@ -6,6 +6,9 @@ module UnixTimeSpec (main, spec) where +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +import Control.Monad (forM_, replicateM) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Data.Function (on) @@ -15,6 +18,7 @@ import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr) import Foreign.Storable (peek, poke) +import System.Environment (lookupEnv) import qualified Language.Haskell.TH as TH (runIO) import Test.Hspec import Test.Hspec.QuickCheck (prop) @@ -40,6 +44,24 @@ spec :: Spec spec = do + describe "formatUnixTimeGMT (long output)" $ + it "does not truncate output longer than the initial buffer" $ do + let fmt = BS.concat (replicate 12 "%Y-%m-%d ") + formatUnixTimeGMT fmt (UnixTime 0 0) + `shouldBe` BS.concat (replicate 12 "1970-01-01 ") + + describe "formatUnixTimeGMT (concurrency)" $ + it "does not corrupt TZ when called concurrently" $ do + tz0 <- lookupEnv "TZ" + vs <- replicateM 8 newEmptyMVar + forM_ (zip [0 ..] vs) $ \(i, v) -> forkIO $ do + forM_ [1 .. 2000 :: Int] $ \j -> + BS.length (formatUnixTimeGMT webDateFormat (UnixTime (i * 100000 + fromIntegral j) 0)) + `seq` return () + putMVar v () + mapM_ takeMVar vs + lookupEnv "TZ" `shouldReturn` tz0 + describe "formatUnixTime" $ prop "behaves like the model" $ \ut -> do let ours = formatUnixTime mailDateFormat ut diff --git a/unix-time.cabal b/unix-time.cabal --- a/unix-time.cabal +++ b/unix-time.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: unix-time -version: 0.5.0 +version: 0.5.1 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -69,7 +69,7 @@ hs-source-dirs: test other-modules: UnixTimeSpec default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -threaded -with-rtsopts=-N build-depends: base, bytestring,