Merge branch 'sshgcrypt'

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,47 +20,20 @@ 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)
 
-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 git or rsync remote, accessed over ssh. -}
+makeSshRemote :: SshData -> Annex RemoteName
+makeSshRemote sshdata = maker (sshRepoName sshdata) (genSshUrl sshdata)
   where
-	rsync = forcersync || rsyncOnly sshdata
 	maker
-		| rsync = makeRsyncRemote
+		| onlyCapability sshdata RsyncCapable = makeRsyncRemote
 		| otherwise = makeGitRemote
 
-{- 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)
-		then [u, h, T.pack ":", sshDirectory sshdata]
-		else [T.pack "ssh://", u, h, d]
-  where
-	u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
-	h = sshHostName sshdata
-	d
-		| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
-		| T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata]
-		| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
-	addtrailingslash s
-		| "/" `isSuffixOf` s = s
-		| otherwise = s ++ "/"
-
 {- Runs an action that returns a name of the remote, and finishes adding it. -}
 addRemote :: Annex RemoteName -> Annex Remote
 addRemote a = do
@@ -146,7 +118,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

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
@@ -22,7 +24,7 @@ import qualified Data.Text as T
 setupAuthorizedKeys :: PairMsg -> FilePath -> IO ()
 setupAuthorizedKeys msg repodir = do
 	validateSshPubKey pubkey
-	unlessM (liftIO $ addAuthorizedKeys False repodir pubkey) $
+	unlessM (liftIO $ addAuthorizedKeys True repodir pubkey) $
 		error "failed setting up ssh authorized keys"
   where
 	pubkey = remoteSshPubKey $ pairMsgData msg
@@ -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 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.

Assistant/Ssh.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant ssh utilities
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,6 +11,7 @@ import Common.Annex
 import Utility.Tmp
 import Utility.UserInfo
 import Utility.Shell
+import Utility.Rsync
 import Git.Remote
 
 import Data.Text (Text)
@@ -25,10 +26,19 @@ 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
+
+onlyCapability :: SshData -> SshServerCapability -> Bool
+onlyCapability d c = all (== c) (sshCapabilities d)
+
 data SshKeyPair = SshKeyPair
 	{ sshPubKey :: String
 	, sshPrivKey :: String
@@ -52,6 +62,48 @@ sshDir = do
 genSshHost :: Text -> Maybe Text -> String
 genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host
 
+{- Generates a ssh or rsync url from a SshData. -}
+genSshUrl :: SshData -> String
+genSshUrl sshdata = addtrailingslash $ T.unpack $ T.concat $
+	if (onlyCapability sshdata RsyncCapable)
+		then [u, h, T.pack ":", sshDirectory sshdata]
+		else [T.pack "ssh://", u, h, d]
+  where
+	u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata
+	h = sshHostName sshdata
+	d
+		| T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata
+		| T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata]
+		| otherwise = T.concat [T.pack "/~/", sshDirectory sshdata]
+	addtrailingslash s
+		| "/" `isSuffixOf` s = s
+		| otherwise = s ++ "/"
+
+{- Reverses genSshUrl -}
+parseSshUrl :: String -> Maybe SshData
+parseSshUrl u
+	| "ssh://" `isPrefixOf` u = fromssh (drop (length "ssh://") u)
+	| otherwise = fromrsync u
+  where
+	mkdata (userhost, dir) = Just $ SshData
+		{ sshHostName = T.pack host
+		, sshUserName = if null user then Nothing else Just $ T.pack user
+		, sshDirectory = T.pack dir
+		, sshRepoName = genSshRepoName host dir
+		-- dummy values, cannot determine from url
+		, sshPort = 22
+		, needsPubKey = True
+		, sshCapabilities = []
+		}
+	  where
+	  	(user, host) = if '@' `elem` userhost
+			then separate (== '@') userhost
+			else ("", userhost)
+	fromrsync s
+		| not (rsyncUrlIsShell u) = Nothing
+		| otherwise = mkdata $ separate (== ':') s
+	fromssh = mkdata . break (== '/')
+
 {- Generates a git remote name, like host_dir or host -}
 genSshRepoName :: String -> FilePath -> String
 genSshRepoName host dir
@@ -92,12 +144,12 @@ validateSshPubKey pubkey
 	safeincomment c = isAlphaNum c || c == '@' || c == '-' || c == '_' || c == '.'
 
 addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool
-addAuthorizedKeys rsynconly dir pubkey = boolSystem "sh"
-	[ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly dir pubkey ]
+addAuthorizedKeys gitannexshellonly dir pubkey = boolSystem "sh"
+	[ Param "-c" , Param $ addAuthorizedKeysCommand gitannexshellonly dir pubkey ]
 
 removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO ()
-removeAuthorizedKeys rsynconly dir pubkey = do
-	let keyline = authorizedKeysLine rsynconly dir pubkey
+removeAuthorizedKeys gitannexshellonly dir pubkey = do
+	let keyline = authorizedKeysLine gitannexshellonly dir pubkey
 	sshdir <- sshDir
 	let keyfile = sshdir </> "authorized_keys"
 	ls <- lines <$> readFileStrict keyfile
@@ -110,7 +162,7 @@ removeAuthorizedKeys rsynconly dir pubkey = do
  - present.
  -}
 addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String
-addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&"
+addAuthorizedKeysCommand gitannexshellonly dir pubkey = intercalate "&&"
 	[ "mkdir -p ~/.ssh"
 	, intercalate "; "
 		[ "if [ ! -e " ++ wrapper ++ " ]"
@@ -122,7 +174,7 @@ addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&"
 	, "chmod 600 ~/.ssh/authorized_keys"
 	, unwords
 		[ "echo"
-		, shellEscape $ authorizedKeysLine rsynconly dir pubkey
+		, shellEscape $ authorizedKeysLine gitannexshellonly dir pubkey
 		, ">>~/.ssh/authorized_keys"
 		]
 	]
@@ -141,11 +193,11 @@ addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&"
 	runshell var = "exec git-annex-shell -c \"" ++ var ++ "\""
 
 authorizedKeysLine :: Bool -> FilePath -> SshPubKey -> String
-authorizedKeysLine rsynconly dir pubkey
+authorizedKeysLine gitannexshellonly dir pubkey
+	| gitannexshellonly = limitcommand ++ pubkey
 	{- TODO: Locking down rsync is difficult, requiring a rather
 	 - long perl script. -}
-	| rsynconly = pubkey
-	| otherwise = limitcommand ++ pubkey
+	| otherwise = pubkey
   where
 	limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding "
 

Assistant/WebApp/Configurators/AWS.hs

@@ -205,7 +205,8 @@ enableAWSRemote _ _ = error "S3 not supported by this build"
 makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler ()
 makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = do
 	liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)
-	setupCloudRemote defaultgroup $ maker hostname remotetype config
+	setupCloudRemote defaultgroup Nothing $
+		maker hostname remotetype config
   where
 	{- AWS services use the remote name as the basis for a host
 	 - name, so filter it to contain valid characters. -}

Assistant/WebApp/Configurators/Pairing.hs

@@ -152,7 +152,7 @@ postFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do
   where
 	alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just
 	setup repodir = setupAuthorizedKeys msg repodir
-	cleanup repodir = removeAuthorizedKeys False repodir $
+	cleanup repodir = removeAuthorizedKeys True repodir $
 		remoteSshPubKey $ pairMsgData msg
 	uuid = Just $ pairUUID $ pairMsgData msg
 #else

Assistant/WebApp/Configurators/Ssh.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant webapp configurator for ssh-based remotes
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -14,14 +14,12 @@ import Assistant.WebApp.Common
 import Assistant.WebApp.Gpg
 import Assistant.Ssh
 import Assistant.MakeRemote
-import Utility.Rsync (rsyncUrlIsShell)
 import Logs.Remote
 import Remote
-import Logs.PreferredContent
 import Types.StandardGroups
 import Utility.UserInfo
 import Utility.Gpg
-import Types.Remote (RemoteConfigKey)
+import Types.Remote (RemoteConfig)
 import Git.Remote
 import Assistant.WebApp.Utility
 import qualified Remote.GCrypt as GCrypt
@@ -54,7 +52,7 @@ mkSshData s = SshData
 		(maybe "" T.unpack $ inputDirectory s)
 	, sshPort = inputPort s
 	, needsPubKey = False
-	, rsyncOnly = False
+	, sshCapabilities = [] -- untested
 	}
 
 mkSshInput :: SshData -> SshInput
@@ -103,15 +101,12 @@ sshInputAForm hostnamefield def = SshInput
 data ServerStatus
 	= UntestedServer
 	| UnusableServer Text -- reason why it's not usable
-	| UsableRsyncServer
-	| UsableSshInput
+	| UsableServer [SshServerCapability]
 	deriving (Eq)
 
-usable :: ServerStatus -> Bool
-usable UntestedServer = False
-usable (UnusableServer _) = False
-usable UsableRsyncServer = True
-usable UsableSshInput = True
+capabilities :: ServerStatus -> [SshServerCapability]
+capabilities (UsableServer cs) = cs
+capabilities _ = []
 
 getAddSshR :: Handler Html
 getAddSshR = postAddSshR
@@ -140,10 +135,11 @@ sshTestModal = $(widgetFile "configurators/ssh/testmodal")
 getEnableRsyncR :: UUID -> Handler Html
 getEnableRsyncR = postEnableRsyncR
 postEnableRsyncR :: UUID -> Handler Html
-postEnableRsyncR = enableSpecialSshRemote "rsyncurl" enableRsyncNet enablersync
+postEnableRsyncR = enableSpecialSshRemote getsshinput enableRsyncNet enablersync
   where
 	enablersync sshdata = redirect $ ConfirmSshR $
-		sshdata { rsyncOnly = True }
+		sshdata { sshCapabilities = [RsyncCapable] }
+	getsshinput = parseSshUrl <=< M.lookup "rsyncurl"
 
 {- This only handles gcrypt repositories that are located on ssh servers;
  - ones on local drives are handled via another part of the UI. -}
@@ -151,19 +147,23 @@ getEnableGCryptR :: UUID -> Handler Html
 getEnableGCryptR = postEnableGCryptR
 postEnableGCryptR :: UUID -> Handler Html
 postEnableGCryptR u = whenGcryptInstalled $
-	enableSpecialSshRemote "gitrepo" enableRsyncNetGCrypt enablersync u
+	enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u
   where
-  	enablersync sshdata = error "TODO enable ssh gcrypt remote"
+  	enablegcrypt sshdata = prepSsh True sshdata $ \sshdata' ->
+		sshConfigurator $
+			checkExistingGCrypt sshdata' $
+				error "Expected to find an encrypted git repository, but did not."
+	getsshinput = parseSshUrl <=< M.lookup "gitrepo"
 
-{- To enable an special remote that uses ssh as its transport, 
+{- 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.
  -}
-enableSpecialSshRemote :: RemoteConfigKey -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> Handler ()) -> UUID -> Handler Html
-enableSpecialSshRemote urlkey rsyncnetsetup genericsetup u = do
+enableSpecialSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> Handler Html) -> UUID -> Handler Html
+enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do
 	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
-	case (parseSshRsyncUrl =<< M.lookup urlkey m, M.lookup "name" m) of
+	case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of
 		(Just sshinput, Just reponame) -> sshConfigurator $ do
 			((result, form), enctype) <- liftH $
 				runFormPost $ renderBootstrap $ sshInputAForm textField sshinput
@@ -175,38 +175,19 @@ enableSpecialSshRemote urlkey rsyncnetsetup genericsetup u = do
 						s <- liftIO $ testServer sshinput'
 						case s of
 							Left status -> showform form enctype status
-							Right sshdata -> liftH $ genericsetup sshdata
+							Right sshdata -> void $ liftH $ genericsetup sshdata
 								{ sshRepoName = reponame }
 				_ -> showform form enctype UntestedServer
 		_ -> redirect AddSshR
   where
+  	unmangle sshdata = sshdata
+		{ sshHostName = T.pack $ unMangleSshHostName $
+			T.unpack $ sshHostName sshdata
+		}
 	showform form enctype status = do
 		description <- liftAnnex $ T.pack <$> prettyUUID u
 		$(widgetFile "configurators/ssh/enable")
 
-{- Converts a rsyncurl value to a SshInput. But only if it's a ssh rsync
- - url; rsync:// urls or bare path names are not supported.
- -
- - The hostname is stored mangled in the remote log for rsync special
- - remotes configured by this webapp. So that mangling has to reversed
- - here to get back the original hostname.
- -}
-parseSshRsyncUrl :: String -> Maybe SshInput
-parseSshRsyncUrl u
-	| not (rsyncUrlIsShell u) = Nothing
-	| otherwise = Just $ SshInput
-			{ inputHostname = val $ unMangleSshHostName host
-			, inputUsername = if null user then Nothing else val user
-			, inputDirectory = val dir
-			, inputPort = 22
-			}
-  where
-	val = Just . T.pack
-	(userhost, dir) = separate (== ':') u
-	(user, host) = if '@' `elem` userhost
-		then separate (== '@') userhost
-		else (userhost, "")
-
 {- Test if we can ssh into the server.
  -
  - Two probe attempts are made. First, try sshing in using the existing
@@ -214,8 +195,9 @@ parseSshRsyncUrl u
  - passwordless login is already enabled, use it. Otherwise,
  - a special ssh key will need to be generated just for this server.
  -
- - Once logged into the server, probe to see if git-annex-shell is
- - available, or rsync. Note that, ~/.ssh/git-annex-shell may be
+ - Once logged into the server, probe to see if git-annex-shell,
+ - git, and rsync are available. 
+ - Note that, ~/.ssh/git-annex-shell may be
  - present, while git-annex-shell is not in PATH.
  -}
 testServer :: SshInput -> IO (Either ServerStatus SshData)
@@ -223,22 +205,23 @@ testServer (SshInput { inputHostname = Nothing }) = return $
 	Left $ UnusableServer "Please enter a host name."
 testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 	status <- probe [sshOpt "NumberOfPasswordPrompts" "0"]
-	if usable status
-		then ret status False
-		else do
+	case capabilities status of
+		[] -> do
 			status' <- probe []
-			if usable status'
-				then ret status' True
-				else return $ Left status'
+			case capabilities status' of
+				[] -> return $ Left status'
+				cs -> ret cs True
+		cs -> ret cs False
   where
-	ret status needspubkey = return $ Right $ (mkSshData sshinput)
+	ret cs needspubkey = return $ Right $ (mkSshData sshinput)
 		{ needsPubKey = needspubkey
-		, rsyncOnly = status == UsableRsyncServer
+		, sshCapabilities = cs
 		}
 	probe extraopts = do
 		let remotecommand = shellWrap $ intercalate ";"
 			[ report "loggedin"
 			, checkcommand "git-annex-shell"
+			, checkcommand "git"
 			, checkcommand "rsync"
 			, checkcommand shim
 			]
@@ -256,14 +239,19 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 			, remotecommand
 			]
 		parsetranscript . fst <$> sshTranscript sshopts Nothing
-	parsetranscript s
-		| reported "git-annex-shell" = UsableSshInput
-		| reported shim = UsableSshInput
-		| reported "rsync" = UsableRsyncServer
-		| reported "loggedin" = UnusableServer
-			"Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?"
-		| otherwise = UnusableServer $ T.pack $
-			"Failed to ssh to the server. Transcript: " ++ s
+	parsetranscript s =
+		let cs = map snd $ filter (reported . fst)
+			[ ("git-annex-shell", GitAnnexShellCapable)
+			, (shim, GitAnnexShellCapable)
+			, ("git", GitCapable)
+			, ("rsync", RsyncCapable)
+			]
+		in if null cs
+			then if reported "loggedin"
+				then UnusableServer "Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?"
+				else UnusableServer $ T.pack $
+					"Failed to ssh to the server. Transcript: " ++ s
+			else UsableServer cs
 	  where
 		reported r = token r `isInfixOf` s
 	
@@ -286,7 +274,9 @@ showSshErr msg = sshConfigurator $
 	$(widgetFile "configurators/ssh/error")
 
 getConfirmSshR :: SshData -> Handler Html
-getConfirmSshR sshdata = sshConfigurator $
+getConfirmSshR sshdata = sshConfigurator $ do
+	secretkeys <- sortBy (comparing snd) . M.toList
+		<$> liftIO secretKeys
 	$(widgetFile "configurators/ssh/confirm")
 
 getRetrySshR :: SshData -> Handler ()
@@ -295,44 +285,81 @@ getRetrySshR sshdata = do
 	redirect $ either (const $ ConfirmSshR sshdata) ConfirmSshR s
 
 getMakeSshGitR :: SshData -> Handler Html
-getMakeSshGitR = makeSsh False
+getMakeSshGitR sshdata = prepSsh False sshdata makeSshRepo
 
 getMakeSshRsyncR :: SshData -> Handler Html
-getMakeSshRsyncR = makeSsh True
+getMakeSshRsyncR sshdata = prepSsh False (rsyncOnly sshdata) makeSshRepo
 
-makeSsh :: Bool -> SshData -> Handler Html
-makeSsh rsync sshdata
+rsyncOnly :: SshData -> SshData
+rsyncOnly sshdata = sshdata { sshCapabilities = [RsyncCapable] }
+
+getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html
+getMakeSshGCryptR sshdata NoRepoKey = whenGcryptInstalled $
+	withNewSecretKey $ getMakeSshGCryptR sshdata . RepoKey
+getMakeSshGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $
+	prepSsh True sshdata $ makeGCryptRepo keyid
+	
+{- Detect if the user entered a location with an existing, known
+ - gcrypt repository, and enable it. Otherwise, runs the action. -}
+checkExistingGCrypt :: SshData -> Widget -> Widget
+checkExistingGCrypt sshdata nope = ifM (liftIO isGcryptInstalled)
+	( checkGCryptRepoEncryption repourl nope $ do
+		mu <- liftAnnex $ probeGCryptRemoteUUID repourl
+		case mu of
+			Just u -> do
+				reponame <- liftAnnex $ getGCryptRemoteName u repourl
+				void $ liftH $ enableGCrypt sshdata reponame
+			Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported."
+	, nope
+	)
+  where
+  	repourl = genSshUrl sshdata
+
+{- Enables an existing gcrypt special remote. -}
+enableGCrypt :: SshData -> RemoteName -> Handler Html
+enableGCrypt sshdata reponame = 
+	setupCloudRemote TransferGroup Nothing $ 
+		enableSpecialRemote reponame GCrypt.remote $ M.fromList
+			[("gitrepo", genSshUrl sshdata)]
+
+{- Sets up remote repository for ssh, or directory for rsync. -}
+prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html
+prepSsh gcrypt sshdata a
 	| needsPubKey sshdata = do
 		keypair <- liftIO genSshKeyPair
 		sshdata' <- liftIO $ setupSshKeyPair keypair sshdata
-		makeSsh' rsync sshdata sshdata' (Just keypair)
+		prepSsh' gcrypt sshdata sshdata' (Just keypair) a
 	| sshPort sshdata /= 22 = do
 		sshdata' <- liftIO $ setSshConfig sshdata []
-		makeSsh' rsync sshdata sshdata' Nothing
-	| otherwise = makeSsh' rsync sshdata sshdata Nothing
+		prepSsh' gcrypt sshdata sshdata' Nothing a
+	| otherwise = prepSsh' gcrypt sshdata sshdata Nothing a
 
-makeSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> Handler Html
-makeSsh' rsync origsshdata sshdata keypair = do
-	sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" $
-		makeSshRepo rsync sshdata
+prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html
+prepSsh' gcrypt origsshdata sshdata keypair a = sshSetup
+	 [ "-p", show (sshPort origsshdata)
+	 , genSshHost (sshHostName origsshdata) (sshUserName origsshdata)
+	 , remoteCommand
+	 ] "" (a sshdata)
   where
-	sshhost = genSshHost (sshHostName origsshdata) (sshUserName origsshdata)
 	remotedir = T.unpack $ sshDirectory sshdata
 	remoteCommand = shellWrap $ intercalate "&&" $ catMaybes
 		[ Just $ "mkdir -p " ++ shellEscape remotedir
 		, Just $ "cd " ++ shellEscape remotedir
-		, if rsync then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi"
-		, if rsync then Nothing else Just "git annex init"
-		, if needsPubKey sshdata
-			then addAuthorizedKeysCommand (rsync || rsyncOnly sshdata) remotedir . sshPubKey <$> keypair
+		, if rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi"
+		, if (rsynconly || gcrypt) then Nothing else Just "git annex init"
+		, if needsPubKey origsshdata
+			then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair
 			else Nothing
 		]
+	rsynconly = onlyCapability origsshdata RsyncCapable
 
-makeSshRepo :: Bool -> SshData -> Handler Html
-makeSshRepo forcersync sshdata = do
-	r <- liftAssistant $ makeSshRemote forcersync sshdata Nothing
-	liftAnnex $ setStandardGroup (Remote.uuid r) TransferGroup
-	redirect $ EditNewCloudRepositoryR $ Remote.uuid r
+makeSshRepo :: SshData -> Handler Html
+makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $
+	makeSshRemote sshdata
+
+makeGCryptRepo :: KeyId -> SshData -> Handler Html
+makeGCryptRepo keyid sshdata = setupCloudRemote TransferGroup Nothing $ 
+	makeGCryptRemote (sshRepoName sshdata) (genSshUrl sshdata) keyid
 
 getAddRsyncNetR :: Handler Html
 getAddRsyncNetR = postAddRsyncNetR
@@ -366,56 +393,35 @@ postAddRsyncNetR = do
 		let reponame = genSshRepoName "rsync.net" 
 			(maybe "" T.unpack $ inputDirectory sshinput)
 		prepRsyncNet sshinput reponame $ \sshdata -> inpage $ 
-			checkexistinggcrypt sshdata $ do
+			checkExistingGCrypt sshdata $ do
 				secretkeys <- sortBy (comparing snd) . M.toList
 					<$> liftIO secretKeys
 				$(widgetFile "configurators/rsync.net/encrypt")
-	{- Detect if the user entered an existing gcrypt repository,
-	 - and enable it. -}
-	checkexistinggcrypt sshdata a = ifM (liftIO isGcryptInstalled)
-		( checkGCryptRepoEncryption repourl a $ do
-			mu <- liftAnnex $ probeGCryptRemoteUUID repourl
-			case mu of
-				Just u -> do
-					reponame <- liftAnnex $ getGCryptRemoteName u repourl
-					void $ liftH $ enableRsyncNetGCrypt' sshdata reponame
-				Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported."
-		, a
-		)
-	  where
-	  	repourl = sshUrl True sshdata
 
 getMakeRsyncNetSharedR :: SshData -> Handler Html
-getMakeRsyncNetSharedR sshdata = makeSshRepo True sshdata
+getMakeRsyncNetSharedR = makeSshRepo . rsyncOnly
 
 {- Make a gcrypt special remote on rsync.net. -}
 getMakeRsyncNetGCryptR :: SshData -> RepoKey -> Handler Html
 getMakeRsyncNetGCryptR sshdata NoRepoKey = whenGcryptInstalled $
 	withNewSecretKey $ getMakeRsyncNetGCryptR sshdata . RepoKey
 getMakeRsyncNetGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ do
-	sshSetup [sshhost, gitinit] [] $
-		setupCloudRemote TransferGroup $ 
-			makeGCryptRemote (sshRepoName sshdata) (sshUrl True sshdata) keyid
+	sshSetup [sshhost, gitinit] [] $ makeGCryptRepo keyid sshdata
   where
 	sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)
 	gitinit = "git init --bare " ++ T.unpack (sshDirectory sshdata)
 
 enableRsyncNet :: SshInput -> String -> Handler Html
 enableRsyncNet sshinput reponame = 
-	prepRsyncNet sshinput reponame $ makeSshRepo True
+	prepRsyncNet sshinput reponame $ makeSshRepo . rsyncOnly
 
 enableRsyncNetGCrypt :: SshInput -> RemoteName -> Handler Html
 enableRsyncNetGCrypt sshinput reponame = 
 	prepRsyncNet sshinput reponame $ \sshdata ->
-		checkGCryptRepoEncryption (sshUrl True sshdata) notencrypted $
-			enableRsyncNetGCrypt' sshdata reponame
+		checkGCryptRepoEncryption (genSshUrl sshdata) notencrypted $
+			enableGCrypt sshdata reponame
   where
 	notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository."
-enableRsyncNetGCrypt' :: SshData -> RemoteName -> Handler Html
-enableRsyncNetGCrypt' sshdata reponame = 
-	setupCloudRemote TransferGroup $ 
-		enableSpecialRemote reponame GCrypt.remote $ M.fromList
-			[("gitrepo", sshUrl True sshdata)]
 
 {- Prepares rsync.net ssh key, and if successful, runs an action with
  - its SshData. -}
@@ -427,7 +433,7 @@ prepRsyncNet sshinput reponame a = do
 		(mkSshData sshinput)
 			{ sshRepoName = reponame 
 			, needsPubKey = True
-			, rsyncOnly = True
+			, sshCapabilities = [RsyncCapable]
 			}
 	{- I'd prefer to separate commands with && , but
 	 - rsync.net's shell does not support that.

Assistant/WebApp/Configurators/WebDAV.hs

@@ -126,7 +126,8 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build"
 makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler ()
 makeWebDavRemote maker name creds config = do
 	liftIO $ WebDAV.setCredsEnv creds
-	setupCloudRemote TransferGroup $ maker name WebDAV.remote config
+	setupCloudRemote TransferGroup Nothing $
+		maker name WebDAV.remote config
 
 {- Only returns creds previously used for the same hostname. -}
 previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair)

Assistant/WebApp/Utility.hs

@@ -20,6 +20,7 @@ import qualified Remote.List as Remote
 import qualified Assistant.Threads.Transferrer as Transferrer
 import Logs.Transfer
 import qualified Config
+import Config.Cost
 import Config.Files
 import Git.Config
 import Assistant.Threads.Watcher
@@ -125,12 +126,13 @@ getCurrentTransfers :: Handler TransferMap
 getCurrentTransfers = currentTransfers <$> liftAssistant getDaemonStatus
 
 {- Runs an action that creates or enables a cloud remote,
- - and finishes setting it up; adding it to a group if it's not already in
- - one, starts syncing with it, and finishes by displaying the page to edit
- - it. -}
-setupCloudRemote :: StandardGroup -> Annex RemoteName -> Handler a
-setupCloudRemote defaultgroup maker = do
+ - and finishes setting it up, then starts syncing with it,
+ - and finishes by displaying the page to edit it. -}
+setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a
+setupCloudRemote defaultgroup mcost maker = do
 	r <- liftAnnex $ addRemote maker
-	liftAnnex $ setStandardGroup (Remote.uuid r) defaultgroup
+	liftAnnex $ do
+		setStandardGroup (Remote.uuid r) defaultgroup
+		maybe noop (Config.setRemoteCost r) mcost
 	liftAssistant $ syncRemote r
 	redirect $ EditNewCloudRepositoryR $ Remote.uuid r

Assistant/WebApp/routes

@@ -44,6 +44,7 @@
 /config/repository/add/ssh/retry/#SshData RetrySshR GET
 /config/repository/add/ssh/make/git/#SshData MakeSshGitR GET
 /config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET
+/config/repository/add/ssh/make/gcrypt/#SshData/#RepoKey MakeSshGCryptR GET
 /config/repository/add/cloud/rsync.net AddRsyncNetR GET POST
 /config/repository/add/cloud/rsync.net/shared/#SshData MakeRsyncNetSharedR GET
 /config/repository/add/cloud/rsync.net/gcrypt/#SshData/#RepoKey MakeRsyncNetGCryptR GET

Command/GCryptSetup.hs

@@ -0,0 +1,35 @@
+{- git-annex command
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.GCryptSetup where
+
+import Common.Annex
+import Command
+import Annex.UUID
+import qualified Remote.GCrypt
+import qualified Git
+
+def :: [Command]
+def = [dontCheck repoExists $ noCommit $
+	command "gcryptsetup" paramValue seek
+		SectionPlumbing "sets up gcrypt repository"]
+
+seek :: [CommandSeek]
+seek = [withStrings start]
+
+start :: String -> CommandStart
+start gcryptid = next $ next $ do
+	g <- gitRepo
+	u <- getUUID
+	gu <- Remote.GCrypt.getGCryptUUID True g
+	if u == NoUUID && gu == Nothing
+		then if Git.repoIsLocalBare g
+			then do
+				void $ Remote.GCrypt.setupRepo gcryptid g
+				return True
+			else error "cannot use gcrypt in a non-bare repository"
+		else error "gcryptsetup permission denied"

Git/Config.hs

@@ -177,3 +177,14 @@ fromFile r f = fromPipe r "git"
 	, File f
 	, Param "--list"
 	]
+
+{- Changes a git config setting in the specified config file.
+ - (Creates the file if it does not already exist.) -}
+changeFile :: FilePath -> String -> String -> IO Bool
+changeFile f k v = boolSystem "git"
+	[ Param "config"
+	, Param "--file"
+	, File f
+	, Param k
+	, Param v
+	]

GitAnnexShell.hs

@@ -30,24 +30,26 @@ import qualified Command.RecvKey
 import qualified Command.SendKey
 import qualified Command.TransferInfo
 import qualified Command.Commit
+import qualified Command.GCryptSetup
 
 cmds_readonly :: [Command]
 cmds_readonly = concat
-	[ Command.ConfigList.def
-	, Command.InAnnex.def
-	, Command.SendKey.def
-	, Command.TransferInfo.def
+	[ gitAnnexShellCheck Command.ConfigList.def
+	, gitAnnexShellCheck Command.InAnnex.def
+	, gitAnnexShellCheck Command.SendKey.def
+	, gitAnnexShellCheck Command.TransferInfo.def
 	]
 
 cmds_notreadonly :: [Command]
 cmds_notreadonly = concat
-	[ Command.RecvKey.def
-	, Command.DropKey.def
-	, Command.Commit.def
+	[ gitAnnexShellCheck Command.RecvKey.def
+	, gitAnnexShellCheck Command.DropKey.def
+	, gitAnnexShellCheck Command.Commit.def
+	, Command.GCryptSetup.def
 	]
 
 cmds :: [Command]
-cmds = map gitAnnexShellCheck $ map adddirparam $ cmds_readonly ++ cmds_notreadonly
+cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
   where
 	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
 
@@ -191,8 +193,8 @@ checkEnv var = do
 
 {- Modifies a Command to check that it is run in either a git-annex
  - repository, or a repository with a gcrypt-id set. -}
-gitAnnexShellCheck :: Command -> Command
-gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists
+gitAnnexShellCheck :: [Command] -> [Command]
+gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists
   where
 	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
 		error "Not a git-annex or gcrypt repository."

Remote/GCrypt.hs

@@ -9,7 +9,8 @@ module Remote.GCrypt (
 	remote,
 	gen,
 	getGCryptUUID,
-	coreGCryptId
+	coreGCryptId,
+	setupRepo
 ) where
 
 import qualified Data.Map as M
@@ -163,7 +164,7 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
 
 		{- Run a git fetch and a push to the git repo in order to get
 		 - its gcrypt-id set up, so that later git annex commands
-		 - will use the remote as a ggcrypt remote. The fetch is
+		 - will use the remote as a gcrypt remote. The fetch is
 		 - needed if the repo already exists; the push is needed
 		 - if the repo has not yet been initialized by gcrypt. -}
 		void $ inRepo $ Git.Command.runBool
@@ -185,51 +186,50 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
 						method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo)
 						gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method)
 						return (c', u)
-					else error "uuid mismatch"
+					else error $ "uuid mismatch " ++ show (u, mu, gcryptid)
 
 {- Sets up the gcrypt repository. The repository is either a local
  - repo, or it is accessed via rsync directly, or it is accessed over ssh
  - and git-annex-shell is available to manage it.
  -
- - The gcrypt-id is stored in the gcrypt repository for later
- - double-checking and identification. This is always done using rsync.
+ - The GCryptID is recorded in the repository's git config for later use.
+ - Also, if the git config has receive.denyNonFastForwards set, disable
+ - it; gcrypt relies on being able to fast-forward branches.
  -}
 setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod
 setupRepo gcryptid r
 	| Git.repoIsUrl r = do
-		accessmethod <- rsyncsetup
+		(_, _, accessmethod) <- rsyncTransport r
 		case accessmethod of
-			AccessDirect -> return AccessDirect
-			AccessShell -> ifM usablegitannexshell
+			AccessDirect -> rsyncsetup
+			AccessShell -> ifM gitannexshellsetup
 				( return AccessShell
-				, return AccessDirect
+				, rsyncsetup
 				)
 	| Git.repoIsLocalUnknown r = localsetup =<< liftIO (Git.Config.read r)
 	| otherwise = localsetup r
   where
 	localsetup r' = do
-		liftIO $ Git.Command.run [Param "config", Param coreGCryptId, Param gcryptid] r'
+		let setconfig k v = liftIO $ Git.Command.run [Param "config", Param k, Param v] r'
+		setconfig coreGCryptId gcryptid
+		setconfig denyNonFastForwards (Git.Config.boolConfig False)
 		return AccessDirect
 
-	{- Download any git config file from the remote,
-	 - add the gcryptid to it, and send it back.
-	 -
-	 - At the same time, create the objectDir on the remote,
-	 - which is needed for direct rsync to work.
+	{- As well as modifying the remote's git config, 
+	 - create the objectDir on the remote,
+	 - which is needed for direct rsync of objects to work.
 	 -}
   	rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
 		liftIO $ createDirectoryIfMissing True $ tmp </> objectDir
-		(rsynctransport, rsyncurl, accessmethod) <- rsyncTransport r
+		(rsynctransport, rsyncurl, _) <- rsyncTransport r
 		let tmpconfig = tmp </> "config"
 		void $ liftIO $ rsync $ rsynctransport ++
 			[ Param $ rsyncurl ++ "/config"
 			, Param tmpconfig
 			]
-		liftIO $ appendFile tmpconfig $ unlines
-			[ ""
-			, "[core]"
-			, "\tgcrypt-id = " ++ gcryptid
-			]
+		liftIO $ do
+			void $ Git.Config.changeFile tmpconfig coreGCryptId gcryptid
+			void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False)
 		ok <- liftIO $ rsync $ rsynctransport ++
 			[ Params "--recursive"
 			, Param $ tmp ++ "/"
@@ -237,12 +237,14 @@ setupRepo gcryptid r
 			]
 		unless ok $
 			error "Failed to connect to remote to set it up."
-		return accessmethod
+		return AccessDirect
 
-	{-  Check if git-annex shell is installed, and is a new enough
-	 -  version to work in a gcrypt repo. -}
-	usablegitannexshell = either (const False) (const True)
-		<$> Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []
+	{-  Ask git-annex-shell to configure the repository as a gcrypt
+	 -  repository. May fail if it is too old. -}
+	gitannexshellsetup = Ssh.onRemote r (boolSystem, False)
+		"gcryptsetup" [ Param gcryptid ] []
+
+	denyNonFastForwards = "receive.denyNonFastForwards"
 
 shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a
 shellOrRsync r ashell arsync = case method of

debian/changelog

@@ -28,6 +28,8 @@ git-annex (4.20130921) UNRELEASED; urgency=low
     written by MacGPG.
   * assistant: More robust inotify handling; avoid crashing if a directory
     cannot be read.
+  * Disable receive.denyNonFastForwards when setting up a gcrypt special
+    remote, since gcrypt needs to be able to fast-forward the master branch.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 22 Sep 2013 19:42:29 -0400
 

doc/design/assistant/encrypted_git_remotes.mdwn

@@ -3,14 +3,15 @@ using [git-remote-gcrypt](https://github.com/blake2-ppc/git-remote-gcrypt).
 
 There are at least two use cases for this in the assistant:
 
-* Storing an encrypted git repository on a local drive.
+* Storing an encrypted git repository on a local drive. **done**
 * Or on a remote server. This could even allow using github. But more
   likely would be a shell server that has git-annex-shell on it so can
   also store file contents, and which is not trusted with unencrypted data.
+  **done**
 
 git-remote-gcrypt is already usable with git-annex. What's needed is
 to make sure it's installed (ie, get it packaged into distros or embedded
-into git-annex), and make it easy to set up from the webapp.
+into git-annex), and make it easy to set up from the webapp. **done**
 
 Hmm, this will need gpg key creation, so would also be a good opportunity
 to make the webapp allow using that for special remotes too.
@@ -18,4 +19,4 @@ to make the webapp allow using that for special remotes too.
 One change is needed in git-annex core.. It currently does not support
 storing encrypted files on git remotes, only on special remotes. Perhaps
 the way to deal with this is to make it consider git-remote-grypt remotes
-to be a special remote type?
+to be a special remote type? **done**

doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM"
+ nickname="Tom"
+ subject="comment 1"
+ date="2013-10-01T17:38:03Z"
+ content="""
+I've had this issue as well. Saw a comment on Joey's blog that implies he knows about it and that a fix will be released soon.
+"""]]

doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment

@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkeJKC5Sy0stmcTWyePOLEVv0G-x1yaT_w"
+ nickname="Josef"
+ subject="Additional Comments"
+ date="2013-09-30T21:33:31Z"
+ content="""
+Imported several thousand files to annex and would like to add the following comments:
+
+- it would be great to have an option to exclude hidden dot files from import,
+
+- empty directories should be deleted when files located in the directories are deleted,
+
+- \"git annex add\" seems to process directories and files alphabetically, unfortunately import processes files in a different order, which makes it hard to predict which files are deleted when deduplicating,
+
+Cheers,
+
+"""]]

doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment

@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM"
+ nickname="Tom"
+ subject="comment 3"
+ date="2013-10-01T18:33:05Z"
+ content="""
+I've got the same issue on Xubuntu 13.04. I installed using this script: https://github.com/zerodogg/scriptbucket/blob/master/gitannex-install
+
+`git-annex version` makes no mention of DNS or ADNS
+
+`host` command is installed on my machine. any suggestions on how best to fix for this setup?
+"""]]

doc/git-annex-shell.mdwn

@@ -60,6 +60,10 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
   This commits any staged changes to the git-annex branch.
   It also runs the annex-content hook.
 
+* gcryptsetup gcryptid
+
+  Sets up a repository as a gcrypt repository.
+
 # OPTIONS
 
 Most options are the same as in git-annex. The ones specific

templates/configurators/rsync.net/encrypt.hamlet

@@ -26,11 +26,11 @@
   <p>
     $forall (keyid, name) <- secretkeys
       <p>
-        <a .btn onclick="$('#setupmodal').modal('show');" href="@{MakeRsyncNetGCryptR sshdata (RepoKey keyid)}">
+        <a .btn href="@{MakeRsyncNetGCryptR sshdata (RepoKey keyid)}" onclick="$('#setupmodal').modal('show');">
           <i .icon-lock></i> Encrypt repository #
         to ^{gpgKeyDisplay keyid (Just name)}
   <p>
-    <a .btn onclick="$('#genkeymodal').modal('show');" href="@{MakeRsyncNetGCryptR sshdata NoRepoKey}">
+    <a .btn href="@{MakeRsyncNetGCryptR sshdata NoRepoKey}" onclick="$('#genkeymodal').modal('show');">
       <i .icon-plus-sign></i> Encrypt repository #
     with a new encryption key
 ^{genKeyModal}

templates/configurators/ssh/confirm.hamlet

@@ -3,45 +3,69 @@
     Ready to add remote server
   <div .row-fluid>
     <div .span9>
-      <p>
-        The server #{sshHostName sshdata} has been verified to be usable.
-      <p>
-        You have two options for how to use the server:
-      <p>
-        $if not (rsyncOnly sshdata)
-          <a .btn .btn-primary href="@{MakeSshGitR sshdata}" onclick="$('#setupmodal').modal('show');">
-            Use a git repository on the server
-        $else
-          <a .btn .disabled .btn-warning href="@{RetrySshR sshdata}" onclick="$('#testmodal').modal('show');">
-            Use a git repository on the server (not available) #
-          <a .btn .btn-primary href="@{RetrySshR sshdata}" onclick="$('#testmodal').modal('show');">
-            Retry
-          <br>
+      $if not (hasCapability sshdata GitAnnexShellCapable)
+        <p>
           <i .icon-warning-sign></i> #
-          <i>
-            The server needs git and git-annex installed to use this option.
-        <br>
-        All your data will be uploaded to the server, including the full #
-        git repository. This is a great choice if you want to set up #
-        other devices to use the same server, or share the repository with #
-        others.
-      <p style="text-align: center">
-        -or-
+          The server #{sshHostName sshdata} can be used as is, but #
+          installing #
+          $if not (hasCapability sshdata GitCapable)
+            git and git-annex #
+          $else
+            git-annex #
+          on it would make it work better, and provide more options below. #
+        <p>
+          If you're able to install software on the server, do so and click
+          <a .btn href="@{RetrySshR sshdata}" onclick="$('#testmodal').modal('show');">
+            Retry
+      $else
+        <p>
+          The server #{sshHostName sshdata} has been verified to be usable. #
+          Depending on whether you trust this server, you can choose between #
+          storing your data on it encrypted, or unencrypted.
+        <h3>
+          Unencrypted repository
+        <p>
+          All your data will be uploaded to the server, including a clone of #
+          the git repository. This is a good choice if you want to set up #
+          other devices to use the same server, or share the repository with #
+          others.
+        <p>
+          <a .btn href="@{MakeSshGitR sshdata}" onclick="$('#setupmodal').modal('show');">
+            Make an unencrypted git repository on the server
+        <p style="text-align: center">
+          -or-
+      <h3>
+        Simple shared encryption
       <p>
-        <a .btn .btn-primary href="@{MakeSshRsyncR sshdata}" onclick="$('#setupmodal').modal('show');">
-          Use an encrypted rsync repository on the server
-        <br>
-        The contents of your files will be stored, fully encrypted, on the #
-        server. The server will not store other information about your #
-        git repository. This is the best choice if you don't run the server #
-        yourself, or have sensitive data.
-    <div .span4>
-      $if needsPubKey sshdata
-        <div .alert .alert-info>
-          <i .icon-info-sign></i> #
-          A ssh key will be installed on the server, allowing git-annex to #
-          access it securely without a password.
+        This allows everyone who has a clone of this repository to #
+        decrypt the files stored on #{sshHostName sshdata}. That makes #
+        it good for sharing. And it's easy to set up and use.
+      <p>
+        <a .btn href="@{MakeSshRsyncR sshdata}" onclick="$('#setupmodal').modal('show');">
+          <i .icon-lock></i> Use shared encryption
+      $if hasCapability sshdata GitCapable
+        <p style="text-align: center">
+          -or-
+        <h3>
+          Encrypt with GnuPG key
+        <p>
+          This stores an encrypted clone of your repository on #
+          #{sshHostName sshdata}, unlike shared encryption which only #
+          stores file contents there. So it's good for backups. But the #
+          encryption will prevent you from sharing the repository with #
+          friends, or easily accessing its contents on another computer.
+        <p>
+          $forall (keyid, name) <- secretkeys
+            <p>
+              <a .btn href="@{MakeSshGCryptR sshdata (RepoKey keyid)}" onclick="$('#setupmodal').modal('show');" >
+                <i .icon-lock></i> Encrypt repository #
+              to ^{gpgKeyDisplay keyid (Just name)}
+        <p>
+          <a .btn href="@{MakeSshGCryptR sshdata NoRepoKey}" onclick="$('#genkeymodal').modal('show');">
+            <i .icon-plus-sign></i> Encrypt repository #
+          with a new encryption key
 ^{sshTestModal}
+^{genKeyModal}
 <div .modal .fade #setupmodal>
   <div .modal-header>
     <h3>