2 files changed, 40 insertions, 23 deletions
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index 13000e03..8b110ae6 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -20,7 +20,8 @@ module Utility.Exception (
 	catchNonAsync,
 	tryNonAsync,
 	tryWhenExists,
-	catchHardwareFault,
+	catchIOErrorType,
+	IOErrorType(..)
 ) where
 
 import Control.Monad.Catch as X hiding (Handler)
@@ -88,11 +89,11 @@ tryWhenExists a = do
 	v <- tryJust (guard . isDoesNotExistError) a
 	return (eitherToMaybe v)
 
-{- Catches only exceptions caused by hardware faults.
- - Ie, disk IO error. -}
-catchHardwareFault :: MonadCatch m => m a -> (IOException -> m a) -> m a
-catchHardwareFault a onhardwareerr = catchIO a onlyhw
+{- Catches only IO exceptions of a particular type.
+ - Ie, use HardwareFault to catch disk IO errors. -}
+catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
+catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
   where
-	onlyhw e
-		| ioeGetErrorType e == HardwareFault = onhardwareerr e
+	onlymatching e
+		| ioeGetErrorType e == errtype = onmatchingerr e
 		| otherwise = throwM e
diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs
index de970fe5..7610f6cc 100644
--- a/src/Utility/Tmp.hs
+++ b/src/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,32 +67,45 @@ 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)
 	makenewdir t n = do
 		let dir = t ++ "." ++ show n
-		either (const $ makenewdir t $ n + 1) (const $ return dir)
-			=<< tryIO (createDirectory dir)
+		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
+			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