aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRaimo Niskanen <[email protected]>2018-04-27 12:00:47 +0200
committerRaimo Niskanen <[email protected]>2018-04-27 12:00:47 +0200
commit87b06e4ab91729f7415578c8ac0aacec28720ad9 (patch)
treed0d0c38d840e9919831ce9d08d554452a4aad3d4
parent8f825cfd0134f892c681dd31a98ba34b34bf108c (diff)
parent5803f0ad5be257b451588e8da83d1295eabea85e (diff)
downloadotp-87b06e4ab91729f7415578c8ac0aacec28720ad9.tar.gz
otp-87b06e4ab91729f7415578c8ac0aacec28720ad9.tar.bz2
otp-87b06e4ab91729f7415578c8ac0aacec28720ad9.zip
Merge branch 'raimo/better-TLS-distribution/OTP-14969'
* raimo/better-TLS-distribution/OTP-14969: Fix distro CRL test cases short vs long names Allow check for node name Move check ip to before SSL handshake Check client IP from server Parse cert primarily for host names Open for host and node allow list Create plug-in for distro cert nodes Rewrite TLS dist to handle node names in certs Improve node allowed check
-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