remotedaemon: When network connection is lost, close all cached ssh connections.

This commit was sponsored by Cedric Staub.

3 files changed, 17 insertions, 5 deletions

diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs
index 0c2937103..b3cfe67b2 100644
--- a/RemoteDaemon/Core.hs
+++ b/RemoteDaemon/Core.hs
@@ -18,6 +18,7 @@ import qualified Git.Types as Git
 import qualified Git.CurrentRepo
 import Utility.SimpleProtocol
 import Config
+import Annex.Ssh
 
 import Control.Concurrent.Async
 import Control.Concurrent
@@ -65,12 +66,19 @@ runController ichan ochan = do
 				let common = M.intersection m m'
 				let new = M.difference m' m
 				let old = M.difference m m'
-				stoprunning old
+				broadcast STOP old
 				unless paused $
 					startrunning new
 				go h paused (M.union common new)
+			LOSTNET -> do
+				-- force close all cached ssh connections
+				-- (done here so that if there are multiple
+				-- ssh remotes, it's only done once)
+				liftAnnex h forceSshCleanup
+				broadcast LOSTNET m
+				go h True M.empty
 			PAUSE -> do
-				stoprunning m
+				broadcast STOP m
 				go h True M.empty
 			RESUME -> do
 				when paused $
@@ -89,9 +97,9 @@ runController ichan ochan = do
 	startrunning m = forM_ (M.elems m) startrunning'
 	startrunning' (transport, _) = void $ async transport
 	
-	-- Ask the transport nicely to stop.
-	stoprunning m = forM_ (M.elems m) stoprunning'
-	stoprunning' (_, c) = writeChan c STOP
+	broadcast msg m = forM_ (M.elems m) send
+	  where
+		send (_, c) = writeChan c msg
 
 -- Generates a map with a transport for each supported remote in the git repo,
 -- except those that have annex.sync = false
diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs
index d6150bbce..ba03a2589 100644
--- a/RemoteDaemon/Transport/Ssh.hs
+++ b/RemoteDaemon/Transport/Ssh.hs
@@ -84,6 +84,7 @@ transport' r url transporthandle ichan ochan = do
 		msg <- readChan ichan
 		case msg of
 			STOP -> return Stopping
+			LOSTNET -> return Stopping
 			_ -> handlecontrol
 
 	-- Old versions of git-annex-shell that do not support
diff --git a/RemoteDaemon/Types.hs b/RemoteDaemon/Types.hs
index eef7389cc..aff910120 100644
--- a/RemoteDaemon/Types.hs
+++ b/RemoteDaemon/Types.hs
@@ -42,6 +42,7 @@ data Emitted
 -- Messages that the deamon consumes.
 data Consumed
 	= PAUSE
+	| LOSTNET
 	| RESUME
 	| CHANGED RefList
 	| RELOAD
@@ -63,6 +64,7 @@ instance Proto.Sendable Emitted where
 
 instance Proto.Sendable Consumed where
 	formatMessage PAUSE = ["PAUSE"]
+	formatMessage LOSTNET = ["LOSTNET"]
 	formatMessage RESUME = ["RESUME"]
 	formatMessage (CHANGED refs) =["CHANGED", Proto.serialize refs]
 	formatMessage RELOAD = ["RELOAD"]
@@ -78,6 +80,7 @@ instance Proto.Receivable Emitted where
 
 instance Proto.Receivable Consumed where
 	parseCommand "PAUSE" = Proto.parse0 PAUSE
+	parseCommand "LOSTNET" = Proto.parse0 LOSTNET
 	parseCommand "RESUME" = Proto.parse0 RESUME
 	parseCommand "CHANGED" = Proto.parse1 CHANGED
 	parseCommand "RELOAD" = Proto.parse0 RELOAD