handle leveldb corruption

master
Michele Guerini Rocco 2021-05-10 22:06:56 +02:00
parent 9d8ea96447
commit 2371e91cbc
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
1 changed files with 18 additions and 4 deletions

22
Main.hs
View File

@ -210,14 +210,14 @@ deleteLocalStorage = do
dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
when (not dbIsOk) (throwError "database is missing or corrupted")
version <- withDB path (\db -> L.get db def "VERSION")
version <- withRetryDB path (\db -> L.get db def "VERSION")
when (version /= Just "1") (throwError "database is empty or the schema unsupported")
withDB path $ \db -> do
badDomains <- L.withIterator db def $ \i ->
LS.keySlice i LS.AllKeys LS.Asc
& LS.filter (\k -> "META:" `B.isPrefixOf ` k
&& (metaDomain k) `notElem` whitelist )
&& (metaDomain k) `notElem` whitelist)
& LS.mapM (\k -> L.delete db def k >> return (metaDomain k))
& LS.toList
@ -255,7 +255,7 @@ deleteSessionStorage = do
dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
when (not dbIsOk) (throwError "database is missing or corrupted")
version <- withDB path (\db -> L.get db def "version")
version <- withRetryDB path (\db -> L.get db def "version")
when (version /= Just "1") (throwError "database is empty or the schema unsupported")
withDB path $ \db -> do
@ -300,6 +300,19 @@ deleteSessionStorage = do
-- withDB :: FilePath -> (L.DB -> ResourceT IO a) -> Action a
withDB path f = liftIO $ L.runResourceT (L.open path def >>= f)
-- | Like 'withDB' but retry the action after repairing the db
--
-- withRetryDB :: FilePath -> (L.DB -> ResourceT IO a) -> Action a
withRetryDB path action = do
res <- CE.try (withDB path action)
case res of
Right b -> return b
Left (e :: BE.IOException) ->
if not ("Corruption" `T.isInfixOf` msg)
then throwError ("error opening the database:\n " <> msg)
else liftIO $ L.repair path def >> withDB path action
where msg = T.pack (BE.displayException e)
-- | Loads the config from a file
loadSettings :: FilePath -> IO Settings
loadSettings path = do
@ -318,4 +331,5 @@ loadSettings path = do
-- | Catches any Selda error
dbErrors :: S.SeldaError -> Action a
dbErrors e = throwError ("database operation failed: " <> T.pack (show e))
dbErrors e = throwError $
"database operation failed: " <> T.pack (BE.displayException e)