importfeed: Support for downloading urls claimed by remotes

2 files changed, 63 insertions, 36 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index ebfd86065..5e6ebff3c 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -73,17 +73,17 @@ seek us = do
 						next $ next $ return False
 					Right (UrlContents sz mf) -> do
 						void $ commandAction $
-							startRemote r relaxed (fromMaybe deffile mf) pathdepth u sz
+							startRemote r relaxed (fromMaybe deffile mf) u sz
 					Right (UrlMulti l) ->
 						forM_ l $ \(u', sz, f) ->
 							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 r relaxed file pathdepth s sz = do
+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 sz
+	next $ performRemote r relaxed uri file sz
 
 performRemote :: Remote -> Bool -> URLString -> FilePath -> Maybe Integer -> CommandPerform
 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
 		Nothing -> (True, True)
 		Just n -> (True, n == fromMaybe n (keySize key))
-	geturi = do
-		urlkey <- Backend.URL.fromUrl uri sz
-		liftIO $ createDirectoryIfMissing True (parentDir file)
-		next $ ifM (Annex.getState Annex.fast <||> pure relaxed)
-			( do
-				cleanup (Remote.uuid r) loguri file urlkey Nothing
-				return True
-			, 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)
-				ok <- isJust <$>
-					downloadWith downloader urlkey (Remote.uuid r) loguri file
-				removeTempUrl urlkey
-				return ok
-			)
+	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
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index f51149163..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,8 +140,27 @@ 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
@@ -151,8 +173,8 @@ 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
@@ -172,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.