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