summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess <joey@kitenet.net>2013-12-10 15:46:51 -0400
committerJoey Hess <joey@kitenet.net>2013-12-10 15:48:18 -0400
commit444a4dad77289265296d1fa76e060c46497ec6c8 (patch)
tree8195b01fd8f0058d738660430038da23b57ee082
parenta0aab76ae762614041720dd55d63ed3e0b7c1c94 (diff)
downloadgit-repair-444a4dad77289265296d1fa76e060c46497ec6c8.tar.gz
merge from git-annex
-rw-r--r--Git/FilePath.hs15
-rw-r--r--Git/Fsck.hs14
-rw-r--r--Git/Repair.hs90
-rw-r--r--debian/changelog6
4 files changed, 77 insertions, 48 deletions
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
index 37d740f..4189244 100644
--- a/Git/FilePath.hs
+++ b/Git/FilePath.hs
@@ -45,15 +45,24 @@ asTopFilePath :: FilePath -> TopFilePath
asTopFilePath file = TopFilePath file
{- Git may use a different representation of a path when storing
- - it internally. For example, on Windows, git uses '/' to separate paths
- - stored in the repository, despite Windows using '\' -}
+ - it internally.
+ -
+ - On Windows, git uses '/' to separate paths stored in the repository,
+ - despite Windows using '\'. Also, git on windows dislikes paths starting
+ - with "./" or ".\".
+ -
+ -}
type InternalGitPath = String
toInternalGitPath :: FilePath -> InternalGitPath
#ifndef mingw32_HOST_OS
toInternalGitPath = id
#else
-toInternalGitPath = replace "\\" "/"
+toInternalGitPath p =
+ let p' = replace "\\" "/" p
+ in if "./" `isPrefixOf` p'
+ then dropWhile (== '/') (drop 1 p')
+ else p'
#endif
fromInternalGitPath :: InternalGitPath -> FilePath
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index 8d5b75b..5389d46 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -11,6 +11,7 @@ module Git.Fsck (
findBroken,
foundBroken,
findMissing,
+ isMissing,
knownMissing,
) where
@@ -25,6 +26,7 @@ import qualified Data.Set as S
type MissingObjects = S.Set Sha
data FsckResults = FsckFoundMissing MissingObjects | FsckFailed
+ deriving (Show)
{- 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
@@ -59,15 +61,17 @@ knownMissing (FsckFoundMissing s) = s
{- Finds objects that are missing from the git repsitory, or are corrupt.
-
- This does not use git cat-file --batch, because catting a corrupt
- - object can cause it to crash, or to report incorrect size information.a
+ - object can cause it to crash, or to report incorrect size information.
-}
findMissing :: [Sha] -> Repo -> IO MissingObjects
-findMissing objs r = S.fromList <$> filterM (not <$$> present) objs
+findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs
+
+isMissing :: Sha -> Repo -> IO Bool
+isMissing s r = either (const True) (const False) <$> tryIO dump
where
- present o = either (const False) (const True) <$> tryIO (dump o)
- dump o = runQuiet
+ dump = runQuiet
[ Param "show"
- , Param (show o)
+ , Param (show s)
] r
findShas :: String -> [Sha]
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 5afa5f9..b8841fc 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -1,4 +1,5 @@
{- git repository recovery
+import qualified Data.Set as S
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
@@ -14,6 +15,7 @@ module Git.Repair (
resetLocalBranches,
removeTrackingBranches,
checkIndex,
+ checkIndexFast,
missingIndex,
emptyGoodCommits,
) where
@@ -335,35 +337,42 @@ verifyTree missing treesha r
{- Checks that the index file only refers to objects that are not missing,
- and is not itself corrupt. Note that a missing index file is not
- considered a problem (repo may be new). -}
-checkIndex :: MissingObjects -> Repo -> IO Bool
-checkIndex missing r = do
- (bad, _good, cleanup) <- partitionIndex missing r
+checkIndex :: Repo -> IO Bool
+checkIndex r = do
+ (bad, _good, cleanup) <- partitionIndex r
if null bad
then cleanup
else do
void cleanup
return False
+{- Does not check every object the index refers to, but only that the index
+ - itself is not corrupt. -}
+checkIndexFast :: Repo -> IO Bool
+checkIndexFast r = do
+ (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
+ length indexcontents `seq` cleanup
+
missingIndex :: Repo -> IO Bool
missingIndex r = not <$> doesFileExist (localGitDir r </> "index")
-partitionIndex :: MissingObjects -> Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
-partitionIndex missing r = do
+{- Finds missing and ok files staged in the index. -}
+partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
+partitionIndex r = do
(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
- let (bad, good) = partition ismissing indexcontents
- return (bad, good, cleanup)
- where
- getblob (_file, Just sha, Just _mode) = Just sha
- getblob _ = Nothing
- ismissing = maybe False (`S.member` missing) . getblob
+ l <- forM indexcontents $ \i -> case i of
+ (_file, Just sha, Just _mode) -> (,) <$> isMissing sha r <*> pure i
+ _ -> pure (False, i)
+ let (bad, good) = partition fst l
+ return (map snd bad, map snd good, cleanup)
{- Rewrites the index file, removing from it any files whose blobs are
- missing. Returns the list of affected files. -}
-rewriteIndex :: MissingObjects -> Repo -> IO [FilePath]
-rewriteIndex missing r
+rewriteIndex :: Repo -> IO [FilePath]
+rewriteIndex r
| repoIsLocalBare r = return []
| otherwise = do
- (bad, good, cleanup) <- partitionIndex missing r
+ (bad, good, cleanup) <- partitionIndex r
unless (null bad) $ do
nukeFile (indexFile r)
UpdateIndex.streamUpdateIndex r
@@ -425,7 +434,7 @@ preRepair g = do
validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s)
{- Put it all together. -}
-runRepair :: Bool -> Repo -> IO (Bool, MissingObjects, [Branch])
+runRepair :: Bool -> Repo -> IO (Bool, [Branch])
runRepair forced g = do
preRepair g
putStrLn "Running git fsck ..."
@@ -434,31 +443,31 @@ runRepair forced g = do
then runRepair' fsckresult forced Nothing g
else do
putStrLn "No problems found."
- return (True, S.empty, [])
+ return (True, [])
-runRepairOf :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch])
+runRepairOf :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
runRepairOf fsckresult forced referencerepo g = do
preRepair g
runRepair' fsckresult forced referencerepo g
-runRepair' :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, MissingObjects, [Branch])
+runRepair' :: FsckResults -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch])
runRepair' fsckresult forced referencerepo g = do
missing <- cleanCorruptObjects fsckresult g
stillmissing <- retrieveMissingObjects missing referencerepo g
case stillmissing of
FsckFoundMissing s
| S.null s -> if repoIsLocalBare g
- then successfulfinish S.empty []
- else ifM (checkIndex S.empty g)
- ( successfulfinish s []
+ then successfulfinish []
+ else ifM (checkIndex g)
+ ( successfulfinish []
, do
putStrLn "No missing objects found, but the index file is corrupt!"
if forced
then corruptedindex
- else needforce S.empty
+ else needforce
)
| otherwise -> if forced
- then ifM (checkIndex s g)
+ then ifM (checkIndex g)
( continuerepairs s
, corruptedindex
)
@@ -467,17 +476,18 @@ runRepair' fsckresult forced referencerepo g = do
[ show (S.size s)
, "missing objects could not be recovered!"
]
- unsuccessfulfinish s
+ unsuccessfulfinish
FsckFailed
- | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex S.empty g)
+ | forced -> ifM (pure (repoIsLocalBare g) <||> checkIndex g)
( do
missing' <- cleanCorruptObjects FsckFailed g
case missing' of
- FsckFailed -> return (False, S.empty, [])
- FsckFoundMissing stillmissing' -> continuerepairs stillmissing'
+ FsckFailed -> return (False, [])
+ FsckFoundMissing stillmissing' ->
+ continuerepairs stillmissing'
, corruptedindex
)
- | otherwise -> unsuccessfulfinish S.empty
+ | otherwise -> unsuccessfulfinish
where
continuerepairs stillmissing = do
(remotebranches, goodcommits) <- removeTrackingBranches stillmissing emptyGoodCommits g
@@ -492,12 +502,12 @@ runRepair' fsckresult forced referencerepo g = do
"Reset these local branches to old versions before the missing objects were committed:"
displayList (map show deletedbranches)
"Deleted these local branches, which could not be recovered due to missing objects:"
- deindexedfiles <- rewriteIndex stillmissing g
+ deindexedfiles <- rewriteIndex g
displayList deindexedfiles
"Removed these missing files from the index. You should look at what files are present in your working tree and git add them back to the index when appropriate."
let modifiedbranches = resetbranches ++ deletedbranches
if null resetbranches && null deletedbranches
- then successfulfinish stillmissing modifiedbranches
+ then successfulfinish modifiedbranches
else do
unless (repoIsLocalBare g) $ do
mcurr <- Branch.currentUnsafe g
@@ -511,7 +521,7 @@ runRepair' fsckresult forced referencerepo g = do
]
putStrLn "Successfully recovered repository!"
putStrLn "Please carefully check that the changes mentioned above are ok.."
- return (True, stillmissing, modifiedbranches)
+ return (True, modifiedbranches)
corruptedindex = do
nukeFile (indexFile g)
@@ -522,25 +532,25 @@ runRepair' fsckresult forced referencerepo g = do
putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate."
return result
- successfulfinish stillmissing modifiedbranches = do
+ successfulfinish modifiedbranches = do
mapM_ putStrLn
[ "Successfully recovered repository!"
, "You should run \"git fsck\" to make sure, but it looks like everything was recovered ok."
]
- return (True, stillmissing, modifiedbranches)
- unsuccessfulfinish stillmissing = do
+ return (True, modifiedbranches)
+ unsuccessfulfinish = do
if repoIsLocalBare g
then do
putStrLn "If you have a clone of this bare repository, you should add it as a remote of this repository, and retry."
putStrLn "If there are no clones of this repository, you can instead retry with the --force parameter to force recovery to a possibly usable state."
- return (False, stillmissing, [])
- else needforce stillmissing
- needforce stillmissing = do
+ return (False, [])
+ else needforce
+ needforce = do
putStrLn "To force a recovery to a usable state, retry with the --force parameter."
- return (False, stillmissing, [])
+ return (False, [])
-successfulRepair :: (Bool, MissingObjects, [Branch]) -> Bool
-successfulRepair = fst3
+successfulRepair :: (Bool, [Branch]) -> Bool
+successfulRepair = fst
safeReadFile :: FilePath -> IO String
safeReadFile f = do
diff --git a/debian/changelog b/debian/changelog
index 1eb84fc..ca860a8 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+git-repair (1.20131204) UNRELEASED; urgency=low
+
+ * Improve repair of index files in some situations.
+
+ -- Joey Hess <joeyh@debian.org> Tue, 10 Dec 2013 15:46:35 -0400
+
git-repair (1.20131203) unstable; urgency=low
* Fix build deps. Closes: #731179