importfeed: Support for downloading urls claimed by remotes

This commit is contained in:
Joey Hess 2014-12-11 16:43:46 -04:00
parent a40bd29c23
commit f41ce65ef4
2 changed files with 63 additions and 36 deletions

View file

@ -73,17 +73,17 @@ seek us = do
next $ next $ return False next $ next $ return False
Right (UrlContents sz mf) -> do Right (UrlContents sz mf) -> do
void $ commandAction $ void $ commandAction $
startRemote r relaxed (fromMaybe deffile mf) pathdepth u sz startRemote r relaxed (fromMaybe deffile mf) u sz
Right (UrlMulti l) -> Right (UrlMulti l) ->
forM_ l $ \(u', sz, f) -> forM_ l $ \(u', sz, f) ->
void $ commandAction $ void $ commandAction $
startRemote r relaxed (deffile </> f) pathdepth u' sz startRemote r relaxed (deffile </> f) u' sz
startRemote :: Remote -> Bool -> FilePath -> Maybe Int -> String -> Maybe Integer -> CommandStart startRemote :: Remote -> Bool -> FilePath -> URLString -> Maybe Integer -> CommandStart
startRemote r relaxed file pathdepth s sz = do startRemote r relaxed file uri sz = do
showStart "addurl" file showStart "addurl" file
showNote $ "using " ++ Remote.name r showNote $ "using " ++ Remote.name r
next $ performRemote r relaxed s file sz next $ performRemote r relaxed uri file sz
performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform
performRemote r relaxed uri file sz = ifAnnexed file adduri geturi performRemote r relaxed uri file sz = ifAnnexed file adduri geturi
@ -93,24 +93,28 @@ performRemote r relaxed uri file sz = ifAnnexed file adduri geturi
checkexistssize key = return $ case sz of checkexistssize key = return $ case sz of
Nothing -> (True, True) Nothing -> (True, True)
Just n -> (True, n == fromMaybe n (keySize key)) Just n -> (True, n == fromMaybe n (keySize key))
geturi = do geturi = next $ isJust <$> downloadRemoteFile r relaxed uri file sz
urlkey <- Backend.URL.fromUrl uri sz
liftIO $ createDirectoryIfMissing True (parentDir file) downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
next $ ifM (Annex.getState Annex.fast <||> pure relaxed) downloadRemoteFile r relaxed uri file sz = do
( do urlkey <- Backend.URL.fromUrl uri sz
cleanup (Remote.uuid r) loguri file urlkey Nothing liftIO $ createDirectoryIfMissing True (parentDir file)
return True ifM (Annex.getState Annex.fast <||> pure relaxed)
, do ( do
-- Set temporary url for the urlkey cleanup (Remote.uuid r) loguri file urlkey Nothing
-- so that the remote knows what url it return (Just urlkey)
-- should use to download it. , do
setTempUrl urlkey uri -- Set temporary url for the urlkey
let downloader = Remote.retrieveKeyFile r urlkey (Just file) -- so that the remote knows what url it
ok <- isJust <$> -- should use to download it.
downloadWith downloader urlkey (Remote.uuid r) loguri file setTempUrl urlkey uri
removeTempUrl urlkey let downloader = Remote.retrieveKeyFile r urlkey (Just file)
return ok ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file
) removeTempUrl urlkey
return ret
)
where
loguri = setDownloader uri OtherDownloader
startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart
startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s

View file

@ -22,10 +22,13 @@ import Common.Annex
import qualified Annex import qualified Annex
import Command import Command
import qualified Annex.Url as Url import qualified Annex.Url as Url
import qualified Remote
import qualified Types.Remote as Remote
import Types.UrlContents
import Logs.Web import Logs.Web
import qualified Utility.Format import qualified Utility.Format
import Utility.Tmp import Utility.Tmp
import Command.AddUrl (addUrlFile, relaxedOption) import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption)
import Annex.Perms import Annex.Perms
import Backend.URL (fromUrl) import Backend.URL (fromUrl)
#ifdef WITH_QUVI #ifdef WITH_QUVI
@ -137,8 +140,27 @@ downloadFeed url = do
performDownload :: Bool -> Cache -> ToDownload -> Annex Bool performDownload :: Bool -> Cache -> ToDownload -> Annex Bool
performDownload relaxed cache todownload = case location todownload of performDownload relaxed cache todownload = case location todownload of
Enclosure url -> checkknown url $ Enclosure url -> checkknown url $
rundownload url (takeExtension url) $ rundownload url (takeExtension url) $ \f -> do
addUrlFile relaxed url r <- Remote.claimingUrl url
if Remote.uuid r == webUUID
then maybeToList <$> addUrlFile relaxed url f
else do
res <- tryNonAsync $ maybe
(error $ "unable to checkUrl of " ++ Remote.name r)
(flip id url)
(Remote.checkUrl r)
case res of
Left _ -> return []
Right (UrlContents sz _) ->
maybeToList <$>
downloadRemoteFile r relaxed url f sz
Right (UrlMulti l) -> do
kl <- forM l $ \(url', sz, subf) ->
downloadRemoteFile r relaxed url' (f </> subf) sz
return $ if all isJust kl
then catMaybes kl
else []
QuviLink pageurl -> do QuviLink pageurl -> do
#ifdef WITH_QUVI #ifdef WITH_QUVI
let quviurl = setDownloader pageurl QuviDownloader let quviurl = setDownloader pageurl QuviDownloader
@ -151,8 +173,8 @@ performDownload relaxed cache todownload = case location todownload of
Just link -> do Just link -> do
let videourl = Quvi.linkUrl link let videourl = Quvi.linkUrl link
checkknown videourl $ checkknown videourl $
rundownload videourl ("." ++ Quvi.linkSuffix link) $ rundownload videourl ("." ++ Quvi.linkSuffix link) $ \f ->
addUrlFileQuvi relaxed quviurl videourl maybeToList <$> addUrlFileQuvi relaxed quviurl videourl f
#else #else
return False return False
#endif #endif
@ -172,16 +194,17 @@ performDownload relaxed cache todownload = case location todownload of
Nothing -> return True Nothing -> return True
Just f -> do Just f -> do
showStart "addurl" f showStart "addurl" f
mk <- getter f ks <- getter f
case mk of if null ks
Just key -> do then do
whenM (annexGenMetaData <$> Annex.getGitConfig) $
addMetaData key $ extractMetaData todownload
showEndOk
return True
Nothing -> do
showEndFail showEndFail
checkFeedBroken (feedurl todownload) checkFeedBroken (feedurl todownload)
else do
forM_ ks $ \key ->
whenM (annexGenMetaData <$> Annex.getGitConfig) $
addMetaData key $ extractMetaData todownload
showEndOk
return True
{- Find a unique filename to save the url to. {- Find a unique filename to save the url to.
- If the file exists, prefixes it with a number. - If the file exists, prefixes it with a number.