From ec4d974dcf71b15545b683790d993b795d4ed8ae Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 26 Jul 2013 18:42:22 -0400
Subject: [PATCH] assistant: Fix deadlock that could occur when adding a lot of
 files at once in indirect mode.

This is a laziness problem. Despite the bang pattern on newfiles, the list
was not being fully evaluated before cleanup was called. Moving cleanup out
to after the list is actually used fixes this.

More evidence that I should be using ResourceT or pipes, if any was needed.
---
 Assistant/Threads/Committer.hs | 14 +++++++-------
 debian/changelog               |  2 ++
 2 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 5c7332ba63..d1fa7224ea 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP, BangPatterns #-}
+{-# LANGUAGE CPP #-}
 
 module Assistant.Threads.Committer where
 
@@ -273,10 +273,11 @@ handleAdds :: Maybe Seconds -> [Change] -> Assistant [Change]
 handleAdds delayadd cs = returnWhen (null incomplete) $ do
 	let (pending, inprocess) = partition isPendingAddChange incomplete
 	direct <- liftAnnex isDirect
-	pending' <- if direct
-		then return pending
+	(pending', cleanup) <- if direct
+		then return (pending, noop)
 		else findnew pending
 	(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess
+	cleanup
 
 	unless (null postponed) $
 		refillChanges postponed
@@ -294,14 +295,13 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
   where
 	(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
 		
-	findnew [] = return []
+	findnew [] = return ([], noop)
 	findnew pending@(exemplar:_) = do
-		(!newfiles, cleanup) <- liftAnnex $
+		(newfiles, cleanup) <- liftAnnex $
 			inRepo (Git.LsFiles.notInRepo False $ map changeFile pending)
-		void $ liftIO cleanup
 		-- note: timestamp info is lost here
 		let ts = changeTime exemplar
-		return $ map (PendingAddChange ts) newfiles
+		return (map (PendingAddChange ts) newfiles, void $ liftIO $ cleanup)
 
 	returnWhen c a
 		| c = return otherchanges
diff --git a/debian/changelog b/debian/changelog
index 9292426297..d99795cb76 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -17,6 +17,8 @@ git-annex (4.20130724) UNRELEASED; urgency=low
     transferred.
   * assistant: Fix NetWatcher to not sync with remotes that have
     remote.<name>.annex-sync set to false.
+  * assistant: Fix deadlock that could occur when adding a lot of files
+    at once in indirect mode.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 23 Jul 2013 12:39:48 -0400