From e81fd720187f3a2d5badcd964c2374523519d4ba Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Apr 2025 10:17:38 -0400 Subject: [PATCH] Added remote.name.annex-web-options config Which is a per-remote version of the annex.web-options config. Had to plumb RemoteGitConfig through to getUrlOptions. In cases where a special remote does not use curl, there was no need to do that and I used Nothing instead. In the case of the addurl and importfeed commands, it seemed best to say that running these commands is not using the web special remote per se, so the config is not used for those commands. --- Annex/Url.hs | 21 +++++--- Annex/YoutubeDl.hs | 12 ++--- Assistant/Upgrade.hs | 2 +- Assistant/WebApp/Configurators/IA.hs | 2 +- CHANGELOG | 2 + CmdLine/GitRemoteAnnex.hs | 2 +- Command/AddUrl.hs | 5 +- Command/ImportFeed.hs | 4 +- P2P/Http/Client.hs | 2 +- Remote/BitTorrent.hs | 22 ++++----- Remote/External.hs | 16 +++--- Remote/Git.hs | 20 ++++---- Remote/GitLFS.hs | 10 ++-- Remote/HttpAlso.hs | 49 ++++++++++--------- Remote/S3.hs | 10 ++-- Remote/Web.hs | 24 ++++----- Types/GitConfig.hs | 5 ++ ..._e5a146811b2ba94eeae424feba52a851._comment | 37 ++++++++++++++ doc/git-annex.mdwn | 6 +-- 19 files changed, 152 insertions(+), 99 deletions(-) create mode 100644 doc/forum/Authentication_for_URL_downloads/comment_1_e5a146811b2ba94eeae424feba52a851._comment diff --git a/Annex/Url.hs b/Annex/Url.hs index 795b4b7b97..1cc742f522 100644 --- a/Annex/Url.hs +++ b/Annex/Url.hs @@ -56,8 +56,8 @@ getUserAgent :: Annex U.UserAgent getUserAgent = Annex.getRead $ fromMaybe defaultUserAgent . Annex.useragent -getUrlOptions :: Annex U.UrlOptions -getUrlOptions = Annex.getState Annex.urloptions >>= \case +getUrlOptions :: Maybe RemoteGitConfig -> Annex U.UrlOptions +getUrlOptions mgc = Annex.getState Annex.urloptions >>= \case Just uo -> return uo Nothing -> do uo <- mk @@ -81,10 +81,15 @@ getUrlOptions = Annex.getState Annex.urloptions >>= \case >>= \case Just output -> pure (lines output) Nothing -> annexHttpHeaders <$> Annex.getGitConfig + + getweboptions = case mgc of + Just gc | not (null (remoteAnnexWebOptions gc)) -> + pure (remoteAnnexWebOptions gc) + _ -> annexWebOptions <$> Annex.getGitConfig checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case ["all"] -> do - curlopts <- map Param . annexWebOptions <$> Annex.getGitConfig + curlopts <- map Param <$> getweboptions allowedurlschemes <- annexAllowedUrlSchemes <$> Annex.getGitConfig let urldownloader = if null curlopts && not (any (`S.notMember` U.conduitUrlSchemes) allowedurlschemes) then U.DownloadWithConduit $ @@ -148,8 +153,8 @@ ipAddressesUnlimited :: Annex Bool ipAddressesUnlimited = ("all" == ) . annexAllowedIPAddresses <$> Annex.getGitConfig -withUrlOptions :: (U.UrlOptions -> Annex a) -> Annex a -withUrlOptions a = a =<< getUrlOptions +withUrlOptions :: Maybe RemoteGitConfig -> (U.UrlOptions -> Annex a) -> Annex a +withUrlOptions mgc a = a =<< getUrlOptions mgc -- When downloading an url, if authentication is needed, uses -- git-credential to prompt for username and password. @@ -157,10 +162,10 @@ withUrlOptions a = a =<< getUrlOptions -- Note that, when the downloader is curl, it will not use git-credential. -- If the user wants to, they can configure curl to use a netrc file that -- handles authentication. -withUrlOptionsPromptingCreds :: (U.UrlOptions -> Annex a) -> Annex a -withUrlOptionsPromptingCreds a = do +withUrlOptionsPromptingCreds :: Maybe RemoteGitConfig -> (U.UrlOptions -> Annex a) -> Annex a +withUrlOptionsPromptingCreds mgc a = do g <- Annex.gitRepo - uo <- getUrlOptions + uo <- getUrlOptions mgc prompter <- mkPrompter cc <- Annex.getRead Annex.gitcredentialcache a $ uo diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs index 60245eec9d..722823b60b 100644 --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -74,7 +74,7 @@ youtubeDlNotAllowedMessage = unwords -- ) youtubeDl :: URLString -> OsPath -> MeterUpdate -> Annex (Either String (Maybe OsPath)) youtubeDl url workdir p = ifM ipAddressesUnlimited - ( withUrlOptions $ youtubeDl' url workdir p + ( withUrlOptions Nothing $ youtubeDl' url workdir p , return $ Left youtubeDlNotAllowedMessage ) @@ -194,7 +194,7 @@ youtubeDlTo key url dest p = do -- without it. So, this first downloads part of the content and checks -- if it's a html page; only then is youtube-dl used. htmlOnly :: URLString -> a -> Annex a -> Annex a -htmlOnly url fallback a = withUrlOptions $ \uo -> +htmlOnly url fallback a = withUrlOptions Nothing $ \uo -> liftIO (downloadPartial url uo htmlPrefixLength) >>= \case Just bs | isHtmlBs bs -> a _ -> return fallback @@ -202,7 +202,7 @@ htmlOnly url fallback a = withUrlOptions $ \uo -> -- Check if youtube-dl supports downloading content from an url. youtubeDlSupported :: URLString -> Annex Bool youtubeDlSupported url = either (const False) id - <$> withUrlOptions (youtubeDlCheck' url) + <$> withUrlOptions Nothing (youtubeDlCheck' url) -- Check if youtube-dl can find media in an url. -- @@ -211,7 +211,7 @@ youtubeDlSupported url = either (const False) id -- download won't succeed. youtubeDlCheck :: URLString -> Annex (Either String Bool) youtubeDlCheck url = ifM youtubeDlAllowed - ( withUrlOptions $ youtubeDlCheck' url + ( withUrlOptions Nothing $ youtubeDlCheck' url , return $ Left youtubeDlNotAllowedMessage ) @@ -227,7 +227,7 @@ youtubeDlCheck' url uo -- -- (This is not always identical to the filename it uses when downloading.) youtubeDlFileName :: URLString -> Annex (Either String OsPath) -youtubeDlFileName url = withUrlOptions go +youtubeDlFileName url = withUrlOptions Nothing go where go uo | supportedScheme uo url = flip catchIO (pure . Left . show) $ @@ -238,7 +238,7 @@ youtubeDlFileName url = withUrlOptions go -- Does not check if the url contains htmlOnly; use when that's already -- been verified. youtubeDlFileNameHtmlOnly :: URLString -> Annex (Either String OsPath) -youtubeDlFileNameHtmlOnly = withUrlOptions . youtubeDlFileNameHtmlOnly' +youtubeDlFileNameHtmlOnly = withUrlOptions Nothing . youtubeDlFileNameHtmlOnly' youtubeDlFileNameHtmlOnly' :: URLString -> UrlOptions -> Annex (Either String OsPath) youtubeDlFileNameHtmlOnly' url uo diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index 9f82e4fdc6..ca6d5b3ada 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -324,7 +324,7 @@ usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV" downloadDistributionInfo :: Assistant (Maybe GitAnnexDistribution) downloadDistributionInfo = do - uo <- liftAnnex Url.getUrlOptions + uo <- liftAnnex $ Url.getUrlOptions Nothing gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig liftIO $ withTmpDir (literalOsPath "git-annex.tmp") $ \tmpdir -> do let infof = tmpdir literalOsPath "info" diff --git a/Assistant/WebApp/Configurators/IA.hs b/Assistant/WebApp/Configurators/IA.hs index 1b2d05e6e2..3818ad7fbb 100644 --- a/Assistant/WebApp/Configurators/IA.hs +++ b/Assistant/WebApp/Configurators/IA.hs @@ -179,7 +179,7 @@ escapeHeader = escapeURIString (\c -> isUnescapedInURI c && c /= ' ') getRepoInfo :: RemoteConfig -> Widget getRepoInfo c = do - uo <- liftAnnex Url.getUrlOptions + uo <- liftAnnex $ Url.getUrlOptions Nothing urlexists <- liftAnnex $ catchDefaultIO False $ Url.exists url uo [whamlet| diff --git a/CHANGELOG b/CHANGELOG index b2ac6a0a44..44a0305bd3 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -7,6 +7,8 @@ git-annex (10.20250321) UNRELEASED; urgency=medium * fsck: Avoid complaining about required content of dead repositories. * drop: Avoid redundant object directory thawing. * httpalso: Windows url fix. + * Added remote.name.annex-web-options config, which is a per-remote + version of the annex.web-options config. -- Joey Hess Fri, 21 Mar 2025 12:27:11 -0400 diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs index beacd137a3..d83be209ce 100644 --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -496,7 +496,7 @@ parseSpecialRemoteUrl url remotename = case parseURI url of resolveSpecialRemoteWebUrl :: String -> Annex (Maybe String) resolveSpecialRemoteWebUrl url | "http://" `isPrefixOf` lcurl || "https://" `isPrefixOf` lcurl = - Url.withUrlOptionsPromptingCreds $ \uo -> + Url.withUrlOptionsPromptingCreds Nothing $ \uo -> withTmpFile (literalOsPath "git-remote-annex") $ \tmp h -> do liftIO $ hClose h Url.download' nullMeterUpdate Nothing url tmp uo >>= \case diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index d81628e6b8..ac825fc409 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -251,7 +251,7 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURIPortab go url = startingAddUrl si urlstring o $ if relaxedOption (downloadOptions o) then go' url Url.assumeUrlExists - else Url.withUrlOptions (Url.getUrlInfo urlstring) >>= \case + else Url.withUrlOptions Nothing (Url.getUrlInfo urlstring) >>= \case Right urlinfo -> go' url urlinfo Left err -> do warning (UnquotedString err) @@ -352,7 +352,8 @@ downloadWeb addunlockedmatcher o url urlinfo file = go =<< downloadWith' downloader urlkey webUUID url file where urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing (verifiableOption o) - downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f + downloader f p = Url.withUrlOptions Nothing $ + downloadUrl False urlkey p Nothing [url] f go Nothing = return Nothing go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile tmp)) ( tryyoutubedl tmp backend diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index df1537fb65..613c9dd0f8 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -268,7 +268,7 @@ findDownloads u f = catMaybes $ map mk (feedItems f) downloadFeed :: URLString -> FilePath -> Annex Bool downloadFeed url f | Url.parseURIRelaxed url == Nothing = giveup "invalid feed url" - | otherwise = Url.withUrlOptions $ + | otherwise = Url.withUrlOptions Nothing $ Url.download nullMeterUpdate Nothing url (toOsPath f) startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart @@ -367,7 +367,7 @@ downloadEnclosure addunlockedmatcher opts cache cv todownload url = let go urlinfo = Just . maybeToList <$> addUrlFile addunlockedmatcher dlopts url urlinfo f if relaxedOption (downloadOptions opts) then go Url.assumeUrlExists - else Url.withUrlOptions (Url.getUrlInfo url) >>= \case + else Url.withUrlOptions Nothing (Url.getUrlInfo url) >>= \case Right urlinfo -> go urlinfo Left err -> do warning (UnquotedString err) diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs index bfaa14bc89..e71e69f28c 100644 --- a/P2P/Http/Client.hs +++ b/P2P/Http/Client.hs @@ -100,7 +100,7 @@ p2pHttpClientVersions' allowedversion rmt rmtrepo fallback clientaction = case p2pHttpBaseUrl <$> remoteAnnexP2PHttpUrl (gitconfig rmt) of Nothing -> error "internal" Just baseurl -> do - mgr <- httpManager <$> getUrlOptions + mgr <- httpManager <$> getUrlOptions Nothing let clientenv = mkClientEnv mgr baseurl ccv <- Annex.getRead Annex.gitcredentialcache Git.CredentialCache cc <- liftIO $ atomically $ diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index 5b7a1d6c84..cf3f947c40 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -66,7 +66,7 @@ gen r _ rc gc rs = do , cost = cst , name = Git.repoDescribe r , storeKey = uploadKey - , retrieveKeyFile = downloadKey + , retrieveKeyFile = downloadKey gc -- Bittorrent downloads out of order, but downloadTorrentContent -- moves the downloaded file to the destination at the end. , retrieveKeyFileInOrder = pure True @@ -94,12 +94,12 @@ gen r _ rc gc rs = do , mkUnavailable = return Nothing , getInfo = return [] , claimUrl = Just (pure . isSupportedUrl) - , checkUrl = Just checkTorrentUrl + , checkUrl = Just (checkTorrentUrl gc) , remoteStateHandle = rs } -downloadKey :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification -downloadKey key _file dest p _ = do +downloadKey :: RemoteGitConfig -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification +downloadKey gc key _file dest p _ = do get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key -- While bittorrent verifies the hash in the torrent file, -- the torrent file itself is downloaded without verification, @@ -112,7 +112,7 @@ downloadKey key _file dest p _ = do ok <- untilTrue urls $ \(u, filenum) -> do registerTorrentCleanup u checkDependencies - ifM (downloadTorrentFile u) + ifM (downloadTorrentFile gc u) ( downloadTorrentContent key u dest filenum p , return False ) @@ -151,11 +151,11 @@ isTorrentMagnetUrl u = "magnet:" `isPrefixOf` u && checkbt (parseURIPortable u) checkbt (Just uri) | "xt=urn:btih:" `isInfixOf` uriQuery uri = True checkbt _ = False -checkTorrentUrl :: URLString -> Annex UrlContents -checkTorrentUrl u = do +checkTorrentUrl :: RemoteGitConfig -> URLString -> Annex UrlContents +checkTorrentUrl gc u = do checkDependencies registerTorrentCleanup u - ifM (downloadTorrentFile u) + ifM (downloadTorrentFile gc u) ( torrentContents u , giveup "could not download torrent file" ) @@ -192,8 +192,8 @@ registerTorrentCleanup u = Annex.addCleanupAction (TorrentCleanup u) $ liftIO . removeWhenExistsWith removeFile =<< tmpTorrentFile u {- Downloads the torrent file. (Not its contents.) -} -downloadTorrentFile :: URLString -> Annex Bool -downloadTorrentFile u = do +downloadTorrentFile :: RemoteGitConfig -> URLString -> Annex Bool +downloadTorrentFile gc u = do torrent <- tmpTorrentFile u ifM (liftIO $ doesFileExist torrent) ( return True @@ -213,7 +213,7 @@ downloadTorrentFile u = do withTmpFileIn othertmp (literalOsPath "torrent") $ \f h -> do liftIO $ hClose h resetAnnexFilePerm f - ok <- Url.withUrlOptions $ + ok <- Url.withUrlOptions (Just gc) $ Url.download nullMeterUpdate Nothing u f when ok $ liftIO $ moveFile f torrent diff --git a/Remote/External.hs b/Remote/External.hs index 251ca666fe..2b26e32239 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -77,9 +77,9 @@ gen rt externalprogram r u rc gc rs exportUnsupported return $ Just $ specialRemote c readonlyStorer - retrieveUrl + (retrieveUrl gc) readonlyRemoveKey - checkKeyUrl + (checkKeyUrl gc) rmt | otherwise = do c <- parsedRemoteConfig remote rc @@ -834,16 +834,16 @@ checkUrlM external url = where mkmulti (u, s, f) = (u, s, toOsPath f) -retrieveUrl :: Retriever -retrieveUrl = fileRetriever' $ \f k p iv -> do +retrieveUrl :: RemoteGitConfig -> Retriever +retrieveUrl gc = fileRetriever' $ \f k p iv -> do us <- getWebUrls k - unlessM (withUrlOptions $ downloadUrl True k p iv us f) $ + unlessM (withUrlOptions (Just gc) $ downloadUrl True k p iv us f) $ giveup "failed to download content" -checkKeyUrl :: CheckPresent -checkKeyUrl k = do +checkKeyUrl :: RemoteGitConfig -> CheckPresent +checkKeyUrl gc k = do us <- getWebUrls k - anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us + anyM (\u -> withUrlOptions (Just gc) $ checkBoth u (fromKey keySize k)) us getWebUrls :: Key -> Annex [URLString] getWebUrls key = filter supported <$> getUrls key diff --git a/Remote/Git.hs b/Remote/Git.hs index cda705cb0e..1f8a02e7da 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -142,11 +142,11 @@ isGitRemoteAnnex r = "annex::" `isPrefixOf` Git.repoLocation r - etc. -} gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -gitSetup Init mu _ c _ = do +gitSetup Init mu _ c gc = do let location = maybe (giveup "Specify location=url") fromProposedAccepted $ M.lookup locationField c r <- inRepo $ Git.Construct.fromRemoteLocation location False - r' <- tryGitConfigRead False r False + r' <- tryGitConfigRead gc False r False let u = getUncachedUUID r' if u == NoUUID then giveup "git repository does not have an annex uuid" @@ -187,10 +187,10 @@ configRead autoinit r = do case (repoCheap r, annexignore, hasuuid) of (_, True, _) -> return r (True, _, _) - | remoteAnnexCheckUUID gc -> tryGitConfigRead autoinit r hasuuid + | remoteAnnexCheckUUID gc -> tryGitConfigRead gc autoinit r hasuuid | otherwise -> return r (False, _, False) -> configSpecialGitRemotes r >>= \case - Nothing -> tryGitConfigRead autoinit r False + Nothing -> tryGitConfigRead gc autoinit r False Just r' -> return r' _ -> return r @@ -273,8 +273,8 @@ unavailable r u c gc = gen r' u c gc' {- Tries to read the config for a specified remote, updates state, and - returns the updated repo. -} -tryGitConfigRead :: Bool -> Git.Repo -> Bool -> Annex Git.Repo -tryGitConfigRead autoinit r hasuuid +tryGitConfigRead :: RemoteGitConfig -> Bool -> Git.Repo -> Bool -> Annex Git.Repo +tryGitConfigRead gc autoinit r hasuuid | haveconfig r = return r -- already read | Git.repoIsSsh r = storeUpdatedRemote $ do v <- Ssh.onRemote NoConsumeStdin r @@ -323,7 +323,7 @@ tryGitConfigRead autoinit r hasuuid warning $ UnquotedString $ "Unable to parse git config from " ++ configloc return $ Left exitcode - geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do + geturlconfig = Url.withUrlOptionsPromptingCreds (Just gc) $ \uo -> do let url = Git.repoLocation r ++ "/config" v <- withTmpFile (literalOsPath "git-annex.tmp") $ \tmpfile h -> do liftIO $ hClose h @@ -449,7 +449,7 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key checkp2phttp = p2pHttpClient rmt giveup (clientCheckPresent key) checkhttp = do gc <- Annex.getGitConfig - Url.withUrlOptionsPromptingCreds $ \uo -> + Url.withUrlOptionsPromptingCreds (Just (gitconfig rmt)) $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key) checkremote = P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt)) key @@ -570,7 +570,7 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc | isP2PHttp r = copyp2phttp | Git.repoIsHttp repo = verifyKeyContentIncrementally vc key $ \iv -> do gc <- Annex.getGitConfig - ok <- Url.withUrlOptionsPromptingCreds $ + ok <- Url.withUrlOptionsPromptingCreds (Just (gitconfig r)) $ Annex.Content.downloadUrl False key meterupdate iv (keyUrls gc repo r key) dest unless ok $ giveup "failed to download content" @@ -890,7 +890,7 @@ mkState r u gc = do rv <- liftIO newEmptyMVar let getrepo = ifM (liftIO $ isEmptyMVar rv) ( do - r' <- tryGitConfigRead False r True + r' <- tryGitConfigRead gc False r True let t = (r', extractGitConfig FromGitConfig r') void $ liftIO $ tryPutMVar rv t return t diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index d598ea5623..fde56b05ed 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -101,7 +101,7 @@ gen r u rc gc rs = do } return $ Just $ specialRemote' specialcfg c (store rs h) - (retrieve rs h) + (retrieve gc rs h) (remove h) (checkKey rs h) (this c cst h) @@ -367,7 +367,7 @@ getLFSEndpoint tro hv = do -- Not for use in downloading an object. makeSmallAPIRequest :: Request -> Annex (Response L.ByteString) makeSmallAPIRequest req = do - uo <- getUrlOptions + uo <- getUrlOptions Nothing let req' = applyRequest uo req fastDebug "Remote.GitLFS" (show req') resp <- liftIO $ httpLbs req' (httpManager uo) @@ -499,8 +499,8 @@ store rs h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \ca Just reqs -> forM_ reqs $ makeSmallAPIRequest . setRequestCheckStatus -retrieve :: RemoteStateHandle -> TVar LFSHandle -> Retriever -retrieve rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownload h >>= \case +retrieve :: RemoteGitConfig -> RemoteStateHandle -> TVar LFSHandle -> Retriever +retrieve gc rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownload h >>= \case Nothing -> giveup "unable to connect to git-lfs endpoint" Just endpoint -> mkDownloadRequest rs k >>= \case Nothing -> giveup "unable to download this object from git-lfs" @@ -520,7 +520,7 @@ retrieve rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownl Just op -> case LFS.downloadOperationRequest op of Nothing -> giveup "unable to parse git-lfs server download url" Just req -> do - uo <- getUrlOptions + uo <- getUrlOptions (Just gc) liftIO $ downloadConduit p iv req dest uo -- Since git-lfs does not support removing content, nothing needs to be diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs index d6ccf15c13..a7b38e2760 100644 --- a/Remote/HttpAlso.hs +++ b/Remote/HttpAlso.hs @@ -57,9 +57,9 @@ gen r u rc gc rs = do ll <- liftIO newLearnedLayout return $ Just $ specialRemote c cannotModify - (downloadKey url ll) + (downloadKey gc url ll) cannotModify - (checkKey url ll) + (checkKey gc url ll) (this url c cst) where this url c cst = Remote @@ -79,9 +79,9 @@ gen r u rc gc rs = do , checkPresentCheap = False , exportActions = ExportActions { storeExport = cannotModify - , retrieveExport = retriveExportHttpAlso url + , retrieveExport = retriveExportHttpAlso gc url , removeExport = cannotModify - , checkPresentExport = checkPresentExportHttpAlso url + , checkPresentExport = checkPresentExportHttpAlso gc url , removeExportDirectory = Nothing , renameExport = cannotModify } @@ -121,34 +121,35 @@ httpAlsoSetup _ (Just u) _ c gc = do gitConfigSpecialRemote u c' [("httpalso", "true")] return (c', u) -downloadKey :: Maybe URLString -> LearnedLayout -> Retriever -downloadKey baseurl ll = fileRetriever' $ \dest key p iv -> - downloadAction dest p iv (keyUrlAction baseurl ll key) +downloadKey :: RemoteGitConfig -> Maybe URLString -> LearnedLayout -> Retriever +downloadKey gc baseurl ll = fileRetriever' $ \dest key p iv -> + downloadAction gc dest p iv (keyUrlAction baseurl ll key) -retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification -retriveExportHttpAlso baseurl key loc dest p = do +retriveExportHttpAlso :: RemoteGitConfig -> Maybe URLString -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification +retriveExportHttpAlso gc baseurl key loc dest p = do verifyKeyContentIncrementally AlwaysVerify key $ \iv -> - downloadAction dest p iv (exportLocationUrlAction baseurl loc) + downloadAction gc dest p iv (exportLocationUrlAction baseurl loc) -downloadAction :: OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex () -downloadAction dest p iv run = - Url.withUrlOptions $ \uo -> +downloadAction :: RemoteGitConfig -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex () +downloadAction gc dest p iv run = + Url.withUrlOptions (Just gc) $ \uo -> run (\url -> Url.download' p iv url dest uo) >>= either giveup (const (return ())) -checkKey :: Maybe URLString -> LearnedLayout -> CheckPresent -checkKey baseurl ll key = - isRight <$> keyUrlAction baseurl ll key (checkKey' key) +checkKey :: RemoteGitConfig -> Maybe URLString -> LearnedLayout -> CheckPresent +checkKey gc baseurl ll key = + isRight <$> keyUrlAction baseurl ll key (checkKey' gc key) -checkKey' :: Key -> URLString -> Annex (Either String ()) -checkKey' key url = ifM (Url.withUrlOptions $ Url.checkBoth url (fromKey keySize key)) - ( return (Right ()) - , return (Left "content not found") - ) +checkKey' :: RemoteGitConfig -> Key -> URLString -> Annex (Either String ()) +checkKey' gc key url = + ifM (Url.withUrlOptions (Just gc) $ Url.checkBoth url (fromKey keySize key)) + ( return (Right ()) + , return (Left "content not found") + ) -checkPresentExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> Annex Bool -checkPresentExportHttpAlso baseurl key loc = - isRight <$> exportLocationUrlAction baseurl loc (checkKey' key) +checkPresentExportHttpAlso :: RemoteGitConfig -> Maybe URLString -> Key -> ExportLocation -> Annex Bool +checkPresentExportHttpAlso gc baseurl key loc = + isRight <$> exportLocationUrlAction baseurl loc (checkKey' gc key) type LearnedLayout = TVar (Maybe [Key -> URLString]) diff --git a/Remote/S3.hs b/Remote/S3.hs index df6f4e6c3c..4486a8e891 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -427,7 +427,7 @@ retrieve hv r rs c info = fileRetriever' $ \f k p iv -> withS3Handle hv $ \case Left failreason -> do warning (UnquotedString failreason) giveup "cannot download content" - Right us -> unlessM (withUrlOptions $ downloadUrl False k p iv us f) $ + Right us -> unlessM (withUrlOptions Nothing $ downloadUrl False k p iv us f) $ giveup "failed to download content" Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r) @@ -475,7 +475,7 @@ checkKey hv r rs c info k = withS3Handle hv $ \case warning (UnquotedString failreason) giveup "cannot check content" Right us -> do - let check u = withUrlOptions $ + let check u = withUrlOptions Nothing $ Url.checkBoth u (fromKey keySize k) anyM check us Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r) @@ -516,7 +516,7 @@ retrieveExportS3 hv r info k loc f p = verifyKeyContentIncrementally AlwaysVerif Right h -> retrieveHelper info h (Left (T.pack exportloc)) f p iv Left S3HandleNeedCreds -> case getPublicUrlMaker info of Just geturl -> either giveup return =<< - Url.withUrlOptions + withUrlOptions Nothing (Url.download' p iv (geturl exportloc) f) Nothing -> giveup $ needS3Creds (uuid r) Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r) @@ -537,7 +537,7 @@ checkPresentExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation checkPresentExportS3 hv r info k loc = withS3Handle hv $ \case Right h -> checkKeyHelper info h (Left (T.pack $ bucketExportLocation info loc)) Left S3HandleNeedCreds -> case getPublicUrlMaker info of - Just geturl -> withUrlOptions $ + Just geturl -> withUrlOptions Nothing $ Url.checkBoth (geturl $ bucketExportLocation info loc) (fromKey keySize k) Nothing -> giveupS3HandleProblem S3HandleNeedCreds (uuid r) Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r) @@ -913,7 +913,7 @@ mkS3HandleVar c gc u = liftIO $ newTVarIO $ Left $ Nothing -> return (Left S3HandleNeedCreds) where go awscreds = do - ou <- getUrlOptions + ou <- getUrlOptions Nothing ua <- getUserAgent let awscfg = AWS.Configuration AWS.Timestamp awscreds debugMapper Nothing let s3cfg = s3Configuration (Just ua) c diff --git a/Remote/Web.hs b/Remote/Web.hs index a097782efe..9ff34e4054 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -75,7 +75,7 @@ gen r u rc gc rs = do , cost = cst , name = Git.repoDescribe r , storeKey = uploadKey - , retrieveKeyFile = downloadKey urlincludeexclude + , retrieveKeyFile = downloadKey gc urlincludeexclude , retrieveKeyFileInOrder = pure True , retrieveKeyFileCheap = Nothing -- HttpManagerRestricted is used here, so this is @@ -83,7 +83,7 @@ gen r u rc gc rs = do , retrievalSecurityPolicy = RetrievalAllKeysSecure , removeKey = dropKey urlincludeexclude , lockContent = Nothing - , checkPresent = checkKey urlincludeexclude + , checkPresent = checkKey gc urlincludeexclude , checkPresentCheap = False , exportActions = exportUnsupported , importActions = importUnsupported @@ -115,8 +115,8 @@ setupInstance _ mu _ c _ = do gitConfigSpecialRemote u c [("web", "true")] return (c, u) -downloadKey :: UrlIncludeExclude -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification -downloadKey urlincludeexclude key _af dest p vc = +downloadKey :: RemoteGitConfig -> UrlIncludeExclude -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification +downloadKey gc urlincludeexclude key _af dest p vc = go =<< getWebUrls' urlincludeexclude key where go [] = giveup "no known url" @@ -138,7 +138,7 @@ downloadKey urlincludeexclude key _af dest p vc = ) dl (us, ytus) = do iv <- startVerifyKeyContentIncrementally vc key - ifM (Url.withUrlOptions $ downloadUrl True key p iv (map fst us) dest) + ifM (Url.withUrlOptions (Just gc) $ downloadUrl True key p iv (map fst us) dest) ( finishVerifyKeyContentIncrementally iv >>= \case (True, v) -> postdl v (False, _) -> dl ([], ytus) @@ -177,19 +177,21 @@ uploadKey _ _ _ _ = giveup "upload to web not supported" dropKey :: UrlIncludeExclude -> Maybe SafeDropProof -> Key -> Annex () dropKey urlincludeexclude _proof k = mapM_ (setUrlMissing k) =<< getWebUrls' urlincludeexclude k -checkKey :: UrlIncludeExclude -> Key -> Annex Bool -checkKey urlincludeexclude key = do +checkKey :: RemoteGitConfig -> UrlIncludeExclude -> Key -> Annex Bool +checkKey gc urlincludeexclude key = do us <- getWebUrls' urlincludeexclude key if null us then return False - else either giveup return =<< checkKey' key us -checkKey' :: Key -> [URLString] -> Annex (Either String Bool) -checkKey' key us = firsthit us (Right False) $ \u -> do + else either giveup return =<< checkKey' gc key us + +checkKey' :: RemoteGitConfig -> Key -> [URLString] -> Annex (Either String Bool) +checkKey' gc key us = firsthit us (Right False) $ \u -> do let (u', downloader) = getDownloader u case downloader of YoutubeDownloader -> youtubeDlCheck u' _ -> catchMsgIO $ - Url.withUrlOptions $ Url.checkBoth u' (fromKey keySize key) + Url.withUrlOptions (Just gc) $ + Url.checkBoth u' (fromKey keySize key) where firsthit [] miss _ = return miss firsthit (u:rest) _ a = do diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index eeae1a0c7e..bf4e9d8835 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -404,6 +404,7 @@ data RemoteGitConfig = RemoteGitConfig , remoteAnnexBwLimitUpload :: Maybe BwRate , remoteAnnexBwLimitDownload :: Maybe BwRate , remoteAnnexAllowUnverifiedDownloads :: Bool + , remoteAnnexWebOptions :: [String] , remoteAnnexUUID :: Maybe UUID , remoteAnnexConfigUUID :: Maybe UUID , remoteAnnexMaxGitBundles :: Int @@ -492,6 +493,7 @@ extractRemoteGitConfig r remotename = do readBwRatePerSecond =<< getmaybe BWLimitDownloadField , remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ getmaybe SecurityAllowUnverifiedDownloadsField + , remoteAnnexWebOptions = getwords WebOptionsField , remoteAnnexUUID = toUUID <$> getmaybe UUIDField , remoteAnnexConfigUUID = toUUID <$> getmaybe ConfigUUIDField , remoteAnnexMaxGitBundles = @@ -556,6 +558,7 @@ extractRemoteGitConfig r remotename = do | B.null b -> Nothing | otherwise -> Just (decodeBS b) _ -> Nothing + getwords k = fromMaybe [] $ words <$> getmaybe k data RemoteGitConfigField = CostField @@ -588,6 +591,7 @@ data RemoteGitConfigField | UUIDField | ConfigUUIDField | SecurityAllowUnverifiedDownloadsField + | WebOptionsField | MaxGitBundlesField | AllowEncryptedGitRepoField | ProxyField @@ -656,6 +660,7 @@ remoteGitConfigField = \case UUIDField -> uninherited True "uuid" ConfigUUIDField -> uninherited True "config-uuid" SecurityAllowUnverifiedDownloadsField -> inherited True "security-allow-unverified-downloads" + WebOptionsField -> inherited True "web-options" MaxGitBundlesField -> inherited True "max-git-bundles" AllowEncryptedGitRepoField -> inherited True "allow-encrypted-gitrepo" -- Allow proxy chains. diff --git a/doc/forum/Authentication_for_URL_downloads/comment_1_e5a146811b2ba94eeae424feba52a851._comment b/doc/forum/Authentication_for_URL_downloads/comment_1_e5a146811b2ba94eeae424feba52a851._comment new file mode 100644 index 0000000000..fa6eecb22f --- /dev/null +++ b/doc/forum/Authentication_for_URL_downloads/comment_1_e5a146811b2ba94eeae424feba52a851._comment @@ -0,0 +1,37 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2025-04-01T13:15:04Z" + content=""" +Well curl does have a --cookie option. But setting that would make all +downloads from the web special remote have the same cookies set. So +exposing them to any other web servers you also use with that remote. + +I think that generally, things involving authentication are a +good use case for writing a little external special remote of your own +that handles the particulars of a given service. Especially if you can +share it with others. [[doc/special_remotes/external/example.sh]] is a good +starting place for writing that. + +That said, this is also right on the line to something it might be possible +for git-annex to support better without you needing to do that work. It's +actually possible to initremote a second web special remote that is limited +to a single host and is used preferentially to the web special remote: + + git-annex initremote --sameas=web archiveorg type=web urlinclude='*archive.org/*' + git config remote.archiveorg.annex-cost 100 + +If `annex.web-options` had a per-remote config, like some other configs do, +but which it currently does not, you could then just set that to pass the +cookies to curl when using that archiveorg special remote: + + git config remote.archiveorg.annex-web-options "--cookie=whatever" + +Since that seems like a good idea, I've implemented it! Get it in the next +release or a daily build. + +PS, you'll also need to set this, which does have its own security +ramifications: + + git config annex.security.allowed-ip-addresses all +"""]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 03204045a6..8ab22b6a83 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -2067,18 +2067,18 @@ Remotes are configured using these settings in `.git/config`. Used by hook special remotes to record the type of the remote. -* `annex.web-options` +* `annex.web-options`, `remote..annex-web-options` Options to pass to curl when git-annex uses it to download urls (rather than the default built-in url downloader). For example, to force IPv4 only, set it to "-4". - Setting this option makes git-annex use curl, but only + Setting this makes git-annex use curl, but only when annex.security.allowed-ip-addresses is configured in a specific way. See its documentation. - Setting this option prevents git-annex from using git-credential + Setting this prevents git-annex from using git-credential for prompting for http passwords. Instead, you can include "--netrc" to make curl use your ~/.netrc file and record the passwords there.