From a8a320bafb35206a62dacad6954c31391ad621b9 Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Mon, 1 Jul 2024 03:12:25 -0700 Subject: [PATCH 1/2] Remove a CanonicalizePath.hs test case When GetFinalPathNameByHandleW is unavailable, canonicalizePath falls back to GetShortPathNameW + GetLongPathNameW, but that not always guaranted to work. The documentation notes, for example: > Resilient File System (ReFS) doesn't support short names. If you call > GetShortPathName on a path that doesn't have any short names on-disk, > the call will succeed, but will return the long-name path instead. https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-getshortpathnamew Both windows-2019 and windows-2022 images on GitHub Actions no longer seem to support GetShortPathNameW and so the tests have now begun to fail. --- tests/CanonicalizePath.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/tests/CanonicalizePath.hs b/tests/CanonicalizePath.hs index 81e303c8..052305c5 100644 --- a/tests/CanonicalizePath.hs +++ b/tests/CanonicalizePath.hs @@ -154,13 +154,6 @@ main _t = do 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 From 73cea1fad09f4cc4cf0b31f9426bf6795d40810b Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Mon, 20 May 2024 01:05:02 -0700 Subject: [PATCH 2/2] Migrate file I/O to file-io --- .github/workflows/build.yml | 11 +++++------ System/Directory/Internal/Common.hs | 11 +++-------- System/Directory/Internal/Posix.hsc | 23 ++--------------------- System/Directory/Internal/Windows.hsc | 22 ---------------------- System/Directory/OsPath.hs | 2 +- changelog.md | 5 +++++ directory.cabal | 7 ++++--- 7 files changed, 20 insertions(+), 61 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 65e3a6d1..c2838ddc 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -14,18 +14,17 @@ jobs: fail-fast: false matrix: include: - - { os: macOS-13, stack: lts-12.26, stack-extra-deps: "bytestring-0.11.3.0, filepath-1.4.100.0, unix-2.8.0.0" } - - { os: macos-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, filepath-1.5.2.0, os-string-2.0.2, unix-2.8.5.1", stack-package-flags: "{directory: {os-string: true}, unix: {os-string: true}}", ghc-flags: -Werror=deprecations } - - { os: ubuntu-latest, ghc: 8.4.4, cabal: 3.0.0.0, overrides: "before_prepare() { sed -i.bak /utimensat/d configure.ac; }" } + - { os: macOS-13, stack: lts-13.30, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.2, filepath-1.4.100.0, unix-2.8.0.0" } + - { os: macos-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.2, filepath-1.5.2.0, os-string-2.0.2, unix-2.8.5.1", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, unix: {os-string: true}}", ghc-flags: -Werror=deprecations } - { os: ubuntu-latest, ghc: 8.6.5, cabal: 3.0.0.0, overrides: "before_prepare() { sed -i.bak /utimensat/d configure.ac; }" } - { os: ubuntu-latest, ghc: 8.10.7, cabal: 3.8.1.0 } - { os: ubuntu-latest, ghc: 9.0.2, cabal: 3.8.1.0 } - { os: ubuntu-latest, ghc: 9.2.4, cabal: 3.8.1.0 } - { os: ubuntu-latest, ghc: 9.4.3, cabal: 3.8.1.0 } - { os: ubuntu-latest, ghc: latest, cabal: latest, cabal-package-flags: +os-string, ghc-flags: -Werror=deprecations } - - { os: windows-latest, stack: lts-12.26, stack-extra-deps: "bytestring-0.11.3.0, filepath-1.4.100.0, time-1.8.0.2, Win32-2.13.3.0", overrides: "before_prepare() { sed -i.bak -e /CreateSymbolicLinkW/d -e /GetFinalPathNameByHandleW/d configure.ac; }" } - - { os: windows-latest, stack: lts-17.5, stack-extra-deps: "bytestring-0.11.3.0, filepath-1.4.100.0, time-1.9.3, Win32-2.13.3.0" } - - { os: windows-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, filepath-1.5.2.0, os-string-2.0.2, time-1.14, Win32-2.14.0.0", stack-package-flags: "{directory: {os-string: true}, Win32: {os-string: true}}", ghc-flags: -Werror=deprecations } + - { os: windows-latest, stack: lts-13.30, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.2, filepath-1.4.100.0, time-1.8.0.2, Win32-2.13.3.0", overrides: "before_prepare() { sed -i.bak -e /CreateSymbolicLinkW/d -e /GetFinalPathNameByHandleW/d configure.ac; }" } + - { os: windows-latest, stack: lts-17.5, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.2, filepath-1.4.100.0, time-1.9.3, Win32-2.13.3.0" } + - { os: windows-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.2, filepath-1.5.2.0, os-string-2.0.2, time-1.14, Win32-2.14.0.0", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, Win32: {os-string: true}}", ghc-flags: -Werror=deprecations } runs-on: ${{ matrix.os }} env: CABAL_PACKAGE_FLAGS: ${{ matrix.cabal-package-flags }} diff --git a/System/Directory/Internal/Common.hs b/System/Directory/Internal/Common.hs index bbf8a9b8..86b95a9e 100644 --- a/System/Directory/Internal/Common.hs +++ b/System/Directory/Internal/Common.hs @@ -8,7 +8,7 @@ import System.Directory.Internal.Prelude 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 @@ -243,13 +243,8 @@ data Permissions , 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 index 27e7f92d..0e4f11c7 100644 --- a/System/Directory/Internal/Posix.hsc +++ b/System/Directory/Internal/Posix.hsc @@ -20,7 +20,6 @@ import qualified System.OsPath.Internal as OsPath import qualified System.Posix.Directory.PosixPath as Posix import qualified System.Posix.Env.PosixString as Posix import qualified System.Posix.Files.PosixString as Posix -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 @@ -244,24 +243,6 @@ tryCopyOwnerAndGroupFromStatus st dst = do 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 +252,8 @@ copyFileContents :: OsPath -- ^ Source filename -> 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/Windows.hsc b/System/Directory/Internal/Windows.hsc index 8c55861c..1c723fb4 100644 --- a/System/Directory/Internal/Windows.hsc +++ b/System/Directory/Internal/Windows.hsc @@ -105,28 +105,6 @@ maxShareMode = 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 diff --git a/System/Directory/OsPath.hs b/System/Directory/OsPath.hs index fc3492e4..db216eed 100644 --- a/System/Directory/OsPath.hs +++ b/System/Directory/OsPath.hs @@ -728,7 +728,7 @@ copyFileToHandle :: OsPath -- ^ Source file -> 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 diff --git a/changelog.md b/changelog.md index d87a2dde..2aca83d8 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,11 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.9.0 (unreleased) + + * Rely on `file-io` for file I/O. + * Drop support for `base` older than 4.12.0. + ## 1.3.8.5 (May 2024) * Fix regression that causes copying of nonexistent files to create empty diff --git a/directory.cabal b/directory.cabal index 7c080242..af35f1d1 100644 --- 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 @@ -60,8 +60,9 @@ Library include-dirs: . build-depends: - base >= 4.11.0 && < 4.21, - time >= 1.8.0 && < 1.15 + base >= 4.12.0 && < 4.21, + file-io >= 0.1.2 && < 0.2, + time >= 1.8.0 && < 1.15, if os(windows) build-depends: Win32 >= 2.13.3 && < 2.15 else