From 85d3807255d63c652708dca601887f949431bdcb 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 | 17 +++++++++++ .../src/Distribution/Client/Config.hs | 12 ++++++-- .../src/Distribution/Client/GlobalFlags.hs | 7 ++--- .../src/Distribution/Client/IndexUtils.hs | 4 +-- .../Client/ProjectConfig/Legacy.hs | 14 ++++++++-- .../src/Test/Cabal/OutputNormalizer.hs | 28 ++++++------------- cabal-testsuite/src/Test/Cabal/Prelude.hs | 6 ++-- changelog.d/pr-10728 | 13 +++++++++ doc/config.rst | 4 +++ 9 files changed, 71 insertions(+), 34 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..34c41e77add 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,15 @@ 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. +asPosixPath :: FilePath -> FilePath +asPosixPath p = + [if x == Windows.pathSeparator then Posix.pathSeparator else x | x <- p] 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..1d79a9949d9 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 ) @@ -189,7 +189,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Network.URI (URI (..), parseURI) import System.Directory (createDirectoryIfMissing, makeAbsolute) -import System.FilePath (isAbsolute, isPathSeparator, makeValid, splitFileName, ()) +import System.FilePath (isAbsolute, isPathSeparator, joinDrive, makeValid, splitFileName, ()) import Text.PrettyPrint ( Doc , render @@ -2040,9 +2040,17 @@ remoteRepoSectionDescr = localToRemote :: LocalRepo -> RemoteRepo localToRemote (LocalRepo name path sharedCache) = (emptyRemoteRepo name) - { remoteRepoURI = URI "file+noindex:" Nothing path "" (if sharedCache then "#shared-cache" else "") + { remoteRepoURI = + URI + "file+noindex:" + Nothing + ((if isWindows then joinDrive "//./" . asPosixPath else id) path) + "" + (if sharedCache then "#shared-cache" else "") } + isWindows = buildOS == Windows + ------------------------------- -- Local field utils -- 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..4e363d4cede --- /dev/null +++ b/changelog.d/pr-10728 @@ -0,0 +1,13 @@ +synopsis: Fix `file+noindex` URI usage on Windows +packages: cabal-install +prs: #10728 +issues: #10703 +significance: + +description: { + +- Windows users can now specify file+noindex paths using 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. + +} 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 ::