Allow building without quvi support.

This commit is contained in:
Joey Hess 2013-09-09 02:16:22 -04:00
parent b5678d74a2
commit ecbb326e9d
6 changed files with 67 additions and 18 deletions

View file

@ -50,5 +50,8 @@ buildFlags = filter (not . null)
#endif #endif
#ifdef WITH_FEED #ifdef WITH_FEED
, "Feeds" , "Feeds"
#endif
#ifdef WITH_QUVI
, "Quvi"
#endif #endif
] ]

View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Command.AddUrl where module Command.AddUrl where
import Network.URI import Network.URI
@ -27,8 +29,10 @@ import Annex.Content.Direct
import Logs.Location import Logs.Location
import qualified Logs.Transfer as Transfer import qualified Logs.Transfer as Transfer
import Utility.Daemon (checkDaemon) import Utility.Daemon (checkDaemon)
#ifdef WITH_QUVI
import Annex.Quvi import Annex.Quvi
import qualified Utility.Quvi as Quvi import qualified Utility.Quvi as Quvi
#endif
def :: [Command] def :: [Command]
def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $
@ -56,18 +60,25 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s
(s', downloader) = getDownloader s (s', downloader) = getDownloader s
bad = fromMaybe (error $ "bad url " ++ s') $ bad = fromMaybe (error $ "bad url " ++ s') $
parseURI $ escapeURIString isUnescapedInURI s' parseURI $ escapeURIString isUnescapedInURI s'
badquvi = error $ "quvi does not know how to download url " ++ s'
choosefile = flip fromMaybe optfile choosefile = flip fromMaybe optfile
go url = case downloader of go url = case downloader of
QuviDownloader -> usequvi QuviDownloader -> usequvi
DefaultDownloader -> ifM (liftIO $ Quvi.supported s') DefaultDownloader ->
( usequvi #ifdef WITH_QIVI
, do ifM (liftIO $ Quvi.supported s')
pathmax <- liftIO $ fileNameLengthLimit "." ( usequvi
let file = choosefile $ url2file url pathdepth pathmax , regulardownload url
showStart "addurl" file )
next $ perform relaxed s' file #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 usequvi = do
page <- fromMaybe badquvi page <- fromMaybe badquvi
<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] s' <$> 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 Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link
showStart "addurl" file showStart "addurl" file
next $ performQuvi relaxed s' (Quvi.linkUrl link) 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 :: Bool -> URLString -> URLString -> FilePath -> CommandPerform
performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
where where
@ -96,6 +111,7 @@ performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
then next $ cleanup quviurl file key (Just tmp) then next $ cleanup quviurl file key (Just tmp)
else stop else stop
) )
#endif
perform :: Bool -> URLString -> FilePath -> CommandPerform perform :: Bool -> URLString -> FilePath -> CommandPerform
perform relaxed url file = ifAnnexed file addurl geturl perform relaxed url file = ifAnnexed file addurl geturl

View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Remote.Web (remote) where module Remote.Web (remote) where
import Common.Annex import Common.Annex
@ -18,8 +20,10 @@ import Logs.Web
import Types.Key import Types.Key
import Utility.Metered import Utility.Metered
import qualified Utility.Url as Url import qualified Utility.Url as Url
#ifdef WITH_QUVI
import Annex.Quvi import Annex.Quvi
import qualified Utility.Quvi as Quvi import qualified Utility.Quvi as Quvi
#endif
import qualified Data.Map as M import qualified Data.Map as M
@ -72,8 +76,14 @@ downloadKey key _file dest _p = get =<< getUrls key
untilTrue urls $ \u -> do untilTrue urls $ \u -> do
let (u', downloader) = getDownloader u let (u', downloader) = getDownloader u
case downloader of case downloader of
QuviDownloader -> flip downloadUrl dest QuviDownloader -> do
=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u' #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 DefaultDownloader -> downloadUrl [u'] dest
downloadKeyCheap :: Key -> FilePath -> Annex Bool downloadKeyCheap :: Key -> FilePath -> Annex Bool
@ -94,14 +104,25 @@ checkKey key = do
us <- getUrls key us <- getUrls key
if null us if null us
then return $ Right False then return $ Right False
else return . Right =<< checkKey' key us else return =<< checkKey' key us
checkKey' :: Key -> [URLString] -> Annex Bool checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
checkKey' key us = untilTrue us $ \u -> do checkKey' key us = firsthit us (Right False) $ \u -> do
let (u', downloader) = getDownloader u let (u', downloader) = getDownloader u
showAction $ "checking " ++ u' showAction $ "checking " ++ u'
case downloader of case downloader of
QuviDownloader -> 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 DefaultDownloader -> do
headers <- getHttpHeaders 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

1
debian/changelog vendored
View file

@ -32,6 +32,7 @@ git-annex (4.20130828) UNRELEASED; urgency=low
Works around chromium behavior where ajax connections to urls Works around chromium behavior where ajax connections to urls
that were already accessed are denied after navigating back to that were already accessed are denied after navigating back to
a previous page. a previous page.
* Allow building without quvi support.
-- Joey Hess <joeyh@debian.org> Tue, 27 Aug 2013 11:03:00 -0400 -- Joey Hess <joeyh@debian.org> Tue, 27 Aug 2013 11:03:00 -0400

View file

@ -11,3 +11,4 @@ See above.
### What version of git-annex are you using? On what operating system? ### 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. I'm running Raspbian Wheezy on a Raspberry Pi. The git-annex version to be built is 4.20130827.
> [[done]] --[[Joey]]

View file

@ -68,6 +68,9 @@ Flag TDFA
Flag Feed Flag Feed
Description: Enable podcast feed support Description: Enable podcast feed support
Flag Quvi
Description: Enable use of quvi to download videos
Executable git-annex Executable git-annex
Main-Is: git-annex.hs Main-Is: git-annex.hs
Build-Depends: MissingH, hslogger, directory, filepath, Build-Depends: MissingH, hslogger, directory, filepath,
@ -76,7 +79,7 @@ Executable git-annex
extensible-exceptions, dataenc, SHA, process, json, extensible-exceptions, dataenc, SHA, process, json,
base (>= 4.5 && < 4.8), monad-control, MonadCatchIO-transformers, base (>= 4.5 && < 4.8), monad-control, MonadCatchIO-transformers,
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process, 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. -- Need to list these because they're generated from .hsc files.
Other-Modules: Utility.Touch Utility.Mounts Other-Modules: Utility.Touch Utility.Mounts
Include-Dirs: Utility Include-Dirs: Utility
@ -142,7 +145,7 @@ Executable git-annex
yesod, yesod-default, yesod-static, yesod-form, yesod-core, yesod, yesod-default, yesod-static, yesod-form, yesod-core,
case-insensitive, http-types, transformers, wai, wai-logger, warp, case-insensitive, http-types, transformers, wai, wai-logger, warp,
blaze-builder, crypto-api, hamlet, clientsession, blaze-builder, crypto-api, hamlet, clientsession,
template-haskell, data-default template-haskell, data-default, aeson
CPP-Options: -DWITH_WEBAPP CPP-Options: -DWITH_WEBAPP
if flag(Pairing) if flag(Pairing)
@ -161,6 +164,10 @@ Executable git-annex
Build-Depends: feed Build-Depends: feed
CPP-Options: -DWITH_FEED CPP-Options: -DWITH_FEED
if flag(Quvi)
Build-Depends: aeson
CPP-Options: -DWITH_QUVI
source-repository head source-repository head
type: git type: git
location: git://git-annex.branchable.com/ location: git://git-annex.branchable.com/