Fix createDirectoryIfMissing to not throw if the dir got deleted

When we call createDirectory and some file system object already exists
we have a problem. We need to distinguish if it is a file that already
exists or if it is a directory because in the latter case it is not an
error. Previously we called doesDirectoryExist however that does not
distinguish the dir not existing (due to another thread deleting it)
and an ordinary file existing. We now use withFileStatus to throw the
original AlreadyExistsError only if a non-directory object exists.
So now the only time we should get a spurious exception is if another
thread deletes the directory and puts a file in its place between our
call to createDirectory and withFileStatus. It should now be safe to
race createDirectoryIfMissing with itself or deleteDirectoryRecursive.

diff --git a/System/Directory.hs b/System/Directory.hs
index d80950b..13a6a66 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -329,11 +329,15 @@ createDirectoryIfMissing create_parents path0
           -- between a dir already existing and a file already existing. So we
           -- check for it here. Unfortunately there is a slight race condition
           -- here, but we think it is benign. It could report an exeption in
-          -- the case that the dir did exist but another process deletes it
-          -- before we can check that it did indeed exist.
-          | isAlreadyExistsError e -> do exists <- doesDirectoryExist dir
-                                         if exists then return ()
-                                                   else throw e
+          -- the case that the dir did exist but another process deletes the
+          -- directory and creates a file in its place before we can check
+          -- that the directory did indeed exist.
+          | isAlreadyExistsError e ->
+              (withFileStatus "createDirectoryIfMissing" dir $ \st -> do
+                 isDir <- isDirectory st
+                 if isDir then return ()
+                          else throw e
+              ) `catch` ((\_ -> return ()) :: IOException -> IO ())
           | otherwise              -> throw e
 
 #if __GLASGOW_HASKELL__