handle leveldb corruption
This commit is contained in:
parent
9d8ea96447
commit
2371e91cbc
22
Main.hs
22
Main.hs
@ -210,14 +210,14 @@ deleteLocalStorage = do
|
|||||||
dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
|
dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
|
||||||
when (not dbIsOk) (throwError "database is missing or corrupted")
|
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")
|
when (version /= Just "1") (throwError "database is empty or the schema unsupported")
|
||||||
|
|
||||||
withDB path $ \db -> do
|
withDB path $ \db -> do
|
||||||
badDomains <- L.withIterator db def $ \i ->
|
badDomains <- L.withIterator db def $ \i ->
|
||||||
LS.keySlice i LS.AllKeys LS.Asc
|
LS.keySlice i LS.AllKeys LS.Asc
|
||||||
& LS.filter (\k -> "META:" `B.isPrefixOf ` k
|
& 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.mapM (\k -> L.delete db def k >> return (metaDomain k))
|
||||||
& LS.toList
|
& LS.toList
|
||||||
|
|
||||||
@ -255,7 +255,7 @@ deleteSessionStorage = do
|
|||||||
dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
|
dbIsOk <- liftIO $ D.doesFileExist (path </> "LOCK")
|
||||||
when (not dbIsOk) (throwError "database is missing or corrupted")
|
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")
|
when (version /= Just "1") (throwError "database is empty or the schema unsupported")
|
||||||
|
|
||||||
withDB path $ \db -> do
|
withDB path $ \db -> do
|
||||||
@ -300,6 +300,19 @@ deleteSessionStorage = do
|
|||||||
-- withDB :: FilePath -> (L.DB -> ResourceT IO a) -> Action a
|
-- withDB :: FilePath -> (L.DB -> ResourceT IO a) -> Action a
|
||||||
withDB path f = liftIO $ L.runResourceT (L.open path def >>= f)
|
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
|
-- | Loads the config from a file
|
||||||
loadSettings :: FilePath -> IO Settings
|
loadSettings :: FilePath -> IO Settings
|
||||||
loadSettings path = do
|
loadSettings path = do
|
||||||
@ -318,4 +331,5 @@ loadSettings path = do
|
|||||||
|
|
||||||
-- | Catches any Selda error
|
-- | Catches any Selda error
|
||||||
dbErrors :: S.SeldaError -> Action a
|
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)
|
||||||
|
Loading…
Reference in New Issue
Block a user