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

S3: Send git-annex or other configured User-Agent.

Browse source 
--user-agent is the only way to configure it currently

(Needs aws-0.24.3)
This commit is contained in:
Joey Hess 2024-11-13 16:10:37 -04:00
parent 3f7953869d
commit 44da423e2e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 34 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Remote/S3.hs
View file

@ -63,8 +63,8 @@ import Utility.Metered
import Utility.DataUnits
import Annex.Content
import qualified Annex.Url as Url
import Utility.Url (extractFromResourceT)
import Annex.Url (getUrlOptions, withUrlOptions, UrlOptions(..))
import Utility.Url (extractFromResourceT, UserAgent)
import Annex.Url (getUserAgent, getUrlOptions, withUrlOptions, UrlOptions(..))
import Utility.Env
import Annex.Verify
@ -885,10 +885,11 @@ mkS3HandleVar c gc u = liftIO $ newTVarIO $ Left $
Just creds -> go =<< liftIO (genCredentials creds)
Nothing -> return (Left S3HandleNeedCreds)
where
s3cfg = s3Configuration c
go awscreds = do
let awscfg = AWS.Configuration AWS.Timestamp awscreds debugMapper Nothing
ou <- getUrlOptions
ua <- getUserAgent
let awscfg = AWS.Configuration AWS.Timestamp awscreds debugMapper Nothing
let s3cfg = s3Configuration (Just ua) c
return $ Right $ S3Handle (httpManager ou) awscfg s3cfg
withS3Handle :: S3HandleVar -> (Either S3HandleProblem S3Handle -> Annex a) -> Annex a
@ -907,13 +908,20 @@ withS3HandleOrFail u hv a = withS3Handle hv $ \case
needS3Creds :: UUID -> String
needS3Creds u = missingCredPairFor "S3" (AWS.creds u)
s3Configuration :: ParsedRemoteConfig -> S3.S3Configuration AWS.NormalQuery
s3Configuration c = cfg
s3Configuration :: Maybe UserAgent -> ParsedRemoteConfig -> S3.S3Configuration AWS.NormalQuery
#if MIN_VERSION_aws(0,24,3)
s3Configuration ua c = cfg
#else
s3Configuration _ua c = cfg
#endif
{ S3.s3Port = port
, S3.s3RequestStyle = case getRemoteConfigValue requeststyleField c of
Just "path" -> S3.PathStyle
Just s -> giveup $ "bad S3 requeststyle value: " ++ s
Nothing -> S3.s3RequestStyle cfg
#if MIN_VERSION_aws(0,24,3)
, S3.s3UserAgent = T.pack <$> ua
#endif
}
where
h = fromJust $ getRemoteConfigValue hostField c
@ -1157,7 +1165,7 @@ s3Info c info = catMaybes
, Just ("versioning", if versioning info then "yes" else "no")
]
where
s3c = s3Configuration c
s3c = s3Configuration Nothing c
showstorageclass (S3.OtherStorageClass t) = T.unpack t
showstorageclass sc = show sc