From b7424870e015fc4aea50eba700780edd68984bf3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 26 Sep 2013 16:09:45 -0400
Subject: 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.
---
 Assistant/MakeRemote.hs                |  41 +++++++++++++++++++++++----------
 debian/changelog                       |   1 +
 doc/assistant/rsync.net.encryption.png | Bin 0 -> 40504 bytes
 3 files changed, 30 insertions(+), 12 deletions(-)
 create mode 100644 doc/assistant/rsync.net.encryption.png

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
diff --git a/debian/changelog b/debian/changelog
index 5588923c2..7c05434e4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -17,6 +17,7 @@ git-annex (4.20130921) UNRELEASED; urgency=low
     the user running the conversion.
   * add, import, assistant: Better preserve the mtime of symlinks,
     when when adding content that gets deduplicated.
+  * webapp: Support storing encrypted git repositories on rsync.net.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 22 Sep 2013 19:42:29 -0400
 
diff --git a/doc/assistant/rsync.net.encryption.png b/doc/assistant/rsync.net.encryption.png
new file mode 100644
index 000000000..ec751d10d
Binary files /dev/null and b/doc/assistant/rsync.net.encryption.png differ
-- 
cgit v1.2.3