webapp: Escape unusual characters in ssh hostnames when generating mangled hostnames. This allows IPv6 addresses to be used on filesystems not supporting : in filenames.

3 files changed, 34 insertions, 8 deletions

diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index fb82586b8..66ed54257 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -341,15 +341,31 @@ setSshConfig sshdata config = do
 {- This hostname is specific to a given repository on the ssh host,
  - so it is based on the real hostname, the username, and the directory.
  -
- - The mangled hostname has the form "git-annex-realhostname-username-port_dir".
- - The only use of "-" is to separate the parts shown; this is necessary
- - to allow unMangleSshHostName to work. Any unusual characters in the
- - username or directory are url encoded, except using "." rather than "%"
+ - The mangled hostname has the form:
+ - "git-annex-realhostname-username_port_dir"
+ - Note that "-" is only used in the realhostname and as a separator;
+ - this is necessary to allow unMangleSshHostName to work.
+ -
+ - Unusual characters are url encoded, but using "." rather than "%"
  - (the latter has special meaning to ssh).
+ -
+ - In the username and directory, unusual characters are any
+ - non-alphanumerics, other than "_"
+ -
+ - The real hostname is not normally encoded at all. This is done for
+ - backwards compatability and to avoid unnecessary ugliness in the
+ - filename. However, when it contains special characters
+ - (notably ":" which cannot be used on some filesystems), it is url
+ - encoded. To indicate it was encoded, the mangled hostname
+ - has the form
+ - "git-annex-.encodedhostname-username_port_dir"
  -}
 mangleSshHostName :: SshData -> String
-mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata)
-	++ "-" ++ escape extra
+mangleSshHostName sshdata = intercalate "-" 
+	[ "git-annex"
+	, escapehostname (T.unpack (sshHostName sshdata))
+	, escape extra
+	]
   where
 	extra = intercalate "_" $ map T.unpack $ catMaybes
 		[ sshUserName sshdata
@@ -361,12 +377,18 @@ mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata)
 		| c == '_' = True
 		| otherwise = False
 	escape s = replace "%" "." $ escapeURIString safe s
+	escapehostname s
+		| all (\c -> c == '.' || safe c) s = s
+		| otherwise = '.' : escape s
 
 {- Extracts the real hostname from a mangled ssh hostname. -}
 unMangleSshHostName :: String -> String
 unMangleSshHostName h = case split "-" h of
-	("git":"annex":rest) -> intercalate "-" (beginning rest)
+	("git":"annex":rest) -> unescape (intercalate "-" (beginning rest))
 	_ -> h
+  where
+	unescape ('.':s) = unEscapeString (replace "." "%" s)
+	unescape s = s
 
 {- Does ssh have known_hosts data for a hostname? -}
 knownHost :: Text -> IO Bool
diff --git a/CHANGELOG b/CHANGELOG
index 35a3a2d5d..96523789c 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -25,6 +25,9 @@ git-annex (6.20160614) UNRELEASED; urgency=medium
   * Support checking presence of content at a http url that redirects to
     a ftp url.
   * log: Added --all option.
+  * webapp: Escape unusual characters in ssh hostnames when generating
+    mangled hostnames. This allows IPv6 addresses to be used on filesystems
+    not supporting : in filenames.
 
  -- Joey Hess <id@joeyh.name>  Mon, 13 Jun 2016 21:52:24 -0400
 
diff --git a/doc/bugs/IPv6_literal_ssh_servers_break_git_annex_webapp.mdwn b/doc/bugs/IPv6_literal_ssh_servers_break_git_annex_webapp.mdwn
index f7ab78d71..ae7809c33 100644
--- a/doc/bugs/IPv6_literal_ssh_servers_break_git_annex_webapp.mdwn
+++ b/doc/bugs/IPv6_literal_ssh_servers_break_git_annex_webapp.mdwn
@@ -60,4 +60,5 @@ The key's randomart image is:
 
 Yeah, it works great on my Linux machines. I'm just getting started with the web app, though; I'm trying to set up limited-access key-based SSH, and the web app seems to be also trying to do that...
 
-
+> Fixed by escaping the hostname when it contains any unusual characters.
+> [[done]] --[[Joey]]