diff options
author | Joey Hess <joey@kitenet.net> | 2013-04-16 13:49:39 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-04-16 13:49:39 -0400 |
commit | 79c9fa95bf4d2de5828db797884baf7ff447664d (patch) | |
tree | 4ba1144972ba2ad8ed83aaa8c4804498804ccd7b /Assistant/Ssh.hs | |
parent | 82ec4cf264d94e61545390bd30b4e40003abb43e (diff) |
webapp: Include the repository directory in the mangled hostname and ssh key name, so that a locked down ssh key for one repository is not re-used when setting up additional repositories on the same server.
Diffstat (limited to 'Assistant/Ssh.hs')
-rw-r--r-- | Assistant/Ssh.hs | 25 |
1 files changed, 17 insertions, 8 deletions
diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 487f62c91..5312eaf77 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -210,18 +210,27 @@ setSshConfig sshdata config = do , ("Port", show $ sshPort sshdata) ] +{- 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. + -} mangleSshHostName :: SshData -> String -mangleSshHostName sshdata = "git-annex-" ++ host ++ (maybe "-" ('-':) user) +mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata) + ++ "-" ++ filter safe extra where - host = T.unpack $ sshHostName sshdata - user = T.unpack <$> sshUserName sshdata + extra = join "_" $ map T.unpack $ catMaybes + [ sshUserName sshdata + , Just $ sshDirectory sshdata + ] + safe c + | isAlphaNum c = True + | c == '_' = True + | otherwise = False +{- Extracts the real hostname from a mangled ssh hostname. -} unMangleSshHostName :: String -> String -unMangleSshHostName h - | "git-annex-" `isPrefixOf` h = join "-" (beginning $ drop 2 dashbits) - | otherwise = h - where - dashbits = split "-" h +unMangleSshHostName h = case split "-" h of + ("git":"annex":rest) -> join "-" (beginning rest) + _ -> h {- Does ssh have known_hosts data for a hostname? -} knownHost :: Text -> IO Bool |