summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Git/Config.hs15
-rw-r--r--Remote/GCrypt.hs14
-rw-r--r--Remote/Git.hs22
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