webapp: support adding existing gcrypt special remotes from removable drives

When adding a removable drive, it's now detected if the drive contains
a gcrypt special remote, and that's all handled nicely. This includes
fetching the git-annex branch from the gcrypt repo in order to find
out how to set up the special remote.

Note that gcrypt repos that are not git-annex special remotes are not
supported. It will attempt to detect such a gcrypt repo and refuse
to use it. (But this is hard to do any may fail; see
https://github.com/blake2-ppc/git-remote-gcrypt/issues/6)

The problem with supporting regular gcrypt repos is that we don't know
what the gcrypt.participants setting is intended to be for the repo.
So even if we can decrypt it, if we push changes to it they might not be
visible to other participants.

Anyway, encrypted sneakernet (or mailnet) is now fully possible with the
git-annex assistant! Assuming that the gpg key distribution is handled
somehow, which the assistant doesn't yet help with.

This commit was sponsored by Navishkar Rao.

5 files changed, 52 insertions, 21 deletions

diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs
index 2e06d52cd..6a77eedc6 100644
--- a/Assistant/DeleteRemote.hs
+++ b/Assistant/DeleteRemote.hs
@@ -17,8 +17,7 @@ import Logs.Location
 import Assistant.DaemonStatus
 import qualified Remote
 import Remote.List
-import qualified Git.Command
-import qualified Git.BuildVersion
+import qualified Git.Remote
 import Logs.Trust
 import qualified Annex
 
@@ -35,15 +34,7 @@ disableRemote uuid = do
 	remote <- fromMaybe (error "unknown remote")
 		<$> liftAnnex (Remote.remoteFromUUID uuid)
 	liftAnnex $ do
-		inRepo $ Git.Command.run
-			[ Param "remote"
-			-- name of this subcommand changed
-			, Param $
-				if Git.BuildVersion.older "1.8.0"
-					then "rm"
-					else "remove"
-			, Param (Remote.name remote)
-			]
+		inRepo $ Git.Remote.remove (Remote.name remote)
 		void $ remoteListRefresh
 	updateSyncRemotes
 	return remote
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index fa662babd..4b0a4c7d9 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -27,8 +27,6 @@ import Creds
 import qualified Data.Text as T
 import qualified Data.Map as M
 
-type RemoteName = String
-
 {- Sets up and begins syncing with a new ssh or rsync remote. -}
 makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote
 makeSshRemote forcersync sshdata mcost = do
diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs
index 1260c2ced..c8c193c45 100644
--- a/Git/GCrypt.hs
+++ b/Git/GCrypt.hs
@@ -13,6 +13,7 @@ import Common
 import Git.Types
 import Git.Construct
 import qualified Git.Config as Config
+import qualified Git.Command as Command
 import Utility.Gpg
 
 urlPrefix :: String
@@ -44,12 +45,28 @@ encryptedRepo baserepo = go
 	go _ = notencrypted
 	notencrypted = error "not a gcrypt encrypted repository"
 
+{- Checks if the git repo at a location is a gcrypt repo that
+ - we can decrypt. This works by trying to fetch from the repo
+ - at the location, into the baserepo.
+ -
+ - Returns false if the git repo is not using gcrypt, or if it is using
+ - gcrypt but cannot be decrypted. We do not try to detect gcrypt
+ - repos that cannot be decrypted, because gcrypt may change in the future
+ - to avoid easy fingerprinting of gcrypt repos.
+ -}
+probeGCryptRepo :: FilePath -> Repo -> IO Bool
+probeGCryptRepo dir baserepo = catchBoolIO $ Command.runBool
+	[ Param "fetch"
+	, Param $ urlPrefix ++ dir
+	] baserepo
+
 type RemoteName = String
+type GCryptId = String
 
 {- gcrypt gives each encrypted repository a uique gcrypt-id,
  - which is stored in the repository (in encrypted form)
  - and cached in a per-remote gcrypt-id configuration setting. -}
-remoteRepoId :: Repo -> Maybe RemoteName -> Maybe String
+remoteRepoId :: Repo -> Maybe RemoteName -> Maybe GCryptId
 remoteRepoId = getRemoteConfig "gcrypt-id"
 
 getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String
diff --git a/Git/Remote.hs b/Git/Remote.hs
index 5640e9ff2..e853e53cb 100644
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -8,15 +8,21 @@
 module Git.Remote where
 
 import Common
+import Git
+import qualified Git.Command
+import qualified Git.BuildVersion
+
 import Data.Char
 
+type RemoteName = String
+
 {- Construct a legal git remote name out of an arbitrary input string.
  -
  - There seems to be no formal definition of this in the git source,
  - just some ad-hoc checks, and some other things that fail with certian
  - types of names (like ones starting with '-').
  -}
-makeLegalName :: String -> String
+makeLegalName :: String -> RemoteName
 makeLegalName s = case filter legal $ replace "/" "_" s of
 	-- it can't be empty
 	[] -> "unnamed"
@@ -31,3 +37,14 @@ makeLegalName s = case filter legal $ replace "/" "_" s of
 	legal '_' = True
 	legal '.' = True
 	legal c = isAlphaNum c
+	
+remove :: RemoteName -> Repo -> IO ()
+remove remotename = Git.Command.run
+	[ Param "remote"
+	-- name of this subcommand changed
+	, Param $
+		if Git.BuildVersion.older "1.8.0"
+			then "rm"
+			else "remove"
+	, Param remotename
+	]
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 70f82f667..d5448ca64 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Remote.GCrypt (remote, gen) where
+module Remote.GCrypt (remote, gen, getGCryptId) where
 
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
@@ -52,13 +52,10 @@ gen gcryptr u c gc = do
 	-- get underlying git repo with real path, not gcrypt path
 	r <- liftIO $ Git.GCrypt.encryptedRepo g gcryptr
 	let r' = r { Git.remoteName = Git.remoteName gcryptr }
-	-- read config of underlying repo if it's local
-	r'' <- if Git.repoIsLocalUnknown r'
-		then liftIO $ catchDefaultIO r' $ Git.Config.read r'
-		else return r'
+	(mgcryptid, r'') <- liftIO $ getGCryptId r'
 	-- doublecheck that local cache matches underlying repo's gcrypt-id
 	-- (which might not be set)
-	case (Git.Config.getMaybe "core.gcrypt-id" r'', Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of
+	case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of
 		(Just gcryptid, Just cachedgcryptid)
 			| gcryptid /= cachedgcryptid -> resetup gcryptid r''
 		_ -> gen' r'' u c gc
@@ -81,6 +78,17 @@ gen gcryptr u c gc = do
 				warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r
 				return Nothing
 
+{- gcrypt repos set up by git-annex as special remotes have a
+ - core.gcrypt-id setting in their config, which can be mapped back to
+ - the remote's UUID. This only works for local repos.
+ - (Also returns a version of input repo with its config read.) -}
+getGCryptId :: Git.Repo -> IO (Maybe Git.GCrypt.GCryptId, Git.Repo)
+getGCryptId r
+	| Git.repoIsLocalUnknown r = do
+		r' <- catchDefaultIO r $ Git.Config.read r
+		return (Git.Config.getMaybe "core.gcrypt-id" r', r')
+	| otherwise = return (Nothing, r)
+
 gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen' r u c gc = do
 	cst <- remoteCost gc $