1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
{- querying quvi (import qualified)
-
- Copyright 2013 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Utility.Quvi where
import Common
import Utility.Url
import Data.Aeson
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import Network.URI (uriAuthority, uriRegName)
import Data.Char
data QuviVersion
= Quvi04
| Quvi09
| NoQuvi
deriving (Show)
data Page = Page
{ pageTitle :: String
, pageLinks :: [Link]
} deriving (Show)
data Link = Link
{ linkSuffix :: Maybe String
, linkUrl :: URLString
} deriving (Show)
{- JSON instances for quvi 0.4. -}
instance FromJSON Page where
parseJSON (Object v) = Page
<$> v .: "page_title"
<*> v .: "link"
parseJSON _ = mzero
instance FromJSON Link where
parseJSON (Object v) = Link
<$> v .:? "file_suffix"
<*> v .: "url"
parseJSON _ = mzero
{- "enum" format used by quvi 0.9 -}
parseEnum :: String -> Maybe Page
parseEnum s = Page
<$> get "QUVI_MEDIA_PROPERTY_TITLE"
<*> ((:[]) <$>
( Link
<$> Just <$> (get "QUVI_MEDIA_STREAM_PROPERTY_CONTAINER")
<*> get "QUVI_MEDIA_STREAM_PROPERTY_URL"
)
)
where
get = flip M.lookup m
m = M.fromList $ map (separate (== '=')) $ lines s
probeVersion :: IO QuviVersion
probeVersion = catchDefaultIO NoQuvi $
examine <$> processTranscript "quvi" ["--version"] Nothing
where
examine (s, True)
| "quvi v0.4" `isInfixOf` s = Quvi04
| otherwise = Quvi09
examine _ = NoQuvi
type Query a = QuviVersion -> [CommandParam] -> URLString -> IO a
{- Throws an error when quvi is not installed. -}
forceQuery :: Query (Maybe Page)
forceQuery v ps url = query' v ps url `catchNonAsync` onerr
where
onerr e = ifM (inPath "quvi")
( error ("quvi failed: " ++ show e)
, error "quvi is not installed"
)
{- Returns Nothing if the page is not a video page, or quvi is not
- installed. -}
query :: Query (Maybe Page)
query v ps url = flip catchNonAsync (const $ return Nothing) (query' v ps url)
query' :: Query (Maybe Page)
query' Quvi09 ps url = parseEnum
<$> readQuvi (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])
query' Quvi04 ps url = do
let p = proc "quvi" (toCommand $ ps ++ [Param url])
decode . BL.fromStrict
<$> withHandle StdoutHandle createProcessSuccess p B.hGetContents
query' NoQuvi _ _ = return Nothing
queryLinks :: Query [URLString]
queryLinks v ps url = maybe [] (map linkUrl . pageLinks) <$> query v ps url
{- Checks if quvi can still find a download link for an url.
- If quvi is not installed, returns False. -}
check :: Query Bool
check v ps url = maybe False (not . null . pageLinks) <$> query v ps url
{- Checks if an url is supported by quvi, as quickly as possible
- (without hitting it if possible), and without outputting
- anything. Also returns False if quvi is not installed. -}
supported :: QuviVersion -> URLString -> IO Bool
supported NoQuvi _ = return False
supported Quvi04 url = boolSystem "quvi"
[ Param "--verbosity", Param "mute"
, Param "--support"
, Param url
]
{- Use quvi-info to see if the url's domain is supported.
- If so, have to do a online verification of the url. -}
supported Quvi09 url = (firstlevel <&&> secondlevel)
`catchNonAsync` (\_ -> return False)
where
firstlevel = case uriAuthority =<< parseURIRelaxed url of
Nothing -> return False
Just auth -> do
let domain = map toLower $ uriRegName auth
let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ split "." domain
any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h)
. map (map toLower) <$> listdomains Quvi09
secondlevel = snd <$> processTranscript "quvi"
(toCommand [Param "dump", Param "-o", Param url]) Nothing
listdomains :: QuviVersion -> IO [String]
listdomains Quvi09 = concatMap (split ",")
. concatMap (drop 1 . words)
. filter ("domains: " `isPrefixOf`) . lines
<$> readQuvi (toCommand [Param "info", Param "-p", Param "domains"])
listdomains _ = return []
type QuviParams = QuviVersion -> [CommandParam]
{- Disables progress, but not information output. -}
quiet :: QuviParams
-- Cannot use quiet as it now disables informational output.
-- No way to disable progress.
quiet Quvi09 = [Param "--verbosity", Param "verbose"]
quiet Quvi04 = [Param "--verbosity", Param "quiet"]
quiet NoQuvi = []
{- Only return http results, not streaming protocols. -}
httponly :: QuviParams
-- No way to do it with 0.9?
httponly Quvi04 = [Param "-c", Param "http"]
httponly _ = [] -- No way to do it with 0.9?
{- Both versions of quvi will output utf-8 encoded data even when
- the locale doesn't support it. -}
readQuvi :: [String] -> IO String
readQuvi ps = withHandle StdoutHandle createProcessSuccess p $ \h -> do
fileEncoding h
r <- hGetContentsStrict h
hClose h
return r
where
p = proc "quvi" ps
|
