From b08cff5c758933b23fbac229a70ea9fcf7cd39ae Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Thu, 10 Aug 2023 15:08:44 +0200 Subject: [PATCH] inets: testcode cleanup --- lib/inets/test/httpc_SUITE.erl | 141 --------------------------------- lib/inets/test/inets_SUITE.erl | 47 ++--------- 2 files changed, 6 insertions(+), 182 deletions(-) diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 24858d9d62f8..de4d9329ecef 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -2265,7 +2265,6 @@ keep_alive_requests(Request, Profile) -> ct:log("Cancel ~p~n", [RequestIdB1]), receive_replys([RequestIdB0, RequestIdB2]). - receive_replys([]) -> ok; receive_replys([ID|IDs]) -> @@ -2276,8 +2275,6 @@ receive_replys([ID|IDs]) -> ct:pal("~p",[{recived_canceld_id, Other}]) end. - - inet_version() -> inet. %% Just run inet for now %% case gen_tcp:listen(0,[inet6]) of @@ -2288,119 +2285,6 @@ inet_version() -> %% inet %%end. -dummy_server(Inet) -> - dummy_server(self(), ip_comm, Inet, []). - -dummy_server(SocketType, Inet, Extra) -> - dummy_server(self(), SocketType, Inet, Extra). - -dummy_server(Caller, SocketType, Inet, Extra) -> - Args = [Caller, SocketType, Inet, Extra], - Pid = spawn(httpc_SUITE, dummy_server_init, Args), - receive - {port, Port} -> - {Pid, Port} - end. - -dummy_server_init(Caller, ip_comm, Inet, _) -> - BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {keepalive, true}, {active, false}], - {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), - {ok, Port} = inet:port(ListenSocket), - Caller ! {port, Port}, - dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, - {max_header, ?HTTP_MAX_HEADER_SIZE}, - {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, - {customize, httpd_custom} - ]]}, - [], ListenSocket); - -dummy_server_init(Caller, ssl, Inet, SSLOptions) -> - BaseOpts = [binary, {reuseaddr,true}, {active, false} | - SSLOptions], - dummy_ssl_server_init(Caller, BaseOpts, Inet). - -dummy_ssl_server_init(Caller, BaseOpts, Inet) -> - {ok, ListenSocket} = ssl:listen(0, [Inet | BaseOpts]), - {ok, {_, Port}} = ssl:sockname(ListenSocket), - Caller ! {port, Port}, - dummy_ssl_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, - {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, - {customize, httpd_custom} - ]]}, - [], ListenSocket). - -dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> - receive - stop -> - lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); - {stop, From} -> - Stopper = fun(Handler) -> Handler ! stop end, - lists:foreach(Stopper, Handlers), - From ! {stopped, self()} - after 0 -> - {ok, Socket} = gen_tcp:accept(ListenSocket), - HandlerPid = dummy_request_handler(MFA, Socket), - gen_tcp:controlling_process(Socket, HandlerPid), - HandlerPid ! ipcomm_controller, - dummy_ipcomm_server_loop(MFA, [HandlerPid | Handlers], - ListenSocket) - end. - -dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> - receive - stop -> - lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); - {stop, From} -> - Stopper = fun(Handler) -> Handler ! stop end, - lists:foreach(Stopper, Handlers), - From ! {stopped, self()} - after 0 -> - {ok, Tsocket} = ssl:transport_accept(ListenSocket), - {ok, Ssocket} = ssl:handshake(Tsocket, infinity), - HandlerPid = dummy_request_handler(MFA, Ssocket), - ssl:controlling_process(Ssocket, HandlerPid), - HandlerPid ! ssl_controller, - dummy_ssl_server_loop(MFA, [HandlerPid | Handlers], - ListenSocket) - end. - -dummy_request_handler(MFA, Socket) -> - spawn(httpc_SUITE, dummy_request_handler_init, [MFA, Socket]). - -dummy_request_handler_init(MFA, Socket) -> - SockType = - receive - ipcomm_controller -> - inet:setopts(Socket, [{active, true}]), - ip_comm; - ssl_controller -> - ssl:setopts(Socket, [{active, true}]), - ssl - end, - dummy_request_handler_loop(MFA, SockType, Socket). - -dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> - receive - {Proto, _, Data} when (Proto =:= tcp) orelse (Proto =:= ssl) -> - case handle_request(Module, Function, [Data | Args], Socket) of - stop when Proto =:= tcp -> - gen_tcp:close(Socket); - stop when Proto =:= ssl -> - ssl:close(Socket); - NewMFA -> - dummy_request_handler_loop(NewMFA, SockType, Socket) - end; - stop when SockType =:= ip_comm -> - gen_tcp:close(Socket); - stop when SockType =:= ssl -> - ssl:close(Socket) - end. - handle_request(Module, Function, Args, Socket) -> case Module:Function(Args) of {ok, Result} -> @@ -2486,31 +2370,6 @@ handle_http_msg({Method, RelUri, _, {_, Headers}, Body}, Socket, _) -> end, NextRequest. -dummy_ssl_server_hang(Caller, Inet, SslOpt) -> - Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, Inet, SslOpt]), - receive - {port, Port} -> - {Pid, Port} - end. - -dummy_ssl_server_hang_init(Caller, Inet, SslOpt) -> - {ok, ListenSocket} = - ssl:listen(0, [binary, Inet, {packet, 0}, - {reuseaddr,true}, - {active, false}] ++ SslOpt), - {ok, {_,Port}} = ssl:sockname(ListenSocket), - Caller ! {port, Port}, - {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), - dummy_ssl_server_hang_loop(AcceptSocket). - -dummy_ssl_server_hang_loop(_) -> - %% Do not do ssl:handshake as we - %% want to time out the underlying gen_tcp:connect - receive - stop -> - ok - end. - ensure_host_header_with_port([]) -> false; ensure_host_header_with_port([{"host", Host}| _]) -> diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl index 96b7847ed1ea..f63b69297cb0 100644 --- a/lib/inets/test/inets_SUITE.erl +++ b/lib/inets/test/inets_SUITE.erl @@ -45,57 +45,22 @@ groups() -> ]}, {app_test, [], [app, appup]}]. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(_Config) -> ok. -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(_Case, Config) -> inets:stop(), Config. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- end_per_testcase(_, Config) -> Config.