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 +3/−0
- System/Directory/Internal/C_utimensat.hsc +3/−7
- System/Directory/Internal/Common.hs +13/−8
- System/Directory/Internal/Posix.hsc +97/−32
- System/Directory/Internal/Prelude.hs +3/−1
- System/Directory/Internal/Windows.hsc +35/−28
- System/Directory/Internal/utility.h +0/−6
- System/Directory/OsPath.hs +58/−63
- changelog.md +10/−0
- configure +7/−0
- configure.ac +1/−0
- directory.buildinfo +0/−1
- directory.cabal +5/−5
- tests/CanonicalizePath.hs +0/−7
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