run ssh in the directory with its socket when stopping

This guarantees that stopping an existing socket never fails.

This might be the route out of the mess of needing to worry about socket
lengths in general. However, it would need quite a lot of refactoring
to make every place in git-annex that runs ssh run it with a cwd that was
determined by the location of its connection caching socket. If this
wasn't already such a mess, I'd consider even the thought of that API a bad
idea..

1 files changed, 8 insertions, 6 deletions

diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index e2b6564e4..8553ee797 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -16,6 +16,7 @@ module Annex.Ssh (
 
 import qualified Data.Map as M
 import Data.Hash.MD5
+import System.Process (cwd)
 
 import Common.Annex
 import Annex.LockPool
@@ -112,9 +113,8 @@ sshCleanup = go =<< sshCacheDir
   where
 	go Nothing = noop
 	go (Just dir) = do
-		sockets <- liftIO $ filter (not . isLock) . catMaybes 
-			<$> (mapM bestSocketPath
-				=<< catchDefaultIO [] (dirContents dir))
+		sockets <- liftIO $ filter (not . isLock)
+			<$> catchDefaultIO [] (dirContents dir)
 		forM_ sockets cleanup
 	cleanup socketfile = do
 #ifndef mingw32_HOST_OS
@@ -137,13 +137,15 @@ sshCleanup = go =<< sshCacheDir
 		stopssh socketfile
 #endif
 	stopssh socketfile = do
-		let params = sshConnectionCachingParams socketfile
+		let (dir, base) = splitFileName socketfile
+		let params = sshConnectionCachingParams base
 		-- "ssh -O stop" is noisy on stderr even with -q
 		void $ liftIO $ catchMaybeIO $
 			withQuietOutput createProcessSuccess $
-				proc "ssh" $ toCommand $
+				(proc "ssh" $ toCommand $
 					[ Params "-O stop"
-					] ++ params ++ [Param "any"]
+					] ++ params ++ [Param "any"])
+					{ cwd = Just dir }
 		-- Cannot remove the lock file; other processes may
 		-- be waiting on our exclusive lock to use it.