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
23-module(ssh_algorithms_SUITE).
24
25-include_lib("common_test/include/ct.hrl").
26-include("ssh_transport.hrl").
27-include("ssh_test_lib.hrl").
28
29-export([
30         suite/0,
31         all/0,
32         groups/0,
33         init_per_suite/1,
34         end_per_suite/1,
35         init_per_group/2,
36         end_per_group/2,
37         init_per_testcase/2,
38         end_per_testcase/2
39        ]).
40
41-export([
42         interpolate/1,
43         simple_connect/1,
44         simple_exec/1,
45         simple_exec_groups/0,
46         simple_exec_groups/1,
47         simple_exec_groups_no_match_too_large/1,
48         simple_exec_groups_no_match_too_small/1,
49         simple_sftp/1,
50         sshc_simple_exec_os_cmd/1,
51         sshd_simple_exec/1
52        ]).
53
54%%--------------------------------------------------------------------
55%% Common Test interface functions -----------------------------------
56%%--------------------------------------------------------------------
57
58suite() ->
59    [{ct_hooks,[ts_install_cth]},
60     {timetrap,{seconds,120}}].
61
62all() ->
63    %% [{group,kex},{group,cipher}... etc
64    [{group,C} || C <- tags()].
65
66
67groups() ->
68    ErlAlgos = extract_algos(ssh_transport:supported_algorithms()),
69    SshcAlgos = extract_algos(ssh_test_lib:default_algorithms(sshc)),
70    SshdAlgos = extract_algos(ssh_test_lib:default_algorithms(sshd)),
71
72    DoubleAlgos =
73	[{Tag, double(Tag,Algs)} || {Tag,Algs} <- ErlAlgos,
74                                    length(Algs) > 1,
75                                    lists:member(Tag, two_way_tags())],
76    TagGroupSet =
77	[{Tag, [], group_members_for_tag(Tag,Algs,DoubleAlgos)}
78	 || {Tag,Algs} <- ErlAlgos,
79	    lists:member(Tag,tags())
80	],
81
82    TypeSSH = ssh_test_lib:ssh_type(),
83
84    AlgoTcSet =
85	[{Alg, [], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos,TypeSSH)}
86	 || {Tag,Algs} <- ErlAlgos ++ DoubleAlgos,
87	    Alg <- Algs],
88
89    TagGroupSet ++ AlgoTcSet.
90
91tags() -> [kex,cipher,mac,compression,public_key].
92two_way_tags() -> [cipher,mac,compression, public_key].
93
94%%--------------------------------------------------------------------
95init_per_suite(Config) ->
96    ?CHECK_CRYPTO(
97       begin
98	   ct:log("~n"
99		  "Environment:~n============~n"
100		  "os:getenv(\"HOME\") = ~p~n"
101		  "init:get_argument(home) = ~p~n~n~n"
102		  "OS ssh:~n=======~n~p~n~n~n"
103		  "Erl ssh:~n========~n~p~n~n~n"
104		  "crypto:info_lib():~n========~n~p~n~n~n"
105		  "Installed ssh client:~n=====================~n~p~n~n~n"
106		  "Installed ssh server:~n=====================~n~p~n~n~n"
107		  "Misc values:~n============~n"
108		  " -- Default dh group exchange parameters ({min,def,max}): ~p~n"
109		  " -- dh_default_groups: ~p~n"
110		  " -- Max num algorithms: ~p~n"
111		 ,[os:getenv("HOME"),
112		   init:get_argument(home),
113		   ssh_test_lib:installed_ssh_version("TIMEOUT"),
114		   ssh:default_algorithms(),
115		   crypto:info_lib(),
116		   ssh_test_lib:default_algorithms(sshc,
117                                                   %% Use a fake system_dir to enable the test
118                                                   %% daemon to start:
119                                                   [{system_dir,proplists:get_value(data_dir,Config)}]),
120		   ssh_test_lib:default_algorithms(sshd),
121		   {?DEFAULT_DH_GROUP_MIN,?DEFAULT_DH_GROUP_NBITS,?DEFAULT_DH_GROUP_MAX},
122		   public_key:dh_gex_group_sizes(),
123		   ?MAX_NUM_ALGORITHMS
124		  ]),
125	   ct:log("all() ->~n    ~p.~n~ngroups()->~n    ~p.~n",[all(),groups()]),
126	   ssh:start(),
127	   [{std_simple_sftp_size,25000} % Sftp transferred data size
128	    | Config]
129       end
130      ).
131
132
133end_per_suite(_Config) ->
134    ssh:stop().
135
136
137init_per_group(Group, Config) ->
138    case lists:member(Group, tags()) of
139	true ->
140	    %% A tag group
141	    Tag = Group,
142	    ct:comment("==== ~p ====",[Tag]),
143	    Config;
144	false ->
145	    %% An algorithm group
146	    Tag = proplists:get_value(name,
147				      hd(proplists:get_value(tc_group_path, Config))),
148	    Alg = Group,
149            init_per_group(Tag, Alg, Config)
150    end.
151
152
153init_per_group(public_key=Tag, Alg, Config) ->
154    PA =
155        case split(Tag, Alg) of
156            [_] ->
157                [Alg];
158            [A1,A2] ->
159                [A1,A2]
160        end,
161    OtherAlgs = [{T,L} || {T,L} <- ssh_transport:supported_algorithms(), T=/=Tag],
162    ct:log("Init tests for public_key ~p~nOtherAlgs=~p",[PA,OtherAlgs]),
163    PrefAlgs = {preferred_algorithms,[{Tag,PA}|OtherAlgs]},
164    %% Daemon started later in init_per_testcase
165    try
166        setup_pubkey(PA,
167                 [{pref_algs,PrefAlgs},
168                  {tag_alg,{Tag,PA}}
169                  | Config])
170    catch
171        _C:_E:_S ->
172            ct:log("Exception ~p:~p~n~p",[_C,_E,_S]),
173            {skip, io_lib:format("Unsupported: ~p",[Alg])}
174    end;
175
176init_per_group(Tag, Alg, Config) ->
177    PA =
178        case split(Tag, Alg) of
179            [_] ->
180                [Alg];
181            [A1,A2] ->
182                [{client2server,[A1]},
183                 {server2client,[A2]}]
184        end,
185    OtherAlgs = [{T,L} || {T,L} <- ssh_transport:supported_algorithms(), T=/=Tag],
186    ct:log("Init tests for tag=~p alg=~p~nOtherAlgs=~p",[Tag,PA,OtherAlgs]),
187    PrefAlgs = {preferred_algorithms,[{Tag,PA}|OtherAlgs]},
188    start_std_daemon([PrefAlgs],
189                     [{pref_algs,PrefAlgs},
190                      {tag_alg,{Tag,[Alg]}}
191                      | Config]).
192
193
194end_per_group(_Alg, Config) ->
195    case proplists:get_value(srvr_pid,Config) of
196	Pid when is_pid(Pid) ->
197	    ssh:stop_daemon(Pid),
198	    ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]);
199	_ ->
200	    ok
201    end.
202
203
204
205init_per_testcase(TC, Config) ->
206    init_per_testcase(TC, proplists:get_value(tag_alg,Config), Config).
207
208
209init_per_testcase(TC, {public_key,Alg}, Config) ->
210    ct:log("init_per_testcase TC=~p, Alg=~p",[TC,Alg]),
211    ExtraOpts = case TC of
212                    simple_connect ->
213                        [{user_dir, proplists:get_value(priv_dir,Config)}];
214                    _ ->
215                        []
216                end,
217    Opts = pubkey_opts(Config) ++ ExtraOpts,
218    {UserAlg,SrvrAlg} =
219        case Alg of
220            [A1,A2] -> {A1,A2};
221            [A0] -> {A0,A0}
222        end,
223    case {ssh_file:user_key(UserAlg,Opts), ssh_file:host_key(SrvrAlg,Opts)} of
224        {{ok,_}, {ok,_}} ->
225            start_pubkey_daemon([proplists:get_value(pref_algs,Config)
226                                | ExtraOpts],
227                                [{extra_daemon,true}|Config]);
228        {{ok,_}, {error,Err}} ->
229            ct:log("SrvrAlg = ~p~nOpts = ~p",[SrvrAlg,Opts]),
230            {skip, io_lib:format("No host key: ~p",[Err])};
231
232        {{error,Err}, {ok,_}} ->
233            ct:log("UserAlg = ~p~nOpts = ~p",[UserAlg,Opts]),
234            {skip, io_lib:format("No user key: ~p",[Err])};
235
236        _ ->
237            ct:log("UserAlg = ~p SrvrAlg = ~p~nOpts = ~p",[UserAlg,SrvrAlg,Opts]),
238            {skip, "Neither host nor user key"}
239    end;
240
241init_per_testcase(sshc_simple_exec_os_cmd, _, Config) ->
242     start_pubkey_daemon([proplists:get_value(pref_algs,Config)],
243                         [{extra_daemon,true}|Config]);
244
245init_per_testcase(_, _, Config) ->
246    Config.
247
248
249end_per_testcase(_TC, Config) ->
250    case proplists:get_value(extra_daemon, Config, false) of
251        true ->
252            case proplists:get_value(srvr_pid,Config) of
253                Pid when is_pid(Pid) ->
254                    ssh:stop_daemon(Pid),
255                    ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]),
256                    Config;
257                _ ->
258                    Config
259            end;
260        _ ->
261            Config
262    end.
263
264%%--------------------------------------------------------------------
265%% Test Cases --------------------------------------------------------
266%%--------------------------------------------------------------------
267%% A simple sftp transfer
268simple_sftp(Config) ->
269    {Host,Port} = proplists:get_value(srvr_addr, Config),
270    {preferred_algorithms,AlgEntries} = proplists:get_value(pref_algs, Config),
271    ssh_test_lib:std_simple_sftp(Host, Port, Config,
272                                 [{modify_algorithms,[{append,AlgEntries}]}]
273                                ).
274
275%%--------------------------------------------------------------------
276%% A simple exec call
277simple_exec(Config) ->
278    {Host,Port} = proplists:get_value(srvr_addr, Config),
279    {preferred_algorithms,AlgEntries} = proplists:get_value(pref_algs, Config),
280    ssh_test_lib:std_simple_exec(Host, Port, Config,
281                                 [{modify_algorithms,[{append,AlgEntries}]}]
282                                ).
283
284%%--------------------------------------------------------------------
285%% A simple exec call
286simple_connect(Config) ->
287    ct:log("PrivDir ~p:~n~p~n~nPrivDir/system: ~p",[proplists:get_value(priv_dir,Config),
288                                                    file:list_dir(proplists:get_value(priv_dir,Config)),
289                                                    catch file:list_dir(
290                                                            filename:join(proplists:get_value(priv_dir,Config),
291                                                                          system))]),
292    {Host,Port} = proplists:get_value(srvr_addr, Config),
293    {preferred_algorithms,AlgEntries} = proplists:get_value(pref_algs, Config),
294    Opts =
295        case proplists:get_value(tag_alg, Config) of
296            {public_key,Alg} -> [{pref_public_key_algs,Alg},
297                                 {preferred_algorithms,AlgEntries}];
298            _ -> [{modify_algorithms,[{append,AlgEntries}]}]
299        end,
300    ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port,
301                                             [{silently_accept_hosts, true},
302                                              {user_interaction, false} |
303                                              Opts]),
304    ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]),
305    ssh:close(ConnectionRef).
306
307%%--------------------------------------------------------------------
308%% Testing if no group matches
309simple_exec_groups_no_match_too_small(Config) ->
310    try_exec_simple_group({400,500,600}, Config).
311
312simple_exec_groups_no_match_too_large(Config) ->
313    try_exec_simple_group({9200,9500,9700}, Config).
314
315
316try_exec_simple_group(Group, Config) ->
317    try simple_exec_group(Group, Config)
318    of
319	_ -> ct:fail("Exec though no group available")
320    catch
321        error:{badmatch,{error,"Key exchange failed"}} -> ok
322    end.
323
324%%--------------------------------------------------------------------
325%% Testing all default groups
326
327simple_exec_groups() ->
328    [{timetrap,{seconds,240}}].
329
330simple_exec_groups(Config) ->
331    Sizes = interpolate( public_key:dh_gex_group_sizes() ),
332    lists:foreach(
333      fun(Sz) ->
334	      ct:log("Try size ~p",[Sz]),
335	      ct:comment(Sz),
336	      simple_exec_group(Sz, Config),
337	      ct:log("Size ~p ok",[Sz])
338      end, Sizes),
339    ct:comment("~p",[lists:map(fun({_,I,_}) -> I;
340				  (I) -> I
341			       end,Sizes)]).
342
343
344interpolate([I1,I2|Is]) ->
345    OneThird = (I2-I1) div 3,
346    [I1,
347     {I1, I1 + OneThird, I2},
348     {I1, I1 + 2*OneThird, I2} | interpolate([I2|Is])];
349interpolate(Is) ->
350    Is.
351
352%%--------------------------------------------------------------------
353%% Use the ssh client of the OS to connect
354
355sshc_simple_exec_os_cmd(Config) ->
356    PrivDir = ?config(priv_dir, Config),
357    KnownHosts = filename:join(PrivDir, "known_hosts"),
358    {Host,Port} = ?config(srvr_addr, Config),
359    Parent = self(),
360    Client = spawn(
361	       fun() ->
362                       Result = ssh_test_lib:open_sshc(Host, Port,
363                                                       [" -C"
364                                                        " -o UserKnownHostsFile=",KnownHosts,
365                                                        " -o CheckHostIP=no"
366                                                        " -o StrictHostKeyChecking=no"
367                                                        " -o UpdateHostKeys=no"
368                                                        " -q"
369                                                        " -x"
370                                                        ],
371                                                       " 1+1."),
372		       Parent ! {result, self(), Result, "2"}
373	       end),
374    receive
375	{result, Client, RawResult, Expect} ->
376	    Lines = string:tokens(RawResult, "\r\n"),
377	    case lists:any(fun(Line) -> Line==Expect end,
378			   Lines) of
379		true ->
380		    ok;
381		false ->
382		    ct:log("Bad result: ~p~nExpected: ~p~nMangled result: ~p", [RawResult,Expect,Lines]),
383		    {fail, "Bad result (see log in testcase)"}
384	    end
385    after ?TIMEOUT ->
386	    ct:fail("Did not receive answer (timeout)")
387    end.
388
389%%--------------------------------------------------------------------
390%% Connect to the ssh server of the OS
391sshd_simple_exec(Config) ->
392    ClientPubKeyOpts =
393        case proplists:get_value(tag_alg,Config) of
394            {public_key,Alg} -> [{pref_public_key_algs,Alg}];
395            _ -> []
396        end,
397    ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT,
398                                         [proplists:get_value(pref_algs,Config)
399                                          | ClientPubKeyOpts]),
400    {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity),
401    success = ssh_connection:exec(ConnectionRef, ChannelId0,
402				  "echo testing", infinity),
403    Data0 = {ssh_cm, ConnectionRef, {data, ChannelId0, 0, <<"testing\n">>}},
404    case ssh_test_lib:receive_exec_result(Data0) of
405	expected ->
406	    ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0);
407	{unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}}
408	 = ExitStatus0} ->
409	    ct:log("0: Collected data ~p", [ExitStatus0]),
410	    ssh_test_lib:receive_exec_result(Data0,
411					     ConnectionRef, ChannelId0);
412	Other0 ->
413	    ct:fail(Other0)
414    end,
415
416    {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity),
417    success = ssh_connection:exec(ConnectionRef, ChannelId1,
418				  "echo testing1", infinity),
419    Data1 = {ssh_cm, ConnectionRef, {data, ChannelId1, 0, <<"testing1\n">>}},
420    case ssh_test_lib:receive_exec_result(Data1) of
421	expected ->
422	    ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1);
423	{unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId1, 0}}
424	 = ExitStatus1} ->
425	    ct:log("0: Collected data ~p", [ExitStatus1]),
426	    ssh_test_lib:receive_exec_result(Data1,
427					     ConnectionRef, ChannelId1);
428	Other1 ->
429	    ct:fail(Other1)
430    end,
431    ssh:close(ConnectionRef).
432
433
434%%%================================================================
435%%%
436%%% Lib functions
437%%%
438
439%%%----------------------------------------------------------------
440%%%
441%%% For construction of the result of all/0 and groups/0
442%%%
443group_members_for_tag(Tag, Algos, DoubleAlgos) ->
444    [{group,Alg} || Alg <- Algos++proplists:get_value(Tag,DoubleAlgos,[])].
445
446double(Tag, Algs) -> [concat(Tag,A1,A2) || A1 <- Algs,
447                                           A2 <- Algs,
448                                           A1 =/= A2].
449
450concat(Tag, A1, A2) ->
451    list_to_atom(lists:concat(["D: ",Tag," ",A1," + ",A2])).
452
453split(TagA, Alg) ->
454    Tag = atom_to_list(TagA),
455    ssh_test_lib:to_atoms(
456      case string:tokens(atom_to_list(Alg), " ") of
457          ["D:",Tag,A1,"+",A2] ->[A1,A2];
458          Other -> Other
459      end).
460
461specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) ->
462    case Tag of
463        public_key -> [simple_connect];
464        _ -> [simple_connect, simple_exec, simple_sftp]
465    end
466    ++ case supports(Tag, Alg, SshcAlgos) of
467           true when TypeSSH == openSSH ->
468               [sshc_simple_exec_os_cmd];
469           _ ->
470               []
471       end ++
472       case supports(Tag, Alg, SshdAlgos) of
473           true ->
474               [sshd_simple_exec];
475           _ ->
476               []
477       end ++
478       case {Tag,Alg} of
479           {kex,_} when Alg == 'diffie-hellman-group-exchange-sha1' ;
480                        Alg == 'diffie-hellman-group-exchange-sha256' ->
481               [simple_exec_groups,
482                simple_exec_groups_no_match_too_large,
483                simple_exec_groups_no_match_too_small
484               ];
485           _ ->
486               []
487       end.
488
489supports(Tag, Alg, Algos) ->
490    lists:all(fun(A) ->
491		      lists:member(A, proplists:get_value(Tag, Algos,[]))
492	      end,
493	      split(Tag, Alg)).
494
495
496extract_algos(Spec) ->
497    [{Tag,get_atoms(List)} || {Tag,List} <- Spec].
498
499get_atoms(L) ->
500    lists:usort(
501      [ A || X <- L,
502	     A <- case X of
503		      {_,L1} when is_list(L1) -> L1;
504		      Y when is_atom(Y) -> [Y]
505		  end]).
506
507%%%----------------------------------------------------------------
508%%%
509%%% Test case related
510%%%
511start_std_daemon(Opts, Config) ->
512    ct:log("starting std_daemon",[]),
513    {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts),
514    ct:log("started ~p:~p  ~p",[Host,Port,Opts]),
515    [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config].
516
517
518start_pubkey_daemon(Opts0, Config) ->
519    ct:log("starting pubkey_daemon",[]),
520    Opts = pubkey_opts(Config) ++ Opts0,
521    {Pid, Host, Port} = ssh_test_lib:daemon([{failfun, fun ssh_test_lib:failfun/2}
522                                             | Opts]),
523    ct:log("started ~p:~p  ~p",[Host,Port,Opts]),
524    [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config].
525
526
527pubkey_opts(Config) ->
528    SystemDir = filename:join(proplists:get_value(priv_dir,Config), "system"),
529    [{auth_methods,"publickey"},
530     {system_dir, SystemDir}].
531
532
533setup_pubkey([AlgClient, AlgServer], Config) ->
534    DataDir = proplists:get_value(data_dir, Config),
535    UserDir = proplists:get_value(priv_dir, Config),
536    ssh_test_lib:del_dir_contents(UserDir),
537    ok = ssh_test_lib:setup_user_key(AlgClient, DataDir, UserDir),
538    _SysDir = ssh_test_lib:setup_host_key_create_dir(AlgServer, DataDir, UserDir),
539try    ct:log("~p:~p AlgClient=~p, AlgServer=~p~nPrivDir ~p:~n~p~n~nSYsDir=~p~nPrivDir/system: ~p",
540           [?MODULE,?LINE,
541            AlgClient, AlgServer,
542            proplists:get_value(priv_dir,Config),
543            file:list_dir(proplists:get_value(priv_dir,Config)),
544            _SysDir,
545            catch file:list_dir(
546                    filename:join(proplists:get_value(priv_dir,Config),
547                                  system))
548           ])
549catch _C:_E:_S ->
550        ct:log("~p:~p  ~p:~p~n~p",[?MODULE,?LINE,_C,_E,_S])
551end,
552    Config;
553
554setup_pubkey([Alg], Config) ->
555    DataDir = proplists:get_value(data_dir, Config),
556    PrivDir = proplists:get_value(priv_dir, Config),
557    ct:log("Setup keys for ~p",[Alg]),
558    ssh_test_lib:setup_user_key(Alg, DataDir, PrivDir),
559    ssh_test_lib:setup_host_key_create_dir(Alg, DataDir, PrivDir),
560    Config.
561
562
563simple_exec_group(I, Config) when is_integer(I) ->
564    simple_exec_group({I,I,I}, Config);
565simple_exec_group({Min,I,Max}, Config) ->
566    {Host,Port} = proplists:get_value(srvr_addr, Config),
567    ssh_test_lib:std_simple_exec(Host, Port, Config,
568				 [proplists:get_value(pref_algs,Config),
569                                  {dh_gex_limits,{Min,I,Max}}]).
570
571