mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

avoid trying youtube-dl for ftp and file url schemes

Browse source 
This commit was sponsored by John Peloquin on Patreon.
This commit is contained in:
Joey Hess 2017-12-11 12:46:34 -04:00
parent f750f261af
commit cc6f5d6e49
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 44 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

63
Annex/YoutubeDl.hs
View file

@ -5,7 +5,13 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Annex.YoutubeDl where module Annex.YoutubeDl (
youtubeDl,
youtubeDlTo,
youtubeDlSupported,
youtubeDlCheck,
youtubeDlFileName,
) where
import Annex.Common import Annex.Common
import qualified Annex import qualified Annex
@ -16,6 +22,8 @@ import Utility.DiskFree
import Utility.HtmlDetect import Utility.HtmlDetect
import Logs.Transfer import Logs.Transfer
import Network.URI
-- Runs youtube-dl in a work directory, to download a single media file -- 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. -- from the url. Reutrns the path to the media file in the work directory.
-- --
@ -30,18 +38,20 @@ import Logs.Transfer
-- (Note that we can't use --output to specifiy the file to download to, -- (Note that we can't use --output to specifiy the file to download to,
-- due to <https://github.com/rg3/youtube-dl/issues/14864>) -- due to <https://github.com/rg3/youtube-dl/issues/14864>)
youtubeDl :: URLString -> FilePath -> Annex (Either String (Maybe FilePath)) youtubeDl :: URLString -> FilePath -> Annex (Either String (Maybe FilePath))
youtubeDl url workdir = ifM (liftIO $ inPath "youtube-dl") youtubeDl url workdir
( runcmd >>= \case | supportedScheme url = ifM (liftIO $ inPath "youtube-dl")
Right True -> workdirfiles >>= \case ( runcmd >>= \case
(f:[]) -> return (Right (Just f)) Right True -> workdirfiles >>= \case
[] -> return nofiles (f:[]) -> return (Right (Just f))
fs -> return (toomanyfiles fs) [] -> return nofiles
Right False -> workdirfiles >>= \case fs -> return (toomanyfiles fs)
[] -> return (Right Nothing) Right False -> workdirfiles >>= \case
_ -> return (Left "youtube-dl download is incomplete. Run the command again to resume.") [] -> return (Right Nothing)
Left msg -> return (Left msg) _ -> return (Left "youtube-dl download is incomplete. Run the command again to resume.")
, return (Right Nothing) Left msg -> return (Left msg)
) , return (Right Nothing)
)
| otherwise = return (Right Nothing)
where where
nofiles = Left "youtube-dl did not put any media in its work directory, perhaps it's been configured to store files somewhere else?" 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 toomanyfiles fs = Left $ "youtube-dl downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs
@ -122,16 +132,22 @@ youtubeDlSupported url = either (const False) id <$> youtubeDlCheck url
-- Check if youtube-dl can find media in an url. -- Check if youtube-dl can find media in an url.
youtubeDlCheck :: URLString -> Annex (Either String Bool) youtubeDlCheck :: URLString -> Annex (Either String Bool)
youtubeDlCheck url = catchMsgIO $ htmlOnly url False $ do youtubeDlCheck url
opts <- youtubeDlOpts [ Param url, Param "--simulate" ] | supportedScheme url = catchMsgIO $ htmlOnly url False $ do
liftIO $ snd <$> processTranscript "youtube-dl" (toCommand opts) Nothing opts <- youtubeDlOpts [ Param url, Param "--simulate" ]
liftIO $ snd <$> processTranscript "youtube-dl" (toCommand opts) Nothing
| otherwise = return (Right False)
-- Ask youtube-dl for the filename of media in an url. -- Ask youtube-dl for the filename of media in an url.
-- --
-- (This is not always identical to the filename it uses when downloading.) -- (This is not always identical to the filename it uses when downloading.)
youtubeDlFileName :: URLString -> Annex (Either String FilePath) youtubeDlFileName :: URLString -> Annex (Either String FilePath)
youtubeDlFileName url = flip catchIO (pure . Left . show) $ youtubeDlFileName url
htmlOnly url nomedia $ do | supportedScheme url = flip catchIO (pure . Left . show) $
htmlOnly url nomedia go
| otherwise = return nomedia
where
go = do
-- Sometimes youtube-dl will fail with an ugly backtrace -- Sometimes youtube-dl will fail with an ugly backtrace
-- (eg, http://bugs.debian.org/874321) -- (eg, http://bugs.debian.org/874321)
-- so catch stderr as well as stdout to avoid the user -- so catch stderr as well as stdout to avoid the user
@ -147,10 +163,19 @@ youtubeDlFileName url = flip catchIO (pure . Left . show) $
return $ case (ok, lines output) of return $ case (ok, lines output) of
(True, (f:_)) | not (null f) -> Right f (True, (f:_)) | not (null f) -> Right f
_ -> nomedia _ -> nomedia
where
nomedia = Left "no media in url" nomedia = Left "no media in url"
youtubeDlOpts :: [CommandParam] -> Annex [CommandParam] youtubeDlOpts :: [CommandParam] -> Annex [CommandParam]
youtubeDlOpts addopts = do youtubeDlOpts addopts = do
opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig opts <- map Param . annexYoutubeDlOptions <$> Annex.getGitConfig
return (opts ++ addopts) return (opts ++ addopts)
supportedScheme :: URLString -> Bool
supportedScheme url = case uriScheme <$> parseURIRelaxed url of
Nothing -> False
-- avoid ugly message from youtube-dl about not supporting file:
Just "file:" -> False
-- ftp indexes may look like html pages, and there's no point
-- involving youtube-dl in a ftp download
Just "ftp:" -> False
Just _ -> True