diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 96d5cd250d1a..dd10481fab1c 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -802,14 +802,16 @@ handle_request(Method, Url, socket_opts = SocketOpts, started = Started, unix_socket = UnixSocket, - ipv6_host_with_brackets = BracketedHost}, - case httpc_manager:request(Request, profile_name(Profile)) of - {ok, RequestId} -> - handle_answer(RequestId, Sync, Options); - {error, Reason} -> - {error, Reason} - end - end + ipv6_host_with_brackets = BracketedHost, + request_options = Options}, + case httpc_manager:request(Request, profile_name(Profile)) of + {ok, RequestId} -> + handle_answer(RequestId, Receiver, Sync, Options, + element(#http_options.timeout, HTTPOptions)); + {error, Reason} -> + {error, Reason} + end + end catch error:{noproc, _} -> {error, {not_started, Profile}}; @@ -861,26 +863,41 @@ mk_chunkify_fun(ProcessBody) -> end. -handle_answer(RequestId, false, _) -> +handle_answer(RequestId, _, false, _, _) -> {ok, RequestId}; -handle_answer(RequestId, true, Options) -> +handle_answer(RequestId, ClientAlias, true, Options, Timeout) -> 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}}} -> + true = unalias(ClientAlias), + {ok, saved_to_file}; + {http, {RequestId, {error, Reason}}} -> + true = unalias(ClientAlias), + {error, Reason}; + {http, {RequestId, {ok, {StatusLine, Headers, BinBody}}}} -> + true = unalias(ClientAlias), + Body = maybe_format_body(BinBody, Options), + {ok, {StatusLine, Headers, Body}}; + {http, {RequestId, {ok, {StatusCode, BinBody}}}} -> + true = unalias(ClientAlias), + Body = maybe_format_body(BinBody, Options), + {ok, {StatusCode, Body}} + after Timeout -> + cancel_request(RequestId), + true = unalias(ClientAlias), + receive + {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}} + after 0 -> + {error, timeout} + end end. maybe_format_body(BinBody, Options) -> @@ -1069,6 +1086,8 @@ request_options_defaults() -> ok; (Value) when is_function(Value, 1) -> ok; + (Value) when is_reference(Value) -> + ok; (_) -> error end, @@ -1090,7 +1109,7 @@ request_options_defaults() -> {body_format, string, VerifyBodyFormat}, {full_result, true, VerifyFullResult}, {headers_as_is, false, VerifyHeaderAsIs}, - {receiver, self(), VerifyReceiver}, + {receiver, alias(), VerifyReceiver}, {socket_opts, undefined, VerifySocketOpts}, {ipv6_host_with_brackets, false, VerifyBrackets} ]. @@ -1144,6 +1163,7 @@ request_options([{Key, DefaultVal, Verify} | Defaults], Options, Acc) -> BodyFormat :: string() | binary() | atom(), SocketOpt :: term(), Receiver :: pid() + | reference() | fun((term()) -> term()) | { ReceiverModule::atom() , ReceiverFunction::atom() @@ -1154,6 +1174,8 @@ request_options_sanity_check(Opts) -> case proplists:get_value(receiver, Opts) of Pid when is_pid(Pid) andalso (Pid =:= self()) -> ok; + Reference when is_reference(Reference) -> + ok; BadReceiver -> throw({error, {bad_options_combo, [{sync, true}, {receiver, BadReceiver}]}}) diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 2dee200291da..be32ebfbad30 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -519,7 +519,6 @@ do_handle_info({Proto, _Socket, Data}, when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> - try Module:Function([Data | Args]) of {ok, Result} -> handle_http_msg(Result, State); @@ -1339,11 +1338,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), @@ -1736,3 +1736,39 @@ format_address({[$[|T], Port}) -> {Address, Port}; format_address(HostPort) -> HostPort. + +format_answer(Res, Options) -> + FullResult = proplists:get_value(full_result, Options, true), + Sync = proplists:get_value(sync, Options, true), + do_format_answer(Res, 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}. diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 344b6a262029..9114fda3352b 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 861bb5d6837d..a9fcdc944959 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -54,31 +54,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/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index 94693577e806..a3b81a6f7c2e 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -150,7 +150,7 @@ result(Response = {{_,Code,_}, _, _}, Request) when (Code div 100) =:= 5 -> result(Response, Request) -> transparent(Response, Request). -send(Receiver, Msg) when is_pid(Receiver) -> +send(Receiver, Msg) when is_pid(Receiver); is_reference(Receiver) -> Receiver ! {http, Msg}; send(Receiver, Msg) when is_function(Receiver) -> (catch Receiver(Msg)); diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 22bd55355cea..f78d8a60ab31 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -569,16 +569,29 @@ async(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, RequestId} = - httpc:request(get, Request, [], [{sync, false}]), + httpc:request(get, Request, [], [{sync, false}]), Body = - receive - {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> - BinBody; - {http, Msg} -> - ct:fail(Msg) - end, + receive + {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> + BinBody; + {http, Msg} -> + 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, [], [{sync, false}, + {full_result, false}]), + 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).