From 34169183ede5b1fe32417b71a9e9f5b6663e6076 Mon Sep 17 00:00:00 2001 From: Gershom Bazerman Date: Fri, 11 Feb 2022 18:33:55 -0500 Subject: [PATCH 1/3] don't crash on a few stray exceptions --- cabal-install/src/Distribution/Client/CmdUpdate.hs | 3 ++- cabal-install/src/Distribution/Client/IndexUtils.hs | 7 +++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index b205dfda348..ed3476d5545 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -13,6 +13,7 @@ module Distribution.Client.CmdUpdate ( ) where import Prelude () +import Control.Exception import Distribution.Client.Compat.Prelude import Distribution.Client.NixStyleOptions @@ -209,7 +210,7 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do case updated of Sec.NoUpdates -> do now <- getCurrentTime - setModificationTime (indexBaseName repo <.> "tar") now + _ <- try $ setModificationTime (indexBaseName repo <.> "tar") now :: IO (Either SomeException ()) noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " is up to date at index-state " ++ prettyShow (IndexStateTime current_ts) diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 02bcd081f6c..6339dafb298 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -365,7 +365,8 @@ readRepoIndex :: Verbosity -> RepoContext -> Repo -> RepoIndexState readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo - updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) + -- note that if this step fails due to a bad repocache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. + _ <- try $ updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) :: IO (Either SomeException ()) readPackageIndexCacheFile verbosity mkAvailablePackage (RepoIndex repoCtxt repo) idxState @@ -1068,7 +1069,9 @@ readIndexTimestamp index `catchIO` \e -> if isDoesNotExistError e then return Nothing - else ioError e + else do + putStrLn $ "Warning: could not read current index timestamp: " ++ show e + return Nothing -- | Optimise sharing of equal values inside 'Cache' -- From 4be36fafb5625a3e42fe00c8c0ca41b06eabb35c Mon Sep 17 00:00:00 2001 From: Gershom Bazerman Date: Fri, 11 Feb 2022 19:59:22 -0500 Subject: [PATCH 2/3] try -> catch and display --- cabal-install/src/Distribution/Client/CmdUpdate.hs | 5 +++-- cabal-install/src/Distribution/Client/IndexUtils.hs | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index ed3476d5545..91a0d6fd6ca 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -43,7 +44,7 @@ import Distribution.Client.Setup import Distribution.Simple.Flag ( fromFlagOrDefault ) import Distribution.Simple.Utils - ( die', notice, wrapText, writeFileAtomic, noticeNoWrap ) + ( die', notice, wrapText, writeFileAtomic, noticeNoWrap, warn ) import Distribution.Verbosity ( normal, lessVerbose ) import Distribution.Client.IndexUtils.Timestamp @@ -210,7 +211,7 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do case updated of Sec.NoUpdates -> do now <- getCurrentTime - _ <- try $ setModificationTime (indexBaseName repo <.> "tar") now :: IO (Either SomeException ()) + setModificationTime (indexBaseName repo <.> "tar") now `catch` (\(e :: SomeException) -> warn verbosity $ "Could not set modification time of index tarball -- " ++ show e) noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " is up to date at index-state " ++ prettyShow (IndexStateTime current_ts) diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 6339dafb298..4a734dabd67 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -366,7 +366,7 @@ readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo -- note that if this step fails due to a bad repocache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. - _ <- try $ updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) :: IO (Either SomeException ()) + updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) `catch` (\(e :: SomeException) -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e) readPackageIndexCacheFile verbosity mkAvailablePackage (RepoIndex repoCtxt repo) idxState From c58432707f97c716647ecf2cdd8dc2366f5704fe Mon Sep 17 00:00:00 2001 From: Gershom Bazerman Date: Tue, 22 Feb 2022 13:49:56 -0500 Subject: [PATCH 3/3] act on reviewer comments --- cabal-install/src/Distribution/Client/CmdUpdate.hs | 3 ++- cabal-install/src/Distribution/Client/IndexUtils.hs | 13 +++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index 91a0d6fd6ca..693ae3cba9c 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -211,7 +211,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do case updated of Sec.NoUpdates -> do now <- getCurrentTime - setModificationTime (indexBaseName repo <.> "tar") now `catch` (\(e :: SomeException) -> warn verbosity $ "Could not set modification time of index tarball -- " ++ show e) + setModificationTime (indexBaseName repo <.> "tar") now `catchIO` + (\e -> warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e) noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " is up to date at index-state " ++ prettyShow (IndexStateTime current_ts) diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 4a734dabd67..48277395870 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -247,7 +247,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do " as explicitly requested (via command line / project configuration)" return idxState Nothing -> do - mb_idxState' <- readIndexTimestamp (RepoIndex repoCtxt r) + mb_idxState' <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) case mb_idxState' of Nothing -> do info verbosity "Using most recent state (could not read timestamp file)" @@ -366,7 +366,8 @@ readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo -- note that if this step fails due to a bad repocache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. - updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) `catch` (\(e :: SomeException) -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e) + 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 @@ -1055,7 +1056,7 @@ writeIndexTimestamp index st -- timestamp you would use to revert to this version currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp currentIndexTimestamp verbosity repoCtxt r = do - mb_is <- readIndexTimestamp (RepoIndex repoCtxt r) + mb_is <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) case mb_is of Just (IndexStateTime ts) -> return ts _ -> do @@ -1063,14 +1064,14 @@ currentIndexTimestamp verbosity repoCtxt r = do return (isiHeadTime isi) -- | Read the 'IndexState' from the filesystem -readIndexTimestamp :: Index -> IO (Maybe RepoIndexState) -readIndexTimestamp index +readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState) +readIndexTimestamp verbosity index = fmap simpleParsec (readFile (timestampFile index)) `catchIO` \e -> if isDoesNotExistError e then return Nothing else do - putStrLn $ "Warning: could not read current index timestamp: " ++ show e + warn verbosity $ "Warning: could not read current index timestamp: " ++ displayException e return Nothing -- | Optimise sharing of equal values inside 'Cache'