summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Remote/Git.hs40
-rw-r--r--Utility/Url.hs34
-rw-r--r--debian/changelog2
-rw-r--r--doc/bugs/__34__fatal:_bad_config_file__34__.mdwn2
4 files changed, 42 insertions, 36 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 32f6a1c7c..b508df958 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -141,7 +141,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r
| haveconfig r = return r -- already read
| Git.repoIsSsh r = store $ do
- v <- onRemote r (pipedsshconfig, Left undefined) "configlist" [] []
+ v <- onRemote r (pipedconfig, Left undefined) "configlist" [] []
case v of
Right r'
| haveconfig r' -> return r'
@@ -149,7 +149,7 @@ tryGitConfigRead r
Left _ -> configlist_failed
| Git.repoIsHttp r = do
headers <- getHttpHeaders
- store $ safely $ geturlconfig headers
+ store $ geturlconfig headers
| Git.repoIsUrl r = return r
| otherwise = store $ safely $ onLocal r $ do
ensureInitialized
@@ -162,8 +162,9 @@ tryGitConfigRead r
safely a = either (const $ return r) return
=<< liftIO (try a :: IO (Either SomeException Git.Repo))
- pipedconfig cmd params =
- withHandle StdoutHandle createProcessSuccess p $ \h -> do
+ 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
@@ -172,18 +173,20 @@ tryGitConfigRead r
warningIO $ "Instead, got: " ++ show val
warningIO $ "This is unexpected; please check the network transport!"
return 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
- withTmpFile "git-annex.tmp" $ \tmpfile h -> do
- hPutStr h s
+ v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do
hClose h
- safely $ pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
+ ifM (Url.downloadQuiet (Git.repoLocation r ++ "/config") headers [] tmpfile)
+ ( pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
+ , return $ Left undefined
+ )
+ case v of
+ Left _ -> do
+ set_ignore "not usable by git-annex"
+ return r
+ Right r' -> return r'
store = observe $ \r' -> do
g <- gitRepo
@@ -204,11 +207,16 @@ tryGitConfigRead r
configlist_failed = case Git.remoteName r of
Nothing -> return r
Just n -> do
- whenM (inRepo $ Git.Command.runBool [Param "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 [Param "config", Param k, Param "true"]
+ whenM (inRepo $ Git.Command.runBool [Param "fetch", Param "--quiet", Param n]) $
+ set_ignore $ "does not have git-annex installed"
return r
+
+ set_ignore msg = case Git.remoteName r of
+ Nothing -> noop
+ Just n -> do
+ let k = "remote." ++ n ++ ".annex-ignore"
+ warning $ "Remote " ++ n ++ " " ++ msg ++ "; setting " ++ k
+ inRepo $ Git.Command.run [Param "config", Param k, Param "true"]
{- Checks if a given remote has the content for a key inAnnex.
- If the remote cannot be accessed, or if it cannot determine
diff --git a/Utility/Url.hs b/Utility/Url.hs
index b831b3f01..e08266a76 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -12,7 +12,7 @@ module Utility.Url (
check,
exists,
download,
- get
+ downloadQuiet
) where
import Common
@@ -91,7 +91,14 @@ exists url headers = case parseURIRelaxed url of
- for only one in.
-}
download :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
-download url headers options file =
+download = download' False
+
+{- No output, even on error. -}
+downloadQuiet :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
+downloadQuiet = download' True
+
+download' :: Bool -> URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
+download' quiet url headers options file =
case parseURIRelaxed url of
Just u
| uriScheme u == "file:" -> do
@@ -103,31 +110,18 @@ download url headers options file =
_ -> return False
where
headerparams = map (\h -> Param $ "--header=" ++ h) headers
- wget = go "wget" $ headerparams ++ [Params "-c -O"]
+ wget = go "wget" $ headerparams ++ quietopt "-q" ++ [Params "-c -O"]
{- Uses the -# progress display, because the normal
- one is very confusing when resuming, showing
- the remainder to download as the whole file,
- and not indicating how much percent was
- downloaded before the resume. -}
- curl = go "curl" $ headerparams ++ [Params "-L -C - -# -o"]
+ curl = go "curl" $ headerparams ++ quietopt "-s" ++ [Params "-L -C - -# -o"]
go cmd opts = boolSystem cmd $
options++opts++[File file, File url]
-
-{- Downloads a small file.
- -
- - Uses curl if available since it handles HTTPS better than
- - the Haskell libraries do. -}
-get :: URLString -> Headers -> IO String
-get url headers = if Build.SysConfig.curl
- then readProcess "curl" $
- ["-s", "-L", url] ++ concatMap (\h -> ["-H", h]) headers
- else case parseURI url of
- Nothing -> error "url parse error"
- Just u -> do
- r <- request u headers GET
- case rspCode r of
- (2,_,_) -> return $ rspBody r
- _ -> error $ rspReason r
+ quietopt s
+ | quiet = [Param s]
+ | otherwise = []
{- Uses Network.Browser to make a http request of an url.
- For example, HEAD can be used to check if the url exists,
diff --git a/debian/changelog b/debian/changelog
index 95ef3c478..9d180fd34 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -13,6 +13,8 @@ git-annex (4.20130522) UNRELEASED; urgency=low
This fixes the behavior of the manual mode group.
* assistant: Work around git-cat-file's not reloading the index after files
are staged.
+ * Improve error handling when getting uuid of http remotes to auto-ignore,
+ like with ssh remotes.
-- Joey Hess <joeyh@debian.org> Tue, 21 May 2013 18:22:46 -0400
diff --git a/doc/bugs/__34__fatal:_bad_config_file__34__.mdwn b/doc/bugs/__34__fatal:_bad_config_file__34__.mdwn
index 4efaf3e21..baaa796db 100644
--- a/doc/bugs/__34__fatal:_bad_config_file__34__.mdwn
+++ b/doc/bugs/__34__fatal:_bad_config_file__34__.mdwn
@@ -10,3 +10,5 @@ is requesting `https://git.example.com/jim/annex.git/config`. My server returns
Forbidden and an error page for that URL, but git-annex tries to use the response as a config file anyway.
Jim
+
+> [[fixed|done]] --[[Joey]]