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

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

(Needs aws-0.24.3)

CHANGELOG

@@ -5,6 +5,8 @@ git-annex (10.20241032) UNRELEASED; urgency=medium
   * vpop: Only update state after successful checkout.
   * S3: Support versioning=yes with a readonly bucket.
     (Needs aws-0.24.3)
+  * S3: Send git-annex or other configured User-Agent.
+    (Needs aws-0.24.3)
 
  -- Joey Hess <id@joeyh.name>  Mon, 11 Nov 2024 12:26:00 -0400
 

Remote/S3.hs

@@ -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
 

doc/bugs/User-Agent_not_sent_with_S3_remote.mdwn

@@ -1,3 +1,5 @@
 ### Please describe the problem.
 
 git-annex does not appear to send a User-Agent when used with an S3 remote.
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/User-Agent_not_sent_with_S3_remote/comment_2_18f895b9e38908faecfc0a55a802fdd3._comment

@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2024-11-13T19:52:28Z"
+ content="""
+Drat, no followup. I seem to remember hearing about a S3 implementation
+that either needed any User-Agent header (currently, git-annex does not
+send one to S3), or perhaps a specific User-Agent. But I don't remember
+details.
+
+Anyway, I have implemented a patch to the aws library that can be used for
+this.
+"""]]

doc/git-annex-common-options.mdwn

@@ -133,7 +133,8 @@ Most of these options are accepted by all git-annex commands.
 
 * `--user-agent=value`
 
-  Overrides the User-Agent to use when downloading files from the web.
+  Overrides the User-Agent to use when downloading files from the web,
+  or otherwise accessing web services.
 
 * `--notify-finish`