diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs index df106af5..6465e97f 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ.hs @@ -96,6 +96,7 @@ data NCQStorageException = | NCQStorageTimeout | NCQStorageCurrentAlreadyOpen | NCQStorageCantOpenCurrent + | NCQStorageBrokenCurrent | NCQMergeInvariantFailed String deriving stock (Show,Typeable) @@ -310,11 +311,13 @@ ncqReadTrackedFiles ncq@NCQStorage{} = do files <- ncqListTrackedFiles ncq ncqAddTrackedFilesIO ncq files -ncqWriteError :: MonadIO m => NCQStorage -> Text -> m () +ncqWriteError :: (MonadIO m) => NCQStorage -> Doc AnsiStyle -> m () ncqWriteError ncq txt = liftIO do p <- getPOSIXTime <&> round @_ @Integer - let msg = Text.pack $ show $ "error" <+> fill 12 (pretty p) <+> pretty txt <> line - Text.appendFile (ncqGetErrorLogName ncq) msg + let msg = "error" <+> fill 12 (pretty p) <+> txt + err msg + let msgTxt = fromString $ show (msg <> line) + Text.appendFile (ncqGetErrorLogName ncq) msgTxt ncqIndexFile :: MonadUnliftIO m => NCQStorage -> FilePath -> m FilePath ncqIndexFile n@NCQStorage{} fp' = do @@ -973,14 +976,28 @@ ncqFixIndexes ncq@NCQStorage{..} = do ncqStorageOpen :: MonadUnliftIO m => FilePath -> m NCQStorage ncqStorageOpen fp' = do - fp <- liftIO $ makeAbsolute fp' - ncq@NCQStorage{..} <- ncqStorageInit_ False fp - ncqReadTrackedFiles ncq - ncqFixIndexes ncq - ncqLoadIndexes ncq - readCurrent ncq - atomically $ putTMVar ncqOpenDone True - pure ncq + flip fix 0 $ \next i -> do + fp <- liftIO $ makeAbsolute fp' + ncq@NCQStorage{..} <- ncqStorageInit_ False fp + ncqReadTrackedFiles ncq + ncqFixIndexes ncq + ncqLoadIndexes ncq + + readCurrent ncq `catch` \case + NCQStorageBrokenCurrent | i < 2 -> do + let fn = ncqGetCurrentName ncq + let msg = "broken file" <+> pretty (takeFileName fn) + ncqWriteError ncq msg + let (p,tpl) = splitFileName (dropExtension fn `addExtension` ".broken") + newFn <- liftIO $ emptyTempFile p tpl + mv fn newFn + rm (ncqGetCurrentSizeName ncq) + void $ next (succ i) + + e -> throwIO e + + atomically $ putTMVar ncqOpenDone True + pure ncq where @@ -999,8 +1016,7 @@ ncqStorageOpen fp' = do let p = BS.take w (BS.drop 4 bs) when (BS.length p < w ) do - err $ "broken file" <+> pretty fn - exit () + throwIO NCQStorageBrokenCurrent let k = BS.take 32 p & coerce . BS.copy let vs = w - 32 @@ -1120,8 +1136,7 @@ ncqStorageInit_ check path = do fossilized <- ncqGetNewFossilName ncq0 debug $ "NEW FOSSIL FILE" <+> pretty fossilized let fn = takeFileName fossilized - let msg = fromString $ show $ "wrong-size" <+> pretty lastSz <+> pretty fn - err $ pretty msg + let msg = "wrong-size" <+> pretty lastSz <+> pretty fn ncqWriteError ncq0 msg mv currentName fossilized PFS.setFileSize fossilized (fromIntegral lastSz)