[commit: Cabal] master: Add compat withTempDirectory function (597ea1f)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/597ea1f595ee5e8c8a928edcae83934a7064f099

>---------------------------------------------------------------

commit 597ea1f595ee5e8c8a928edcae83934a7064f099
Author: Duncan Coutts <duncan at haskell.org>
Date:   Mon Feb 2 01:19:17 2009 +0000

    Add compat withTempDirectory function
    This is already in Cabal HEAD but we cannot use that yet

>---------------------------------------------------------------

 cabal-install/Distribution/Client/Utils.hs    |   13 +++++++++-
 cabal-install/Distribution/Compat/TempFile.hs |   28 +++++++++++++++++++++++++
 cabal-install/cabal-install.cabal             |    1 +
 3 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs
index 07a0b87..6e3d73c 100644
--- a/cabal-install/Distribution/Client/Utils.hs
+++ b/cabal-install/Distribution/Client/Utils.hs
@@ -13,9 +13,11 @@ import System.IO.Error
          ( isDoesNotExistError )
 import System.Directory
          ( removeFile, renameFile, doesFileExist, getModificationTime
-         , getCurrentDirectory, setCurrentDirectory )
+         , getCurrentDirectory, setCurrentDirectory, removeDirectoryRecursive )
+import Distribution.Compat.TempFile
+         ( createTempDirectory )
 import qualified Control.Exception as Exception
-         ( handle, throwIO, evaluate, finally )
+         ( handle, throwIO, evaluate, finally, bracket )
 
 -- | Generic merging utility. For sorted input lists this is a full outer join.
 --
@@ -92,6 +94,13 @@ rewriteFile path newContent =
     mightNotExist e | isDoesNotExistError e = writeFile path newContent
                     | otherwise             = ioError e
 
+--TODO: replace with function from Cabal utils in next version
+withTempDirectory :: FilePath -> String -> (FilePath -> IO a) -> IO a
+withTempDirectory targetDir template =
+  Exception.bracket
+    (createTempDirectory targetDir template)
+    (removeDirectoryRecursive)
+
 -- | Executes the action in the specified directory.
 inDir :: Maybe FilePath -> IO () -> IO ()
 inDir Nothing m = m
diff --git a/cabal-install/Distribution/Compat/TempFile.hs b/cabal-install/Distribution/Compat/TempFile.hs
new file mode 100644
index 0000000..0d56803
--- /dev/null
+++ b/cabal-install/Distribution/Compat/TempFile.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -cpp #-}
+{-# OPTIONS_NHC98 -cpp #-}
+{-# OPTIONS_JHC -fcpp #-}
+-- #hide
+module Distribution.Compat.TempFile (
+  createTempDirectory,
+  ) where
+
+import System.FilePath        ((</>))
+import System.Posix.Internals (mkdir, c_getpid)
+import Foreign.C              (withCString, getErrno, eEXIST, errnoToIOError)
+
+createTempDirectory :: FilePath -> String -> IO FilePath
+createTempDirectory dir template = do
+  pid <- c_getpid
+  findTempName pid
+  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))
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 7f36d81..6960733 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -67,6 +67,7 @@ Executable cabal
         Distribution.Client.Upload
         Distribution.Client.Utils
         Distribution.Client.Win32SelfUpgrade
+        Distribution.Compat.TempFile
         Paths_cabal_install
 
     build-depends: base >= 2 && < 4,