diff options
| -rw-r--r-- | Remote/Git.hs | 40 | ||||
| -rw-r--r-- | Utility/Url.hs | 34 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/bugs/__34__fatal:_bad_config_file__34__.mdwn | 2 |
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]] |