diff options
Diffstat (limited to 'lib/ssl/src/inet_tls_dist.erl')
| -rw-r--r-- | lib/ssl/src/inet_tls_dist.erl | 997 |
1 files changed, 823 insertions, 174 deletions
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 4c677b9c33..3e9828a2fe 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2017. All Rights Reserved. +%% Copyright Ericsson AB 2011-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,16 +21,28 @@ %% -module(inet_tls_dist). --export([childspecs/0, listen/1, accept/1, accept_connection/5, +-export([childspecs/0]). +-export([listen/1, accept/1, accept_connection/5, setup/5, close/1, select/1, is_node_name/1]). %% Generalized dist API -export([gen_listen/2, gen_accept/2, gen_accept_connection/6, - gen_setup/6, gen_select/2]). + gen_setup/6, gen_close/2, gen_select/2]). + +-export([nodelay/0]). + +-export([verify_client/3, verify_server/3, cert_nodes/1]). + +-export([dbg/0]). % Debug -include_lib("kernel/include/net_address.hrl"). -include_lib("kernel/include/dist.hrl"). -include_lib("kernel/include/dist_util.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +-include("ssl_api.hrl"). + +%% ------------------------------------------------------------------------- childspecs() -> {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, @@ -40,107 +52,597 @@ select(Node) -> gen_select(inet_tcp, Node). gen_select(Driver, Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_, Host] -> - case inet:getaddr(Host, Driver:family()) of + case dist_util:split_node(Node) of + {node,_,Host} -> + case Driver:getaddr(Host) of {ok, _} -> true; _ -> false end; - _ -> - false + _ -> + false + end. + +%% ------------------------------------------------------------------------- + +is_node_name(Node) -> + dist_util:is_node_name(Node). + +%% ------------------------------------------------------------------------- + +hs_data_common(#sslsocket{pid = DistCtrl} = SslSocket) -> + #hs_data{ + f_send = + fun (Ctrl, Packet) when Ctrl == DistCtrl -> + f_send(SslSocket, Packet) + end, + f_recv = + fun (Ctrl, Length, Timeout) when Ctrl == DistCtrl -> + f_recv(SslSocket, Length, Timeout) + end, + f_setopts_pre_nodeup = + fun (Ctrl) when Ctrl == DistCtrl -> + f_setopts_pre_nodeup(SslSocket) + end, + f_setopts_post_nodeup = + fun (Ctrl) when Ctrl == DistCtrl -> +%%% sys:trace(Ctrl, true), + f_setopts_post_nodeup(SslSocket) + end, + f_getll = + fun (Ctrl) when Ctrl == DistCtrl -> + f_getll(DistCtrl) + end, + f_address = + fun (Ctrl, Node) when Ctrl == DistCtrl -> + f_address(SslSocket, Node) + end, + mf_tick = + fun (Ctrl) when Ctrl == DistCtrl -> + mf_tick(DistCtrl) + end, + mf_getstat = + fun (Ctrl) when Ctrl == DistCtrl -> + mf_getstat(SslSocket) + end, + mf_setopts = + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + mf_setopts(SslSocket, Opts) + end, + mf_getopts = + fun (Ctrl, Opts) when Ctrl == DistCtrl -> + mf_getopts(SslSocket, Opts) + end, + f_handshake_complete = + fun (Ctrl, Node, DHandle) when Ctrl == DistCtrl -> + f_handshake_complete(DistCtrl, Node, DHandle) + end}. + +f_send(SslSocket, Packet) -> + ssl:send(SslSocket, Packet). + +f_recv(SslSocket, Length, Timeout) -> + case ssl:recv(SslSocket, Length, Timeout) of + {ok, Bin} when is_binary(Bin) -> + {ok, binary_to_list(Bin)}; + Other -> + Other end. -is_node_name(Node) when is_atom(Node) -> - select(Node); -is_node_name(_) -> - false. +f_setopts_pre_nodeup(_SslSocket) -> + ok. + +f_setopts_post_nodeup(_SslSocket) -> + ok. + +f_getll(DistCtrl) -> + {ok, DistCtrl}. + +f_address(SslSocket, Node) -> + case ssl:peername(SslSocket) of + {ok, Address} -> + case dist_util:split_node(Node) of + {node,_,Host} -> + #net_address{ + address=Address, host=Host, + protocol=tls, family=inet}; + _ -> + {error, no_node} + end + end. + +mf_tick(DistCtrl) -> + DistCtrl ! tick, + ok. + +mf_getstat(SslSocket) -> + case ssl:getstat( + SslSocket, [recv_cnt, send_cnt, send_pend]) of + {ok, Stat} -> + split_stat(Stat,0,0,0); + Error -> + Error + end. + +mf_setopts(SslSocket, Opts) -> + case setopts_filter(Opts) of + [] -> + ssl:setopts(SslSocket, Opts); + Opts1 -> + {error, {badopts,Opts1}} + end. + +mf_getopts(SslSocket, Opts) -> + ssl:getopts(SslSocket, Opts). + +f_handshake_complete(DistCtrl, Node, DHandle) -> + ssl_connection:handshake_complete(DistCtrl, Node, DHandle). + + +setopts_filter(Opts) -> + [Opt || {K,_} = Opt <- Opts, + K =:= active orelse K =:= deliver orelse K =:= packet]. + +split_stat([{recv_cnt, R}|Stat], _, W, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_cnt, W}|Stat], R, _, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_pend, P}|Stat], R, W, _) -> + split_stat(Stat, R, W, P); +split_stat([], R, W, P) -> + {ok, R, W, P}. + +%% ------------------------------------------------------------------------- listen(Name) -> gen_listen(inet_tcp, Name). gen_listen(Driver, Name) -> - ssl_tls_dist_proxy:listen(Driver, Name). + case inet_tcp_dist:gen_listen(Driver, Name) of + {ok, {Socket, Address, Creation}} -> + inet:setopts(Socket, [{packet, 4}]), + {ok, {Socket, Address#net_address{protocol=tls}, Creation}}; + Other -> + Other + end. + +%% ------------------------------------------------------------------------- accept(Listen) -> gen_accept(inet_tcp, Listen). gen_accept(Driver, Listen) -> - ssl_tls_dist_proxy:accept(Driver, Listen). + Kernel = self(), + monitor_pid( + spawn_opt( + fun () -> + accept_loop(Driver, Listen, Kernel) + end, + [link, {priority, max}])). -accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - gen_accept_connection(inet_tcp, AcceptPid, Socket, MyNode, Allowed, SetupTime). +accept_loop(Driver, Listen, Kernel) -> + case Driver:accept(Listen) of + {ok, Socket} -> + case check_ip(Driver, Socket) of + true -> + accept_loop(Driver, Listen, Kernel, Socket); + {false,IP} -> + error_logger:error_msg( + "** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown2(no_node, trace({disallowed, IP})) + end; + Error -> + exit(trace(Error)) + end. + +accept_loop(Driver, Listen, Kernel, Socket) -> + {Opts,CertNodesFun} = + setup_verify_client( + Driver, Socket, get_ssl_options(server)), + wait_for_code_server(), + case + ssl:ssl_accept( + Socket, + trace([{active, false},{packet, 4}|Opts]), + net_kernel:connecttime()) + of + {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + trace( + Kernel ! + {accept, self(), DistCtrl, + Driver:family(), tls}), + receive + {Kernel, controller, Pid} -> + ok = ssl:controlling_process(SslSocket, Pid), + trace( + Pid ! {self(), controller, CertNodesFun}); + {Kernel, unsupported_protocol} -> + exit(trace(unsupported_protocol)) + end, + accept_loop(Driver, Listen, Kernel); + {error, {options, _}} = Error -> + %% Bad options: that's probably our fault. + %% Let's log that. + error_logger:error_msg( + "Cannot accept TLS distribution connection: ~s~n", + [ssl:format_error(Error)]), + gen_tcp:close(Socket), + exit(trace(Error)); + Other -> + gen_tcp:close(Socket), + exit(trace(Other)) + end. + + +%% {verify_fun,{fun ?MODULE:verify_client/3,_}} is used +%% as a configuration marker that verify_client/3 shall be used. +%% +%% Replace the State in the first occurence of +%% {verify_fun,{fun ?MODULE:verify_client/3,State}} and remove the rest. +%% The inserted state is not accesible from a configuration file +%% since it is dynamic and connection dependent. +%% +setup_verify_client(Driver, Socket, Opts) -> + setup_verify_client(Driver, Socket, Opts, undefined, []). +%% +setup_verify_client(_Driver, _Socket, [], CertNodesFun, OptsR) -> + {lists:reverse(OptsR),CertNodesFun}; +setup_verify_client(Driver, Socket, [Opt|Opts], CertNodesFun, OptsR) -> + case Opt of + {verify_fun,{Fun,NewCertNodesFun}} -> + case Fun =:= fun ?MODULE:verify_client/3 of + true when is_function(NewCertNodesFun, 1) -> + if + CertNodesFun =:= undefined -> + case inet:peername(Socket) of + {ok,{PeerIP,_Port}} -> + setup_verify_client( + Driver, Socket, Opts, NewCertNodesFun, + [{verify_fun, + {Fun, + {NewCertNodesFun,Driver,PeerIP}}} + |OptsR]); + {error,Reason} -> + exit(trace({no_peername,Reason})) + end; + true -> + setup_verify_client( + Driver, Socket, Opts, CertNodesFun, OptsR) + end; + true -> + exit( + trace( + {verify_client_bad_argument,CertNodesFun})); + false -> + setup_verify_client( + Driver, Socket, Opts, CertNodesFun, [Opt|OptsR]) + end; + _ -> + setup_verify_client( + Driver, Socket, Opts, CertNodesFun, [Opt|OptsR]) + end. + +%% Same as verify_peer but check cert host names for +%% peer IP address +verify_client(_, {bad_cert,_} = Reason, _) -> + {fail,Reason}; +verify_client(_, {extension,_}, S) -> + {unknown,S}; +verify_client(_, valid, S) -> + {valid,S}; +verify_client(PeerCert, valid_peer, {CertNodesFun,Driver,PeerIP} = S) -> + %% + %% Parse out all node names from the peer's certificate + %% + case CertNodesFun(PeerCert) of + undefined -> + %% Certificate allows all nodes + {valid,S}; + [] -> + %% Certificate allows no nodes + {fail,cert_missing_node_name}; + CertNodes -> + %% Check if the IP address of one of the nodes + %% in the peer certificate has the peer's IP address + case filter_nodes_by_ip(CertNodes, Driver, PeerIP) of + [] -> + {fail,cert_no_host_with_peer_ip}; + _ -> + {valid,S} + end + end. + +%% Filter out the nodes that has got the given IP address +%% +filter_nodes_by_ip(Nodes, Driver, IP) -> + [Node || + Node <- Nodes, + case dist_util:split_node(Node) of + {node,_,Host} -> + filter_host_by_ip(Host, Driver, IP); + {host,Host} -> + filter_host_by_ip(Host, Driver, IP); + {name,_Name} -> + true + end]. + +filter_host_by_ip(Host, Driver, IP) -> + case Driver:getaddr(Host) of + {ok,IP} -> + true; + _ -> + false + end. -gen_accept_connection(Driver, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + +wait_for_code_server() -> + %% This is an ugly hack. Upgrading a socket to TLS requires the + %% crypto module to be loaded. Loading the crypto module triggers + %% its on_load function, which calls code:priv_dir/1 to find the + %% directory where its NIF library is. However, distribution is + %% started earlier than the code server, so the code server is not + %% necessarily started yet, and code:priv_dir/1 might fail because + %% of that, if we receive an incoming connection on the + %% distribution port early enough. + %% + %% If the on_load function of a module fails, the module is + %% unloaded, and the function call that triggered loading it fails + %% with 'undef', which is rather confusing. + %% + %% Thus, the accept process will terminate, and be + %% restarted by ssl_dist_sup. However, it won't have any memory + %% of being asked by net_kernel to listen for incoming + %% connections. Hence, the node will believe that it's open for + %% distribution, but it actually isn't. + %% + %% So let's avoid that by waiting for the code server to start. + case whereis(code_server) of + undefined -> + timer:sleep(10), + wait_for_code_server(); + Pid when is_pid(Pid) -> + ok + end. + +%% ------------------------------------------------------------------------- + +accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + gen_accept_connection( + inet_tcp, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime). + +gen_accept_connection( + Driver, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> Kernel = self(), - spawn_link(fun() -> do_accept(Driver, Kernel, AcceptPid, Socket, - MyNode, Allowed, SetupTime) end). + monitor_pid( + spawn_opt( + fun() -> + do_accept( + Driver, Kernel, AcceptPid, DistCtrl, + MyNode, Allowed, SetupTime) + end, + [link, {priority, max}])). -setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames,SetupTime). +do_accept(Driver, Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) -> + SslSocket = ssl_connection:get_sslsocket(DistCtrl), + receive + {AcceptPid, controller, CertNodesFun} -> + Timer = dist_util:start_timer(SetupTime), + NewAllowed = + allowed_nodes( + Driver, CertNodesFun, SslSocket, Allowed), + HSData0 = hs_data_common(SslSocket), + HSData = + HSData0#hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + allowed = NewAllowed}, + link(DistCtrl), + dist_util:handshake_other_started(trace(HSData)) + end. -gen_setup(Driver, Node, Type, MyNode, LongOrShortNames,SetupTime) -> +%% Return a list of allowed nodes according to +%% the given Allowed list that matches the peer certificate +%% +allowed_nodes(_Driver, undefined, _SslSocket, Allowed) -> + Allowed; +allowed_nodes(Driver, CertNodesFun, SslSocket, Allowed) -> + case ssl:peercert(SslSocket) of + {ok,PeerCertDER} -> + case ssl:peername(SslSocket) of + {ok,{PeerIP,_Port}} -> + PeerCert = public_key:pkix_decode_cert(PeerCertDER, otp), + %% + %% Parse out all node names from the peer's certificate + %% + case CertNodesFun(PeerCert) of + undefined -> + %% Certificate allows all nodes + Allowed; + [] -> + %% Certificate allows no nodes + ?shutdown(cert_missing_node_name); + CertNodes -> + %% Filter out all nodes in the + %% allowed list that is in peer + %% certificate and that has got + %% the same IP address as the peer + allowed( + filter_nodes_by_ip( + CertNodes, Driver, PeerIP), + Allowed) + end; + Error1 -> + ?shutdown2(no_peer_ip, trace(Error1)) + end; + Error2 -> + ?shutdown2(no_peer_cert, trace(Error2)) + end. + +allowed(CertNodes, []) -> + %% Empty allowed list means all allowed + %% -> allow only certificate nodes + CertNodes; +allowed(CertNodes, Allowed) -> + %% Find the intersection of the allowed list and certificate nodes + case + [CertNode || + CertNode <- CertNodes, + dist_util:is_allowed(CertNode, Allowed)] + of + [] -> + error_logger:error_msg( + "** Connection attempt from " + "disallowed node(s) ~p ** ~n", [CertNodes]), + ?shutdown2(CertNodes, trace({is_allowed, not_allowed})); + NewAllowed -> + NewAllowed + end. + + +setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -> + gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). + +gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> Kernel = self(), - spawn_opt(fun() -> do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end, [link, {priority, max}]). - + monitor_pid( + spawn_opt( + fun() -> + do_setup( + Driver, Kernel, Node, Type, + MyNode, LongOrShortNames, SetupTime) + end, + [link, {priority, max}])). + do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> - [Name, Address] = splitnode(Driver, Node, LongOrShortNames), - case inet:getaddr(Address, Driver:family()) of + {Name, Address} = split_node(Driver, Node, LongOrShortNames), + case Driver:getaddr(Address) of {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), + Timer = trace(dist_util:start_timer(SetupTime)), ErlEpmd = net_kernel:epmd_module(), case ErlEpmd:port_please(Name, Ip) of {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", - [Node,Version]), + Opts = + trace( + connect_options( + %% + %% Use verify_server/3 to verify that + %% the server's certificate is for Node + %% + setup_verify_server( + get_ssl_options(client), Node))), dist_util:reset_timer(Timer), - case - ssl_tls_dist_proxy:connect( - Driver, Address, TcpPort, - [{server_name_indication, atom_to_list(Node)}]) - of - {ok, Socket} -> - HSData = connect_hs_data(Kernel, Node, MyNode, Socket, - Timer, Version, Ip, TcpPort, Address, - Type), - dist_util:handshake_we_started(HSData); + case ssl:connect( + Address, TcpPort, + [binary, {active, false}, {packet, 4}, + Driver:family(), nodelay()] ++ Opts, + net_kernel:connecttime()) of + {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + _ = monitor_pid(DistCtrl), + ok = ssl:controlling_process(SslSocket, self()), + HSData0 = hs_data_common(SslSocket), + HSData = + HSData0#hs_data{ + kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + other_version = Version, + request_type = Type}, + link(DistCtrl), + dist_util:handshake_we_started(trace(HSData)); Other -> %% Other Node may have closed since %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown2(Node, {shutdown, {connect_failed, Other}}) + ?shutdown2( + Node, + trace( + {ssl_connect_failed, Ip, TcpPort, Other})) end; Other -> - ?trace("port_please (~p) " - "failed.~n", [Node]), - ?shutdown2(Node, {shutdown, {port_please_failed, Other}}) + ?shutdown2( + Node, + trace( + {port_please_failed, ErlEpmd, Name, Ip, Other})) end; Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,Other]), - ?shutdown2(Node, {shutdown, {inet_getaddr_failed, Other}}) + ?shutdown2( + Node, + trace({getaddr_failed, Driver, Address, Other})) end. close(Socket) -> - gen_tcp:close(Socket), - ok. + gen_close(inet, Socket). -do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - process_flag(priority, max), - receive - {AcceptPid, controller} -> - Timer = dist_util:start_timer(SetupTime), - case check_ip(Driver, Socket) of - true -> - HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed), - dist_util:handshake_other_started(HSData); - {false,IP} -> - error_logger:error_msg("** Connection attempt from " - "disallowed IP ~w ** ~n", [IP]), - ?shutdown(no_node) - end +gen_close(Driver, Socket) -> + trace(Driver:close(Socket)). + +%% {verify_fun,{fun ?MODULE:verify_server/3,_}} is used +%% as a configuration marker that verify_server/3 shall be used. +%% +%% Replace the State in the first occurence of +%% {verify_fun,{fun ?MODULE:verify_server/3,State}} and remove the rest. +%% The inserted state is not accesible from a configuration file +%% since it is dynamic and connection dependent. +%% +setup_verify_server(Opts, Node) -> + setup_verify_server(Opts, Node, true). +%% +setup_verify_server([], _Node, _) -> + []; +setup_verify_server([Opt|Opts], Node, Once) -> + case Opt of + {verify_fun,{Fun,CertNodesFun}} -> + case Fun =:= fun ?MODULE:verify_server/3 of + true when not is_function(CertNodesFun, 1) -> + ?shutdown2( + Node, + {verify_server_bad_argument,CertNodesFun}); + true when Once -> + [{verify_fun,{Fun,{CertNodesFun,Node}}} + |setup_verify_server(Opts, Node, false)]; + true -> + setup_verify_server(Opts, Node, Once); + false -> + [Opt|setup_verify_server(Opts, Node, Once)] + end; + _ -> + [Opt|setup_verify_server(Opts, Node, Once)] end. + +verify_server(_, {bad_cert,_} = Reason, _) -> + {fail,Reason}; +verify_server(_, {extension,_}, S) -> + {unknown,S}; +verify_server(_, valid, S) -> + {valid,S}; +verify_server(PeerCert, valid_peer, {CertNodesFun,Node} = S) -> + %% + %% Parse out all node names from the peer's certificate + %% + case CertNodesFun(PeerCert) of + undefined -> + %% Certificate allows all nodes + {valid,S}; + [] -> + %% Certificate allows no nodes + {fail,cert_missing_node_name}; + CertNodes -> + %% Check that the node we are connecting to + %% is in the peer certificate + case dist_util:is_allowed(Node, CertNodes) of + true -> + {valid,S}; + false -> + {fail,wrong_nodes_in_cert} + end + end. + + %% ------------------------------------------------------------ %% Do only accept new connection attempts from nodes at our %% own LAN, if the check_ip environment parameter is true. @@ -151,16 +653,26 @@ check_ip(Driver, Socket) -> case get_ifs(Socket) of {ok, IFs, IP} -> check_ip(Driver, IFs, IP); - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2( + no_node, trace({check_ip_failed, Socket, Other})) end; _ -> true end. +check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip(_Driver, [], PeerIP) -> + {false, PeerIP}. + get_ifs(Socket) -> case inet:peername(Socket) of {ok, {IP, _}} -> + %% XXX this is seriously broken for IPv6 case inet:getif(Socket) of {ok, IFs} -> {ok, IFs, IP}; Error -> Error @@ -169,125 +681,262 @@ get_ifs(Socket) -> Error end. -check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of - {M, M} -> true; - _ -> check_ip(IFs, PeerIP) + +%% Look in Extensions, in all subjectAltName:s +%% to find node names in this certificate. +%% Host names are picked up as a subjectAltName containing +%% a dNSName, and the first subjectAltName containing +%% a commonName is the node name. +%% +cert_nodes( + #'OTPCertificate'{ + tbsCertificate = #'OTPTBSCertificate'{extensions = Extensions}}) -> + parse_extensions(Extensions). + + +parse_extensions(Extensions) when is_list(Extensions) -> + parse_extensions(Extensions, [], []); +parse_extensions(asn1_NOVALUE) -> + undefined. % Allow all nodes +%% +parse_extensions([], [], []) -> + undefined; % Allow all nodes +parse_extensions([], Hosts, []) -> + lists:reverse(Hosts); +parse_extensions([], [], Names) -> + [Name ++ "@" || Name <- lists:reverse(Names)]; +parse_extensions([], Hosts, Names) -> + [Name ++ "@" ++ Host || + Host <- lists:reverse(Hosts), + Name <- lists:reverse(Names)]; +parse_extensions( + [#'Extension'{ + extnID = ?'id-ce-subjectAltName', + extnValue = AltNames} + |Extensions], + Hosts, Names) -> + case parse_subject_altname(AltNames) of + none -> + parse_extensions(Extensions, Hosts, Names); + {host,Host} -> + parse_extensions(Extensions, [Host|Hosts], Names); + {name,Name} -> + parse_extensions(Extensions, Hosts, [Name|Names]) end; -check_ip(_Driver, [], PeerIP) -> - {false, PeerIP}. +parse_extensions([_|Extensions], Hosts, Names) -> + parse_extensions(Extensions, Hosts, Names). + +parse_subject_altname([]) -> + none; +parse_subject_altname([{dNSName,Host}|_AltNames]) -> + {host,Host}; +parse_subject_altname( + [{directoryName,{rdnSequence,[Rdn|_]}}|AltNames]) -> + %% + %% XXX Why is rdnSequence a sequence? + %% Should we parse all members? + %% + case parse_rdn(Rdn) of + none -> + parse_subject_altname(AltNames); + Name -> + {name,Name} + end; +parse_subject_altname([_|AltNames]) -> + parse_subject_altname(AltNames). + + +parse_rdn([]) -> + none; +parse_rdn( + [#'AttributeTypeAndValue'{ + type = ?'id-at-commonName', + value = {utf8String,CommonName}}|_]) -> + unicode:characters_to_list(CommonName); +parse_rdn([_|Rdn]) -> + parse_rdn(Rdn). %% If Node is illegal terminate the connection setup!! -splitnode(Driver, Node, LongOrShortNames) -> - case split_node(atom_to_list(Node), $@, []) of - [Name|Tail] when Tail =/= [] -> - Host = lists:append(Tail), - check_node(Driver, Name, Node, Host, LongOrShortNames); - [_] -> - error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n", - [Node]), - ?shutdown(Node); +split_node(Driver, Node, LongOrShortNames) -> + case dist_util:split_node(Node) of + {node, Name, Host} -> + check_node(Driver, Node, Name, Host, LongOrShortNames); + {host, _} -> + error_logger:error_msg( + "** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown2(Node, trace({illegal_node_n@me, Node})); _ -> - error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), - ?shutdown(Node) + error_logger:error_msg( + "** Nodename ~p illegal **~n", [Node]), + ?shutdown2(Node, trace({illegal_node_name, Node})) end. -check_node(Driver, Name, Node, Host, LongOrShortNames) -> - case split_node(Host, $., []) of - [_] when LongOrShortNames == longnames -> +check_node(Driver, Node, Name, Host, LongOrShortNames) -> + case string:split(Host, ".", all) of + [_] when LongOrShortNames =:= longnames -> case Driver:parse_address(Host) of {ok, _} -> - [Name, Host]; + {Name, Host}; _ -> - error_logger:error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node) + error_logger:error_msg( + "** System running to use " + "fully qualified hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown2(Node, trace({not_longnames, Host})) end; - [_, _ | _] when LongOrShortNames == shortnames -> - error_logger:error_msg("** System NOT running to use fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); + [_,_|_] when LongOrShortNames =:= shortnames -> + error_logger:error_msg( + "** System NOT running to use " + "fully qualified hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown2(Node, trace({not_shortnames, Host})); _ -> - [Name, Host] + {Name, Host} end. -split_node([Chr|T], Chr, Ack) -> - [lists:reverse(Ack)|split_node(T, Chr, [])]; -split_node([H|T], Chr, Ack) -> - split_node(T, Chr, [H|Ack]); -split_node([], _, Ack) -> - [lists:reverse(Ack)]. - -connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) -> - common_hs_data(Kernel, MyNode, Socket, Timer, - #hs_data{other_node = Node, - other_version = Version, - f_address = - fun(_,_) -> - #net_address{address = {Ip,TcpPort}, - host = Address, - protocol = proxy, - family = inet} - end, - request_type = Type - }). - -accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> - common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ - allowed = Allowed, - f_address = fun get_remote_id/2 - }). - -common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> - HsData#hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - f_send = - fun(S,D) -> - gen_tcp:send(S,D) - end, - f_recv = - fun(S,N,T) -> - gen_tcp:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - inet:setopts(S, [{active, false}, {packet, 4}]) - end, - f_setopts_post_nodeup = - fun(S) -> - inet:setopts(S, [{deliver, port},{active, true}]) - end, - f_getll = - fun(S) -> - inet:getll(S) - end, - mf_tick = - fun(S) -> - gen_tcp:send(S, <<>>) - end, - mf_getstat = - fun(S) -> - {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]), - R = proplists:get_value(recv_cnt, Stats, 0), - W = proplists:get_value(send_cnt, Stats, 0), - P = proplists:get_value(send_pend, Stats, 0), - {ok, R,W,P} - end}. - -get_remote_id(Socket, _Node) -> - case ssl_tls_dist_proxy:get_tcp_address(Socket) of - {ok, Address} -> - Address; - {error, _Reason} -> - ?shutdown(no_node) +%% ------------------------------------------------------------------------- + +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + lists:ukeysort(1, ConnectOpts ++ Opts); + _ -> + Opts + end. + +%% we may not always want the nodelay behaviour +%% for performance reasons +nodelay() -> + case application:get_env(kernel, dist_nodelay) of + undefined -> + {nodelay, true}; + {ok, true} -> + {nodelay, true}; + {ok, false} -> + {nodelay, false}; + _ -> + {nodelay, true} + end. + + +get_ssl_options(Type) -> + try ets:lookup(ssl_dist_opts, Type) of + [{Type, Opts}] -> + [{erl_dist, true} | Opts]; + _ -> + get_ssl_dist_arguments(Type) + catch + error:badarg -> + get_ssl_dist_arguments(Type) + end. + +get_ssl_dist_arguments(Type) -> + case init:get_argument(ssl_dist_opt) of + {ok, Args} -> + [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; + _ -> + [{erl_dist, true}] + end. + + +ssl_options(_Type, []) -> + []; +ssl_options(client, ["client_" ++ Opt, Value | T] = Opts) -> + ssl_options(client, T, Opts, Opt, Value); +ssl_options(server, ["server_" ++ Opt, Value | T] = Opts) -> + ssl_options(server, T, Opts, Opt, Value); +ssl_options(Type, [_Opt, _Value | T]) -> + ssl_options(Type, T). +%% +ssl_options(Type, T, Opts, Opt, Value) -> + case ssl_option(Type, Opt) of + error -> + error(malformed_ssl_dist_opt, [Type, Opts]); + Fun -> + [{list_to_atom(Opt), Fun(Value)}|ssl_options(Type, T)] end. + +ssl_option(server, Opt) -> + case Opt of + "dhfile" -> fun listify/1; + "fail_if_no_peer_cert" -> fun atomize/1; + _ -> ssl_option(client, Opt) + end; +ssl_option(client, Opt) -> + case Opt of + "certfile" -> fun listify/1; + "cacertfile" -> fun listify/1; + "keyfile" -> fun listify/1; + "password" -> fun listify/1; + "verify" -> fun atomize/1; + "verify_fun" -> fun verify_fun/1; + "crl_check" -> fun atomize/1; + "crl_cache" -> fun termify/1; + "reuse_sessions" -> fun atomize/1; + "secure_renegotiate" -> fun atomize/1; + "depth" -> fun erlang:list_to_integer/1; + "hibernate_after" -> fun erlang:list_to_integer/1; + "ciphers" -> fun listify/1; + _ -> error + end. + +listify(List) when is_list(List) -> + List. + +atomize(List) when is_list(List) -> + list_to_atom(List); +atomize(Atom) when is_atom(Atom) -> + Atom. + +termify(String) when is_list(String) -> + {ok, Tokens, _} = erl_scan:string(String ++ "."), + {ok, Term} = erl_parse:parse_term(Tokens), + Term. + +verify_fun(Value) -> + case termify(Value) of + {Mod, Func, State} when is_atom(Mod), is_atom(Func) -> + Fun = fun Mod:Func/3, + {Fun, State}; + _ -> + error(malformed_ssl_dist_opt, [Value]) + end. + +%% ------------------------------------------------------------------------- + +%% Trace point +trace(Term) -> Term. + +%% Keep an eye on distribution Pid:s we know of +monitor_pid(Pid) -> + %%spawn( + %% fun () -> + %% MRef = erlang:monitor(process, Pid), + %% receive + %% {'DOWN', MRef, _, _, normal} -> + %% error_logger:error_report( + %% [dist_proc_died, + %% {reason, normal}, + %% {pid, Pid}]); + %% {'DOWN', MRef, _, _, Reason} -> + %% error_logger:info_report( + %% [dist_proc_died, + %% {reason, Reason}, + %% {pid, Pid}]) + %% end + %% end), + Pid. + +dbg() -> + dbg:stop(), + dbg:tracer(), + dbg:p(all, c), + dbg:tpl(?MODULE, cx), + dbg:tpl(erlang, dist_ctrl_get_data_notification, cx), + dbg:tpl(erlang, dist_ctrl_get_data, cx), + dbg:tpl(erlang, dist_ctrl_put_data, cx), + ok. |