From 23d5c7df36b2a06c0d9199da6efd3baa39a5d0bd Mon Sep 17 00:00:00 2001 From: Jakub Witczak Date: Fri, 31 May 2024 17:15:40 +0200 Subject: [PATCH] ssh: do_start_subsystem added, skip system_sup for client --- lib/ssh/src/ssh.erl | 11 ++- lib/ssh/src/ssh_info.erl | 40 ++++++++--- lib/ssh/src/ssh_system_sup.erl | 122 +++++++++++++++++---------------- lib/ssh/test/ssh_sup_SUITE.erl | 19 +++-- 4 files changed, 107 insertions(+), 85 deletions(-) diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 2bc1bb4621f2..d7fa6f72ad08 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -610,8 +610,7 @@ daemon(Host0, Port0, UserOptions0) when 0 =< Port0, Port0 =< 65535, %% throws error:Error if no usable hostkey is found ssh_connection_handler:available_hkey_algorithms(server, Options1), - ssh_system_sup:start_system(server, - #address{address = Host, + ssh_system_sup:start_system(#address{address = Host, port = Port, profile = ?GET_OPT(profile,Options1)}, Options1) @@ -799,8 +798,7 @@ stop_listener(Address, Port, Profile) -> lists:foreach(fun({Sup,_Addr}) -> stop_listener(Sup) end, - ssh_system_sup:addresses(server, - #address{address=Address, + ssh_system_sup:addresses(#address{address=Address, port=Port, profile=Profile})). @@ -808,7 +806,7 @@ stop_listener(Address, Port, Profile) -> -spec stop_daemon(DaemonRef::daemon_ref()) -> ok. stop_daemon(SysSup) -> - ssh_system_sup:stop_system(server, SysSup). + ssh_system_sup:stop_system(SysSup). -doc(#{equiv => stop_daemon/3}). @@ -826,8 +824,7 @@ stop_daemon(Address, Port, Profile) -> lists:foreach(fun({Sup,_Addr}) -> stop_daemon(Sup) end, - ssh_system_sup:addresses(server, - #address{address=Address, + ssh_system_sup:addresses(#address{address=Address, port=Port, profile=Profile})). diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index ec8f32f9eb0d..bcf34f7e7306 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -132,13 +132,25 @@ format_sup(server, {{{ssh_system_sup,LocalAddress},Pid,supervisor,[ssh_system_su walk_tree(server, Children, ?inc(Indent)), io_lib:nl() % Separate system supervisors by an empty line ]; -format_sup(client, {{{ssh_system_sup,LocalAddress},Pid,supervisor,[ssh_system_sup]}, _Spec, Children}, Indent) -> - [indent(Indent), - io_lib:format("Local: ~s sys_sup=~s~n", [format_address(LocalAddress), print_pid(Pid)]), - walk_tree(client, Children, ?inc(Indent)), - io_lib:nl() % Separate system supervisors by an empty line +format_sup(client, + {{Ref,SubSysSup,supervisor,[ssh_subsystem_sup]}, _SubSysSpec, + [{{connection,ConnPid,worker,[ssh_connection_handler]}, _ConnSpec} + | Children] + }, + Indent) when is_reference(Ref) -> + [io_lib:format("~sLocal: ~s~n" + "~sRemote: ~s (Version: ~s)~n" + "~sConnectionRef=~s, subsys_sup=~s~n", + [indent(Indent), local_addr(ConnPid), + indent(Indent), peer_addr(ConnPid), peer_version(client,ConnPid), + indent(Indent), print_pid(ConnPid), print_pid(SubSysSup) + ]), + walk_tree(client, + [{H,{connref,ConnPid},Cs} || {H,_,Cs} <- Children], + ?inc(Indent)), + io_lib:nl() % Separate sub system supervisors by an empty line ]; -format_sup(Role, +format_sup(server, {{Ref,SubSysSup,supervisor,[ssh_subsystem_sup]}, _SubSysSpec, [{{connection,ConnPid,worker,[ssh_connection_handler]}, _ConnSpec} | Children] @@ -146,10 +158,10 @@ format_sup(Role, Indent) when is_reference(Ref) -> [io_lib:format("~sRemote: ~s (Version: ~s)~n" "~sConnectionRef=~s, subsys_sup=~s~n", - [indent(Indent), peer_addr(ConnPid), peer_version(Role,ConnPid), + [indent(Indent), peer_addr(ConnPid), peer_version(server,ConnPid), indent(Indent), print_pid(ConnPid), print_pid(SubSysSup) ]), - walk_tree(Role, + walk_tree(server, [{H,{connref,ConnPid},Cs} || {H,_,Cs} <- Children], ?inc(Indent)), io_lib:nl() % Separate sub system supervisors by an empty line @@ -251,7 +263,17 @@ peer_addr(Pid) -> catch _:_ -> "?" end. - + +local_addr(Pid) -> + try + [{socket,Socket}] = + ssh_connection_handler:connection_info(Pid, [socket]), + {ok, AddrPort} = inet:sockname(Socket), + ssh_lib:format_address_port(AddrPort) + catch + _:_ -> "?" + end. + format_address(#address{address=Addr, port=Port, profile=Prof}) -> io_lib:format("~s (profile ~p)", [ssh_lib:format_address_port({Addr,Port}),Prof]); diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index e7daa69fd74d..6435f2692c83 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -34,11 +34,11 @@ -export([start_link/3, stop_listener/1, - stop_system/2, - start_system/3, + stop_system/1, + start_system/2, start_subsystem/4, get_daemon_listen_address/1, - addresses/2, + addresses/1, get_options/2, get_acceptor_options/1, replace_acceptor_options/2 @@ -51,29 +51,27 @@ %%% API %%%========================================================================= -start_system(Role, Address0, Options) -> - case find_system_sup(Role, Address0) of - {ok,{SysPid,Address}} when Role =:= server-> +start_system(Address0, Options) -> + case find_system_sup(Address0) of + {ok,{SysPid,Address}} -> restart_acceptor(SysPid, Address, Options); - {ok,{SysPid,_}}-> - {ok,SysPid}; {error,not_found} -> - supervisor:start_child(sup(Role), + supervisor:start_child(sshd_sup, #{id => {?MODULE,Address0}, - start => {?MODULE, start_link, [Role, Address0, Options]}, + start => {?MODULE, start_link, [server, Address0, Options]}, restart => temporary, type => supervisor }) end. %%%---------------------------------------------------------------- -stop_system(Role, SysSup) when is_pid(SysSup) -> - case lists:keyfind(SysSup, 2, supervisor:which_children(sup(Role))) of - {{?MODULE, Id}, SysSup, _, _} -> stop_system(Role, Id); +stop_system(SysSup) when is_pid(SysSup) -> + case lists:keyfind(SysSup, 2, supervisor:which_children(sup(server))) of + {{?MODULE, Id}, SysSup, _, _} -> stop_system(Id); false -> ok end; -stop_system(Role, Id) -> - supervisor:terminate_child(sup(Role), {?MODULE, Id}). +stop_system(Id) -> + supervisor:terminate_child(sup(server), {?MODULE, Id}). %%%---------------------------------------------------------------- @@ -96,42 +94,49 @@ get_daemon_listen_address(SystemSup) -> end. %%%---------------------------------------------------------------- -%%% Start the subsystem child. It is a child of the system supervisor (callback = this module) -start_subsystem(Role, Address=#address{}, Socket, Options0) -> - Options = ?PUT_INTERNAL_OPT([{user_pid, self()}], Options0), +%%% Start the subsystem child. It is a significant child of the system +%%% supervisor (callback = this module) for server and non-significant +%%% child of sshc_sup for client +start_subsystem(Role = client, _, Socket, Options) -> + do_start_subsystem(Role, sup(client), false, Socket, Options); +start_subsystem(Role = server, Address=#address{}, Socket, Options) -> + case get_system_sup(Address, Options) of + {ok, SysPid} -> + do_start_subsystem(Role, SysPid, true, Socket, Options); + Others -> + Others + end. + +do_start_subsystem(Role, SupPid, Significant, Socket, Options0) -> Id = make_ref(), - case get_system_sup(Role, Address, Options) of - {ok,SysPid} -> - case supervisor:start_child(SysPid, - #{id => Id, - start => {ssh_subsystem_sup, start_link, - [Role,Id,Socket,Options] - }, - restart => temporary, - significant => true, - type => supervisor - }) - of - {ok,_SubSysPid} -> - try - receive - {new_connection_ref, Id, ConnPid} -> - ssh_connection_handler:takeover(ConnPid, Role, Socket, Options) - after 10000 -> - error(timeout) - end - catch - error:{badmatch,{error,Error}} -> - {error,Error}; - error:timeout -> - %% The connection was started, but the takover procedure timed out, - %% therefore it exists a subtree, but it is not quite ready and - %% must be removed (by the supervisor above): - supervisor:terminate_child(SysPid, Id), - {error, connection_start_timeout} - end; - Others -> - Others + Options = ?PUT_INTERNAL_OPT([{user_pid, self()}], Options0), + case supervisor:start_child(SupPid, + #{id => Id, + start => {ssh_subsystem_sup, start_link, + [Role,Id,Socket,Options] + }, + restart => temporary, + significant => Significant, + type => supervisor + }) + of + {ok,_SubSysPid} -> + try + receive + {new_connection_ref, Id, ConnPid} -> + ssh_connection_handler:takeover(ConnPid, Role, Socket, Options) + after 10000 -> + error(timeout) + end + catch + error:{badmatch,{error,Error}} -> + {error,Error}; + error:timeout -> + %% The connection was started, but the takover procedure timed out, + %% therefore it exists a subtree, but it is not quite ready and + %% must be removed (by the supervisor above): + supervisor:terminate_child(SupPid, Id), + {error, connection_start_timeout} end; Others -> Others @@ -142,9 +147,9 @@ start_link(Role, Address, Options) -> supervisor:start_link(?MODULE, [Role, Address, Options]). %%%---------------------------------------------------------------- -addresses(Role, #address{address=Address, port=Port, profile=Profile}) -> +addresses(#address{address=Address, port=Port, profile=Profile}) -> [{SysSup,A} || {{ssh_system_sup,A},SysSup,supervisor,_} <- - supervisor:which_children(sup(Role)), + supervisor:which_children(sshd_sup), Address == any orelse A#address.address == Address, Port == any orelse A#address.port == Port, Profile == any orelse A#address.profile == Profile]. @@ -228,19 +233,20 @@ acceptor_sup_child_spec(SysSup, Address, Options) -> lookup(SupModule, SystemSup) -> lists:keyfind([SupModule], 4, supervisor:which_children(SystemSup)). -get_system_sup(Role, Address0, Options) -> - case find_system_sup(Role, Address0) of +get_system_sup(Address0, Options) -> + case find_system_sup(Address0) of {ok,{SysPid,_Address}} -> {ok,SysPid}; {error,not_found} -> - start_system(Role, Address0, Options); + start_system(Address0, Options); {error,Error} -> {error,Error} end. -find_system_sup(Role, Address0) -> - case addresses(Role, Address0) of - [{SysSupPid,Address}] -> {ok,{SysSupPid,Address}}; +find_system_sup(Address0) -> + case addresses(Address0) of + [{SysSupPid,Address}] -> + {ok,{SysSupPid,Address}}; [] -> {error,not_found}; [_,_|_] -> {error,ambiguous} end. diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index ebbe10ab189c..66b5fd8c0bc4 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -129,25 +129,22 @@ sshc_subtree(Config) when is_list(Config) -> {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - ?wait_match([?SYSTEM_SUP(SysSup, - #address{address=LocalIP, - port=LocalPort, - profile=?DEFAULT_PROFILE})], + ?wait_match([?SUB_SYSTEM_SUP(SubSysSup)], supervisor:which_children(sshc_sup), - [SysSup, LocalIP, LocalPort]), - check_sshc_system_tree(SysSup, Pid1, LocalIP, LocalPort, Config), + [SubSysSup]), + check_sshc_system_tree(SubSysSup, Pid1, Config), Pid2 = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {save_accepted_host, false}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - ?wait_match([?SYSTEM_SUP(_,_), - ?SYSTEM_SUP(_,_) + ?wait_match([?SUB_SYSTEM_SUP(_), + ?SUB_SYSTEM_SUP(_) ], supervisor:which_children(sshc_sup)), ssh:close(Pid1), - ?wait_match([?SYSTEM_SUP(_,_) + ?wait_match([?SUB_SYSTEM_SUP(_) ], supervisor:which_children(sshc_sup)), ssh:close(Pid2), @@ -415,9 +412,9 @@ check_sshd_system_tree(Daemon, Host, Port, Config) -> ssh:close(ClientConn). -check_sshc_system_tree(SysSup, Connection, _LocalIP, _LocalPort, _Config) -> +check_sshc_system_tree(SubSysSup, Connection, _Config) -> ?wait_match([?SUB_SYSTEM_SUP(SubSysSup)], - supervisor:which_children(SysSup), + supervisor:which_children(sshc_sup), [SubSysSup]), ?wait_match([{_,FwdAccSup, supervisor,[ssh_tcpip_forward_acceptor_sup]}, {_,_,supervisor,[ssh_channel_sup]},