Improve error handling when getting uuid of http remotes to auto-ignore, like with ssh remotes.

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