summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Git/Fsck.hs17
-rw-r--r--Git/RecoverRepository.hs22
-rw-r--r--Utility/Batch.hs38
-rw-r--r--git-recover-repository.hs7
4 files changed, 54 insertions, 30 deletions
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index 5fdc73385..3872c6b04 100644
--- a/Git/Fsck.hs
+++ b/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
diff --git a/Git/RecoverRepository.hs b/Git/RecoverRepository.hs
index c2cad53f2..a109896e7 100644
--- a/Git/RecoverRepository.hs
+++ b/Git/RecoverRepository.hs
@@ -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"
diff --git a/Utility/Batch.hs b/Utility/Batch.hs
index fcd844885..011d30c94 100644
--- a/Utility/Batch.hs
+++ b/Utility/Batch.hs
@@ -44,7 +44,28 @@ batch a = a
maxNice :: Int
maxNice = 19
-{- Runs a command in a way that's suitable for batch jobs.
+{- Converts a command to run niced. -}
+toBatchCommand :: (String, [CommandParam]) -> (String, [CommandParam])
+toBatchCommand (command, params) = (command', params')
+ where
+#ifndef mingw32_HOST_OS
+ commandline = unwords $ map shellEscape $ command : toCommand params
+ nicedcommand
+ | Build.SysConfig.nice = "nice " ++ commandline
+ | otherwise = commandline
+ command' = "sh"
+ params' =
+ [ Param "-c"
+ , Param $ "exec " ++ nicedcommand
+ ]
+#else
+ command' = command
+ params' = params
+#endif
+
+{- Runs a command in a way that's suitable for batch jobs that can be
+ - interrupted.
+ -
- The command is run niced. If the calling thread receives an async
- exception, it sends the command a SIGTERM, and after the command
- finishes shuttting down, it re-raises the async exception. -}
@@ -63,15 +84,6 @@ batchCommandEnv command params environ = do
void $ waitForProcess pid
E.throwIO asyncexception
where
-#ifndef mingw32_HOST_OS
- p = proc "sh"
- [ "-c"
- , "exec " ++ nicedcommand
- ]
- commandline = unwords $ map shellEscape $ command : toCommand params
- nicedcommand
- | Build.SysConfig.nice = "nice " ++ commandline
- | otherwise = commandline
-#else
- p = proc command (toCommand params)
-#endif
+ (command', params') = toBatchCommand (command, params)
+ p = proc command' $ toCommand params'
+
diff --git a/git-recover-repository.hs b/git-recover-repository.hs
index 11a0b3a1c..d2249a433 100644
--- a/git-recover-repository.hs
+++ b/git-recover-repository.hs
@@ -1,6 +1,6 @@
{- git-recover-repository program
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -15,6 +15,7 @@ import qualified Data.Set as S
import Common
import qualified Git
import qualified Git.CurrentRepo
+import qualified Git.Fsck
import qualified Git.RecoverRepository
import qualified Git.Config
import qualified Git.Branch
@@ -46,7 +47,9 @@ main = do
forced <- parseArgs
g <- Git.Config.read =<< Git.CurrentRepo.get
- missing <- Git.RecoverRepository.cleanCorruptObjects g
+ putStrLn "Running git fsck ..."
+ fsckresult <- Git.Fsck.findBroken False g
+ missing <- Git.RecoverRepository.cleanCorruptObjects fsckresult g
stillmissing <- Git.RecoverRepository.retrieveMissingObjects missing g
if S.null stillmissing
then putStr $ unlines