packages feed

directory 1.3.8.5 → 1.3.9.0

raw patch · 14 files changed

+235/−158 lines, 14 filesdep +file-iodep ~basedep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: file-io

Dependency ranges changed: base, time

API changes (from Hackage documentation)

- System.Directory.Internal: defaultFlags :: OpenFileFlags
- System.Directory.Internal: openFileForRead :: OsPath -> IO Handle
- System.Directory.Internal: openFileForWrite :: OsPath -> IO Handle
- System.Directory.Internal: withBinaryHandle :: IO Handle -> (Handle -> IO r) -> IO r
+ System.Directory.Internal: FollowLinks :: WhetherFollow
+ System.Directory.Internal: NoFollow :: WhetherFollow
+ System.Directory.Internal: atWhetherFollow :: WhetherFollow -> CInt
+ System.Directory.Internal: c_AT_FDCWD :: Fd
+ System.Directory.Internal: c_AT_SYMLINK_NOFOLLOW :: CInt
+ System.Directory.Internal: c_fchmodat :: Fd -> CString -> FileMode -> CInt -> IO CInt
+ System.Directory.Internal: c_fstatat :: Fd -> CString -> Ptr CStat -> CInt -> IO CInt
+ System.Directory.Internal: c_unlinkat :: Fd -> CString -> CInt -> IO CInt
+ System.Directory.Internal: closeRaw :: RawHandle -> IO ()
+ System.Directory.Internal: data WhetherFollow
+ System.Directory.Internal: defaultOpenFlags :: OpenFileFlags
+ System.Directory.Internal: dropSpecialDotDirs :: [OsPath] -> [OsPath]
+ System.Directory.Internal: getMetadataAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO Metadata
+ System.Directory.Internal: isNoFollow :: WhetherFollow -> Bool
+ System.Directory.Internal: openDirFromFd :: Fd -> IO DirStream
+ System.Directory.Internal: openRaw :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO RawHandle
+ System.Directory.Internal: readDirStreamToEnd :: DirStream -> IO [OsPath]
+ System.Directory.Internal: readDirToEnd :: RawHandle -> IO [OsPath]
+ System.Directory.Internal: removePathAt :: FileType -> Maybe RawHandle -> OsPath -> IO ()
+ System.Directory.Internal: setForceRemoveMode :: Mode -> Mode
+ System.Directory.Internal: setModeAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> Mode -> IO ()
+ System.Directory.Internal: type RawHandle = Fd
+ System.Directory.Internal: withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r

Files

HsDirectoryConfig.h.in view
@@ -48,6 +48,9 @@ /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H +/* Define to 1 if you have the `utimensat' function. */+#undef HAVE_UTIMENSAT+ /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT 
System/Directory/Internal/C_utimensat.hsc view
@@ -12,17 +12,16 @@ #ifdef HAVE_SYS_STAT_H # include <sys/stat.h> #endif-#include <System/Directory/Internal/utility.h> import Prelude () import System.Directory.Internal.Prelude import Data.Time.Clock.POSIX (POSIXTime)+import qualified System.Posix as Posix  data CTimeSpec = CTimeSpec EpochTime CLong  instance Storable CTimeSpec where     sizeOf    _ = #{size struct timespec}-    -- workaround (hsc2hs for GHC < 8.0 doesn't support #{alignment ...})-    alignment _ = #{size char[alignof(struct timespec)] }+    alignment _ = #{alignment struct timespec}     poke p (CTimeSpec sec nsec) = do       (#poke struct timespec, tv_sec)  p sec       (#poke struct timespec, tv_nsec) p nsec@@ -31,9 +30,6 @@       nsec <- #{peek struct timespec, tv_nsec} p       return (CTimeSpec sec nsec) -c_AT_FDCWD :: CInt-c_AT_FDCWD = (#const AT_FDCWD)- utimeOmit :: CTimeSpec utimeOmit = CTimeSpec (CTime 0) (#const UTIME_OMIT) @@ -44,6 +40,6 @@     (sec', frac') = properFraction (toRational t)  foreign import capi "sys/stat.h utimensat" c_utimensat-  :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt+  :: Posix.Fd -> CString -> Ptr CTimeSpec -> CInt -> IO CInt  #endif
System/Directory/Internal/Common.hs view
@@ -8,7 +8,7 @@ import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure)) import GHC.IO.Encoding.UTF16 (mkUTF16le) import GHC.IO.Encoding.UTF8 (mkUTF8)-import System.IO (hSetBinaryMode)+import System.File.OsPath.Internal (openFileWithCloseOnExec) import System.OsPath   ( OsPath   , OsString@@ -126,6 +126,10 @@     (mkUTF8 TransliterateCodingFailure)     (mkUTF16le TransliterateCodingFailure) +dropSpecialDotDirs :: [OsPath] -> [OsPath]+dropSpecialDotDirs = filter f+  where f filename = filename /= os "." && filename /= os ".."+ -- | Given a list of path segments, expand @.@ and @..@.  The path segments -- must not contain path separators. expandDots :: [OsPath] -> [OsPath]@@ -215,6 +219,12 @@     subpathIsAbsolute = any isPathSeparator (take 1 (unpack subpath))     hasTrailingPathSep = hasTrailingPathSeparator subpath +data WhetherFollow = NoFollow | FollowLinks deriving (Show)++isNoFollow :: WhetherFollow -> Bool+isNoFollow NoFollow    = True+isNoFollow FollowLinks = False+ data FileType = File               | SymbolicLink -- ^ POSIX: either file or directory link; Windows: file link               | Directory@@ -243,13 +253,8 @@   , searchable :: Bool   } deriving (Eq, Ord, Read, Show) -withBinaryHandle :: IO Handle -> (Handle -> IO r) -> IO r-withBinaryHandle open = bracket openBinary hClose-  where-    openBinary = do-      h <- open-      hSetBinaryMode h True-      pure h+withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r+withBinaryFile path mode = bracket (openFileWithCloseOnExec path mode) hClose  -- | Copy data from one handle to another until end of file. copyHandleData :: Handle                -- ^ Source handle
System/Directory/Internal/Posix.hsc view
@@ -1,9 +1,14 @@+{-# LANGUAGE CApiFFI #-} module System.Directory.Internal.Posix where #include <HsDirectoryConfig.h> #if !defined(mingw32_HOST_OS)+#include <fcntl.h> #ifdef HAVE_LIMITS_H # include <limits.h> #endif+#ifdef HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif import Prelude () import System.Directory.Internal.Prelude #ifdef HAVE_UTIMENSAT@@ -17,17 +22,62 @@ import System.OsString.Internal.Types (OsString(OsString, getOsString)) import qualified Data.Time.Clock.POSIX as POSIXTime import qualified System.OsPath.Internal as OsPath+import qualified System.Posix.Directory.Fd as Posix import qualified System.Posix.Directory.PosixPath as Posix import qualified System.Posix.Env.PosixString as Posix+import qualified System.Posix.Files as Posix (FileStatus(..)) import qualified System.Posix.Files.PosixString as Posix+import qualified System.Posix.Internals as Posix (CStat) import qualified System.Posix.IO.PosixString as Posix import qualified System.Posix.PosixPath.FilePath as Posix import qualified System.Posix.Types as Posix import qualified System.Posix.User.ByteString as Posix +c_AT_FDCWD :: Posix.Fd+c_AT_FDCWD = Posix.Fd (#const AT_FDCWD)++c_AT_SYMLINK_NOFOLLOW :: CInt+c_AT_SYMLINK_NOFOLLOW = (#const AT_SYMLINK_NOFOLLOW)++atWhetherFollow :: WhetherFollow -> CInt+atWhetherFollow NoFollow    = c_AT_SYMLINK_NOFOLLOW+atWhetherFollow FollowLinks = 0++defaultOpenFlags :: Posix.OpenFileFlags+defaultOpenFlags =+  Posix.defaultFileFlags+  { Posix.noctty = True+  , Posix.nonBlock = True+  , Posix.cloexec = True+  }++type RawHandle = Posix.Fd++openRaw :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO RawHandle+openRaw whetherFollow dir (OsString path) =+  Posix.openFdAt dir path Posix.ReadOnly flags+  where+    flags = defaultOpenFlags { Posix.nofollow = isNoFollow whetherFollow }++closeRaw :: RawHandle -> IO ()+closeRaw = Posix.closeFd+ createDirectoryInternal :: OsPath -> IO () createDirectoryInternal (OsString path) = Posix.createDirectory path 0o777 +foreign import ccall "unistd.h unlinkat" c_unlinkat+  :: Posix.Fd -> CString -> CInt -> IO CInt++removePathAt :: FileType -> Maybe RawHandle -> OsPath -> IO ()+removePathAt ty dir (OsString path) =+  Posix.withFilePath path $ \ pPath -> do+    Posix.throwErrnoPathIfMinus1_ "unlinkat" path+      (c_unlinkat (fromMaybe c_AT_FDCWD dir) pPath flag)+    pure ()+  where+    flag | fileTypeIsDirectory ty = (#const AT_REMOVEDIR)+         | otherwise              = 0+ removePathInternal :: Bool -> OsPath -> IO () removePathInternal True  = Posix.removeDirectory . getOsString removePathInternal False = Posix.removeLink . getOsString@@ -101,20 +151,25 @@ exeExtensionInternal :: OsString exeExtensionInternal = exeExtension +openDirFromFd :: Posix.Fd -> IO Posix.DirStream+openDirFromFd fd = Posix.unsafeOpenDirStreamFd =<< Posix.dup fd++readDirStreamToEnd :: Posix.DirStream -> IO [OsPath]+readDirStreamToEnd stream = loop id+  where+    loop acc = do+      e <- Posix.readDirStream stream+      if e == mempty+        then pure (acc [])+        else loop (acc . (OsString e :))++readDirToEnd :: RawHandle -> IO [OsPath]+readDirToEnd fd =+  bracket (openDirFromFd fd) Posix.closeDirStream readDirStreamToEnd+ getDirectoryContentsInternal :: OsPath -> IO [OsPath] getDirectoryContentsInternal (OsString path) =-  bracket-    (Posix.openDirStream path)-    Posix.closeDirStream-    start-  where-    start dirp = loop id-      where-        loop acc = do-          e <- Posix.readDirStream dirp-          if e == mempty-            then pure (acc [])-            else loop (acc . (OsString e :))+  bracket (Posix.openDirStream path) Posix.closeDirStream readDirStreamToEnd  getCurrentDirectoryInternal :: IO OsPath getCurrentDirectoryInternal = OsString <$> Posix.getWorkingDirectory@@ -154,6 +209,20 @@  type Metadata = Posix.FileStatus +foreign import capi "sys/stat.h fstatat" c_fstatat+  :: Posix.Fd -> CString -> Ptr Posix.CStat -> CInt -> IO CInt++getMetadataAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO Metadata+getMetadataAt whetherFollow dir (OsString path) =+  Posix.withFilePath path $ \ pPath -> do+    stat <- mallocForeignPtrBytes (#const sizeof(struct stat))+    withForeignPtr stat $ \ pStat -> do+      Posix.throwErrnoPathIfMinus1_ "fstatat" path $ do+        c_fstatat (fromMaybe c_AT_FDCWD dir) pPath pStat flags+    pure (Posix.FileStatus stat)+  where+    flags = atWhetherFollow whetherFollow+ getSymbolicLinkMetadata :: OsPath -> IO Metadata getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus . getOsString @@ -198,6 +267,20 @@ setWriteMode False m = m .&. complement allWriteMode setWriteMode True  m = m .|. allWriteMode +setForceRemoveMode :: Mode -> Mode+setForceRemoveMode m = m .|. Posix.ownerModes++foreign import capi "sys/stat.h fchmodat" c_fchmodat+  :: Posix.Fd -> CString -> Posix.FileMode -> CInt -> IO CInt++setModeAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> Mode -> IO ()+setModeAt whetherFollow dir (OsString path) mode = do+  Posix.withFilePath path $ \ pPath ->+    Posix.throwErrnoPathIfMinus1_ "fchmodat" path $ do+      c_fchmodat (fromMaybe c_AT_FDCWD dir) pPath mode flags+  where+    flags = atWhetherFollow whetherFollow+ setFileMode :: OsPath -> Mode -> IO () setFileMode = Posix.setFileMode . getOsString @@ -244,24 +327,6 @@   ignoreIOExceptions (copyOwnerFromStatus st dst)   ignoreIOExceptions (copyGroupFromStatus st dst) -defaultFlags :: Posix.OpenFileFlags-defaultFlags =-  Posix.defaultFileFlags-  { Posix.noctty = True-  , Posix.nonBlock = True-  , Posix.cloexec = True-  }--openFileForRead :: OsPath -> IO Handle-openFileForRead (OsString p) =-  Posix.fdToHandle =<< Posix.openFd p Posix.ReadOnly defaultFlags--openFileForWrite :: OsPath -> IO Handle-openFileForWrite (OsString p) =-  Posix.fdToHandle =<<-    Posix.openFd p Posix.WriteOnly-      defaultFlags { Posix.creat = Just 0o666, Posix.trunc = True }- -- | Truncate the destination file and then copy the contents of the source -- file to the destination file.  If the destination file already exists, its -- attributes shall remain unchanged.  Otherwise, its attributes are reset to@@ -271,8 +336,8 @@                  -> IO () copyFileContents fromFPath toFPath =   (`ioeAddLocation` "copyFileContents") `modifyIOError` do-    withBinaryHandle (openFileForWrite toFPath) $ \ hTo -> do-      withBinaryHandle (openFileForRead fromFPath) $ \ hFrom -> do+    withBinaryFile toFPath WriteMode $ \ hTo -> do+      withBinaryFile fromFPath ReadMode $ \ hFrom -> do         copyHandleData hFrom hTo  copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())
System/Directory/Internal/Prelude.hs view
@@ -58,7 +58,7 @@ import Control.Monad ((>=>), (<=<), unless, when, replicateM, replicateM_) import Data.Bits ((.&.), (.|.), complement) import Data.Char (isAlpha, isAscii, toLower, toUpper)-import Data.Foldable (for_)+import Data.Foldable (for_, sequenceA_) import Data.Function (on) import Data.Maybe (catMaybes, fromMaybe, maybeToList) import Data.Monoid ((<>), mconcat, mempty)@@ -80,11 +80,13 @@   , allocaArray   , allocaBytes   , allocaBytesAligned+  , mallocForeignPtrBytes   , maybeWith   , nullPtr   , plusPtr   , with   , withArray+  , withForeignPtr   ) import Foreign.C   ( CInt(..)
System/Directory/Internal/Windows.hsc view
@@ -12,7 +12,6 @@ #include <shlobj.h> #include <windows.h> #include <HsBaseConfig.h>-#include <System/Directory/Internal/utility.h> #include <System/Directory/Internal/windows_ext.h> import Prelude () import System.Directory.Internal.Prelude@@ -43,12 +42,27 @@ import qualified System.Win32.WindowsString.Time as Win32 import qualified System.Win32.WindowsString.Types as Win32 +type RawHandle = OsPath++pathAt :: Maybe RawHandle -> OsPath -> OsPath+pathAt dir path = fromMaybe mempty dir </> path++openRaw :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO RawHandle+openRaw _ dir path = pure (pathAt dir path)++closeRaw :: RawHandle -> IO ()+closeRaw _ = pure ()+ createDirectoryInternal :: OsPath -> IO () createDirectoryInternal path =   (`ioeSetOsPath` path) `modifyIOError` do     path' <- furnishPath path     Win32.createDirectory path' Nothing +removePathAt :: FileType -> Maybe RawHandle -> OsPath -> IO ()+removePathAt ty dir path = removePathInternal isDir (pathAt dir path)+  where isDir = fileTypeIsDirectory ty+ removePathInternal :: Bool -> OsPath -> IO () removePathInternal isDir path =   (`ioeSetOsPath` path) `modifyIOError` do@@ -105,28 +119,6 @@   Win32.fILE_SHARE_READ   .|.   Win32.fILE_SHARE_WRITE -openFileForRead :: OsPath -> IO Handle-openFileForRead (OsString path) =-  bracketOnError-    (Win32.createFile-      path-      Win32.gENERIC_READ-      maxShareMode-      Nothing-      Win32.oPEN_EXISTING-      (Win32.fILE_ATTRIBUTE_NORMAL .|. possiblyOverlapped)-      Nothing)-    Win32.closeHandle-    Win32.hANDLEToHandle--possiblyOverlapped :: Win32.FileAttributeOrFlag-#ifdef __IO_MANAGER_WINIO__-possiblyOverlapped | ioSubSystem == IoNative = Win32.fILE_FLAG_OVERLAPPED-                   | otherwise               = 0-#else-possiblyOverlapped = 0-#endif- win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO WindowsPath #ifdef HAVE_GETFINALPATHNAMEBYHANDLEW win32_getFinalPathNameByHandle h flags = do@@ -199,8 +191,7 @@   allocaBytesAligned size align $ \ ptr ->     action (ptr, size)   where size = fromIntegral win32_mAXIMUM_REPARSE_DATA_BUFFER_SIZE-        -- workaround (hsc2hs for GHC < 8.0 don't support #{alignment ...})-        align = #{size char[alignof(HsDirectory_REPARSE_DATA_BUFFER)]}+        align = #{alignment HsDirectory_REPARSE_DATA_BUFFER}  win32_peek_REPARSE_DATA_BUFFER   :: Ptr Win32_REPARSE_DATA_BUFFER -> IO Win32_REPARSE_DATA_BUFFER@@ -418,9 +409,12 @@       pure path  searchPathEnvForExes :: OsString -> IO (Maybe OsPath)-searchPathEnvForExes (OsString binary) =-  (OsString <$>) <$>-    Win32.searchPath Nothing binary (Just (getOsString exeExtension))+searchPathEnvForExes (OsString binary) = search `catch` \e ->+  if ioeGetErrorType e == InvalidArgument+  then pure Nothing+  else throwIO e+ where+  search = (OsString <$>) <$> Win32.searchPath Nothing binary (Just (getOsString exeExtension))  findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)                             -> OsString@@ -430,6 +424,9 @@ exeExtensionInternal :: OsString exeExtensionInternal = exeExtension +readDirToEnd :: RawHandle -> IO [OsPath]+readDirToEnd = getDirectoryContentsInternal+ getDirectoryContentsInternal :: OsPath -> IO [OsPath] getDirectoryContentsInternal path = do   query <- furnishPath (path </> os "*")@@ -544,6 +541,10 @@  type Metadata = Win32.BY_HANDLE_FILE_INFORMATION +getMetadataAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> IO Metadata+getMetadataAt NoFollow    dir path = getSymbolicLinkMetadata (pathAt dir path)+getMetadataAt FollowLinks dir path = getFileMetadata         (pathAt dir path)+ getSymbolicLinkMetadata :: OsPath -> IO Metadata getSymbolicLinkMetadata path =   (`ioeSetOsPath` path) `modifyIOError` do@@ -626,6 +627,12 @@ setWriteMode :: Bool -> Mode -> Mode setWriteMode False m = m .|. Win32.fILE_ATTRIBUTE_READONLY setWriteMode True  m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY++setForceRemoveMode :: Mode -> Mode+setForceRemoveMode m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY++setModeAt :: WhetherFollow -> Maybe RawHandle -> OsPath -> Mode -> IO ()+setModeAt _ dir path = setFileMode (pathAt dir path)  setFileMode :: OsPath -> Mode -> IO () setFileMode path mode =
− System/Directory/Internal/utility.h
@@ -1,6 +0,0 @@-#if !defined(alignof) && __cplusplus < 201103L-# ifdef STDC_HEADERS-#  include <stddef.h>-# endif-# define alignof(x) offsetof(struct { char c; x m; }, m)-#endif
System/Directory/OsPath.hs view
@@ -105,13 +105,12 @@ import Prelude () import System.Directory.Internal import System.Directory.Internal.Prelude+import qualified System.File.OsPath as OS import System.OsPath   ( (<.>)   , (</>)   , addTrailingPathSeparator-  , decodeFS   , dropTrailingPathSeparator-  , encodeFS   , hasTrailingPathSeparator   , isAbsolute   , joinPath@@ -119,10 +118,14 @@   , splitDirectories   , splitSearchPath   , takeDirectory+  , encodeWith   ) import qualified Data.List.NonEmpty as NE import Data.Time (UTCTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import GHC.IO.Encoding.UTF8 ( mkUTF8 )+import GHC.IO.Encoding.UTF16 ( mkUTF16le )+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )  {- $intro A directory contains a series of entries, each of which is a named@@ -392,6 +395,42 @@ removeDirectory :: OsPath -> IO () removeDirectory = removePathInternal True +type Preremover = Maybe RawHandle -> OsPath -> Metadata -> IO ()++noPreremover :: Preremover+noPreremover _ _ _ = pure ()++forcePreremover :: Preremover+forcePreremover dir path metadata = do+  when (fileTypeIsDirectory (fileTypeFromMetadata metadata)+        || not filesAlwaysRemovable) $ do+    setModeAt NoFollow dir path mode+      `catchIOError` \ _ -> pure ()+  where+    mode = setForceRemoveMode (modeFromMetadata metadata)++removeRecursivelyAt+  :: (IO () -> IO ())+  -> ([IO ()] -> IO ())+  -> Preremover+  -> Maybe RawHandle+  -> OsPath+  -> IO ()+removeRecursivelyAt catcher sequencer preremover dir name = catcher $ do+  metadata <- getMetadataAt NoFollow dir name+  preremover dir name metadata+  let+    fileType = fileTypeFromMetadata metadata+    subremovals = do+      when (fileType == Directory) $ do+        bracket (openRaw NoFollow dir name) closeRaw $ \ handle -> do+          -- dropSpecialDotDirs is extremely important! Otherwise it will+          -- recurse into the parent directory and wreak havoc.+          names <- dropSpecialDotDirs <$> readDirToEnd handle+          sequencer (recurse (Just handle) <$> names)+  sequencer [subremovals, removePathAt fileType dir name]+  where recurse = removeRecursivelyAt catcher sequencer preremover+ -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ -- together with its contents and subdirectories. Within this directory, -- symbolic links are removed without affecting their targets.@@ -406,41 +445,13 @@     m <- getSymbolicLinkMetadata path     case fileTypeFromMetadata m of       Directory ->-        removeContentsRecursive path+        removeRecursivelyAt id sequenceA_ noPreremover Nothing path       DirectoryLink ->         ioError (err `ioeSetErrorString` "is a directory symbolic link")       _ ->         ioError (err `ioeSetErrorString` "not a directory")   where err = mkIOError InappropriateType "" Nothing Nothing `ioeSetOsPath` 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.------ This operation is reported to be flaky on Windows so retry logic may--- be advisable. See: https://github.com/haskell/directory/pull/108-removePathRecursive :: OsPath -> IO ()-removePathRecursive path =-  (`ioeAddLocation` "removePathRecursive") `modifyIOError` do-    m <- getSymbolicLinkMetadata path-    case fileTypeFromMetadata m of-      Directory     -> removeContentsRecursive path-      DirectoryLink -> removeDirectory path-      _             -> removeFile path---- | @removeContentsRecursive dir@ removes the contents of the directory--- /dir/ recursively. Symbolic links are removed without affecting their the--- targets.------ This operation is reported to be flaky on Windows so retry logic may--- be advisable. See: https://github.com/haskell/directory/pull/108-removeContentsRecursive :: OsPath -> IO ()-removeContentsRecursive path =-  (`ioeAddLocation` "removeContentsRecursive") `modifyIOError` do-    cont <- listDirectory path-    for_ [path </> x | x <- cont] removePathRecursive-    removeDirectory path- -- | Removes a file or directory at /path/ together with its contents and -- subdirectories. Symbolic links are removed without affecting their -- targets. If the path does not exist, nothing happens.@@ -460,34 +471,19 @@ removePathForcibly :: OsPath -> IO () removePathForcibly path =   (`ioeAddLocation` "removePathForcibly") `modifyIOError` do-    ignoreDoesNotExistError $ do-      m <- getSymbolicLinkMetadata path-      case fileTypeFromMetadata m of-        DirectoryLink -> do-          makeRemovable path-          removeDirectory path-        Directory -> do-          makeRemovable path-          names <- listDirectory path-          sequenceWithIOErrors_ $-            [ removePathForcibly (path </> name) | name <- names ] ++-            [ removeDirectory path ]-        _ -> do-          unless filesAlwaysRemovable (makeRemovable path)-          removeFile path+    removeRecursivelyAt+      ignoreDoesNotExistError+      sequenceWithIOErrors_+      forcePreremover+      Nothing+      path+   where      ignoreDoesNotExistError :: IO () -> IO ()     ignoreDoesNotExistError action =       () <$ tryIOErrorType isDoesNotExistError action -    makeRemovable :: OsPath -> IO ()-    makeRemovable p = (`catchIOError` \ _ -> pure ()) $ do-      perms <- getPermissions p-      setPermissions path perms{ readable = True-                               , searchable = True-                               , writable = True }- {- |'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. The implementation may specify additional constraints which must be@@ -728,7 +724,7 @@                  -> IO () copyFileToHandle fromFPath hTo =   (`ioeAddLocation` "copyFileToHandle") `modifyIOError` do-    withBinaryHandle (openFileForRead fromFPath) $ \ hFrom ->+    withBinaryFile fromFPath ReadMode $ \ hFrom ->       copyHandleData hFrom hTo  -- | Copy the contents of a source file to a destination file, replacing the@@ -756,13 +752,13 @@ withReplacementFile path postAction action =   (`ioeAddLocation` "withReplacementFile") `modifyIOError` do     mask $ \ restore -> do-      -- TODO: AFPP doesn't support openBinaryTempFile yet,-      --       so we have to use this (sad) workaround-      --       (on unix, converts using filesystem encoding, on windows-      --       converts with UTF-16LE)-      d <- decodeFS (takeDirectory path)-      (tmpFPath', hTmp) <- openBinaryTempFile d ".copyFile.tmp"-      tmpFPath <- encodeFS tmpFPath'+      let tmpPath = case encodeWith (mkUTF8 ErrorOnCodingFailure)+                                    (mkUTF16le ErrorOnCodingFailure)+                                    ".copyFile.tmp"+                         of+            Left err -> error ("withReplacementFile: invalid encoding: " ++ show err)+            Right p -> p+      (tmpFPath, hTmp) <- OS.openBinaryTempFile (takeDirectory path) tmpPath       (`onException` ignoreIOExceptions (removeFile tmpFPath)) $ do         r <- (`onException` ignoreIOExceptions (hClose hTmp)) $ do           restore (action hTmp)@@ -1140,8 +1136,7 @@ --   @[ENOTDIR]@ -- listDirectory :: OsPath -> IO [OsPath]-listDirectory path = filter f <$> getDirectoryContents path-  where f filename = filename /= os "." && filename /= os ".."+listDirectory path = dropSpecialDotDirs <$> getDirectoryContents path  -- | Obtain the current working directory as an absolute path. --
changelog.md view
@@ -1,6 +1,16 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.9.0 (Oct 2024)++  * Rely on `file-io` for file I/O.+  * Drop support for `base` older than 4.12.0.+  * Resolve TOCTOU issue with `removeDirectoryRecursive` and+    `removePathForcibly` on POSIX systems.+    (part of [#97](https://github.com/haskell/directory/issues/97))+  * `findExecutable ""` now returns `Nothing`, matching non-Windows systems+    ([#180](https://github.com/haskell/directory/issues/180))+ ## 1.3.8.5 (May 2024)    * Fix regression that causes copying of nonexistent files to create empty
configure view
@@ -3383,6 +3383,13 @@  fi +ac_fn_c_check_func "$LINENO" "utimensat" "ac_cv_func_utimensat"+if test "x$ac_cv_func_utimensat" = xyes+then :+  printf "%s\n" "#define HAVE_UTIMENSAT 1" >>confdefs.h++fi+ ac_fn_c_check_func "$LINENO" "CreateSymbolicLinkW" "ac_cv_func_CreateSymbolicLinkW" if test "x$ac_cv_func_CreateSymbolicLinkW" = xyes then :
configure.ac view
@@ -31,6 +31,7 @@ AC_CHECK_HEADERS([fcntl.h limits.h sys/types.h sys/stat.h time.h])  AC_CHECK_FUNCS([realpath])+AC_CHECK_FUNCS([utimensat]) AC_CHECK_FUNCS([CreateSymbolicLinkW]) AC_CHECK_FUNCS([GetFinalPathNameByHandleW]) 
− directory.buildinfo
@@ -1,1 +0,0 @@-install-includes: HsDirectoryConfig.h
directory.cabal view
@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           directory-version:        1.3.8.5+version:        1.3.9.0 license:        BSD-3-Clause license-file:   LICENSE maintainer:     libraries@haskell.org@@ -11,7 +11,7 @@   directories in a portable way. category:       System build-type:     Configure-tested-with:    GHC == 8.6.5 || == 8.10.7 || == 9.0.2 || == 9.2.4 || == 9.4.3+tested-with:    GHC == 8.10.7 || == 9.0.2 || == 9.2.4 || == 9.4.3  extra-tmp-files:     autom4te.cache@@ -28,7 +28,6 @@     System/Directory/Internal/*.h     configure     configure.ac-    directory.buildinfo     tests/*.hs     tests/util.inl @@ -60,8 +59,9 @@     include-dirs: .      build-depends:-        base     >= 4.11.0 && < 4.21,-        time     >= 1.8.0 && < 1.15+        base     >= 4.13.0 && < 4.21,+        file-io  >= 0.1.4 && < 0.2,+        time     >= 1.8.0 && < 1.15,     if os(windows)         build-depends: Win32 >= 2.13.3 && < 2.15     else
tests/CanonicalizePath.hs view
@@ -154,13 +154,6 @@     T(expectEq) () foo foo9     T(expectEq) () foo foo10 -    -- Make sure long file names can be canonicalized too-    -- (i.e. GetLongPathName by itself won't work)-    createDirectory "verylongdirectoryname"-    vldn <- canonicalizePath "verylongdirectoryname"-    vldn2 <- canonicalizePath "VERYLONGDIRECTORYNAME"-    T(expectEq) () vldn vldn2-   let isWindows = #if defined(mingw32_HOST_OS)         True