1 files changed, 30 insertions, 11 deletions
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 3b1e4b457..e2b6564e4 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -52,14 +52,30 @@ sshInfo (host, port) = go =<< sshCacheDir
   where
 	go Nothing = return (Nothing, [])
 	go (Just dir) = do
-		let socketfile = dir </> hostport2socket host port
-		if valid_unix_socket_path socketfile
-			then return (Just socketfile, sshConnectionCachingParams socketfile)
-			else do
-				socketfile' <- liftIO $ relPathCwdToFile socketfile
-				return $ if valid_unix_socket_path socketfile'
-					then (Just socketfile', sshConnectionCachingParams socketfile')
-					else (Nothing, [])
+		r <- liftIO $ bestSocketPath $ dir </> hostport2socket host port
+		return $ case r of
+			Nothing -> (Nothing, [])
+			Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile)
+
+{- Given an absolute path to use for a socket file,
+ - returns whichever is shorter of that or the relative path to the same
+ - file.
+ -
+ - If no path can be constructed that is a valid socket, returns Nothing. -}
+bestSocketPath :: FilePath -> IO (Maybe FilePath)
+bestSocketPath abssocketfile = do
+	relsocketfile <- liftIO $ relPathCwdToFile abssocketfile
+	let socketfile = if length abssocketfile <= length relsocketfile
+		then abssocketfile
+		else relsocketfile
+	return $ if valid_unix_socket_path (socketfile ++ sshgarbage)
+			then Just socketfile
+			else Nothing
+  where
+  	-- ssh appends a 16 char extension to the socket when setting it
+	-- up, which needs to be taken into account when checking
+	-- that a valid socket was constructed.
+  	sshgarbage = take (1+16) $ repeat 'X'
 
 sshConnectionCachingParams :: FilePath -> [CommandParam]
 sshConnectionCachingParams socketfile = 
@@ -96,8 +112,9 @@ sshCleanup = go =<< sshCacheDir
   where
 	go Nothing = noop
 	go (Just dir) = do
-		sockets <- filter (not . isLock) <$>
-			liftIO (catchDefaultIO [] $ dirContents dir)
+		sockets <- liftIO $ filter (not . isLock) . catMaybes 
+			<$> (mapM bestSocketPath
+				=<< catchDefaultIO [] (dirContents dir))
 		forM_ sockets cleanup
 	cleanup socketfile = do
 #ifndef mingw32_HOST_OS
@@ -139,8 +156,10 @@ hostport2socket host Nothing = hostport2socket' host
 hostport2socket host (Just port) = hostport2socket' $ host ++ "!" ++ show port
 hostport2socket' :: String -> FilePath
 hostport2socket' s
-	| length s > 32 = md5s (Str s)
+	| length s > lengthofmd5s = md5s (Str s)
 	| otherwise = s
+  where
+	lengthofmd5s = 32
 
 socket2lock :: FilePath -> FilePath
 socket2lock socket = socket ++ lockExt