better probing for gcrypt repositories using new --check option

Now can tell if a repo uses gcrypt or not, and whether it's decryptable
with the current gpg keys.

This closes the hole that undecryptable gcrypt repos could have before been
combined into the repo in encrypted mode.

4 files changed, 24 insertions, 18 deletions

diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs
index c8c193c45..f2f38dfa4 100644
--- a/Git/GCrypt.hs
+++ b/Git/GCrypt.hs
@@ -32,8 +32,8 @@ isEncrypted _ = False
  - Throws an exception if an url is invalid or the repo does not use
  - gcrypt.
  -}
-encryptedRepo :: Repo -> Repo -> IO Repo
-encryptedRepo baserepo = go
+encryptedRemote :: Repo -> Repo -> IO Repo
+encryptedRemote baserepo = go
   where
   	go Repo { location = Url url }
 		| urlPrefix `isPrefixOf` u =
@@ -45,20 +45,26 @@ 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.
+data ProbeResult = Decryptable | NotDecryptable | NotEncrypted
+
+{- Checks if the git repo at a location uses gcrypt.
+ - 
+ - Rather expensive -- many need to fetch the entire repo contents.
+ - (Which is fine if the repo is going to be added as a remote..)
  -}
-probeGCryptRepo :: FilePath -> Repo -> IO Bool
-probeGCryptRepo dir baserepo = catchBoolIO $ Command.runBool
-	[ Param "fetch"
-	, Param $ urlPrefix ++ dir
-	] baserepo
+probeRepo :: String -> Repo -> IO ProbeResult
+probeRepo loc baserepo = do
+	let p = proc "git" $ toCommand $ Command.gitCommandLine
+		[ Param "remote-gcrypt"
+		, Param "--check"
+		, Param loc
+		] baserepo
+	(_, _, _, pid) <- createProcess p
+	code <- waitForProcess pid
+	return $ case code of
+		ExitSuccess -> Decryptable
+		ExitFailure 1 -> NotDecryptable
+		ExitFailure _ -> NotEncrypted
 
 type RemoteName = String
 type GCryptId = String
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index d5448ca64..27d368690 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -50,7 +50,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remot
 gen gcryptr u c gc = do
 	g <- gitRepo
 	-- get underlying git repo with real path, not gcrypt path
-	r <- liftIO $ Git.GCrypt.encryptedRepo g gcryptr
+	r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr
 	let r' = r { Git.remoteName = Git.remoteName gcryptr }
 	(mgcryptid, r'') <- liftIO $ getGCryptId r'
 	-- doublecheck that local cache matches underlying repo's gcrypt-id
diff --git a/Remote/Git.hs b/Remote/Git.hs
index d761b03ba..2802db9ae 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -128,7 +128,7 @@ repoAvail r
 	| Git.GCrypt.isEncrypted r = do
 		g <- gitRepo
 		liftIO $ do
-			er <- Git.GCrypt.encryptedRepo g r
+			er <- Git.GCrypt.encryptedRemote g r
 			if Git.repoIsLocal er || Git.repoIsLocalUnknown er
 				then catchBoolIO $
 					void (Git.Config.read er) >> return True
diff --git a/debian/control b/debian/control
index 5c42e3442..fc7e3d608 100644
--- a/debian/control
+++ b/debian/control
@@ -72,7 +72,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
 	wget,
 	curl,
 	openssh-client (>= 1:5.6p1)
-Recommends: lsof, gnupg, bind9-host, ssh-askpass, quvi, git-remote-gcrypt
+Recommends: lsof, gnupg, bind9-host, ssh-askpass, quvi, git-remote-gcrypt (>= 0.20130908-4)
 Suggests: graphviz, bup, libnss-mdns
 Description: manage files with git, without checking their contents into git
  git-annex allows managing files with git, without checking the file