From 6a9a53a8db7a3cc1af9e2623eb677146f0ec2ea2 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 9 Jan 2025 00:54:01 +0100 Subject: [PATCH] Fix file+noindex URI usage on Windows --- Cabal-syntax/src/Distribution/Utils/Path.hs | 40 +++++++++++++++++++ Makefile | 2 +- .../src/Distribution/Client/Config.hs | 12 +++++- .../src/Distribution/Client/GlobalFlags.hs | 7 ++-- .../src/Distribution/Client/IndexUtils.hs | 4 +- .../Client/ProjectConfig/Legacy.hs | 27 +++++++++++-- .../Distribution/Client/ProjectConfig.hs | 6 ++- .../src/Test/Cabal/OutputNormalizer.hs | 28 +++++-------- cabal-testsuite/src/Test/Cabal/Prelude.hs | 6 +-- changelog.d/pr-10728 | 14 +++++++ doc/config.rst | 4 ++ 11 files changed, 114 insertions(+), 36 deletions(-) create mode 100644 changelog.d/pr-10728 diff --git a/Cabal-syntax/src/Distribution/Utils/Path.hs b/Cabal-syntax/src/Distribution/Utils/Path.hs index a0f18a1dfdd..fef2fe996a2 100644 --- a/Cabal-syntax/src/Distribution/Utils/Path.hs +++ b/Cabal-syntax/src/Distribution/Utils/Path.hs @@ -67,6 +67,9 @@ module Distribution.Utils.Path -- ** Module names , moduleNameSymbolicPath + + -- * Windows + , asPosixPath ) where import Distribution.Compat.Prelude @@ -86,6 +89,8 @@ import qualified Distribution.Compat.CharParsing as P import qualified System.Directory as Directory import qualified System.FilePath as FilePath +import qualified System.FilePath.Posix as Posix +import qualified System.FilePath.Windows as Windows import Data.Kind ( Type @@ -531,3 +536,38 @@ data Response -- -- See Note [Symbolic paths] in Distribution.Utils.Path. data PkgConf + +------------------------------------------------------------------------------- + +-- * Windows utils + +------------------------------------------------------------------------------- + +-- | Sometimes we need to represent a Windows path (that might have been +-- normalized) as a POSIX path, for example in URIs, as that is what +-- @network-uri@ understands. Furthermore they need to use the @\\.\@ DOS +-- device syntax or otherwise the filepath will be unusable. +-- +-- >>> import Network.URI +-- >>> uriPath <$> parseURI "file+noindex://C:/foo.txt" +-- Just "/foo.txt" +-- >>> parseURI "file+noindex://C:\foo.txt" +-- Nothing +-- >>> uriPath <$> parseURI "file+noindex:///C:/foo.txt" +-- Just "/C:/foo.txt" +-- >>> uriPath <$> parseURI "file+noindex:////./C:/foo.txt" +-- Just "//./C:/foo.txt" +-- +-- Out of the ones above, only the last one can be used from anywhere in the +-- system, after normalization into @"\\\\.\\C:/foo.txt"@ (see filepath#247 for +-- why there is a forward slash there): +-- +-- >>> import Network.URI +-- >>> import qualified System.FilePath.Windows as Windows +-- >>> Windows.normalise . uriPath <$> parseURI "file+noindex:////./C:/foo.txt" +-- Just "\\\\.\\C:/foo.txt" +asPosixPath :: FilePath -> FilePath +asPosixPath p = + -- We don't use 'isPathSeparator' because @Windows.isPathSeparator + -- Posix.pathSeparator == True@. + [if x == Windows.pathSeparator then Posix.pathSeparator else x | x <- p] diff --git a/Makefile b/Makefile index 70e150edebb..639a6a82d2d 100644 --- a/Makefile +++ b/Makefile @@ -125,7 +125,7 @@ ghcid-cli: ## Run ghcid for the cabal-install executable. .PHONY: doctest doctest: ## Run doctests. - cd Cabal-syntax && $(DOCTEST) + cd Cabal-syntax && $(DOCTEST) --build-depends=network-uri cd Cabal-described && $(DOCTEST) cd Cabal && $(DOCTEST) cd cabal-install-solver && $(DOCTEST) diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index d4214cc383b..365d49d85bb 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -227,7 +227,8 @@ import System.Directory , renameFile ) import System.FilePath - ( takeDirectory + ( normalise + , takeDirectory , (<.>) , () ) @@ -1693,7 +1694,14 @@ postProcessRepo lineno reponameStr repo0 = do -- Note: the trailing colon is important "file+noindex:" -> do let uri = remoteRepoURI repo0 - return $ Left $ LocalRepo reponame (uriPath uri) (uriFragment uri == "#shared-cache") + return $ + Left $ + LocalRepo + reponame + -- Normalization of Windows paths that use @//./@ does not fully + -- normalize the path (see filepath#247), but it is still usable. + (normalise (uriPath uri)) + (uriFragment uri == "#shared-cache") _ -> do let repo = repo0{remoteRepoName = reponame} diff --git a/cabal-install/src/Distribution/Client/GlobalFlags.hs b/cabal-install/src/Distribution/Client/GlobalFlags.hs index 6b41a79b5ef..2fd19e71b50 100644 --- a/cabal-install/src/Distribution/Client/GlobalFlags.hs +++ b/cabal-install/src/Distribution/Client/GlobalFlags.hs @@ -57,7 +57,8 @@ import Network.URI , uriScheme ) import System.FilePath - ( () + ( isAbsolute + , () ) import qualified Distribution.Client.Security.DNS as Sec.DNS @@ -69,8 +70,6 @@ import qualified Hackage.Security.Client.Repository.Remote as Sec.Remote import qualified Hackage.Security.Util.Path as Sec import qualified Hackage.Security.Util.Pretty as Sec -import qualified System.FilePath.Posix as FilePath.Posix - -- ------------------------------------------------------------ -- * Global flags @@ -192,7 +191,7 @@ withRepoContext' ignoreExpiry extraPaths = \callback -> do for_ localNoIndexRepos $ \local -> - unless (FilePath.Posix.isAbsolute (localRepoPath local)) $ + unless (isAbsolute (localRepoPath local)) $ warn verbosity $ "file+noindex " ++ unRepoName (localRepoName local) ++ " repository path is not absolute; this is fragile, and not recommended" diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 828c6ea52c3..c01108c2b6e 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -466,7 +466,7 @@ readRepoIndex verbosity repoCtxt repo idxState = RepoSecure{..} -> warn verbosity $ exceptionMessageCabalInstall $ MissingPackageList repoRemote RepoLocalNoIndex local _ -> warn verbosity $ - "Error during construction of local+noindex " + "Error during construction of file+noindex " ++ unRepoName (localRepoName local) ++ " repository index: " ++ show e @@ -526,7 +526,7 @@ whenCacheOutOfDate index action = do then action else if localNoIndex index - then return () -- TODO: don't update cache for local+noindex repositories + then return () -- TODO: don't update cache for file+noindex repositories else do indexTime <- getModTime $ indexFile index cacheTime <- getModTime $ cacheFile index diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 1b6357c335b..b49b6444695 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -175,7 +175,7 @@ import Distribution.Simple.Command , option , reqArg' ) -import Distribution.System (Arch, OS) +import Distribution.System (Arch, OS (Windows), buildOS) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint ) @@ -187,7 +187,7 @@ import Distribution.Utils.Path hiding import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map import qualified Data.Set as Set -import Network.URI (URI (..), parseURI) +import Network.URI (URI (..), nullURIAuth, parseURI) import System.Directory (createDirectoryIfMissing, makeAbsolute) import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) import Text.PrettyPrint @@ -2040,9 +2040,30 @@ remoteRepoSectionDescr = localToRemote :: LocalRepo -> RemoteRepo localToRemote (LocalRepo name path sharedCache) = (emptyRemoteRepo name) - { remoteRepoURI = URI "file+noindex:" Nothing path "" (if sharedCache then "#shared-cache" else "") + { remoteRepoURI = + normaliseFileNoIndexURI buildOS $ + URI + "file+noindex:" + (Just nullURIAuth) + path + "" + (if sharedCache then "#shared-cache" else "") } +-- | When on Windows, we need to convert the path to be POSIX-style. +-- +-- >>> normaliseFileNoIndexURI Windows (URI "file+noindex:" (Just nullURIAuth) "\\.\C:\\dev\\foo" "" "") +-- file+noindex:////./C:/dev/foo +-- +-- See haddocks of 'asPosixPath' for some examples of why this is needed for +-- @network-uri@. +normaliseFileNoIndexURI :: OS -> URI -> URI +normaliseFileNoIndexURI os uri@(URI scheme auth path query fragment) + | "file+noindex:" <- scheme + , Windows <- os = + URI scheme auth (asPosixPath path) query fragment + | otherwise = uri + ------------------------------- -- Local field utils -- diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 1996dab1a1d..91c8dc57966 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -33,6 +33,7 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.Program.Db import Distribution.Simple.Program.Types import Distribution.Simple.Utils (toUTF8BS) +import Distribution.System (OS (Windows), buildOS) import Distribution.Types.PackageVersionConstraint import Distribution.Version @@ -1016,7 +1017,10 @@ instance Arbitrary LocalRepo where arbitrary = LocalRepo <$> arbitrary - <*> elements ["/tmp/foo", "/tmp/bar"] -- TODO: generate valid absolute paths + <*> elements + ( (if buildOS == Windows then map (normalise . ("//./C:" ++)) else id) + ["/tmp/foo", "/tmp/bar"] + ) -- TODO: generate valid absolute paths <*> arbitrary instance Arbitrary PreSolver where diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index beadf91a523..15b5a8a10cb 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -46,25 +46,7 @@ normalizeOutput nenv = . resub (posixRegexEscape "tmp/src-" ++ "[0-9]+") "" . resub (posixRegexEscape (normalizerTmpDir nenv) ++ sameDir) "/" . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv) ++ sameDir) "/" - . (if buildOS == Windows - then - -- OK. Here's the deal. In `./Prelude.hs`, `withRepoNoUpdate` sets - -- `repoUri` to the tmpdir but with backslashes replaced with - -- slashes. This is because Windows treats backslashes and forward - -- slashes largely the same in paths, and backslashes aren't allowed - -- in a URL like `file+noindex://...`. - -- - -- But that breaks the regexes above, which expect the paths to have - -- backslashes. - -- - -- Honestly this whole `normalizeOutput` thing is super janky and - -- worth rewriting from the ground up. To you, poor soul in the - -- future, here is one more hack upon a great pile. Hey, at least all - -- the `PackageTests` function as a test suite for this thing... - resub (posixRegexEscape (backslashToSlash $ normalizerTmpDir nenv) ++ sameDir) "/" - . resub (posixRegexEscape (backslashToSlash $ normalizerCanonicalTmpDir nenv) ++ sameDir) "/" - else id) - -- Munge away C: prefix on filenames (Windows). We convert C:\\ to \\. + -- Munge away C:\ prefix on filenames (Windows). We convert C:\ to \. . (if buildOS == Windows then resub "([A-Z]):\\\\" "\\\\" else id) . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv))) -- Look for 0.1/installed-0d6uzW7Ubh1Fb4TB5oeQ3G @@ -96,6 +78,14 @@ normalizeOutput nenv = else id) . normalizeBuildInfoJson . maybe id normalizePathCmdOutput (normalizerCabalInstallVersion nenv) + -- Munge away \\.\C:/ prefix on paths (Windows). We convert @\\.\C:/@ to + -- @\@. We need to do this before the step above as that one would convert + -- @\\.\@ to @\.\@. + -- + -- These paths might come up in file+noindex URIs due to @filepath@ + -- normalizing @//./C:/foo.txt@ paths to @\\.\C:/foo.txt@, see + -- (filepath#247). + . (if buildOS == Windows then resub "\\\\\\\\\\.\\\\([A-Z]):/" "\\\\" else id) -- hackage-security locks occur non-deterministically . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" "" . resub "installed: [0-9]+(\\.[0-9]+)*" "installed: " diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index daa5472c9d0..b7a14d81165 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -48,7 +48,7 @@ import Distribution.PackageDescription import Test.Utils.TempTestDir (withTestDir) import Distribution.Verbosity (normal) import Distribution.Utils.Path - ( makeSymbolicPath, relativeSymbolicPath, interpretSymbolicPathCWD ) + ( asPosixPath, makeSymbolicPath, relativeSymbolicPath, interpretSymbolicPathCWD ) import Distribution.Compat.Stack @@ -613,9 +613,7 @@ withRepoNoUpdate repo_dir m = do -- TODO: Arguably should undo everything when we're done... where repoUri env ="file+noindex://" ++ (if isWindows - then map (\x -> case x of - '\\' -> '/' - _ -> x) + then joinDrive "//./" . asPosixPath else id) (testRepoDir env) -- | Given a directory (relative to the 'testCurrentDir') containing diff --git a/changelog.d/pr-10728 b/changelog.d/pr-10728 new file mode 100644 index 00000000000..1f960058507 --- /dev/null +++ b/changelog.d/pr-10728 @@ -0,0 +1,14 @@ +synopsis: Fix `file+noindex` URI usage on Windows +packages: cabal-install +prs: #10728 +issues: #10703 +significance: + +description: { + +- `file+noindex` repositories in Windows systems must use the format `file+noindex:////./C:/path/to/repo`. + This syntax comes from https://learn.microsoft.com/en-us/dotnet/standard/io/file-path-formats#dos-device-paths, + and is the only syntax for DOS paths fully supported by the `network-uri` package, which Cabal uses to + interpret URIs in repository stanzas. + +} diff --git a/doc/config.rst b/doc/config.rst index 36a53f958b0..9f4ccc18318 100644 --- a/doc/config.rst +++ b/doc/config.rst @@ -200,6 +200,10 @@ repository. ``package-name-version.tar.gz`` files in the directory, and will use optional corresponding ``package-name-version.cabal`` files as new revisions. +.. note:: + On Windows systems, the path has to be prefixed by ``//./`` as in + ``url: file+noindex:////./C:/absolute/path/to/directory``. + For example, if ``/absolute/path/to/directory`` looks like ::