Skip to content

Commit

Permalink
Make behavior of removeDirectoryRecursive more consistent
Browse files Browse the repository at this point in the history
The way `removeDirectoryRecursive dir` works right now is totally
inconsistent:

  - If there's a directory-like symbolic link, the function removes it
    without recursing into it, *unless* the symbolic link is not
    removable for some reason (e.g. no permission), in which case it
    recurses into it and wipes out everything inside.

  - If `dir` itself is actually a directory-like symbolic link, it will
    recurse into it but fail to remove `dir` itself.

The causes of these two problems are:

  - Instead of explicitly checking whether path refers to a true
    directory, it assumes any unremovable file that also satisfies
    `directoryExists` must necessarily be a directory.  This is false,
    because `directoryExists` dereferences the symbolic link.

  - `getDirectoryContents` should not be called until `dir` is verified
    to be a true directory.

Note that there are two possible ways to handle the case where `dir` is
not a true directory:

  - One can delete it silently, similar to the behavior of the POSIX
    command `rm -r`.

  - Or one can raise an error, similar to the behavior of the Python
    function `shutil.rmtree`.

The former is more elegant to implement but for backward compatibility
`removeDirectoryRecursive` shall retain the Python-like behavior.
Another function `removePathRecursive` was added to implement the POSIX
behavior, although it is currently not exported.
  • Loading branch information
Rufflewind committed Jan 31, 2015
1 parent b78c422 commit a3e0a45
Showing 1 changed file with 44 additions and 25 deletions.
69 changes: 44 additions & 25 deletions System/Directory.hs
Original file line number Diff line number Diff line change
Expand Up @@ -456,24 +456,49 @@ removeDirectory path =

#endif

-- | @'removeDirectoryRecursive' dir@ removes an existing directory
-- /dir/ together with its content and all subdirectories. If the
-- directory contains symlinks this function removes but does not
-- follow them.
-- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
-- together with its contents and subdirectories. Symbolic links are removed
-- without affecting their the targets.
removeDirectoryRecursive :: FilePath -> IO ()
removeDirectoryRecursive startLoc = do
cont <- getDirectoryContents startLoc
sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
removeDirectory startLoc
where
rm :: FilePath -> IO ()
rm f = do temp <- E.try (removeFile f)
case temp of
Left e -> do isDir <- doesDirectoryExist f
-- If f is not a directory, re-throw the error
unless isDir $ throwIO (e :: SomeException)
removeDirectoryRecursive f
Right _ -> return ()
removeDirectoryRecursive path =
(`ioeSetLocation` "removeDirectoryRecursive") `modifyIOError` do
isDir <- isRealDirectory path
if isDir
then removeContentsRecursive path
else ioError . (`ioeSetErrorString` "not a directory") $
mkIOError InappropriateType "" Nothing (Just path)

-- | @'removePathRecursive' path@ removes an existing file or directory at
-- /path/ together with its contents and subdirectories. Symbolic links are
-- removed without affecting their the targets.
removePathRecursive :: FilePath -> IO ()
removePathRecursive path =
(`ioeSetLocation` "removePathRecursive") `modifyIOError` do
isDir <- isRealDirectory path
if isDir
then removeContentsRecursive path
else removeFile path

-- | @'removeContentsRecursive' dir@ removes the contents of the directory
-- /dir/ recursively. Symbolic links are removed without affecting their the
-- targets.
removeContentsRecursive :: FilePath -> IO ()
removeContentsRecursive path =
(`ioeSetLocation` "removeContentsRecursive") `modifyIOError` do
cont <- getDirectoryContents path
mapM_ removePathRecursive [path </> x | x <- cont, x /= "." && x /= ".."]
removeDirectory path

-- | @'isRealDirectory path'@ checks whether /path/ refers to an actual
-- directory, i.e. not a symbolic link to another directory.
isRealDirectory :: FilePath -> IO Bool
isRealDirectory path =
#ifdef mingw32_HOST_OS
-- ToDo: use Win32 API
withFileOrSymlinkStatus "" path isDirectory
#else
Posix.isDirectory `fmap` Posix.getSymbolicLinkStatus path
#endif

#if __GLASGOW_HASKELL__
{- |'removeFile' /file/ removes the directory entry for an existing file
Expand Down Expand Up @@ -636,14 +661,8 @@ Either path refers to an existing directory.
renameFile :: FilePath -> FilePath -> IO ()
renameFile opath npath = do
-- XXX this test isn't performed atomically with the following rename
#ifdef mingw32_HOST_OS
-- ToDo: use Win32 API
withFileOrSymlinkStatus "renameFile" opath $ \st -> do
is_dir <- isDirectory st
#else
stat <- Posix.getSymbolicLinkStatus opath
let is_dir = Posix.isDirectory stat
#endif
is_dir <- (`ioeSetLocation` "renameFile") `modifyIOError`
isRealDirectory opath
if is_dir
then ioError (ioeSetErrorString
(mkIOError InappropriateType "renameFile" Nothing (Just opath))
Expand Down

0 comments on commit a3e0a45

Please sign in to comment.