webapp: Allow user to specify the ssh port when setting up a remote.

This commit is contained in:
Joey Hess 2012-12-06 17:09:08 -04:00
parent 25bc68d764
commit 551924e6be
6 changed files with 77 additions and 36 deletions

View file

@ -24,6 +24,7 @@ data SshData = SshData
, sshUserName :: Maybe Text
, sshDirectory :: Text
, sshRepoName :: String
, sshPort :: Int
, needsPubKey :: Bool
, rsyncOnly :: Bool
}
@ -188,7 +189,6 @@ genSshKeyPair = withTempDir "git-annex-keygen" $ \dir -> do
setupSshKeyPair :: SshKeyPair -> SshData -> IO SshData
setupSshKeyPair sshkeypair sshdata = do
sshdir <- sshDir
let configfile = sshdir </> "config"
createDirectoryIfMissing True sshdir
unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $ do
@ -200,25 +200,39 @@ setupSshKeyPair sshkeypair sshdata = do
unlessM (doesFileExist $ sshdir </> sshpubkeyfile) $
writeFile (sshdir </> sshpubkeyfile) (sshPubKey sshkeypair)
setSshConfig sshdata
[ ("IdentityFile", "~/.ssh/" ++ sshprivkeyfile) ]
where
sshprivkeyfile = "key." ++ mangleSshHostName sshdata
sshpubkeyfile = sshprivkeyfile ++ ".pub"
{- Setups up a ssh config with a mangled hostname.
- Returns a modified SshData containing the mangled hostname. -}
setSshConfig :: SshData -> [(String, String)] -> IO SshData
setSshConfig sshdata config = do
sshdir <- sshDir
createDirectoryIfMissing True sshdir
let configfile = sshdir </> "config"
unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFile configfile) $
appendFile configfile $ unlines
appendFile configfile $ unlines $
[ ""
, "# Added automatically by git-annex"
, "Host " ++ mangledhost
, "\tHostname " ++ T.unpack (sshHostName sshdata)
, "\tIdentityFile ~/.ssh/" ++ sshprivkeyfile
]
] ++ map (\(k, v) -> "\t" ++ k ++ " " ++ v)
(settings ++ config)
return $ sshdata { sshHostName = T.pack mangledhost }
where
sshprivkeyfile = "key." ++ mangledhost
sshpubkeyfile = sshprivkeyfile ++ ".pub"
mangledhost = mangleSshHostName
(T.unpack $ sshHostName sshdata)
(T.unpack <$> sshUserName sshdata)
mangledhost = mangleSshHostName sshdata
settings =
[ ("Hostname", T.unpack $ sshHostName sshdata)
, ("Port", show $ sshPort sshdata)
]
mangleSshHostName :: String -> Maybe String -> String
mangleSshHostName host user = "git-annex-" ++ host ++ (maybe "-" ('-':) user)
mangleSshHostName :: SshData -> String
mangleSshHostName sshdata = "git-annex-" ++ host ++ (maybe "-" ('-':) user)
where
host = T.unpack $ sshHostName sshdata
user = T.unpack <$> sshUserName sshdata
unMangleSshHostName :: String -> String
unMangleSshHostName h