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

OsPath conversion of Annex.YouTubeDl

Browse source 
The change of R.doesPathExist to doesFileExist I think fixes a reversion
introduced in commit 1ceece3108. Before
that commit, it was doesFileExist, and I assume to point is that this is
only supposed to return files, not any subdirectories that yt-dlp might
create while running.
This commit is contained in:
Joey Hess 2025-02-05 11:56:26 -04:00
parent 85fa337f61
commit 7805cd89ad
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 27 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

52
Annex/YoutubeDl.hs
View file

@ -5,6 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
module Annex.YoutubeDl ( module Annex.YoutubeDl (
@ -30,7 +31,6 @@ import Utility.Metered
import Utility.Tmp import Utility.Tmp
import Messages.Progress import Messages.Progress
import Logs.Transfer import Logs.Transfer
import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F import qualified Utility.FileIO as F
import Network.URI import Network.URI
@ -72,20 +72,21 @@ youtubeDlNotAllowedMessage = unwords
-- (This can fail, but youtube-dl is deprecated, and they closed my -- (This can fail, but youtube-dl is deprecated, and they closed my
-- issue requesting something like --print-to-file; -- issue requesting something like --print-to-file;
-- <https://github.com/rg3/youtube-dl/issues/14864>) -- <https://github.com/rg3/youtube-dl/issues/14864>)
youtubeDl :: URLString -> FilePath -> MeterUpdate -> Annex (Either String (Maybe FilePath)) youtubeDl :: URLString -> OsPath -> MeterUpdate -> Annex (Either String (Maybe OsPath))
youtubeDl url workdir p = ifM ipAddressesUnlimited youtubeDl url workdir p = ifM ipAddressesUnlimited
( withUrlOptions $ youtubeDl' url workdir p ( withUrlOptions $ youtubeDl' url workdir p
, return $ Left youtubeDlNotAllowedMessage , return $ Left youtubeDlNotAllowedMessage
) )
youtubeDl' :: URLString -> FilePath -> MeterUpdate -> UrlOptions -> Annex (Either String (Maybe FilePath)) youtubeDl' :: URLString -> OsPath -> MeterUpdate -> UrlOptions -> Annex (Either String (Maybe OsPath))
youtubeDl' url workdir p uo youtubeDl' url workdir p uo
| supportedScheme uo url = do | supportedScheme uo url = do
cmd <- youtubeDlCommand cmd <- youtubeDlCommand
ifM (liftIO $ inSearchPath cmd) ifM (liftIO $ inSearchPath cmd)
( runcmd cmd >>= \case ( runcmd cmd >>= \case
Right True -> downloadedfiles cmd >>= \case Right True -> downloadedfiles cmd >>= \case
(f:[]) -> return (Right (Just f)) (f:[]) -> return $
Right (Just (toOsPath f))
[] -> return (nofiles cmd) [] -> return (nofiles cmd)
fs -> return (toomanyfiles cmd fs) fs -> return (toomanyfiles cmd fs)
Right False -> workdirfiles >>= \case Right False -> workdirfiles >>= \case
@ -100,13 +101,13 @@ youtubeDl' url workdir p uo
toomanyfiles cmd fs = Left $ cmd ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs toomanyfiles cmd fs = Left $ cmd ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs
downloadedfiles cmd downloadedfiles cmd
| isytdlp cmd = liftIO $ | isytdlp cmd = liftIO $
(nub . lines <$> readFile filelistfile) (nub . lines <$> readFile (fromOsPath filelistfile))
`catchIO` (pure . const []) `catchIO` (pure . const [])
| otherwise = map fromRawFilePath <$> workdirfiles | otherwise = map fromOsPath <$> workdirfiles
workdirfiles = liftIO $ filter (/= toRawFilePath filelistfile) workdirfiles = liftIO $ filter (/= filelistfile)
<$> (filterM R.doesPathExist =<< dirContents (toRawFilePath workdir)) <$> (filterM doesFileExist =<< dirContents workdir)
filelistfile = workdir </> filelistfilebase filelistfile = workdir </> filelistfilebase
filelistfilebase = "git-annex-file-list-file" filelistfilebase = literalOsPath "git-annex-file-list-file"
isytdlp cmd = cmd == "yt-dlp" isytdlp cmd = cmd == "yt-dlp"
runcmd cmd = youtubeDlMaxSize workdir >>= \case runcmd cmd = youtubeDlMaxSize workdir >>= \case
Left msg -> return (Left msg) Left msg -> return (Left msg)
@ -122,7 +123,7 @@ youtubeDl' url workdir p uo
liftIO $ commandMeter' liftIO $ commandMeter'
(if isytdlp cmd then parseYtdlpProgress else parseYoutubeDlProgress) (if isytdlp cmd then parseYtdlpProgress else parseYoutubeDlProgress)
oh (Just meter) meterupdate cmd opts oh (Just meter) meterupdate cmd opts
(\pr -> pr { cwd = Just workdir }) (\pr -> pr { cwd = Just (fromOsPath workdir) })
return (Right ok) return (Right ok)
dlopts cmd = dlopts cmd =
[ Param url [ Param url
@ -145,7 +146,7 @@ youtubeDl' url workdir p uo
, Param progressTemplate , Param progressTemplate
, Param "--print-to-file" , Param "--print-to-file"
, Param "after_move:filepath" , Param "after_move:filepath"
, Param filelistfilebase , Param (fromOsPath filelistfilebase)
] ]
else [] else []
@ -153,14 +154,14 @@ youtubeDl' url workdir p uo
-- large a media file. Factors in other downloads that are in progress, -- large a media file. Factors in other downloads that are in progress,
-- and any files in the workdir that it may have partially downloaded -- and any files in the workdir that it may have partially downloaded
-- before. -- before.
youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam]) youtubeDlMaxSize :: OsPath -> Annex (Either String [CommandParam])
youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force) youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force)
( return $ Right [] ( return $ Right []
, liftIO (getDiskFree workdir) >>= \case , liftIO (getDiskFree (fromOsPath workdir)) >>= \case
Just have -> do Just have -> do
inprogress <- sizeOfDownloadsInProgress (const True) inprogress <- sizeOfDownloadsInProgress (const True)
partial <- liftIO $ sum partial <- liftIO $ sum
<$> (mapM getFileSize =<< dirContents (toRawFilePath workdir)) <$> (mapM getFileSize =<< dirContents workdir)
reserve <- annexDiskReserve <$> Annex.getGitConfig reserve <- annexDiskReserve <$> Annex.getGitConfig
let maxsize = have - reserve - inprogress + partial let maxsize = have - reserve - inprogress + partial
if maxsize > 0 if maxsize > 0
@ -175,12 +176,12 @@ youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force)
) )
-- Download a media file to a destination, -- Download a media file to a destination,
youtubeDlTo :: Key -> URLString -> FilePath -> MeterUpdate -> Annex Bool youtubeDlTo :: Key -> URLString -> OsPath -> MeterUpdate -> Annex Bool
youtubeDlTo key url dest p = do youtubeDlTo key url dest p = do
res <- withTmpWorkDir key $ \workdir -> res <- withTmpWorkDir key $ \workdir ->
youtubeDl url (fromRawFilePath workdir) p >>= \case youtubeDl url workdir p >>= \case
Right (Just mediafile) -> do Right (Just mediafile) -> do
liftIO $ moveFile (toRawFilePath mediafile) (toRawFilePath dest) liftIO $ moveFile mediafile dest
return (Just True) return (Just True)
Right Nothing -> return (Just False) Right Nothing -> return (Just False)
Left msg -> do Left msg -> do
@ -225,7 +226,7 @@ youtubeDlCheck' url uo
-- 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 OsPath)
youtubeDlFileName url = withUrlOptions go youtubeDlFileName url = withUrlOptions go
where where
go uo go uo
@ -236,10 +237,10 @@ youtubeDlFileName url = withUrlOptions go
-- Does not check if the url contains htmlOnly; use when that's already -- Does not check if the url contains htmlOnly; use when that's already
-- been verified. -- been verified.
youtubeDlFileNameHtmlOnly :: URLString -> Annex (Either String FilePath) youtubeDlFileNameHtmlOnly :: URLString -> Annex (Either String OsPath)
youtubeDlFileNameHtmlOnly = withUrlOptions . youtubeDlFileNameHtmlOnly' youtubeDlFileNameHtmlOnly = withUrlOptions . youtubeDlFileNameHtmlOnly'
youtubeDlFileNameHtmlOnly' :: URLString -> UrlOptions -> Annex (Either String FilePath) youtubeDlFileNameHtmlOnly' :: URLString -> UrlOptions -> Annex (Either String OsPath)
youtubeDlFileNameHtmlOnly' url uo youtubeDlFileNameHtmlOnly' url uo
| supportedScheme uo url = flip catchIO (pure . Left . show) go | supportedScheme uo url = flip catchIO (pure . Left . show) go
| otherwise = return nomedia | otherwise = return nomedia
@ -269,7 +270,7 @@ youtubeDlFileNameHtmlOnly' url uo
ok <- liftIO $ checkSuccessProcess pid ok <- liftIO $ checkSuccessProcess pid
wait errt wait errt
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 (toOsPath f)
_ -> nomedia _ -> nomedia
waitproc _ _ _ _ = error "internal" waitproc _ _ _ _ = error "internal"
@ -353,7 +354,7 @@ youtubePlaylist url = do
else return $ Left $ "Scraping needs yt-dlp, but git-annex has been configured to use " ++ cmd else return $ Left $ "Scraping needs yt-dlp, but git-annex has been configured to use " ++ cmd
youtubePlaylist' :: URLString -> String -> IO (Either String [YoutubePlaylistItem]) youtubePlaylist' :: URLString -> String -> IO (Either String [YoutubePlaylistItem])
youtubePlaylist' url cmd = withTmpFile (toOsPath (toRawFilePath "yt-dlp")) $ \tmpfile h -> do youtubePlaylist' url cmd = withTmpFile (literalOsPath "yt-dlp") $ \tmpfile h -> do
hClose h hClose h
(outerr, ok) <- processTranscript cmd (outerr, ok) <- processTranscript cmd
[ "--simulate" [ "--simulate"
@ -363,7 +364,7 @@ youtubePlaylist' url cmd = withTmpFile (toOsPath (toRawFilePath "yt-dlp")) $ \tm
, "--print-to-file" , "--print-to-file"
-- Write json with selected fields. -- Write json with selected fields.
, "%(.{" ++ intercalate "," youtubePlaylistItemFields ++ "})j" , "%(.{" ++ intercalate "," youtubePlaylistItemFields ++ "})j"
, fromRawFilePath (fromOsPath tmpfile) , fromOsPath tmpfile
, url , url
] ]
Nothing Nothing
@ -407,5 +408,6 @@ data YoutubePlaylistItem = YoutubePlaylistItem
instance Aeson.FromJSON YoutubePlaylistItem instance Aeson.FromJSON YoutubePlaylistItem
where where
parseJSON = Aeson.genericParseJSON Aeson.defaultOptions parseJSON = Aeson.genericParseJSON Aeson.defaultOptions
{ Aeson.fieldLabelModifier = drop (length "youtube_") } { Aeson.fieldLabelModifier =
drop (length ("youtube_" :: String))
}