index file recovery

This commit is contained in:
Joey Hess 2013-10-22 12:58:04 -04:00
parent 5673fbbd72
commit 3e61749d08
6 changed files with 69 additions and 16 deletions

View file

@ -10,6 +10,7 @@ module Git.RecoverRepository (
retrieveMissingObjects,
resetLocalBranches,
removeTrackingBranches,
rewriteIndex,
emptyGoodCommits,
) where
@ -19,17 +20,21 @@ import Git.Command
import Git.Fsck
import Git.Objects
import Git.Sha
import Git.Types
import qualified Git.Config
import qualified Git.Construct
import qualified Git.LsTree as LsTree
import qualified Git.LsFiles as LsFiles
import qualified Git.Ref as Ref
import qualified Git.RefLog as RefLog
import qualified Git.UpdateIndex as UpdateIndex
import Utility.Tmp
import Utility.Rsync
import qualified Data.Set as S
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
@ -349,6 +354,30 @@ verifyTree missing treesha r
-- as long as ls-tree succeeded, we're good
else 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
| repoIsLocalBare r = return []
| otherwise = do
(indexcontents, cleanup) <- LsFiles.stagedDetails [Git.repoPath r] r
let (missing, present) = partition ismissing indexcontents
unless (null missing) $ do
nukeFile (localGitDir r </> "index")
UpdateIndex.streamUpdateIndex r
=<< (catMaybes <$> mapM reinject present)
void cleanup
return $ map fst3 missing
where
getblob (_file, Just sha, Just _mode) = Just sha
getblob _ = Nothing
ismissing = maybe False (`S.member` missing) . getblob
reinject (file, Just sha, Just mode) = case toBlobType mode of
Nothing -> return Nothing
Just blobtype -> Just <$>
UpdateIndex.stageFile sha blobtype file r
reinject _ = return Nothing
newtype GoodCommits = GoodCommits (S.Set Sha)
emptyGoodCommits :: GoodCommits

View file

@ -9,6 +9,7 @@ module Git.Types where
import Network.URI
import qualified Data.Map as M
import System.Posix.Types
{- Support repositories on local disk, and repositories accessed via an URL.
-
@ -81,3 +82,9 @@ readBlobType "100644" = Just FileBlob
readBlobType "100755" = Just ExecutableBlob
readBlobType "120000" = Just SymlinkBlob
readBlobType _ = Nothing
toBlobType :: FileMode -> Maybe BlobType
toBlobType 0o100644 = Just FileBlob
toBlobType 0o100755 = Just ExecutableBlob
toBlobType 0o120000 = Just SymlinkBlob
toBlobType _ = Nothing

View file

@ -13,6 +13,7 @@ module Git.UpdateIndex (
streamUpdateIndex,
lsTree,
updateIndexLine,
stageFile,
unstageFile,
stageSymlink
) where
@ -61,6 +62,11 @@ updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
updateIndexLine sha filetype file =
show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file
stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
stageFile sha filetype file repo = do
p <- toTopFilePath file repo
return $ pureStreamer $ updateIndexLine sha filetype p
{- A streamer that removes a file from the index. -}
unstageFile :: FilePath -> Repo -> IO Streamer
unstageFile file repo = do