summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2015-12-15 21:05:00 -0400
committerJoey Hess2015-12-15 21:05:00 -0400
commit571318218c5598ad841cc3dff73c9fee2c7216ef (patch)
tree5b7ef7ba00b9b7556ceacc83d4889fad36c32d52 /src/Utility
parentb67c39f990ef0ccf465280e0ecdcbff85b94857c (diff)
merge from git-annex
withTmpDir security fix in git-annex merged Fix potential denial of service attack when creating temp dirs. withTmpDir now makes directory mode 700. AFAICS, propellor didn't leak any info with the old permissions, and no uses of withTmpDir in propellor are broken by the new permissions.
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/Exception.hs15
-rw-r--r--src/Utility/Tmp.hs48
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