From d2ff4e12d0ae0d32263e258ea7c2a283d1d92149 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 24 Feb 2014 19:36:58 -0400
Subject: repair: Optimise unpacking of pack files, and avoid repeated error
 messages about corrupt pack files.

---
 Git/Repair.hs    | 41 ++++++++++++++++++++++++++---------------
 debian/changelog |  2 ++
 2 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/Git/Repair.hs b/Git/Repair.hs
index 96da5ffe7..cdd70329d 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -75,24 +75,35 @@ removeLoose r s = do
 			return True
 		else return False
 
+{- Explodes all pack files, and deletes them.
+ -
+ - First moves all pack files to a temp dir, before unpacking them each in
+ - turn.
+ -
+ - This is because unpack-objects will not unpack a pack file if it's in the
+ - git repo.
+ -
+ - Also, this prevents unpack-objects from possibly looking at corrupt
+ - pack files to see if they contain an object, while unpacking a
+ - non-corrupt pack file.
+ -}
 explodePacks :: Repo -> IO Bool
-explodePacks r = do
-	packs <- listPackFiles r
-	if null packs
-		then return False
-		else do
-			putStrLn "Unpacking all pack files."
-			mapM_ go packs
-			return True
+explodePacks r = go =<< listPackFiles r
   where
-	go packfile = withTmpFileIn (localGitDir r) "pack" $ \tmp _ -> do
-		moveFile packfile tmp
-		nukeFile $ packIdxFile packfile
-		allowRead tmp
-		-- May fail, if pack file is corrupt.
-		void $ tryIO $
-			pipeWrite [Param "unpack-objects", Param "-r"] r $ \h ->
+	go [] = return False
+	go packs = withTmpDir "packs" $ \tmpdir -> do
+		putStrLn "Unpacking all pack files."
+		forM_ packs $ \packfile -> do
+			moveFile packfile (tmpdir </> takeFileName packfile)
+			nukeFile $ packIdxFile packfile
+		forM_ packs $ \packfile -> do
+			let tmp = tmpdir </> takeFileName packfile
+			allowRead tmp
+			-- May fail, if pack file is corrupt.
+			void $ tryIO $
+				pipeWrite [Param "unpack-objects", Param "-r"] r $ \h ->
 				L.hPut h =<< L.readFile tmp
+		return True
 
 {- Try to retrieve a set of missing objects, from the remotes of a
  - repository. Returns any that could not be retreived.
diff --git a/debian/changelog b/debian/changelog
index a9f2350b6..7d0a186fd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -20,6 +20,8 @@ git-annex (5.20140222) UNRELEASED; urgency=medium
   * webdav: When built with DAV 0.6.0, use the new DAV monad to avoid
     locking files, which is not needed by git-annex's use of webdav, and
     does not work on Box.com.
+  * repair: Optimise unpacking of pack files, and avoid repeated error
+    messages about corrupt pack files.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 21 Feb 2014 13:03:04 -0400
 
-- 
cgit v1.2.3