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