(oldstable) fix dashed ssh hostname issue CVE-2017-12976

Security fix: Disallow hostname starting with a dash, which would get
passed to ssh and be treated an option. This could be used by an attacker
who provides a crafted ssh url (for eg a git remote) to execute arbitrary
code via ssh -oProxyCommand.

The same class of security hole recently affected git itself,
CVE-2017-1000117.

Method: Identified all places where ssh is run, by git grep '"ssh"'
Converted them all to use a SshHost, if they did not already, for
specifying the hostname.

SshHost was made a data type with a smart constructor, which rejects
hostnames starting with '-'.

Note that git-annex already contains extensive use of Utility.SafeCommand,
which fixes a similar class of problem where a filename starting with a
dash gets passed to a program which treats it as an option.

This was backported by Antoine Beaupré, from the upstream stable patch
provided by Joey Hess.
# Veuillez saisir le message de validation pour vos modifications. Les lignes
# commençant par '#' seront ignorées, et un message vide abandonne la validation.
#
# Date :       Mon Oct 23 16:50:56 2017 -0400
#
# Sur la branche debian-wheezy-security
# Modifications qui seront validées :
#	modifié :         Annex/Ssh.hs
#	modifié :         Remote/Helper/Ssh.hs
#	nouveau fichier : Utility/SshHost.hs
#	modifié :         debian/changelog
#
# Fichiers non suivis:
#	0001-prepare-wheezy-update-of-CVE-2017-12976.patch
#
# ------------------------ >8 ------------------------
# Ne touchez pas à la ligne ci-dessus
# Tout ce qui suit sera éliminé.
#
# Modifications qui seront validées :
diff --git c/Annex/Ssh.hs i/Annex/Ssh.hs
index 8bd4fe33a..63c2324a3 100644
--- c/Annex/Ssh.hs
+++ i/Annex/Ssh.hs
@@ -18,10 +18,11 @@ import qualified Git.Config
 import Config
 import qualified Build.SysConfig as SysConfig
 import Annex.Perms
+import Utility.SshHost
 
 {- Generates parameters to ssh to a given host (or user@host) on a given
  - port, with connection caching. -}
-sshParams :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam]
+sshParams :: (SshHost, Maybe Integer) -> [CommandParam] -> Annex [CommandParam]
 sshParams (host, port) opts = go =<< sshInfo (host, port)
 	where
 		go (Nothing, params) = ret params
@@ -30,14 +31,14 @@ sshParams (host, port) opts = go =<< sshInfo (host, port)
 			liftIO $ createDirectoryIfMissing True $ parentDir socketfile
 			lockFile $ socket2lock socketfile
 			ret params
-		ret ps = return $ ps ++ opts ++ portParams port ++ [Param host]
+		ret ps = return $ ps ++ opts ++ portParams port ++ [Param (fromSshHost host)]
 		-- If the lock pool is empty, this is the first ssh of this
 		-- run. There could be stale ssh connections hanging around
 		-- from a previous git-annex run that was interrupted.
 		cleanstale = whenM (not . any isLock . M.keys <$> getPool) $
 			sshCleanup
 
-sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
+sshInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
 sshInfo (host, port) = ifM caching
 	( do
 		dir <- fromRepo gitAnnexSshDir
@@ -91,7 +92,7 @@ sshCleanup = do
 				-- "ssh -O stop" is noisy on stderr even with -q
 				let cmd = unwords $ toCommand $
 					[ Params "-O stop"
-					] ++ params ++ [Param host]
+					] ++ params ++ [Param (fromSshHost host)]
 				boolSystem "sh"
 					[ Param "-c"
 					, Param $ "ssh " ++ cmd ++ " >/dev/null 2>/dev/null"
@@ -99,16 +100,17 @@ sshCleanup = do
 				-- Cannot remove the lock file; other processes may
 				-- be waiting on our exclusive lock to use it.
 
-hostport2socket :: String -> Maybe Integer -> FilePath
-hostport2socket host Nothing = host
-hostport2socket host (Just port) = host ++ "!" ++ show port
+hostport2socket :: SshHost -> Maybe Integer -> FilePath
+hostport2socket host Nothing = fromSshHost host
+hostport2socket host (Just port) = fromSshHost host ++ "!" ++ show port
 
-socket2hostport :: FilePath -> (String, Maybe Integer)
+socket2hostport :: FilePath -> (SshHost, Maybe Integer)
 socket2hostport socket
-	| null p = (h, Nothing)
-	| otherwise = (h, readish p)
+	| null p = (sshhost, Nothing)
+	| otherwise = (sshhost, readish p)
 	where
 		(h, p) = separate (== '!') $ takeFileName socket
+                sshhost = either error id (mkSshHost h)
 
 socket2lock :: FilePath -> FilePath
 socket2lock socket = socket ++ lockExt
diff --git c/Remote/Helper/Ssh.hs i/Remote/Helper/Ssh.hs
index f6742b89f..0101748aa 100644
--- c/Remote/Helper/Ssh.hs
+++ i/Remote/Helper/Ssh.hs
@@ -13,14 +13,19 @@ import qualified Git.Url
 import Config
 import Annex.UUID
 import Annex.Ssh
+import Utility.SshHost
 
 {- 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
+	let host = maybe
+		(error "bad ssh url")
+		(either error id . mkSshHost)
+		(Just $ Git.Url.hostuser repo)
 	opts <- map Param . words <$> getRemoteConfig repo "ssh-options" ""
-	params <- sshParams (Git.Url.hostuser repo, Git.Url.port repo) opts
+	params <- sshParams (host, Git.Url.port repo) opts
 	return $ params ++ sshcmd
 
 {- Generates parameters to run a git-annex-shell command on a remote
diff --git c/Utility/SshHost.hs i/Utility/SshHost.hs
new file mode 100644
index 000000000..d8a8da11d
--- /dev/null
+++ i/Utility/SshHost.hs
@@ -0,0 +1,29 @@
+{- ssh hostname sanitization
+ -
+ - When constructing a ssh command with a hostname that may be controlled
+ - by an attacker, prevent the hostname from starting with "-",
+ - to prevent tricking ssh into arbitrary command execution via
+ - eg "-oProxyCommand="
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.SshHost (SshHost, mkSshHost, fromSshHost) where
+
+newtype SshHost = SshHost String
+
+-- | Smart constructor for a legal hostname or IP address.
+-- In some cases, it may be prefixed with "user@" to specify the remote
+-- user at the host.
+--
+-- For now, we only filter out the problem ones, because determining an
+-- actually legal hostnames is quite complicated.
+mkSshHost :: String -> Either String SshHost
+mkSshHost h@('-':_) = Left $
+	"rejecting ssh hostname that starts with '-' : " ++ h
+mkSshHost h = Right (SshHost h)
+
+fromSshHost :: SshHost -> String
+fromSshHost (SshHost h) = h
diff --git c/debian/changelog i/debian/changelog
index 96d85da27..ec3f93d13 100644
--- c/debian/changelog
+++ i/debian/changelog
@@ -1,3 +1,13 @@
+git-annex (3.20120629+deb7u1) UNRELEASED; urgency=medium
+
+  * Non-maintainer upload by the Security Team.
+  * CVE-2017-12976: git-annex before 6.20170818 allows remote attackers to
+    execute arbitrary commands via an ssh URL with an initial dash
+    character in the hostname, as demonstrated by an ssh://-eProxyCommand=
+    URL (Closes: #873088)
+
+ -- Antoine Beaupré <anarcat@debian.org>  Mon, 23 Oct 2017 16:00:55 -0400
+
 git-annex (3.20120629) unstable; urgency=low
 
   * cabal: Only try to use inotify on Linux.
