diff options
Diffstat (limited to 'Git/Repair.hs')
-rw-r--r-- | Git/Repair.hs | 46 |
1 files changed, 20 insertions, 26 deletions
diff --git a/Git/Repair.hs b/Git/Repair.hs index f1e6818..5afa5f9 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -25,6 +25,7 @@ import Git.Objects import Git.Sha import Git.Types import Git.Fsck +import Git.Index import qualified Git.Config as Config import qualified Git.Construct as Construct import qualified Git.LsTree as LsTree @@ -42,17 +43,16 @@ import qualified Data.ByteString.Lazy as L import Data.Tuple.Utils {- Given a set of bad objects found by git fsck, which may not - - be complete, finds and removes all corrupt objects, and - - returns a list of missing objects, which need to be - - found elsewhere to finish recovery. + - be complete, finds and removes all corrupt objects, + - and returns missing objects. -} -cleanCorruptObjects :: FsckResults -> Repo -> IO (Maybe MissingObjects) +cleanCorruptObjects :: FsckResults -> Repo -> IO FsckResults cleanCorruptObjects fsckresults r = do void $ explodePacks r objs <- listLooseObjectShas r mapM_ (tryIO . allowRead . looseObjectFile r) objs bad <- findMissing objs r - void $ removeLoose r $ S.union bad (fromMaybe S.empty fsckresults) + void $ removeLoose r $ S.union bad (knownMissing fsckresults) -- Rather than returning the loose objects that were removed, re-run -- fsck. Other missing objects may have been in the packs, -- and this way fsck will find them. @@ -98,20 +98,17 @@ explodePacks r = do - If another clone of the repository exists locally, which might not be a - remote of the repo being repaired, its path can be passed as a reference - repository. - - - Can also be run with Nothing, if it's not known which objects are - - missing, just that some are. (Ie, fsck failed badly.) -} -retrieveMissingObjects :: Maybe MissingObjects -> Maybe FilePath -> Repo -> IO (Maybe MissingObjects) +retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults retrieveMissingObjects missing referencerepo r - | missing == Just S.empty = return $ Just S.empty + | not (foundBroken missing) = return missing | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do unlessM (boolSystem "git" [Params "init", File tmpdir]) $ error $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromAbsPath tmpdir stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing - if stillmissing == Just S.empty - then return $ Just S.empty + if S.null (knownMissing stillmissing) + then return stillmissing else pullremotes tmpr (remotes r) fetchallrefs stillmissing where pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of @@ -121,12 +118,12 @@ retrieveMissingObjects missing referencerepo r void $ explodePacks tmpr void $ copyObjects tmpr r case stillmissing of - Nothing -> return $ Just S.empty - Just s -> Just <$> findMissing (S.toList s) r + FsckFailed -> return $ FsckFailed + FsckFoundMissing s -> FsckFoundMissing <$> findMissing (S.toList s) r , return stillmissing ) pullremotes tmpr (rmt:rmts) fetchrefs ms - | ms == Just S.empty = return $ Just S.empty + | not (foundBroken ms) = return ms | otherwise = do putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt ++ "." ifM (fetchfrom (repoLocation rmt) fetchrefs tmpr) @@ -134,10 +131,10 @@ retrieveMissingObjects missing referencerepo r void $ explodePacks tmpr void $ copyObjects tmpr r case ms of - Nothing -> pullremotes tmpr rmts fetchrefs ms - Just s -> do + FsckFailed -> pullremotes tmpr rmts fetchrefs ms + FsckFoundMissing s -> do stillmissing <- findMissing (S.toList s) r - pullremotes tmpr rmts fetchrefs (Just stillmissing) + pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing) , pullremotes tmpr rmts fetchrefs ms ) fetchfrom fetchurl ps = runBool $ @@ -380,9 +377,6 @@ rewriteIndex missing r UpdateIndex.stageFile sha blobtype file r reinject _ = return Nothing -indexFile :: Repo -> FilePath -indexFile r = localGitDir r </> "index" - newtype GoodCommits = GoodCommits (S.Set Sha) emptyGoodCommits :: GoodCommits @@ -452,7 +446,7 @@ runRepair' fsckresult forced referencerepo g = do missing <- cleanCorruptObjects fsckresult g stillmissing <- retrieveMissingObjects missing referencerepo g case stillmissing of - Just s + FsckFoundMissing s | S.null s -> if repoIsLocalBare g then successfulfinish S.empty [] else ifM (checkIndex S.empty g) @@ -474,13 +468,13 @@ runRepair' fsckresult forced referencerepo g = do , "missing objects could not be recovered!" ] unsuccessfulfinish s - Nothing + FsckFailed | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g) ( do - missing' <- cleanCorruptObjects Nothing g + missing' <- cleanCorruptObjects FsckFailed g case missing' of - Nothing -> return (False, S.empty, []) - Just stillmissing' -> continuerepairs stillmissing' + FsckFailed -> return (False, S.empty, []) + FsckFoundMissing stillmissing' -> continuerepairs stillmissing' , corruptedindex ) | otherwise -> unsuccessfulfinish S.empty |