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
#ifdef WITH_FEED
, "Feeds"
#endif
#ifdef WITH_QUVI
, "Quvi"
#endif
]

View file

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

View file

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

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

View file

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

View file

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