mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Automatically detect when a ssh remote does not have git-annex-shell installed, and set annex-ignore.

Browse source 
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.
This commit is contained in:
Joey Hess 2012-10-12 13:45:14 -04:00
parent 75dccc57ba
commit e290f1b903
2 changed files with 22 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
Remote/Git.hs
View file

@ -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

2
debian/changelog vendored
View file

@ -15,6 +15,8 @@ git-annex (3.20121010) UNRELEASED; urgency=low
a remote gets synced.
* Fix a crash when merging files in the git-annex branch that contain
invalid utf8.
* Automatically detect when a ssh remote does not have git-annex-shell
installed, and set annex-ignore.
-- Joey Hess <joeyh@debian.org> Wed, 10 Oct 2012 12:59:25 -0400