diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/AddUrl.hs | 53 | ||||
| -rw-r--r-- | Command/ImportFeed.hs | 83 |
2 files changed, 65 insertions, 71 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 977bd8001..06a960b0e 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -165,7 +165,7 @@ downloadRemoteFile r relaxed uri file sz = checkCanAdd file $ do liftIO $ createDirectoryIfMissing True (parentDir file) ifM (Annex.getState Annex.fast <||> pure relaxed) ( do - cleanup (Remote.uuid r) loguri file urlkey Nothing + addWorkTree (Remote.uuid r) loguri file urlkey Nothing return (Just urlkey) , do -- Set temporary url for the urlkey @@ -214,46 +214,6 @@ performWeb o url file urlinfo = ifAnnexed file addurl geturl addurl = addUrlChecked (relaxedOption o) url webUUID $ \k -> return $ (Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k) -performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform -performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl - where - quviurl = setDownloader pageurl QuviDownloader - addurl key = next $ do - cleanup webUUID quviurl file key Nothing - return True - geturl = next $ isJust <$> addUrlFileQuvi relaxed quviurl videourl file - -addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex (Maybe Key) -addUrlFileQuvi relaxed quviurl videourl file = checkCanAdd file $ do - let key = Backend.URL.fromUrl quviurl Nothing - ifM (pure relaxed <||> Annex.getState Annex.fast) - ( do - cleanup webUUID quviurl file key Nothing - return (Just key) - , do - {- Get the size, and use that to check - - disk space. However, the size info is not - - retained, because the size of a video stream - - might change and we want to be able to download - - it later. -} - urlinfo <- Url.withUrlOptions (Url.getUrlInfo videourl) - let sizedkey = addSizeUrlKey urlinfo key - checkDiskSpaceToGet sizedkey Nothing $ do - tmp <- fromRepo $ gitAnnexTmpObjectLocation key - showOutput - ok <- Transfer.notifyTransfer Transfer.Download afile $ - Transfer.download webUUID key afile Transfer.forwardRetry $ \p -> do - liftIO $ createDirectoryIfMissing True (parentDir tmp) - downloadUrl key p [videourl] tmp - if ok - then do - cleanup webUUID quviurl file key (Just tmp) - return (Just key) - else return Nothing - ) - where - afile = AssociatedFile (Just file) - addUrlChecked :: Bool -> URLString -> UUID -> (Key -> Annex (Bool, Bool)) -> Key -> CommandPerform addUrlChecked relaxed url u checkexistssize key | relaxed = do @@ -321,7 +281,7 @@ downloadWeb url urlinfo file = pruneTmpWorkDirBefore tmp (liftIO . nukeFile) let dest = takeFileName mediafile showDestinationFile dest - cleanup webUUID mediaurl dest mediakey (Just mediafile) + addWorkTree webUUID mediaurl dest mediakey (Just mediafile) return $ Right $ Just mediakey Right Nothing -> Right <$> normalfinish tmp Left msg -> return $ Left msg @@ -379,15 +339,16 @@ finishDownloadWith tmp u url file = do case k of Nothing -> return Nothing Just (key, _) -> do - cleanup u url file key (Just tmp) + addWorkTree u url file key (Just tmp) return (Just key) {- Adds the url size to the Key. -} addSizeUrlKey :: Url.UrlInfo -> Key -> Key addSizeUrlKey urlinfo key = key { keySize = Url.urlSize urlinfo } -cleanup :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex () -cleanup u url file key mtmp = case mtmp of +{- Adds worktree file to the repository. -} +addWorkTree :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex () +addWorkTree u url file key mtmp = case mtmp of Nothing -> go Just tmp -> do -- Move to final location for large file check. @@ -418,7 +379,7 @@ nodownload :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) nodownload url urlinfo file | Url.urlExists urlinfo = do let key = Backend.URL.fromUrl url (Url.urlSize urlinfo) - cleanup webUUID url file key Nothing + addWorkTree webUUID url file key Nothing return (Just key) | otherwise = do warning $ "unable to access url: " ++ url diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 0a8122b25..57daa22f8 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -36,12 +36,12 @@ import Command.AddUrl (addUrlFile, downloadRemoteFile, parseRelaxedOption, parse import Annex.Perms import Annex.UUID import Backend.URL (fromUrl) -import Annex.Quvi -import qualified Utility.Quvi as Quvi -import Command.AddUrl (addUrlFileQuvi) +import Annex.Content +import Annex.YoutubeDl import Types.MetaData import Logs.MetaData import Annex.MetaData +import Command.AddUrl (addWorkTree) cmd :: Command cmd = notBareRepo $ @@ -101,7 +101,7 @@ data ToDownload = ToDownload , location :: DownloadLocation } -data DownloadLocation = Enclosure URLString | QuviLink URLString +data DownloadLocation = Enclosure URLString | MediaLink URLString type ItemId = String @@ -141,14 +141,10 @@ findDownloads u = go =<< downloadFeed u Just (enclosureurl, _, _) -> return $ Just $ ToDownload f u i $ Enclosure $ fromFeed enclosureurl - Nothing -> mkquvi f i - mkquvi f i = case getItemLink i of - Just link -> ifM (quviSupported $ fromFeed link) - ( return $ Just $ ToDownload f u i $ QuviLink $ - fromFeed link - , return Nothing - ) - Nothing -> return Nothing + Nothing -> case getItemLink i of + Just link -> return $ Just $ ToDownload f u i $ + MediaLink $ fromFeed link + Nothing -> return Nothing {- Feeds change, so a feed download cannot be resumed. -} downloadFeed :: URLString -> Annex (Maybe Feed) @@ -192,19 +188,18 @@ performDownload opts cache todownload = case location todownload of then catMaybes kl else [] - QuviLink pageurl -> do - let quviurl = setDownloader pageurl QuviDownloader - checkknown quviurl $ do - mp <- withQuviOptions Quvi.query [Quvi.quiet, Quvi.httponly] pageurl - case mp of - Nothing -> return False - Just page -> case headMaybe $ Quvi.pageLinks page of - Nothing -> return False - Just link -> do - let videourl = Quvi.linkUrl link - checkknown videourl $ - rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f -> - maybeToList <$> addUrlFileQuvi (relaxedOption opts) quviurl videourl f + MediaLink linkurl -> do + let mediaurl = setDownloader linkurl YoutubeDownloader + let mediakey = Backend.URL.fromUrl mediaurl Nothing + -- Old versions of git-annex that used quvi might have + -- used the quviurl for this, so check i/f it's known + -- to avoid adding it a second time. + let quviurl = setDownloader linkurl QuviDownloader + checkknown mediaurl $ checkknown quviurl $ + ifM (Annex.getState Annex.fast <||> pure (relaxedOption opts)) + ( addmediafast linkurl mediaurl mediakey + , downloadmedia linkurl mediaurl mediakey + ) where forced = Annex.getState Annex.force @@ -265,6 +260,44 @@ performDownload opts cache todownload = case location todownload of ( return Nothing , tryanother ) + + downloadmedia linkurl mediaurl mediakey = do + r <- withTmpWorkDir mediakey $ \workdir -> do + dl <- youtubeDl linkurl workdir + case dl of + Right (Just mediafile) -> do + let ext = case takeExtension mediafile of + [] -> ".m" + s -> s + ok <- rundownload linkurl ext $ \f -> do + addWorkTree webUUID mediaurl f mediakey (Just mediafile) + return [mediakey] + return (Right ok) + -- youtude-dl didn't support it, so + -- download it as if the link were + -- an enclosure. + Right Nothing -> Right <$> + performDownload opts cache todownload + { location = Enclosure linkurl } + Left msg -> return (Left msg) + case r of + Left msg -> do + warning msg + return False + Right b -> return b + + addmediafast linkurl mediaurl mediakey = + youtubeDlSupported linkurl >>= \case + Right True -> + rundownload linkurl ".m" $ \f -> do + addWorkTree webUUID mediaurl f mediakey Nothing + return [mediakey] + Right False -> + performDownload opts cache todownload + { location = Enclosure linkurl } + Left msg -> do + warning msg + return False defaultTemplate :: String defaultTemplate = "${feedtitle}/${itemtitle}${extension}" |