Merge branch 'master' into tasty-tests

Conflicts:
	Test.hs

1 files changed, 47 insertions, 14 deletions

diff --git a/Remote/Web.hs b/Remote/Web.hs
index 2c59528ef..0a8df35d5 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Remote.Web (remote) where
 
 import Common.Annex
@@ -15,11 +17,13 @@ import Annex.Content
 import Config
 import Config.Cost
 import Logs.Web
-import qualified Utility.Url as Url
 import Types.Key
 import Utility.Metered
-
-import qualified Data.Map as M
+import qualified Annex.Url as Url
+#ifdef WITH_QUVI
+import Annex.Quvi
+import qualified Utility.Quvi as Quvi
+#endif
 
 remote :: RemoteType
 remote = RemoteType {
@@ -37,9 +41,9 @@ list = do
 	r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
 	return [r]
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r _ _ gc = 
-	return Remote {
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
+gen r _ c gc = 
+	return $ Just Remote {
 		uuid = webUUID,
 		cost = expensiveRemoteCost,
 		name = Git.repoDescribe r,
@@ -50,7 +54,9 @@ gen r _ _ gc =
 		hasKey = checkKey,
 		hasKeyCheap = False,
 		whereisKey = Just getUrls,
-		config = M.empty,
+		remoteFsck = Nothing,
+		repairRepo = Nothing,
+		config = c,
 		gitconfig = gc,
 		localpath = Nothing,
 		repo = r,
@@ -67,7 +73,18 @@ downloadKey key _file dest _p = get =<< getUrls key
 		return False
 	get urls = do
 		showOutput -- make way for download progress bar
-		downloadUrl urls dest
+		untilTrue urls $ \u -> do
+			let (u', downloader) = getDownloader u
+			case downloader of
+				QuviDownloader -> do
+#ifdef WITH_QUVI
+					flip downloadUrl dest
+						=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u'
+#else
+					warning "quvi support needed for this url"
+					return False
+#endif
+				DefaultDownloader -> downloadUrl [u'] dest
 
 downloadKeyCheap :: Key -> FilePath -> Annex Bool
 downloadKeyCheap _ _ = return False
@@ -87,9 +104,25 @@ checkKey key = do
 	us <- getUrls key
 	if null us
 		then return $ Right False
-		else return . Right =<< checkKey' key us
-checkKey' :: Key -> [URLString] -> Annex Bool
-checkKey' key us = untilTrue us $ \u -> do
-	showAction $ "checking " ++ u
-	headers <- getHttpHeaders
-	liftIO $ Url.check u headers (keySize key)
+		else return =<< checkKey' key us
+checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
+checkKey' key us = firsthit us (Right False) $ \u -> do
+	let (u', downloader) = getDownloader u
+	showAction $ "checking " ++ u'
+	case downloader of
+		QuviDownloader ->
+#ifdef WITH_QUVI
+			Right <$> withQuviOptions Quvi.check [Quvi.httponly, Quvi.quiet] u'
+#else
+			return $ Left "quvi support needed for this url"
+#endif
+		DefaultDownloader -> do
+			headers <- getHttpHeaders
+			Right <$> Url.withUserAgent (Url.checkBoth u' headers $ keySize key)
+  where
+  	firsthit [] miss _ = return miss
+	firsthit (u:rest) _ a = do
+		r <- a u
+		case r of
+			Right _ -> return r
+			Left _ -> firsthit rest r a