Allow building without quvi support.
This commit is contained in:
		
					parent
					
						
							
								b5678d74a2
							
						
					
				
			
			
				commit
				
					
						ecbb326e9d
					
				
			
		
					 6 changed files with 67 additions and 18 deletions
				
			
		| 
						 | 
				
			
			@ -50,5 +50,8 @@ buildFlags = filter (not . null)
 | 
			
		|||
#endif
 | 
			
		||||
#ifdef WITH_FEED
 | 
			
		||||
	, "Feeds"
 | 
			
		||||
#endif
 | 
			
		||||
#ifdef WITH_QUVI
 | 
			
		||||
	, "Quvi"
 | 
			
		||||
#endif
 | 
			
		||||
	]
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
									
									
								
							
							
						
						
									
										1
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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]]
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue