From d345e5b52fadbca33564165d024f755dd0470931 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 22 Oct 2013 16:02:52 -0400 Subject: [PATCH] add git fsck to cronner, and UI for repository repair (not yet wired up) --- Assistant/Alert.hs | 19 ++++++++ Assistant/Threads/Cronner.hs | 35 +++++++++------ Assistant/Threads/WebApp.hs | 1 + Assistant/WebApp/Repair.hs | 26 +++++++++++ Assistant/WebApp/Types.hs | 1 - Assistant/WebApp/routes | 3 ++ Git/Fsck.hs | 17 ++++++-- Git/RecoverRepository.hs | 2 +- Locations.hs | 6 +++ Logs/FsckResults.hs | 43 +++++++++++++++++++ templates/control/repairrepository.hamlet | 25 +++++++++++ templates/control/repairrepository/run.hamlet | 3 ++ 12 files changed, 163 insertions(+), 18 deletions(-) create mode 100644 Assistant/WebApp/Repair.hs create mode 100644 Logs/FsckResults.hs create mode 100644 templates/control/repairrepository.hamlet create mode 100644 templates/control/repairrepository/run.hamlet diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index 3455d05639..4e6dab0331 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -79,6 +79,22 @@ warningAlert name msg = Alert , alertButton = Nothing } +errorAlert :: String -> AlertButton -> Alert +errorAlert msg button = Alert + { alertClass = Error + , alertHeader = Just $ tenseWords ["error"] + , alertMessageRender = renderData + , alertData = [UnTensed $ T.pack msg] + , alertCounter = 0 + , alertBlockDisplay = True + , alertClosable = True + , alertPriority = Pinned + , alertIcon = Just ErrorIcon + , alertCombiner = Nothing + , alertName = Nothing + , alertButton = Just button + } + activityAlert :: Maybe TenseText -> [TenseChunk] -> Alert activityAlert header dat = baseActivityAlert { alertHeader = header @@ -158,6 +174,9 @@ fsckAlert button n = baseActivityAlert , alertButton = Just button } +brokenRepositoryAlert :: AlertButton -> Alert +brokenRepositoryAlert = errorAlert "Your repository needs repairs." + pairingAlert :: AlertButton -> Alert pairingAlert button = baseActivityAlert { alertData = [ UnTensed "Pairing in progress" ] diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs index 8eb3d472ed..786044b200 100644 --- a/Assistant/Threads/Cronner.hs +++ b/Assistant/Threads/Cronner.hs @@ -32,6 +32,8 @@ import Remote import Assistant.WebApp.Types #endif import Git.Remote (RemoteName) +import qualified Git.Fsck +import Logs.FsckResults import Control.Concurrent.Async import Control.Concurrent.MVar @@ -182,15 +184,24 @@ runActivity urlrenderer activity nowt = do runActivity' :: UrlRenderer -> ScheduledActivity -> Assistant () runActivity' urlrenderer (ScheduledSelfFsck _ d) = do program <- liftIO $ readProgramFile - void $ runFsck urlrenderer Nothing $ - batchCommand program (Param "fsck" : fsckParams d) + g <- liftAnnex gitRepo + fsckresults <- showFscking urlrenderer Nothing $ tryNonAsync $ do + r <- Git.Fsck.findBroken True g + void $ batchCommand program (Param "fsck" : annexFsckParams d) + return r + when (Git.Fsck.foundBroken fsckresults) $ do + u <- liftAnnex getUUID + liftAnnex $ writeFsckResults u fsckresults + button <- mkAlertButton True (T.pack "Repair") urlrenderer $ + RepairRepositoryR u + void $ addAlert $ brokenRepositoryAlert button mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir) where reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download runActivity' urlrenderer (ScheduledRemoteFsck u s d) = go =<< liftAnnex (remoteFromUUID u) where go (Just r) = void $ case Remote.remoteFsck r of - Nothing -> void $ runFsck urlrenderer (Just $ Remote.name r) $ do + Nothing -> void $ showFscking urlrenderer (Just $ Remote.name r) $ tryNonAsync $ do program <- readProgramFile batchCommand program $ [ Param "fsck" @@ -198,28 +209,28 @@ runActivity' urlrenderer (ScheduledRemoteFsck u s d) = go =<< liftAnnex (remoteF , Param "--fast" , Param "--from" , Param $ Remote.name r - ] ++ fsckParams d + ] ++ annexFsckParams d Just mkfscker -> {- Note that having mkfsker return an IO action - avoids running a long duration fsck in the - Annex monad. -} - void . runFsck urlrenderer (Just $ Remote.name r) - =<< liftAnnex (mkfscker (fsckParams d)) + void . showFscking urlrenderer (Just $ Remote.name r) . tryNonAsync + =<< liftAnnex (mkfscker (annexFsckParams d)) go Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s] -runFsck :: UrlRenderer -> Maybe RemoteName -> IO Bool -> Assistant Bool -runFsck urlrenderer remotename a = do +showFscking :: UrlRenderer -> Maybe RemoteName -> IO (Either E.SomeException a) -> Assistant a +showFscking urlrenderer remotename a = do #ifdef WITH_WEBAPP button <- mkAlertButton False (T.pack "Configure") urlrenderer ConfigFsckR - r <- alertDuring (fsckAlert button remotename) $ liftIO $ do - E.try a :: IO (Either E.SomeException Bool) + r <- alertDuring (fsckAlert button remotename) $ + liftIO a either (liftIO . E.throwIO) return r #else a #endif -fsckParams :: Duration -> [CommandParam] -fsckParams d = +annexFsckParams :: Duration -> [CommandParam] +annexFsckParams d = [ Param "--incremental-schedule=1d" , Param $ "--time-limit=" ++ fromDuration d ] diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 2c5b1dbd25..a5f4f42011 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -33,6 +33,7 @@ import Assistant.WebApp.Configurators.Fsck import Assistant.WebApp.Documentation import Assistant.WebApp.Control import Assistant.WebApp.OtherRepos +import Assistant.WebApp.Repair import Assistant.Types.ThreadedMonad import Utility.WebApp import Utility.Tmp diff --git a/Assistant/WebApp/Repair.hs b/Assistant/WebApp/Repair.hs new file mode 100644 index 0000000000..1b87a39084 --- /dev/null +++ b/Assistant/WebApp/Repair.hs @@ -0,0 +1,26 @@ +{- git-annex assistant repository repair + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-} + +module Assistant.WebApp.Repair where + +import Assistant.WebApp.Common +import Remote (prettyUUID) + +getRepairRepositoryR :: UUID -> Handler Html +getRepairRepositoryR = postRepairRepositoryR +postRepairRepositoryR :: UUID -> Handler Html +postRepairRepositoryR u = page "Repair repository" Nothing $ do + repodesc <- liftAnnex $ prettyUUID u + $(widgetFile "control/repairrepository") + +getRepairRepositoryRunR :: UUID -> Handler Html +getRepairRepositoryRunR = postRepairRepositoryR +postRepairRepositoryRunR :: UUID -> Handler Html +postRepairRepositoryRunR u = page "Repair repository" Nothing $ do + $(widgetFile "control/repairrepository/run") diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index b98f7d8099..718dbcf732 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -216,4 +216,3 @@ instance PathPiece ThreadName where instance PathPiece ScheduledActivity where toPathPiece = pack . show fromPathPiece = readish . unpack - diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 0ad32811ee..bfe244ba43 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -108,4 +108,7 @@ /transfer/start/#Transfer StartTransferR GET POST /transfer/cancel/#Transfer CancelTransferR GET POST +/repair/#UUID RepairRepositoryR GET POST +/repair/run/#UUID RepairRepositoryRunR GET POST + /static StaticR Static getStatic diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 3872c6b040..2c94230054 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -6,9 +6,11 @@ -} module Git.Fsck ( + FsckResults, + MissingObjects, findBroken, + foundBroken, findMissing, - MissingObjects ) where import Common @@ -22,17 +24,20 @@ import qualified Data.Set as S type MissingObjects = S.Set Sha +{- If fsck succeeded, Just a set of missing objects it found. + - If it failed, Nothing. -} +type FsckResults = Maybe MissingObjects + {- Runs fsck to find some of the broken objects in the repository. - May not find all broken objects, if fsck fails on bad data in some of - - the broken objects it does find. If the fsck fails generally without - - finding any broken objects, returns Nothing. + - the broken objects it does find. - - Strategy: Rather than parsing fsck's current specific output, - look for anything in its output (both stdout and stderr) that appears - to be a git sha. Not all such shas are of broken objects, so ask git - to try to cat the object, and see if it fails. -} -findBroken :: Bool -> Repo -> IO (Maybe MissingObjects) +findBroken :: Bool -> Repo -> IO FsckResults findBroken batchmode r = do (output, fsckok) <- processTranscript command' (toCommand params') Nothing let objs = parseFsckOutput output @@ -46,6 +51,10 @@ findBroken batchmode r = do | batchmode = toBatchCommand (command, params) | otherwise = (command, params) +foundBroken :: FsckResults -> Bool +foundBroken Nothing = True +foundBroken (Just s) = not (S.null s) + {- Finds objects that are missing from the git repsitory, or are corrupt. - - Note that catting a corrupt object will cause cat-file to crash; diff --git a/Git/RecoverRepository.hs b/Git/RecoverRepository.hs index 0563c636b8..f591bd6b2e 100644 --- a/Git/RecoverRepository.hs +++ b/Git/RecoverRepository.hs @@ -48,7 +48,7 @@ import Data.Tuple.Utils - To remove corrupt objects, unpack all packs, and remove the packs - (to handle corrupt packs), and remove loose object files. -} -cleanCorruptObjects :: Maybe MissingObjects -> Repo -> IO MissingObjects +cleanCorruptObjects :: FsckResults -> Repo -> IO MissingObjects cleanCorruptObjects mmissing r = check mmissing where check Nothing = do diff --git a/Locations.hs b/Locations.hs index b96f58d5fe..47a009590c 100644 --- a/Locations.hs +++ b/Locations.hs @@ -28,6 +28,7 @@ module Locations ( gitAnnexBadLocation, gitAnnexUnusedLog, gitAnnexFsckState, + gitAnnexFsckResultsLog, gitAnnexScheduleState, gitAnnexTransferDir, gitAnnexCredsDir, @@ -66,6 +67,7 @@ import Data.Char import Common import Types import Types.Key +import Types.UUID import qualified Git {- Conventions: @@ -193,6 +195,10 @@ gitAnnexUnusedLog prefix r = gitAnnexDir r (prefix ++ "unused") gitAnnexFsckState :: Git.Repo -> FilePath gitAnnexFsckState r = gitAnnexDir r "fsckstate" +{- .git/annex/fsckresults/uuid is used to store results of git fscks -} +gitAnnexFsckResultsLog :: UUID -> Git.Repo -> FilePath +gitAnnexFsckResultsLog u r = gitAnnexDir r "fsckresults" fromUUID u + {- .git/annex/schedulestate is used to store information about when - scheduled jobs were last run. -} gitAnnexScheduleState :: Git.Repo -> FilePath diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs new file mode 100644 index 0000000000..75ed7389cd --- /dev/null +++ b/Logs/FsckResults.hs @@ -0,0 +1,43 @@ +{- git-annex fsck results log files + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.FsckResults ( + writeFsckResults, + readFsckResults +) where + +import Common.Annex +import Utility.Tmp +import Git.Fsck +import Git.Types + +import qualified Data.Set as S + +writeFsckResults :: UUID -> FsckResults -> Annex () +writeFsckResults u fsckresults = do + logfile <- fromRepo $ gitAnnexFsckResultsLog u + liftIO $ + case fsckresults of + Nothing -> store S.empty logfile + Just s + | S.null s -> nukeFile logfile + | otherwise -> store s logfile + where + store s logfile = do + createDirectoryIfMissing True (parentDir logfile) + liftIO $ viaTmp writeFile logfile $ serialize s + serialize = unlines . map show . S.toList + +readFsckResults :: UUID -> Annex FsckResults +readFsckResults u = do + logfile <- fromRepo $ gitAnnexFsckResultsLog u + liftIO $ catchDefaultIO (Just S.empty) $ + deserialize <$> readFile logfile + where + deserialize l = + let s = S.fromList $ map Ref $ lines l + in if S.null s then Nothing else Just s diff --git a/templates/control/repairrepository.hamlet b/templates/control/repairrepository.hamlet new file mode 100644 index 0000000000..3965d22137 --- /dev/null +++ b/templates/control/repairrepository.hamlet @@ -0,0 +1,25 @@ +
+

+ A periodic # + + consistency check # + found corrupt data in the git repository #{repodesc}. +

+ While this is not good, this problem can be automatically repaired, + often without data loss. +

+ When possible, the corrupt data will be recovered from other # + repositories. You should make sure any other repositories # + are available before continuing. Ie, plug in any removable drive # + that contains a repository, or make sure your network connection # + to other repositories is active. +

+ + Start Repair Process +

+
+

+ Repairing #{repodesc} ... +
+

+ This may take some time. diff --git a/templates/control/repairrepository/run.hamlet b/templates/control/repairrepository/run.hamlet new file mode 100644 index 0000000000..30cea4b70b --- /dev/null +++ b/templates/control/repairrepository/run.hamlet @@ -0,0 +1,3 @@ +

+

+ TODO