add git fsck to cronner, and UI for repository repair (not yet wired up)
This commit is contained in:
parent
44bb9a808f
commit
d345e5b52f
12 changed files with 163 additions and 18 deletions
17
Git/Fsck.hs
17
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;
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue