diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 3b80b50dd94..b5201aaf939 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -70,7 +70,7 @@ data CabalInstallException | ReportTargetProblems String | ListBinTargetException String | ResolveWithoutDependency String - | CannotReadCabalFile FilePath + | CannotReadCabalFile FilePath FilePath | ErrorUpdatingIndex FilePath IOException | InternalError FilePath | ReadIndexCache FilePath @@ -390,7 +390,11 @@ exceptionMessageCabalInstall e = case e of ReportTargetProblems problemsMsg -> problemsMsg ListBinTargetException errorStr -> errorStr ResolveWithoutDependency errorStr -> errorStr - CannotReadCabalFile file -> "Cannot read .cabal file inside " ++ file + CannotReadCabalFile expect file -> + "Failed to read " + ++ expect + ++ " from archive " + ++ file ErrorUpdatingIndex name ioe -> "Error while updating index for " ++ name ++ " repository " ++ show ioe InternalError msg -> "internal error when reading package index: " diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 705c62d62d1..bb95610cab6 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -66,6 +66,10 @@ import Distribution.Client.Types import Distribution.Parsec (simpleParsecBS) import Distribution.Verbosity +import Distribution.Client.ProjectConfig + ( CabalFileParseError + , readSourcePackageCabalFile + ) import Distribution.Client.Setup ( RepoContext (..) ) @@ -97,6 +101,7 @@ import Distribution.Simple.Utils , fromUTF8LBS , info , warn + , warnError ) import Distribution.Types.Dependency import Distribution.Types.PackageName (PackageName) @@ -880,14 +885,22 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam where cabalPath = prettyShow pkgid ++ ".cabal" Just pkgId -> do + let tarFile = localDir file -- check for the right named .cabal file in the compressed tarball - tarGz <- BS.readFile (localDir file) + tarGz <- BS.readFile tarFile let tar = GZip.decompress tarGz entries = Tar.read tar + expectFilename = prettyShow pkgId FilePath. prettyShow (packageName pkgId) ++ ".cabal" - case Tar.foldEntries (readCabalEntry pkgId) Nothing (const Nothing) entries of + tarballPackageDescription <- + Tar.foldEntries + (readCabalEntry expectFilename) + (pure Nothing) + (handleTarFormatError tarFile) + entries + case tarballPackageDescription of Just ce -> return (Just ce) - Nothing -> dieWithException verbosity $ CannotReadCabalFile file + Nothing -> dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile let (prefs, gpds) = partitionEithers $ @@ -918,16 +931,41 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam stripSuffix sfx str = fmap reverse (stripPrefix (reverse sfx) (reverse str)) - -- look for /.cabal inside the tarball - readCabalEntry :: PackageIdentifier -> Tar.Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry - readCabalEntry pkgId entry Nothing - | filename == Tar.entryPath entry - , Tar.NormalFile contents _ <- Tar.entryContent entry = - let bs = BS.toStrict contents - in ((`CacheGPD` bs) <$> parseGenericPackageDescriptionMaybe bs) - where - filename = prettyShow pkgId FilePath. prettyShow (packageName pkgId) ++ ".cabal" - readCabalEntry _ _ x = x + handleTarFormatError :: FilePath -> Tar.FormatError -> IO (Maybe NoIndexCacheEntry) + handleTarFormatError tarFile formatError = do + warnError verbosity $ + "Failed to parse " + <> tarFile + <> ": " + <> displayException formatError + pure Nothing + + -- look for `expectFilename` inside the tarball + readCabalEntry + :: FilePath + -> Tar.Entry + -> IO (Maybe NoIndexCacheEntry) + -> IO (Maybe NoIndexCacheEntry) + readCabalEntry expectFilename entry previous' = do + previous <- previous' + case previous of + Just _entry -> pure previous + Nothing -> do + if expectFilename /= Tar.entryPath entry + then pure Nothing + else case Tar.entryContent entry of + Tar.NormalFile contents _fileSize -> do + let bytes = BS.toStrict contents + maybePackageDescription + :: Either CabalFileParseError GenericPackageDescription <- + try $ readSourcePackageCabalFile verbosity expectFilename bytes + case maybePackageDescription of + Left exception -> do + warnError verbosity $ displayException exception + pure Nothing + Right genericPackageDescription -> + pure $ Just $ CacheGPD genericPackageDescription bytes + _ -> pure Nothing withIndexEntries verbosity index callback _ = do -- non-secure repositories withFile (indexFile index) ReadMode $ \h -> do diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 5f31dc0fab5..d5d77d14afe 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -38,6 +38,8 @@ module Distribution.Client.ProjectConfig , writeProjectConfigFile , commandLineFlagsToProjectConfig , onlyTopLevelProvenance + , readSourcePackageCabalFile + , CabalFileParseError (..) -- * Packages within projects , ProjectPackageLocation (..) @@ -1615,7 +1617,7 @@ readSourcePackageCabalFile verbosity pkgfilename content = case runParseResult (parseGenericPackageDescription content) of (warnings, Right pkg) -> do unless (null warnings) $ - info verbosity (formatWarnings warnings) + warn verbosity (formatWarnings warnings) return pkg (warnings, Left (mspecVersion, errors)) -> throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings