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.

Assistant/WebApp/Configurators/Local.hs

@@ -307,24 +307,21 @@ getFinishAddDriveR drive = go
 		, page "Encrypt repository" (Just Configuration) $
 			$(widgetFile "configurators/needgcrypt")
 		)
-	{- Either making a new unencrypted repo, or combining with
-	 - an existing unencrypted repo, or combining with an existing
-	 - gcrypt special remot, or some other existing gcrypt repo. -}
 	go NoRepoKey = do
-		mu <- liftIO $ probeGCryptRemoteUUID dir
-		case mu of
-			Just u -> enablegcryptremote u
-			Nothing ->
-				ifM (liftAnnex $ inRepo $ Git.GCrypt.probeGCryptRepo dir)
-					( error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
-					, makeunencrypted
-					)
-	{- Sync the git-annex branch from the gcrypt repo, in order to
-	 - make sure we know how the special remote should be set up. -}
+		pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo dir
+		case pr of
+			Git.GCrypt.Decryptable -> do
+				mu <- liftIO $ probeGCryptRemoteUUID dir
+				case mu of
+					Just u -> enablegcryptremote u
+					Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
+			Git.GCrypt.NotDecryptable ->
+				error $ "The drive contains a git repository that is encrypted with a GnuPG key that you do not have."
+			Git.GCrypt.NotEncrypted -> makeunencrypted
 	enablegcryptremote u = do
 		mname <- liftAnnex $ getGCryptRemoteName u dir
 		case mname of
-			Nothing -> error $ "Unable to use the gcrypt remote at " ++ dir ++ ". Perhaps it is encrypted using a GnuPG key that you do not have?"
+			Nothing -> error $ "Cannot find configuration for the gcrypt remote at " ++ dir
 			Just name -> makewith $ const $ do
 				r <- liftAnnex $ addRemote $
 					enableSpecialRemote name GCrypt.remote $ M.fromList

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

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

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

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