diff --git a/lib/compiler/test/compile_SUITE_data/ssh_connect.hrl b/lib/compiler/test/compile_SUITE_data/ssh_connect.hrl index 3165588c68df..07bbf6005f68 100644 --- a/lib/compiler/test/compile_SUITE_data/ssh_connect.hrl +++ b/lib/compiler/test/compile_SUITE_data/ssh_connect.hrl @@ -269,5 +269,5 @@ suggest_window_size, suggest_packet_size, exec, - sub_system_supervisor + connection_supervisor }). diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 5fba21655d30..a8a088eb7daf 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -80,7 +80,7 @@ MODULES= \ ssh_sftpd \ ssh_sftpd_file\ ssh_shell \ - ssh_subsystem_sup \ + ssh_connection_sup \ ssh_system_sup \ ssh_tcpip_forward_srv \ ssh_tcpip_forward_client \ diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index eb31e69db89e..93f4c2b305bf 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -36,7 +36,7 @@ ssh_sftpd, ssh_sftpd_file, ssh_sftpd_file_api, - ssh_subsystem_sup, + ssh_connection_sup, ssh_tcpip_forward_client, ssh_tcpip_forward_srv, ssh_tcpip_forward_acceptor_sup, @@ -51,7 +51,7 @@ ssh_acceptor, ssh_channel_sup, ssh_connection_handler, - ssh_subsystem_sup, + ssh_connection_sup, ssh_system_sup ]}, {default_filter, rm} %% rm | filter diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 2bc1bb4621f2..7f6d5ea02fb0 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -414,7 +414,7 @@ continue_connect(Socket, Options0, NegTimeout) -> port = SockPort, profile = ?GET_OPT(profile,Options) }, - ssh_system_sup:start_subsystem(client, Address, Socket, Options). + ssh_system_sup:start_connection(client, Address, Socket, Options). %%-------------------------------------------------------------------- -doc "Closes an SSH connection.". @@ -532,7 +532,7 @@ daemon(Socket, UserOptions) -> profile = ?GET_OPT(profile,Options0) }, Options = ?PUT_INTERNAL_OPT({connected_socket, Socket}, Options0), - case ssh_system_sup:start_subsystem(server, Address, Socket, Options) of + case ssh_system_sup:start_connection(server, Address, Socket, Options) of {ok,Pid} -> {ok,Pid}; {error, {already_started, _}} -> @@ -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_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 32f1406fa2d2..1831e32f6cd4 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -191,7 +191,7 @@ handle_connection(Address, Port, _Peer, Options, Socket, _MaxSessions, _NumSessi handle_connection(Address, Port, Options0, Socket) -> Options = ?PUT_INTERNAL_OPT([{user_pid, self()} ], Options0), - ssh_system_sup:start_subsystem(server, + ssh_system_sup:start_connection(server, #address{address = Address, port = Port, profile = ?GET_OPT(profile,Options) @@ -247,7 +247,7 @@ handle_error(Reason, ToAddress, ToPort, FromAddress, FromPort) -> %%%---------------------------------------------------------------- number_of_connections(SysSupPid) -> - lists:foldl(fun({_Ref,_Pid,supervisor,[ssh_subsystem_sup]}, N) -> N+1; + lists:foldl(fun({_Ref,_Pid,supervisor,[ssh_connection_sup]}, N) -> N+1; (_, N) -> N end, 0, supervisor:which_children(SysSupPid)). diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index e9e924d128a0..c0ed00725c31 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -269,5 +269,5 @@ suggest_window_size, suggest_packet_size, exec, - sub_system_supervisor + connection_supervisor }). diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 8849f29575cc..424a6e25837c 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -886,7 +886,7 @@ handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip", suggest_window_size = WinSz, suggest_packet_size = PktSz, options = Options, - sub_system_supervisor = SubSysSup + connection_supervisor = ConnectionSup } = C, client, _SSH) -> {ReplyMsg, NextChId} = @@ -894,7 +894,7 @@ handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip", {ok, {ConnectToHost,ConnectToPort}} -> case gen_tcp:connect(ConnectToHost, ConnectToPort, [{active,false}, binary]) of {ok,Sock} -> - {ok,Pid} = ssh_subsystem_sup:start_channel(client, SubSysSup, self(), + {ok,Pid} = ssh_connection_sup:start_channel(client, ConnectionSup, self(), ssh_tcpip_forward_client, ChId, [Sock], undefined, Options), ssh_client_channel:cache_update(Cache, @@ -944,7 +944,7 @@ handle_msg(#ssh_msg_channel_open{channel_type = "direct-tcpip", suggest_window_size = WinSz, suggest_packet_size = PktSz, options = Options, - sub_system_supervisor = SubSysSup + connection_supervisor = ConnectionSup } = C, server, _SSH) -> {ReplyMsg, NextChId} = @@ -960,7 +960,7 @@ handle_msg(#ssh_msg_channel_open{channel_type = "direct-tcpip", case gen_tcp:connect(binary_to_list(HostToConnect), PortToConnect, [{active,false}, binary]) of {ok,Sock} -> - {ok,Pid} = ssh_subsystem_sup:start_channel(server, SubSysSup, self(), + {ok,Pid} = ssh_connection_sup:start_channel(server, ConnectionSup, self(), ssh_tcpip_forward_srv, ChId, [Sock], undefined, Options), ssh_client_channel:cache_update(Cache, @@ -1192,8 +1192,8 @@ handle_msg(#ssh_msg_global_request{name = <<"tcpip-forward">>, {[{connection_reply, request_failure_msg()}], Connection}; true -> - SubSysSup = ?GET_INTERNAL_OPT(subsystem_sup, Opts), - FwdSup = ssh_subsystem_sup:tcpip_fwd_supervisor(SubSysSup), + ConnectionSup = ?GET_INTERNAL_OPT(connection_sup, Opts), + FwdSup = ssh_connection_sup:tcpip_fwd_supervisor(ConnectionSup), ConnPid = self(), case ssh_tcpip_forward_acceptor:supervised_start(FwdSup, {ListenAddrStr, ListenPort}, @@ -1423,22 +1423,22 @@ setup_session(#connection{channel_cache = Cache, start_cli(#connection{options = Options, cli_spec = CliSpec, exec = Exec, - sub_system_supervisor = SubSysSup}, ChannelId) -> + connection_supervisor = ConnectionSup}, ChannelId) -> case CliSpec of no_cli -> {error, cli_disabled}; {CbModule, Args} -> - ssh_subsystem_sup:start_channel(server, SubSysSup, self(), CbModule, ChannelId, Args, Exec, Options) + ssh_connection_sup:start_channel(server, ConnectionSup, self(), CbModule, ChannelId, Args, Exec, Options) end. start_subsystem(BinName, #connection{options = Options, - sub_system_supervisor = SubSysSup}, + connection_supervisor = ConnectionSup}, #channel{local_id = ChannelId}, _ReplyMsg) -> Name = binary_to_list(BinName), case check_subsystem(Name, Options) of {Callback, Opts} when is_atom(Callback), Callback =/= none -> - ssh_subsystem_sup:start_channel(server, SubSysSup, self(), Callback, ChannelId, Opts, undefined, Options); + ssh_connection_sup:start_channel(server, ConnectionSup, self(), Callback, ChannelId, Opts, undefined, Options); {none, _} -> {error, bad_subsystem}; {_, _} -> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 12db85d015fb..1c25e171ba5b 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -43,7 +43,7 @@ %%==================================================================== %%% Start and stop --export([start_link/4, start_link/5, +-export([start_link/3, start_link/4, takeover/4, stop/1 ]). @@ -99,10 +99,10 @@ %% Start / stop %%==================================================================== -start_link(Role, Address, Socket, Options) -> - start_link(Role, Address, undefined, Socket, Options). +start_link(Role, Socket, Options) -> + start_link(Role, undefined, Socket, Options). -start_link(Role, _Address=#address{}, Id, Socket, Options) -> +start_link(Role, Id, Socket, Options) -> case gen_statem:start_link(?MODULE, [Role, Socket, Options], [{spawn_opt, [{message_queue_data,off_heap}]}]) of @@ -111,7 +111,7 @@ start_link(Role, _Address=#address{}, Id, Socket, Options) -> %% Announce the ConnectionRef to the system supervisor so it could %% 1) initiate the socket handover, and %% 2) be returned to whoever called for example ssh:connect; the Pid - %% returned from this function is "consumed" by the subsystem + %% returned from this function is "consumed" by the connection %% supervisor. ?GET_INTERNAL_OPT(user_pid,Options) ! {new_connection_ref, Id, Pid}, {ok, Pid}; @@ -197,8 +197,8 @@ open_channel(ConnectionHandler, %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . start_channel(ConnectionHandler, CallbackModule, ChannelId, Args, Exec) -> - {ok, {SubSysSup,Role,Opts}} = call(ConnectionHandler, get_misc), - ssh_subsystem_sup:start_channel(Role, SubSysSup, + {ok, {ConnectionSup,Role,Opts}} = call(ConnectionHandler, get_misc), + ssh_connection_sup:start_channel(Role, ConnectionSup, ConnectionHandler, CallbackModule, ChannelId, Args, Exec, Opts). @@ -418,7 +418,7 @@ init_connection_record(Role, Socket, Opts) -> suggest_packet_size = PktSz, requests = [], options = Opts, - sub_system_supervisor = ?GET_INTERNAL_OPT(subsystem_sup, Opts) + connection_supervisor = ?GET_INTERNAL_OPT(connection_sup, Opts) }, case Role of server -> @@ -1022,8 +1022,8 @@ handle_event({call,From}, {eof, ChannelId}, StateName, D0) handle_event({call,From}, get_misc, StateName, #data{connection_state = #connection{options = Opts}} = D) when ?CONNECTED(StateName) -> - SubSysSup = ?GET_INTERNAL_OPT(subsystem_sup, Opts), - Reply = {ok, {SubSysSup, ?role(StateName), Opts}}, + ConnectionSup = ?GET_INTERNAL_OPT(connection_sup, Opts), + Reply = {ok, {ConnectionSup, ?role(StateName), Opts}}, {keep_state, D, [{reply,From,Reply}]}; handle_event({call,From}, @@ -1286,9 +1286,9 @@ handle_event(info, check_cache, _, D) -> handle_event(info, {fwd_connect_received, Sock, ChId, ChanCB}, StateName, #data{connection_state = Connection}) -> #connection{options = Options, channel_cache = Cache, - sub_system_supervisor = SubSysSup} = Connection, + connection_supervisor = ConnectionSup} = Connection, Channel = ssh_client_channel:cache_lookup(Cache, ChId), - {ok,Pid} = ssh_subsystem_sup:start_channel(?role(StateName), SubSysSup, self(), ChanCB, ChId, [Sock], undefined, Options), + {ok,Pid} = ssh_connection_sup:start_channel(?role(StateName), ConnectionSup, self(), ChanCB, ChId, [Sock], undefined, Options), ssh_client_channel:cache_update(Cache, Channel#channel{user=Pid}), gen_tcp:controlling_process(Sock, Pid), inet:setopts(Sock, [{active,once}]), @@ -1297,8 +1297,8 @@ handle_event(info, {fwd_connect_received, Sock, ChId, ChanCB}, StateName, #data{ handle_event({call,From}, {handle_direct_tcpip, ListenHost, ListenPort, ConnectToHost, ConnectToPort, _Timeout}, _StateName, - #data{connection_state = #connection{sub_system_supervisor=SubSysSup}}) -> - case ssh_tcpip_forward_acceptor:supervised_start(ssh_subsystem_sup:tcpip_fwd_supervisor(SubSysSup), + #data{connection_state = #connection{connection_supervisor=ConnectionSup}}) -> + case ssh_tcpip_forward_acceptor:supervised_start(ssh_connection_sup:tcpip_fwd_supervisor(ConnectionSup), {ListenHost, ListenPort}, {ConnectToHost, ConnectToPort}, "direct-tcpip", ssh_tcpip_forward_client, diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_connection_sup.erl similarity index 57% rename from lib/ssh/src/ssh_subsystem_sup.erl rename to lib/ssh/src/ssh_connection_sup.erl index 5b23a79c90d4..db410cf7e5f4 100644 --- a/lib/ssh/src/ssh_subsystem_sup.erl +++ b/lib/ssh/src/ssh_connection_sup.erl @@ -19,17 +19,17 @@ %% %% %%---------------------------------------------------------------------- -%% Purpose: The ssh subsystem supervisor +%% Purpose: The ssh connection supervisor %%---------------------------------------------------------------------- --module(ssh_subsystem_sup). +-module(ssh_connection_sup). -moduledoc false. -behaviour(supervisor). -include("ssh.hrl"). --export([start_link/5, +-export([start_link/4, start_channel/8, tcpip_fwd_supervisor/1 ]). @@ -40,8 +40,8 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link(Role, Address=#address{}, Id, Socket, Options) -> - case supervisor:start_link(?MODULE, [Role, Address, Id, Socket, Options]) of +start_link(Role, Id, Socket, Options) -> + case supervisor:start_link(?MODULE, [Role, Id, Socket, Options]) of {error, {shutdown, {failed_to_start_child, _, Error}}} -> {error,Error}; Other -> @@ -52,52 +52,47 @@ start_channel(Role, SupPid, ConnRef, Callback, Id, Args, Exec, Opts) -> ChannelSup = channel_supervisor(SupPid), ssh_channel_sup:start_child(Role, ChannelSup, ConnRef, Callback, Id, Args, Exec, Opts). -tcpip_fwd_supervisor(SubSysSup) -> - find_child(tcpip_forward_acceptor_sup, SubSysSup). +tcpip_fwd_supervisor(ConnectionSup) -> + find_child(tcpip_forward_acceptor_sup, ConnectionSup). %%%========================================================================= %%% Supervisor callback %%%========================================================================= -init([Role, Address, Id, Socket, Options]) -> - ssh_lib:set_label(Role, {subsystem_sup, Socket}), - SubSysSup = self(), +init([Role, Id, Socket, Options]) -> + ssh_lib:set_label(Role, {connection_sup, Socket}), + ConnectionSup = self(), SupFlags = #{strategy => one_for_all, auto_shutdown => any_significant, intensity => 0, - period => 3600 - }, - ChildSpecs = [#{id => connection, - restart => temporary, - type => worker, - significant => true, - start => {ssh_connection_handler, - start_link, - [Role, Address, Id, Socket, - ?PUT_INTERNAL_OPT([ - {subsystem_sup, SubSysSup} - ], Options) - ] - } - }, - #{id => channel_sup, - restart => temporary, - type => supervisor, - start => {ssh_channel_sup, start_link, [Options]} - }, + period => 3600}, + ChildSpecs = + [#{id => connection, + restart => temporary, + type => worker, + significant => true, + start => {ssh_connection_handler, + start_link, + [Role, Id, Socket, + ?PUT_INTERNAL_OPT([{connection_sup, ConnectionSup}], Options)]} + }, + #{id => channel_sup, + restart => temporary, + type => supervisor, + start => {ssh_channel_sup, start_link, [Options]} + }, - #{id => tcpip_forward_acceptor_sup, - restart => temporary, - type => supervisor, - start => {ssh_tcpip_forward_acceptor_sup, start_link, []} - } - ], + #{id => tcpip_forward_acceptor_sup, + restart => temporary, + type => supervisor, + start => {ssh_tcpip_forward_acceptor_sup, start_link, []} + }], {ok, {SupFlags,ChildSpecs}}. %%%========================================================================= %%% Internal functions %%%========================================================================= -channel_supervisor(SubSysSup) -> find_child(channel_sup, SubSysSup). +channel_supervisor(ConnectionSup) -> find_child(channel_sup, ConnectionSup). find_child(Id, Sup) when is_pid(Sup) -> try diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index ec8f32f9eb0d..10c3a0e07c89 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -132,24 +132,36 @@ 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,ConnSup,supervisor,[ssh_connection_sup]}, _ConnSupSpec, + [{{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(ConnSup) + ]), + 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, - {{Ref,SubSysSup,supervisor,[ssh_subsystem_sup]}, _SubSysSpec, - [{{connection,ConnPid,worker,[ssh_connection_handler]}, _ConnSpec} +format_sup(server, + {{Ref,ConnSup,supervisor,[ssh_connection_sup]}, _ConnSupSpec, + [{{connection,ConnPid,worker,[ssh_connection_handler]}, _ConnSpec} | Children] }, 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), print_pid(ConnPid), print_pid(SubSysSup) + [indent(Indent), peer_addr(ConnPid), peer_version(server,ConnPid), + indent(Indent), print_pid(ConnPid), print_pid(ConnSup) ]), - 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 91da0b4aed34..bc1d79d0f49a 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, - start_subsystem/4, + stop_system/1, + start_system/2, + start_connection/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 connection 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_connection(Role = client, _, Socket, Options) -> + do_start_connection(Role, sup(client), false, Socket, Options); +start_connection(Role = server, Address=#address{}, Socket, Options) -> + case get_system_sup(Address, Options) of + {ok, SysPid} -> + do_start_connection(Role, SysPid, true, Socket, Options); + Others -> + Others + end. + +do_start_connection(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,Address,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_connection_sup, start_link, + [Role,Id,Socket,Options] + }, + restart => temporary, + significant => Significant, + type => supervisor + }) + of + {ok,_ConnectionSupPid} -> + 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/Makefile b/lib/ssh/test/Makefile index 2c3d2a6f274e..763f8534e1bb 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -80,7 +80,8 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) SPEC_FILES = \ ssh.spec \ - ssh_bench.spec + ssh_bench.spec \ + ssh_sup.spec COVER_FILE = ssh.cover diff --git a/lib/ssh/test/ssh.cover b/lib/ssh/test/ssh.cover index daf6c723b9b9..c4cac8daf5be 100644 --- a/lib/ssh/test/ssh.cover +++ b/lib/ssh/test/ssh.cover @@ -7,7 +7,7 @@ %% %% Supervisors %% ssh_acceptor_sup, ssh_channel_sup, - %% sshc_sup, sshd_sup, ssh_subsystem_sup, ssh_sup, + %% sshc_sup, sshd_sup, ssh_connection_sup, ssh_sup, %% ssh_system_sup, ssh_tcpip_forward_acceptor_sup, %% Test and/or info modules: diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 11e6f95964c4..b6d3a244c6d1 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -228,8 +228,6 @@ end_per_group(_, Config) -> %%-------------------------------------------------------------------- init_per_testcase(_TestCase, Config) -> - %% To make sure we start clean as it is not certain that - %% end_per_testcase will be run! ssh:stop(), ssh:start(), {ok, TestLogHandlerRef} = ssh_test_lib:add_log_handler(), @@ -239,26 +237,125 @@ init_per_testcase(_TestCase, Config) -> end_per_testcase(TestCase, Config) -> {ok, Events} = ssh_test_lib:get_log_events( proplists:get_value(log_handler_ref, Config)), - EventNumber = length(Events), - VerifcationResult = verify_events(TestCase, EventNumber, Events), + EventCnt = length(Events), + {ok, InterestingEventCnt} = analyze_events(Events, EventCnt), + VerificationResult = verify_events(TestCase, InterestingEventCnt), ssh_test_lib:rm_log_handler(), ssh:stop(), - VerifcationResult. - -verify_events(_TestCase, 0, _Events) -> ok; -verify_events(gracefull_invalid_version, 1, _) -> ok; -verify_events(gracefull_invalid_start, 1, _) -> ok; -verify_events(gracefull_invalid_long_start, 1, _) -> ok; -verify_events(gracefull_invalid_long_start_no_nl, 1, _) -> ok; -verify_events(kex_error, 2, _) -> ok; -verify_events(stop_listener, 1, _) -> ok; -verify_events(no_sensitive_leak, 10, _) -> ok; -verify_events(start_subsystem_on_closed_channel, 8, _) -> ok; -verify_events(max_channels_option, 11, _) -> ok; -verify_events(_TestCase, EventNumber, Events) when EventNumber > 0-> - ct:log("~nEvent number: ~p~nEvents:~n~p", [EventNumber, Events]), + VerificationResult. + +analyze_events(_, 0) -> + {ok, 0}; +analyze_events(Events, EventNumber) when EventNumber > 0 -> + {ok, Cnt} = print_interesting_events(Events, 0), + case Cnt > 0 of + true -> + ct:comment("(logger stats) interesting: ~p boring: ~p", + [Cnt, EventNumber - Cnt]); + _ -> + ct:comment("(logger stats) boring: ~p", + [length(Events)]) + end, + AllEventsSummary = lists:flatten([process_event(E) || E <- Events]), + ct:log("~nTotal logger events: ~p~nAll events:~n~s", [EventNumber, AllEventsSummary]), + {ok, Cnt}. + +process_event(#{msg := {report, + #{label := Label, + report := [{supervisor, Supervisor}, + {Status, Properties}]}}, + level := Level}) -> + format_event1(Label, Supervisor, Status, Properties, Level); +process_event(#{msg := {report, + #{label := Label, + report := [{supervisor, Supervisor}, + {errorContext, _ErrorContext}, + {reason, {Status, _ReasonDetails}}, + {offender, Properties}]}}, + level := Level}) -> + format_event1(Label, Supervisor, Status, Properties, Level); +process_event(#{msg := {report, + #{label := Label, + report := [{supervisor, Supervisor}, + {errorContext, _ErrorContext}, + {reason, Status}, + {offender, Properties}]}}, + level := Level}) -> + format_event1(Label, Supervisor, Status, Properties, Level); +process_event(#{msg := {report, + #{label := Label, + report := [Properties, []]}}, + level := Level}) -> + {status, Status} = get_value(status, Properties), + {pid, Pid} = get_value(pid, Properties), + Id = get_value(registered_name, Properties), + {initial_call, {M, F, Args}} = get_value(initial_call, Properties), + io_lib:format("[~44s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s)~n", + [io_lib:format("~p", [E]) || + E <- [Pid, Level, Label, Status, Id, M, F, Args]]); +process_event(#{msg := {report, + #{label := Label, + name := Pid, + reason := {Reason, _Stack = [{M, F, Args, Location} | _]}}}, + level := Level}) -> + io_lib:format("[~44s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s) ~30s~n", + [io_lib:format("~p", [E]) || + E <- [Pid, Level, Label, Reason, undefined, M, F, Args, Location]]); +process_event(#{msg := {report, + #{label := Label, + format := Format, + args := Args}}, + meta := #{pid := Pid}, + level := Level}) -> + io_lib:format("[~44s] ~6s ~30s ~150s~n", + [io_lib:format("~p", [E]) || + E <- [Pid, Level, Label]] ++ [io_lib:format(Format, Args)]); +process_event(E) -> + io_lib:format("~n||RAW event||~n~p~n", [E]). + +format_event1(Label, Supervisor, Status, Properties, Level) -> + {pid, Pid} = get_value(pid, Properties), + Id = get_value(id, Properties), + {M, F, Args} = get_mfa_value(Properties), + RestartType = get_value(restart_type, Properties), + Significant = get_value(significant, Properties), + io_lib:format("[~30s <- ~10s] ~6s ~30s ~20s ~30s ~20s:~10s(~40s) ~20s ~25s~n", + [io_lib:format("~p", [E]) || + E <- [Supervisor, Pid, Level, Label, Status, Id, M, F, Args, + Significant, RestartType]]). + +get_mfa_value(Properties) -> + case get_value(mfargs, Properties) of + {mfargs, MFA} -> + MFA; + false -> + {mfa, MFA} = get_value(mfa, Properties), + MFA + end. + +get_value(Key, List) -> + case lists:keyfind(Key, 1, List) of + R = false -> + ct:log("Key ~p not found in~n~p", [Key, List]), + R; + R -> R + end. + +print_interesting_events([], Cnt) -> + {ok, Cnt}; +print_interesting_events([#{level := Level} = Event | Tail], Cnt) + when Level /= info, Level /= notice -> + ct:log("------------~nInteresting event found:~n~p~n==========~n", [Event]), + print_interesting_events(Tail, Cnt + 1); +print_interesting_events([_|Tail], Cnt) -> + print_interesting_events(Tail, Cnt). + +verify_events(_TestCase, 0) -> ok; +verify_events(no_sensitive_leak, 1) -> ok; +verify_events(max_channels_option, 3) -> ok; +verify_events(_TestCase, EventNumber) when EventNumber > 0-> {fail, lists:flatten( - io_lib:format("Unexpected ~s events found", + io_lib:format("unexpected event cnt: ~s", [integer_to_list(EventNumber)]))}. %%-------------------------------------------------------------------- @@ -659,6 +756,15 @@ ptty_alloc_pixel(Config) when is_list(Config) -> ssh:close(ConnectionRef). %%-------------------------------------------------------------------- +%%- small_interrupted_send is interrupted by ssh_echo_server which is +%% done with transferring data towards client and terminates the +%% channel (this results with {error, closed} return value from +%% ssh_connection:send on the client side) +%%- interrupted_send used to be interrupted when ssh_echo_server ran +%% out of data window and closed channel +%%- but with automatic window adjustment, above condition is not taking +%% place, so ssh_echo_server continues sending data until it is done +%%- so ssh_connection:send returns 'ok' small_interrupted_send(Config) -> K = 1024, SendSize = 10 * K * K, diff --git a/lib/ssh/test/ssh_limited.cover b/lib/ssh/test/ssh_limited.cover index 29c0121ae1ff..64904c9ce737 100644 --- a/lib/ssh/test/ssh_limited.cover +++ b/lib/ssh/test/ssh_limited.cover @@ -9,7 +9,7 @@ %% Supervisors ssh_acceptor_sup, ssh_channel_sup, - sshc_sup, sshd_sup, ssh_subsystem_sup, ssh_sup, + sshc_sup, sshd_sup, ssh_connection_sup, ssh_sup, ssh_system_sup, ssh_tcpip_forward_acceptor_sup, %% Test and/or info modules: diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index aca777774a72..425d78f20b4e 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -1259,7 +1259,7 @@ find_handshake_parent([{{ssh_acceptor_sup,{address,_,Port,_}}, {Parents,Handshakers} = lists:unzip(ParentHandshakers), find_handshake_parent(T, Port, {AccP++Parents, AccC, AccH++Handshakers}); -find_handshake_parent([{_Ref,PidS,supervisor,[ssh_subsystem_sup]}|T], Port, {AccP,AccC,AccH}) -> +find_handshake_parent([{_Ref,PidS,supervisor,[ssh_connection_sup]}|T], Port, {AccP,AccC,AccH}) -> Connections = [Pid || {connection,Pid,worker,[ssh_connection_handler]} <- supervisor:which_children(PidS)], find_handshake_parent(T, Port, {AccP, AccC++Connections, AccH}); diff --git a/lib/ssh/test/ssh_sup.spec b/lib/ssh/test/ssh_sup.spec new file mode 100644 index 000000000000..4d11437f77cc --- /dev/null +++ b/lib/ssh/test/ssh_sup.spec @@ -0,0 +1,5 @@ +{suites,"../ssh_test", + [ssh_sup_SUITE, ssh_connection_SUITE, ssh_to_openssh_SUITE]}. +{event_handler, {cte_track, []}}. +{enable_builtin_hooks, false}. +{ct_hooks, [{cth_log_redirect, [{mode, replace}]}]}. diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index ebbe10ab189c..ca85bcd99a7e 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -50,7 +50,7 @@ -define(SSHD_SUP(Pid), {sshd_sup, Pid, supervisor, [supervisor]}). -define(SYSTEM_SUP(Pid,Address), {{ssh_system_sup, Address}, Pid, supervisor,[ssh_system_sup]}). --define(SUB_SYSTEM_SUP(Pid), {_,Pid, supervisor,[ssh_subsystem_sup]}). +-define(CONNECTION_SUP(Pid), {_,Pid, supervisor,[ssh_connection_sup]}). -define(ACCEPTOR_SUP(Pid,Address), {{ssh_acceptor_sup,Address},Pid,supervisor,[ssh_acceptor_sup]}). -define(ACCEPTOR_WORKER(Pid,Address), @@ -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([?CONNECTION_SUP(ConnectionSup)], supervisor:which_children(sshc_sup), - [SysSup, LocalIP, LocalPort]), - check_sshc_system_tree(SysSup, Pid1, LocalIP, LocalPort, Config), + [ConnectionSup]), + check_sshc_system_tree(ConnectionSup, 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([?CONNECTION_SUP(_), + ?CONNECTION_SUP(_) ], supervisor:which_children(sshc_sup)), ssh:close(Pid1), - ?wait_match([?SYSTEM_SUP(_,_) + ?wait_match([?CONNECTION_SUP(_) ], supervisor:which_children(sshc_sup)), ssh:close(Pid2), @@ -301,7 +298,7 @@ shell_channel_tree(Config) -> {user_interaction, true}, {user_dir, UserDir}]), - [SubSysSup,_ChPid|_] = Sups0 = chk_empty_con_daemon(Daemon), + [ConnectionSup,_ChPid|_] = Sups0 = chk_empty_con_daemon(Daemon), {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), ok = ssh_connection:shell(ConnectionRef,ChannelId0), @@ -311,7 +308,7 @@ shell_channel_tree(Config) -> {_,ChSup,supervisor,[ssh_channel_sup]}, {connection,_,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup]), ?wait_match([{_,GroupPid,worker,[ssh_server_channel]} ], @@ -328,9 +325,9 @@ shell_channel_tree(Config) -> {ssh_cm,ConnectionRef, {data, ChannelId0, 0, <<"TimeoutShell started!",Rest/binary>>}} -> ct:log("TimeoutShell started. Rest = ~p", [Rest]), receive - %%---- wait for the subsystem to terminate + %%---- wait for the connection to terminate {ssh_cm,ConnectionRef,{closed,ChannelId0}} -> - ct:log("Subsystem terminated",[]), + ct:log("Connection terminated",[]), case {chk_empty_con_daemon(Daemon), process_info(GroupPid), process_info(ShellPid)} of @@ -361,23 +358,23 @@ shell_channel_tree(Config) -> end. chk_empty_con_daemon(Daemon) -> - ?wait_match([?SUB_SYSTEM_SUP(SubSysSup), + ?wait_match([?CONNECTION_SUP(ConnectionSup), ?ACCEPTOR_SUP(AccSup,_) ], supervisor:which_children(Daemon), - [SubSysSup,AccSup]), + [ConnectionSup,AccSup]), ?wait_match([{_,FwdAccSup, supervisor,[ssh_tcpip_forward_acceptor_sup]}, {_,ChSup,supervisor,[ssh_channel_sup]}, {connection,ServerConnPid,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup,FwdAccSup,ServerConnPid]), ?wait_match([], supervisor:which_children(FwdAccSup)), ?wait_match([], supervisor:which_children(ChSup)), ?wait_match([?ACCEPTOR_WORKER(_,_)], supervisor:which_children(AccSup), []), - [SubSysSup, ChSup, ServerConnPid, AccSup, FwdAccSup]. + [ConnectionSup, ChSup, ServerConnPid, AccSup, FwdAccSup]. %%------------------------------------------------------------------------- %% Help functions @@ -389,14 +386,14 @@ check_sshd_system_tree(Daemon, Host, Port, Config) -> {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - ?wait_match([?SUB_SYSTEM_SUP(SubSysSup), + ?wait_match([?CONNECTION_SUP(ConnectionSup), ?ACCEPTOR_SUP(AccSup,_)], supervisor:which_children(Daemon), - [SubSysSup,AccSup]), + [ConnectionSup,AccSup]), ?wait_match([{_,FwdAccSup, supervisor,[ssh_tcpip_forward_acceptor_sup]}, {_,_,supervisor,[ssh_channel_sup]}, {connection,ServerConn,worker,[ssh_connection_handler]}], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [FwdAccSup,ServerConn]), ?wait_match([], supervisor:which_children(FwdAccSup)), ?wait_match([?ACCEPTOR_WORKER(_,_)], supervisor:which_children(AccSup)), @@ -404,7 +401,7 @@ check_sshd_system_tree(Daemon, Host, Port, Config) -> ?wait_match([{_,FwdAccSup, supervisor,[ssh_tcpip_forward_acceptor_sup]}, {_,ChSup,supervisor,[ssh_channel_sup]}, {connection,ServerConn,worker,[ssh_connection_handler]}], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup,ServerConn]), ?wait_match([{_,PidS,worker,[ssh_server_channel]}], @@ -415,15 +412,15 @@ check_sshd_system_tree(Daemon, Host, Port, Config) -> ssh:close(ClientConn). -check_sshc_system_tree(SysSup, Connection, _LocalIP, _LocalPort, _Config) -> - ?wait_match([?SUB_SYSTEM_SUP(SubSysSup)], - supervisor:which_children(SysSup), - [SubSysSup]), +check_sshc_system_tree(ConnectionSup, Connection, _Config) -> + ?wait_match([?CONNECTION_SUP(ConnectionSup)], + supervisor:which_children(sshc_sup), + [ConnectionSup]), ?wait_match([{_,FwdAccSup, supervisor,[ssh_tcpip_forward_acceptor_sup]}, {_,_,supervisor,[ssh_channel_sup]}, {connection,Connection,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [FwdAccSup]), ?wait_match([], supervisor:which_children(FwdAccSup)), @@ -432,7 +429,7 @@ check_sshc_system_tree(SysSup, Connection, _LocalIP, _LocalPort, _Config) -> {_,ChSup,supervisor, [ssh_channel_sup]}, {connection,Connection,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup,FwdAccSup]), ?wait_match([{_,ChPid1,worker,[ssh_client_channel]} @@ -445,7 +442,7 @@ check_sshc_system_tree(SysSup, Connection, _LocalIP, _LocalPort, _Config) -> {_,ChSup,supervisor, [ssh_channel_sup]}, {connection,Connection,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup,FwdAccSup]), ?wait_match([{_,ChPid2,worker,[ssh_client_channel]}, @@ -460,7 +457,7 @@ check_sshc_system_tree(SysSup, Connection, _LocalIP, _LocalPort, _Config) -> {_,ChSup,supervisor, [ssh_channel_sup]}, {connection,Connection,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup,FwdAccSup]), ?wait_match([{_,ChPid2,worker,[ssh_client_channel]} @@ -474,7 +471,7 @@ check_sshc_system_tree(SysSup, Connection, _LocalIP, _LocalPort, _Config) -> {_,ChSup,supervisor, [ssh_channel_sup]}, {connection,Connection,worker,[ssh_connection_handler]} ], - supervisor:which_children(SubSysSup), + supervisor:which_children(ConnectionSup), [ChSup,FwdAccSup]), ?wait_match([], supervisor:which_children(ChSup)),