diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/AddUrl.hs | 139 | ||||
| -rw-r--r-- | Command/ImportFeed.hs | 53 |
2 files changed, 110 insertions, 82 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 76095d6e4..5e6ebff3c 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -25,6 +25,7 @@ import Annex.Content import Logs.Web import Types.Key import Types.KeySource +import Types.UrlContents import Config import Annex.Content.Direct import Logs.Location @@ -50,75 +51,70 @@ relaxedOption :: Option relaxedOption = flagOption [] "relaxed" "skip size check" seek :: CommandSeek -seek ps = do - f <- getOptionField fileOption return +seek us = do + optfile <- getOptionField fileOption return relaxed <- getOptionFlag relaxedOption - d <- getOptionField pathdepthOption (return . maybe Nothing readish) - withStrings (start relaxed f d) ps - -start :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart -start relaxed optfile pathdepth s = do - r <- Remote.claimingUrl s - if Remote.uuid r == webUUID - then startWeb relaxed optfile pathdepth s - else startRemote r relaxed optfile pathdepth s + pathdepth <- getOptionField pathdepthOption (return . maybe Nothing readish) + forM_ us $ \u -> do + r <- Remote.claimingUrl u + if Remote.uuid r == webUUID + then void $ commandAction $ startWeb relaxed optfile pathdepth u + else do + pathmax <- liftIO $ fileNameLengthLimit "." + let deffile = fromMaybe (urlString2file u pathdepth pathmax) optfile + res <- tryNonAsync $ maybe + (error $ "unable to checkUrl of " ++ Remote.name r) + (flip id u) + (Remote.checkUrl r) + case res of + Left e -> void $ commandAction $ do + showStart "addurl" u + warning (show e) + next $ next $ return False + Right (UrlContents sz mf) -> do + void $ commandAction $ + startRemote r relaxed (fromMaybe deffile mf) u sz + Right (UrlMulti l) -> + forM_ l $ \(u', sz, f) -> + void $ commandAction $ + startRemote r relaxed (deffile </> f) u' sz -startRemote :: Remote -> Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart -startRemote r relaxed optfile pathdepth s = do - url <- case Url.parseURIRelaxed s of - Nothing -> error $ "bad uri " ++ s - Just u -> pure u - pathmax <- liftIO $ fileNameLengthLimit "." - let file = choosefile $ url2file url pathdepth pathmax +startRemote :: Remote -> Bool -> FilePath -> URLString -> Maybe Integer -> CommandStart +startRemote r relaxed file uri sz = do showStart "addurl" file showNote $ "using " ++ Remote.name r - next $ performRemote r relaxed s file - where - choosefile = flip fromMaybe optfile + next $ performRemote r relaxed uri file sz -performRemote :: Remote -> Bool -> URLString -> FilePath -> CommandPerform -performRemote r relaxed uri file = ifAnnexed file adduri geturi +performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform +performRemote r relaxed uri file sz = ifAnnexed file adduri geturi where loguri = setDownloader uri OtherDownloader adduri = addUrlChecked relaxed loguri (Remote.uuid r) checkexistssize - checkexistssize key = do - res <- tryNonAsync $ Remote.checkUrl r uri - case res of - Left e -> do - warning (show e) - return (False, False) - Right Nothing -> - return (True, True) - Right (Just sz) -> - return (True, sz == fromMaybe sz (keySize key)) - geturi = do - dummykey <- Backend.URL.fromUrl uri =<< - if relaxed - then return Nothing - else Remote.checkUrl r uri - liftIO $ createDirectoryIfMissing True (parentDir file) - next $ ifM (Annex.getState Annex.fast <||> pure relaxed) - ( do - res <- tryNonAsync $ Remote.checkUrl r uri - case res of - Left e -> do - warning (show e) - return False - Right size -> do - key <- Backend.URL.fromUrl uri size - cleanup (Remote.uuid r) loguri file key Nothing - return True - , do - -- Set temporary url for the dummy key - -- so that the remote knows what url it - -- should use to download it. - setTempUrl dummykey uri - let downloader = Remote.retrieveKeyFile r dummykey (Just file) - ok <- isJust <$> - downloadWith downloader dummykey (Remote.uuid r) loguri file - removeTempUrl dummykey - return ok - ) + checkexistssize key = return $ case sz of + Nothing -> (True, True) + Just n -> (True, n == fromMaybe n (keySize key)) + geturi = next $ isJust <$> downloadRemoteFile r relaxed uri file sz + +downloadRemoteFile :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key) +downloadRemoteFile r relaxed uri file sz = do + urlkey <- Backend.URL.fromUrl uri sz + liftIO $ createDirectoryIfMissing True (parentDir file) + ifM (Annex.getState Annex.fast <||> pure relaxed) + ( do + cleanup (Remote.uuid r) loguri file urlkey Nothing + return (Just urlkey) + , do + -- Set temporary url for the urlkey + -- so that the remote knows what url it + -- should use to download it. + setTempUrl urlkey uri + let downloader = Remote.retrieveKeyFile r urlkey (Just file) + 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 relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s @@ -158,6 +154,13 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s usequvi = error "not built with quvi support" #endif +performWeb :: Bool -> URLString -> FilePath -> CommandPerform +performWeb relaxed url file = ifAnnexed file addurl geturl + where + geturl = next $ isJust <$> addUrlFile relaxed url file + addurl = addUrlChecked relaxed url webUUID checkexistssize + checkexistssize = Url.withUrlOptions . Url.check url . keySize + #ifdef WITH_QUVI performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl @@ -199,20 +202,13 @@ addUrlFileQuvi relaxed quviurl videourl file = do ) #endif -performWeb :: Bool -> URLString -> FilePath -> CommandPerform -performWeb relaxed url file = ifAnnexed file addurl geturl - where - geturl = next $ isJust <$> addUrlFile relaxed url file - addurl = addUrlChecked relaxed url webUUID checkexistssize - checkexistssize = Url.withUrlOptions . Url.check url . keySize - addUrlChecked :: Bool -> URLString -> UUID -> (Key -> Annex (Bool, Bool)) -> Key -> CommandPerform addUrlChecked relaxed url u checkexistssize key | relaxed = do setUrlPresent u key url next $ return True | otherwise = ifM (elem url <$> getUrls key) - ( stop + ( next $ return True -- nothing to do , do (exists, samesize) <- checkexistssize key if exists && samesize @@ -327,3 +323,8 @@ url2file url pathdepth pathmax = case pathdepth of frombits a = intercalate "/" $ a urlbits urlbits = map (truncateFilePath pathmax . sanitizeFilePath) $ filter (not . null) $ split "/" fullurl + +urlString2file :: URLString -> Maybe Int -> Int -> FilePath +urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of + Nothing -> error $ "bad uri " ++ s + Just u -> url2file u pathdepth pathmax diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index ecfee1db8..a34052110 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -22,10 +22,13 @@ import Common.Annex import qualified Annex import Command import qualified Annex.Url as Url +import qualified Remote +import qualified Types.Remote as Remote +import Types.UrlContents import Logs.Web import qualified Utility.Format import Utility.Tmp -import Command.AddUrl (addUrlFile, relaxedOption) +import Command.AddUrl (addUrlFile, downloadRemoteFile, relaxedOption) import Annex.Perms import Backend.URL (fromUrl) #ifdef WITH_QUVI @@ -137,9 +140,29 @@ downloadFeed url = do performDownload :: Bool -> Cache -> ToDownload -> Annex Bool performDownload relaxed cache todownload = case location todownload of Enclosure url -> checkknown url $ - rundownload url (takeExtension url) $ - addUrlFile relaxed url + rundownload url (takeExtension url) $ \f -> do + 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 +#ifdef WITH_QUVI let quviurl = setDownloader pageurl QuviDownloader checkknown quviurl $ do mp <- withQuviOptions Quvi.query [Quvi.quiet, Quvi.httponly] pageurl @@ -150,8 +173,11 @@ performDownload relaxed cache todownload = case location todownload of Just link -> do let videourl = Quvi.linkUrl link checkknown videourl $ - rundownload videourl ("." ++ Quvi.linkSuffix link) $ - addUrlFileQuvi relaxed quviurl videourl + rundownload videourl ("." ++ Quvi.linkSuffix link) $ \f -> + maybeToList <$> addUrlFileQuvi relaxed quviurl videourl f +#else + return False +#endif where forced = Annex.getState Annex.force @@ -168,16 +194,17 @@ performDownload relaxed cache todownload = case location todownload of Nothing -> return True Just f -> do showStart "addurl" f - mk <- getter f - case mk of - Just key -> do - whenM (annexGenMetaData <$> Annex.getGitConfig) $ - addMetaData key $ extractMetaData todownload - showEndOk - return True - Nothing -> do + ks <- getter f + if null ks + then do showEndFail 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. - If the file exists, prefixes it with a number. |