diff options
author | Joey Hess <joey@kitenet.net> | 2013-11-14 17:04:58 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-11-14 17:04:58 -0400 |
commit | 521ef9dfebd6a9418a5dce7d1686dbf353ddd0a0 (patch) | |
tree | afe6bb5d52e21a049f04020ae448afb81adc02a7 /Remote/Web.hs | |
parent | f4b4f327b69189d24663a7db6407c1f7a6e48fdd (diff) | |
parent | 5c6f6e4d0abb9b4856908a500611044b3b7a48e6 (diff) |
Merge branch 'master' into tasty-tests
Conflicts:
Test.hs
Diffstat (limited to 'Remote/Web.hs')
-rw-r--r-- | Remote/Web.hs | 61 |
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 |