diff options
author | Joey Hess <joey@kitenet.net> | 2013-11-20 17:06:32 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-11-20 17:06:32 -0400 |
commit | 6a154cbb2ce47e33d6e775026cc1f402c7306751 (patch) | |
tree | e671996745dc4c9f59671c5cf84bc5b4828cc1e6 | |
parent | d3aa5938993372daea5c38c28d2b84b9112f1fc3 (diff) | |
download | git-repair-6a154cbb2ce47e33d6e775026cc1f402c7306751.tar.gz |
fix pack exploding
unpack-objects does nothing unless the pack is moved out of the packs
directory.
Also, unpack any packs recevied when fetching.
-rw-r--r-- | Git/Repair.hs | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/Git/Repair.hs b/Git/Repair.hs index 4ae0008..30f31cb 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -117,13 +117,13 @@ explodePacks r = do mapM_ go packs return True where - go packfile = do + go packfile = withTmpFileIn (localGitDir r) "pack" $ \tmp _ -> do + moveFile packfile tmp + nukeFile $ packIdxFile packfile -- May fail, if pack file is corrupt. void $ tryIO $ - pipeWrite [Param "unpack-objects"] r $ \h -> - L.hPut h =<< L.readFile packfile - nukeFile packfile - nukeFile $ packIdxFile packfile + pipeWrite [Param "unpack-objects", Param "-r"] r $ \h -> + L.hPut h =<< L.readFile tmp {- Try to retrieve a set of missing objects, from the remotes of a - repository. Returns any that could not be retreived. @@ -151,6 +151,7 @@ retrieveMissingObjects missing referencerepo r Nothing -> return stillmissing Just p -> ifM (fetchfrom p fetchrefs tmpr) ( do + void $ explodePacks tmpr void $ copyObjects tmpr r case stillmissing of Nothing -> return $ Just S.empty @@ -163,6 +164,7 @@ retrieveMissingObjects missing referencerepo r putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt ifM (fetchfrom (repoLocation rmt) fetchrefs tmpr) ( do + void $ explodePacks tmpr void $ copyObjects tmpr r case ms of Nothing -> pullremotes tmpr rmts fetchrefs ms |