UI for making encrypted ssh remotes with gcrypt

Improved probing the remote server, so it gathers a list of the
capabilities it has. From that list, we can determine which types
of remotes are supported, and display an appropriate UI.

The new buttons for making gcrypt repos don't work yet, but the old buttons
for unencrypted git repo and encrypted rsync repo have been adapted to the
new data types and are working.

This commit was sponsored by David Schmitt.

3 files changed, 19 insertions, 18 deletions

diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 2619039c0..1880d519e 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -9,7 +9,6 @@ module Assistant.MakeRemote where
 
 import Assistant.Common
 import Assistant.Ssh
-import Assistant.Sync
 import qualified Types.Remote as R
 import qualified Remote
 import Remote.List
@@ -21,8 +20,6 @@ import qualified Command.InitRemote
 import Logs.UUID
 import Logs.Remote
 import Git.Remote
-import Config
-import Config.Cost
 import Creds
 import Assistant.Gpg
 import Utility.Gpg (KeyId)
@@ -30,17 +27,12 @@ import Utility.Gpg (KeyId)
 import qualified Data.Text as T
 import qualified Data.Map as M
 
-{- Sets up and begins syncing with a new ssh or rsync remote. -}
-makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote
-makeSshRemote forcersync sshdata mcost = do
-	r <- liftAnnex $
-		addRemote $ maker (sshRepoName sshdata)
-			(sshUrl forcersync sshdata)
-	liftAnnex $ maybe noop (setRemoteCost r) mcost
-	syncRemote r
-	return r
+{- Sets up a new ssh or rsync remote. -}
+makeSshRemote :: Bool -> SshData -> Annex RemoteName
+makeSshRemote forcersync sshdata = 
+	maker (sshRepoName sshdata) (sshUrl forcersync sshdata)
   where
-	rsync = forcersync || rsyncOnly sshdata
+	rsync = forcersync || sshCapabilities sshdata == [RsyncCapable]
 	maker
 		| rsync = makeRsyncRemote
 		| otherwise = makeGitRemote
@@ -48,7 +40,7 @@ makeSshRemote forcersync sshdata mcost = do
 {- Generates a ssh or rsync url from a SshData. -}
 sshUrl :: Bool -> SshData -> String
 sshUrl forcersync sshdata = addtrailingslash $ T.unpack $ T.concat $
-	if (forcersync || rsyncOnly sshdata)
+	if (forcersync || sshCapabilities sshdata == [RsyncCapable])
 		then [u, h, T.pack ":", sshDirectory sshdata]
 		else [T.pack "ssh://", u, h, d]
   where
@@ -146,7 +138,6 @@ makeRemote basename location a = do
 	g <- gitRepo
 	if not (any samelocation $ Git.remotes g)
 		then do
-			
 			let name = uniqueRemoteName basename 0 g
 			a name
 			return name
diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs
index edd27e35a..47811963b 100644
--- a/Assistant/Pairing/MakeRemote.hs
+++ b/Assistant/Pairing/MakeRemote.hs
@@ -12,7 +12,9 @@ import Assistant.Ssh
 import Assistant.Pairing
 import Assistant.Pairing.Network
 import Assistant.MakeRemote
+import Assistant.Sync
 import Config.Cost
+import Config
 
 import Network.Socket
 import qualified Data.Text as T
@@ -43,7 +45,9 @@ finishedLocalPairing msg keypair = do
 			, "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata)
 			]
 			Nothing
-	void $ makeSshRemote False sshdata (Just semiExpensiveRemoteCost)
+	r <- liftAnnex $ addRemote $ makeSshRemote False sshdata
+	liftAnnex $ setRemoteCost r semiExpensiveRemoteCost
+	syncRemote r
 
 {- Mostly a straightforward conversion.  Except:
  -  * Determine the best hostname to use to contact the host.
@@ -63,7 +67,7 @@ pairMsgToSshData msg = do
 		, sshRepoName = genSshRepoName hostname dir
 		, sshPort = 22
 		, needsPubKey = True
-		, rsyncOnly = False
+		, sshCapabilities = [GitAnnexShellCapable, GitCapable, RsyncCapable]
 		}
 
 {- Finds the best hostname to use for the host that sent the PairMsg.
diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index a62319096..9df9b64b9 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -25,10 +25,16 @@ data SshData = SshData
 	, sshRepoName :: String
 	, sshPort :: Int
 	, needsPubKey :: Bool
-	, rsyncOnly :: Bool
+	, sshCapabilities :: [SshServerCapability]
 	}
 	deriving (Read, Show, Eq)
 
+data SshServerCapability = GitAnnexShellCapable | GitCapable | RsyncCapable
+	deriving (Read, Show, Eq)
+
+hasCapability :: SshData -> SshServerCapability -> Bool
+hasCapability d c = c `elem` sshCapabilities d
+
 data SshKeyPair = SshKeyPair
 	{ sshPubKey :: String
 	, sshPrivKey :: String