summaryrefslogtreecommitdiff
path: root/Remote/Git.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-12 13:45:14 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-12 13:45:14 -0400
commitb5e4e1fd407395e2f37192eeed1a15c3bde013a8 (patch)
tree35eeab60fb6639d7322f6f0f6d5c7ef6ba8a4bf4 /Remote/Git.hs
parent613b162611b45ebd6e4f7ee1d1227b46b02cc4c7 (diff)
Automatically detect when a ssh remote does not have git-annex-shell installed, and set annex-ignore.
Aka solve the github problem. Note that it's possible the initial configlist will fail for some network reason etc, and then the fetch succeeds. In this case, a usable remote gets disabled. But it does print a message, and this only happens once per remote, so that seems ok.
Diffstat (limited to 'Remote/Git.hs')
-rw-r--r--Remote/Git.hs23
1 files changed, 20 insertions, 3 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs
index df97db7a6..cc524fd30 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -22,6 +22,7 @@ import Types.Remote
import qualified Git
import qualified Git.Config
import qualified Git.Construct
+import qualified Git.Command
import qualified Annex
import Logs.Presence
import Logs.Transfer
@@ -126,7 +127,20 @@ guardUsable r onerr a
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r
| not $ M.null $ Git.config r = return r -- already read
- | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] []
+ | Git.repoIsSsh r = store $ do
+ v <- onRemote r (pipedsshconfig, Left undefined) "configlist" [] []
+ case (v, Git.remoteName r) of
+ (Right r', _) -> return r'
+ (Left _, Just n) -> do
+ {- Is this remote just not available, or does
+ - it not have git-annex-shell?
+ - Find out by trying to fetch from the remote. -}
+ whenM (inRepo $ Git.Command.runBool "fetch" [Param "--quiet", Param n]) $ do
+ let k = "remote." ++ n ++ ".annex-ignore"
+ warning $ "Remote " ++ n ++ " does not have git-annex installed; setting " ++ k
+ inRepo $ Git.Command.run "config" [Param k, Param "true"]
+ return r
+ _ -> return r
| Git.repoIsHttp r = do
headers <- getHttpHeaders
store $ safely $ geturlconfig headers
@@ -140,18 +154,21 @@ tryGitConfigRead r
safely a = either (const $ return r) return
=<< liftIO (try a :: IO (Either SomeException Git.Repo))
- pipedconfig cmd params = safely $
+ pipedconfig cmd params =
withHandle StdoutHandle createProcessSuccess p $
Git.Config.hRead r
where
p = proc cmd $ toCommand params
+ pipedsshconfig cmd params =
+ liftIO (try (pipedconfig cmd params) :: IO (Either SomeException Git.Repo))
+
geturlconfig headers = do
s <- Url.get (Git.repoLocation r ++ "/config") headers
withTempFile "git-annex.tmp" $ \tmpfile h -> do
hPutStr h s
hClose h
- pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
+ safely $ pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
store = observe $ \r' -> do
g <- gitRepo