mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages1 Wiki Activity Actions

--debug urls

Browse source 
When git-annex used wget and curl, --debug would show urls. So there can't
be any new security problem with doing so.

This commit was sponsored by John Pellman on Patreon.
This commit is contained in:
Joey Hess 2018-09-14 12:46:39 -04:00
parent 773084c49b
commit b3c9c59d3d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 7 additions and 0 deletions

2
CHANGELOG
View file

@ -2,6 +2,8 @@ git-annex (6.20180914) UNRELEASED; urgency=medium
* S3: Fix url construction bug when the publicurl has been set to an url * S3: Fix url construction bug when the publicurl has been set to an url
that does not end with a slash. that does not end with a slash.
* --debug shows urls accessed by git-annex, like it used to do when
git-annex used wget and curl.
-- Joey Hess <id@joeyh.name> Fri, 14 Sep 2018 12:20:19 -0400 -- Joey Hess <id@joeyh.name> Fri, 14 Sep 2018 12:20:19 -0400

5
Utility/Url.hs
View file

@ -51,6 +51,7 @@ import Control.Monad.Trans.Resource
import Network.HTTP.Conduit import Network.HTTP.Conduit
import Network.HTTP.Client import Network.HTTP.Client
import Data.Conduit import Data.Conduit
import System.Log.Logger
#if ! MIN_VERSION_http_client(0,5,0) #if ! MIN_VERSION_http_client(0,5,0)
responseTimeoutNone :: Maybe Int responseTimeoutNone :: Maybe Int
@ -232,6 +233,7 @@ getUrlInfo url uo = case parseURIRelaxed url of
existsconduit req = do existsconduit req = do
let req' = headRequest (applyRequest uo req) let req' = headRequest (applyRequest uo req)
debugM "url" (show req')
runResourceT $ do runResourceT $ do
resp <- http req' (httpManager uo) resp <- http req' (httpManager uo)
-- forces processing the response while -- forces processing the response while
@ -315,6 +317,7 @@ download meterupdate url file uo =
downloadconduit req = catchMaybeIO (getFileSize file) >>= \case downloadconduit req = catchMaybeIO (getFileSize file) >>= \case
Nothing -> runResourceT $ do Nothing -> runResourceT $ do
liftIO $ debugM "url" (show req')
resp <- http (applyRequest uo req') (httpManager uo) resp <- http (applyRequest uo req') (httpManager uo)
if responseStatus resp == ok200 if responseStatus resp == ok200
then store zeroBytesProcessed WriteMode resp then store zeroBytesProcessed WriteMode resp
@ -347,6 +350,7 @@ download meterupdate url file uo =
where where
dl = runResourceT $ do dl = runResourceT $ do
let req' = req { requestHeaders = resumeFromHeader sz : requestHeaders req } let req' = req { requestHeaders = resumeFromHeader sz : requestHeaders req }
liftIO $ debugM "url" (show req')
resp <- http req' (httpManager uo) resp <- http req' (httpManager uo)
if responseStatus resp == partialContent206 if responseStatus resp == partialContent206
then store (BytesProcessed sz) AppendMode resp then store (BytesProcessed sz) AppendMode resp
@ -452,6 +456,7 @@ downloadPartial url uo n = case parseURIRelaxed url of
Nothing -> return Nothing Nothing -> return Nothing
Just req -> do Just req -> do
let req' = applyRequest uo req let req' = applyRequest uo req
liftIO $ debugM "url" (show req')
withResponse req' (httpManager uo) $ \resp -> withResponse req' (httpManager uo) $ \resp ->
if responseStatus resp == ok200 if responseStatus resp == ok200
then Just <$> brread n [] (responseBody resp) then Just <$> brread n [] (responseBody resp)