fix sshCleanup race using STM

4 files changed, 19 insertions, 22 deletions

diff --git a/Annex.hs b/Annex.hs
index 3c47789b5..597a5dd1b 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -71,6 +71,7 @@ import Utility.Url
 import "mtl" Control.Monad.Reader
 import Control.Concurrent
 import Control.Concurrent.Async
+import Control.Concurrent.STM
 import qualified Data.Map as M
 import qualified Data.Set as S
 
@@ -124,7 +125,7 @@ data AnnexState = AnnexState
 	, groupmap :: Maybe GroupMap
 	, ciphers :: M.Map StorableCipher Cipher
 	, lockcache :: LockCache
-	, sshstalecleaned :: MVar ()
+	, sshstalecleaned :: TMVar Bool
 	, flags :: M.Map String Bool
 	, fields :: M.Map String String
 	, cleanup :: M.Map CleanupAction (Annex ())
@@ -147,7 +148,7 @@ newState :: GitConfig -> Git.Repo -> IO AnnexState
 newState c r = do
 	emptyactiveremotes <- newMVar M.empty
 	o <- newMessageState
-	sc <- newMVar ()
+	sc <- newTMVarIO False
 	return $ AnnexState
 		{ repo = r
 		, repoadjustment = return
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 09df67666..e0cc4a0fe 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -43,7 +43,7 @@ import Annex.LockPool
 #endif
 
 import Data.Hash.MD5
-import Control.Concurrent
+import Control.Concurrent.STM
 
 {- Some ssh commands are fed stdin on a pipe and so should be allowed to
  - consume it. But ssh commands that are not piped stdin should generally
@@ -173,23 +173,31 @@ prepSocket :: FilePath -> RemoteGitConfig -> [CommandParam] -> Annex ()
 prepSocket socketfile gc sshparams = do
 	-- There could be stale ssh connections hanging around
 	-- from a previous git-annex run that was interrupted.
-	-- This must run only once, before we have made any ssh connection.
-	whenM (isJust <$> (liftIO . tryTakeMVar =<< Annex.getState Annex.sshstalecleaned)) $
-		sshCleanup
+	-- This must run only once, before we have made any ssh connection,
+	-- and any other prepSocket calls must block while it's run.
+	tv <- Annex.getState Annex.sshstalecleaned
+	join $ liftIO $ atomically $ do
+		cleaned <- takeTMVar tv
+		if cleaned
+			then do
+				putTMVar tv cleaned
+				return noop
+			else return $ do
+				sshCleanup
+				liftIO $ atomically $ putTMVar tv True
 	-- Cleanup at shutdown.
 	Annex.addCleanup SshCachingCleanup sshCleanup
 	
 	liftIO $ createDirectoryIfMissing True $ parentDir socketfile
 	let socketlock = socket2lock socketfile
 
-	prompt $ \s -> when (concurrentOutputEnabled s) $
+	prompt $ \s -> when (concurrentOutputEnabled s) $ do
 		-- If the LockCache already has the socketlock in it,
 		-- the connection has already been started. Otherwise,
 		-- get the connection started now.
 		whenM (isNothing <$> fromLockCache socketlock) $
 			void $ liftIO $ boolSystem "ssh" $
 				sshparams ++ startSshConnection gc
-	
 	lockFileCached socketlock
 
 -- Parameters to get ssh connected to the remote host,
diff --git a/doc/devblog/day_457__improved_ssh_password_prompting.mdwn b/doc/devblog/day_457__improved_ssh_password_prompting.mdwn
index 0b99cbce6..df38304e4 100644
--- a/doc/devblog/day_457__improved_ssh_password_prompting.mdwn
+++ b/doc/devblog/day_457__improved_ssh_password_prompting.mdwn
@@ -15,6 +15,3 @@ up several ssh's at the same time, so connection caching didn't kick in,
 and there could be a bunch of ssh password prompts at the same time. Now
 there will never be more than one ssh password prompt at once, and only one
 prompt per host. (As long as connection caching is enabled.)
-
-That mostly works, but `git annex drop -J` exposes a bug in it, which I'll
-have to get back to tomorrow.
diff --git a/get_-J_cannot_be_used_with_password-based_authentication/comment_1_5da63cf5fa93120c85b98077fba51488._comment b/get_-J_cannot_be_used_with_password-based_authentication/comment_1_5da63cf5fa93120c85b98077fba51488._comment
index 4e0c93fb1..052790459 100644
--- a/get_-J_cannot_be_used_with_password-based_authentication/comment_1_5da63cf5fa93120c85b98077fba51488._comment
+++ b/get_-J_cannot_be_used_with_password-based_authentication/comment_1_5da63cf5fa93120c85b98077fba51488._comment
@@ -5,15 +5,6 @@
  content="""
 Current status: It's implemented, but not for `GIT_SSH` yet.
 
-`git annex get -J 3` seems to work well.
-
-`git annex drop -J 3` sometimes (once per 5 or so tries) runs
-2 ssh processes both prompting at once. For example:
-
-	21555 pts/3    S+     0:00      |           \_ ssh localhost -S .git/annex/ssh/localhost -o ControlMaster=auto -o ControlPersist=yes -T git-annex-shell 'lockcontent' '/~/tmp/b/a' 'SHA256E-s30--ec748fe42378798b82ddf4e6b3e778a0cbc5d76d458685af01dc1f09cc423eb7' --uuid ad19d177-519e-4440-a9c9-0c9cddd99db2
-	21556 pts/3    S+     0:00      |           \_ ssh localhost -S .git/annex/ssh/localhost -o ControlMaster=auto -o ControlPersist=yes -n -T git-annex-shell inannex .
-
-The inannex is what's used to bring up the ssh connection, so
-I don't immediately understand how the lockcontent could run before
-the ssh connection is brought up.
+The display is a bit ugly, because the ssh password prompt line
+confuses the concurrent-output region manager.
 """]]