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.

Assistant/Threads/SanityChecker.hs

@@ -26,7 +26,7 @@ sanityCheckerThread st status transferqueue changechan = forever $ do
 	waitForNextCheck st status
 
 	runThreadState st $
-		modifyDaemonStatus status $ \s -> s
+		modifyDaemonStatus_ status $ \s -> s
 				{ sanityCheckRunning = True }
 
 	now <- getPOSIXTime -- before check started
@@ -34,7 +34,7 @@ sanityCheckerThread st status transferqueue changechan = forever $ do
 		(runThreadState st . warning . show)
 
 	runThreadState st $ do
-		modifyDaemonStatus status $ \s -> s
+		modifyDaemonStatus_ status $ \s -> s
 			{ sanityCheckRunning = False
 			, lastSanityCheck = Just now
 			}

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	

Assistant/Threads/Transferrer.hs

@@ -44,12 +44,6 @@ shouldTransfer dstatus t = go =<< currentTransfers <$> getDaemonStatus dstatus
 				not <$> inAnnex (transferKey t)
 			| otherwise = return True
 
-{- Waits for any of the transfers in the map to complete. -}
-waitTransfer :: IO ()
-waitTransfer = error "TODO"
---			getProcessStatus True False pid
---			runThreadState st invalidateCache
-
 {- A transfer is run in a separate process, with a *copy* of the Annex
  - state. This is necessary to avoid blocking the rest of the assistant
  - on the transfer completing, and also to allow multiple transfers to run
@@ -81,4 +75,5 @@ runTransfer st dstatus t info
 						M.insertWith' const t info
 							{ startedTime = Just now
 							, transferPid = Just pid
+							, shouldWait = True
 							}

Assistant/Threads/Watcher.hs

@@ -67,7 +67,7 @@ statupScan st dstatus scanner = do
 		showAction "scanning"
 	r <- scanner
 	runThreadState st $
-		modifyDaemonStatus dstatus $ \s -> s { scanComplete = True }
+		modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
 
 	-- Notice any files that were deleted before watching was started.
 	runThreadState st $ do