wait on child transfer processes, and invalidate cache

There's still a bug; if the child updates its transfer info file,
then the data from it will superscede the TransferInfo, losing the
info that we should wait on this child.

1 files changed, 19 insertions, 7 deletions

diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index 48c0c79ae..4e468a416 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -13,6 +13,7 @@ import Assistant.DaemonStatus
 import Logs.Transfer
 import Utility.DirWatcher
 import Utility.Types.DirWatcher
+import Annex.BranchState
 
 import Data.Map as M
 
@@ -51,16 +52,27 @@ onErr _ _ msg _ = error msg
 onAdd :: Handler
 onAdd st dstatus file _ = case parseTransferFile file of
 	Nothing -> noop
-	Just t -> do
-		pid <- getProcessID
-		runThreadState st $ go t pid =<< checkTransfer t
+	Just t -> runThreadState st $ go t =<< checkTransfer t
 	where
-		go _ _ Nothing = noop -- transfer already finished
-		go t pid (Just info) = adjustTransfers dstatus $
+		go _ Nothing = noop -- transfer already finished
+		go t (Just info) = adjustTransfers dstatus $
 			M.insertWith' const t info
 
-{- Called when a transfer information file is removed. -}
+{- Called when a transfer information file is removed.
+ -
+ - When the transfer process is a child of this process, wait on it
+ - to avoid zombies.
+ -}
 onDel :: Handler
 onDel st dstatus file _ = case parseTransferFile file of
 	Nothing -> noop
-	Just t -> runThreadState st $ adjustTransfers dstatus $ M.delete t
+	Just t -> maybe noop waitchild
+		=<< runThreadState st (removeTransfer dstatus t)
+	where
+		waitchild info
+			| shouldWait info = case transferPid info of
+				Nothing -> noop
+				Just pid -> do
+					void $ getProcessStatus True False pid
+					runThreadState st invalidateCache
+			| otherwise = noop