Support ssh remotes with a port specified.

5 files changed, 40 insertions, 7 deletions

diff --git a/Command/Map.hs b/Command/Map.hs
index fbc48392a..6c3e0b3df 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -22,6 +22,7 @@ import Types
 import Utility
 import UUID
 import Trust
+import Ssh
 import qualified Dot
 
 -- a link from the first repository to the second (its remote)
@@ -204,13 +205,11 @@ tryScan r
 		configlist =
 			Remotes.onRemote r (pipedconfig, Nothing) "configlist" []
 		manualconfiglist = do
-			sshoptions <- Annex.repoConfig r "ssh-options" ""
 			let sshcmd =
 				"cd " ++ shellEscape(Git.workTree r) ++ " && " ++
 				"git config --list"
-			liftIO $ pipedconfig "ssh" $ map Param $ 
-					words sshoptions ++
-					[Git.urlAuthority r, sshcmd]
+			sshparams <- sshToRepo r [Param sshcmd]
+			liftIO $ pipedconfig "ssh" sshparams
 
 		-- First, try sshing and running git config manually,
 		-- only fall back to git-annex-shell configlist if that
diff --git a/Remotes.hs b/Remotes.hs
index faee8ace5..3c9db314c 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -38,6 +38,7 @@ import qualified Content
 import Messages
 import CopyFile
 import RsyncFile
+import Ssh
 
 {- Human visible list of remotes. -}
 list :: [Git.Repo] -> String
@@ -314,9 +315,8 @@ git_annex_shell :: Git.Repo -> String -> [CommandParam] -> Annex (Maybe (FilePat
 git_annex_shell r command params
 	| not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts)
 	| Git.repoIsSsh r = do
-		sshoptions <- Annex.repoConfig r "ssh-options" ""
-		return $ Just ("ssh", map Param (words sshoptions) ++ 
-			[Param (Git.urlHostUser r), Param sshcmd])
+		sshparams <- sshToRepo r [Param sshcmd]
+		return $ Just ("ssh", sshparams)
 	| otherwise = return Nothing
 	where
 		dir = Git.workTree r
diff --git a/Ssh.hs b/Ssh.hs
new file mode 100644
index 000000000..04cd9bec8
--- /dev/null
+++ b/Ssh.hs
@@ -0,0 +1,26 @@
+{- git-annex repository access with ssh
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Ssh where
+
+import qualified Annex
+import qualified GitRepo as Git
+import Utility
+import Types
+
+{- Generates parameters to ssh to a repository's host and run a command.
+ - Caller is responsible for doing any neccessary shellEscaping of the
+ - passed command. -}
+sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
+sshToRepo repo sshcmd = do
+	s <- Annex.repoConfig repo "ssh-options" ""
+	let sshoptions = map Param (words s)
+	let sshport = case Git.urlPort repo of
+		Nothing -> []
+		Just p -> [Param "-p", Param (show p)]
+	let sshhost = Param $ Git.urlHostUser repo
+	return $ sshoptions ++ sshport ++ [sshhost] ++ sshcmd
diff --git a/debian/changelog b/debian/changelog
index 56f3bbdaa..6d77caf4c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+git-annex (0.23) UNRELEASED; urgency=low
+
+  * Support ssh remotes with a port specified.
+
+ -- Joey Hess <joeyh@debian.org>  Sat, 05 Mar 2011 15:39:13 -0400
+
 git-annex (0.22) unstable; urgency=low
 
   * Git annexes can now be attached to bare git repositories.
diff --git a/doc/bugs/git_annex_get_choke_when_remote_is_an_ssh_url_with_a_port.mdwn b/doc/bugs/git_annex_get_choke_when_remote_is_an_ssh_url_with_a_port.mdwn
index 0746417fa..92cc9170f 100644
--- a/doc/bugs/git_annex_get_choke_when_remote_is_an_ssh_url_with_a_port.mdwn
+++ b/doc/bugs/git_annex_get_choke_when_remote_is_an_ssh_url_with_a_port.mdwn
@@ -9,3 +9,5 @@ this is confusing because git can handle this url correctly, and will happily cl
 temporary workaround is to use ssh://host/annex as url and define remote.name.annex-ssh-options to "-p 5122", but we need to use this workaround when doing annex get and undo the workaround when pushing/cloning.
 
 if i had more time, i would have learned haskell and provided a patch ;)
+
+> Fixed in git! --[[Joey]] [[done]]