work around ssh brain-damange

The control socket path passed to ssh needs to be 17 characters shorter
than the maximum unix domain socket length, because ssh appends stuff to it
to make a temporary filename. Closes: #725512

Also, take the shorter of the relative and the absolute paths to the
socket. Typically the relative path will be a lot shorter (unless
deep inside a subdirectory of the repository), and so using it will
avoid flirting with the maximum safe socket lenghts in more situations,
and so lead to less breakage if all my attempts at fixing this are
still buggy.

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
+		r <- liftIO $ bestSocketPath $ dir </> hostport2socket host port
-		if valid_unix_socket_path socketfile
+		return $ case r of
-			then return (Just socketfile, sshConnectionCachingParams socketfile)
+			Nothing -> (Nothing, [])
-			else do
+			Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile)
-				socketfile' <- liftIO $ relPathCwdToFile socketfile
+
-				return $ if valid_unix_socket_path socketfile'
+{- Given an absolute path to use for a socket file,
-					then (Just socketfile', sshConnectionCachingParams socketfile')
+ - returns whichever is shorter of that or the relative path to the same
-					else (Nothing, [])
+ - 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) <$>
+		sockets <- liftIO $ filter (not . isLock) . catMaybes 
-			liftIO (catchDefaultIO [] $ dirContents dir)
+			<$> (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

debian/changelog

@@ -7,6 +7,9 @@ git-annex (4.20131003) UNRELEASED; urgency=low
   * addurl: Better sanitization of generated filenames.
   * Better sanitization of problem characters when generating URL and WORM
     keys.
+  * The control socket path passed to ssh needs to be 17 characters
+    shorter than the maximum unix domain socket length, because ssh
+    appends stuff to it to make a temporary filename. Closes: #725512
 
  -- Joey Hess <joeyh@debian.org>  Thu, 03 Oct 2013 15:41:24 -0400