From e005225c0fb5054f352fb97fd6d5b7e12c422400 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 22 Jun 2023 15:40:37 +0200 Subject: [PATCH] Reject index states after last known timestamp --- .../src/Distribution/Client/IndexUtils.hs | 79 +++++++++++-------- changelog.d/index-state-cabal-update | 14 ++++ 2 files changed, 58 insertions(+), 35 deletions(-) create mode 100644 changelog.d/index-state-cabal-update diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 367a5e6fc5c..6608d77afce 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -130,6 +130,8 @@ import Data.Either import Data.List (stripPrefix) import qualified Data.Map as Map import qualified Data.Set as Set +import Data.Time (diffUTCTime, getCurrentTime) +import Data.Time.Clock.POSIX (posixDayLength) import Distribution.Client.GZipUtils (maybeDecompress) import Distribution.Client.Utils ( byteStringToFilePath @@ -320,38 +322,19 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do info verbosity ("index-state(" ++ unRepoName rname ++ ") = " ++ prettyShow (isiHeadTime isi)) return () IndexStateTime ts0 -> do + -- isiMaxTime is the latest timestamp in the filtered view returned by + -- `readRepoIndex` above. It is always true that isiMaxTime is less or + -- equal to a requested IndexStateTime. When `isiMaxTime isi /= ts0` (or + -- equivalently `isiMaxTime isi < ts0`) it means that ts0 falls between + -- two timestamps in the index. when (isiMaxTime isi /= ts0) $ - if ts0 > isiMaxTime isi - then - warn verbosity $ - "Requested index-state " - ++ prettyShow ts0 - ++ " is newer than '" - ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - else - info verbosity $ - "Requested index-state " - ++ prettyShow ts0 - ++ " does not exist in '" - ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - info - verbosity - ( "index-state(" + info verbosity $ + "There is no index-state for '" ++ unRepoName rname - ++ ") = " + ++ "' exactly at the requested timestamp (" + ++ prettyShow ts0 + ++ "). Falling back to the previous index-state that exists: " ++ prettyShow (isiMaxTime isi) - ++ " (HEAD = " - ++ prettyShow (isiHeadTime isi) - ++ ")" - ) pure RepoData @@ -440,15 +423,19 @@ readRepoIndex -> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo) readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do - when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo -- note that if this step fails due to a bad repo cache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) `catchIO` (\e -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e) - readPackageIndexCacheFile - verbosity - mkAvailablePackage - (RepoIndex repoCtxt repo) - idxState + ret@(_, _, isi) <- + readPackageIndexCacheFile + verbosity + mkAvailablePackage + (RepoIndex repoCtxt repo) + idxState + when (isRepoRemote repo) $ do + dieIfRequestedIdxIsNewer isi + warnIfIndexIsOld =<< getIndexFileAge repo + pure ret where mkAvailablePackage pkgEntry = SourcePackage @@ -480,13 +467,25 @@ readRepoIndex verbosity repoCtxt repo idxState = return (mempty, mempty, emptyStateInfo) else ioError e + isOldThreshold :: Double isOldThreshold = 15 -- days + warnIfIndexIsOld dt = do when (dt >= isOldThreshold) $ case repo of RepoRemote{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt RepoSecure{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt RepoLocalNoIndex{} -> return () + dieIfRequestedIdxIsNewer isi = + let latestTime = isiHeadTime isi + in case idxState of + IndexStateTime t -> when (t > latestTime) $ case repo of + RepoRemote{..} -> pure () + RepoSecure{..} -> + die' verbosity $ errRequestedIdxIsNewer repoRemote latestTime t + RepoLocalNoIndex{} -> return () + IndexStateHead -> pure () + errMissingPackageList repoRemote = "The package list for '" ++ unRepoName (remoteRepoName repoRemote) @@ -497,6 +496,16 @@ readRepoIndex verbosity repoCtxt repo idxState = ++ "' is " ++ shows (floor dt :: Int) " days old.\nRun " ++ "'cabal update' to get the latest list of available packages." + errRequestedIdxIsNewer repoRemote maxFound req = + "Latest known index-state for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' (" + ++ prettyShow maxFound + ++ ") is older than the requested index-state (" + ++ prettyShow req + ++ ").\nRun 'cabal update' or set the index-state to a value at or before " + ++ prettyShow maxFound + ++ "." -- | Return the age of the index file in days (as a Double). getIndexFileAge :: Repo -> IO Double diff --git a/changelog.d/index-state-cabal-update b/changelog.d/index-state-cabal-update new file mode 100644 index 00000000000..f40ae672709 --- /dev/null +++ b/changelog.d/index-state-cabal-update @@ -0,0 +1,14 @@ +synopsis: Reject index-state younger than cached index file +packages: cabal-install +prs: #8944 + +description: { + +Requesting to use an index-state younger than the cached version will now fail, +telling the user to use an index-state older or equal to the cached file, or to +run `cabal update`. + +The warning for a non-existing index-state has been also demoted to appear only +on verbose logging. + +}