Commit 92c51628 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Try to regenerate a corrupted 01-index.cache

With this commit, if a corrupted index cache is detected the
`readIndexCache` function now regenerates the index cache and then
reattempt to read the index once (and 'die's if it fails again).
parent 31eddce7
...@@ -79,13 +79,14 @@ import Data.Char (isAlphaNum) ...@@ -79,13 +79,14 @@ import Data.Char (isAlphaNum)
import Data.Maybe (mapMaybe, catMaybes, maybeToList) import Data.Maybe (mapMaybe, catMaybes, maybeToList)
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Data.Int (Int64) import Data.Int (Int64)
import Data.Word
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..)) import Data.Monoid (Monoid(..))
#endif #endif
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.DeepSeq import Control.DeepSeq
import Control.Monad (when, liftM) import Control.Monad (when, liftM)
import Control.Exception (evaluate) import Control.Exception
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import qualified Data.ByteString.Char8 as BSS import qualified Data.ByteString.Char8 as BSS
...@@ -169,7 +170,7 @@ getSourcePackages verbosity repoCtxt = do ...@@ -169,7 +170,7 @@ getSourcePackages verbosity repoCtxt = do
readCacheStrict :: Verbosity -> Index -> (PackageEntry -> pkg) -> IO ([pkg], [Dependency]) readCacheStrict :: Verbosity -> Index -> (PackageEntry -> pkg) -> IO ([pkg], [Dependency])
readCacheStrict verbosity index mkPkg = do readCacheStrict verbosity index mkPkg = do
updateRepoIndexCache verbosity index updateRepoIndexCache verbosity index
cache <- readIndexCache index cache <- readIndexCache verbosity index
withFile (indexFile index) ReadMode $ \indexHnd -> withFile (indexFile index) ReadMode $ \indexHnd ->
packageListFromCache mkPkg indexHnd cache ReadPackageIndexStrict packageListFromCache mkPkg indexHnd cache ReadPackageIndexStrict
...@@ -186,7 +187,8 @@ readRepoIndex verbosity repoCtxt repo = ...@@ -186,7 +187,8 @@ readRepoIndex verbosity repoCtxt repo =
handleNotFound $ do handleNotFound $ do
warnIfIndexIsOld =<< getIndexFileAge repo warnIfIndexIsOld =<< getIndexFileAge repo
updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) updateRepoIndexCache verbosity (RepoIndex repoCtxt repo)
readPackageIndexCacheFile mkAvailablePackage (RepoIndex repoCtxt repo) readPackageIndexCacheFile verbosity mkAvailablePackage
(RepoIndex repoCtxt repo)
where where
mkAvailablePackage pkgEntry = mkAvailablePackage pkgEntry =
...@@ -513,11 +515,12 @@ data ReadPackageIndexMode = ReadPackageIndexStrict ...@@ -513,11 +515,12 @@ data ReadPackageIndexMode = ReadPackageIndexStrict
| ReadPackageIndexLazyIO | ReadPackageIndexLazyIO
readPackageIndexCacheFile :: Package pkg readPackageIndexCacheFile :: Package pkg
=> (PackageEntry -> pkg) => Verbosity
-> (PackageEntry -> pkg)
-> Index -> Index
-> IO (PackageIndex pkg, [Dependency]) -> IO (PackageIndex pkg, [Dependency])
readPackageIndexCacheFile mkPkg index = do readPackageIndexCacheFile verbosity mkPkg index = do
cache <- readIndexCache index cache <- readIndexCache verbosity index
indexHnd <- openFile (indexFile index) ReadMode indexHnd <- openFile (indexFile index) ReadMode
packageIndexFromCache mkPkg indexHnd cache ReadPackageIndexLazyIO packageIndexFromCache mkPkg indexHnd cache ReadPackageIndexLazyIO
...@@ -606,10 +609,33 @@ packageListFromCache mkPkg hnd Cache{..} mode = accum mempty [] mempty cacheEntr ...@@ -606,10 +609,33 @@ packageListFromCache mkPkg hnd Cache{..} mode = accum mempty [] mempty cacheEntr
-- --
-- | Read the 'Index' cache from the filesystem -- | Read the 'Index' cache from the filesystem
readIndexCache :: Index -> IO Cache --
readIndexCache index -- If a corrupted index cache is detected this function regenerates
| is01Index index = decodeFile (cacheFile index) -- the index cache and then reattempt to read the index once (and
| otherwise = liftM read00IndexCache $ BSS.readFile (cacheFile index) -- 'die's if it fails again).
readIndexCache :: Verbosity -> Index -> IO Cache
readIndexCache verbosity index = do
cacheOrFail <- readIndexCache' index
case cacheOrFail of
Left msg -> do
warn verbosity $ concat
[ "Parsing the index cache failed (", msg, "). "
, "Trying to regenerated the index cache..."
]
updatePackageIndexCacheFile verbosity index
either die return =<< readIndexCache' index
Right res -> return res
-- | Read the 'Index' cache from the filesystem without attempting to
-- regenerate on parsing failures.
readIndexCache' :: Index -> IO (Either String Cache)
readIndexCache' index
| is01Index index = decodeFileOrFail' (cacheFile index)
| otherwise = liftM (Right .read00IndexCache) $
BSS.readFile (cacheFile index)
-- | Write the 'Index' cache to the filesystem -- | Write the 'Index' cache to the filesystem
writeIndexCache :: Index -> Cache -> IO () writeIndexCache :: Index -> Cache -> IO ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment