deal with transferkey crashing

If transferkey crashes or even fails to run, the TransferWatcher will not
see the transfer info file be created, so will not remove the transfer
from the list of active transfers. This causes the list to grow
continually, and all active transfers are displayed in the webapp. So, put
in a guard.

I assume that transferkey will not exit 0 while neglecting to clean up.

1 files changed, 19 insertions, 12 deletions

diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 1720b4c9c..ccca4ca5e 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -88,19 +88,26 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
 		 - made, in order to queue a push of the git-annex
 		 - branch out to remotes that did not participate
 		 - in the transfer.
+		 -
+		 - If the process failed, it could have crashed,
+		 - so remove the transfer from the list of current
+		 - transfers, just in case it didn't stop
+		 - in a way that lets the TransferWatcher do its
+		 - usual cleanup.
 		 -}
-		whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do
-			void $ addAlert $ makeAlertFiller True $
-				transferFileAlert direction True file
-			unless isdownload $
-				handleDrops
-					("object uploaded to " ++ show remote)
-					True (transferKey t)
-					(associatedFile info)
-					(Just remote)
-			recordCommit
-
-		void $ removeTransfer t
+		ifM (liftIO $ (==) ExitSuccess <$> waitForProcess pid)
+			( do
+				void $ addAlert $ makeAlertFiller True $
+					transferFileAlert direction True file
+				unless isdownload $
+					handleDrops
+						("object uploaded to " ++ show remote)
+						True (transferKey t)
+						(associatedFile info)
+						(Just remote)
+				recordCommit
+			, void $ removeTransfer t
+			)
 	  where
 		params =
 			[ Param "transferkey"