From 1883f7ef8f9f617c60832c7f0794b54515fc652d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 22 Jan 2020 16:13:48 -0400 Subject: [PATCH] support git remotes that need http basic auth using git credential to get the password One thing this doesn't do is wrap the password prompting inside the prompt action. So with -J, the output can be a bit garbled. --- Annex/Content.hs | 7 +- Annex/Url.hs | 20 +++- CHANGELOG | 2 + Command/AddUrl.hs | 2 +- Git/Credential.hs | 19 ++- Remote/External.hs | 2 +- Remote/Git.hs | 7 +- Remote/GitLFS.hs | 13 +-- Remote/S3.hs | 2 +- Remote/Web.hs | 2 +- Utility/Url.hs | 108 ++++++++++++++---- ...ad_downloaded___34__config__34___file.mdwn | 3 + 12 files changed, 143 insertions(+), 44 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 7c57cf5040..9615513669 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -780,13 +780,12 @@ saveState nocommit = doSideAction $ do {- Downloads content from any of a list of urls, displaying a progress - meter. -} -downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool -downloadUrl k p urls file = +downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool +downloadUrl k p urls file uo = -- Poll the file to handle configurations where an external -- download command is used. meteredFile file (Just p) k $ - Url.withUrlOptions $ \uo -> - anyM (\u -> Url.download p u file uo) urls + anyM (\u -> Url.download p u file uo) urls {- Copies a key's content, when present, to a temp file. - This is used to speed up some rsyncs. -} diff --git a/Annex/Url.hs b/Annex/Url.hs index bcc6a747f5..08c3e3bf70 100644 --- a/Annex/Url.hs +++ b/Annex/Url.hs @@ -1,13 +1,14 @@ {- Url downloading, with git-annex user agent and configured http - headers, security restrictions, etc. - - - Copyright 2013-2019 Joey Hess + - Copyright 2013-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} module Annex.Url ( withUrlOptions, + withUrlOptionsPromptingCreds, getUrlOptions, getUserAgent, ipAddressesUnlimited, @@ -34,6 +35,7 @@ import qualified Utility.Url as U import Utility.IPAddress import Utility.HttpManagerRestricted import Utility.Metered +import Git.Credential import qualified BuildInfo import Network.Socket @@ -64,6 +66,7 @@ getUrlOptions = Annex.getState Annex.urloptions >>= \case <*> pure urldownloader <*> pure manager <*> (annexAllowedUrlSchemes <$> Annex.getGitConfig) + <*> pure U.noBasicAuth headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd]) @@ -124,6 +127,21 @@ ipAddressesUnlimited = withUrlOptions :: (U.UrlOptions -> Annex a) -> Annex a withUrlOptions a = a =<< getUrlOptions +-- When downloading an url, if authentication is needed, uses +-- git-credential to prompt for username and password. +withUrlOptionsPromptingCreds :: (U.UrlOptions -> Annex a) -> Annex a +withUrlOptionsPromptingCreds a = do + g <- Annex.gitRepo + uo <- getUrlOptions + a $ uo + { U.getBasicAuth = getBasicAuthFromCredential g + -- Can't download with curl and handle basic auth, + -- so avoid using curl. + , U.urlDownloader = case U.urlDownloader uo of + U.DownloadWithCurl _ -> U.DownloadWithConduit $ U.DownloadWithCurlRestricted mempty + v -> v + } + checkBoth :: U.URLString -> Maybe Integer -> U.UrlOptions -> Annex Bool checkBoth url expected_size uo = liftIO (U.checkBoth url expected_size uo) >>= \case diff --git a/CHANGELOG b/CHANGELOG index b80dcfe833..c36aec2821 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -17,6 +17,8 @@ git-annex (7.20191231) UNRELEASED; urgency=medium programs that use GETCONFIG/SETCONFIG are recommended to implement it. * init: Avoid an ugly error message when http remote has no git-annex uuid configured. + * Support git remotes that need http basic auth to be accessed, + using git credential to get the password. -- Joey Hess Wed, 01 Jan 2020 12:51:40 -0400 diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 4fb03f6b04..f728eb175e 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -261,7 +261,7 @@ downloadWeb addunlockedmatcher o url urlinfo file = go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just (toRawFilePath file))) where urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing - downloader f p = downloadUrl urlkey p [url] f + downloader f p = Url.withUrlOptions $ downloadUrl urlkey p [url] f go Nothing = return Nothing -- If we downloaded a html file, try to use youtube-dl to -- extract embedded media. diff --git a/Git/Credential.hs b/Git/Credential.hs index 5de95d1a37..9465d27963 100644 --- a/Git/Credential.hs +++ b/Git/Credential.hs @@ -1,6 +1,6 @@ {- git credential interface - - - Copyright 2019 Joey Hess + - Copyright 2019-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -22,6 +22,23 @@ credentialUsername = M.lookup "username" . fromCredential credentialPassword :: Credential -> Maybe String credentialPassword = M.lookup "password" . fromCredential +credentialBasicAuth :: Credential -> Maybe BasicAuth +credentialBasicAuth cred = BasicAuth + <$> credentialUsername cred + <*> credentialPassword cred + +getBasicAuthFromCredential :: Repo -> GetBasicAuth +getBasicAuthFromCredential r u = do + c <- getUrlCredential u r + case credentialBasicAuth c of + Just ba -> return $ Just (ba, signalsuccess c) + Nothing -> do + signalsuccess c False + return Nothing + where + signalsuccess c True = approveUrlCredential c r + signalsuccess c False = rejectUrlCredential c r + -- | This may prompt the user for login information, or get cached login -- information. getUrlCredential :: URLString -> Repo -> IO Credential diff --git a/Remote/External.hs b/Remote/External.hs index cf3676ccec..750e6ed773 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -747,7 +747,7 @@ checkUrlM external url = retrieveUrl :: Retriever retrieveUrl = fileRetriever $ \f k p -> do us <- getWebUrls k - unlessM (downloadUrl k p us f) $ + unlessM (withUrlOptions $ downloadUrl k p us f) $ giveup "failed to download content" checkKeyUrl :: Git.Repo -> CheckPresent diff --git a/Remote/Git.hs b/Remote/Git.hs index eb66215ab7..ea07c0e4c4 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -276,7 +276,7 @@ tryGitConfigRead autoinit r warning $ "Unable to parse git config from " ++ configloc return $ Left l - geturlconfig = Url.withUrlOptions $ \uo -> do + geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do liftIO $ hClose h let url = Git.repoLocation r ++ "/config" @@ -382,7 +382,7 @@ inAnnex' repo rmt (State connpool duc _ _) key checkhttp = do showChecking repo gc <- Annex.getGitConfig - ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key)) + ifM (Url.withUrlOptionsPromptingCreds $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key)) ( return True , giveup "not found" ) @@ -514,7 +514,8 @@ copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile copyFromRemote'' repo forcersync r st@(State connpool _ _ _) key file dest meterupdate | Git.repoIsHttp repo = unVerified $ do gc <- Annex.getGitConfig - Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest + Url.withUrlOptionsPromptingCreds $ + Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest | not $ Git.repoIsUrl repo = guardUsable repo (unVerified (return False)) $ do params <- Ssh.rsyncParams r Download u <- getUUID diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index f400d0dd9e..2f91d1c77a 100644 --- a/Remote/GitLFS.hs +++ b/Remote/GitLFS.hs @@ -37,6 +37,7 @@ import Crypto import Backend.Hash import Utility.Hash import Utility.SshHost +import Utility.Url import Logs.Remote import Logs.RemoteState import qualified Utility.GitLFS as LFS @@ -283,7 +284,7 @@ discoverLFSEndpoint tro h if needauth (responseStatus resp) then do cred <- prompt $ inRepo $ Git.getUrlCredential (show lfsrepouri) - let endpoint' = addbasicauth cred endpoint + let endpoint' = addbasicauth (Git.credentialBasicAuth cred) endpoint let testreq' = LFS.startTransferRequest endpoint' transfernothing flip catchNonAsync (const (returnendpoint endpoint')) $ do resp' <- makeSmallAPIRequest testreq' @@ -303,12 +304,10 @@ discoverLFSEndpoint tro h needauth status = status == unauthorized401 - addbasicauth cred endpoint = - case (Git.credentialUsername cred, Git.credentialPassword cred) of - (Just u, Just p) -> - LFS.modifyEndpointRequest endpoint $ - applyBasicAuth (encodeBS u) (encodeBS p) - _ -> endpoint + addbasicauth (Just ba) endpoint = + LFS.modifyEndpointRequest endpoint $ + applyBasicAuth' ba + addbasicauth Nothing endpoint = endpoint -- The endpoint is cached for later use. getLFSEndpoint :: LFS.TransferRequestOperation -> TVar LFSHandle -> Annex (Maybe LFS.Endpoint) diff --git a/Remote/S3.hs b/Remote/S3.hs index 8e925a3f91..ff5484464d 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -387,7 +387,7 @@ retrieve hv r rs c info = fileRetriever $ \f k p -> withS3Handle hv $ \case Left failreason -> do warning failreason giveup "cannot download content" - Right us -> unlessM (downloadUrl k p us f) $ + Right us -> unlessM (withUrlOptions $ downloadUrl k p us f) $ giveup "failed to download content" retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> FilePath -> MeterUpdate -> Annex () diff --git a/Remote/Web.hs b/Remote/Web.hs index 1df743ed3a..a2c0cb6407 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -90,7 +90,7 @@ downloadKey key _af dest p = unVerified $ get =<< getWebUrls key YoutubeDownloader -> do showOutput youtubeDlTo key u' dest - _ -> downloadUrl key p [u'] dest + _ -> Url.withUrlOptions $ downloadUrl key p [u'] dest downloadKeyCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool downloadKeyCheap _ _ _ = return False diff --git a/Utility/Url.hs b/Utility/Url.hs index 2aa4e6a589..37fb705351 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -1,6 +1,6 @@ {- Url downloading. - - - Copyright 2011-2019 Joey Hess + - Copyright 2011-2020 Joey Hess - - License: BSD-2-clause -} @@ -8,6 +8,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE BangPatterns #-} module Utility.Url ( newManager, @@ -35,6 +36,10 @@ module Utility.Url ( parseURIRelaxed, matchStatusCodeException, matchHttpExceptionContent, + BasicAuth(..), + GetBasicAuth, + noBasicAuth, + applyBasicAuth', ) where import Common @@ -84,6 +89,7 @@ data UrlOptions = UrlOptions , applyRequest :: Request -> Request , httpManager :: Manager , allowedSchemes :: S.Set Scheme + , getBasicAuth :: GetBasicAuth } data UrlDownloader @@ -101,10 +107,11 @@ defUrlOptions = UrlOptions <*> pure id <*> newManager tlsManagerSettings <*> pure (S.fromList $ map mkScheme ["http", "https", "ftp"]) + <*> pure noBasicAuth -mkUrlOptions :: Maybe UserAgent -> Headers -> UrlDownloader -> Manager -> S.Set Scheme -> UrlOptions -mkUrlOptions defuseragent reqheaders urldownloader manager = - UrlOptions useragent reqheaders urldownloader applyrequest manager +mkUrlOptions :: Maybe UserAgent -> Headers -> UrlDownloader -> Manager -> S.Set Scheme -> GetBasicAuth -> UrlOptions +mkUrlOptions defuseragent reqheaders urldownloader manager getbasicauth = + UrlOptions useragent reqheaders urldownloader applyrequest manager getbasicauth where applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders } addedheaders = uaheader ++ otherheaders @@ -197,14 +204,14 @@ getUrlInfo url uo = case parseURIRelaxed url of Nothing -> return (Right dne) where go :: URI -> IO (Either String UrlInfo) - go u = case (urlDownloader uo, parseUrlRequest (show u)) of + go u = case (urlDownloader uo, parseRequest (show u)) of (DownloadWithConduit (DownloadWithCurlRestricted r), Just req) -> catchJust -- When http redirects to a protocol which -- conduit does not support, it will throw -- a StatusCodeException with found302 -- and a Response with the redir Location. (matchStatusCodeException (== found302)) - (Right <$> existsconduit req) + (Right <$> existsconduit req uo) (followredir r) `catchNonAsync` (const $ return $ Right dne) (DownloadWithConduit (DownloadWithCurlRestricted r), Nothing) @@ -243,18 +250,28 @@ getUrlInfo url uo = case parseURIRelaxed url of extractfilename = contentDispositionFilename . B8.toString <=< lookup hContentDisposition . responseHeaders - existsconduit req = do + existsconduit req uo' = do let req' = headRequest (applyRequest uo req) debugM "url" (show req') - runResourceT $ do + join $ runResourceT $ do resp <- http req' (httpManager uo) -- forces processing the response while -- within the runResourceT liftIO $ if responseStatus resp == ok200 - then found - (extractlen resp) - (extractfilename resp) - else return dne + then do + let !len = extractlen resp + let !fn = extractfilename resp + return $ found len fn + else if responseStatus resp == unauthorized401 + then return $ getBasicAuth uo' (show (getUri req)) >>= \case + Nothing -> return dne + Just (ba, signalsuccess) -> do + ui <- existsconduit + (applyBasicAuth' ba req) + (uo' { getBasicAuth = noBasicAuth }) + signalsuccess (urlExists ui) + return ui + else return $ return dne existscurl u curlparams = do output <- catchDefaultIO "" $ @@ -284,6 +301,7 @@ getUrlInfo url uo = case parseURIRelaxed url of sz <- getFileSize' f stat found (Just sz) Nothing Nothing -> return dne + followredir r (HttpExceptionRequest _ (StatusCodeException resp _)) = case headMaybe $ map decodeBS $ getResponseHeader hLocation resp of Just url' -> case parseURIRelaxed url' of @@ -334,7 +352,7 @@ download' nocurlerror meterupdate url file uo = where go = case parseURIRelaxed url of Just u -> checkPolicy uo u $ - case (urlDownloader uo, parseUrlRequest (show u)) of + case (urlDownloader uo, parseRequest (show u)) of (DownloadWithConduit (DownloadWithCurlRestricted r), Just req) -> catchJust (matchStatusCodeException (== found302)) (downloadConduit meterupdate req file uo >> return (Right ())) @@ -416,12 +434,18 @@ downloadConduit :: MeterUpdate -> Request -> FilePath -> UrlOptions -> IO () downloadConduit meterupdate req file uo = catchMaybeIO (getFileSize file) >>= \case Just sz | sz > 0 -> resumedownload sz - _ -> runResourceT $ do + _ -> join $ runResourceT $ do liftIO $ debugM "url" (show req') resp <- http req' (httpManager uo) if responseStatus resp == ok200 - then store zeroBytesProcessed WriteMode resp - else respfailure resp + then do + store zeroBytesProcessed WriteMode resp + return (return ()) + else if responseStatus resp == unauthorized401 + then return $ getBasicAuth uo (show (getUri req')) >>= \case + Nothing -> respfailure resp + Just ba -> retryauthed ba + else return $ respfailure resp where req' = applyRequest uo $ req -- Override http-client's default decompression of gzip @@ -440,15 +464,23 @@ downloadConduit meterupdate req file uo = dl (const noop) where - dl = runResourceT $ do + dl = join $ runResourceT $ do let req'' = req' { requestHeaders = resumeFromHeader sz : requestHeaders req } liftIO $ debugM "url" (show req'') resp <- http req'' (httpManager uo) if responseStatus resp == partialContent206 - then store (toBytesProcessed sz) AppendMode resp + then do + store (toBytesProcessed sz) AppendMode resp + return (return ()) else if responseStatus resp == ok200 - then store zeroBytesProcessed WriteMode resp - else respfailure resp + then do + store zeroBytesProcessed WriteMode resp + return (return ()) + else if responseStatus resp == unauthorized401 + then return $ getBasicAuth uo (show (getUri req'')) >>= \case + Nothing -> respfailure resp + Just ba -> retryauthed ba + else return $ respfailure resp alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 && case lookup hContentRange h of @@ -469,6 +501,18 @@ downloadConduit meterupdate req file uo = respfailure = giveup . B8.toString . statusMessage . responseStatus + retryauthed (ba, signalsuccess) = do + r <- tryNonAsync $ downloadConduit + meterupdate + (applyBasicAuth' ba req) + file + (uo { getBasicAuth = noBasicAuth }) + case r of + Right () -> signalsuccess True + Left e -> do + signalsuccess False + throwM e + {- Sinks a Response's body to a file. The file can either be opened in - WriteMode or AppendMode. Updates the meter as data is received. - @@ -502,7 +546,7 @@ downloadPartial url uo n = case parseURIRelaxed url of Nothing -> return Nothing Just u -> go u `catchNonAsync` const (return Nothing) where - go u = case parseUrlRequest (show u) of + go u = case parseRequest (show u) of Nothing -> return Nothing Just req -> do let req' = applyRequest uo req @@ -517,9 +561,6 @@ parseURIRelaxed :: URLString -> Maybe URI parseURIRelaxed s = maybe (parseURIRelaxed' s) Just $ parseURI $ escapeURIString isAllowedInURI s -parseUrlRequest :: URLString -> Maybe Request -parseUrlRequest = parseUrlThrow - {- Some characters like '[' are allowed in eg, the address of - an uri, but cannot appear unescaped further along in the uri. - This handles that, expensively, by successively escaping each character @@ -628,3 +669,22 @@ curlRestrictedParams r u defport ps = case uriAuthority u of , Param "--max-redirs", Param "0" ] bracketaddr a = "[" ++ a ++ "]" + +data BasicAuth = BasicAuth + { basicAuthUser :: String + , basicAuthPassword :: String + } + +-- Note that this is only used when using conduit, not curl. +-- +-- The returned IO action is run after trying to use the BasicAuth, +-- indicating if the password worked. +type GetBasicAuth = URLString -> IO (Maybe (BasicAuth, Bool -> IO ())) + +noBasicAuth :: GetBasicAuth +noBasicAuth = const $ pure Nothing + +applyBasicAuth' :: BasicAuth -> Request -> Request +applyBasicAuth' ba = applyBasicAuth + (encodeBS (basicAuthUser ba)) + (encodeBS (basicAuthPassword ba)) diff --git a/doc/bugs/leaks_git_config_error_message_upon_inability_to_read_downloaded___34__config__34___file.mdwn b/doc/bugs/leaks_git_config_error_message_upon_inability_to_read_downloaded___34__config__34___file.mdwn index 63c691cd6e..9457d4b8bf 100644 --- a/doc/bugs/leaks_git_config_error_message_upon_inability_to_read_downloaded___34__config__34___file.mdwn +++ b/doc/bugs/leaks_git_config_error_message_upon_inability_to_read_downloaded___34__config__34___file.mdwn @@ -145,3 +145,6 @@ git annex 7.20190819+git2-g908476a9b-1~ndall+1 and the same with bleeding edge 7 [[!meta author=yoh]] [[!tag projects/dandi]] +> [[done]]; the error message is improved and also git remotes that need +> http basic auth to access will get password from `git credential`. +> --[[Joey]]