1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2004-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_test_lib). 24 25-export([ 26connect/2, 27connect/3, 28daemon/1, 29daemon/2, 30daemon/3, 31daemon_port/1, 32daemon_port/2, 33gen_tcp_connect/2, 34gen_tcp_connect/3, 35open_sshc/3, 36open_sshc/4, 37open_sshc_cmd/3, 38open_sshc_cmd/4, 39std_daemon/2, 40std_daemon1/2, 41std_connect/4, 42std_simple_sftp/3, 43std_simple_sftp/4, 44std_simple_exec/3, 45std_simple_exec/4, 46start_shell/2, 47start_shell/3, 48start_io_server/0, 49init_io_server/1, 50loop_io_server/2, 51io_request/5, 52io_reply/3, 53reply/2, 54rcv_expected/3, 55rcv_lingering/1, 56receive_exec_result/1, 57receive_exec_result_or_fail/1, 58receive_exec_end/2, 59receive_exec_end/3, 60receive_exec_result/3, 61failfun/2, 62hostname/0, 63del_dirs/1, 64del_dir_contents/1, 65do_del_files/2, 66openssh_sanity_check/1, 67default_algorithms/1, 68default_algorithms/3, 69default_algorithms/2, 70run_fake_ssh/1, 71extract_algos/1, 72get_atoms/1, 73intersection/2, 74intersect/2, 75intersect_bi_dir/1, 76some_empty/1, 77sort_spec/1, 78sshc/1, 79ssh_type/0, 80ssh_type1/0, 81installed_ssh_version/1, 82algo_intersection/2, 83to_atoms/1, 84ssh_supports/2, 85has_inet6_address/0, 86open_port/1, 87open_port/2, 88sleep_millisec/1, 89sleep_microsec/1, 90busy_wait/2, 91get_kex_init/1, 92get_kex_init/3, 93expected_state/1, 94random_chars/1, 95create_random_dir/1, 96match_ip/2, 97match_ip0/2, 98match_ip1/2, 99mangle_connect_address/1, 100mangle_connect_address/2, 101loopback/1, 102mangle_connect_address1/2, 103ntoa/1, 104try_enable_fips_mode/0, 105is_cryptolib_fips_capable/0, 106report/2, 107lc_name_in/1, 108ptty_supported/0, 109has_WSL/0, 110winpath_to_linuxpath/1, 111copy_recursive/2, 112mk_dir_path/1, 113setup_all_user_host_keys/1, 114setup_all_user_host_keys/2, 115setup_all_user_host_keys/3, 116setup_all_host_keys/1, 117setup_all_host_keys/2, 118setup_all_user_keys/2, 119setup_user_key/3, 120setup_host_key_create_dir/3, 121setup_host_key/3, 122setup_known_host/3, 123get_addr_str/0, 124file_base_name/2 125 ]). 126 127-include_lib("common_test/include/ct.hrl"). 128-include("ssh_transport.hrl"). 129-include_lib("kernel/include/file.hrl"). 130-include("ssh_test_lib.hrl"). 131 132%%%---------------------------------------------------------------- 133connect(Port, Options) when is_integer(Port) -> 134 connect(hostname(), Port, Options). 135 136connect(any, Port, Options) -> 137 connect(hostname(), Port, Options); 138 139connect(Host, ?SSH_DEFAULT_PORT, Options0) -> 140 Options = 141 set_opts_if_not_set([{silently_accept_hosts, true}, 142 {save_accepted_host, false}, 143 {user_interaction, false} 144 ], Options0), 145 do_connect(Host, ?SSH_DEFAULT_PORT, Options); 146 147connect(Host, Port, Options0) -> 148 Options = 149 case proplists:get_value(user_dir,Options0) of 150 undefined -> 151 %% Avoid uppdating the known_hosts if it is the default one 152 set_opts_if_not_set([{save_accepted_host, false}], Options0); 153 _ -> 154 Options0 155 end, 156 do_connect(Host, Port, Options). 157 158 159do_connect(Host, Port, Options) -> 160 R = ssh:connect(Host, Port, Options), 161 ct:log("~p:~p ssh:connect(~p, ~p, ~p)~n -> ~p",[?MODULE,?LINE,Host, Port, Options, R]), 162 {ok, ConnectionRef} = R, 163 ConnectionRef. 164 165set_opts_if_not_set(OptsToSet, Options0) -> 166 lists:foldl(fun({K,V}, Opts) -> 167 case proplists:get_value(K, Opts) of 168 undefined -> 169 [{K,V} | Opts]; 170 _ -> 171 Opts 172 end 173 end, Options0, OptsToSet). 174 175%%%---------------------------------------------------------------- 176daemon(Options) -> 177 daemon(any, 0, Options). 178 179daemon(Port, Options) when is_integer(Port) -> 180 daemon(any, Port, Options); 181daemon(Host, Options) -> 182 daemon(Host, 0, Options). 183 184 185daemon(Host, Port, Options) -> 186 ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), 187 case ssh:daemon(Host, Port, Options) of 188 {ok, Pid} -> 189 R = ssh:daemon_info(Pid), 190 ct:log("~p:~p ssh:daemon_info(~p) ->~n ~p",[?MODULE,?LINE,Pid,R]), 191 {ok,L} = R, 192 ListenPort = proplists:get_value(port, L), 193 ListenIP = proplists:get_value(ip, L), 194 {Pid, ListenIP, ListenPort}; 195 Error -> 196 ct:log("ssh:daemon error ~p",[Error]), 197 Error 198 end. 199 200%%%---------------------------------------------------------------- 201daemon_port(Pid) -> daemon_port(0, Pid). 202 203 204daemon_port(0, Pid) -> {ok,Dinf} = ssh:daemon_info(Pid), 205 proplists:get_value(port, Dinf); 206daemon_port(Port, _) -> Port. 207 208%%%---------------------------------------------------------------- 209gen_tcp_connect(Port, Options) -> 210 gen_tcp_connect("localhost", Port, Options). 211 212gen_tcp_connect(Host0, Port, Options) -> 213 Host = ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(Host0)), 214 ct:log("~p:~p gen_tcp:connect(~p, ~p, ~p)~nHost0 = ~p", 215 [?MODULE,?LINE, Host, Port, Options, Host0]), 216 Result = gen_tcp:connect(Host, Port, Options), 217 ct:log("~p:~p Result = ~p", [?MODULE,?LINE, Result]), 218 Result. 219 220%%%---------------------------------------------------------------- 221open_sshc(Host0, Port, OptStr) -> 222 open_sshc(Host0, Port, OptStr, ""). 223 224open_sshc(Host0, Port, OptStr, ExecStr) -> 225 Cmd = open_sshc_cmd(Host0, Port, OptStr, ExecStr), 226 Result = os:cmd(Cmd), 227 ct:log("~p:~p Result = ~p", [?MODULE,?LINE, Result]), 228 Result. 229 230 231open_sshc_cmd(Host, Port, OptStr) -> 232 open_sshc_cmd(Host, Port, OptStr, ""). 233 234open_sshc_cmd(Host0, Port, OptStr, ExecStr) -> 235 Host = ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(Host0)), 236 Cmd = lists:flatten(["ssh -p ", integer_to_list(Port), 237 " ", OptStr, 238 " ", Host, 239 " ", ExecStr]), 240 ct:log("~p:~p OpenSSH Cmd = ~p", [?MODULE,?LINE, Cmd]), 241 Cmd. 242 243%%%---------------------------------------------------------------- 244std_daemon(Config, ExtraOpts) -> 245 PrivDir = proplists:get_value(priv_dir, Config), 246 UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth 247 file:make_dir(UserDir), 248 std_daemon1(Config, 249 ExtraOpts ++ 250 [{user_dir, UserDir}, 251 {user_passwords, [{"usr1","pwd1"}]}]). 252 253std_daemon1(Config, ExtraOpts) -> 254 SystemDir = proplists:get_value(data_dir, Config), 255 {_Server, _Host, _Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, 256 {failfun, fun ssh_test_lib:failfun/2} 257 | ExtraOpts]). 258 259%%%---------------------------------------------------------------- 260std_connect(Config, Host, Port, ExtraOpts) -> 261 UserDir = proplists:get_value(priv_dir, Config), 262 _ConnectionRef = 263 ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, 264 {user_dir, UserDir}, 265 {user, "usr1"}, 266 {password, "pwd1"}, 267 {user_interaction, false} 268 | ExtraOpts]). 269 270%%%---------------------------------------------------------------- 271std_simple_sftp(Host, Port, Config) -> 272 std_simple_sftp(Host, Port, Config, []). 273 274std_simple_sftp(Host, Port, Config, Opts) -> 275 UserDir = proplists:get_value(priv_dir, Config), 276 DataFile = filename:join(UserDir, "test.data"), 277 ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), 278 {ok, ChannelRef} = ssh_sftp:start_channel(ConnectionRef), 279 Data = crypto:strong_rand_bytes(proplists:get_value(std_simple_sftp_size,Config,10)), 280 ok = ssh_sftp:write_file(ChannelRef, DataFile, Data), 281 {ok,ReadData} = file:read_file(DataFile), 282 {Data == ReadData, ConnectionRef}. 283 284%%%---------------------------------------------------------------- 285std_simple_exec(Host, Port, Config) -> 286 std_simple_exec(Host, Port, Config, []). 287 288std_simple_exec(Host, Port, Config, Opts) -> 289 ct:log("~p:~p std_simple_exec",[?MODULE,?LINE]), 290 ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), 291 ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]), 292 {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), 293 ct:log("~p:~p session_channel ok ~p",[?MODULE,?LINE,ChannelId]), 294 ExecResult = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), 295 ct:log("~p:~p exec ~p",[?MODULE,?LINE,ExecResult]), 296 case ExecResult of 297 success -> 298 Expected = {ssh_cm, ConnectionRef, {data,ChannelId,0,<<"42">>}}, 299 case receive_exec_result(Expected) of 300 expected -> 301 ok; 302 Other -> 303 ct:fail(Other) 304 end, 305 receive_exec_end(ConnectionRef, ChannelId), 306 ssh:close(ConnectionRef); 307 _ -> 308 ct:fail(ExecResult) 309 end. 310 311%%%---------------------------------------------------------------- 312start_shell(Port, IOServer) -> 313 start_shell(Port, IOServer, []). 314 315start_shell(Port, IOServer, ExtraOptions) -> 316 spawn_link( 317 fun() -> 318 ct:log("~p:~p:~p ssh_test_lib:start_shell(~p, ~p, ~p)", 319 [?MODULE,?LINE,self(), Port, IOServer, ExtraOptions]), 320 Options = [{user_interaction, false}, 321 {silently_accept_hosts,true}, 322 {save_accepted_host,false} 323 | ExtraOptions], 324 try 325 group_leader(IOServer, self()), 326 case Port of 327 22 -> 328 Host = hostname(), 329 ct:log("Port==22 Call ssh:shell(~p, ~p)", 330 [Host, Options]), 331 ssh:shell(Host, Options); 332 _ when is_integer(Port) -> 333 Host = hostname(), 334 ct:log("is_integer(Port) Call ssh:shell(~p, ~p, ~p)", 335 [Host, Port, Options]), 336 ssh:shell(Host, Port, Options); 337 ConnRef when is_pid(ConnRef) -> 338 ct:log("is_pid(ConnRef) Call ssh:shell(~p)", 339 [ConnRef]), 340 ssh:shell(ConnRef); % Options were given in ssh:connect 341 Socket -> 342 receive 343 start -> ok 344 end, 345 ct:log("Socket Call ssh:shell(~p, ~p)", 346 [Socket, Options]), 347 ssh:shell(Socket, Options) 348 end 349 of 350 R -> 351 ct:log("~p:~p ssh_test_lib:start_shell(~p, ~p, ~p) -> ~p", 352 [?MODULE,?LINE,Port, IOServer, ExtraOptions, R]) 353 catch 354 C:E:S -> 355 ct:log("Exception ~p:~p~n~p", [C,E,S]), 356 ct:fail("Exception",[]) 357 end 358 end). 359 360 361%%%---------------------------------------------------------------- 362start_io_server() -> 363 spawn_link(?MODULE, init_io_server, [self()]). 364 365init_io_server(TestCase) -> 366 process_flag(trap_exit, true), 367 loop_io_server(TestCase, []). 368 369loop_io_server(TestCase, Buff0) -> 370 receive 371 {input, TestCase, Line} = _INP -> 372 %%ct:log("io_server ~p:~p ~p got ~p",[?MODULE,?LINE,self(),_INP]), 373 loop_io_server(TestCase, Buff0 ++ [Line]); 374 {io_request, From, ReplyAs, Request} = _REQ-> 375 %%ct:log("io_server ~p:~p ~p got ~p",[?MODULE,?LINE,self(),_REQ]), 376 {ok, Reply, Buff} = io_request(Request, TestCase, From, 377 ReplyAs, Buff0), 378 %%ct:log("io_server ~p:~p ~p going to reply ~p",[?MODULE,?LINE,self(),Reply]), 379 io_reply(From, ReplyAs, Reply), 380 loop_io_server(TestCase, Buff); 381 {'EXIT',_, _} = _Exit -> 382 ct:log("ssh_test_lib:loop_io_server/2 got ~p",[_Exit]), 383 ok 384 after 385 30000 -> ct:fail("timeout ~p:~p",[?MODULE,?LINE]) 386 end. 387 388io_request(getopts,_TestCase, _, _, Buff) -> 389 {ok, [], Buff}; 390io_request({get_geometry,columns},_TestCase, _, _, Buff) -> 391 {ok, 80, Buff}; 392io_request({get_geometry,rows},_TestCase, _, _, Buff) -> 393 {ok, 24, Buff}; 394io_request({put_chars, Chars}, TestCase, _, _, Buff) -> 395 reply(TestCase, Chars), 396 {ok, ok, Buff}; 397io_request({put_chars, unicode, Chars}, TestCase, _, _, Buff) when is_binary(Chars) -> 398 reply(TestCase, Chars), 399 {ok, ok, Buff}; 400io_request({put_chars, unicode, io_lib, format, [Fmt,Args]}, TestCase, _, _, Buff) -> 401 reply(TestCase, unicode:characters_to_binary(io_lib:format(Fmt,Args))), 402 {ok, ok, Buff}; 403io_request({put_chars, Enc, Chars}, TestCase, _, _, Buff) -> 404 reply(TestCase, unicode:characters_to_binary(Chars,Enc,latin1)), 405 {ok, ok, Buff}; 406 407io_request({get_line, _} = Request, _, From, ReplyAs, [] = Buff) -> 408 erlang:send_after(1000, self(), {io_request, From, ReplyAs, Request}), 409 {ok, [], Buff}; 410io_request({get_line, _Enc, _Prompt} = Request, _, From, ReplyAs, [] = Buff) -> 411 erlang:send_after(1000, self(), {io_request, From, ReplyAs, Request}), 412 {ok, [], Buff}; 413 414io_request({get_line, _Enc,_}, _, _, _, [Line | Buff]) -> 415 {ok, Line, Buff}. 416 417 418io_reply(_, _, []) -> 419 ok; 420io_reply(From, ReplyAs, Reply) -> 421%%ct:log("io_reply ~p sending ~p ! ~p",[self(),From, {io_reply, ReplyAs, Reply}]), 422 From ! {io_reply, ReplyAs, Reply}. 423 424reply(_, []) -> 425 ok; 426reply(TestCase, Result) -> 427%%ct:log("reply ~p sending ~p ! ~p",[self(), TestCase, Result]), 428 TestCase ! Result. 429 430%%%---------------------------------------------------------------- 431rcv_expected(Expect, SshPort, Timeout) -> 432 receive 433 {SshPort, Recvd} when is_function(Expect) -> 434 case Expect(Recvd) of 435 true -> 436 ct:log("Got expected ~p from ~p",[Recvd,SshPort]), 437 catch port_close(SshPort), 438 rcv_lingering(50); 439 false -> 440 ct:log("Got UNEXPECTED ~p~n",[Recvd]), 441 rcv_expected(Expect, SshPort, Timeout) 442 end; 443 {SshPort, Expect} -> 444 ct:log("Got expected ~p from ~p",[Expect,SshPort]), 445 catch port_close(SshPort), 446 rcv_lingering(50); 447 Other -> 448 ct:log("Got UNEXPECTED ~p~nExpect ~p",[Other, {SshPort,Expect}]), 449 rcv_expected(Expect, SshPort, Timeout) 450 451 after Timeout -> 452 catch port_close(SshPort), 453 ct:fail("Did not receive answer") 454 end. 455 456rcv_lingering(Timeout) -> 457 receive 458 Msg -> 459 ct:log("Got LINGERING ~p",[Msg]), 460 rcv_lingering(Timeout) 461 462 after Timeout -> 463 ct:log("No more lingering messages",[]), 464 ok 465 end. 466 467 468receive_exec_result([]) -> 469 expected; 470receive_exec_result(Msgs) when is_list(Msgs) -> 471 ct:log("~p:~p Expect data! ~p", [?MODULE,?FUNCTION_NAME,Msgs]), 472 receive 473 Msg -> 474 case lists:member(Msg, Msgs) 475 orelse lists:member({optional,Msg}, Msgs) 476 of 477 true -> 478 ct:log("~p:~p Collected data ~p", [?MODULE,?FUNCTION_NAME,Msg]), 479 receive_exec_result(Msgs--[Msg,{optional,Msg}]); 480 false -> 481 case Msg of 482 {ssh_cm,_,{data,_,1, Data}} -> 483 ct:log("~p:~p unexpected StdErr: ~p~n~p~n", [?MODULE,?FUNCTION_NAME,Data,Msg]), 484 receive_exec_result(Msgs); 485 Other -> 486 ct:log("~p:~p unexpected Other ~p", [?MODULE,?FUNCTION_NAME,Other]), 487 {unexpected_msg, Other} 488 end 489 end 490 after 491 30000 -> 492 case lists:all(fun(M) -> 493 is_tuple(M) andalso (element(1,M) == optional) 494 end, Msgs) 495 of 496 false -> 497 ct:fail("timeout ~p:~p",[?MODULE,?FUNCTION_NAME]); 498 true -> 499 ct:log("~p:~p Only optional messages expected!~n ~p", [?MODULE,?FUNCTION_NAME,Msgs]), 500 expected 501 end 502 end; 503receive_exec_result(Msg) -> 504 receive_exec_result([Msg]). 505 506 507receive_exec_result_or_fail(Msg) -> 508 case receive_exec_result(Msg) of 509 expected -> expected; 510 Other -> ct:fail(Other) 511 end. 512 513receive_exec_end(ConnectionRef, ChannelId) -> 514 receive_exec_end(ConnectionRef, ChannelId, 0). 515 516receive_exec_end(ConnectionRef, ChannelId, ExitStatus) -> 517 receive_exec_result( 518 [{ssh_cm, ConnectionRef, {eof, ChannelId}}, 519 {optional, {ssh_cm, ConnectionRef, {exit_status, ChannelId, ExitStatus}}}, 520 {ssh_cm, ConnectionRef, {closed, ChannelId}} 521 ]). 522 523receive_exec_result(Data, ConnectionRef, ChannelId) -> 524 Eof = {ssh_cm, ConnectionRef, {eof, ChannelId}}, 525 Closed = {ssh_cm, ConnectionRef,{closed, ChannelId}}, 526 expected = receive_exec_result(Data), 527 expected = receive_exec_result(Eof), 528 expected = receive_exec_result(Closed). 529 530 531failfun(_User, {authmethod,none}) -> 532 ok; 533failfun(User, Reason) -> 534 error_logger:format("~p failed XXX to login: ~p~n", [User, Reason]). 535 536hostname() -> 537 {ok,Host} = inet:gethostname(), 538 Host. 539 540del_dirs(Dir) -> 541 del_dir_contents(Dir), 542 file:del_dir(Dir), 543 ok. 544 545 546del_dir_contents(Dir) -> 547 case file:list_dir(Dir) of 548 {ok, Files} -> 549 do_del_files(Dir, Files); 550 _ -> 551 ok 552 end. 553 554do_del_files(Dir, Files) -> 555 lists:foreach(fun(File) -> 556 FullPath = filename:join(Dir,File), 557 case filelib:is_dir(FullPath) of 558 true -> 559 del_dirs(FullPath); 560 false -> 561 file:delete(FullPath) 562 end 563 end, Files). 564 565 566openssh_sanity_check(Config) -> 567 ssh:start(), 568 case ssh:connect("localhost", ?SSH_DEFAULT_PORT, 569 [{password,""}, 570 {silently_accept_hosts, true}, 571 {save_accepted_host, false}, 572 {user_interaction, false} 573 ]) of 574 {ok, Pid} -> 575 ssh:close(Pid), 576 ssh:stop(), 577 Config; 578 Err -> 579 Str = lists:append(io_lib:format("~p", [Err])), 580 ssh:stop(), 581 {skip, Str} 582 end. 583 584%%%-------------------------------------------------------------------- 585%%% Probe a server or a client about algorithm support 586 587default_algorithms(sshd) -> 588 default_algorithms(sshd, "localhost", 22); 589 590default_algorithms(sshc) -> 591 default_algorithms(sshc, []). 592 593default_algorithms(sshd, Host, Port) -> 594 try run_fake_ssh( 595 ssh_trpt_test_lib:exec( 596 [{connect,Host,Port, [{silently_accept_hosts, true}, 597 {save_accepted_host, false}, 598 {user_interaction, false}]}])) 599 catch 600 _C:_E -> 601 ct:log("***~p:~p: ~p:~p",[?MODULE,?LINE,_C,_E]), 602 [] 603 end. 604 605default_algorithms(sshc, DaemonOptions) -> 606 Parent = self(), 607 %% Start a process handling one connection on the server side: 608 Srvr = 609 spawn_link( 610 fun() -> 611 Parent ! 612 {result, self(), 613 try 614 {ok,InitialState} = ssh_trpt_test_lib:exec(listen), 615 Parent ! {hostport,self(),ssh_trpt_test_lib:server_host_port(InitialState)}, 616 run_fake_ssh( 617 ssh_trpt_test_lib:exec([{accept, DaemonOptions}], 618 InitialState)) 619 catch 620 _C:_E -> 621 ct:log("***~p:~p: ~p:~p",[?MODULE,?LINE,_C,_E]), 622 [] 623 end} 624 end), 625 626 receive 627 {hostport,Srvr,{_Host,Port}} -> 628 spawn(fun()-> os:cmd(lists:concat(["ssh -o \"StrictHostKeyChecking no\" -p ",Port," localhost"])) end) 629 after ?TIMEOUT -> 630 ct:fail("No server respons (timeout) 1") 631 end, 632 633 receive 634 {result,Srvr,L} -> 635 L 636 after ?TIMEOUT -> 637 ct:fail("No server respons (timeout) 2") 638 end. 639 640run_fake_ssh({ok,InitialState}) -> 641 KexInitPattern = 642 #ssh_msg_kexinit{ 643 kex_algorithms = '$kex_algorithms', 644 server_host_key_algorithms = '$server_host_key_algorithms', 645 encryption_algorithms_client_to_server = '$encryption_algorithms_client_to_server', 646 encryption_algorithms_server_to_client = '$encryption_algorithms_server_to_client', 647 mac_algorithms_client_to_server = '$mac_algorithms_client_to_server', 648 mac_algorithms_server_to_client = '$mac_algorithms_server_to_client', 649 compression_algorithms_client_to_server = '$compression_algorithms_client_to_server', 650 compression_algorithms_server_to_client = '$compression_algorithms_server_to_client', 651 _ = '_' 652 }, 653 {ok,E} = ssh_trpt_test_lib:exec([{set_options,[silent]}, 654 {send, hello}, 655 receive_hello, 656 {send, ssh_msg_kexinit}, 657 {match, KexInitPattern, receive_msg}, 658 close_socket 659 ], 660 InitialState), 661 [Kex, PubKey, EncC2S, EncS2C, MacC2S, MacS2C, CompC2S, CompS2C] = 662 ssh_trpt_test_lib:instantiate(['$kex_algorithms', 663 '$server_host_key_algorithms', 664 '$encryption_algorithms_client_to_server', 665 '$encryption_algorithms_server_to_client', 666 '$mac_algorithms_client_to_server', 667 '$mac_algorithms_server_to_client', 668 '$compression_algorithms_client_to_server', 669 '$compression_algorithms_server_to_client' 670 ], E), 671 [{kex, to_atoms(Kex)}, 672 {public_key, to_atoms(PubKey)}, 673 {cipher, [{client2server, to_atoms(EncC2S)}, 674 {server2client, to_atoms(EncS2C)}]}, 675 {mac, [{client2server, to_atoms(MacC2S)}, 676 {server2client, to_atoms(MacS2C)}]}, 677 {compression, [{client2server, to_atoms(CompC2S)}, 678 {server2client, to_atoms(CompS2C)}]}]. 679 680 681%%%---------------------------------------------------------------- 682extract_algos(Spec) -> 683 [{Tag,get_atoms(List)} || {Tag,List} <- Spec]. 684 685get_atoms(L) -> 686 lists:usort( 687 [ A || X <- L, 688 A <- case X of 689 {_,L1} when is_list(L1) -> L1; 690 Y when is_atom(Y) -> [Y] 691 end]). 692 693 694intersection(AlgoSpec1, AlgoSpec2) -> intersect(sort_spec(AlgoSpec1), sort_spec(AlgoSpec2)). 695 696intersect([{Tag,S1}|Ss1], [{Tag,S2}|Ss2]) -> 697 [{Tag,intersect(S1,S2)} | intersect(Ss1,Ss2)]; 698intersect(L1=[A1|_], L2=[A2|_]) when is_atom(A1),is_atom(A2) -> 699 Diff = L1 -- L2, 700 L1 -- Diff; 701intersect(_, _) -> 702 []. 703 704intersect_bi_dir([{Tag,[{client2server,L1},{server2client,L2}]}|T]) -> 705 [{Tag,intersect(L1,L2)} | intersect_bi_dir(T)]; 706intersect_bi_dir([H={_,[A|_]}|T]) when is_atom(A) -> 707 [H | intersect_bi_dir(T)]; 708intersect_bi_dir([]) -> 709 []. 710 711some_empty([]) -> 712 false; 713some_empty([{_,[]}|_]) -> 714 true; 715some_empty([{_,L}|T]) when is_atom(hd(L)) -> 716 some_empty(T); 717some_empty([{_,L}|T]) when is_tuple(hd(L)) -> 718 some_empty(L) orelse some_empty(T). 719 720 721sort_spec(L = [{_,_}|_] ) -> [{Tag,sort_spec(Es)} || {Tag,Es} <- L]; 722sort_spec(L) -> lists:usort(L). 723 724%%-------------------------------------------------------------------- 725sshc(Tag) -> 726 to_atoms( 727 string:tokens(os:cmd(lists:concat(["ssh -Q ",Tag])), "\n") 728 ). 729 730ssh_type() -> 731 Parent = self(), 732 Pid = spawn(fun() -> 733 Parent ! {ssh_type,self(),ssh_type1()} 734 end), 735 MonitorRef = monitor(process, Pid), 736 receive 737 {ssh_type, Pid, Result} -> 738 demonitor(MonitorRef), 739 Result; 740 {'DOWN', MonitorRef, process, Pid, _Info} -> 741 ct:log("~p:~p Process DOWN",[?MODULE,?LINE]), 742 not_found 743 after 744 10000 -> 745 ct:log("~p:~p Timeout",[?MODULE,?LINE]), 746 demonitor(MonitorRef), 747 not_found 748 end. 749 750 751ssh_type1() -> 752 try 753 ct:log("~p:~p os:find_executable(\"ssh\")",[?MODULE,?LINE]), 754 case os:find_executable("ssh") of 755 false -> 756 ct:log("~p:~p Executable \"ssh\" not found",[?MODULE,?LINE]), 757 not_found; 758 Path -> 759 ct:log("~p:~p Found \"ssh\" at ~p",[?MODULE,?LINE,Path]), 760 case installed_ssh_version(timeout) of 761 Version = "OpenSSH" ++ _ -> 762 ct:log("~p:~p Found OpenSSH ~p",[?MODULE,?LINE,Version]), 763 openSSH; 764 Other -> 765 ct:log("ssh client ~p is unknown",[Other]), 766 unknown 767 end 768 end 769 catch 770 Class:Exception -> 771 ct:log("~p:~p Exception ~p:~p",[?MODULE,?LINE,Class,Exception]), 772 not_found 773 end. 774 775installed_ssh_version(TimeoutReturn) -> 776 Parent = self(), 777 Pid = spawn(fun() -> 778 Parent ! {open_ssh_version, os:cmd("ssh -V")} 779 end), 780 receive 781 {open_ssh_version, V} -> 782 V 783 after ?TIMEOUT -> 784 exit(Pid, kill), 785 TimeoutReturn 786 end. 787 788 789 790 791algo_intersection([], _) -> []; 792algo_intersection(_, []) -> []; 793algo_intersection(L1=[A1|_], L2=[A2|_]) when is_atom(A1), is_atom(A2) -> 794 true = lists:all(fun erlang:is_atom/1, L1++L2), 795 lists:foldr(fun(A,Acc) -> 796 case lists:member(A,L2) of 797 true -> [A|Acc]; 798 false -> Acc 799 end 800 end, [], L1); 801algo_intersection([{K,V1}|T1], L2) -> 802 case lists:keysearch(K,1,L2) of 803 {value, {K,V2}} -> 804 [{K,algo_intersection(V1,V2)} | algo_intersection(T1,L2)]; 805 false -> 806 algo_intersection(T1,L2) 807 end; 808algo_intersection(_, _) -> 809 []. 810 811 812to_atoms(L) -> lists:map(fun erlang:list_to_atom/1, L). 813 814%%%---------------------------------------------------------------- 815ssh_supports(Alg, SshDefaultAlg_tag) -> 816 SupAlgs = 817 case proplists:get_value(SshDefaultAlg_tag, 818 ssh:default_algorithms()) of 819 [{_K1,L1}, {_K2,L2}] -> 820 lists:usort(L1++L2); 821 L -> 822 L 823 end, 824 if 825 is_atom(Alg) -> 826 lists:member(Alg, SupAlgs); 827 is_list(Alg) -> 828 case Alg--SupAlgs of 829 [] -> 830 true; 831 UnSup -> 832 {false,UnSup} 833 end 834 end. 835 836%%%---------------------------------------------------------------- 837has_inet6_address() -> 838 try 839 [throw(6) || {ok,L} <- [inet:getifaddrs()], 840 {_,L1} <- L, 841 {addr,{_,_,_,_,_,_,_,_}} <- L1] 842 of 843 [] -> false 844 catch 845 throw:6 -> true 846 end. 847 848%%%---------------------------------------------------------------- 849open_port(Arg1) -> 850 ?MODULE:open_port(Arg1, []). 851 852open_port(Arg1, ExtraOpts) -> 853 erlang:open_port(Arg1, 854 [binary, 855 stderr_to_stdout, 856 exit_status, 857 use_stdio, 858 overlapped_io, hide %only affects windows 859 | ExtraOpts]). 860 861%%%---------------------------------------------------------------- 862%%% Sleeping 863 864%%% Milli sec 865sleep_millisec(Nms) -> receive after Nms -> ok end. 866 867%%% Micro sec 868sleep_microsec(Nus) -> 869 busy_wait(Nus, erlang:system_time(microsecond)). 870 871busy_wait(Nus, T0) -> 872 T = erlang:system_time(microsecond) - T0, 873 Tleft = Nus - T, 874 if 875 Tleft > 2000 -> 876 sleep_millisec((Tleft-1500) div 1000), % μs -> ms 877 busy_wait(Nus,T0); 878 Tleft > 1 -> 879 busy_wait(Nus, T0); 880 true -> 881 T 882 end. 883 884%%%---------------------------------------------------------------- 885%% get_kex_init - helper function to get key_exchange_init_msg 886 887get_kex_init(Conn) -> 888 Ref = make_ref(), 889 {ok,TRef} = timer:send_after(15000, {reneg_timeout,Ref}), 890 get_kex_init(Conn, Ref, TRef). 891 892get_kex_init(Conn, Ref, TRef) -> 893 %% First, validate the key exchange is complete (StateName == connected) 894 {State, S} = sys:get_state(Conn), 895 case expected_state(State) of 896 true -> 897 timer:cancel(TRef), 898 %% Next, walk through the elements of the #state record looking 899 %% for the #ssh_msg_kexinit record. This method is robust against 900 %% changes to either record. The KEXINIT message contains a cookie 901 %% unique to each invocation of the key exchange procedure (RFC4253) 902 SL = tuple_to_list(S), 903 case lists:keyfind(ssh_msg_kexinit, 1, SL) of 904 false -> 905 throw(not_found); 906 KexInit -> 907 KexInit 908 end; 909 910 false -> 911 receive 912 {reneg_timeout,Ref} -> 913 ct:log("~p:~p Not in 'connected' state: ~p but reneg_timeout received. Fail.", 914 [?MODULE,?LINE,State]), 915 ct:log("S = ~p", [S]), 916 ct:fail(reneg_timeout) 917 after 0 -> 918 ct:log("~p:~p Not in 'connected' state: ~p, Will try again after 100ms",[?MODULE,?LINE,State]), 919 timer:sleep(100), % If renegotiation is complete we do not 920 % want to exit on the reneg_timeout 921 get_kex_init(Conn, Ref, TRef) 922 end 923 end. 924 925expected_state({ext_info,_,_}) -> true; 926expected_state({connected,_}) -> true; 927expected_state(_) -> false. 928 929%%%---------------------------------------------------------------- 930%%% Return a string with N random characters 931%%% 932random_chars(N) -> [($a-1)+rand:uniform($z-$a) || _<-lists:duplicate(N,x)]. 933 934 935create_random_dir(Config) -> 936 PrivDir = proplists:get_value(priv_dir, Config), 937 Name = filename:join(PrivDir, random_chars(15)), 938 case file:make_dir(Name) of 939 ok -> 940 Name; 941 {error,eexist} -> 942 %% The Name already denotes an existing file system object, try again. 943 %% The likelyhood of always generating an existing file name is low 944 create_random_dir(Config) 945 end. 946 947%%%---------------------------------------------------------------- 948match_ip(A, B) -> 949 R = match_ip0(A,B) orelse match_ip0(B,A), 950 ct:log("match_ip(~p, ~p) -> ~p",[A, B, R]), 951 R. 952 953match_ip0(A, A) -> 954 true; 955match_ip0(any, _) -> 956 true; 957match_ip0(A, B) -> 958 case match_ip1(A, B) of 959 true -> 960 true; 961 false when is_list(A) -> 962 case inet:parse_address(A) of 963 {ok,IPa} -> match_ip0(IPa, B); 964 _ -> false 965 end; 966 false when is_list(B) -> 967 case inet:parse_address(B) of 968 {ok,IPb} -> match_ip0(A, IPb); 969 _ -> false 970 end; 971 false -> 972 false 973 end. 974 975match_ip1(any, _) -> true; 976match_ip1(loopback, {127,_,_,_}) -> true; 977match_ip1({0,0,0,0}, {127,_,_,_}) -> true; 978match_ip1(loopback, {0,0,0,0,0,0,0,1}) -> true; 979match_ip1({0,0,0,0,0,0,0,0}, {0,0,0,0,0,0,0,1}) -> true; 980match_ip1(_, _) -> false. 981 982%%%---------------------------------------------------------------- 983mangle_connect_address(A) -> 984 mangle_connect_address(A, []). 985 986mangle_connect_address(A, SockOpts) -> 987 mangle_connect_address1(A, proplists:get_value(inet6,SockOpts,false)). 988 989loopback(true) -> {0,0,0,0,0,0,0,1}; 990loopback(false) -> {127,0,0,1}. 991 992mangle_connect_address1( loopback, V6flg) -> loopback(V6flg); 993mangle_connect_address1( any, V6flg) -> loopback(V6flg); 994mangle_connect_address1({0,0,0,0}, _) -> loopback(false); 995mangle_connect_address1({0,0,0,0,0,0,0,0}, _) -> loopback(true); 996mangle_connect_address1( IP, _) when is_tuple(IP) -> IP; 997mangle_connect_address1(A, _) -> 998 case catch inet:parse_address(A) of 999 {ok, {0,0,0,0}} -> loopback(false); 1000 {ok, {0,0,0,0,0,0,0,0}} -> loopback(true); 1001 _ -> A 1002 end. 1003 1004%%%---------------------------------------------------------------- 1005ntoa(A) -> 1006 try inet:ntoa(A) 1007 of 1008 {error,_} when is_atom(A) -> atom_to_list(A); 1009 {error,_} when is_list(A) -> A; 1010 S when is_list(S) -> S 1011 catch 1012 _:_ when is_atom(A) -> atom_to_list(A); 1013 _:_ when is_list(A) -> A 1014 end. 1015 1016%%%---------------------------------------------------------------- 1017try_enable_fips_mode() -> 1018 case crypto:info_fips() of 1019 enabled -> 1020 report("FIPS mode already enabled", ?LINE), 1021 ok; 1022 not_enabled -> 1023 %% Erlang/crypto configured with --enable-fips 1024 case crypto:enable_fips_mode(true) of 1025 true -> 1026 %% and also the cryptolib is fips enabled 1027 report("FIPS mode enabled", ?LINE), 1028 enabled = crypto:info_fips(), 1029 ok; 1030 false -> 1031 case is_cryptolib_fips_capable() of 1032 false -> 1033 report("No FIPS mode in cryptolib", ?LINE), 1034 {skip, "FIPS mode not supported in cryptolib"}; 1035 true -> 1036 ct:fail("Failed to enable FIPS mode", []) 1037 end 1038 end; 1039 not_supported -> 1040 report("FIPS mode not supported by Erlang/OTP", ?LINE), 1041 {skip, "FIPS mode not supported"} 1042 end. 1043 1044is_cryptolib_fips_capable() -> 1045 [{_,_,Inf}] = crypto:info_lib(), 1046 nomatch =/= re:run(Inf, "(F|f)(I|i)(P|p)(S|s)"). 1047 1048report(Comment, Line) -> 1049 ct:comment(Comment), 1050 ct:log("~p:~p try_enable_fips_mode~n" 1051 "crypto:info_lib() = ~p~n" 1052 "crypto:info_fips() = ~p~n" 1053 "crypto:supports() =~n~p~n", 1054 [?MODULE, Line, 1055 crypto:info_lib(), 1056 crypto:info_fips(), 1057 crypto:supports()]). 1058 1059%%%---------------------------------------------------------------- 1060lc_name_in(Names) -> 1061 case inet:gethostname() of 1062 {ok,Name} -> 1063 lists:member(string:to_lower(Name), Names); 1064 Other -> 1065 ct:log("~p:~p inet:gethostname() returned ~p", [?MODULE,?LINE,Other]), 1066 false 1067 end. 1068 1069ptty_supported() -> not lc_name_in([]). %%["fobi"]). 1070 1071%%%---------------------------------------------------------------- 1072has_WSL() -> 1073 os:getenv("WSLENV") =/= false. % " =/= false" =/= "== true" :) 1074 1075winpath_to_linuxpath(Path) -> 1076 case {has_WSL(), Path} of 1077 {true, [_,$:|WithoutWinInit]} -> 1078 "/mnt/c" ++ WithoutWinInit; 1079 _ -> 1080 Path 1081 end. 1082 1083%%%---------------------------------------------------------------- 1084copy_recursive(Src, Dst) -> 1085 {ok,S} = file:read_file_info(Src), 1086 case S#file_info.type of 1087 directory -> 1088 %%ct:log("~p:~p copy dir ~ts -> ~ts", [?MODULE,?LINE,Src,Dst]), 1089 {ok,Names} = file:list_dir(Src), 1090 mk_dir_path(Dst), 1091 %%ct:log("~p:~p Names = ~p", [?MODULE,?LINE,Names]), 1092 lists:foreach(fun(Name) -> 1093 copy_recursive(filename:join(Src, Name), 1094 filename:join(Dst, Name)) 1095 end, Names); 1096 _ -> 1097 %%ct:log("~p:~p copy file ~ts -> ~ts", [?MODULE,?LINE,Src,Dst]), 1098 {ok,_NumBytesCopied} = file:copy(Src, Dst) 1099 end. 1100 1101%%%---------------------------------------------------------------- 1102%% Make a directory even if parts of the path does not exist 1103 1104mk_dir_path(DirPath) -> 1105 case file:make_dir(DirPath) of 1106 {error,eexist} -> 1107 %%ct:log("~p:~p dir exists ~ts", [?MODULE,?LINE,DirPath]), 1108 ok; 1109 {error,enoent} -> 1110 %%ct:log("~p:~p try make dirname of ~ts", [?MODULE,?LINE,DirPath]), 1111 case mk_dir_path( filename:dirname(DirPath) ) of 1112 ok -> 1113 %%ct:log("~p:~p redo ~ts", [?MODULE,?LINE,DirPath]), 1114 file:make_dir(DirPath); 1115 Error -> 1116 %%ct:log("~p:~p return Error ~p ~ts", [?MODULE,?LINE,Error,DirPath]), 1117 Error 1118 end; 1119 Other -> 1120 %%ct:log("~p:~p return Other ~p ~ts", [?MODULE,?LINE,Other,DirPath]), 1121 Other 1122 end. 1123 1124%%%---------------------------------------------------------------- 1125%%% New 1126 1127setup_all_user_host_keys(Config) -> 1128 DataDir = proplists:get_value(data_dir, Config), 1129 PrivDir = proplists:get_value(priv_dir, Config), 1130 setup_all_user_host_keys(DataDir, PrivDir). 1131 1132setup_all_user_host_keys(DataDir, PrivDir) -> 1133 setup_all_user_host_keys(DataDir, PrivDir, filename:join(PrivDir,"system")). 1134 1135setup_all_user_host_keys(DataDir, UserDir, SysDir) -> 1136 lists:foldl(fun(Alg, OkAlgs) -> 1137 try 1138 ok = ssh_test_lib:setup_user_key(Alg, DataDir, UserDir), 1139 ok = ssh_test_lib:setup_host_key(Alg, DataDir, SysDir) 1140 of 1141 ok -> [Alg|OkAlgs] 1142 catch 1143 error:{badmatch, {error,enoent}} -> 1144 OkAlgs; 1145 C:E:S -> 1146 ct:log("Exception in ~p:~p for alg ~p: ~p:~p~n~p", 1147 [?MODULE,?FUNCTION_NAME,Alg,C,E,S]), 1148 OkAlgs 1149 end 1150 end, [], ssh_transport:supported_algorithms(public_key)). 1151 1152 1153setup_all_host_keys(Config) -> 1154 DataDir = proplists:get_value(data_dir, Config), 1155 PrivDir = proplists:get_value(priv_dir, Config), 1156 setup_all_host_keys(DataDir, filename:join(PrivDir,"system")). 1157 1158setup_all_host_keys(DataDir, SysDir) -> 1159 lists:foldl(fun(Alg, OkAlgs) -> 1160 try 1161 ok = ssh_test_lib:setup_host_key(Alg, DataDir, SysDir) 1162 of 1163 ok -> [Alg|OkAlgs] 1164 catch 1165 error:{badmatch, {error,enoent}} -> 1166 OkAlgs; 1167 C:E:S -> 1168 ct:log("Exception in ~p:~p for alg ~p: ~p:~p~n~p", 1169 [?MODULE,?FUNCTION_NAME,Alg,C,E,S]), 1170 OkAlgs 1171 end 1172 end, [], ssh_transport:supported_algorithms(public_key)). 1173 1174 1175setup_all_user_keys(DataDir, UserDir) -> 1176 lists:foldl(fun(Alg, OkAlgs) -> 1177 try 1178 ok = ssh_test_lib:setup_user_key(Alg, DataDir, UserDir) 1179 of 1180 ok -> [Alg|OkAlgs] 1181 catch 1182 error:{badmatch, {error,enoent}} -> 1183 OkAlgs; 1184 C:E:S -> 1185 ct:log("Exception in ~p:~p for alg ~p: ~p:~p~n~p", 1186 [?MODULE,?FUNCTION_NAME,Alg,C,E,S]), 1187 OkAlgs 1188 end 1189 end, [], ssh_transport:supported_algorithms(public_key)). 1190 1191 1192setup_user_key(SshAlg, DataDir, UserDir) -> 1193 file:make_dir(UserDir), 1194 %% Copy private user key to user's dir 1195 {ok,_} = file:copy(filename:join(DataDir, file_base_name(user_src,SshAlg)), 1196 filename:join(UserDir, file_base_name(user,SshAlg))), 1197 %% Setup authorized_keys in user's dir 1198 {ok,Pub} = file:read_file(filename:join(DataDir, file_base_name(user_src,SshAlg)++".pub")), 1199 ok = file:write_file(filename:join(UserDir, "authorized_keys"), 1200 io_lib:format("~n~s~n",[Pub]), 1201 [append]), 1202 ?ct_log_show_file( filename:join(DataDir, file_base_name(user_src,SshAlg)++".pub") ), 1203 ?ct_log_show_file( filename:join(UserDir, "authorized_keys") ), 1204 ok. 1205 1206setup_host_key_create_dir(SshAlg, DataDir, BaseDir) -> 1207 SysDir = filename:join(BaseDir,"system"), 1208 ct:log("~p:~p SshAlg=~p~nDataDir = ~p~nBaseDir = ~p~nSysDir = ~p",[?MODULE,?LINE,SshAlg, DataDir, BaseDir,SysDir]), 1209 file:make_dir(SysDir), 1210 setup_host_key(SshAlg, DataDir, SysDir), 1211 SysDir. 1212 1213setup_host_key(SshAlg, DataDir, SysDir) -> 1214 mk_dir_path(SysDir), 1215 %% Copy private host key to system's dir 1216 {ok,_} = file:copy(filename:join(DataDir, file_base_name(system_src,SshAlg)), 1217 filename:join(SysDir, file_base_name(system,SshAlg))), 1218 ?ct_log_show_file( filename:join(SysDir, file_base_name(system,SshAlg)) ), 1219 ok. 1220 1221setup_known_host(SshAlg, DataDir, UserDir) -> 1222 {ok,Pub} = file:read_file(filename:join(DataDir, file_base_name(system_src,SshAlg)++".pub")), 1223 S = lists:join(" ", lists:reverse(tl(lists:reverse(string:tokens(binary_to_list(Pub), " "))))), 1224 ok = file:write_file(filename:join(UserDir, "known_hosts"), 1225 io_lib:format("~p~n",[S])), 1226 ?ct_log_show_file( filename:join(UserDir, "known_hosts") ), 1227 ok. 1228 1229 1230get_addr_str() -> 1231 {ok, Hostname} = inet:gethostname(), 1232 {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), 1233 IP = lists:concat([A, ".", B, ".", C, ".", D]), 1234 lists:concat([Hostname,",",IP]). 1235 1236 1237file_base_name(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa"; 1238file_base_name(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa"; 1239file_base_name(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa"; 1240file_base_name(user, 'rsa-sha2-256' ) -> "id_rsa"; 1241file_base_name(user, 'rsa-sha2-384' ) -> "id_rsa"; 1242file_base_name(user, 'rsa-sha2-512' ) -> "id_rsa"; 1243file_base_name(user, 'ssh-dss' ) -> "id_dsa"; 1244file_base_name(user, 'ssh-ed25519' ) -> "id_ed25519"; 1245file_base_name(user, 'ssh-ed448' ) -> "id_ed448"; 1246file_base_name(user, 'ssh-rsa' ) -> "id_rsa"; 1247 1248file_base_name(user_src, 'ecdsa-sha2-nistp256') -> "id_ecdsa256"; 1249file_base_name(user_src, 'ecdsa-sha2-nistp384') -> "id_ecdsa384"; 1250file_base_name(user_src, 'ecdsa-sha2-nistp521') -> "id_ecdsa521"; 1251file_base_name(user_src, Alg) -> file_base_name(user, Alg); 1252 1253file_base_name(system, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; 1254file_base_name(system, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; 1255file_base_name(system, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key"; 1256file_base_name(system, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; 1257file_base_name(system, 'rsa-sha2-384' ) -> "ssh_host_rsa_key"; 1258file_base_name(system, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; 1259file_base_name(system, 'ssh-dss' ) -> "ssh_host_dsa_key"; 1260file_base_name(system, 'ssh-ed25519' ) -> "ssh_host_ed25519_key"; 1261file_base_name(system, 'ssh-ed448' ) -> "ssh_host_ed448_key"; 1262file_base_name(system, 'ssh-rsa' ) -> "ssh_host_rsa_key"; 1263 1264file_base_name(system_src, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key256"; 1265file_base_name(system_src, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key384"; 1266file_base_name(system_src, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key521"; 1267file_base_name(system_src, Alg) -> file_base_name(system, Alg). 1268 1269%%%---------------------------------------------------------------- 1270