webapp: Encourage user to install git-annex on a server when adding a ssh server, rather than just funneling them through to rsync.
This commit is contained in:
parent
ab0c6db755
commit
996e899acc
6 changed files with 50 additions and 20 deletions
|
@ -49,6 +49,14 @@ mkSshData s = SshData
|
|||
, rsyncOnly = False
|
||||
}
|
||||
|
||||
mkSshInput :: SshData -> SshInput
|
||||
mkSshInput s = SshInput
|
||||
{ inputHostname = Just $ sshHostName s
|
||||
, inputUsername = sshUserName s
|
||||
, inputDirectory = Just $ sshDirectory s
|
||||
, inputPort = sshPort s
|
||||
}
|
||||
|
||||
sshInputAForm :: (Field WebApp WebApp Text) -> SshInput -> AForm WebApp WebApp SshInput
|
||||
sshInputAForm hostnamefield def = SshInput
|
||||
<$> aopt check_hostname "Host name" (Just $ inputHostname def)
|
||||
|
@ -104,6 +112,9 @@ getAddSshR = sshConfigurator $ do
|
|||
where
|
||||
showform form enctype status = $(widgetFile "configurators/ssh/add")
|
||||
|
||||
sshTestModal :: Widget
|
||||
sshTestModal = $(widgetFile "configurators/ssh/testmodal")
|
||||
|
||||
{- To enable an existing rsync special remote, parse the SshInput from
|
||||
- its rsyncurl, and display a form whose only real purpose is to check
|
||||
- if ssh public keys need to be set up. From there, we can proceed with
|
||||
|
@ -243,6 +254,11 @@ getConfirmSshR :: SshData -> Handler RepHtml
|
|||
getConfirmSshR sshdata = sshConfigurator $
|
||||
$(widgetFile "configurators/ssh/confirm")
|
||||
|
||||
getRetrySshR :: SshData -> Handler ()
|
||||
getRetrySshR sshdata = do
|
||||
s <- liftIO $ testServer $ mkSshInput sshdata
|
||||
redirect $ either (const $ ConfirmSshR sshdata) ConfirmSshR s
|
||||
|
||||
getMakeSshGitR :: SshData -> Handler RepHtml
|
||||
getMakeSshGitR = makeSsh False setupGroup
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue