add back lost check that git-annex-shell supports gcrypt

3 files changed, 38 insertions, 13 deletions

diff --git a/Git/Config.hs b/Git/Config.hs
index adc75a208..513c3e5a6 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -10,6 +10,7 @@ module Git.Config where
 import qualified Data.Map as M
 import Data.Char
 import System.Process (cwd, env)
+import Control.Exception.Extensible
 
 import Common
 import Git
@@ -153,3 +154,17 @@ boolConfig False = "false"
 
 isBare :: Repo -> Bool
 isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r
+
+{- Runs a command to get the configuration of a repo,
+ - and returns a repo populated with the configuration, as well as the raw
+ - output of the command. -}
+fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String))
+fromPipe r cmd params = try $
+	withHandle StdoutHandle createProcessSuccess p $ \h -> do
+ 		fileEncoding h
+		val <- hGetContentsStrict h
+		r' <- store val r
+		return (r', val)
+  where
+	p = proc cmd $ toCommand params
+
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index e5e7e8d48..5e8102652 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -209,7 +209,14 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
  -}
 setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod
 setupRepo gcryptid r
-	| Git.repoIsUrl r = rsyncsetup
+	| Git.repoIsUrl r = do
+		accessmethod <- rsyncsetup
+		case accessmethod of
+			AccessDirect -> return AccessDirect
+			AccessShell -> ifM usablegitannexshell
+				( return AccessShell
+				, return AccessDirect
+				)
 	| Git.repoIsLocalUnknown r = localsetup =<< liftIO (Git.Config.read r)
 	| otherwise = localsetup r
   where
@@ -245,6 +252,11 @@ setupRepo gcryptid r
 			error "Failed to connect to remote to set it up."
 		return accessmethod
 
+	{-  Check if git-annex shell is installed, and is a new enough
+	 -  version to work in a gcrypt repo. -}
+	usablegitannexshell = either (const False) (const True)
+		<$> Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []
+
 shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a
 shellOrRsync r ashell arsync = case method of
 	AccessShell -> ashell
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 2761995b2..6876ec4b4 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -165,18 +165,16 @@ tryGitConfigRead r
 	safely a = either (const $ return r) return
 			=<< liftIO (try a :: IO (Either SomeException Git.Repo))
 
-	pipedconfig cmd params = try run :: IO (Either SomeException Git.Repo)
-	  where
-	  	run = withHandle StdoutHandle createProcessSuccess p $ \h -> do
- 			fileEncoding h
-			val <- hGetContentsStrict h
-			r' <- Git.Config.store val r
-			when (getUncachedUUID r' == NoUUID && not (null val)) $ do
-				warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
-				warningIO $ "Instead, got: " ++ show val
-				warningIO $ "This is unexpected; please check the network transport!"
-			return r'
-		p = proc cmd $ toCommand params
+	pipedconfig cmd params = do
+		v <- Git.Config.fromPipe r cmd params
+		case v of
+			Right (r', val) -> do
+				when (getUncachedUUID r' == NoUUID && not (null val)) $ do
+					warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r
+					warningIO $ "Instead, got: " ++ show val
+					warningIO $ "This is unexpected; please check the network transport!"
+				return $ Right r'
+			Left l -> return $ Left l
 
 	geturlconfig headers = do
 		v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do