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
|
{- youtube-dl integration for git-annex
-
- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.YoutubeDl where
import Annex.Common
import qualified Annex
import Annex.Content
import Utility.Url (URLString)
-- Runs youtube-dl in a work directory, to download a single media file
-- from the url. Reutrns the path to the media file in the work directory.
--
-- If youtube-dl fails without writing any files to the work directory,
-- or is not installed, returns Right Nothing.
--
-- The work directory can contain files from a previous run of youtube-dl
-- and it will resume. It should not contain any other files though,
-- and youtube-dl needs to finish up with only one file in the directory
-- so we know which one it downloaded.
--
-- (Note that we can't use --output to specifiy the file to download to,
-- due to <https://github.com/rg3/youtube-dl/issues/14864>)
youtubeDl :: URLString -> FilePath -> Annex (Either String (Maybe FilePath))
youtubeDl url workdir = ifM (liftIO (inPath "youtube-dl") <&&> runcmd)
( do
fs <- liftIO $ filterM (doesFileExist) =<< dirContents workdir
case fs of
(f:[]) -> return (Right (Just f))
[] -> return nofiles
_ -> return (toomanyfiles fs)
, do
fs <- liftIO $ filterM (doesFileExist) =<< dirContents workdir
if null fs
then return (Right Nothing)
else return (Left "youtube-dl download is incomplete. Run the command again to resume.")
)
where
nofiles = Left "youtube-dl did not put any media in its work directory, perhaps it's been configured to store files somewhere else?"
toomanyfiles fs = Left $ "youtube-dl downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs
runcmd = do
opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig
quiet <- commandProgressDisabled
let opts' = opts ++
[ Param url
-- To make youtube-dl only download one file,
-- when given a page with a video and a playlist,
-- download only the video.
, Param "--no-playlist"
-- And when given a page with only a playlist,
-- download only the first video on the playlist.
-- (Assumes the video is somewhat stable, but
-- this is the only way to prevent youtube-dl
-- from downloading the whole playlist.)
, Param "--playlist-items", Param "0"
-- TODO --max-filesize
] ++
if quiet then [ Param "--quiet" ] else []
liftIO $ boolSystem' "youtube-dl" opts' $
\p -> p { cwd = Just workdir }
-- Download a media file to a destination,
youtubeDlTo :: Key -> URLString -> FilePath -> Annex Bool
youtubeDlTo key url dest = do
res <- withTmpWorkDir key $ \workdir -> do
dl <- youtubeDl url workdir
case dl of
Right (Just mediafile) -> do
liftIO $ renameFile mediafile dest
return (Right True)
Right Nothing -> return (Right False)
Left msg -> return (Left msg)
case res of
Left msg -> do
warning msg
return False
Right r -> return r
youtubeDlSupported :: URLString -> Annex Bool
youtubeDlSupported url = either (const False) id <$> youtubeDlCheck url
-- Check if youtube-dl can still find media in an url.
youtubeDlCheck :: URLString -> Annex (Either String Bool)
youtubeDlCheck url = catchMsgIO $ do
opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig
let opts' = opts ++ [ Param url, Param "--simulate" ]
liftIO $ snd <$> processTranscript "youtube-dl" (toCommand opts') Nothing
|
