From f3419129f0363af70bebb3898d1e8646cc05b8ea Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 20 Dec 2024 00:23:04 +0100 Subject: [PATCH 1/6] Undo hack in OutputNormalizer --- .../src/Test/Cabal/OutputNormalizer.hs | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index beadf91a523..bc16af4f577 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -46,24 +46,6 @@ 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 \\. . (if buildOS == Windows then resub "([A-Z]):\\\\" "\\\\" else id) . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv))) From 74b40a73e8b8b8e9b0048e5811e8fa5d2058e2d1 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 20 Dec 2024 00:25:51 +0100 Subject: [PATCH 2/6] Use RFC-compliant syntax when creating test local repos on Windows --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 6455dbb87b1..0372eb307dd 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -608,11 +608,15 @@ withRepoNoUpdate repo_dir m = do withReaderT (\env' -> env' { testHaveRepo = True }) m -- TODO: Arguably should undo everything when we're done... where - repoUri env ="file+noindex://" ++ (if isWindows - then map (\x -> case x of - '\\' -> '/' - _ -> x) - else id) (testRepoDir env) + repoUri env ="file+noindex://" + ++ (if isWindows + -- Windows paths need a preceeding slash to be compliant with file + -- URI RFCs (8089 and 3986). In particular to be an instance of + -- @path-absolute@. + then ('/' :) . map (\x -> case x of + '\\' -> '/' + _ -> x) + else id) (testRepoDir env) -- | Given a directory (relative to the 'testCurrentDir') containing -- a series of directories representing packages, generate an From de836e0523b53d4907adffff6fda636173cdc156 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 20 Dec 2024 00:26:25 +0100 Subject: [PATCH 3/6] Properly check if a filepath is absolute for different OSes --- cabal-install/src/Distribution/Client/GlobalFlags.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/GlobalFlags.hs b/cabal-install/src/Distribution/Client/GlobalFlags.hs index 6b41a79b5ef..4f3b5ac2d52 100644 --- a/cabal-install/src/Distribution/Client/GlobalFlags.hs +++ b/cabal-install/src/Distribution/Client/GlobalFlags.hs @@ -69,7 +69,7 @@ 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 +import qualified System.FilePath as FilePath -- ------------------------------------------------------------ @@ -192,9 +192,9 @@ withRepoContext' ignoreExpiry extraPaths = \callback -> do for_ localNoIndexRepos $ \local -> - unless (FilePath.Posix.isAbsolute (localRepoPath local)) $ + unless (FilePath.isAbsolute (localRepoPath local)) $ warn verbosity $ - "file+noindex " ++ unRepoName (localRepoName local) ++ " repository path is not absolute; this is fragile, and not recommended" + "file+noindex " ++ unRepoName (localRepoName local) ++ " repository path (" ++ show (localRepoPath local) ++ ") is not absolute; this is fragile, and not recommended" transportRef <- newMVar Nothing let httpLib = From b29a1f068304c81c4a1a17cee695528467577ee1 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 20 Dec 2024 00:27:01 +0100 Subject: [PATCH 4/6] Canonical output of paths to tar archives --- cabal-install/src/Distribution/Client/IndexUtils.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 13ef8c6456d..fd91975c7d4 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -142,7 +142,7 @@ import Distribution.Compat.Directory (listDirectory) import Distribution.Compat.Time (getFileAge, getModTime) import Distribution.Utils.Generic (fstOf3) import Distribution.Utils.Structured (Structured (..), nominalStructure, structuredDecodeFileOrFail, structuredEncodeFile) -import System.Directory (doesDirectoryExist, doesFileExist) +import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute) import System.FilePath ( normalise , splitDirectories @@ -900,7 +900,9 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam entries case tarballPackageDescription of Just ce -> return (Just ce) - Nothing -> dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile + Nothing -> do + tarFile' <- makeAbsolute tarFile + dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile' let (prefs, gpds) = partitionEithers $ @@ -975,7 +977,8 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam -- Here we show the _failure_ to parse the `.cabal` file as -- a warning. This will impact which versions/packages are -- available in your index, so users should know! - warn verbosity $ "In " <> tarFile <> ": " <> displayException exception + tarFile' <- makeAbsolute tarFile + warn verbosity $ "In " <> tarFile' <> ": " <> displayException exception pure Nothing Right genericPackageDescription -> pure $ Just $ CacheGPD genericPackageDescription bytes From 36a09b2a1c4b346a2969212350ae90fffca042f8 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 20 Dec 2024 00:32:28 +0100 Subject: [PATCH 5/6] Rely on file-uri when parsing local+noindex repos --- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/Config.hs | 31 ++++++++++++++++--- 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 68845e4b8b4..e69c49cc120 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -230,6 +230,7 @@ library echo >= 0.1.3 && < 0.2, edit-distance >= 0.2.2 && < 0.3, exceptions >= 0.10.4 && < 0.11, + file-uri >= 0.1 && < 0.2, filepath >= 1.4.0.0 && < 1.6, HTTP >= 4000.1.5 && < 4000.5, mtl >= 2.0 && < 2.4, diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index d4214cc383b..c488a95a9cc 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -110,6 +110,7 @@ import Distribution.Utils.NubList ) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 import qualified Data.Map as M import Distribution.Client.Errors import Distribution.Client.HttpUtils @@ -207,6 +208,10 @@ import Distribution.Simple.Utils , warn ) import Distribution.Solver.Types.ConstraintSource +import Distribution.System + ( OS (Windows) + , buildOS + ) import Distribution.Utils.Path (getSymbolicPath, unsafeMakeSymbolicPath) import Distribution.Verbosity ( normal @@ -215,6 +220,7 @@ import Network.URI ( URI (..) , URIAuth (..) , parseURI + , uriToString ) import System.Directory ( XdgDirectory (XdgCache, XdgConfig, XdgState) @@ -234,6 +240,11 @@ import System.FilePath import System.IO.Error ( isDoesNotExistError ) +import System.URI.File + ( FileURI (..) + , ParseSyntax (..) + , parseFileURI + ) import Text.PrettyPrint ( ($+$) ) @@ -1049,12 +1060,12 @@ readConfigFile initial file = else ioError ioe createDefaultConfigFile :: Verbosity -> [String] -> FilePath -> IO SavedConfig -createDefaultConfigFile verbosity extraLines filePath = do +createDefaultConfigFile verbosity extraLines filepath = do commentConf <- commentSavedConfig initialConf <- initialSavedConfig extraConf <- parseExtraLines verbosity extraLines - notice verbosity $ "Writing default configuration to " ++ filePath - writeConfigFile filePath commentConf (initialConf `mappend` extraConf) + notice verbosity $ "Writing default configuration to " ++ filepath + writeConfigFile filepath commentConf (initialConf `mappend` extraConf) return initialConf writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO () @@ -1692,8 +1703,18 @@ postProcessRepo lineno reponameStr repo0 = do -- TODO: check that there are no authority, query or fragment -- Note: the trailing colon is important "file+noindex:" -> do - let uri = remoteRepoURI repo0 - return $ Left $ LocalRepo reponame (uriPath uri) (uriFragment uri == "#shared-cache") + -- defer to file-uri package which is more accurate when parsing Windows + -- paths + let uri' = BS8.pack $ "file:" ++ uriToString id ((remoteRepoURI repo0) { uriScheme = "" }) [] + case parseFileURI (if buildOS == Windows then ExtendedWindows else ExtendedPosix) uri' of + Left{} -> fail $ "Invalid path in URI: " <> show (remoteRepoURI repo0) + Right uri'' -> + return + $ Left + $ LocalRepo + reponame + (BS8.unpack $ filePath uri'') + (uriFragment (remoteRepoURI repo0) == "#shared-cache") _ -> do let repo = repo0{remoteRepoName = reponame} From 78d99d175ad5c40b85cf9097d4ed28c134d4390c Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Fri, 20 Dec 2024 00:35:03 +0100 Subject: [PATCH 6/6] Clarify documentation about file+noindex repos --- doc/config.rst | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/config.rst b/doc/config.rst index 36a53f958b0..8bc9eb1698e 100644 --- a/doc/config.rst +++ b/doc/config.rst @@ -198,7 +198,9 @@ repository. ``cabal`` will construct the index automatically from the ``package-name-version.tar.gz`` files in the directory, and will use optional -corresponding ``package-name-version.cabal`` files as new revisions. +corresponding ``package-name-version.cabal`` files as new revisions. Note that +Windows should use three slashes too, as in +``file+noindex:///C:/absolute/path/to/directory``. For example, if ``/absolute/path/to/directory`` looks like ::