webapp: Support storing encrypted git repositories on rsync.net.

Does not yet support re-enabling such a repository though.

This commit was sponsored by Jan Pieper.

1 files changed, 29 insertions, 12 deletions

diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 4b0a4c7d9..8a93e359b 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -14,6 +14,7 @@ import qualified Types.Remote as R
 import qualified Remote
 import Remote.List
 import qualified Remote.Rsync as Rsync
+import qualified Remote.GCrypt as GCrypt
 import qualified Git
 import qualified Git.Command
 import qualified Command.InitRemote
@@ -23,6 +24,8 @@ 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
@@ -31,7 +34,8 @@ import qualified Data.Map as M
 makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote
 makeSshRemote forcersync sshdata mcost = do
 	r <- liftAnnex $
-		addRemote $ maker (sshRepoName sshdata) sshurl
+		addRemote $ maker (sshRepoName sshdata)
+			(sshUrl forcersync sshdata)
 	liftAnnex $ maybe noop (setRemoteCost r) mcost
 	syncRemote r
 	return r
@@ -40,17 +44,20 @@ makeSshRemote forcersync sshdata mcost = do
 	maker
 		| rsync = makeRsyncRemote
 		| otherwise = makeGitRemote
-	sshurl = T.unpack $ T.concat $
-		if rsync
-			then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
-			else [T.pack "ssh://", u, h, d, T.pack "/"]
-	  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]
+
+{- Generates a ssh or rsync url from a SshData. -}
+sshUrl :: Bool -> SshData -> String
+sshUrl forcersync sshdata = T.unpack $ T.concat $
+	if (forcersync || rsyncOnly sshdata)
+		then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"]
+		else [T.pack "ssh://", u, h, d, T.pack "/"]
+  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]
 	
 {- Runs an action that returns a name of the remote, and finishes adding it. -}
 addRemote :: Annex RemoteName -> Annex Remote
@@ -74,6 +81,16 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
 		, ("type", "rsync")
 		]
 
+{- Inits a gcrypt special remote, and returns its name. -}
+makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName
+makeGCryptRemote remotename location keyid = 
+	initSpecialRemote remotename GCrypt.remote $ M.fromList
+		[ ("type", "gcrypt")
+		, ("gitrepo", location)
+		, configureEncryption HybridEncryption
+		, ("keyid", keyid)
+		]
+
 type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName
 
 {- Inits a new special remote. The name is used as a suggestion, but