diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-09-03 00:39:55 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-09-03 00:39:55 -0400 |
| commit | b584d96c131a23d0f7d6ed424a8915e9e15a6bc4 (patch) | |
| tree | da5f81e4000a58326a95fc94cd5a5ad22e76e34c /Assistant | |
| parent | 6a45ca465877c3dcf17e4f41ff538dd66b2438c0 (diff) | |
rsync.net configurator display
Doesn't set up the repo yet.
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/WebApp/Configurators/Ssh.hs | 27 | ||||
| -rw-r--r-- | Assistant/WebApp/routes | 1 |
2 files changed, 25 insertions, 3 deletions
diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index b8e2b351a..334ee0807 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -42,10 +42,10 @@ data SshServer = SshServer } deriving (Show) -sshServerAForm :: Text -> AForm WebApp WebApp SshServer +sshServerAForm :: (Maybe Text) -> AForm WebApp WebApp SshServer sshServerAForm localusername = SshServer <$> aopt check_hostname "Host name" Nothing - <*> aopt check_username "User name" (Just $ Just localusername) + <*> aopt check_username "User name" (Just localusername) <*> aopt textField "Directory" (Just $ Just $ T.pack gitAnnexAssistantDefaultDir) where check_hostname = checkM (liftIO . checkdns) textField @@ -83,7 +83,7 @@ getAddSshR = sshConfigurator $ do u <- liftIO $ T.pack . userName <$> (getUserEntryForID =<< getEffectiveUserID) ((result, form), enctype) <- lift $ - runFormGet $ renderBootstrap $ sshServerAForm u + runFormGet $ renderBootstrap $ sshServerAForm (Just u) case result of FormSuccess sshserver -> do (status, needspubkey) <- liftIO $ testServer sshserver @@ -320,3 +320,24 @@ genSshKey sshdata = do sshpubkeyfile = sshprivkeyfile ++ ".pub" mangledhost = "git-annex-" ++ T.unpack (sshHostName sshdata) ++ user user = maybe "" (\u -> "-" ++ T.unpack u) (sshUserName sshdata) + +getAddRsyncNetR :: Handler RepHtml +getAddRsyncNetR = bootstrap (Just Config) $ do + sideBarDisplay + setTitle "Add a Rsync.net repository" + ((result, form), enctype) <- lift $ + runFormGet $ renderBootstrap $ sshServerAForm Nothing + let showform status = do + let authtoken = webAppFormAuthToken + $(widgetFile "configurators/addrsync.net") + case result of + FormSuccess sshserver -> do + let host = fromMaybe "" $ hostname sshserver + checkhost host showform $ do + error "TODO" + _ -> showform UntestedServer + where + checkhost host showform a + | ".rsync.net" `T.isSuffixOf` T.toLower host = a + | otherwise = showform $ UnusableServer + "That is not a rsync.net host name." diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 5f8dfbbc4..7ed1f30d3 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -10,6 +10,7 @@ /config/repository/add/ssh/confirm/#SshData ConfirmSshR GET /config/repository/add/ssh/make/git/#SshData MakeSshGitR GET /config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET +/config/repository/add/rsync.net AddRsyncNetR GET /config/repository/first FirstRepositoryR GET /transfers/#NotificationId TransfersR GET |