diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 2a346322c0f..ce538ea1d24 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -136,9 +136,8 @@ acceptor_loop(Port, Address, Opts, ListenSocket, AcceptTimeout, SystemSup) -> PeerName = inet:peername(Socket), MaxSessions = ?GET_OPT(max_sessions, Opts), NumSessions = number_of_connections(SystemSup), - ParallelLogin = ?GET_OPT(parallel_login, Opts), case handle_connection(Address, Port, PeerName, Opts, Socket, - MaxSessions, NumSessions, ParallelLogin) of + MaxSessions, NumSessions) of {error,Error} -> catch close(Socket, Opts), handle_error(Error, Address, Port, PeerName); @@ -156,33 +155,15 @@ acceptor_loop(Port, Address, Opts, ListenSocket, AcceptTimeout, SystemSup) -> %%%---------------------------------------------------------------- handle_connection(_Address, _Port, _Peer, _Options, _Socket, - MaxSessions, NumSessions, _ParallelLogin) + MaxSessions, NumSessions) when NumSessions >= MaxSessions-> {error,{max_sessions,MaxSessions}}; handle_connection(_Address, _Port, {error,Error}, _Options, _Socket, - _MaxSessions, _NumSessions, _ParallelLogin) -> + _MaxSessions, _NumSessions) -> {error,Error}; handle_connection(Address, Port, _Peer, Options, Socket, - _MaxSessions, _NumSessions, ParallelLogin) - when ParallelLogin == false -> - handle_connection(Address, Port, Options, Socket); -handle_connection(Address, Port, _Peer, Options, Socket, - _MaxSessions, _NumSessions, ParallelLogin) - when ParallelLogin == true -> - Ref = make_ref(), - Pid = spawn_link( - fun() -> - process_flag(trap_exit, true), - receive - {start,Ref} -> - handle_connection(Address, Port, Options, Socket) - after 10000 -> - {error, timeout2} - end - end), - catch gen_tcp:controlling_process(Socket, Pid), - Pid ! {start,Ref}, - ok. + _MaxSessions, _NumSessions) -> + handle_connection(Address, Port, Options, Socket). handle_connection(Address, Port, Options, Socket) -> AddressR = #address{address = Address, port = Port, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 6502fed7984..e8f7752d53e 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -52,7 +52,7 @@ -export([available_hkey_algorithms/2, open_channel/6, start_channel/5, - handshake/2, + notify_handshaker/2, handle_direct_tcpip/6, request/6, request/7, reply_request/3, @@ -128,16 +128,20 @@ takeover(ConnPid, Role, Socket, Options) -> ok end, {_, Callback, _} = ?GET_OPT(transport, Options), - case Callback:controlling_process(Socket, ConnPid) of - ok -> + ParallelLogin = ?GET_OPT(parallel_login, Options, disabled), + case {Callback:controlling_process(Socket, ConnPid), ParallelLogin} of + {ok, true} -> + gen_statem:cast(ConnPid, socket_control), + {ok, ConnPid}; + {ok, _} -> Ref = erlang:monitor(process, ConnPid), gen_statem:cast(ConnPid, socket_control), NegTimeout = ?GET_INTERNAL_OPT(negotiation_timeout, Options, ?GET_OPT(negotiation_timeout, Options) ), - handshake(ConnPid, Role, Ref, NegTimeout); - {error, Reason} -> + monitor_handshake(ConnPid, Ref, NegTimeout); + {{error, Reason}, _} -> {error, Reason} end. @@ -407,7 +411,16 @@ init([Role, Socket, Opts]) when Role==client ; Role==server -> %% ssh_params will be updated after receiving socket_control event %% in wait_for_socket state; D = #data{socket = Socket, ssh_params = #ssh{role = Role, opts = Opts}}, - {ok, {wait_for_socket, Role}, D}. + ParallelLogin = ?GET_OPT(parallel_login, Opts, disabled), + case ParallelLogin of + true -> + NegTimeout = ?GET_INTERNAL_OPT(negotiation_timeout, Opts, + ?GET_OPT(negotiation_timeout, Opts)), + {ok, {wait_for_socket, Role}, D, + [{{timeout, negotiation}, NegTimeout, close_connection}]}; + _ -> + {ok, {wait_for_socket, Role}, D} + end. %%%---------------------------------------------------------------- %%% Connection start and initialization helpers @@ -491,27 +504,7 @@ init_ssh_record(Role, Socket, PeerAddr, Opts) -> } end. -handshake(ConnPid, server, Ref, Timeout) -> - receive - {ConnPid, ssh_connected} -> - erlang:demonitor(Ref, [flush]), - {ok, ConnPid}; - {ConnPid, {not_connected, Reason}} -> - erlang:demonitor(Ref, [flush]), - {error, Reason}; - {'DOWN', Ref, process, ConnPid, {shutdown, Reason}} -> - {error, Reason}; - {'DOWN', Ref, process, ConnPid, Reason} -> - {error, Reason}; - {'EXIT',_,Reason} -> - stop(ConnPid), - {error, {exit,Reason}} - after Timeout -> - erlang:demonitor(Ref, [flush]), - ssh_connection_handler:stop(ConnPid), - {error, timeout} - end; -handshake(ConnPid, client, Ref, Timeout) -> +monitor_handshake(ConnPid, Ref, Timeout) -> receive {ConnPid, ssh_connected} -> erlang:demonitor(Ref, [flush]), @@ -529,7 +522,7 @@ handshake(ConnPid, client, Ref, Timeout) -> {error, timeout} end. -handshake(Msg, #data{starter = User}) -> +notify_handshaker(Msg, #data{starter = User}) -> User ! {self(), Msg}. %%==================================================================== @@ -721,6 +714,9 @@ handle_event(internal, {#ssh_msg_kexinit{},_}, {connected,Role}, D0) -> send_bytes(SshPacket, D), {next_state, {kexinit,Role,renegotiate}, D, [postpone, {change_callback_module,ssh_fsm_kexinit}]}; +handle_event({timeout, negotiation}, close_connection, _StateName, _D) -> + {stop, {shutdown,"Negotiation timeout."}}; + handle_event(internal, #ssh_msg_disconnect{description=Desc} = Msg, StateName, D0) -> {disconnect, _, RepliesCon} = ssh_connection:handle_msg(Msg, D0#data.connection_state, ?role(StateName), D0#data.ssh_params), @@ -762,7 +758,7 @@ handle_event(internal, {conn_msg,Msg}, StateName, #data{connection_state = Conne case {Reason0,Role} of {{_, Reason}, client} when ((StateName =/= {connected,client}) and (not Rengotation)) -> - handshake({not_connected,Reason}, D); + notify_handshaker({not_connected,Reason}, D); _ -> ok end, @@ -2107,7 +2103,7 @@ ssh_dbg_flags(disconnect) -> [c]. ssh_dbg_on(connections) -> dbg:tp(?MODULE, init, 1, x), ssh_dbg_on(terminate); ssh_dbg_on(connection_events) -> dbg:tp(?MODULE, handle_event, 4, x); -ssh_dbg_on(connection_handshake) -> dbg:tpl(?MODULE, handshake, 3, x); +ssh_dbg_on(connection_handshake) -> dbg:tpl(?MODULE, monitor_handshake, 3, x); ssh_dbg_on(renegotiation) -> dbg:tpl(?MODULE, init_renegotiate_timers, 3, x), dbg:tpl(?MODULE, pause_renegotiate_timers, 3, x), dbg:tpl(?MODULE, check_data_rekeying_dbg, 2, x), @@ -2136,7 +2132,7 @@ ssh_dbg_off(renegotiation) -> dbg:ctpl(?MODULE, init_renegotiate_timers, 3), dbg:ctpl(?MODULE, start_rekeying, 2), dbg:ctpg(?MODULE, renegotiate, 1); ssh_dbg_off(connection_events) -> dbg:ctpg(?MODULE, handle_event, 4); -ssh_dbg_off(connection_handshake) -> dbg:ctpl(?MODULE, handshake, 3); +ssh_dbg_off(connection_handshake) -> dbg:ctpl(?MODULE, monitor_handshake, 3); ssh_dbg_off(connections) -> dbg:ctpg(?MODULE, init, 1), ssh_dbg_off(terminate). @@ -2303,14 +2299,14 @@ ssh_dbg_format(renegotiation, {return_from, {?MODULE,send_disconnect,7}, _Ret}) skip. -ssh_dbg_format(connection_handshake, {call, {?MODULE,handshake,[Pid, Ref, Timeout]}}, Stack) -> +ssh_dbg_format(connection_handshake, {call, {?MODULE,monitor_handshake,[Pid, Ref, Timeout]}}, Stack) -> {["Connection handshake\n", io_lib:format("Connection Child: ~p~nReg: ~p~nTimeout: ~p~n", [Pid, Ref, Timeout]) ], [Pid|Stack] }; -ssh_dbg_format(connection_handshake, {Tag, {?MODULE,handshake,3}, Ret}, [Pid|Stack]) -> +ssh_dbg_format(connection_handshake, {Tag, {?MODULE,monitor_handshake,3}, Ret}, [Pid|Stack]) -> {[lists:flatten(io_lib:format("Connection handshake result ~p\n", [Tag])), io_lib:format("Connection Child: ~p~nRet: ~p~n", [Pid, Ret]) diff --git a/lib/ssh/src/ssh_fsm_userauth_client.erl b/lib/ssh/src/ssh_fsm_userauth_client.erl index 362747d02d4..0fc15256cd6 100644 --- a/lib/ssh/src/ssh_fsm_userauth_client.erl +++ b/lib/ssh/src/ssh_fsm_userauth_client.erl @@ -65,7 +65,7 @@ handle_event(internal, #ssh_msg_ext_info{}=Msg, {userauth,client}, D0) -> %%---- received userauth success from the server handle_event(internal, #ssh_msg_userauth_success{}, {userauth,client}, D0=#data{ssh_params = Ssh}) -> ssh_auth:ssh_msg_userauth_result(success), - ssh_connection_handler:handshake(ssh_connected, D0), + ssh_connection_handler:notify_handshaker(ssh_connected, D0), D = D0#data{ssh_params=Ssh#ssh{authenticated = true}}, {next_state, {connected,client}, D, {change_callback_module,ssh_connection_handler}}; diff --git a/lib/ssh/src/ssh_fsm_userauth_server.erl b/lib/ssh/src/ssh_fsm_userauth_server.erl index 140f0b068fa..ab4c3d95b4c 100644 --- a/lib/ssh/src/ssh_fsm_userauth_server.erl +++ b/lib/ssh/src/ssh_fsm_userauth_server.erl @@ -74,12 +74,11 @@ handle_event(internal, D = connected_state(Reply, Ssh1, User, Method, D0), {next_state, {connected,server}, D, [set_max_initial_idle_timeout(D), + {{timeout, negotiation}, cancel}, {change_callback_module,ssh_connection_handler} ] } - end; - {"ssh-connection", "ssh-connection", Method} -> %% Userauth request with a method like "password" or so case lists:member(Method, Ssh0#ssh.userauth_methods) of @@ -90,6 +89,7 @@ handle_event(internal, D = connected_state(Reply, Ssh1, User, Method, D0), {next_state, {connected,server}, D, [set_max_initial_idle_timeout(D), + {{timeout, negotiation}, cancel}, {change_callback_module,ssh_connection_handler} ]}; {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> @@ -126,6 +126,7 @@ handle_event(internal, #ssh_msg_userauth_info_response{} = Msg, {userauth_keyboa D = connected_state(Reply, Ssh1, User, "keyboard-interactive", D0), {next_state, {connected,server}, D, [set_max_initial_idle_timeout(D), + {{timeout, negotiation}, cancel}, {change_callback_module,ssh_connection_handler} ]}; {not_authorized, {User, Reason}, {Reply, Ssh}} -> @@ -144,6 +145,7 @@ handle_event(internal, #ssh_msg_userauth_info_response{} = Msg, {userauth_keyboa D = connected_state(Reply, Ssh1, User, "keyboard-interactive", D0), {next_state, {connected,server}, D, [set_max_initial_idle_timeout(D), + {{timeout, negotiation}, cancel}, {change_callback_module,ssh_connection_handler} ] }; @@ -172,7 +174,13 @@ code_change(_OldVsn, StateName, State, _Extra) -> connected_state(Reply, Ssh1, User, Method, D0) -> D1 = #data{ssh_params=Ssh} = ssh_connection_handler:send_msg(Reply, D0#data{ssh_params = Ssh1}), - ssh_connection_handler:handshake(ssh_connected, D1), + ParallelLogin = ?GET_OPT(parallel_login, Ssh#ssh.opts, disabled), + case ParallelLogin of + true -> + ok; + _ -> + ssh_connection_handler:notify_handshaker(ssh_connected, D1) + end, connected_fun(User, Method, D1), D1#data{auth_user=User, %% Note: authenticated=true MUST NOT be sent diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 7b8d4e9767b..0fb064bc82c 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -1024,7 +1024,7 @@ client_close_after_hello(Config0) -> length(Handshakers), Handshakers, length(Parents), Parents]), if - length(Handshakers)>0 -> + length(Handshakers) == 0 -> % no handshakers are created after parallel_login rewrite lists:foreach(fun(P) -> exit(P,some_reason) end, Parents), ct:log("After sending exits; now going to sleep", []), timer:sleep((SleepSec+15)*1000), @@ -1052,7 +1052,7 @@ client_close_after_hello(Config0) -> end; true -> - {fail, no_handshakers} + {fail, handshakers_found} end.