UI for enabling special remotes

Now other repositories can configure special remotes, and when their
configuration has propigated out, they'll appear in the webapp's list of
repositories, with a link to enable them.

Added support for enabling rsync special remotes, and directory special
remotes that are on removable drives. However, encrypted directory special
remotes are not supported yet. The removable drive configuator doesn't
support them yet anyway.

1 files changed, 13 insertions, 2 deletions

diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index ded2b0056..32df9cd0b 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -186,8 +186,19 @@ setupSshKeyPair sshkeypair sshdata = do
 	where
 		sshprivkeyfile = "key." ++ mangledhost
 		sshpubkeyfile = sshprivkeyfile ++ ".pub"
-		mangledhost = "git-annex-" ++ T.unpack (sshHostName sshdata) ++ user
-		user = maybe "" (\u -> '-' : T.unpack u) (sshUserName sshdata)
+		mangledhost = mangleSshHostName
+			(T.unpack $ sshHostName sshdata)
+			(T.unpack <$> sshUserName sshdata)
+
+mangleSshHostName :: String -> Maybe String -> String
+mangleSshHostName host user = "git-annex-" ++ host ++ (maybe "-" ('-':) user)
+
+unMangleSshHostName :: String -> String
+unMangleSshHostName h
+	| "git-annex-" `isPrefixOf` h = join "-" (beginning $ drop 2 dashbits)
+	| otherwise = h
+	where
+		dashbits = split "-" h
 
 {- Does ssh have known_hosts data for a hostname? -}
 knownHost :: Text -> IO Bool