1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2008-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22-module(ssh_to_openssh_SUITE).
23
24-include_lib("common_test/include/ct.hrl").
25-include("ssh_test_lib.hrl").
26
27-export([
28         suite/0,
29         all/0,
30         groups/0,
31         init_per_suite/1,
32         end_per_suite/1,
33         init_per_group/2,
34         end_per_group/2,
35         init_per_testcase/2,
36         end_per_testcase/2
37        ]).
38
39-export([
40         erlang_server_openssh_client_renegotiate/1,
41         erlang_shell_client_openssh_server/1,
42         exec_direct_with_io_in_sshc/1,
43         exec_with_io_in_sshc/1,
44         tunnel_in_erlclient_erlserver/1,
45         tunnel_in_erlclient_openssh_server/1,
46         tunnel_in_non_erlclient_erlserver/1,
47         tunnel_out_erlclient_erlserver/1,
48         tunnel_out_erlclient_openssh_server/1,
49         tunnel_out_non_erlclient_erlserver/1
50
51        ]).
52
53-define(REKEY_DATA_TMO, 65000).
54
55%%--------------------------------------------------------------------
56%% Common Test interface functions -----------------------------------
57%%--------------------------------------------------------------------
58
59suite() ->
60    [{timetrap,{seconds,60}}].
61
62all() ->
63    case os:find_executable("ssh") of
64	false ->
65	    {skip, "openSSH not installed on host"};
66	_ ->
67	    [{group, erlang_client},
68             {group, erlang_server}
69	     ]
70    end.
71
72groups() ->
73    [{erlang_client, [], [tunnel_in_erlclient_erlserver,
74                          tunnel_out_erlclient_erlserver,
75                          {group, tunnel_distro_server},
76                          erlang_shell_client_openssh_server
77			 ]},
78     {tunnel_distro_server, [], [tunnel_in_erlclient_openssh_server,
79                                 tunnel_out_erlclient_openssh_server]},
80     {erlang_server, [], [{group, tunnel_distro_client},
81                          erlang_server_openssh_client_renegotiate,
82                          exec_with_io_in_sshc,
83                          exec_direct_with_io_in_sshc
84                         ]
85     },
86     {tunnel_distro_client, [], [tunnel_in_non_erlclient_erlserver,
87                                 tunnel_out_non_erlclient_erlserver]}
88    ].
89
90init_per_suite(Config) ->
91    ?CHECK_CRYPTO(
92       case gen_tcp:connect("localhost", ?SSH_DEFAULT_PORT, []) of
93	   {error,econnrefused} ->
94	       {skip,"No openssh deamon (econnrefused)"};
95	   _ ->
96               ssh_test_lib:openssh_sanity_check(
97                 [{ptty_supported, ssh_test_lib:ptty_supported()}
98                  | Config]
99                )
100       end
101      ).
102
103end_per_suite(_Config) ->
104    ok.
105
106init_per_group(erlang_server, Config) ->
107    Config;
108init_per_group(G, Config) when G==tunnel_distro_server ;
109                               G==tunnel_distro_client ->
110    case no_forwarding(Config) of
111        true ->
112            {skip, "port forwarding disabled in external ssh"};
113        false ->
114            Config
115    end;
116init_per_group(erlang_client, Config) ->
117    CommonAlgs = ssh_test_lib:algo_intersection(
118		   ssh:default_algorithms(),
119		   ssh_test_lib:default_algorithms(sshd)),
120    [{common_algs,CommonAlgs} | Config];
121init_per_group(_, Config) ->
122    Config.
123
124end_per_group(_, Config) ->
125    Config.
126
127
128init_per_testcase(erlang_server_openssh_client_renegotiate, Config) ->
129    case os:type() of
130	{unix,_} -> ssh:start(), Config;
131	Type -> {skip, io_lib:format("Unsupported test on ~p",[Type])}
132    end;
133init_per_testcase(_TestCase, Config) ->
134    ssh:start(),
135    Config.
136
137end_per_testcase(_TestCase, _Config) ->
138    ssh:stop(),
139    ok.
140
141%%--------------------------------------------------------------------
142%% Test Cases --------------------------------------------------------
143%%--------------------------------------------------------------------
144erlang_shell_client_openssh_server(Config) when is_list(Config) ->
145    process_flag(trap_exit, true),
146    IO = ssh_test_lib:start_io_server(),
147    Prev = lists:usort(supervisor:which_children(sshc_sup)),
148    Shell = ssh_test_lib:start_shell(?SSH_DEFAULT_PORT, IO),
149    IO ! {input, self(), "echo Hej\n"},
150    case proplists:get_value(ptty_supported, Config) of
151        true ->
152            ct:log("~p:~p  ptty supported", [?MODULE,?LINE]),
153            receive_data("Hej", undefined),
154            IO ! {input, self(), "exit\n"},
155            receive_logout(),
156            receive_normal_exit(Shell),
157            %% Check that the connection is closed:
158            ct:log("Expects ~p", [Prev]),
159            ?wait_match(Prev, lists:usort(supervisor:which_children(sshc_sup)));
160        false ->
161            ct:log("~p:~p  ptty unsupported", [?MODULE,?LINE]),
162            receive_exit(Shell,
163                         fun({{badmatch,failure},
164                              [{ssh,shell,_,_} | _]}) -> true;
165                            (_) ->
166                                 false
167                         end)
168    end.
169
170%%--------------------------------------------------------------------
171%% Test that the server could redirect stdin and stdout from/to an
172%% OpensSSH client when handling an exec request
173exec_with_io_in_sshc(Config) when is_list(Config) ->
174    SystemDir = proplists:get_value(data_dir, Config),
175    {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
176                                             {failfun, fun ssh_test_lib:failfun/2}]),
177    ct:sleep(500),
178
179    _PrivDir = proplists:get_value(priv_dir, Config),
180    ExecStr = "\"io:read('% ').\"",
181    Cmd =  "echo howdy. | " ++ ssh_test_lib:open_sshc_cmd(Host, Port,
182                                                          [" -o UserKnownHostsFile=", "/dev/null",
183                                                           " -o CheckHostIP=no"
184                                                           " -o StrictHostKeyChecking=no"
185                                                           " -q"
186                                                           " -x" % Disable X forwarding
187                                                          ],
188                                                          ExecStr),
189    ct:log("Cmd = ~p~n",[Cmd]),
190    case os:cmd(Cmd) of
191        "% {ok,howdy}" -> ok;
192        "{ok,howdy}% " -> ok; % Could happen if the client sends the piped
193                              % input before receiving the prompt ("% ").
194        Other -> ct:fail("Received ~p",[Other])
195    end,
196    ssh:stop_daemon(Pid).
197
198%%--------------------------------------------------------------------
199%% Test that the server could redirect stdin and stdout from/to an
200%% OpensSSH client when handling an direct exec request
201exec_direct_with_io_in_sshc(Config) when is_list(Config) ->
202    SystemDir = proplists:get_value(data_dir, Config),
203    {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
204                                             {failfun, fun ssh_test_lib:failfun/2},
205                                             {exec,{direct,fun(Cmnd) ->
206                                                                   {ok,X} = io:read(Cmnd),
207                                                                   {ok,{X,lists:reverse(atom_to_list(X))}}
208                                                           end}}
209                                            ]),
210    ct:sleep(500),
211
212    _PrivDir = proplists:get_value(priv_dir, Config),
213    Cmd =  "echo ciao. | " ++ ssh_test_lib:open_sshc_cmd(Host, Port,
214                                                          [" -o UserKnownHostsFile=", "/dev/null",
215                                                           " -o CheckHostIP=no"
216                                                           " -o StrictHostKeyChecking=no"
217                                                           " -q"
218                                                           " -x" % Disable X forwarding
219                                                          ],
220                                                         "'? '"),
221    ct:log("Cmd = ~p~n",[Cmd]),
222    case os:cmd(Cmd) of
223        "? {ciao,\"oaic\"}" -> ok;
224        "'? '{ciao,\"oaic\"}" -> ok; % WSL
225        "{ciao,\"oaic\"}? " -> ok; % Could happen if the client sends the piped
226                                   % input before receiving the prompt ("? ").
227        Other -> ct:fail("Received ~p",[Other])
228    end,
229    ssh:stop_daemon(Pid).
230
231%%--------------------------------------------------------------------
232%% Test that the Erlang/OTP server can renegotiate with openSSH
233erlang_server_openssh_client_renegotiate(Config) ->
234    _PubKeyAlg = ssh_rsa,
235    SystemDir = proplists:get_value(data_dir, Config),
236    PrivDir = proplists:get_value(priv_dir, Config),
237
238    {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
239                                             {failfun, fun ssh_test_lib:failfun/2}]),
240    ct:sleep(500),
241
242    RenegLimitK = 3,
243    DataFile = filename:join(PrivDir, "renegotiate_openssh_client.data"),
244    Data =  lists:duplicate(trunc(1.1*RenegLimitK*1024), $a),
245    ok = file:write_file(DataFile, Data),
246
247    Cmd = ssh_test_lib:open_sshc_cmd(Host, Port,
248                                     [" -o UserKnownHostsFile=", "/dev/null",
249                                      " -o CheckHostIP=no"
250                                      " -o StrictHostKeyChecking=no"
251                                      " -q"
252                                      " -x",
253                                      " -o RekeyLimit=",integer_to_list(RenegLimitK),"K"]),
254
255
256    OpenSsh = ssh_test_lib:open_port({spawn, Cmd++" < "++DataFile}),
257
258    Expect = fun({data,R}) ->
259		     try
260			 NonAlphaChars = [C || C<-lists:seq(1,255),
261					       not lists:member(C,lists:seq($a,$z)),
262					       not lists:member(C,lists:seq($A,$Z))
263					 ],
264			 Lines = string:tokens(binary_to_list(R), NonAlphaChars),
265			 lists:any(fun(L) -> length(L)>1 andalso lists:prefix(L, Data) end,
266				   Lines)
267		     catch
268			 _:_ -> false
269		     end;
270
271		({exit_status,E}) when E=/=0 ->
272		     ct:log("exit_status ~p",[E]),
273		     throw({skip,"exit status"});
274
275		(_) ->
276		     false
277	     end,
278
279    try
280	ssh_test_lib:rcv_expected(Expect, OpenSsh, ?TIMEOUT)
281    of
282	_ ->
283	    %% Unfortunately we can't check that there has been a renegotiation, just trust OpenSSH.
284	    ssh:stop_daemon(Pid)
285    catch
286	throw:{skip,R} -> {skip,R}
287    end.
288
289%%--------------------------------------------------------------------
290tunnel_out_non_erlclient_erlserver(Config) ->
291    SystemDir = proplists:get_value(data_dir, Config),
292    _PrivDir = proplists:get_value(priv_dir, Config),
293
294    {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_out, true},
295                                             {system_dir, SystemDir},
296                                             {failfun, fun ssh_test_lib:failfun/2}]),
297    {ToSock, _ToHost, ToPort} = tunneling_listner(),
298
299    ListenHost = {127,0,0,1},
300    ListenPort = 2345,
301
302    Cmd = ssh_test_lib:open_sshc_cmd(Host, Port,
303                                     [" -o UserKnownHostsFile=", "/dev/null",
304                                      " -o CheckHostIP=no"
305                                      " -o StrictHostKeyChecking=no"
306                                      " -q"
307                                      " -x",
308                                      " -R ",integer_to_list(ListenPort),":127.0.0.1:",integer_to_list(ToPort)]),
309    spawn(fun() ->
310                  ct:log(["ssh command:\r\n  ",Cmd],[]),
311                  R = os:cmd(Cmd),
312                  ct:log(["ssh returned:\r\n",R],[])
313          end),
314
315    ct:sleep(1000),
316    test_tunneling(ToSock, ListenHost, ListenPort).
317
318%%--------------------------------------------------------------------
319tunnel_in_non_erlclient_erlserver(Config) ->
320    SystemDir = proplists:get_value(data_dir, Config),
321    _UserDir = proplists:get_value(priv_dir, Config),
322    {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_in, true},
323                                              {system_dir, SystemDir},
324                                              {failfun, fun ssh_test_lib:failfun/2}]),
325    {ToSock, _ToHost, ToPort} = tunneling_listner(),
326
327    ListenHost = {127,0,0,1},
328    ListenPort = 2345,
329
330    Cmd =
331        ssh_test_lib:open_sshc_cmd(Host, Port,
332                                   [" -o UserKnownHostsFile=", "/dev/null",
333                                    " -o CheckHostIP=no"
334                                    " -o StrictHostKeyChecking=no"
335                                    " -q"
336                                    " -x",
337                                    " -L ",integer_to_list(ListenPort),":127.0.0.1:",integer_to_list(ToPort)]),
338    spawn(fun() ->
339                  ct:log(["ssh command:\r\n  ",Cmd],[]),
340                  R = os:cmd(Cmd),
341                  ct:log(["ssh returned:\r\n",R],[])
342          end),
343    ct:sleep(1000),
344    test_tunneling(ToSock, ListenHost, ListenPort).
345
346%%--------------------------------------------------------------------
347tunnel_in_erlclient_erlserver(Config) ->
348    SystemDir = proplists:get_value(data_dir, Config),
349    UserDir = proplists:get_value(priv_dir, Config),
350    {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_in, true},
351                                              {system_dir, SystemDir},
352                                              {user_dir, UserDir},
353                                              {user_passwords, [{"foo", "bar"}]},
354                                              {failfun, fun ssh_test_lib:failfun/2}]),
355    C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
356                                          {user_dir, UserDir},
357                                          {user,"foo"},{password,"bar"},
358                                          {user_interaction, false}]),
359    {ToSock, ToHost, ToPort} = tunneling_listner(),
360
361    ListenHost = {127,0,0,1},
362    {ok,ListenPort} = ssh:tcpip_tunnel_to_server(C, ListenHost,0, ToHost,ToPort, 2000),
363
364    test_tunneling(ToSock, ListenHost, ListenPort).
365
366%%--------------------------------------------------------------------
367tunnel_in_erlclient_openssh_server(_Config) ->
368    C = ssh_test_lib:connect(?SSH_DEFAULT_PORT, []),
369    {ToSock, ToHost, ToPort} = tunneling_listner(),
370
371    ListenHost = {127,0,0,1},
372    {ok,ListenPort} = ssh:tcpip_tunnel_to_server(C, ListenHost,0, ToHost,ToPort, 5000),
373
374    test_tunneling(ToSock, ListenHost, ListenPort).
375
376%%--------------------------------------------------------------------
377tunnel_out_erlclient_erlserver(Config) ->
378    SystemDir = proplists:get_value(data_dir, Config),
379    UserDir = proplists:get_value(priv_dir, Config),
380    {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_out, true},
381                                              {system_dir, SystemDir},
382                                              {user_dir, UserDir},
383                                              {user_passwords, [{"foo", "bar"}]},
384                                              {failfun, fun ssh_test_lib:failfun/2}]),
385    C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
386                                          {user_dir, UserDir},
387                                          {user,"foo"},{password,"bar"},
388                                          {user_interaction, false}]),
389    {ToSock, ToHost, ToPort} = tunneling_listner(),
390
391    ListenHost = {127,0,0,1},
392    {ok,ListenPort} = ssh:tcpip_tunnel_from_server(C, ListenHost,0, ToHost,ToPort, 5000),
393
394    test_tunneling(ToSock, ListenHost, ListenPort).
395
396%%--------------------------------------------------------------------
397tunnel_out_erlclient_openssh_server(_Config) ->
398    C = ssh_test_lib:connect(?SSH_DEFAULT_PORT, []),
399    {ToSock, ToHost, ToPort} = tunneling_listner(),
400
401    ListenHost = {127,0,0,1},
402    {ok,ListenPort} = ssh:tcpip_tunnel_from_server(C, ListenHost,0, ToHost,ToPort, 5000),
403
404    test_tunneling(ToSock, ListenHost, ListenPort).
405
406%%--------------------------------------------------------------------
407%%% Internal functions -----------------------------------------------
408%%--------------------------------------------------------------------
409tunneling_listner() ->
410    {ok,LSock} = gen_tcp:listen(0, [{active,false}]),
411    {ok, {LHost,LPort}} = inet:sockname(LSock),
412    {LSock, LHost, LPort}.
413
414test_tunneling(ListenSocket, Host, Port) ->
415    {ok,Client1} = gen_tcp:connect(Host, Port, [{active,false}]),
416    {ok,Server1} = gen_tcp:accept(ListenSocket),
417    {ok,Client2} = gen_tcp:connect(Host, Port, [{active,false}]),
418    {ok,Server2} = gen_tcp:accept(ListenSocket),
419    send_rcv("Hi!", Client1, Server1),
420    send_rcv("Happy to see you!", Server1, Client1),
421    send_rcv("Hi, you to!", Client2, Server2),
422    send_rcv("Happy to see you also!", Server2, Client2),
423    close_and_check(Client1, Server1),
424    send_rcv("Still there?", Client2, Server2),
425    send_rcv("Yes!", Server2, Client2),
426    close_and_check(Server2, Client2).
427
428
429close_and_check(OneSide, OtherSide) ->
430    ok = gen_tcp:close(OneSide),
431    ok = chk_closed(OtherSide).
432
433
434chk_closed(Sock) ->
435    chk_closed(Sock, 0).
436chk_closed(Sock, Timeout) ->
437    case gen_tcp:recv(Sock, 0, Timeout) of
438        {error,closed} ->
439            ok;
440        {error,timeout} ->
441            chk_closed(Sock, 2*max(Timeout,250));
442        Other ->
443            Other
444    end.
445
446send_rcv(Txt, From, To) ->
447    ct:log("Send ~p from ~p to ~p", [Txt, From, To]),
448    ok = gen_tcp:send(From, Txt),
449    ct:log("Recv ~p on ~p", [Txt, To]),
450    {ok,Txt} = gen_tcp:recv(To, 0, 5000),
451    ok.
452
453%%--------------------------------------------------------------------
454receive_data(Data, Conn) ->
455    receive
456	Info when is_binary(Info) ->
457	    Lines = string:tokens(binary_to_list(Info), "\r\n "),
458	    case lists:member(Data, Lines) of
459		true ->
460		    ct:log("~p:~p  Expected result ~p found in lines: ~p~n", [?MODULE,?LINE,Data,Lines]),
461		    ok;
462		false ->
463		    ct:log("~p:~p  Extra info: ~p~n", [?MODULE,?LINE,Info]),
464		    receive_data(Data, Conn)
465	    end;
466	Other ->
467	    ct:log("~p:~p  Unexpected: ~p",[?MODULE,?LINE,Other]),
468	    receive_data(Data, Conn)
469    after
470	30000 ->
471             {State, _} = case Conn of
472                              undefined -> {'??','??'};
473                              _ -> sys:get_state(Conn)
474                          end,
475            ct:log("timeout ~p:~p~nExpect ~p~nState = ~p",[?MODULE,?LINE,Data,State]),
476            ct:fail("timeout ~p:~p",[?MODULE,?LINE])
477    end.
478
479receive_logout() ->
480    receive
481	<<"logout">> ->
482	    extra_logout(),
483	    receive
484		<<"Connection closed">> ->
485		    ok
486	    after
487		30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
488	    end;
489	Info ->
490	    ct:log("Extra info when logging out: ~p~n", [Info]),
491	    receive_logout()
492    after
493	30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
494    end.
495
496
497receive_normal_exit(Shell) ->
498    receive_exit(Shell, fun(Reason) -> Reason == normal end).
499
500
501receive_exit(Shell, F) when is_function(F,1) ->
502    receive
503        {'EXIT', Shell, Reason} ->
504            case F(Reason) of
505                true ->
506                    ok;
507                false ->
508                    ct:fail({unexpected_exit, Reason})
509            end;
510
511        <<"\r\n">> ->
512            receive_normal_exit(Shell);
513
514        Other ->
515            ct:fail({unexpected_msg, Other})
516
517        after
518	30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE])
519    end.
520
521
522extra_logout() ->
523    receive
524	<<"logout">> ->
525	    ok
526    after 500 ->
527	    ok
528    end.
529
530%%%----------------------------------------------------------------
531no_forwarding(Config) ->
532    %%% Check if the ssh of the OS has tunneling enabled
533    _UserDir = proplists:get_value(priv_dir, Config),
534    Cmnd = ["ssh "
535            " -o UserKnownHostsFile=", "/dev/null",
536            " -o CheckHostIP=no"
537            " -o StrictHostKeyChecking=no"
538            " -R 0:localhost:4567 localhost exit"],
539    FailRegExp =
540        "Port forwarding is disabled"
541        "|remote port forwarding failed"
542        "|Bad.*specification"
543        "|Bad forwarding port",
544    {Result,TheText} =
545        try
546            Parent = self(),
547            Pid = spawn(fun() ->
548                                Parent ! {self(), os:cmd(Cmnd)}
549                        end),
550            receive
551                {Pid, Txt} ->
552                    case re:run(Txt, FailRegExp) of
553                        {match,_} -> {true,Txt};
554                        _ -> {false,Txt}
555                end
556        after 10000 ->
557                ct:log("*** TIMEOUT ***",[]),
558                {true,""}
559        end
560    catch C:E:S ->
561            ct:log("Exception in no_forwarding():~n~p:~p~n~p~n", [C,E,S]),
562            {true, ""}
563    end,
564    ct:log("---- os:cmd(~p) returned:~n~s~n"
565           "~n"
566           "---- Checking with regexp~n"
567           "~p~n"
568           "~n"
569           "---- The function no_forwarding() returns ~p",
570           [Cmnd,TheText, FailRegExp, Result]),
571    Result.
572