diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-11-29 15:49:05 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-11-29 16:40:32 -0400 |
commit | 3b3f7512f6d0b91de21f6fcc4aba8897174bc4a8 (patch) | |
tree | 44c85fda3d6a35d62b00cca26bf6acaf474133c2 /Annex/YoutubeDl.hs | |
parent | b7178922644c813a2cb69c185ca751aa234fa05b (diff) |
youtube-dl working
Including resuming and cleanup of incomplete downloads.
Still todo: --fast, --relaxed, importfeed, disk reserve checking,
quvi code cleanup.
This commit was sponsored by Anthony DeRobertis on Patreon.
Diffstat (limited to 'Annex/YoutubeDl.hs')
-rw-r--r-- | Annex/YoutubeDl.hs | 86 |
1 files changed, 86 insertions, 0 deletions
diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs new file mode 100644 index 000000000..e646f3fe8 --- /dev/null +++ b/Annex/YoutubeDl.hs @@ -0,0 +1,86 @@ +{- 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 + +-- Check if youtube-dl can still find media in an url. +youtubeDlSupported :: URLString -> Annex (Either String Bool) +youtubeDlSupported url = liftIO $ catchMsgIO $ + snd <$> processTranscript "youtube-dl" [ url, "--simulate" ] Nothing |