1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2011-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(inet_tls_dist). 23 24-export([childspecs/0]). 25-export([listen/2, accept/1, accept_connection/5, 26 setup/5, close/1, select/1, address/0, is_node_name/1]). 27 28%% Generalized dist API 29-export([gen_listen/3, gen_accept/2, gen_accept_connection/6, 30 gen_setup/6, gen_close/2, gen_select/2, gen_address/1]). 31 32-export([nodelay/0]). 33 34-export([verify_client/3, cert_nodes/1]). 35 36-export([dbg/0]). % Debug 37 38-include_lib("kernel/include/net_address.hrl"). 39-include_lib("kernel/include/dist.hrl"). 40-include_lib("kernel/include/dist_util.hrl"). 41-include_lib("public_key/include/public_key.hrl"). 42 43-include("ssl_api.hrl"). 44-include_lib("kernel/include/logger.hrl"). 45 46%% ------------------------------------------------------------------------- 47 48childspecs() -> 49 {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, 50 permanent, infinity, supervisor, [ssl_dist_sup]}]}. 51 52select(Node) -> 53 gen_select(inet_tcp, Node). 54 55gen_select(Driver, Node) -> 56 case dist_util:split_node(Node) of 57 {node,_,Host} -> 58 case Driver:getaddr(Host) of 59 {ok, _} -> true; 60 _ -> false 61 end; 62 _ -> 63 false 64 end. 65 66%% ------------------------------------------------------------ 67%% Get the address family that this distribution uses 68%% ------------------------------------------------------------ 69address() -> 70 gen_address(inet_tcp). 71gen_address(Driver) -> 72 inet_tcp_dist:gen_address(Driver). 73 74%% ------------------------------------------------------------------------- 75 76is_node_name(Node) -> 77 dist_util:is_node_name(Node). 78 79%% ------------------------------------------------------------------------- 80 81hs_data_common(#sslsocket{pid = [_, DistCtrl|_]} = SslSocket) -> 82 #hs_data{ 83 f_send = 84 fun (_Ctrl, Packet) -> 85 f_send(SslSocket, Packet) 86 end, 87 f_recv = 88 fun (_, Length, Timeout) -> 89 f_recv(SslSocket, Length, Timeout) 90 end, 91 f_setopts_pre_nodeup = 92 fun (Ctrl) when Ctrl == DistCtrl -> 93 f_setopts_pre_nodeup(SslSocket) 94 end, 95 f_setopts_post_nodeup = 96 fun (Ctrl) when Ctrl == DistCtrl -> 97%%% sys:trace(Ctrl, true), 98 f_setopts_post_nodeup(SslSocket) 99 end, 100 f_getll = 101 fun (Ctrl) when Ctrl == DistCtrl -> 102 f_getll(DistCtrl) 103 end, 104 f_address = 105 fun (Ctrl, Node) when Ctrl == DistCtrl -> 106 f_address(SslSocket, Node) 107 end, 108 mf_tick = 109 fun (Ctrl) when Ctrl == DistCtrl -> 110 mf_tick(DistCtrl) 111 end, 112 mf_getstat = 113 fun (Ctrl) when Ctrl == DistCtrl -> 114 mf_getstat(SslSocket) 115 end, 116 mf_setopts = 117 fun (Ctrl, Opts) when Ctrl == DistCtrl -> 118 mf_setopts(SslSocket, Opts) 119 end, 120 mf_getopts = 121 fun (Ctrl, Opts) when Ctrl == DistCtrl -> 122 mf_getopts(SslSocket, Opts) 123 end, 124 f_handshake_complete = 125 fun (Ctrl, Node, DHandle) when Ctrl == DistCtrl -> 126 f_handshake_complete(DistCtrl, Node, DHandle) 127 end}. 128 129f_send(SslSocket, Packet) -> 130 ssl:send(SslSocket, Packet). 131 132f_recv(SslSocket, Length, Timeout) -> 133 case ssl:recv(SslSocket, Length, Timeout) of 134 {ok, Bin} when is_binary(Bin) -> 135 {ok, binary_to_list(Bin)}; 136 Other -> 137 Other 138 end. 139 140f_setopts_pre_nodeup(_SslSocket) -> 141 ok. 142 143f_setopts_post_nodeup(SslSocket) -> 144 ssl:setopts(SslSocket, [nodelay()]). 145 146f_getll(DistCtrl) -> 147 {ok, DistCtrl}. 148 149f_address(SslSocket, Node) -> 150 case ssl:peername(SslSocket) of 151 {ok, Address} -> 152 case dist_util:split_node(Node) of 153 {node,_,Host} -> 154 #net_address{ 155 address=Address, host=Host, 156 protocol=tls, family=inet}; 157 _ -> 158 {error, no_node} 159 end 160 end. 161 162mf_tick(DistCtrl) -> 163 DistCtrl ! tick, 164 ok. 165 166mf_getstat(SslSocket) -> 167 case ssl:getstat( 168 SslSocket, [recv_cnt, send_cnt, send_pend]) of 169 {ok, Stat} -> 170 split_stat(Stat,0,0,0); 171 Error -> 172 Error 173 end. 174 175mf_setopts(SslSocket, Opts) -> 176 case setopts_filter(Opts) of 177 [] -> 178 ssl:setopts(SslSocket, Opts); 179 Opts1 -> 180 {error, {badopts,Opts1}} 181 end. 182 183mf_getopts(SslSocket, Opts) -> 184 ssl:getopts(SslSocket, Opts). 185 186f_handshake_complete(DistCtrl, Node, DHandle) -> 187 tls_sender:dist_handshake_complete(DistCtrl, Node, DHandle). 188 189setopts_filter(Opts) -> 190 [Opt || {K,_} = Opt <- Opts, 191 K =:= active orelse K =:= deliver orelse K =:= packet]. 192 193split_stat([{recv_cnt, R}|Stat], _, W, P) -> 194 split_stat(Stat, R, W, P); 195split_stat([{send_cnt, W}|Stat], R, _, P) -> 196 split_stat(Stat, R, W, P); 197split_stat([{send_pend, P}|Stat], R, W, _) -> 198 split_stat(Stat, R, W, P); 199split_stat([], R, W, P) -> 200 {ok, R, W, P}. 201 202%% ------------------------------------------------------------------------- 203 204listen(Name, Host) -> 205 gen_listen(inet_tcp, Name, Host). 206 207gen_listen(Driver, Name, Host) -> 208 case inet_tcp_dist:gen_listen(Driver, Name, Host) of 209 {ok, {Socket, Address, Creation}} -> 210 inet:setopts(Socket, [{packet, 4}, {nodelay, true}]), 211 {ok, {Socket, Address#net_address{protocol=tls}, Creation}}; 212 Other -> 213 Other 214 end. 215 216%% ------------------------------------------------------------------------- 217 218accept(Listen) -> 219 gen_accept(inet_tcp, Listen). 220 221gen_accept(Driver, Listen) -> 222 Kernel = self(), 223 monitor_pid( 224 spawn_opt( 225 fun () -> 226 process_flag(trap_exit, true), 227 LOpts = application:get_env(kernel, inet_dist_listen_options, []), 228 MaxPending = 229 case lists:keyfind(backlog, 1, LOpts) of 230 {backlog, Backlog} -> Backlog; 231 false -> 128 232 end, 233 DLK = {Driver, Listen, Kernel}, 234 accept_loop(DLK, spawn_accept(DLK), MaxPending, #{}) 235 end, 236 [link, {priority, max}])). 237 238%% Concurrent accept loop will spawn a new HandshakePid when 239%% there is no HandshakePid already running, and Pending map is 240%% smaller than MaxPending 241accept_loop(DLK, undefined, MaxPending, Pending) when map_size(Pending) < MaxPending -> 242 accept_loop(DLK, spawn_accept(DLK), MaxPending, Pending); 243accept_loop(DLK, HandshakePid, MaxPending, Pending) -> 244 receive 245 {continue, HandshakePid} when is_pid(HandshakePid) -> 246 accept_loop(DLK, undefined, MaxPending, Pending#{HandshakePid => true}); 247 {'EXIT', Pid, Reason} when is_map_key(Pid, Pending) -> 248 Reason =/= normal andalso 249 ?LOG_ERROR("TLS distribution handshake failed: ~p~n", [Reason]), 250 accept_loop(DLK, HandshakePid, MaxPending, maps:remove(Pid, Pending)); 251 {'EXIT', HandshakePid, Reason} when is_pid(HandshakePid) -> 252 %% HandshakePid crashed before turning into Pending, which means 253 %% error happened in accept. Need to restart the listener. 254 exit(Reason); 255 Unexpected -> 256 ?LOG_WARNING("TLS distribution: unexpected message: ~p~n" ,[Unexpected]), 257 accept_loop(DLK, HandshakePid, MaxPending, Pending) 258 end. 259 260spawn_accept({Driver, Listen, Kernel}) -> 261 AcceptLoop = self(), 262 spawn_link( 263 fun () -> 264 case Driver:accept(Listen) of 265 {ok, Socket} -> 266 AcceptLoop ! {continue, self()}, 267 case check_ip(Driver, Socket) of 268 true -> 269 accept_one(Driver, Kernel, Socket); 270 {false,IP} -> 271 ?LOG_ERROR( 272 "** Connection attempt from " 273 "disallowed IP ~w ** ~n", [IP]), 274 trace({disallowed, IP}) 275 end; 276 Error -> 277 exit(Error) 278 end 279 end). 280 281accept_one(Driver, Kernel, Socket) -> 282 Opts = setup_verify_client(Socket, get_ssl_options(server)), 283 wait_for_code_server(), 284 case 285 ssl:handshake( 286 Socket, 287 trace([{active, false},{packet, 4}|Opts]), 288 net_kernel:connecttime()) 289 of 290 {ok, #sslsocket{pid = [_, DistCtrl| _]} = SslSocket} -> 291 trace( 292 Kernel ! 293 {accept, self(), DistCtrl, 294 Driver:family(), tls}), 295 receive 296 {Kernel, controller, Pid} -> 297 case ssl:controlling_process(SslSocket, Pid) of 298 ok -> 299 trace(Pid ! {self(), controller}); 300 Error -> 301 trace(Pid ! {self(), exit}), 302 ?LOG_ERROR( 303 "Cannot control TLS distribution connection: ~p~n", 304 [Error]) 305 end; 306 {Kernel, unsupported_protocol} -> 307 trace(unsupported_protocol) 308 end; 309 {error, {options, _}} = Error -> 310 %% Bad options: that's probably our fault. 311 %% Let's log that. 312 ?LOG_ERROR( 313 "Cannot accept TLS distribution connection: ~s~n", 314 [ssl:format_error(Error)]), 315 gen_tcp:close(Socket), 316 trace(Error); 317 Other -> 318 gen_tcp:close(Socket), 319 trace(Other) 320 end. 321 322 323%% {verify_fun,{fun ?MODULE:verify_client/3,_}} is used 324%% as a configuration marker that verify_client/3 shall be used. 325%% 326%% Replace the State in the first occurence of 327%% {verify_fun,{fun ?MODULE:verify_client/3,State}} 328%% and remove the rest. 329%% The inserted state is not accesible from a configuration file 330%% since it is dynamic and connection dependent. 331%% 332setup_verify_client(Socket, Opts) -> 333 setup_verify_client(Socket, Opts, true, []). 334%% 335setup_verify_client(_Socket, [], _, OptsR) -> 336 lists:reverse(OptsR); 337setup_verify_client(Socket, [Opt|Opts], First, OptsR) -> 338 case Opt of 339 {verify_fun,{Fun,_}} -> 340 case Fun =:= fun ?MODULE:verify_client/3 of 341 true -> 342 if 343 First -> 344 case inet:peername(Socket) of 345 {ok,{PeerIP,_Port}} -> 346 {ok,Allowed} = net_kernel:allowed(), 347 AllowedHosts = allowed_hosts(Allowed), 348 setup_verify_client( 349 Socket, Opts, false, 350 [{verify_fun, 351 {Fun, {AllowedHosts,PeerIP}}} 352 |OptsR]); 353 {error,Reason} -> 354 exit(trace({no_peername,Reason})) 355 end; 356 true -> 357 setup_verify_client( 358 Socket, Opts, First, OptsR) 359 end; 360 false -> 361 setup_verify_client( 362 Socket, Opts, First, [Opt|OptsR]) 363 end; 364 _ -> 365 setup_verify_client(Socket, Opts, First, [Opt|OptsR]) 366 end. 367 368allowed_hosts(Allowed) -> 369 lists:usort(allowed_node_hosts(Allowed)). 370%% 371allowed_node_hosts([]) -> []; 372allowed_node_hosts([Node|Allowed]) -> 373 case dist_util:split_node(Node) of 374 {node,_,Host} -> 375 [Host|allowed_node_hosts(Allowed)]; 376 {host,Host} -> 377 [Host|allowed_node_hosts(Allowed)]; 378 _ -> 379 allowed_node_hosts(Allowed) 380 end. 381 382%% Same as verify_peer but check cert host names for 383%% peer IP address 384verify_client(_, {bad_cert,_} = Reason, _) -> 385 {fail,Reason}; 386verify_client(_, {extension,_}, S) -> 387 {unknown,S}; 388verify_client(_, valid, S) -> 389 {valid,S}; 390verify_client(_, valid_peer, {[],_} = S) -> 391 %% Allow all hosts 392 {valid,S}; 393verify_client(PeerCert, valid_peer, {AllowedHosts,PeerIP} = S) -> 394 case 395 public_key:pkix_verify_hostname( 396 PeerCert, 397 [{ip,PeerIP}|[{dns_id,Host} || Host <- AllowedHosts]]) 398 of 399 true -> 400 {valid,S}; 401 false -> 402 {fail,cert_no_hostname_nor_ip_match} 403 end. 404 405 406wait_for_code_server() -> 407 %% This is an ugly hack. Upgrading a socket to TLS requires the 408 %% crypto module to be loaded. Loading the crypto module triggers 409 %% its on_load function, which calls code:priv_dir/1 to find the 410 %% directory where its NIF library is. However, distribution is 411 %% started earlier than the code server, so the code server is not 412 %% necessarily started yet, and code:priv_dir/1 might fail because 413 %% of that, if we receive an incoming connection on the 414 %% distribution port early enough. 415 %% 416 %% If the on_load function of a module fails, the module is 417 %% unloaded, and the function call that triggered loading it fails 418 %% with 'undef', which is rather confusing. 419 %% 420 %% Thus, the accept process will terminate, and be 421 %% restarted by ssl_dist_sup. However, it won't have any memory 422 %% of being asked by net_kernel to listen for incoming 423 %% connections. Hence, the node will believe that it's open for 424 %% distribution, but it actually isn't. 425 %% 426 %% So let's avoid that by waiting for the code server to start. 427 case whereis(code_server) of 428 undefined -> 429 timer:sleep(10), 430 wait_for_code_server(); 431 Pid when is_pid(Pid) -> 432 ok 433 end. 434 435%% ------------------------------------------------------------------------- 436 437accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> 438 gen_accept_connection( 439 inet_tcp, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime). 440 441gen_accept_connection( 442 Driver, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> 443 Kernel = self(), 444 monitor_pid( 445 spawn_opt( 446 fun() -> 447 do_accept( 448 Driver, AcceptPid, DistCtrl, 449 MyNode, Allowed, SetupTime, Kernel) 450 end, 451 [link, {priority, max}])). 452 453do_accept( 454 _Driver, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime, Kernel) -> 455 receive 456 {AcceptPid, controller} -> 457 {ok, SslSocket} = tls_sender:dist_tls_socket(DistCtrl), 458 Timer = dist_util:start_timer(SetupTime), 459 NewAllowed = allowed_nodes(SslSocket, Allowed), 460 HSData0 = hs_data_common(SslSocket), 461 HSData = 462 HSData0#hs_data{ 463 kernel_pid = Kernel, 464 this_node = MyNode, 465 socket = DistCtrl, 466 timer = Timer, 467 this_flags = 0, 468 allowed = NewAllowed}, 469 link(DistCtrl), 470 dist_util:handshake_other_started(trace(HSData)); 471 {AcceptPid, exit} -> 472 %% this can happen when connection was initiated, but dropped 473 %% between TLS handshake completion and dist handshake start 474 ?shutdown2(MyNode, connection_setup_failed) 475 end. 476 477allowed_nodes(_SslSocket, []) -> 478 %% Allow all 479 []; 480allowed_nodes(SslSocket, Allowed) -> 481 case ssl:peercert(SslSocket) of 482 {ok,PeerCertDER} -> 483 case ssl:peername(SslSocket) of 484 {ok,{PeerIP,_Port}} -> 485 PeerCert = 486 public_key:pkix_decode_cert(PeerCertDER, otp), 487 case 488 allowed_nodes( 489 PeerCert, allowed_hosts(Allowed), PeerIP) 490 of 491 [] -> 492 ?LOG_ERROR( 493 "** Connection attempt from " 494 "disallowed node(s) ~p ** ~n", [PeerIP]), 495 ?shutdown2( 496 PeerIP, trace({is_allowed, not_allowed})); 497 AllowedNodes -> 498 AllowedNodes 499 end; 500 Error1 -> 501 ?shutdown2(no_peer_ip, trace(Error1)) 502 end; 503 {error,no_peercert} -> 504 Allowed; 505 Error2 -> 506 ?shutdown2(no_peer_cert, trace(Error2)) 507 end. 508 509allowed_nodes(PeerCert, [], PeerIP) -> 510 case public_key:pkix_verify_hostname(PeerCert, [{ip,PeerIP}]) of 511 true -> 512 Host = inet:ntoa(PeerIP), 513 true = is_list(Host), 514 [Host]; 515 false -> 516 [] 517 end; 518allowed_nodes(PeerCert, [Node|Allowed], PeerIP) -> 519 case dist_util:split_node(Node) of 520 {node,_,Host} -> 521 allowed_nodes(PeerCert, Allowed, PeerIP, Node, Host); 522 {host,Host} -> 523 allowed_nodes(PeerCert, Allowed, PeerIP, Node, Host); 524 _ -> 525 allowed_nodes(PeerCert, Allowed, PeerIP) 526 end. 527 528allowed_nodes(PeerCert, Allowed, PeerIP, Node, Host) -> 529 case public_key:pkix_verify_hostname(PeerCert, [{dns_id,Host}]) of 530 true -> 531 [Node|allowed_nodes(PeerCert, Allowed, PeerIP)]; 532 false -> 533 allowed_nodes(PeerCert, Allowed, PeerIP) 534 end. 535 536setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -> 537 gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). 538 539gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> 540 Kernel = self(), 541 monitor_pid( 542 spawn_opt(setup_fun(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime), 543 [link, {priority, max}])). 544 545-spec setup_fun(_,_,_,_,_,_,_) -> fun(() -> no_return()). 546setup_fun(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> 547 fun() -> 548 do_setup( 549 Driver, Kernel, Node, Type, 550 MyNode, LongOrShortNames, SetupTime) 551 end. 552 553 554-spec do_setup(_,_,_,_,_,_,_) -> no_return(). 555do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> 556 {Name, Address} = split_node(Driver, Node, LongOrShortNames), 557 ErlEpmd = net_kernel:epmd_module(), 558 {ARMod, ARFun} = get_address_resolver(ErlEpmd, Driver), 559 Timer = trace(dist_util:start_timer(SetupTime)), 560 case ARMod:ARFun(Name,Address,Driver:family()) of 561 {ok, Ip, TcpPort, Version} -> 562 do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer); 563 {ok, Ip} -> 564 case ErlEpmd:port_please(Name, Ip) of 565 {port, TcpPort, Version} -> 566 do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer); 567 Other -> 568 ?shutdown2( 569 Node, 570 trace( 571 {port_please_failed, ErlEpmd, Name, Ip, Other})) 572 end; 573 Other -> 574 ?shutdown2( 575 Node, 576 trace({getaddr_failed, Driver, Address, Other})) 577 end. 578 579-spec do_setup_connect(_,_,_,_,_,_,_,_,_,_) -> no_return(). 580 581do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer) -> 582 Opts = trace(connect_options(get_ssl_options(client))), 583 dist_util:reset_timer(Timer), 584 case ssl:connect( 585 Address, TcpPort, 586 [binary, {active, false}, {packet, 4}, 587 Driver:family(), {nodelay, true}] ++ Opts, 588 net_kernel:connecttime()) of 589 {ok, #sslsocket{pid = [_, DistCtrl| _]} = SslSocket} -> 590 _ = monitor_pid(DistCtrl), 591 ok = ssl:controlling_process(SslSocket, self()), 592 HSData0 = hs_data_common(SslSocket), 593 HSData = 594 HSData0#hs_data{ 595 kernel_pid = Kernel, 596 other_node = Node, 597 this_node = MyNode, 598 socket = DistCtrl, 599 timer = Timer, 600 this_flags = 0, 601 other_version = Version, 602 request_type = Type}, 603 link(DistCtrl), 604 dist_util:handshake_we_started(trace(HSData)); 605 Other -> 606 %% Other Node may have closed since 607 %% port_please ! 608 ?shutdown2( 609 Node, 610 trace( 611 {ssl_connect_failed, Ip, TcpPort, Other})) 612 end. 613 614close(Socket) -> 615 gen_close(inet, Socket). 616 617gen_close(Driver, Socket) -> 618 trace(Driver:close(Socket)). 619 620 621%% ------------------------------------------------------------ 622%% Determine if EPMD module supports address resolving. Default 623%% is to use inet_tcp:getaddr/2. 624%% ------------------------------------------------------------ 625get_address_resolver(EpmdModule, _Driver) -> 626 case erlang:function_exported(EpmdModule, address_please, 3) of 627 true -> {EpmdModule, address_please}; 628 _ -> {erl_epmd, address_please} 629 end. 630 631%% ------------------------------------------------------------ 632%% Do only accept new connection attempts from nodes at our 633%% own LAN, if the check_ip environment parameter is true. 634%% ------------------------------------------------------------ 635check_ip(Driver, Socket) -> 636 case application:get_env(check_ip) of 637 {ok, true} -> 638 case get_ifs(Socket) of 639 {ok, IFs, IP} -> 640 check_ip(Driver, IFs, IP); 641 Other -> 642 ?shutdown2( 643 no_node, trace({check_ip_failed, Socket, Other})) 644 end; 645 _ -> 646 true 647 end. 648 649check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) -> 650 case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of 651 {M, M} -> true; 652 _ -> check_ip(IFs, PeerIP) 653 end; 654check_ip(_Driver, [], PeerIP) -> 655 {false, PeerIP}. 656 657get_ifs(Socket) -> 658 case inet:peername(Socket) of 659 {ok, {IP, _}} -> 660 %% XXX this is seriously broken for IPv6 661 case inet:getif(Socket) of 662 {ok, IFs} -> {ok, IFs, IP}; 663 Error -> Error 664 end; 665 Error -> 666 Error 667 end. 668 669 670%% Look in Extensions, in all subjectAltName:s 671%% to find node names in this certificate. 672%% Host names are picked up as a subjectAltName containing 673%% a dNSName, and the first subjectAltName containing 674%% a commonName is the node name. 675%% 676cert_nodes( 677 #'OTPCertificate'{ 678 tbsCertificate = #'OTPTBSCertificate'{extensions = Extensions}}) -> 679 parse_extensions(Extensions). 680 681 682parse_extensions(Extensions) when is_list(Extensions) -> 683 parse_extensions(Extensions, [], []); 684parse_extensions(asn1_NOVALUE) -> 685 undefined. % Allow all nodes 686%% 687parse_extensions([], [], []) -> 688 undefined; % Allow all nodes 689parse_extensions([], Hosts, []) -> 690 lists:reverse(Hosts); 691parse_extensions([], [], Names) -> 692 [Name ++ "@" || Name <- lists:reverse(Names)]; 693parse_extensions([], Hosts, Names) -> 694 [Name ++ "@" ++ Host || 695 Host <- lists:reverse(Hosts), 696 Name <- lists:reverse(Names)]; 697parse_extensions( 698 [#'Extension'{ 699 extnID = ?'id-ce-subjectAltName', 700 extnValue = AltNames} 701 |Extensions], 702 Hosts, Names) -> 703 case parse_subject_altname(AltNames) of 704 none -> 705 parse_extensions(Extensions, Hosts, Names); 706 {host,Host} -> 707 parse_extensions(Extensions, [Host|Hosts], Names); 708 {name,Name} -> 709 parse_extensions(Extensions, Hosts, [Name|Names]) 710 end; 711parse_extensions([_|Extensions], Hosts, Names) -> 712 parse_extensions(Extensions, Hosts, Names). 713 714parse_subject_altname([]) -> 715 none; 716parse_subject_altname([{dNSName,Host}|_AltNames]) -> 717 {host,Host}; 718parse_subject_altname( 719 [{directoryName,{rdnSequence,[Rdn|_]}}|AltNames]) -> 720 %% 721 %% XXX Why is rdnSequence a sequence? 722 %% Should we parse all members? 723 %% 724 case parse_rdn(Rdn) of 725 none -> 726 parse_subject_altname(AltNames); 727 Name -> 728 {name,Name} 729 end; 730parse_subject_altname([_|AltNames]) -> 731 parse_subject_altname(AltNames). 732 733 734parse_rdn([]) -> 735 none; 736parse_rdn( 737 [#'AttributeTypeAndValue'{ 738 type = ?'id-at-commonName', 739 value = {utf8String,CommonName}}|_]) -> 740 unicode:characters_to_list(CommonName); 741parse_rdn([_|Rdn]) -> 742 parse_rdn(Rdn). 743 744 745%% If Node is illegal terminate the connection setup!! 746split_node(Driver, Node, LongOrShortNames) -> 747 case dist_util:split_node(Node) of 748 {node, Name, Host} -> 749 check_node(Driver, Node, Name, Host, LongOrShortNames); 750 {host, _} -> 751 ?LOG_ERROR( 752 "** Nodename ~p illegal, no '@' character **~n", 753 [Node]), 754 ?shutdown2(Node, trace({illegal_node_n@me, Node})); 755 _ -> 756 ?LOG_ERROR( 757 "** Nodename ~p illegal **~n", [Node]), 758 ?shutdown2(Node, trace({illegal_node_name, Node})) 759 end. 760 761check_node(Driver, Node, Name, Host, LongOrShortNames) -> 762 case string:split(Host, ".", all) of 763 [_] when LongOrShortNames =:= longnames -> 764 case Driver:parse_address(Host) of 765 {ok, _} -> 766 {Name, Host}; 767 _ -> 768 ?LOG_ERROR( 769 "** System running to use " 770 "fully qualified hostnames **~n" 771 "** Hostname ~s is illegal **~n", 772 [Host]), 773 ?shutdown2(Node, trace({not_longnames, Host})) 774 end; 775 [_,_|_] when LongOrShortNames =:= shortnames -> 776 ?LOG_ERROR( 777 "** System NOT running to use " 778 "fully qualified hostnames **~n" 779 "** Hostname ~s is illegal **~n", 780 [Host]), 781 ?shutdown2(Node, trace({not_shortnames, Host})); 782 _ -> 783 {Name, Host} 784 end. 785 786%% ------------------------------------------------------------------------- 787 788connect_options(Opts) -> 789 case application:get_env(kernel, inet_dist_connect_options) of 790 {ok,ConnectOpts} -> 791 lists:ukeysort(1, ConnectOpts ++ Opts); 792 _ -> 793 Opts 794 end. 795 796%% we may not always want the nodelay behaviour 797%% for performance reasons 798nodelay() -> 799 case application:get_env(kernel, dist_nodelay) of 800 undefined -> 801 {nodelay, true}; 802 {ok, true} -> 803 {nodelay, true}; 804 {ok, false} -> 805 {nodelay, false}; 806 _ -> 807 {nodelay, true} 808 end. 809 810 811get_ssl_options(Type) -> 812 try ets:lookup(ssl_dist_opts, Type) of 813 [{Type, Opts0}] -> 814 [{erl_dist, true} | dist_defaults(Opts0)]; 815 _ -> 816 get_ssl_dist_arguments(Type) 817 catch 818 error:badarg -> 819 get_ssl_dist_arguments(Type) 820 end. 821 822get_ssl_dist_arguments(Type) -> 823 case init:get_argument(ssl_dist_opt) of 824 {ok, Args} -> 825 [{erl_dist, true} | dist_defaults(ssl_options(Type, lists:append(Args)))]; 826 _ -> 827 [{erl_dist, true}] 828 end. 829 830dist_defaults(Opts) -> 831 case proplists:get_value(versions, Opts, undefined) of 832 undefined -> 833 [{versions, ['tlsv1.2']} | Opts]; 834 _ -> 835 Opts 836 end. 837 838ssl_options(_Type, []) -> 839 []; 840ssl_options(client, ["client_" ++ Opt, Value | T] = Opts) -> 841 ssl_options(client, T, Opts, Opt, Value); 842ssl_options(server, ["server_" ++ Opt, Value | T] = Opts) -> 843 ssl_options(server, T, Opts, Opt, Value); 844ssl_options(Type, [_Opt, _Value | T]) -> 845 ssl_options(Type, T). 846%% 847ssl_options(Type, T, Opts, Opt, Value) -> 848 case ssl_option(Type, Opt) of 849 error -> 850 error(malformed_ssl_dist_opt, [Type, Opts]); 851 Fun -> 852 [{list_to_atom(Opt), Fun(Value)}|ssl_options(Type, T)] 853 end. 854 855ssl_option(server, Opt) -> 856 case Opt of 857 "dhfile" -> fun listify/1; 858 "fail_if_no_peer_cert" -> fun atomize/1; 859 _ -> ssl_option(client, Opt) 860 end; 861ssl_option(client, Opt) -> 862 case Opt of 863 "certfile" -> fun listify/1; 864 "cacertfile" -> fun listify/1; 865 "keyfile" -> fun listify/1; 866 "password" -> fun listify/1; 867 "verify" -> fun atomize/1; 868 "verify_fun" -> fun verify_fun/1; 869 "crl_check" -> fun atomize/1; 870 "crl_cache" -> fun termify/1; 871 "reuse_sessions" -> fun atomize/1; 872 "secure_renegotiate" -> fun atomize/1; 873 "depth" -> fun erlang:list_to_integer/1; 874 "hibernate_after" -> fun erlang:list_to_integer/1; 875 "ciphers" -> fun listify/1; 876 _ -> error 877 end. 878 879listify(List) when is_list(List) -> 880 List. 881 882atomize(List) when is_list(List) -> 883 list_to_atom(List); 884atomize(Atom) when is_atom(Atom) -> 885 Atom. 886 887termify(String) when is_list(String) -> 888 {ok, Tokens, _} = erl_scan:string(String ++ "."), 889 {ok, Term} = erl_parse:parse_term(Tokens), 890 Term. 891 892verify_fun(Value) -> 893 case termify(Value) of 894 {Mod, Func, State} when is_atom(Mod), is_atom(Func) -> 895 Fun = fun Mod:Func/3, 896 {Fun, State}; 897 _ -> 898 error(malformed_ssl_dist_opt, [Value]) 899 end. 900 901%% ------------------------------------------------------------------------- 902 903%% Trace point 904trace(Term) -> Term. 905 906%% Keep an eye on distribution Pid:s we know of 907monitor_pid(Pid) -> 908 %%spawn( 909 %% fun () -> 910 %% MRef = erlang:monitor(process, Pid), 911 %% receive 912 %% {'DOWN', MRef, _, _, normal} -> 913 %% ?LOG_ERROR( 914 %% [{slogan, dist_proc_died}, 915 %% {reason, normal}, 916 %% {pid, Pid}]); 917 %% {'DOWN', MRef, _, _, Reason} -> 918 %% ?LOG_NOTICE( 919 %% [{slogan, dist_proc_died}, 920 %% {reason, Reason}, 921 %% {pid, Pid}]) 922 %% end 923 %% end), 924 Pid. 925 926dbg() -> 927 dbg:stop(), 928 dbg:tracer(), 929 dbg:p(all, c), 930 dbg:tpl(?MODULE, cx), 931 dbg:tpl(erlang, dist_ctrl_get_data_notification, cx), 932 dbg:tpl(erlang, dist_ctrl_get_data, cx), 933 dbg:tpl(erlang, dist_ctrl_put_data, cx), 934 ok. 935