aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib/kernel/src/dist_util.erl152
-rw-r--r--lib/ssl/src/inet_tls_dist.erl601
-rw-r--r--lib/ssl/test/make_certs.erl30
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl7
-rw-r--r--lib/ssl/test/ssl_dist_bench_SUITE.erl74
5 files changed, 641 insertions, 223 deletions
diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl
index 781397e1ee..ecc022b28d 100644
--- a/lib/kernel/src/dist_util.erl
+++ b/lib/kernel/src/dist_util.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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.
@@ -30,6 +30,7 @@
strict_order_flags/0,
start_timer/1, setup_timer/2,
reset_timer/1, cancel_timer/1,
+ is_node_name/1, split_node/1, is_allowed/2,
shutdown/3, shutdown/4]).
-import(error_logger,[error_msg/2]).
@@ -182,7 +183,6 @@ handshake_other_started(#hs_data{request_type=ReqType,
reject_flags=RejFlgs,
require_flags=ReqFlgs},
check_dflags(HSData, EDF),
- is_allowed(HSData),
?debug({"MD5 connection from ~p (V~p)~n",
[Node, HSData#hs_data.other_version]}),
mark_pending(HSData),
@@ -200,21 +200,6 @@ handshake_other_started(OldHsData) when element(1,OldHsData) =:= hs_data ->
%%
-%% check if connecting node is allowed to connect
-%% with allow-node-scheme
-%%
-is_allowed(#hs_data{other_node = Node,
- allowed = Allowed} = HSData) ->
- case lists:member(Node, Allowed) of
- false when Allowed =/= [] ->
- send_status(HSData, not_allowed),
- error_msg("** Connection attempt from "
- "disallowed node ~w ** ~n", [Node]),
- ?shutdown2(Node, {is_allowed, not_allowed});
- _ -> true
- end.
-
-%%
%% Check mandatory flags...
%%
check_dflags(#hs_data{other_node = Node,
@@ -642,33 +627,130 @@ send_challenge_ack(#hs_data{socket = Socket, f_send = FSend},
%% tcp_drv.c which used it to detect simultaneous connection
%% attempts).
%%
-recv_name(#hs_data{socket = Socket, f_recv = Recv}) ->
+recv_name(#hs_data{socket = Socket, f_recv = Recv} = HSData) ->
case Recv(Socket, 0, infinity) of
- {ok,Data} ->
- get_name(Data);
+ {ok,
+ [$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4
+ | OtherNode] = Data} ->
+ case is_node_name(OtherNode) of
+ true ->
+ Flags = ?u32(Flag1, Flag2, Flag3, Flag4),
+ Version = ?u16(VersionA,VersionB),
+ is_allowed(HSData, Flags, OtherNode, Version);
+ false ->
+ ?shutdown(Data)
+ end;
_ ->
?shutdown(no_node)
end.
-get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode] = Data) ->
- case is_valid_name(OtherNode) of
+is_node_name(OtherNodeName) ->
+ case string:split(OtherNodeName, "@", all) of
+ [Name,Host] ->
+ (not string:is_empty(Name))
+ andalso (not string:is_empty(Host));
+ _ ->
+ false
+ end.
+
+split_node(Node) ->
+ Split = string:split(listify(Node), "@", all),
+ case Split of
+ [Name,Host] ->
+ case string:is_empty(Name) of
+ true ->
+ Split;
+ false ->
+ case string:is_empty(Host) of
+ true ->
+ {name,Name};
+ false ->
+ {node,Name,Host}
+ end
+ end;
+ [Host] ->
+ case string:is_empty(Host) of
+ true ->
+ Split;
+ false ->
+ {host,Host}
+ end
+ end.
+
+%% Check if connecting node is allowed to connect
+%% with allow-node-scheme. An empty allowed list
+%% allows all nodes.
+%%
+is_allowed(#hs_data{allowed = []}, Flags, Node, Version) ->
+ {Flags,list_to_atom(Node),Version};
+is_allowed(#hs_data{allowed = Allowed} = HSData, Flags, Node, Version) ->
+ case is_allowed(Node, Allowed) of
true ->
- {?u32(Flag1, Flag2, Flag3, Flag4), list_to_atom(OtherNode),
- ?u16(VersionA,VersionB)};
+ {Flags,list_to_atom(Node),Version};
false ->
- ?shutdown(Data)
- end;
-get_name(Data) ->
- ?shutdown(Data).
-
-is_valid_name(OtherNodeName) ->
- case string:lexemes(OtherNodeName,"@") of
- [_OtherNodeName,_OtherNodeHost] ->
- true;
- _else ->
- false
+ send_status(HSData#hs_data{other_node = Node}, not_allowed),
+ error_msg("** Connection attempt from "
+ "disallowed node ~s ** ~n", [Node]),
+ ?shutdown2(Node, {is_allowed, not_allowed})
+ end.
+
+%% The allowed list can contain node names, host names
+%% or names before '@', in atom or list form:
+%% [[email protected], "host.example.org", "node@"].
+%% An empty allowed list allows no nodes.
+%%
+%% Allow a node that matches any entry in the allowed list.
+%% Also allow allowed entries as node to match, not from
+%% this module; here the node has to be a valid name.
+%%
+is_allowed(_Node, []) ->
+ false;
+is_allowed(Node, [Node|_Allowed]) ->
+ %% Just an optimization
+ true;
+is_allowed(Node, [AllowedNode|Allowed]) ->
+ case split_node(AllowedNode) of
+ {node,AllowedName,AllowedHost} ->
+ %% Allowed node name
+ case split_node(Node) of
+ {node,AllowedName,AllowedHost} ->
+ true;
+ _ ->
+ is_allowed(Node, Allowed)
+ end;
+ {host,AllowedHost} ->
+ %% Allowed host name
+ case split_node(Node) of
+ {node,_,AllowedHost} ->
+ %% Matching Host part
+ true;
+ {host,AllowedHost} ->
+ %% Host matches Host
+ true;
+ _ ->
+ is_allowed(Node, Allowed)
+ end;
+ {name,AllowedName} ->
+ %% Allowed name before '@'
+ case split_node(Node) of
+ {node,AllowedName,_} ->
+ %% Matching Name part
+ true;
+ {name,AllowedName} ->
+ %% Name matches Name
+ true;
+ _ ->
+ is_allowed(Node, Allowed)
+ end;
+ _ ->
+ is_allowed(Node, Allowed)
end.
+listify(Atom) when is_atom(Atom) ->
+ atom_to_list(Atom);
+listify(Node) when is_list(Node) ->
+ Node.
+
publish_type(Flags) ->
case Flags band ?DFLAG_PUBLISHED of
0 ->
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
index 8e605bec65..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.
@@ -29,13 +29,16 @@
-export([gen_listen/2, gen_accept/2, gen_accept_connection/6,
gen_setup/6, gen_close/2, gen_select/2]).
--export([split_node/1, nodelay/0]).
+-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").
@@ -49,25 +52,20 @@ select(Node) ->
gen_select(inet_tcp, Node).
gen_select(Driver, Node) ->
- case split_node(Node) of
- false ->
- false;
- Host ->
+ case dist_util:split_node(Node) of
+ {node,_,Host} ->
case Driver:getaddr(Host) of
{ok, _} -> true;
_ -> false
- end
+ end;
+ _ ->
+ false
end.
%% -------------------------------------------------------------------------
is_node_name(Node) ->
- case split_node(Node) of
- false ->
- false;
- _Host ->
- true
- end.
+ dist_util:is_node_name(Node).
%% -------------------------------------------------------------------------
@@ -142,13 +140,13 @@ f_getll(DistCtrl) ->
f_address(SslSocket, Node) ->
case ssl:peername(SslSocket) of
{ok, Address} ->
- case split_node(Node) of
- false ->
- {error, no_node};
- Host ->
+ case dist_util:split_node(Node) of
+ {node,_,Host} ->
#net_address{
address=Address, host=Host,
- protocol=tls, family=inet}
+ protocol=tls, family=inet};
+ _ ->
+ {error, no_node}
end
end.
@@ -224,42 +222,158 @@ gen_accept(Driver, Listen) ->
accept_loop(Driver, Listen, Kernel) ->
case Driver:accept(Listen) of
{ok, Socket} ->
- Opts = get_ssl_options(server),
- wait_for_code_server(),
- case ssl:ssl_accept(
- Socket, [{active, false}, {packet, 4}] ++ Opts,
- net_kernel:connecttime()) of
- {ok, #sslsocket{pid = DistCtrl} = SslSocket} ->
- monitor_pid(DistCtrl),
- trace(
- Kernel !
- {accept, self(), DistCtrl,
- Driver:family(), tls}),
- receive
- {Kernel, controller, Pid} ->
- ok = ssl:controlling_process(SslSocket, Pid),
- trace(
- Pid ! {self(), controller});
- {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.
+ case check_ip(Driver, Socket) of
+ true ->
+ accept_loop(Driver, Listen, Kernel, Socket);
+ {false,IP} ->
error_logger:error_msg(
- "Cannot accept TLS distribution connection: ~s~n",
- [ssl:format_error(Error)]),
- _ = trace(Error),
- gen_tcp:close(Socket);
- Other ->
- _ = trace(Other),
- gen_tcp:close(Socket)
+ "** 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).
+ 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.
+
wait_for_code_server() ->
%% This is an ugly hack. Upgrading a socket to TLS requires the
@@ -311,29 +425,81 @@ gen_accept_connection(
do_accept(Driver, Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
SslSocket = ssl_connection:get_sslsocket(DistCtrl),
receive
- {AcceptPid, controller} ->
+ {AcceptPid, controller, CertNodesFun} ->
Timer = dist_util:start_timer(SetupTime),
- case check_ip(Driver, SslSocket) of
- true ->
- HSData0 = hs_data_common(SslSocket),
- HSData =
- HSData0#hs_data{
- kernel_pid = Kernel,
- this_node = MyNode,
- socket = DistCtrl,
- timer = Timer,
- this_flags = 0,
- allowed = Allowed},
- link(DistCtrl),
- dist_util:handshake_other_started(trace(HSData));
- {false,IP} ->
- error_logger:error_msg(
- "** Connection attempt from "
- "disallowed IP ~w ** ~n", [IP]),
- ?shutdown2(no_node, trace({disallowed, IP}))
- end
+ 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.
+%% 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) ->
@@ -351,7 +517,7 @@ gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
[link, {priority, max}])).
do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
- [Name, Address] = splitnode(Driver, Node, LongOrShortNames),
+ {Name, Address} = split_node(Driver, Node, LongOrShortNames),
case Driver:getaddr(Address) of
{ok, Ip} ->
Timer = trace(dist_util:start_timer(SetupTime)),
@@ -361,8 +527,12 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
Opts =
trace(
connect_options(
- [{server_name_indication, atom_to_list(Node)}
- |get_ssl_options(client)])),
+ %%
+ %% 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:connect(
Address, TcpPort,
@@ -370,7 +540,7 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
Driver:family(), nodelay()] ++ Opts,
net_kernel:connecttime()) of
{ok, #sslsocket{pid = DistCtrl} = SslSocket} ->
- monitor_pid(DistCtrl),
+ _ = monitor_pid(DistCtrl),
ok = ssl:controlling_process(SslSocket, self()),
HSData0 = hs_data_common(SslSocket),
HSData =
@@ -411,19 +581,81 @@ close(Socket) ->
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.
%% ------------------------------------------------------------
-check_ip(Driver, SslSocket) ->
+check_ip(Driver, Socket) ->
case application:get_env(check_ip) of
{ok, true} ->
- case get_ifs(SslSocket) of
+ case get_ifs(Socket) of
{ok, IFs, IP} ->
check_ip(Driver, IFs, IP);
Other ->
?shutdown2(
- no_node, trace({check_ip_failed, SslSocket, Other}))
+ no_node, trace({check_ip_failed, Socket, Other}))
end;
_ ->
true
@@ -437,7 +669,7 @@ check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) ->
check_ip(_Driver, [], PeerIP) ->
{false, PeerIP}.
-get_ifs(#sslsocket{fd = {gen_tcp, Socket, _}}) ->
+get_ifs(Socket) ->
case inet:peername(Socket) of
{ok, {IP, _}} ->
%% XXX this is seriously broken for IPv6
@@ -450,12 +682,87 @@ get_ifs(#sslsocket{fd = {gen_tcp, Socket, _}}) ->
end.
+%% 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;
+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 string:split(atom_to_list(Node), "@") of
- [Name, Host] when Host =/= [] ->
- check_node(Driver, Name, Node, Host, LongOrShortNames);
- [_] ->
+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]),
@@ -466,12 +773,12 @@ splitnode(Driver, Node, LongOrShortNames) ->
?shutdown2(Node, trace({illegal_node_name, Node}))
end.
-check_node(Driver, Name, Node, Host, LongOrShortNames) ->
- case string:split(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 "
@@ -480,7 +787,7 @@ check_node(Driver, Name, Node, Host, LongOrShortNames) ->
[Host]),
?shutdown2(Node, trace({not_longnames, Host}))
end;
- [_, _] when LongOrShortNames == shortnames ->
+ [_,_|_] when LongOrShortNames =:= shortnames ->
error_logger:error_msg(
"** System NOT running to use "
"fully qualified hostnames **~n"
@@ -488,19 +795,9 @@ check_node(Driver, Name, Node, Host, LongOrShortNames) ->
[Host]),
?shutdown2(Node, trace({not_shortnames, Host}));
_ ->
- [Name, Host]
+ {Name, Host}
end.
-split_node(Node) when is_atom(Node) ->
- case string:split(atom_to_list(Node), "@") of
- [Name, Host] when Name =/= [], Host =/= [] ->
- Host;
- _ ->
- false
- end;
-split_node(_) ->
- false.
-
%% -------------------------------------------------------------------------
connect_options(Opts) ->
@@ -545,70 +842,50 @@ get_ssl_dist_arguments(Type) ->
[{erl_dist, true}]
end.
-ssl_options(_,[]) ->
+
+ssl_options(_Type, []) ->
[];
-ssl_options(server, ["client_" ++ _, _Value |T]) ->
- ssl_options(server,T);
-ssl_options(client, ["server_" ++ _, _Value|T]) ->
- ssl_options(client,T);
-ssl_options(server, ["server_certfile", Value|T]) ->
- [{certfile, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_certfile", Value | T]) ->
- [{certfile, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_cacertfile", Value|T]) ->
- [{cacertfile, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_cacertfile", Value|T]) ->
- [{cacertfile, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_keyfile", Value|T]) ->
- [{keyfile, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_keyfile", Value|T]) ->
- [{keyfile, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_password", Value|T]) ->
- [{password, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_password", Value|T]) ->
- [{password, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_verify", Value|T]) ->
- [{verify, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_verify", Value|T]) ->
- [{verify, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_verify_fun", Value|T]) ->
- [{verify_fun, verify_fun(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_verify_fun", Value|T]) ->
- [{verify_fun, verify_fun(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_crl_check", Value|T]) ->
- [{crl_check, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_crl_check", Value|T]) ->
- [{crl_check, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_crl_cache", Value|T]) ->
- [{crl_cache, termify(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_crl_cache", Value|T]) ->
- [{crl_cache, termify(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_reuse_sessions", Value|T]) ->
- [{reuse_sessions, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_reuse_sessions", Value|T]) ->
- [{reuse_sessions, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_secure_renegotiate", Value|T]) ->
- [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_secure_renegotiate", Value|T]) ->
- [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_depth", Value|T]) ->
- [{depth, list_to_integer(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_depth", Value|T]) ->
- [{depth, list_to_integer(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_hibernate_after", Value|T]) ->
- [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_hibernate_after", Value|T]) ->
- [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_ciphers", Value|T]) ->
- [{ciphers, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_ciphers", Value|T]) ->
- [{ciphers, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_dhfile", Value|T]) ->
- [{dhfile, Value} | ssl_options(server,T)];
-ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) ->
- [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)];
-ssl_options(Type, Opts) ->
- error(malformed_ssl_dist_opt, [Type, Opts]).
+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);
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index ecbacc1590..8fe7c54549 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -19,7 +19,7 @@
%%
-module(make_certs).
--compile([export_all]).
+-compile([export_all, nowarn_export_all]).
%-export([all/1, all/2, rootCA/2, intermediateCA/3, endusers/3, enduser/3, revoke/3, gencrl/2, verify/3]).
@@ -34,14 +34,15 @@
ecc_certs = false,
issuing_distribution_point = false,
crl_port = 8000,
- openssl_cmd = "openssl"}).
+ openssl_cmd = "openssl",
+ hostname = "host.example.com"}).
default_config() ->
- #config{}.
+ #config{hostname = net_adm:localhost()}.
make_config(Args) ->
- make_config(Args, #config{}).
+ make_config(Args, default_config()).
make_config([], C) ->
C;
@@ -66,7 +67,9 @@ make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) ->
make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) ->
make_config(T, C#config{issuing_distribution_point = Bool});
make_config([{openssl_cmd, Cmd}|T], C) when is_list(Cmd) ->
- make_config(T, C#config{openssl_cmd = Cmd}).
+ make_config(T, C#config{openssl_cmd = Cmd});
+make_config([{hostname, Hostname}|T], C) when is_list(Hostname) ->
+ make_config(T, C#config{hostname = Hostname}).
all([DataDir, PrivDir]) ->
@@ -384,8 +387,11 @@ req_cnf(Root, C) ->
"subjectKeyIdentifier = hash\n"
"subjectAltName = email:copy\n"].
-ca_cnf(Root, C = #config{issuing_distribution_point = true}) ->
- Hostname = net_adm:localhost(),
+ca_cnf(
+ Root,
+ #config{
+ issuing_distribution_point = true,
+ hostname = Hostname} = C) ->
["# Purpose: Configuration for CAs.\n"
"\n"
"ROOTDIR = " ++ Root ++ "\n"
@@ -464,8 +470,12 @@ ca_cnf(Root, C = #config{issuing_distribution_point = true}) ->
"crlDistributionPoints=@crl_section\n"
];
-ca_cnf(Root, C = #config{issuing_distribution_point = false}) ->
- Hostname = net_adm:localhost(),
+ca_cnf(
+ Root,
+ #config{
+ issuing_distribution_point = false,
+ hostname = Hostname
+ } = C) ->
["# Purpose: Configuration for CAs.\n"
"\n"
"ROOTDIR = " ++ Root ++ "\n"
diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl
index c822a52d1f..003e1fc448 100644
--- a/lib/ssl/test/ssl_dist_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -25,7 +25,7 @@
-include("ssl_dist_test_lib.hrl").
%% Note: This directive should only be used in test suites.
--compile(export_all).
+-compile([export_all, nowarn_export_all]).
-define(DEFAULT_TIMETRAP_SECS, 240).
@@ -724,7 +724,8 @@ setup_certs(Config) ->
ok = file:make_dir(NodeDir),
ok = file:make_dir(RGenDir),
make_randfile(RGenDir),
- {ok, _} = make_certs:all(RGenDir, NodeDir),
+ [Hostname|_] = string:split(net_adm:localhost(), ".", all),
+ {ok, _} = make_certs:all(RGenDir, NodeDir, [{hostname,Hostname}]),
SDir = filename:join([NodeDir, "server"]),
SC = filename:join([SDir, "cert.pem"]),
SK = filename:join([SDir, "key.pem"]),
diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl
index 4d27564319..f827ea12bb 100644
--- a/lib/ssl/test/ssl_dist_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl
@@ -1,7 +1,7 @@
%%%-------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2017. All Rights Reserved.
+%% Copyright Ericsson AB 2017-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.
@@ -77,6 +77,7 @@ init_per_suite(Config) ->
try
Node =/= nonode@nohost orelse
throw({skipped,"Node not distributed"}),
+ verify_node_src_addr(),
{supported, SSLVersions} =
lists:keyfind(supported, 1, ssl:versions()),
lists:member(TLSVersion, SSLVersions) orelse
@@ -95,14 +96,14 @@ init_per_suite(Config) ->
_ ->
PrivDir = proplists:get_value(priv_dir, Config),
%%
- [_, HostA] = string:split(atom_to_list(Node), "@"),
+ [_, HostA] = split_node(Node),
NodeAName = ?MODULE_STRING ++ "_node_a",
NodeAString = NodeAName ++ "@" ++ HostA,
NodeAConfFile = filename:join(PrivDir, NodeAString ++ ".conf"),
NodeA = list_to_atom(NodeAString),
%%
ServerNode = ssl_bench_test_lib:setup(dist_server),
- [_, HostB] = string:split(atom_to_list(ServerNode), "@"),
+ [_, HostB] = split_node(ServerNode),
NodeBName = ?MODULE_STRING ++ "_node_b",
NodeBString = NodeBName ++ "@" ++ HostB,
NodeBConfFile = filename:join(PrivDir, NodeBString ++ ".conf"),
@@ -116,16 +117,25 @@ init_per_suite(Config) ->
?MODULE_STRING ++ " ROOT CA", CertOptions),
SSLConf =
[{verify, verify_peer},
+ {fail_if_no_peer_cert, true},
{versions, [TLSVersion]},
{ciphers, [TLSCipher]}],
+ ServerConf =
+ [{verify_fun,
+ {fun inet_tls_dist:verify_client/3,
+ fun inet_tls_dist:cert_nodes/1}}
+ | SSLConf],
+ ClientConf =
+ [{verify_fun,
+ {fun inet_tls_dist:verify_server/3,
+ fun inet_tls_dist:cert_nodes/1}}
+ | SSLConf],
%%
write_node_conf(
- NodeAConfFile, NodeA,
- [{fail_if_no_peer_cert, true} | SSLConf], SSLConf,
+ NodeAConfFile, NodeA, ServerConf, ClientConf,
CertOptions, RootCert),
write_node_conf(
- NodeBConfFile, NodeB,
- [{fail_if_no_peer_cert, true} | SSLConf], SSLConf,
+ NodeBConfFile, NodeB, ServerConf, ClientConf,
CertOptions, RootCert),
%%
[{node_a_name, NodeAName},
@@ -170,17 +180,53 @@ end_per_testcase(_Func, _Conf) ->
%%%-------------------------------------------------------------------
%%% CommonTest API helpers
+verify_node_src_addr() ->
+ Msg = "Hello, world!",
+ {ok,Host} = inet:gethostname(),
+ {ok,DstAddr} = inet:getaddr(Host, inet),
+ {ok,Socket} = gen_udp:open(0, [{active,false}]),
+ {ok,Port} = inet:port(Socket),
+ ok = gen_udp:send(Socket, DstAddr, Port, Msg),
+ case gen_udp:recv(Socket, length(Msg) + 1, 1000) of
+ {ok,{DstAddr,Port,Msg}} ->
+ ok;
+ {ok,{SrcAddr,Port,Msg}} ->
+ throw({skipped,
+ "Src and dst address mismatch: " ++
+ term_to_string(SrcAddr) ++ " =:= " ++
+ term_to_string(DstAddr)});
+ Weird ->
+ error(Weird)
+ end.
+
write_node_conf(
ConfFile, Node, ServerConf, ClientConf, CertOptions, RootCert) ->
+ [Name,Host] = split_node(Node),
Conf =
public_key:pkix_test_data(
#{root => RootCert,
peer =>
[{extensions,
- [#'Extension'{
+ [
+ #'Extension'{
+ extnID = ?'id-ce-subjectAltName',
+ extnValue = [{dNSName, Host}],
+ critical = true},
+ #'Extension'{
extnID = ?'id-ce-subjectAltName',
- extnValue = [{dNSName, atom_to_list(Node)}],
- critical = false}]} | CertOptions]}),
+ extnValue =
+ [{directoryName,
+ {rdnSequence,
+ [[#'AttributeTypeAndValue'{
+ type = ?'id-at-commonName',
+ value =
+ {utf8String,
+ unicode:characters_to_binary(
+ Name, utf8)
+ }
+ }]]}}],
+ critical = true}
+ ]} | CertOptions]}),
NodeConf =
[{server, ServerConf ++ Conf}, {client, ClientConf ++ Conf}],
{ok, Fd} = file:open(ConfFile, [write]),
@@ -188,6 +234,8 @@ write_node_conf(
io:format(Fd, "~p.~n", [NodeConf]),
ok = file:close(Fd).
+split_node(Node) ->
+ string:split(atom_to_list(Node), "@").
%%%-------------------------------------------------------------------
%%% Test cases
@@ -199,7 +247,7 @@ setup(Config) ->
run_nodepair_test(fun setup/5, Config).
setup(A, B, Prefix, HA, HB) ->
- Rounds = 10,
+ Rounds = 50,
[] = ssl_apply(HA, erlang, nodes, []),
[] = ssl_apply(HB, erlang, nodes, []),
{SetupTime, CycleTime} =
@@ -221,9 +269,9 @@ setup_loop(_A, _B, T, 0) ->
T;
setup_loop(A, B, T, N) ->
StartTime = start_time(),
- [A] = rpc:block_call(B, erlang, nodes, []),
+ [N,A] = [N|rpc:block_call(B, erlang, nodes, [])],
Time = elapsed_time(StartTime),
- [B] = erlang:nodes(),
+ [N,B] = [N|erlang:nodes()],
Mref = erlang:monitor(process, {rex,B}),
true = net_kernel:disconnect(B),
receive