diff options
-rw-r--r-- | BuildFlags.hs | 3 | ||||
-rw-r--r-- | Command/AddUrl.hs | 34 | ||||
-rw-r--r-- | Remote/Web.hs | 35 | ||||
-rw-r--r-- | debian/changelog | 1 | ||||
-rw-r--r-- | doc/bugs/Feature_request:___34__quvi__34___flag.mdwn | 1 | ||||
-rw-r--r-- | git-annex.cabal | 11 |
6 files changed, 67 insertions, 18 deletions
diff --git a/BuildFlags.hs b/BuildFlags.hs index 384590c57..e1e5c1b88 100644 --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -51,4 +51,7 @@ buildFlags = filter (not . null) #ifdef WITH_FEED , "Feeds" #endif +#ifdef WITH_QUVI + , "Quvi" +#endif ] diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 0309a6a59..21cb83f7e 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Command.AddUrl where import Network.URI @@ -27,8 +29,10 @@ import Annex.Content.Direct import Logs.Location import qualified Logs.Transfer as Transfer import Utility.Daemon (checkDaemon) +#ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi +#endif def :: [Command] def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ @@ -56,18 +60,25 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s (s', downloader) = getDownloader s bad = fromMaybe (error $ "bad url " ++ s') $ parseURI $ escapeURIString isUnescapedInURI s' - badquvi = error $ "quvi does not know how to download url " ++ s' choosefile = flip fromMaybe optfile go url = case downloader of QuviDownloader -> usequvi - DefaultDownloader -> ifM (liftIO $ Quvi.supported s') - ( usequvi - , do - pathmax <- liftIO $ fileNameLengthLimit "." - let file = choosefile $ url2file url pathdepth pathmax - showStart "addurl" file - next $ perform relaxed s' file - ) + DefaultDownloader -> +#ifdef WITH_QIVI + ifM (liftIO $ Quvi.supported s') + ( usequvi + , regulardownload url + ) +#else + regulardownload url +#endif + regulardownload url = do + pathmax <- liftIO $ fileNameLengthLimit "." + let file = choosefile $ url2file url pathdepth pathmax + showStart "addurl" file + next $ perform relaxed s' file +#ifdef WITH_QUVI + badquvi = error $ "quvi does not know how to download url " ++ s' usequvi = do page <- fromMaybe badquvi <$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] s' @@ -76,7 +87,11 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link showStart "addurl" file next $ performQuvi relaxed s' (Quvi.linkUrl link) file +#else + usequvi = error "not built with quvi support" +#endif +#ifdef WITH_QUVI performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl where @@ -96,6 +111,7 @@ performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl then next $ cleanup quviurl file key (Just tmp) else stop ) +#endif perform :: Bool -> URLString -> FilePath -> CommandPerform perform relaxed url file = ifAnnexed file addurl geturl diff --git a/Remote/Web.hs b/Remote/Web.hs index 42ae032e9..5b8df2994 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 @@ -18,8 +20,10 @@ import Logs.Web import Types.Key import Utility.Metered import qualified Utility.Url as Url +#ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi +#endif import qualified Data.Map as M @@ -72,8 +76,14 @@ downloadKey key _file dest _p = get =<< getUrls key untilTrue urls $ \u -> do let (u', downloader) = getDownloader u case downloader of - QuviDownloader -> flip downloadUrl dest - =<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u' + 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 @@ -94,14 +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 + 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 -> - withQuviOptions Quvi.check [Quvi.httponly, Quvi.quiet] u' +#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 - liftIO $ Url.check u' headers (keySize key) + liftIO $ Right <$> Url.check 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 diff --git a/debian/changelog b/debian/changelog index 6a5150eb8..2e537c6dd 100644 --- a/debian/changelog +++ b/debian/changelog @@ -32,6 +32,7 @@ git-annex (4.20130828) UNRELEASED; urgency=low Works around chromium behavior where ajax connections to urls that were already accessed are denied after navigating back to a previous page. + * Allow building without quvi support. -- Joey Hess <joeyh@debian.org> Tue, 27 Aug 2013 11:03:00 -0400 diff --git a/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn b/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn index b710b6cf4..950aad0fc 100644 --- a/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn +++ b/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn @@ -11,3 +11,4 @@ See above. ### What version of git-annex are you using? On what operating system? I'm running Raspbian Wheezy on a Raspberry Pi. The git-annex version to be built is 4.20130827. +> [[done]] --[[Joey]] diff --git a/git-annex.cabal b/git-annex.cabal index 9aca6db7b..915f9aabe 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -68,6 +68,9 @@ Flag TDFA Flag Feed Description: Enable podcast feed support +Flag Quvi + Description: Enable use of quvi to download videos + Executable git-annex Main-Is: git-annex.hs Build-Depends: MissingH, hslogger, directory, filepath, @@ -76,7 +79,7 @@ Executable git-annex extensible-exceptions, dataenc, SHA, process, json, base (>= 4.5 && < 4.8), monad-control, MonadCatchIO-transformers, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, - SafeSemaphore, uuid, random, dlist, unix-compat, aeson + SafeSemaphore, uuid, random, dlist, unix-compat -- Need to list these because they're generated from .hsc files. Other-Modules: Utility.Touch Utility.Mounts Include-Dirs: Utility @@ -142,7 +145,7 @@ Executable git-annex yesod, yesod-default, yesod-static, yesod-form, yesod-core, case-insensitive, http-types, transformers, wai, wai-logger, warp, blaze-builder, crypto-api, hamlet, clientsession, - template-haskell, data-default + template-haskell, data-default, aeson CPP-Options: -DWITH_WEBAPP if flag(Pairing) @@ -160,6 +163,10 @@ Executable git-annex if flag(Feed) Build-Depends: feed CPP-Options: -DWITH_FEED + + if flag(Quvi) + Build-Depends: aeson + CPP-Options: -DWITH_QUVI source-repository head type: git |