Merge branch 'master' into smudge

2 files changed, 42 insertions, 15 deletions

diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index 1e9b63483..efef5fa25 100644
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -27,12 +27,24 @@ import Utility.Exception
 
 {- Applies a conversion function to a file's mode. -}
 modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
-modifyFileMode f convert = do
+modifyFileMode f convert = void $ modifyFileMode' f convert
+
+modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
+modifyFileMode' f convert = do
 	s <- getFileStatus f
 	let old = fileMode s
 	let new = convert old
 	when (new /= old) $
 		setFileMode f new
+	return old
+
+{- Runs an action after changing a file's mode, then restores the old mode. -}
+withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
+withModifiedFileMode file convert a = bracket setup cleanup go
+  where
+	setup = modifyFileMode' file convert
+	cleanup oldmode = modifyFileMode file (const oldmode)
+	go _ = a
 
 {- Adds the specified FileModes to the input mode, leaving the rest
  - unchanged. -}
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index 7e4db1101..7610f6cc8 100644
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -15,6 +15,9 @@ import System.Directory
 import Control.Monad.IfElse
 import System.FilePath
 import Control.Monad.IO.Class
+#ifndef mingw32_HOST_OS
+import System.Posix.Temp (mkdtemp)
+#endif
 
 import Utility.Exception
 import Utility.FileSystemEncoding
@@ -64,25 +67,22 @@ withTmpFileIn tmpdir template a = bracket create remove use
  - directory and all its contents. -}
 withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
 withTmpDir template a = do
-	tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
-	withTmpDirIn tmpdir template a
+	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+#ifndef mingw32_HOST_OS
+	-- Use mkdtemp to create a temp directory securely in /tmp.
+	bracket
+		(liftIO $ mkdtemp $ topleveltmpdir </> template)
+		removeTmpDir
+		a
+#else
+	withTmpDirIn topleveltmpdir template a
+#endif
 
 {- Runs an action with a tmp directory located within a specified directory,
  - then removes the tmp directory and all its contents. -}
 withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
-withTmpDirIn tmpdir template = bracketIO create remove
+withTmpDirIn tmpdir template = bracketIO create removeTmpDir
   where
-	remove d = whenM (doesDirectoryExist d) $ do
-#if mingw32_HOST_OS
-		-- Windows will often refuse to delete a file
-		-- after a process has just written to it and exited.
-		-- Because it's crap, presumably. So, ignore failure
-		-- to delete the temp directory.
-		_ <- tryIO $ removeDirectoryRecursive d
-		return ()
-#else
-		removeDirectoryRecursive d
-#endif
 	create = do
 		createDirectoryIfMissing True tmpdir
 		makenewdir (tmpdir </> template) (0 :: Int)
@@ -92,6 +92,21 @@ withTmpDirIn tmpdir template = bracketIO create remove
 			createDirectory dir
 			return dir
 
+{- Deletes the entire contents of the the temporary directory, if it
+ - exists. -}
+removeTmpDir :: MonadIO m => FilePath -> m ()
+removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
+#if mingw32_HOST_OS
+	-- Windows will often refuse to delete a file
+	-- after a process has just written to it and exited.
+	-- Because it's crap, presumably. So, ignore failure
+	-- to delete the temp directory.
+	_ <- tryIO $ removeDirectoryRecursive tmpdir
+	return ()
+#else
+	removeDirectoryRecursive tmpdir
+#endif
+
 {- It's not safe to use a FilePath of an existing file as the template
  - for openTempFile, because if the FilePath is really long, the tmpfile
  - will be longer, and may exceed the maximum filename length.