fix last zombies in the assistant

Made Git.LsFiles return cleanup actions, and everything waits on
processes now, except of course for Seek.

Annex/Branch.hs

@@ -262,7 +262,9 @@ files = do
 	update
 	withIndex $ do
 		bfiles <- inRepo $ Git.Command.pipeNullSplitZombie
-			[Params "ls-tree --name-only -r -z", Param $ show fullname]
+			[ Params "ls-tree --name-only -r -z"
+			, Param $ show fullname
+			]
 		jfiles <- getJournalledFiles
 		return $ jfiles ++ bfiles
 

Assistant/Threads/Committer.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns #-}
 
 module Assistant.Threads.Committer where
 
@@ -174,8 +174,9 @@ handleAdds delayadd st changechan transferqueue dstatus cs = returnWhen (null in
 		
 		findnew [] = return []
 		findnew pending = do
-			newfiles <- runThreadState st $
+			(!newfiles, cleanup) <- runThreadState st $
 				inRepo (Git.LsFiles.notInRepo False $ map changeFile pending)
+			void cleanup
 			-- note: timestamp info is lost here
 			let ts = changeTime (pending !! 0)
 			return $ map (PendingAddChange ts) newfiles

Assistant/Threads/SanityChecker.hs

@@ -76,7 +76,7 @@ check :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO
 check st dstatus transferqueue changechan = do
 	g <- runThreadState st $ fromRepo id
 	-- Find old unstaged symlinks, and add them to git.
-	unstaged <- Git.LsFiles.notInRepo False ["."] g
+	(unstaged, cleanup) <- Git.LsFiles.notInRepo False ["."] g
 	now <- getPOSIXTime
 	forM_ unstaged $ \file -> do
 		ms <- catchMaybeIO $ getSymbolicLinkStatus file
@@ -85,6 +85,7 @@ check st dstatus transferqueue changechan = do
 				| isSymbolicLink s ->
 					addsymlink file ms
 			_ -> noop
+	void cleanup
 	return True
 	where
 		toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)

Assistant/Threads/TransferScanner.hs

@@ -94,8 +94,9 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
 	liftIO $ debug thisThread ["starting scan of", show visiblers]
 	void $ alertWhile dstatus (scanAlert visiblers) $ do
 		g <- runThreadState st $ fromRepo id
-		files <- LsFiles.inRepo [] g
+		(files, cleanup) <- LsFiles.inRepo [] g
 		go files
+		void cleanup
 		return True
 	liftIO $ debug thisThread ["finished scan of", show visiblers]
 	where

Command/Sync.hs

@@ -196,11 +196,13 @@ mergeFrom branch = do
 resolveMerge :: Annex Bool
 resolveMerge = do
 	top <- fromRepo Git.repoPath
-	merged <- all id <$> (mapM resolveMerge' =<< inRepo (LsFiles.unmerged [top]))
+	(fs, cleanup) <- inRepo (LsFiles.unmerged [top])
+	merged <- all id <$> mapM resolveMerge' fs
 	when merged $ do
 		Annex.Queue.flush
 		void $ inRepo $ Git.Command.runBool "commit"
 			[Param "-m", Param "git-annex automatic merge conflict fix"]
+	void $ liftIO cleanup
 	return merged
 
 resolveMerge' :: LsFiles.Unmerged -> Annex Bool

Command/Unannex.hs

@@ -39,12 +39,14 @@ cleanup file key = do
 	-- Commit that removal now, to avoid later confusing the
 	-- pre-commit hook if this file is later added back to
 	-- git as a normal, non-annexed file.
-	whenM (not . null <$> inRepo (LsFiles.staged [file])) $ do
+	(s, clean) <- inRepo $ LsFiles.staged [file]
+	when (not $ null s) $ do
 		showOutput
 		inRepo $ Git.Command.run "commit" [
 			Param "-q",
 			Params "-m", Param "content removed from git annex",
 			Param "--", File file]
+	void $ liftIO clean
 
 	ifM (Annex.getState Annex.fast)
 		( do

Command/Unused.hs

@@ -228,10 +228,14 @@ withKeysReferencedM a = withKeysReferenced' () calla
 		calla k _ = a k
 
 withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v
-withKeysReferenced' initial a = go initial =<< files
+withKeysReferenced' initial a = do
+	(files, clean) <- getfiles
+	r <- go initial files
+	liftIO $ void clean
+	return r
 	where
-		files = ifM isBareRepo
-			( return []
+		getfiles = ifM isBareRepo
+			( return ([], return True)
 			, do
 				top <- fromRepo Git.repoPath
 				inRepo $ LsFiles.inRepo [top]

Git/Command.hs

@@ -89,10 +89,13 @@ pipeNullSplit params repo = do
 	where
 		sep = "\0"
 
-{- Does not wait on the git command when it's done, so produces
- - one zombie. -}
+
 pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String]
-pipeNullSplitZombie params repo = fst <$> pipeNullSplit params repo
+pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
+
+{- Doesn't run the cleanup action. A zombie results. -}
+leaveZombie :: (a, IO Bool) -> a
+leaveZombie = fst
 
 {- Reaps any zombie git processes. 
  -

Git/LsFiles.hs

@@ -25,12 +25,12 @@ import Git.Types
 import Git.Sha
 
 {- Scans for files that are checked into git at the specified locations. -}
-inRepo :: [FilePath] -> Repo -> IO [FilePath]
-inRepo l = pipeNullSplitZombie $ Params "ls-files --cached -z --" : map File l
+inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
 
 {- Scans for files at the specified locations that are not checked into git. -}
-notInRepo :: Bool -> [FilePath] -> Repo -> IO [FilePath]
-notInRepo include_ignored l repo = pipeNullSplitZombie params repo
+notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+notInRepo include_ignored l repo = pipeNullSplit params repo
 	where
 		params = [Params "ls-files --others"] ++ exclude ++
 			[Params "-z --"] ++ map File l
@@ -39,44 +39,44 @@ notInRepo include_ignored l repo = pipeNullSplitZombie params repo
 			| otherwise = [Param "--exclude-standard"]
 
 {- Returns a list of all files that are staged for commit. -}
-staged :: [FilePath] -> Repo -> IO [FilePath]
+staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 staged = staged' []
 
 {- Returns a list of the files, staged for commit, that are being added,
  - moved, or changed (but not deleted), from the specified locations. -}
-stagedNotDeleted :: [FilePath] -> Repo -> IO [FilePath]
+stagedNotDeleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
 
-staged' :: [CommandParam] -> [FilePath] -> Repo -> IO [FilePath]
-staged' ps l = pipeNullSplitZombie $ prefix ++ ps ++ suffix
+staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
 	where
 		prefix = [Params "diff --cached --name-only -z"]
 		suffix = Param "--" : map File l
 
 {- Returns a list of files that have unstaged changes. -}
-changedUnstaged :: [FilePath] -> Repo -> IO [FilePath]
-changedUnstaged l = pipeNullSplitZombie params
+changedUnstaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+changedUnstaged l = pipeNullSplit params
 	where
 		params = Params "diff --name-only -z --" : map File l
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}
-typeChangedStaged :: [FilePath] -> Repo -> IO [FilePath]
+typeChangedStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 typeChangedStaged = typeChanged' [Param "--cached"]
 
 {- Returns a list of the files in the specified locations whose type has
  - changed.  Files only staged for commit will not be included. -}
-typeChanged :: [FilePath] -> Repo -> IO [FilePath]
+typeChanged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 typeChanged = typeChanged' []
 
-typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO [FilePath]
+typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 typeChanged' ps l repo = do
-	fs <- pipeNullSplitZombie (prefix ++ ps ++ suffix) repo
+	(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
 	-- git diff returns filenames relative to the top of the git repo;
 	-- convert to filenames relative to the cwd, like git ls-files.
 	let top = repoPath repo
 	cwd <- getCurrentDirectory
-	return $ map (\f -> relPathDirToFile cwd $ top </> f) fs
+	return (map (\f -> relPathDirToFile cwd $ top </> f) fs, cleanup)
 	where
 		prefix = [Params "diff --name-only --diff-filter=T -z"]
 		suffix = Param "--" : map File l
@@ -104,12 +104,12 @@ data Unmerged = Unmerged
  -   3 = them
  - If a line is omitted, that side deleted the file.
  -}
-unmerged :: [FilePath] -> Repo -> IO [Unmerged]
-unmerged l repo = reduceUnmerged [] . catMaybes . map parseUnmerged <$> list repo
+unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool)
+unmerged l repo = do
+	(fs, cleanup) <- pipeNullSplit params repo
+	return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
 	where
-		files = map File l
-		list = pipeNullSplitZombie $
-			Params "ls-files --unmerged -z --" : files
+		params = Params "ls-files --unmerged -z --" : map File l
 
 data InternalUnmerged = InternalUnmerged
 	{ isus :: Bool

Remote/Git.hs

@@ -20,7 +20,6 @@ import Utility.Rsync
 import Remote.Helper.Ssh
 import Types.Remote
 import qualified Git
-import qualified Git.Command
 import qualified Git.Config
 import qualified Git.Construct
 import qualified Annex

Seek.hs

@@ -16,12 +16,14 @@ import Types.Command
 import Types.Key
 import qualified Annex
 import qualified Git
+import qualified Git.Command
 import qualified Git.LsFiles as LsFiles
 import qualified Limit
 import qualified Option
 
-seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
-seekHelper a params = inRepo $ \g -> runPreserveOrder (`a` g) params
+seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath]
+seekHelper a params = inRepo $ \g ->
+	runPreserveOrder (\fs -> Git.Command.leaveZombie <$> a fs g) params
 
 withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
 withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
@@ -39,7 +41,7 @@ withFilesNotInGit a params = do
 		seekunless _ l = do
 			force <- Annex.getState Annex.force
 			g <- gitRepo
-			liftIO $ (\p -> LsFiles.notInRepo force p g) l
+			liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g
 
 withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek
 withPathContents a params = map a . concat <$> liftIO (mapM get params)
@@ -72,7 +74,7 @@ withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
 withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek
 withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
 
-withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek
 withFilesUnlocked' typechanged a params = do
 	-- unlocked files have changed type from a symlink to a regular file
 	typechangedfiles <- seekHelper typechanged params

Upgrade/V1.hs

@@ -83,8 +83,9 @@ updateSymlinks :: Annex ()
 updateSymlinks = do
 	showAction "updating symlinks"
 	top <- fromRepo Git.repoPath
-	files <- inRepo $ LsFiles.inRepo [top]
+	(files, cleanup) <- inRepo $ LsFiles.inRepo [top]
 	forM_ files fixlink
+	void $ liftIO cleanup
 	where
 		fixlink f = do
 			r <- lookupFile1 f

doc/bugs/git_defunct_processes___40__child_of_git-annex_assistant__41__.mdwn

@@ -30,3 +30,5 @@ are changed to  [ Param "-m", Param "git assistant".... or something like that.
 I have done this on my copy for testing it.
 
 For testing, I am also using two repositories on the same computer.  I set this up from the command line, as the web app does not seem to support syncing to two different git folders on the same computer.
+
+> [[done]]; all zombies are squelched now in the assistant. --[[Joey]]