make git fsck batch-capable
This commit is contained in:
parent
657f9b98cb
commit
ff3f654cbe
4 changed files with 54 additions and 30 deletions
17
Git/Fsck.hs
17
Git/Fsck.hs
|
@ -16,6 +16,7 @@ import Git
|
|||
import Git.Command
|
||||
import Git.Sha
|
||||
import Git.CatFile
|
||||
import Utility.Batch
|
||||
|
||||
import qualified Data.Set as S
|
||||
|
||||
|
@ -31,17 +32,25 @@ type MissingObjects = S.Set Sha
|
|||
- 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 :: Repo -> IO (Maybe MissingObjects)
|
||||
findBroken r = do
|
||||
(output, fsckok) <- processTranscript "git" (toCommand $ fsckParams r) Nothing
|
||||
findBroken :: Bool -> Repo -> IO (Maybe MissingObjects)
|
||||
findBroken batchmode r = do
|
||||
(output, fsckok) <- processTranscript command' (toCommand params') Nothing
|
||||
let objs = parseFsckOutput output
|
||||
badobjs <- findMissing objs r
|
||||
if S.null badobjs && not fsckok
|
||||
then return Nothing
|
||||
else return $ Just badobjs
|
||||
where
|
||||
(command, params) = ("git", fsckParams r)
|
||||
(command', params')
|
||||
| batchmode = toBatchCommand (command, params)
|
||||
| otherwise = (command, params)
|
||||
|
||||
{- Finds objects that are missing from the git repsitory, or are corrupt.
|
||||
- Note that catting a corrupt object will cause cat-file to crash. -}
|
||||
-
|
||||
- Note that catting a corrupt object will cause cat-file to crash;
|
||||
- this is detected and it's restarted.
|
||||
-}
|
||||
findMissing :: [Sha] -> Repo -> IO MissingObjects
|
||||
findMissing objs r = go objs [] =<< start
|
||||
where
|
||||
|
|
|
@ -36,22 +36,22 @@ import qualified Data.ByteString.Lazy as L
|
|||
import System.Log.Logger
|
||||
import Data.Tuple.Utils
|
||||
|
||||
{- Finds and removes corrupt objects from the repository, returning a list
|
||||
- of all such objects, which need to be found elsewhere to finish
|
||||
- recovery.
|
||||
{- Given a set of bad objects found by git fsck, removes all
|
||||
- corrupt objects, and returns a list of missing objects,
|
||||
- which need to be found elsewhere to finish recovery.
|
||||
-
|
||||
- Strategy: Run git fsck, remove objects it identifies as corrupt,
|
||||
- and repeat until git fsck finds no new objects.
|
||||
- Since git fsck may crash on corrupt objects, and so not
|
||||
- report the full set of corrupt or missing objects,
|
||||
- this removes corrupt objects, and re-runs fsck, until it
|
||||
- stabalizes.
|
||||
-
|
||||
- To remove corrupt objects, unpack all packs, and remove the packs
|
||||
- (to handle corrupt packs), and remove loose object files.
|
||||
-}
|
||||
cleanCorruptObjects :: Repo -> IO MissingObjects
|
||||
cleanCorruptObjects r = do
|
||||
notice "Running git fsck ..."
|
||||
check =<< findBroken r
|
||||
cleanCorruptObjects :: Maybe MissingObjects -> Repo -> IO MissingObjects
|
||||
cleanCorruptObjects mmissing r = check mmissing
|
||||
where
|
||||
check Nothing = do
|
||||
check Nothing = do
|
||||
notice "git fsck found a problem but no specific broken objects. Perhaps a corrupt pack file?"
|
||||
ifM (explodePacks r)
|
||||
( retry S.empty
|
||||
|
@ -72,7 +72,7 @@ cleanCorruptObjects r = do
|
|||
else return bad
|
||||
retry oldbad = do
|
||||
notice "Re-running git fsck to see if it finds more problems."
|
||||
v <- findBroken r
|
||||
v <- findBroken False r
|
||||
case v of
|
||||
Nothing -> error $ unwords
|
||||
[ "git fsck found a problem, which was not corrected after removing"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue