webapp: Support for enabling known git repositories on ssh servers.

The repository must have been added using initremote.

Turned out to be much much simpler than expected, because I was able to
reuse the existing code for enabling rsync and gcrypt remotes, which
was already sufficiently general that it will also work for ssh remotes.
Total win!

This commit was sponsored by an unknown bitcoin contributor.

Assistant/WebApp/Configurators/Ssh.hs

@@ -166,7 +166,7 @@ sshSetupModal sshdata = $(widgetFile "configurators/ssh/setupmodal")
 getEnableRsyncR :: UUID -> Handler Html
 getEnableRsyncR = postEnableRsyncR
 postEnableRsyncR :: UUID -> Handler Html
-postEnableRsyncR = enableSpecialSshRemote getsshinput enableRsyncNet enablersync
+postEnableRsyncR = enableSshRemote getsshinput enableRsyncNet enablersync
   where
 	enablersync sshdata u = redirect $ ConfirmSshR
 		(sshdata { sshCapabilities = [RsyncCapable] }) u
@@ -178,7 +178,7 @@ getEnableSshGCryptR :: UUID -> Handler Html
 getEnableSshGCryptR = postEnableSshGCryptR
 postEnableSshGCryptR :: UUID -> Handler Html
 postEnableSshGCryptR u = whenGcryptInstalled $
-	enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u
+	enableSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u
   where
   	enablegcrypt sshdata _ = prepSsh False sshdata $ \sshdata' ->
 		sshConfigurator $
@@ -186,13 +186,21 @@ postEnableSshGCryptR u = whenGcryptInstalled $
 				error "Expected to find an encrypted git repository, but did not."
 	getsshinput = parseSshUrl <=< M.lookup "gitrepo"
 
-{- To enable a special remote that uses ssh as its transport, 
- - parse a config key to get its url, and display a form whose
- - only real purpose is to check if ssh public keys need to be
- - set up.
+getEnableSshGitRemoteR :: UUID -> Handler Html
+getEnableSshGitRemoteR = postEnableSshGitRemoteR
+postEnableSshGitRemoteR :: UUID -> Handler Html
+postEnableSshGitRemoteR = enableSshRemote getsshinput enableRsyncNet enablesshgitremote
+  where
+	enablesshgitremote sshdata u = redirect $ ConfirmSshR sshdata u
+
+	getsshinput = parseSshUrl <=< M.lookup "location"
+
+{- To enable a remote that uses ssh as its transport, 
+ - parse a config key to get its url, and display a form
+ - to prompt for its password.
  -}
-enableSpecialSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html
-enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
+enableSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html
+enableSshRemote getsshinput rsyncnetsetup genericsetup u = do
 	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
 	case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of
 		(Just sshinput, Just reponame) -> sshConfigurator $ do

Assistant/WebApp/RepoList.hs

@@ -189,6 +189,11 @@ repoList reposelector
 				Just rr	| remoteLocationIsUrl (parseRemoteLocation rr g) ->
 					val True EnableSshGCryptR
 				_ -> Nothing
+		Just "git" -> 
+			case getconfig "location" of
+				Just loc | remoteLocationIsSshUrl (parseRemoteLocation loc g) ->
+					val True EnableSshGitRemoteR
+				_ -> Nothing
 		_ -> Nothing
 	  where
 	  	getconfig k = M.lookup k =<< M.lookup u m

Assistant/WebApp/routes

@@ -81,6 +81,7 @@
 /config/repository/enable/IA/#UUID EnableIAR GET POST
 /config/repository/enable/glacier/#UUID EnableGlacierR GET POST
 /config/repository/enable/webdav/#UUID EnableWebDAVR GET POST
+/config/repository/enable/sshgitremote/#UUID EnableSshGitRemoteR GET POST
 
 /config/repository/reorder RepositoriesReorderR GET
 

debian/changelog

@@ -7,6 +7,8 @@ git-annex (5.20140518) UNRELEASED; urgency=medium
   * initremote/enableremote: Basic support for using with regular git remotes;
     initremote stores the location of an already existing git remote,
     and enableremote setups up a remote using its stored location.
+  * webapp: Support for enabling known git repositories on ssh servers.
+    The repository must have been added using initremote.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 19 May 2014 15:59:25 -0400