Commit 108ef255 authored by Simon Marlow's avatar Simon Marlow
Browse files

clean up createTempDirectory, using System.Posix or System.Directory

rather than low-level System.Posix.Internals operations which are
about to go away.
parent db9334e5
......@@ -48,6 +48,9 @@ Library
array >= 0.1 && < 0.3,
pretty >= 1 && < 1.1
if !os(windows)
Build-Depends: unix >= 2.2 && < 2.4
ghc-options: -Wall
if impl(ghc >= 6.8)
ghc-options: -fwarn-tabs
......
......@@ -14,7 +14,6 @@ module Distribution.Compat.TempFile (
import System.FilePath ((</>))
import System.Posix.Internals (mkdir)
import Foreign.C (eEXIST)
#if __NHC__ || __HUGS__
......@@ -27,8 +26,11 @@ import System.IO (Handle, openTempFile, openBinaryTempFile)
import Data.Bits ((.|.))
import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR,
o_BINARY, o_NONBLOCK, o_NOCTTY)
import System.IO.Error (try, isAlreadyExistsError, ioError)
#if __GLASGOW_HASKELL__ >= 611
import System.Posix.Internals (withFilePath)
#else
import Foreign.C (withCString)
#endif
import Foreign.C (CInt)
#if __GLASGOW_HASKELL__ >= 611
......@@ -38,7 +40,7 @@ import GHC.Handle (fdToHandle)
#endif
import Distribution.Compat.Exception (onException)
#endif
import Foreign.C (withCString, getErrno, errnoToIOError)
import Foreign.C (getErrno, errnoToIOError)
#if __NHC__
import System.Posix.Types (CPid(..))
......@@ -47,6 +49,12 @@ foreign import ccall unsafe "getpid" c_getpid :: IO CPid
import System.Posix.Internals (c_getpid)
#endif
#ifdef mingw32_HOST_OS
import System.Directory ( createDirectory )
#else
import qualified System.Posix
#endif
-- ------------------------------------------------------------
-- * temporary files
-- ------------------------------------------------------------
......@@ -181,11 +189,15 @@ createTempDirectory dir template = do
where
findTempName x = do
let dirpath = dir </> template ++ show x
res <- withCString dirpath $ \s -> mkdir s 0o700
if res == 0
then return dirpath
else do
errno <- getErrno
if errno == eEXIST
then findTempName (x+1)
else ioError (errnoToIOError "createTempDirectory" errno Nothing (Just dir))
r <- try $ mkPrivateDir dirpath
case r of
Right _ -> return dirpath
Left e | isAlreadyExistsError e -> findTempName (x+1)
| otherwise -> ioError e
mkPrivateDir :: String -> IO ()
#ifdef mingw32_HOST_OS
mkPrivateDir s = createDirectory s
#else
mkPrivateDir s = System.Posix.createDirectory s 0o700
#endif
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment