File 7951-OTP-19158-httpc-enable-options-for-async-request.patch of Package erlang

From 299be8d249b8d2e44169bed409b9867d0542bc72 Mon Sep 17 00:00:00 2001
From: Konrad Pietrzak <konrad@erlang.org>
Date: Thu, 4 Jul 2024 11:39:33 +0200
Subject: [PATCH 1/2] OTP-19158 httpc enable options for async request

---
 lib/inets/src/http_client/httpc.erl          | 29 +++++-------
 lib/inets/src/http_client/httpc_handler.erl  | 43 +++++++++++++++--
 lib/inets/src/http_client/httpc_internal.hrl |  3 +-
 lib/inets/src/http_client/httpc_request.erl  | 50 ++++++++++----------
 lib/inets/test/httpc_SUITE.erl               | 13 ++++-
 5 files changed, 92 insertions(+), 46 deletions(-)

diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl
index d9ea9c76e3..0ac74f14f3 100644
--- a/lib/inets/src/http_client/httpc.erl
+++ b/lib/inets/src/http_client/httpc.erl
@@ -1204,7 +1204,8 @@ handle_request(Method, Url,
 			       socket_opts   = SocketOpts, 
 			       started       = Started,
 			       unix_socket   = UnixSocket,
-			       ipv6_host_with_brackets = BracketedHost},
+			       ipv6_host_with_brackets = BracketedHost,
+			       request_options       = Options},
 	    case httpc_manager:request(Request, profile_name(Profile)) of
 		{ok, RequestId} ->
 		    handle_answer(RequestId, Sync, Options);
@@ -1267,22 +1268,16 @@ handle_answer(RequestId, false, _) ->
     {ok, RequestId};
 handle_answer(RequestId, true, Options) ->
     receive
-	{http, {RequestId, saved_to_file}} ->
-	    {ok, saved_to_file};
-	{http, {RequestId, {_,_,_} = Result}} ->
-	    return_answer(Options, Result);
-	{http, {RequestId, {error, Reason}}} ->
-	    {error, Reason}
-    end.
-
-return_answer(Options, {StatusLine, Headers, BinBody}) ->
-    Body = maybe_format_body(BinBody, Options),
-    case proplists:get_value(full_result, Options, true) of
-	true ->
-	    {ok, {StatusLine, Headers, Body}};
-	false ->
-	    {_, Status, _} = StatusLine,
-	    {ok, {Status, Body}}
+        {http, {RequestId, {ok, saved_to_file}}} ->
+            {ok, saved_to_file};
+        {http, {RequestId, {error, Reason}}} ->
+            {error, Reason};
+        {http, {RequestId, {ok, {StatusLine,Headers,BinBody}}}} ->
+            Body = maybe_format_body(BinBody, Options),
+            {ok, {StatusLine, Headers, Body}};
+        {http, {RequestId, {ok, {StatusCode,BinBody}}}} ->
+            Body = maybe_format_body(BinBody, Options),
+            {ok, {StatusCode, Body}}
     end.
 
 maybe_format_body(BinBody, Options) ->
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index ca3a46ccd9..ad8694c9f2 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -1319,11 +1319,12 @@ handle_server_closing(State = #state{headers = Headers}) ->
         false -> State
     end.
 
-answer_request(#request{id = RequestId, from = From} = Request, Msg, 
+answer_request(#request{id = RequestId, from = From, request_options = Options} = Request, Msg,
 	       #state{session      = Session, 
 		      timers       = Timers, 
-		      profile_name = ProfileName} = State) -> 
-    httpc_response:send(From, Msg),
+		      profile_name = ProfileName} = State) ->
+    Answer = format_answer(Msg, Options),
+    httpc_response:send(From, Answer),
     RequestTimers = Timers#timers.request_timers,
     TimerRef =
 	proplists:get_value(RequestId, RequestTimers, undefined),
@@ -1717,6 +1718,42 @@ format_address({[$[|T], Port}) ->
 format_address(HostPort) ->
     HostPort.
 
+format_answer(Res0, Options) ->
+    FullResult = proplists:get_value(full_result, Options, true),
+    Sync = proplists:get_value(sync, Options, true),
+    do_format_answer(Res0, FullResult, Sync).
+do_format_answer({Ref, StatusLine}, _, Sync) when is_atom(StatusLine) ->
+    case Sync of
+        true ->
+            {Ref, {ok, StatusLine}};
+        _ ->
+            {Ref, StatusLine}
+    end;
+do_format_answer({Ref, StatusLine, Headers}, _, Sync) when is_atom(StatusLine) ->
+    case Sync of
+        true ->
+            {Ref, {ok, {StatusLine, Headers}}};
+        _ ->
+            {Ref, StatusLine, Headers}
+    end;
+do_format_answer({Ref, {StatusLine, Headers, BinBody}}, true, Sync) ->
+    case Sync of
+        true ->
+            {Ref, {ok, {StatusLine, Headers, BinBody}}};
+        _ ->
+            {Ref, {StatusLine, Headers, BinBody}}
+        end;
+do_format_answer({Ref, {StatusLine, _, BinBody}}, false, Sync) ->
+        {_, Status, _} = StatusLine,
+    case Sync of
+        true ->
+            {Ref, {ok, {Status, BinBody}}};
+        _ ->
+            {Ref, {Status, BinBody}}
+    end;
+do_format_answer({Ref, {error, _Reason} = Error}, _, _) ->
+    {Ref, Error}.
+
 clobber_and_retry(#state{session = #session{id = Id,
                                             type = Type},
                          profile_name = ProfileName,
diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl
index 344b6a2620..9114fda335 100644
--- a/lib/inets/src/http_client/httpc_internal.hrl
+++ b/lib/inets/src/http_client/httpc_internal.hrl
@@ -117,7 +117,8 @@
 	  timer         :: undefined | reference(),
 	  socket_opts,   % undefined | [socket_option()]
 	  unix_socket,   % undefined | string()
-	  ipv6_host_with_brackets % boolean()
+	  ipv6_host_with_brackets, % boolean()
+	  request_options :: undefined | proplists:proplist()
 	}
        ).
 -type request() :: #request{}.
diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl
index fc48adec44..23c7156c02 100644
--- a/lib/inets/src/http_client/httpc_request.erl
+++ b/lib/inets/src/http_client/httpc_request.erl
@@ -55,31 +55,33 @@ send(SendAddr, #session{socket = Socket, socket_type = SocketType},
 send(SendAddr, #session{socket = Socket, socket_type = SocketType}, Request) ->
     send(SendAddr, Socket, SocketType, Request).
     
-send(SendAddr, Socket, SocketType, 
-     #request{method        = Method, 
-	      path          = Path, 
-	      pquery        = Query, 
-	      headers       = Headers,
-	      content       = Content, 
-	      address       = Address, 
-	      abs_uri       = AbsUri, 
-	      headers_as_is = HeadersAsIs,
-	      settings      = HttpOptions, 
-	      userinfo      = UserInfo}) -> 
+send(SendAddr, Socket, SocketType,
+     #request{method        = Method,
+	      path              = Path,
+	      pquery            = Query,
+	      headers           = Headers,
+	      content           = Content,
+	      address           = Address,
+	      abs_uri           = AbsUri,
+	      headers_as_is     = HeadersAsIs,
+	      settings          = HttpOptions,
+	      userinfo          = UserInfo,
+	      request_options   = Options}) ->
     
-    ?hcrt("send", 
-	  [{send_addr,     SendAddr}, 
-	   {socket,        Socket}, 
-	   {method,        Method}, 
-	   {path,          Path}, 
-	   {pquery,        Query}, 
-	   {headers,       Headers},
-	   {content,       Content}, 
-	   {address,       Address}, 
-	   {abs_uri,       AbsUri}, 
-	   {headers_as_is, HeadersAsIs},
-	   {settings,      HttpOptions}, 
-	   {userinfo,      UserInfo}]),
+    ?hcrt("send",
+	  [{send_addr,              SendAddr},
+	   {socket,                 Socket},
+	   {method,                 Method},
+	   {path,                   Path},
+	   {pquery,                 Query},
+	   {headers,                Headers},
+	   {content,                Content},
+	   {address,                Address},
+	   {abs_uri,                AbsUri},
+	   {headers_as_is,          HeadersAsIs},
+	   {settings,               HttpOptions},
+	   {userinfo,               UserInfo},
+	   {request_options,        Options}]),
 
     TmpHdrs = handle_user_info(UserInfo, Headers),
 
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index a76cf8a45a..a3149e7f26 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -570,7 +570,18 @@ async(Config) when is_list(Config) ->
 		ct:fail(Msg)
 	end,
     inets_test_lib:check_body(binary_to_list(Body)),
-
+    %% Check full result false option for async request
+    {ok, RequestId2} =
+        httpc:request(get, Request, [?SSL_NO_VERIFY], [{sync, false},
+                                                       {full_result, false}], ?profile(Config)),
+    Body2 =
+        receive
+            {http, {RequestId2, {200, BinBody2}}} ->
+                BinBody2;
+            {http, Msg2} ->
+                ct:fail(Msg2)
+        end,
+    inets_test_lib:check_body(binary_to_list(Body2)),
     {ok, NewRequestId} =
 	httpc:request(get, Request, [], [{sync, false}]),
     ok = httpc:cancel_request(NewRequestId).
-- 
2.43.0

openSUSE Build Service is sponsored by