diff --git a/HsDirectoryConfig.h.in b/HsDirectoryConfig.h.in --- a/HsDirectoryConfig.h.in +++ b/HsDirectoryConfig.h.in @@ -48,6 +48,9 @@ /* Define to 1 if you have the 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 diff --git a/System/Directory/Internal/C_utimensat.hsc b/System/Directory/Internal/C_utimensat.hsc --- a/System/Directory/Internal/C_utimensat.hsc +++ b/System/Directory/Internal/C_utimensat.hsc @@ -12,17 +12,16 @@ #ifdef HAVE_SYS_STAT_H # include #endif -#include 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 diff --git a/System/Directory/Internal/Common.hs b/System/Directory/Internal/Common.hs --- a/System/Directory/Internal/Common.hs +++ b/System/Directory/Internal/Common.hs @@ -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 diff --git a/System/Directory/Internal/Posix.hsc b/System/Directory/Internal/Posix.hsc --- a/System/Directory/Internal/Posix.hsc +++ b/System/Directory/Internal/Posix.hsc @@ -1,9 +1,14 @@ +{-# LANGUAGE CApiFFI #-} module System.Directory.Internal.Posix where #include #if !defined(mingw32_HOST_OS) +#include #ifdef HAVE_LIMITS_H # include #endif +#ifdef HAVE_SYS_STAT_H +# include +#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 ()) diff --git a/System/Directory/Internal/Prelude.hs b/System/Directory/Internal/Prelude.hs --- a/System/Directory/Internal/Prelude.hs +++ b/System/Directory/Internal/Prelude.hs @@ -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(..) diff --git a/System/Directory/Internal/Windows.hsc b/System/Directory/Internal/Windows.hsc --- a/System/Directory/Internal/Windows.hsc +++ b/System/Directory/Internal/Windows.hsc @@ -12,7 +12,6 @@ #include #include #include -#include #include 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 = diff --git a/System/Directory/Internal/utility.h b/System/Directory/Internal/utility.h deleted file mode 100644 --- a/System/Directory/Internal/utility.h +++ /dev/null @@ -1,6 +0,0 @@ -#if !defined(alignof) && __cplusplus < 201103L -# ifdef STDC_HEADERS -# include -# endif -# define alignof(x) offsetof(struct { char c; x m; }, m) -#endif diff --git a/System/Directory/OsPath.hs b/System/Directory/OsPath.hs --- a/System/Directory/OsPath.hs +++ b/System/Directory/OsPath.hs @@ -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. -- diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 diff --git a/configure b/configure --- a/configure +++ b/configure @@ -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 : diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -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]) diff --git a/directory.buildinfo b/directory.buildinfo deleted file mode 100644 --- a/directory.buildinfo +++ /dev/null @@ -1,1 +0,0 @@ -install-includes: HsDirectoryConfig.h diff --git a/directory.cabal b/directory.cabal --- a/directory.cabal +++ b/directory.cabal @@ -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 diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs --- a/tests/CanonicalizePath.hs +++ b/tests/CanonicalizePath.hs @@ -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