webapp: Encourage user to install git-annex on a server when adding a ssh server, rather than just funneling them through to rsync.

Assistant/WebApp/Configurators/Ssh.hs

@@ -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