aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorIngela Anderton Andin <ingela@erlang.org>2011-06-30 15:38:55 +0200
committerIngela Anderton Andin <ingela@erlang.org>2011-09-09 15:59:24 +0200
commit5b0a4180582921fe3b61b430f0c87d9a68ba6da8 (patch)
treef0850e6caaa6c8d02ab9f38523da97f1e983177f /lib
parent50392cec6e5bda7ac62abff3313eae551b006612 (diff)
downloadotp-5b0a4180582921fe3b61b430f0c87d9a68ba6da8.tar.gz
otp-5b0a4180582921fe3b61b430f0c87d9a68ba6da8.tar.bz2
otp-5b0a4180582921fe3b61b430f0c87d9a68ba6da8.zip
First fully working version
Diffstat (limited to 'lib')
-rw-r--r--lib/ssl/client.pem34
-rw-r--r--lib/ssl/doc/src/ssl_distribution.xml209
-rw-r--r--lib/ssl/doc/src/ssl_protocol.xml16
-rw-r--r--lib/ssl/inet_proxy_dist.erl229
-rw-r--r--lib/ssl/proxy_server.erl272
-rw-r--r--lib/ssl/server.pem34
-rw-r--r--lib/ssl/src/Makefile5
-rw-r--r--lib/ssl/src/inet_ssl_dist.erl6
-rw-r--r--lib/ssl/src/inet_tls_dist.erl275
-rw-r--r--lib/ssl/src/ssl.app.src3
-rw-r--r--lib/ssl/src/ssl.erl8
-rw-r--r--lib/ssl/src/ssl_connection.erl24
-rw-r--r--lib/ssl/src/ssl_connection_sup.erl12
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl84
-rw-r--r--lib/ssl/src/ssl_internal.hrl4
-rw-r--r--lib/ssl/src/ssl_manager.erl28
-rw-r--r--lib/ssl/src/ssl_sup.erl35
-rw-r--r--lib/ssl/src/ssl_tls_dist_proxy.erl326
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl603
20 files changed, 1493 insertions, 715 deletions
diff --git a/lib/ssl/client.pem b/lib/ssl/client.pem
deleted file mode 100644
index 90d88a259a..0000000000
--- a/lib/ssl/client.pem
+++ /dev/null
@@ -1,34 +0,0 @@
------BEGIN CERTIFICATE-----
-MIICfjCCAeegAwIBAgIFZ0ez/tEwDQYJKoZIhvcNAQEFBQAwdzEeMBwGCSqGSIb3
-DQEJARYPZGd1ZEBlcmxhbmcub3JnMQ0wCwYDVQQDEwRkZ3VkMRIwEAYDVQQHEwlT
-dG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcxFDASBgNVBAsT
-C3Rlc3RpbmcgZGVwMCIYDzIwMTAwODI1MDAwMDAwWhgPMjAxMDA5MDEwMDAwMDBa
-MHcxHjAcBgkqhkiG9w0BCQEWD2RndWRAZXJsYW5nLm9yZzENMAsGA1UEAxMEZGd1
-ZDESMBAGA1UEBxMJU3RvY2tob2xtMQswCQYDVQQGEwJTRTEPMA0GA1UEChMGZXJs
-YW5nMRQwEgYDVQQLEwt0ZXN0aW5nIGRlcDCBnjANBgkqhkiG9w0BAQEFAAOBjAAw
-gYgCgYBk/3JXHJ02+rqJ1qJqtMtBhPh2HKRhy7SHFhIg0LbalsH+B0pXcP6c3b9p
-nY68FEqhB69jJfFgb98tW68+qDDh4aWeJc3cw3NslVvJXB5ADWsewrUoXx0hTHiL
-T/f+RC5BBvnfAZAJYXTxpoukiVZJvVuq7o/rVWDpQPfy8MNr/QIDAQABoxMwETAP
-BgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAGXTeYefvpqgs6JcLTw8
-Hem8YrZIK1Icgu2QYRVZHuqFf45MBqrEUHHXNxDIWXD7U6shWezw5laB+5AcW8sq
-9RI+3CYU0wOb0XgFQmcIfCMFbhKvTdB5S7zjy3B39B264/cRBZXFdgAeILEDsBk0
-zgFSLCMULbtTxF+3zNJ/Fclq
------END CERTIFICATE-----
-
-XXX Following key assumed not encrypted
------BEGIN RSA PRIVATE KEY-----
-MIICWgIBAAKBgGT/clccnTb6uonWomq0y0GE+HYcpGHLtIcWEiDQttqWwf4HSldw
-/pzdv2mdjrwUSqEHr2Ml8WBv3y1brz6oMOHhpZ4lzdzDc2yVW8lcHkANax7CtShf
-HSFMeItP9/5ELkEG+d8BkAlhdPGmi6SJVkm9W6ruj+tVYOlA9/Lww2v9AgMBAAEC
-gYAH8urm3EOrXhRsYM4ro8sTfwmnEh4F7Ghq8Vu/5W1eytq9yYkaVLRVWEaGY3Ym
-a1psThSJsyTKOEPSaBLk1YvzQeITmgHLGpJ11qJOMZO6mvj7lSQBdCc2vuusajtw
-zFOaGe6MOrFEetOKBjnGri8byrEfqJogEH2+aiPEog40KQJBAKYtiPFqh91oC3qH
-AQ1uJodhyQTrTwSBltqN1Hp9nuE6ydfNWBd1aC9sIiDY1IjUhW89eJYEYvotougQ
-ntU+8UcCQQCblsff2IGl8SdHfhWjqT3Rsg4RMKgDH52Ym9U2kI5y6Z4E9G9tQXuR
-6/tohmWX/j6CFiORuz7FhVIQ7b4HuPqbAkBVuDthvMAk15zEMYu7b8x0HV7iKLdz
-7ZzxVCP8o3wnVnnz1brRLwD1JWRdaTwI8Qd7oEvppo2f25ai+p/UBEnVAkAuU9Ur
-59Gi0Y16kiZrVudbWwMpRy2f0HgiirQPzTc9LCarHwVWqNrcdkGju/DgMwn1vhXV
-PMXSFoJ7G+8raX7lAkA4Ck9izAs08+37jmhRxcmYpOjdCxA9yWrwALJysYKlTw4N
-Qwb7Q4uDQz6EunuTGfiXZz7Oep/0L+BXRJmvweBX
------END RSA PRIVATE KEY-----
-
diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml
index 7bcc12eb5f..a2c7370ddc 100644
--- a/lib/ssl/doc/src/ssl_distribution.xml
+++ b/lib/ssl/doc/src/ssl_distribution.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2000</year><year>2010</year>
+ <year>2000</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -33,36 +33,32 @@
</header>
<p>This chapter describes how the Erlang distribution can use
SSL to get additional verification and security.
-
- <note><p>Note this
- documentation is written for the old ssl implementation and
- will be updated for the new one once this functionality is
- supported by the new implementation.</p></note>
</p>
<section>
<title>Introduction</title>
<p>The Erlang distribution can in theory use almost any connection
based protocol as bearer. A module that implements the protocol
- specific parts of connection setup is however needed. The
+ specific parts of the connection setup is however needed. The
default distribution module is <c>inet_tcp_dist</c> which is
included in the Kernel application. When starting an
Erlang node distributed, <c>net_kernel</c> uses this module to
setup listen ports and connections. </p>
- <p>In the SSL application there is an additional distribution
- module, <c>inet_ssl_dist</c> which can be used as an
+
+ <p>In the SSL application there is an additional distribution
+ module, <c>inet_tls_dist</c> which can be used as an
alternative. All distribution connections will be using SSL and
all participating Erlang nodes in a distributed system must use
this distribution module.</p>
- <p>The security depends on how the connections are set up, one can
- use key files or certificates to just get a encrypted
- connection. One can also make the SSL package verify the
- certificates of other nodes to get additional security.
- Cookies are however always used as they can be used to
- differentiate between two different Erlang networks.</p>
+
+ <p>The security level depends on the parameters provided to the
+ SSL connection setup. Erlang node cookies are however always
+ used, as they can be used to differentiate between two different
+ Erlang networks.</p>
<p>Setting up Erlang distribution over SSL involves some simple but
necessary steps:</p>
- <list type="bulleted">
+
+ <list type="bulleted">
<item>Building boot scripts including the SSL application</item>
<item>Specifying the distribution module for net_kernel</item>
<item>Specifying security options and other SSL options</item>
@@ -77,122 +73,135 @@
SASL application. Refer to the SASL documentations
for more information on systools. This is only an example of
what can be done.</p>
- <p>The simplest boot script possible includes only the Kernel
+
+ <p>The simplest boot script possible includes only the Kernel
and STDLIB applications. Such a script is located in the
Erlang distributions bin directory. The source for the script
can be found under the Erlang installation top directory under
- <c><![CDATA[releases/<OTP version>start_clean.rel]]></c>. Copy that
+ <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>. Copy that
script to another location (and preferably another name)
- and add the SSL application with its current version number
+ and add the applications crypto, public_key and SSL with their current version numbers
after the STDLIB application.</p>
<p>An example .rel file with SSL added may look like this:</p>
+
<code type="none">
-{release, {"OTP APN 181 01","P7A"}, {erts, "5.0"},
- [{kernel,"2.5"},
- {stdlib,"1.8.1"},
- {ssl,"2.2.1"}]}. </code>
- <p>Note that the version numbers surely will differ in your system.
- Whenever one of the applications included in the script is
- upgraded, the script has to be changed.</p>
- <p>Assuming the above .rel file is stored in a file
- <c>start_ssl.rel</c> in the current directory, a boot script
- can be built like this:</p>
- <code type="none">
-1> systools:make_script("start_ssl",[]). </code>
- <p>There will now be a file <c>start_ssl.boot</c> in the current
- directory. To test the boot script, start Erlang with the
- <c>-boot</c> command line parameter specifying this boot script
- (with its full path but without the <c>.boot</c> suffix), in
- Unix it could look like this:</p>
- <p></p>
- <code type="none"><![CDATA[
+ {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"},
+ [{kernel,"2.15"},
+ {stdlib,"1.18"},
+ {crypto, "2.0.3"},
+ {public_key, "0.12"},
+ {ssl, "5.0"}
+ ]}.
+ </code>
+
+ <p>Note that the version numbers surely will differ in your system.
+ Whenever one of the applications included in the script is
+ upgraded, the script has to be changed.</p>
+ <p>Assuming the above .rel file is stored in a file
+ <c>start_ssl.rel</c> in the current directory, a boot script
+ can be built like this:</p>
+
+ <code type="none">
+ 1> systools:make_script("start_ssl",[]). </code>
+
+ <p>There will now be a file <c>start_ssl.boot</c> in the current
+ directory. To test the boot script, start Erlang with the
+ <c>-boot</c> command line parameter specifying this boot script
+ (with its full path but without the <c>.boot</c> suffix), in
+ Unix it could look like this:</p>
+ <p></p>
+
+ <code type="none"><![CDATA[
$ erl -boot /home/me/ssl/start_ssl
Erlang (BEAM) emulator version 5.0
Eshell V5.0 (abort with ^G)
-1> whereis(ssl_server).
-<0.32.0> ]]></code>
+1> whereis(ssl_manager).
+<0.41.0> ]]></code>
<p>The <c>whereis</c> function call verifies that the SSL
application is really started.</p>
- <p>As an alternative to building a bootscript, one can explicitly
- add the path to the ssl <c>ebin</c> directory on the command
+
+ <p>As an alternative to building a bootscript, one can explicitly
+ add the path to the SSL <c>ebin</c> directory on the command
line. This is done with the command line option <c>-pa</c>. This
- works as the ssl application really need not be started for the
- distribution to come up, a primitive version of the ssl server
- is started by the distribution module itself, so as long as the
- primitive code server can reach the code, the distribution will
+ works as the SSL application does not need to be started for the
+ distribution to come up, as a clone of the SSL application is
+ hooked into the kernel application, so as long as the
+ SSL applications code can be reached, the distribution will
start. The <c>-pa</c> method is only recommended for testing
purposes.</p>
+
+ <note><p>Note that the clone of the SSL application is necessary to
+ enable the use of the SSL code in such an early bootstage as
+ needed to setup the distribution, however this will make it
+ impossible to soft upgrade the SSL application.</p></note>
</section>
<section>
<title>Specifying distribution module for net_kernel</title>
- <p>The distribution module for SSL is named <c>inet_ssl_dist</c>
- and is specified on the command line whit the <c>-proto_dist</c>
+ <p>The distribution module for SSL is named <c>inet_tls_dist</c>
+ and is specified on the command line with the <c>-proto_dist</c>
option. The argument to <c>-proto_dist</c> should be the module
name without the <c>_dist</c> suffix, so this distribution
- module is specified with <c>-proto_dist inet_ssl</c> on the
+ module is specified with <c>-proto_dist inet_tls</c> on the
command line.</p>
<p></p>
+
<p>Extending the command line from above gives us the following:</p>
<code type="none">
-$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl </code>
- <p>For the distribution to actually be started, we need to give
- the emulator a name as well:</p>
+$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </code>
+
+<p>For the distribution to actually be started, we need to give
+the emulator a name as well:</p>
<code type="none">
-$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl -sname ssl_test
+$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -sname ssl_test
Erlang (BEAM) emulator version 5.0 [source]
Eshell V5.0 (abort with ^G)
(ssl_test@myhost)1> </code>
<p>Note however that a node started in this way will refuse to talk
- to other nodes, as no certificates or key files are supplied
+ to other nodes, as no ssl parameters are supplied
(see below).</p>
- <p>When the SSL distribution starts, the OTP system is in its
- early boot stage, why neither <c>application</c> nor <c>code</c>
- are usable. As SSL needs to start a port program in this early
- stage, it tries to determine the path to that program from the
- primitive code loaders code path. If this fails, one need to
- specify the directory where the port program resides. This can
- be done either with an environment variable
- <c>ERL_SSL_PORTPROGRAM_DIR</c> or with the command line option
- <c>-ssl_portprogram_dir</c>. The value should be the directory
- where the <c>ssl_esock</c> port program is located. Note that
- this option is never needed in a normal Erlang installation.</p>
</section>
<section>
- <title>Specifying security options and other SSL options</title>
- <p>For SSL to work, you either need certificate files or a
- key file. Certificate files can be specified both when working as
- client and as server (connecting or accepting). </p>
- <p></p>
+ <title>Specifying SSL options</title> <p>For SSL to work, at least
+ a public key and certificate needs to be specified for the server
+ side. In the following example the PEM-files consists of two
+ entries the servers certificate and its private key.</p>
+
<p>On the <c>erl</c> command line one can specify options that the
- ssl distribution will add when creation a socket. It is
- mandatory to specify at least a key file or client and server
- certificates. One can specify any <em>SSL option</em> on the
- command line, but must not specify any socket options (like
- packet size and such). The SSL options are listed in the
- Reference Manual. The only difference between the
- options in the reference manual and the ones that can be
- specified to the distribution on the command line is that
- <c>certfile</c> can (and usually needs to) be specified as
- <c>client_certfile</c> and <c>server_certfile</c>. The
- <c>client_certfile</c> is used when the distribution initiates a
- connection to another node and the <c>server_certfile</c> is used
- when accepting a connection from a remote node. </p>
- <p>The command line argument for specifying the SSL options is named
- <c>-ssl_dist_opt</c> and should be followed by an even number of
- SSL options/option values. The <c>-ssl_dist_opt</c> argument can
- be repeated any number of times.</p>
- <p>An example command line would now look something like this
+ SSL distribution will add when creating a socket.</p>
+
+ <p>One can specify the simpler SSL options certfile, keyfile,
+ password, cacertfile, verify, reuse_sessions,
+ secure_renegotiation, depth, hibernate_after and ciphers (use old
+ string format) by adding the prefix server_ or client_ to the
+ option name. The server can also take the options dhfile and
+ fail_if_no_peer_cert (also prefixed).
+ <c>client_</c>-prfixed options are used when the distribution initiates a
+ connection to another node and the <c>server_</c>-prefixed options are used
+ when accepting a connection from a remote node. </p>
+
+ <p> More complex options such as verify_fun are not available at
+ the moment but a mechanism to handle such options may be added in
+ a future release. </p>
+
+ <p> Raw socket options such as packet and size must not be specified on
+ the command line</p>.
+
+ <p>The command line argument for specifying the SSL options is named
+ <c>-ssl_dist_opt</c> and should be followed by pairs of
+ SSL options and their values. The <c>-ssl_dist_opt</c> argument can
+ be repeated any number of times.</p>
+
+ <p>An example command line would now look something like this
(line breaks in the command are for readability,
they should not be there when typed):</p>
<code type="none">
-$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl
- -ssl_dist_opt client_certfile "/home/me/ssl/erlclient.pem"
+$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls
-ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem"
- -ssl_dist_opt verify 1 depth 1
+ -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true
-sname ssl_test
Erlang (BEAM) emulator version 5.0 [source]
@@ -211,12 +220,11 @@ Eshell V5.0 (abort with ^G)
subsequent invocations of Erlang.</p>
<p></p>
<p>In a Unix (Bourne) shell it could look like this (line breaks for
- readability):</p>
+ readability, they should not be there when typed):</p>
<code type="none">
-$ ERL_FLAGS="-boot \\"/home/me/ssl/start_ssl\\" -proto_dist inet_ssl
- -ssl_dist_opt client_certfile \\"/home/me/ssl/erlclient.pem\\"
- -ssl_dist_opt server_certfile \\"/home/me/ssl/erlserver.pem\\"
- -ssl_dist_opt verify 1 -ssl_dist_opt depth 1"
+$ ERL_FLAGS="-boot /home/me/ssl/start_ssl -proto_dist inet_tls
+ -ssl_dist_opt server_certfile /home/me/ssl/erlserver.pem
+ -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true"
$ export ERL_FLAGS
$ erl -sname ssl_test
Erlang (BEAM) emulator version 5.0 [source]
@@ -227,15 +235,12 @@ Eshell V5.0 (abort with ^G)
{progname,["erl "]},
{sname,["ssl_test"]},
{boot,["/home/me/ssl/start_ssl"]},
- {proto_dist,["inet_ssl"]},
- {ssl_dist_opt,["client_certfile","/home/me/ssl/erlclient.pem"]},
+ {proto_dist,["inet_tls"]},
{ssl_dist_opt,["server_certfile","/home/me/ssl/erlserver.pem"]},
- {ssl_dist_opt,["verify","1"]},
- {ssl_dist_opt,["depth","1"]},
+ {ssl_dist_opt,["server_secure_renegotiation","true",
+ "client_secure_renegotiate","true"]
{home,["/home/me"]}] </code>
<p>The <c>init:get_arguments()</c> call verifies that the correct
arguments are supplied to the emulator. </p>
</section>
</chapter>
-
-
diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml
index ca5cc8bc7a..17268a634d 100644
--- a/lib/ssl/doc/src/ssl_protocol.xml
+++ b/lib/ssl/doc/src/ssl_protocol.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2003</year><year>2010</year>
+ <year>2003</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -25,18 +25,18 @@
<file>ssl_protocol.xml</file>
</header>
- <p>The erlang ssl application currently supports SSL 3.0 and TLS 1.0
+ <p>The erlang SSL application currently supports SSL 3.0 and TLS 1.0
RFC 2246, and will in the future also support later versions of TLS.
SSL 2.0 is not supported.
</p>
- <p>By default erlang ssl is run over the TCP/IP protocol even
+ <p>By default erlang SSL is run over the TCP/IP protocol even
though you could plug in any other reliable transport protocol
with the same API as gen_tcp.</p>
<p>If a client and server wants to use an upgrade mechanism, such as
- defined by RFC2817, to upgrade a regular TCP/IP connection to an ssl
- connection the erlang ssl API supports this. This can be useful for
+ defined by RFC2817, to upgrade a regular TCP/IP connection to an SSL
+ connection the erlang SSL API supports this. This can be useful for
things such as supporting HTTP and HTTPS on the same port and
implementing virtual hosting.
</p>
@@ -131,7 +131,7 @@
connections. Sessions are used to avoid the expensive negotiation
of new security parameters for each connection."</p>
- <p>Session data is by default kept by the ssl application in a
+ <p>Session data is by default kept by the SSL application in a
memory storage hence session data will be lost at application
restart or takeover. Users may define their own callback module
to handle session data storage if persistent data storage is
@@ -140,8 +140,8 @@
possible to configure the amount of time the session data should be
saved.</p>
- <p>Ssl clients will by default try to reuse an available session,
- ssl servers will by default agree to reuse sessions when clients
+ <p>SSL clients will by default try to reuse an available session,
+ SSL servers will by default agree to reuse sessions when clients
ask to do so.</p>
</section>
diff --git a/lib/ssl/inet_proxy_dist.erl b/lib/ssl/inet_proxy_dist.erl
deleted file mode 100644
index 9e415def3e..0000000000
--- a/lib/ssl/inet_proxy_dist.erl
+++ /dev/null
@@ -1,229 +0,0 @@
-%%%-------------------------------------------------------------------
-%%% @author Dan Gudmundsson <dgud@erlang.org>
-%%% @copyright (C) 2010, Dan Gudmundsson
-%%% @doc
-%%%
-%%% @end
-%%% Created : 22 Jun 2010 by Dan Gudmundsson <dgud@erlang.org>
-%%%-------------------------------------------------------------------
--module(inet_proxy_dist).
-
--export([childspecs/0, listen/1, accept/1, accept_connection/5,
- setup/5, close/1, select/1, is_node_name/1]).
-
--include_lib("kernel/src/net_address.hrl").
--include_lib("kernel/src/dist.hrl").
--include_lib("kernel/src/dist_util.hrl").
-
--import(error_logger,[error_msg/2]).
-
-childspecs() ->
- io:format("childspecs called~n",[]),
- {ok, [{proxy_server,{proxy_server, start_link, []},
- permanent, 2000, worker, [proxy_server]}]}.
-
-select(Node) ->
- io:format("Select called~n",[]),
- inet_ssl_dist:select(Node).
-
-is_node_name(Name) ->
- io:format("is_node_name~n",[]),
- inet_ssl_dist:is_node_name(Name).
-
-listen(Name) ->
- io:format("listen called~n",[]),
- gen_server:call(proxy_server, {listen, Name}, infinity).
-
-accept(Listen) ->
- io:format("accept called~n",[]),
- gen_server:call(proxy_server, {accept, Listen}, infinity).
-
-accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
- io:format("accept_connection called ~n",[]),
- Kernel = self(),
- spawn_link(fun() -> do_accept(Kernel, AcceptPid, Socket,
- MyNode, Allowed, SetupTime) end).
-
-setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
- io:format("setup called~n",[]),
- Kernel = self(),
- spawn(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end).
-
-do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
- [Name, Address] = splitnode(Node, LongOrShortNames),
- case inet:getaddr(Address, inet) of
- {ok, Ip} ->
- Timer = dist_util:start_timer(SetupTime),
- case erl_epmd:port_please(Name, Ip) of
- {port, TcpPort, Version} ->
- ?trace("port_please(~p) -> version ~p~n",
- [Node,Version]),
- dist_util:reset_timer(Timer),
- case gen_server:call(proxy_server, {connect, Ip, TcpPort}, infinity) of
- {ok, Socket} ->
- HSData = #hs_data{
- kernel_pid = Kernel,
- other_node = Node,
- this_node = MyNode,
- socket = Socket,
- timer = Timer,
- this_flags = 0,
- other_version = Version,
- f_send = fun(S,D) ->
- io:format("Kernel call send~n",[]),
- gen_tcp:send(S,D)
- end,
- f_recv = fun(S,N,T) ->
- io:format("Kernel call receive~n",[]),
- gen_tcp:recv(S,N,T)
- end,
- f_setopts_pre_nodeup =
- fun(S) ->
- io:format("Kernel pre nodeup~n",[]),
- inet:setopts(S, [{active, false}, {packet, 4}])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- io:format("Kernel post nodeup~n",[]),
- inet:setopts(S, [{deliver, port},{active, true}])
- end,
- f_getll = fun(S) -> inet:getll(S) end,
- f_address =
- fun(_,_) ->
- #net_address{address = {Ip,TcpPort},
- host = Address,
- protocol = proxy,
- family = inet}
- 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,
- request_type = Type
- },
- dist_util:handshake_we_started(HSData);
- _ ->
- %% Other Node may have closed since
- %% port_please !
- ?trace("other node (~p) "
- "closed since port_please.~n",
- [Node]),
- ?shutdown(Node)
- end;
- _ ->
- ?trace("port_please (~p) "
- "failed.~n", [Node]),
- ?shutdown(Node)
- end;
- _Other ->
- ?trace("inet_getaddr(~p) "
- "failed (~p).~n", [Node,Other]),
- ?shutdown(Node)
- end.
-
-close(Socket) ->
- try
- erlang:error(foo)
- catch _:_ ->
- io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()])
- end,
- gen_tcp:close(Socket),
- ok.
-
-do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
- process_flag(priority, max),
- io:format("~p: in do_accept~n", [self()]),
- receive
- {AcceptPid, controller} ->
- io:format("~p: do_accept controller~n", [self()]),
- Timer = dist_util:start_timer(SetupTime),
- case check_ip(Socket) of
- true ->
- HSData = #hs_data{
- kernel_pid = Kernel,
- this_node = MyNode,
- socket = Socket,
- timer = Timer,
- this_flags = 0,
- allowed = Allowed,
- f_send = fun(S,D) ->
- io:format("Kernel call send~n",[]),
- gen_tcp:send(S,D) end,
- f_recv = fun(S,N,T) ->
- io:format("Kernel call receive~n",[]),
- gen_tcp:recv(S,N,T) end,
- f_setopts_pre_nodeup =
- fun(S) ->
- io:format("Kernel pre nodeup~n",[]),
- inet:setopts(S, [{active, false}, {packet, 4}])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- io:format("Kernel post nodeup~n",[]),
- inet:setopts(S, [{deliver, port},{active, true}])
- end,
- f_getll = fun(S) -> inet:getll(S) end,
- f_address = fun get_remote_id/2,
- 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
- },
- dist_util:handshake_other_started(HSData);
- {false,IP} ->
- error_logger:error_msg("** Connection attempt from "
- "disallowed IP ~w ** ~n", [IP]),
- ?shutdown(no_node)
- end
- end.
-
-get_remote_id(Socket, Node) ->
- gen_server:call(proxy_server, {get_remote_id, {Socket,Node}}, infinity).
-
-check_ip(_) ->
- true.
-
-
-%% If Node is illegal terminate the connection setup!!
-splitnode(Node, LongOrShortNames) ->
- case split_node(atom_to_list(Node), $@, []) of
- [Name|Tail] when Tail =/= [] ->
- Host = lists:append(Tail),
- case split_node(Host, $., []) of
- [_] when LongOrShortNames == longnames ->
- error_msg("** System running to use "
- "fully qualified "
- "hostnames **~n"
- "** Hostname ~s is illegal **~n",
- [Host]),
- ?shutdown(Node);
- [_, _ | _] when LongOrShortNames == shortnames ->
- error_msg("** System NOT running to use fully qualified "
- "hostnames **~n"
- "** Hostname ~s is illegal **~n",
- [Host]),
- ?shutdown(Node);
- _ ->
- [Name, Host]
- end;
- [_] ->
- error_msg("** Nodename ~p illegal, no '@' character **~n",
- [Node]),
- ?shutdown(Node);
- _ ->
- error_msg("** Nodename ~p illegal **~n", [Node]),
- ?shutdown(Node)
- 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)].
-
diff --git a/lib/ssl/proxy_server.erl b/lib/ssl/proxy_server.erl
deleted file mode 100644
index 38ec0ef0d8..0000000000
--- a/lib/ssl/proxy_server.erl
+++ /dev/null
@@ -1,272 +0,0 @@
-%%%-------------------------------------------------------------------
-%%% @author Dan Gudmundsson <dgud@erlang.org>
-%%% @copyright (C) 2010, Dan Gudmundsson
-%%% @doc start server with -proto_dist inet_proxy and net_kernel:start([s@faenor, shortnames]).
-%%%
-%%% @end
-%%% Created : 22 Jun 2010 by Dan Gudmundsson <dgud@erlang.org>
-%%%-------------------------------------------------------------------
--module(proxy_server).
-
--export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3]).
-
--include_lib("kernel/src/net_address.hrl").
--include_lib("kernel/src/dist.hrl").
--include_lib("kernel/src/dist_util.hrl").
-
--record(state,
- {listen,
- accept_loop
- }).
-
--define(PPRE, 4).
--define(PPOST, 4).
-
-start_link() ->
- gen_server:start_link({local, proxy_server}, proxy_server, [], []).
-
-init([]) ->
- io:format("~p: init~n",[self()]),
- process_flag(priority, max),
- {ok, #state{}}.
-
-handle_call(What = {listen, Name}, _From, State) ->
- io:format("~p: call listen ~p~n",[self(), What]),
- case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of
- {ok, Socket} ->
- {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]),
- TcpAddress = get_tcp_address(Socket),
- WorldTcpAddress = get_tcp_address(World),
- {_,Port} = WorldTcpAddress#net_address.address,
- {ok, Creation} = erl_epmd:register_node(Name, Port),
- {reply, {ok, {Socket, TcpAddress, Creation}},
- State#state{listen={Socket, World}}};
- Error ->
- {reply, Error, State}
- end;
-
-handle_call(What = {accept, Listen}, {From, _}, State = #state{listen={_, World}}) ->
- io:format("~p: call accept ~p~n",[self(), What]),
- Self = self(),
- ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end),
- WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end),
- {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}};
-
-handle_call({connect, Ip, Port}, {From, _}, State) ->
- Me = self(),
- Pid = spawn_link(fun() -> setup_proxy(Ip, Port, Me) end),
- receive
- {Pid, go_ahead, LPort} ->
- Res = {ok, Socket} = try_connect(LPort),
- ok = gen_tcp:controlling_process(Socket, From),
- {reply, Res, State};
- {Pid, Error} ->
- {reply, Error, State}
- end;
-
-handle_call({get_remote_id, {Socket,_Node}}, _From, State) ->
- Address = get_tcp_address(Socket),
- io:format("~p: get_remote_id ~p~n",[self(), Address]),
- {reply, Address, State};
-
-handle_call(What, _From, State) ->
- io:format("~p: call ~p~n",[self(), What]),
- {reply, ok, State}.
-
-handle_cast(What, State) ->
- io:format("~p: cast ~p~n",[self(), What]),
- {noreply, State}.
-
-handle_info(What, State) ->
- io:format("~p: info ~p~n",[self(), What]),
- {noreply, State}.
-
-terminate(_Reason, _St) ->
- ok.
-
-code_change(_OldVsn, St, _Extra) ->
- {ok, St}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_tcp_address(Socket) ->
- {ok, Address} = inet:sockname(Socket),
- {ok, Host} = inet:gethostname(),
- #net_address{
- address = Address,
- host = Host,
- protocol = proxy,
- family = inet
- }.
-
-accept_loop(Proxy, Type, Listen, Extra) ->
- process_flag(priority, max),
- case Type of
- erts ->
- case gen_tcp:accept(Listen) of
- {ok, Socket} ->
- io:format("~p: erts accept~n",[self()]),
- Extra ! {accept,self(),Socket,inet,proxy},
- receive
- {_Kernel, controller, Pid} ->
- ok = gen_tcp:controlling_process(Socket, Pid),
- Pid ! {self(), controller};
- {_Kernel, unsupported_protocol} ->
- exit(unsupported_protocol)
- end;
- Error ->
- exit(Error)
- end;
- world ->
- case gen_tcp:accept(Listen) of
- {ok, Socket} ->
- Opts = get_ssl_options(server),
- {ok, SslSocket} = ssl:ssl_accept(Socket, Opts),
- io:format("~p: world accept~n",[self()]),
- PairHandler = spawn_link(fun() -> setup_connection(SslSocket, Extra) end),
- ok = ssl:controlling_process(SslSocket, PairHandler);
- Error ->
- exit(Error)
- end
- end,
- accept_loop(Proxy, Type, Listen, Extra).
-
-
-try_connect(Port) ->
- case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of
- R = {ok, _S} ->
- R;
- {error, _R} ->
- io:format("Failed ~p~n",[_R]),
- try_connect(Port)
- end.
-
-setup_proxy(Ip, Port, Parent) ->
- process_flag(trap_exit, true),
- Opts = get_ssl_options(client),
- case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of
- {ok, World} ->
- {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, binary, {packet,?PPRE}]),
- #net_address{address={_,LPort}} = get_tcp_address(ErtsL),
- Parent ! {self(), go_ahead, LPort},
- case gen_tcp:accept(ErtsL) of
- {ok, Erts} ->
- %% gen_tcp:close(ErtsL),
- io:format("World ~p Erts ~p~n",[World, Erts]),
- loop_conn_setup(World, Erts);
- Err ->
- Parent ! {self(), Err}
- end;
- Err ->
- Parent ! {self(), Err}
- end.
-
-setup_connection(World, ErtsListen) ->
- process_flag(trap_exit, true),
- io:format("Setup connection ~n",[]),
- TcpAddress = get_tcp_address(ErtsListen),
- {_Addr,Port} = TcpAddress#net_address.address,
- {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]),
- ssl:setopts(World, [{active,true}, {packet,?PPRE}]),
- io:format("~p ~n",[?LINE]),
- loop_conn_setup(World, Erts).
-
-loop_conn_setup(World, Erts) ->
- receive
- {ssl, World, Data = <<$a, _/binary>>} ->
- gen_tcp:send(Erts, Data),
- io:format("Handshake finished World -> Erts ~p ~c~n",[size(Data), $a]),
- ssl:setopts(World, [{packet,?PPOST}]),
- inet:setopts(Erts, [{packet,?PPOST}]),
- loop_conn(World, Erts);
- {tcp, Erts, Data = <<$a, _/binary>>} ->
- ssl:send(World, Data),
- io:format("Handshake finished Erts -> World ~p ~c~n",[size(Data), $a]),
- ssl:setopts(World, [{packet,?PPOST}]),
- inet:setopts(Erts, [{packet,?PPOST}]),
- loop_conn(World, Erts);
-
- {ssl, World, Data = <<H, _/binary>>} ->
- gen_tcp:send(Erts, Data),
- io:format("Handshake World -> Erts ~p ~c~n",[size(Data), H]),
- loop_conn_setup(World, Erts);
- {tcp, Erts, Data = <<H, _/binary>>} ->
- ssl:send(World, Data),
- io:format("Handshake Erts -> World ~p ~c~n",[size(Data), H]),
- loop_conn_setup(World, Erts);
- {ssl, World, Data} ->
- gen_tcp:send(Erts, Data),
- io:format("World -> Erts ~p <<>>~n",[size(Data)]),
- loop_conn_setup(World, Erts);
- {tcp, Erts, Data} ->
- ssl:send(World, Data),
- io:format("Erts -> World ~p <<>>~n",[size(Data)]),
- loop_conn_setup(World, Erts);
- Other ->
- io:format("~p ~p~n",[?LINE, Other])
- end.
-
-loop_conn(World, Erts) ->
- receive
- {ssl, World, Data = <<H, _/binary>>} ->
- gen_tcp:send(Erts, Data),
- io:format("World -> Erts ~p ~c~n",[size(Data), H]),
- loop_conn(World, Erts);
- {tcp, Erts, Data = <<H, _/binary>>} ->
- ssl:send(World, Data),
- io:format("Erts -> World ~p ~c~n",[size(Data), H]),
- loop_conn(World, Erts);
- {ssl, World, Data} ->
- gen_tcp:send(Erts, Data),
- io:format("World -> Erts ~p <<>>~n",[size(Data)]),
- loop_conn(World, Erts);
- {tcp, Erts, Data} ->
- ssl:send(World, Data),
- io:format("Erts -> World ~p <<>>~n",[size(Data)]),
- loop_conn(World, Erts);
-
- Other ->
- io:format("~p ~p~n",[?LINE, Other])
- end.
-
-get_ssl_options(Type) ->
- case init:get_argument(ssl_dist_opt) of
- {ok, Args} ->
- ssl_options(Type, Args);
- _ ->
- []
- end.
-
-ssl_options(_,[]) ->
- [];
-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(server, [["server_keyfile", Value]|T]) ->
- [{keyfile, Value} | ssl_options(server,T)];
-ssl_options(Type, [["client_certfile", _Value]|T]) ->
- ssl_options(Type,T);
-ssl_options(Type, [["server_certfile", _Value]|T]) ->
- ssl_options(Type,T);
-ssl_options(Type, [[Item, Value]|T]) ->
- [{atomize(Item),fixup(Value)} | ssl_options(Type,T)];
-ssl_options(Type, [[Item,Value |T1]|T2]) ->
- ssl_options(atomize(Type),[[Item,Value],T1|T2]);
-ssl_options(_,_) ->
- exit(malformed_ssl_dist_opt).
-
-fixup(Value) ->
- case catch list_to_integer(Value) of
- {'EXIT',_} ->
- Value;
- Int ->
- Int
- end.
-
-atomize(List) when is_list(List) ->
- list_to_atom(List);
-atomize(Atom) when is_atom(Atom) ->
- Atom.
diff --git a/lib/ssl/server.pem b/lib/ssl/server.pem
deleted file mode 100644
index 4e4aae5342..0000000000
--- a/lib/ssl/server.pem
+++ /dev/null
@@ -1,34 +0,0 @@
------BEGIN CERTIFICATE-----
-MIICezCCAeSgAwIBAgIFFX2Pz5EwDQYJKoZIhvcNAQEFBQAwczEcMBoGCSqGSIb3
-DQEJARYNQ0FAZXJsYW5nLm9yZzELMAkGA1UEAxMCQ0ExEjAQBgNVBAcTCVN0b2Nr
-aG9sbTELMAkGA1UEBhMCU0UxDzANBgNVBAoTBmVybGFuZzEUMBIGA1UECxMLdGVz
-dGluZyBkZXAwIhgPMjAxMDA4MjUwMDAwMDBaGA8yMDEwMDkwMTAwMDAwMFowdzEe
-MBwGCSqGSIb3DQEJARYPZGd1ZEBlcmxhbmcub3JnMQ0wCwYDVQQDEwRkZ3VkMRIw
-EAYDVQQHEwlTdG9ja2hvbG0xCzAJBgNVBAYTAlNFMQ8wDQYDVQQKEwZlcmxhbmcx
-FDASBgNVBAsTC3Rlc3RpbmcgZGVwMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB
-gQDAu0FFOt/gZUz5DLBtqA/YUNrq+xXevXTsR1I/uxzNS+nYWkMN81W5oI2yXJ08
-LLdat6APru64DWRGQPMn6BTr4ti9l9Nq4jQEY96G2ee+YrB5SAduxkWwg2qyNMb3
-s4OIq56tp+pzty/v8VcapUTn3uKJv3SL0eYWxASD79WmdQIDAQABoxMwETAPBgNV
-HRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBBQUAA4GBAKaT0GL8gIlnPBJS+81CnQos
-cMoZll7QdXLGxzSN1laxDrvHOHE9SAtrx1EJHcv8nh/jvhL715bVbnuaoAtgxQoW
-KF3A7DziDEYhkZd20G80rC+i6rx3n/+9T51RPhzymNbgSQhuVBFs0JXL73HPEqeZ
-wskDuSyiV8DCDjiwlgpq
------END CERTIFICATE-----
-
-XXX Following key assumed not encrypted
------BEGIN RSA PRIVATE KEY-----
-MIICXAIBAAKBgQDAu0FFOt/gZUz5DLBtqA/YUNrq+xXevXTsR1I/uxzNS+nYWkMN
-81W5oI2yXJ08LLdat6APru64DWRGQPMn6BTr4ti9l9Nq4jQEY96G2ee+YrB5SAdu
-xkWwg2qyNMb3s4OIq56tp+pzty/v8VcapUTn3uKJv3SL0eYWxASD79WmdQIDAQAB
-AoGAERwOjVDOsyMLFEj2GKYE0hVLefTUWjPDf35NZO79fZQxrE1HCqQBhjskmSLz
-qnXlyR3oDbxf4OL/deUqMO6/fJHVOD7O9UQRK26f01IZoTq0WmBMFP2C7upafzgx
-9gxddQ7j9B6rqz2agV/YUpvij7hfhXFmV/ogggeuVsyQ0AECQQDNSBH8WMVgky0I
-QLa7MfBLsiHQ5FXmVYU6i9C/QUpL7SWu6eV3edAm7xbtcWnqXEMxeC7D9NIAxDhO
-VaV21bR1AkEA8Flmsy/XRVPF2rmfz0o1Cc+9m6NZOQAUK9sHAXuL3HoTPcigS+f5
-fHbAGFPDBoolS9qRJs5AcL95majzpDnqAQJAJ/SjK47LvCRpW3XdG0p5DwK4+kO3
-RIHY0LBuDQvUPjsGXqk/9KVNEobu24B7sRYMLhDKaXG5flSy8OxSrHKkEQJBAKvg
-ItMs+RK4r5qUd7Xy6S7VAlCUZa+fYM1j2gSzZvcJzUy3dfoSL5VUDlbXP3YjwDwY
-VwibIfX+12SNL35XdAECQHLGnDKYLO3M7HCPf9Yp8tiOmD9mASKcXd3NdBg5mD/l
-oOlKIQhdAQS0BLFhyASfb6hzY0Mj8B2Nq5Z3sq8yD1s=
------END RSA PRIVATE KEY-----
-
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 7514ad2aa2..9c40d4ea53 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2010. All Rights Reserved.
+# Copyright Ericsson AB 1999-2011. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -43,10 +43,12 @@ MODULES= \
ssl_app \
ssl_broker \
ssl_broker_sup \
+ ssl_dist_sup\
ssl_server \
ssl_sup \
ssl_prim \
inet_ssl_dist \
+ inet_tls_dist \
ssl_certificate\
ssl_certificate_db\
ssl_cipher \
@@ -62,6 +64,7 @@ MODULES= \
ssl_ssl2 \
ssl_ssl3 \
ssl_tls1 \
+ ssl_tls_dist_proxy
INTERNAL_HRL_FILES = \
ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \
diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl
index f4bcb593d0..42a03a4879 100644
--- a/lib/ssl/src/inet_ssl_dist.erl
+++ b/lib/ssl/src/inet_ssl_dist.erl
@@ -31,7 +31,7 @@
-import(error_logger,[error_msg/2]).
--include_lib("kernel/src/net_address.hrl").
+-include_lib("kernel/include/net_address.hrl").
-define(to_port(Socket, Data, Opts),
case ssl_prim:send(Socket, Data, Opts) of
@@ -42,8 +42,8 @@
R
end).
--include_lib("kernel/src/dist.hrl").
--include_lib("kernel/src/dist_util.hrl").
+-include_lib("kernel/include/dist.hrl").
+-include_lib("kernel/include/dist_util.hrl").
%% -------------------------------------------------------------
%% This function should return a valid childspec, so that
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
new file mode 100644
index 0000000000..f42c076460
--- /dev/null
+++ b/lib/ssl/src/inet_tls_dist.erl
@@ -0,0 +1,275 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(inet_tls_dist).
+
+-export([childspecs/0, listen/1, accept/1, accept_connection/5,
+ setup/5, close/1, select/1, is_node_name/1]).
+
+-include_lib("kernel/include/net_address.hrl").
+-include_lib("kernel/include/dist.hrl").
+-include_lib("kernel/include/dist_util.hrl").
+
+childspecs() ->
+ {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []},
+ permanent, 2000, worker, [ssl_dist_sup]}]}.
+
+select(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_,_Host] ->
+ true;
+ _ ->
+ false
+ end.
+
+is_node_name(Node) when is_atom(Node) ->
+ select(Node);
+is_node_name(_) ->
+ false.
+
+listen(Name) ->
+ ssl_tls_dist_proxy:listen(Name).
+
+accept(Listen) ->
+ ssl_tls_dist_proxy:accept(Listen).
+
+accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ Kernel = self(),
+ spawn_link(fun() -> do_accept(Kernel, AcceptPid, Socket,
+ MyNode, Allowed, SetupTime) end).
+
+setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ Kernel = self(),
+ spawn(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end).
+
+do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
+ [Name, Address] = splitnode(Node, LongOrShortNames),
+ case inet:getaddr(Address, inet) of
+ {ok, Ip} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case erl_epmd:port_please(Name, Ip) of
+ {port, TcpPort, Version} ->
+ ?trace("port_please(~p) -> version ~p~n",
+ [Node,Version]),
+ dist_util:reset_timer(Timer),
+ case ssl_tls_dist_proxy:connect(Ip, TcpPort) of
+ {ok, Socket} ->
+ HSData = connect_hs_data(Kernel, Node, MyNode, Socket,
+ Timer, Version, Ip, TcpPort, Address,
+ Type),
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?trace("other node (~p) "
+ "closed since port_please.~n",
+ [Node]),
+ ?shutdown(Node)
+ end;
+ _ ->
+ ?trace("port_please (~p) "
+ "failed.~n", [Node]),
+ ?shutdown(Node)
+ end;
+ _Other ->
+ ?trace("inet_getaddr(~p) "
+ "failed (~p).~n", [Node,Other]),
+ ?shutdown(Node)
+ end.
+
+close(Socket) ->
+ try
+ erlang:error(foo)
+ catch _:_ ->
+ io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()])
+ end,
+ gen_tcp:close(Socket),
+ ok.
+
+do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ process_flag(priority, max),
+ receive
+ {AcceptPid, controller} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case check_ip(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
+ end.
+%% ------------------------------------------------------------
+%% Do only accept new connection attempts from nodes at our
+%% own LAN, if the check_ip environment parameter is true.
+%% ------------------------------------------------------------
+check_ip(Socket) ->
+ case application:get_env(check_ip) of
+ {ok, true} ->
+ case get_ifs(Socket) of
+ {ok, IFs, IP} ->
+ check_ip(IFs, IP);
+ _ ->
+ ?shutdown(no_node)
+ end;
+ _ ->
+ true
+ end.
+
+get_ifs(Socket) ->
+ case ssl_prim:peername(Socket) of
+ {ok, {IP, _}} ->
+ case ssl_prim:getif(Socket) of
+ {ok, IFs} -> {ok, IFs, IP};
+ Error -> Error
+ end;
+ Error ->
+ Error
+ end.
+
+check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) ->
+ case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of
+ {M, M} -> true;
+ _ -> check_ip(IFs, PeerIP)
+ end;
+check_ip([], PeerIP) ->
+ {false, PeerIP}.
+
+mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) ->
+ {M1 band IP1,
+ M2 band IP2,
+ M3 band IP3,
+ M4 band IP4};
+
+mask({M1,M2,M3,M4, M5, M6, M7, M8}, {IP1,IP2,IP3,IP4, IP5, IP6, IP7, IP8}) ->
+ {M1 band IP1,
+ M2 band IP2,
+ M3 band IP3,
+ M4 band IP4,
+ M5 band IP5,
+ M6 band IP6,
+ M7 band IP7,
+ M8 band IP8}.
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [Name|Tail] when Tail =/= [] ->
+ Host = lists:append(Tail),
+ check_node(Name, Node, Host, LongOrShortNames);
+ [_] ->
+ error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown(Node);
+ _ ->
+ error_logger:error_msg("** Nodename ~p illegal **~n", [Node]),
+ ?shutdown(Node)
+ end.
+
+check_node(Name, Node, Host, LongOrShortNames) ->
+ case split_node(Host, $., []) of
+ [_] when LongOrShortNames == longnames ->
+ error_logger:error_msg("** System 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]),
+ ?shutdown(Node);
+ _ ->
+ [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(S, N) ->
+ ssl_tls_dist_proxy:get_remote_id(S, N)
+ end
+ }).
+
+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}.
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index b9716786e6..afe19da900 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -8,6 +8,9 @@
ssl_broker,
ssl_broker_sup,
ssl_prim,
+ inet_tls_dist,
+ ssl_tls_dist_proxy,
+ ssl_dist_sup,
inet_ssl_dist,
ssl_tls1,
ssl_ssl3,
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 74900936a3..795b891aa0 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -742,7 +742,8 @@ handle_options(Opts0, _Role) ->
secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
debug = handle_option(debug, Opts, []),
- hibernate_after = handle_option(hibernate_after, Opts, undefined)
+ hibernate_after = handle_option(hibernate_after, Opts, undefined),
+ erl_dist = handle_option(erl_dist, Opts, false)
},
CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
@@ -751,7 +752,7 @@ handle_options(Opts0, _Role) ->
depth, cert, certfile, key, keyfile,
password, cacerts, cacertfile, dh, dhfile, ciphers,
debug, reuse_session, reuse_sessions, ssl_imp,
- cb_info, renegotiate_at, secure_renegotiate, hibernate_after],
+ cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist],
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
@@ -862,6 +863,9 @@ validate_option(hibernate_after, undefined) ->
undefined;
validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 ->
Value;
+validate_option(erl_dist,Value) when Value == true;
+ Value == false ->
+ Value;
validate_option(Opt, Value) ->
throw({error, {eoptions, {Opt, Value}}}).
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 0ae39689cc..95af7f2448 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -1033,7 +1033,8 @@ code_change(_OldVsn, StateName, State, _Extra) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo,
+start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts,
+ User, {CbModule, _,_, _} = CbInfo,
Timeout) ->
try
{ok, Pid} = ssl_connection_sup:start_child([Role, Host, Port, Socket,
@@ -1044,9 +1045,26 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo,
catch
error:{badmatch, {error, _} = Error} ->
Error
+ end;
+
+start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts,
+ User, {CbModule, _,_, _} = CbInfo,
+ Timeout) ->
+ try
+ {ok, Pid} = ssl_connection_sup:start_child_dist([Role, Host, Port, Socket,
+ Opts, User, CbInfo]),
+ {ok, SslSocket} = socket_control(Socket, Pid, CbModule),
+ ok = handshake(SslSocket, Timeout),
+ {ok, SslSocket}
+ catch
+ error:{badmatch, {error, _} = Error} ->
+ Error
end.
ssl_init(SslOpts, Role) ->
+
+ init_manager_name(SslOpts#ssl_options.erl_dist),
+
{ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role),
PrivateKey =
init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile,
@@ -1054,6 +1072,10 @@ ssl_init(SslOpts, Role) ->
DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role),
{ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}.
+init_manager_name(false) ->
+ put(ssl_manager, ssl_manager);
+init_manager_name(true) ->
+ put(ssl_manager, ssl_manager_dist).
init_certificates(#ssl_options{cacerts = CaCerts,
cacertfile = CACertFile,
diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl
index e9328d5f7c..78cfda5e63 100644
--- a/lib/ssl/src/ssl_connection_sup.erl
+++ b/lib/ssl/src/ssl_connection_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -26,8 +26,8 @@
-behaviour(supervisor).
%% API
--export([start_link/0]).
--export([start_child/1]).
+-export([start_link/0, start_link_dist/0]).
+-export([start_child/1, start_child_dist/1]).
%% Supervisor callback
-export([init/1]).
@@ -38,9 +38,15 @@
start_link() ->
supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+start_link_dist() ->
+ supervisor:start_link({local, ssl_connection_sup_dist}, ?MODULE, []).
+
start_child(Args) ->
supervisor:start_child(?MODULE, Args).
+start_child_dist(Args) ->
+ supervisor:start_child(ssl_connection_sup_dist, Args).
+
%%%=========================================================================
%%% Supervisor callback
%%%=========================================================================
diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl
new file mode 100644
index 0000000000..c1912401d7
--- /dev/null
+++ b/lib/ssl/src/ssl_dist_sup.erl
@@ -0,0 +1,84 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_dist_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+-spec start_link() -> {ok, pid()} | ignore | {error, term()}.
+
+start_link() ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+-spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}.
+
+init([]) ->
+ SessionCertManager = session_and_cert_manager_child_spec(),
+ ConnetionManager = connection_manager_child_spec(),
+ ProxyServer = proxy_server_child_spec(),
+
+ {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
+ ProxyServer]}}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+session_and_cert_manager_child_spec() ->
+ Opts = ssl_sup:manager_opts(),
+ Name = ssl_manager_dist,
+ StartFunc = {ssl_manager, start_link_dist, [Opts]},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_manager],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+connection_manager_child_spec() ->
+ Name = ssl_connection_dist,
+ StartFunc = {ssl_connection_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_connection],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+proxy_server_child_spec() ->
+ Name = ssl_tls_dist_proxy,
+ StartFunc = {ssl_tls_dist_proxy, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_tls_dist_proxy],
+ Type = worker,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 6bf1edc452..483e06067c 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -98,10 +98,12 @@
renegotiate_at,
secure_renegotiate,
debug,
- hibernate_after % undefined if not hibernating,
+ hibernate_after,% undefined if not hibernating,
% or number of ms of inactivity
% after which ssl_connection will
% go into hibernation
+ %% This option should only be set to true by inet_tls_dist
+ erl_dist = false
}).
-record(socket_options,
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 56c43a16d1..0d308438b7 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -27,7 +27,7 @@
-include("ssl_internal.hrl").
%% Internal application API
--export([start_link/1,
+-export([start_link/1, start_link_dist/1,
connection_init/2, cache_pem_file/2,
lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4,
server_session_id/4,
@@ -66,10 +66,20 @@
%%--------------------------------------------------------------------
-spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}.
%%
-%% Description: Starts the server
+%% Description: Starts the ssl manager that takes care of sessions
+%% and certificate caching.
%%--------------------------------------------------------------------
start_link(Opts) ->
- gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []).
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [?MODULE, Opts], []).
+
+%%--------------------------------------------------------------------
+-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}.
+%%
+%% Description: Starts a special instance of the ssl manager to
+%% be used by the erlang distribution. Note disables soft upgrade!
+%%--------------------------------------------------------------------
+start_link_dist(Opts) ->
+ gen_server:start_link({local, ssl_manager_dist}, ?MODULE, [ssl_manager_dist, Opts], []).
%%--------------------------------------------------------------------
-spec connection_init(string()| {der, list()}, client | server) ->
@@ -166,7 +176,8 @@ invalidate_session(Port, Session) ->
%%
%% Description: Initiates the server
%%--------------------------------------------------------------------
-init([Opts]) ->
+init([Name, Opts]) ->
+ put(ssl_manager, Name),
process_flag(trap_exit, true),
CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache),
SessionLifeTime =
@@ -376,10 +387,10 @@ code_change(_OldVsn, State, _Extra) ->
%%% Internal functions
%%--------------------------------------------------------------------
call(Msg) ->
- gen_server:call(?MODULE, {Msg, self()}, infinity).
+ gen_server:call(get(ssl_manager), {Msg, self()}, infinity).
cast(Msg) ->
- gen_server:cast(?MODULE, Msg).
+ gen_server:cast(get(ssl_manager), Msg).
validate_session(Host, Port, Session, LifeTime) ->
case ssl_session:valid_session(Session, LifeTime) of
@@ -399,9 +410,10 @@ validate_session(Port, Session, LifeTime) ->
start_session_validator(Cache, CacheCb, LifeTime) ->
spawn_link(?MODULE, init_session_validator,
- [[Cache, CacheCb, LifeTime]]).
+ [[get(ssl_manager), Cache, CacheCb, LifeTime]]).
-init_session_validator([Cache, CacheCb, LifeTime]) ->
+init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) ->
+ put(ssl_manager, SslManagerName),
CacheCb:foldl(fun session_validation/2,
LifeTime, Cache).
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index 316ed8a4e9..a008682b89 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,7 +24,7 @@
-behaviour(supervisor).
%% API
--export([start_link/0]).
+-export([start_link/0, manager_opts/0]).
%% Supervisor callback
-export([init/1]).
@@ -62,6 +62,22 @@ init([]) ->
{ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager,
ConnetionManager]}}.
+
+manager_opts() ->
+ CbOpts = case application:get_env(ssl, session_cb) of
+ {ok, Cb} when is_atom(Cb) ->
+ InitArgs = session_cb_init_args(),
+ [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
+ _ ->
+ []
+ end,
+ case application:get_env(ssl, session_lifetime) of
+ {ok, Time} when is_integer(Time) ->
+ [{session_lifetime, Time}| CbOpts];
+ _ ->
+ CbOpts
+ end.
+
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
@@ -86,21 +102,6 @@ connection_manager_child_spec() ->
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-manager_opts() ->
- CbOpts = case application:get_env(ssl, session_cb) of
- {ok, Cb} when is_atom(Cb) ->
- InitArgs = session_cb_init_args(),
- [{session_cb, Cb}, {session_cb_init_args, InitArgs}];
- _ ->
- []
- end,
- case application:get_env(ssl, session_lifetime) of
- {ok, Time} when is_integer(Time) ->
- [{session_lifetime, Time}| CbOpts];
- _ ->
- CbOpts
- end.
-
session_cb_init_args() ->
case application:get_env(ssl, session_cb_init_args) of
{ok, Args} when is_list(Args) ->
diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl
new file mode 100644
index 0000000000..1a998a0f34
--- /dev/null
+++ b/lib/ssl/src/ssl_tls_dist_proxy.erl
@@ -0,0 +1,326 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssl_tls_dist_proxy).
+
+
+-export([listen/1, accept/1, connect/2, get_remote_id/2]).
+-export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3, ssl_options/2]).
+
+-include_lib("kernel/include/net_address.hrl").
+
+-record(state,
+ {listen,
+ accept_loop
+ }).
+
+-define(PPRE, 4).
+-define(PPOST, 4).
+
+
+%%====================================================================
+%% Internal application API
+%%====================================================================
+
+listen(Name) ->
+ gen_server:call(?MODULE, {listen, Name}, infinity).
+
+accept(Listen) ->
+ gen_server:call(?MODULE, {accept, Listen}, infinity).
+
+connect(Ip, Port) ->
+ gen_server:call(?MODULE, {connect, Ip, Port}, infinity).
+
+get_remote_id(Socket, Node) ->
+ gen_server:call(?MODULE, {get_remote_id, {Socket,Node}}, infinity).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+start_link() ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+init([]) ->
+ process_flag(priority, max),
+ {ok, #state{}}.
+
+handle_call({listen, Name}, _From, State) ->
+ case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of
+ {ok, Socket} ->
+ {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]),
+ TcpAddress = get_tcp_address(Socket),
+ WorldTcpAddress = get_tcp_address(World),
+ {_,Port} = WorldTcpAddress#net_address.address,
+ {ok, Creation} = erl_epmd:register_node(Name, Port),
+ {reply, {ok, {Socket, TcpAddress, Creation}},
+ State#state{listen={Socket, World}}};
+ Error ->
+ {reply, Error, State}
+ end;
+
+handle_call({accept, Listen}, {From, _}, State = #state{listen={_, World}}) ->
+ Self = self(),
+ ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end),
+ WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end),
+ {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}};
+
+handle_call({connect, Ip, Port}, {From, _}, State) ->
+ Me = self(),
+ Pid = spawn_link(fun() -> setup_proxy(Ip, Port, Me) end),
+ receive
+ {Pid, go_ahead, LPort} ->
+ Res = {ok, Socket} = try_connect(LPort),
+ ok = gen_tcp:controlling_process(Socket, From),
+ flush_old_controller(From, Socket),
+ {reply, Res, State};
+ {Pid, Error} ->
+ {reply, Error, State}
+ end;
+
+handle_call({get_remote_id, {Socket,_Node}}, _From, State) ->
+ Address = get_tcp_address(Socket),
+ {reply, Address, State};
+
+handle_call(_What, _From, State) ->
+ {reply, ok, State}.
+
+handle_cast(_What, State) ->
+ {noreply, State}.
+
+handle_info(_What, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _St) ->
+ ok.
+
+code_change(_OldVsn, St, _Extra) ->
+ {ok, St}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+get_tcp_address(Socket) ->
+ {ok, Address} = inet:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ #net_address{
+ address = Address,
+ host = Host,
+ protocol = proxy,
+ family = inet
+ }.
+
+accept_loop(Proxy, Type, Listen, Extra) ->
+ process_flag(priority, max),
+ case Type of
+ erts ->
+ case gen_tcp:accept(Listen) of
+ {ok, Socket} ->
+ Extra ! {accept,self(),Socket,inet,proxy},
+ receive
+ {_Kernel, controller, Pid} ->
+ ok = gen_tcp:controlling_process(Socket, Pid),
+ flush_old_controller(Pid, Socket),
+ Pid ! {self(), controller};
+ {_Kernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end;
+ Error ->
+ exit(Error)
+ end;
+ world ->
+ case gen_tcp:accept(Listen) of
+ {ok, Socket} ->
+ Opts = get_ssl_options(server),
+ case ssl:ssl_accept(Socket, Opts) of
+ {ok, SslSocket} ->
+ PairHandler =
+ spawn_link(fun() ->
+ setup_connection(SslSocket, Extra)
+ end),
+ ok = ssl:controlling_process(SslSocket, PairHandler),
+ flush_old_controller(PairHandler, SslSocket);
+ _ ->
+ gen_tcp:close(Socket)
+ end;
+ Error ->
+ exit(Error)
+ end
+ end,
+ accept_loop(Proxy, Type, Listen, Extra).
+
+
+try_connect(Port) ->
+ case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of
+ R = {ok, _S} ->
+ R;
+ {error, _R} ->
+ try_connect(Port)
+ end.
+
+setup_proxy(Ip, Port, Parent) ->
+ process_flag(trap_exit, true),
+ Opts = get_ssl_options(client),
+ case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of
+ {ok, World} ->
+ {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, binary, {packet,?PPRE}]),
+ #net_address{address={_,LPort}} = get_tcp_address(ErtsL),
+ Parent ! {self(), go_ahead, LPort},
+ case gen_tcp:accept(ErtsL) of
+ {ok, Erts} ->
+ %% gen_tcp:close(ErtsL),
+ loop_conn_setup(World, Erts);
+ Err ->
+ Parent ! {self(), Err}
+ end;
+ Err ->
+ Parent ! {self(), Err}
+ end.
+
+setup_connection(World, ErtsListen) ->
+ process_flag(trap_exit, true),
+ TcpAddress = get_tcp_address(ErtsListen),
+ {_Addr,Port} = TcpAddress#net_address.address,
+ {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]),
+ ssl:setopts(World, [{active,true}, {packet,?PPRE}]),
+ loop_conn_setup(World, Erts).
+
+loop_conn_setup(World, Erts) ->
+ receive
+ {ssl, World, Data = <<$a, _/binary>>} ->
+ gen_tcp:send(Erts, Data),
+ ssl:setopts(World, [{packet,?PPOST}]),
+ inet:setopts(Erts, [{packet,?PPOST}]),
+ loop_conn(World, Erts);
+ {tcp, Erts, Data = <<$a, _/binary>>} ->
+ ssl:send(World, Data),
+ ssl:setopts(World, [{packet,?PPOST}]),
+ inet:setopts(Erts, [{packet,?PPOST}]),
+ loop_conn(World, Erts);
+ {ssl, World, Data = <<_, _/binary>>} ->
+ gen_tcp:send(Erts, Data),
+ loop_conn_setup(World, Erts);
+ {tcp, Erts, Data = <<_, _/binary>>} ->
+ ssl:send(World, Data),
+ loop_conn_setup(World, Erts);
+ {ssl, World, Data} ->
+ gen_tcp:send(Erts, Data),
+ loop_conn_setup(World, Erts);
+ {tcp, Erts, Data} ->
+ ssl:send(World, Data),
+ loop_conn_setup(World, Erts)
+ end.
+
+loop_conn(World, Erts) ->
+ receive
+ {ssl, World, Data} ->
+ gen_tcp:send(Erts, Data),
+ loop_conn(World, Erts);
+ {tcp, Erts, Data} ->
+ ssl:send(World, Data),
+ loop_conn(World, Erts);
+ {tcp_closed, Erts} ->
+ ssl:close(World);
+ {ssl_closed, World} ->
+ gen_tcp:close(Erts)
+ end.
+
+get_ssl_options(Type) ->
+ case init:get_argument(ssl_dist_opt) of
+ {ok, Args} ->
+ [{erl_dist, true} | ssl_options(Type, Args)];
+ _ ->
+ [{erl_dist, true}]
+ end.
+
+ssl_options(_,[]) ->
+ [];
+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_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_renegotiation", Value]|T]) ->
+ [{secure_renegotiation, atomize(Value)} | ssl_options(server,T)];
+ssl_options(client, [["client_secure_renegotiation", Value]|T]) ->
+ [{secure_renegotiation, 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(_,_) ->
+ exit(malformed_ssl_dist_opt).
+
+atomize(List) when is_list(List) ->
+ list_to_atom(List);
+atomize(Atom) when is_atom(Atom) ->
+ Atom.
+
+flush_old_controller(Pid, Socket) ->
+ receive
+ {tcp, Socket, Data} ->
+ Pid ! {tcp, Socket, Data},
+ flush_old_controller(Pid, Socket);
+ {tcp_closed, Socket} ->
+ Pid ! {tcp_closed, Socket},
+ flush_old_controller(Pid, Socket);
+ {ssl, Socket, Data} ->
+ Pid ! {ssl, Socket, Data},
+ flush_old_controller(Pid, Socket);
+ {ssl_closed, Socket} ->
+ Pid ! {ssl_closed, Socket},
+ flush_old_controller(Pid, Socket)
+ after 0 ->
+ ok
+ end.
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 5be07cad2c..45a401aa68 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -41,6 +41,7 @@ MODULES = \
ssl_payload_SUITE \
ssl_to_openssl_SUITE \
ssl_session_cache_SUITE \
+ ssl_dist_SUITE \
ssl_test_MACHINE \
old_ssl_active_SUITE \
old_ssl_active_once_SUITE \
diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl
new file mode 100644
index 0000000000..7325e97ff5
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_SUITE.erl
@@ -0,0 +1,603 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ssl_dist_SUITE).
+
+-include_lib("test_server/include/test_server.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-define(DEFAULT_TIMETRAP_SECS, 240).
+
+-define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000).
+
+-record(node_handle,
+ {connection_handler,
+ socket,
+ name,
+ nodename}
+ ).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [basic].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+init_per_suite(Config) ->
+ try crypto:start() of
+ ok ->
+ add_ssl_opts_config(Config)
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+
+end_per_suite(Config) ->
+ application:stop(crypto),
+ Config.
+
+init_per_testcase(Case, Config) when list(Config) ->
+ Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)),
+ [{watchdog, Dog},{testcase, Case}|Config].
+
+end_per_testcase(_Case, Config) when list(Config) ->
+ Dog = ?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Testcases %%
+%% %%
+
+basic(doc) ->
+ ["Test that two nodes can connect via ssl distribution"];
+basic(suite) ->
+ [];
+basic(Config) when is_list(Config) ->
+ NH1 = start_ssl_node(Config),
+ Node1 = NH1#node_handle.nodename,
+ NH2 = start_ssl_node(Config),
+ Node2 = NH2#node_handle.nodename,
+
+ pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
+
+ [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
+ [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end),
+
+ %% The test_server node has the same cookie as the ssl nodes
+ %% but it should not be able to communicate with the ssl nodes
+ %% via the erlang distribution.
+ pang = net_adm:ping(Node1),
+ pang = net_adm:ping(Node2),
+
+ %%
+ %% Check that we are able to communicate over the erlang
+ %% distribution between the ssl nodes.
+ %%
+ Ref = make_ref(),
+ spawn(fun () ->
+ apply_on_ssl_node(
+ NH1,
+ fun () ->
+ tstsrvr_format("Hi from ~p!~n", [node()]),
+ send_to_tstcntrl({Ref, self()}),
+ receive
+ {From, ping} ->
+ tstsrvr_format("Received ping ~p!~n", [node()]),
+ From ! {self(), pong}
+ end
+ end)
+ end),
+ receive
+ {Ref, SslPid} ->
+ ok = apply_on_ssl_node(
+ NH2,
+ fun () ->
+ tstsrvr_format("Hi from ~p!~n", [node()]),
+ SslPid ! {self(), ping},
+ receive
+ {SslPid, pong} ->
+ ok
+ end
+ end)
+ end,
+ stop_ssl_node(NH1),
+ stop_ssl_node(NH2),
+ success(Config).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Internal functions %%
+%% %%
+
+%%
+%% ssl_node side api
+%%
+
+tstsrvr_format(Fmt, ArgList) ->
+ send_to_tstsrvr({format, Fmt, ArgList}).
+
+send_to_tstcntrl(Message) ->
+ send_to_tstsrvr({message, Message}).
+
+
+%%
+%% test_server side api
+%%
+
+apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) ->
+ Ref = make_ref(),
+ send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}),
+ receive
+ {Ref, Result} ->
+ Result
+ end.
+
+apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) ->
+ Ref = make_ref(),
+ send_to_ssl_node(Node, {apply, self(), Ref, Fun}),
+ receive
+ {Ref, Result} ->
+ Result
+ end.
+
+stop_ssl_node(#node_handle{connection_handler = Handler,
+ socket = Socket,
+ name = Name}) ->
+ ?t:format("Trying to stop ssl node ~s.~n", [Name]),
+ Mon = erlang:monitor(process, Handler),
+ unlink(Handler),
+ case gen_tcp:send(Socket, term_to_binary(stop)) of
+ ok ->
+ receive
+ {'DOWN', Mon, process, Handler, Reason} ->
+ case Reason of
+ normal -> ok;
+ _ -> exit(Reason)
+ end
+ end;
+ Error ->
+ erlang:demonitor(Mon, [flush]),
+ exit(Error)
+ end.
+
+start_ssl_node(Config) ->
+ start_ssl_node(Config, "").
+
+start_ssl_node(Config, XArgs) ->
+ Name = mk_node_name(Config),
+ SSL = ?config(ssl_opts, Config),
+ SSLDistOpts = setup_dist_opts(Name, ?config(priv_dir, Config)),
+ start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs).
+
+start_ssl_node_raw(Name, Args) ->
+ {ok, LSock} = gen_tcp:listen(0,
+ [binary, {packet, 4}, {active, false}]),
+ {ok, ListenPort} = inet:port(LSock),
+ CmdLine = mk_node_cmdline(ListenPort, Name, Args),
+ ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]),
+ case open_port({spawn, CmdLine}, []) of
+ Port when port(Port) ->
+ unlink(Port),
+ erlang:port_close(Port),
+ case await_ssl_node_up(Name, LSock) of
+ #node_handle{} = NodeHandle ->
+ ?t:format("Ssl node ~s started.~n", [Name]),
+ NodeName = list_to_atom(Name ++ "@" ++ host_name()),
+ NodeHandle#node_handle{nodename = NodeName};
+ Error ->
+ exit({failed_to_start_node, Name, Error})
+ end;
+ Error ->
+ exit({failed_to_start_node, Name, Error})
+ end.
+
+%%
+%% command line creation
+%%
+
+host_name() ->
+ [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end,
+ atom_to_list(node())),
+ Host.
+
+mk_node_name(Config) ->
+ {A, B, C} = erlang:now(),
+ Case = ?config(testcase, Config),
+ atom_to_list(?MODULE)
+ ++ "_"
+ ++ atom_to_list(Case)
+ ++ "_"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C).
+
+mk_node_cmdline(ListenPort, Name, Args) ->
+ Static = "-detached -noinput",
+ Pa = filename:dirname(code:which(?MODULE)),
+ Prog = case catch init:get_argument(progname) of
+ {ok,[[P]]} -> P;
+ _ -> exit(no_progname_argument_found)
+ end,
+ NameSw = case net_kernel:longnames() of
+ false -> "-sname ";
+ _ -> "-name "
+ end,
+ {ok, Pwd} = file:get_cwd(),
+ Prog ++ " "
+ ++ Static ++ " "
+ ++ NameSw ++ " " ++ Name ++ " "
+ ++ "-pa " ++ Pa ++ " "
+ ++ "-run application start crypto -run application start public_key "
+ ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr "
+ ++ host_name() ++ " "
+ ++ integer_to_list(ListenPort) ++ " "
+ ++ Args ++ " "
+ ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " "
+ ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
+
+%%
+%% Connection handler test_server side
+%%
+
+await_ssl_node_up(Name, LSock) ->
+ case gen_tcp:accept(LSock, ?AWAIT_SLL_NODE_UP_TIMEOUT) of
+ timeout ->
+ gen_tcp:close(LSock),
+ ?t:format("Timeout waiting for ssl node ~s to come up~n",
+ [Name]),
+ timeout;
+ {ok, Socket} ->
+ gen_tcp:close(LSock),
+ case gen_tcp:recv(Socket, 0) of
+ {ok, Bin} ->
+ check_ssl_node_up(Socket, Name, Bin);
+ {error, closed} ->
+ gen_tcp:close(Socket),
+ exit({lost_connection_with_ssl_node_before_up, Name})
+ end;
+ {error, Error} ->
+ gen_tcp:close(LSock),
+ exit({accept_failed, Error})
+ end.
+
+check_ssl_node_up(Socket, Name, Bin) ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ exit({bad_data_received_from_ssl_node, Name, Bin});
+ {ssl_node_up, NodeName} ->
+ case list_to_atom(Name++"@"++host_name()) of
+ NodeName ->
+ Parent = self(),
+ Go = make_ref(),
+ %% Spawn connection handler on test server side
+ Pid = spawn_link(
+ fun () ->
+ receive Go -> ok end,
+ tstsrvr_con_loop(Name, Socket, Parent)
+ end),
+ ok = gen_tcp:controlling_process(Socket, Pid),
+ Pid ! Go,
+ #node_handle{connection_handler = Pid,
+ socket = Socket,
+ name = Name};
+ _ ->
+ exit({unexpected_ssl_node_connected, NodeName})
+ end;
+ Msg ->
+ exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg})
+ end.
+
+send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) ->
+ Hndlr ! {relay_to_ssl_node, term_to_binary(Term)},
+ ok.
+
+tstsrvr_con_loop(Name, Socket, Parent) ->
+ inet:setopts(Socket,[{active,once}]),
+ receive
+ {relay_to_ssl_node, Data} when is_binary(Data) ->
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ ok;
+ _Error ->
+ gen_tcp:close(Socket),
+ exit({failed_to_relay_data_to_ssl_node, Name, Data})
+ end;
+ {tcp, Socket, Bin} ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ exit({bad_data_received_from_ssl_node, Name, Bin});
+ {format, FmtStr, ArgList} ->
+ ?t:format(FmtStr, ArgList);
+ {message, Msg} ->
+ ?t:format("Got message ~p", [Msg]),
+ Parent ! Msg;
+ {apply_res, To, Ref, Res} ->
+ To ! {Ref, Res};
+ bye ->
+ ?t:format("Ssl node ~s stopped.~n", [Name]),
+ gen_tcp:close(Socket),
+ exit(normal);
+ Unknown ->
+ exit({unexpected_message_from_ssl_node, Name, Unknown})
+ end;
+ {tcp_closed, Socket} ->
+ gen_tcp:close(Socket),
+ exit({lost_connection_with_ssl_node, Name})
+ end,
+ tstsrvr_con_loop(Name, Socket, Parent).
+
+%%
+%% Connection handler ssl_node side
+%%
+
+% cnct2tstsrvr() is called via command line arg -run ...
+cnct2tstsrvr([Host, Port]) when list(Host), list(Port) ->
+ %% Spawn connection handler on ssl node side
+ ConnHandler
+ = spawn(fun () ->
+ case catch gen_tcp:connect(Host,
+ list_to_integer(Port),
+ [binary,
+ {packet, 4},
+ {active, false}]) of
+ {ok, Socket} ->
+ notify_ssl_node_up(Socket),
+ ets:new(test_server_info,
+ [set,
+ public,
+ named_table,
+ {keypos, 1}]),
+ ets:insert(test_server_info,
+ {test_server_handler, self()}),
+ ssl_node_con_loop(Socket);
+ _Error ->
+ halt("Failed to connect to test server")
+ end
+ end),
+ spawn(fun () ->
+ Mon = erlang:monitor(process, ConnHandler),
+ receive
+ {'DOWN', Mon, process, ConnHandler, Reason} ->
+ receive after 1000 -> ok end,
+ halt("test server connection handler terminated: "
+ ++
+ lists:flatten(io_lib:format("~p", [Reason])))
+ end
+ end).
+
+notify_ssl_node_up(Socket) ->
+ case catch gen_tcp:send(Socket,
+ term_to_binary({ssl_node_up, node()})) of
+ ok -> ok;
+ _ -> halt("Failed to notify test server that I'm up")
+ end.
+
+send_to_tstsrvr(Term) ->
+ case catch ets:lookup_element(test_server_info, test_server_handler, 2) of
+ Hndlr when pid(Hndlr) ->
+ Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok;
+ _ ->
+ receive after 200 -> ok end,
+ send_to_tstsrvr(Term)
+ end.
+
+ssl_node_con_loop(Socket) ->
+ inet:setopts(Socket,[{active,once}]),
+ receive
+ {relay_to_test_server, Data} when is_binary(Data) ->
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ ok;
+ _Error ->
+ gen_tcp:close(Socket),
+ halt("Failed to relay data to test server")
+ end;
+ {tcp, Socket, Bin} ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ halt("test server sent me bad data");
+ {apply, From, Ref, M, F, A} ->
+ spawn_link(
+ fun () ->
+ send_to_tstsrvr({apply_res,
+ From,
+ Ref,
+ (catch apply(M, F, A))})
+ end);
+ {apply, From, Ref, Fun} ->
+ spawn_link(fun () ->
+ send_to_tstsrvr({apply_res,
+ From,
+ Ref,
+ (catch Fun())})
+ end);
+ stop ->
+ gen_tcp:send(Socket, term_to_binary(bye)),
+ gen_tcp:close(Socket),
+ init:stop(),
+ receive after infinity -> ok end;
+ _Unknown ->
+ halt("test server sent me an unexpected message")
+ end;
+ {tcp_closed, Socket} ->
+ halt("Lost connection to test server")
+ end,
+ ssl_node_con_loop(Socket).
+
+%%
+%% Setup ssl dist info
+%%
+
+rand_bin(N) ->
+ rand_bin(N, []).
+
+rand_bin(0, Acc) ->
+ Acc;
+rand_bin(N, Acc) ->
+ rand_bin(N-1, [random:uniform(256)-1|Acc]).
+
+make_randfile(Dir) ->
+ {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]),
+ {A, B, C} = erlang:now(),
+ random:seed(A, B, C),
+ ok = file:write(IoDev, rand_bin(1024)),
+ file:close(IoDev).
+
+append_files(FileNames, ResultFileName) ->
+ {ok, ResultFile} = file:open(ResultFileName, [write]),
+ do_append_files(FileNames, ResultFile).
+
+do_append_files([], RF) ->
+ ok = file:close(RF);
+do_append_files([F|Fs], RF) ->
+ {ok, Data} = file:read_file(F),
+ ok = file:write(RF, Data),
+ do_append_files(Fs, RF).
+
+setup_dist_opts(Name, PrivDir) ->
+ NodeDir = filename:join([PrivDir, Name]),
+ RGenDir = filename:join([NodeDir, "rand_gen"]),
+ ok = file:make_dir(NodeDir),
+ ok = file:make_dir(RGenDir),
+ make_randfile(RGenDir),
+ make_certs:all(RGenDir, NodeDir),
+ SDir = filename:join([NodeDir, "server"]),
+ SC = filename:join([SDir, "cert.pem"]),
+ SK = filename:join([SDir, "key.pem"]),
+ SKC = filename:join([SDir, "keycert.pem"]),
+ append_files([SK, SC], SKC),
+ CDir = filename:join([NodeDir, "client"]),
+ CC = filename:join([CDir, "cert.pem"]),
+ CK = filename:join([CDir, "key.pem"]),
+ CKC = filename:join([CDir, "keycert.pem"]),
+ append_files([CK, CC], CKC),
+ "-proto_dist inet_tls "
+ ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " "
+ ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " ".
+
+%%
+%% Start scripts etc...
+%%
+
+add_ssl_opts_config(Config) ->
+ %%
+ %% Start with boot scripts if on an installed system; otherwise,
+ %% just point out ssl ebin with -pa.
+ %%
+ try
+ Dir = ?config(priv_dir, Config),
+ LibDir = code:lib_dir(),
+ Apps = application:which_applications(),
+ {value, {stdlib, _, STDL_VSN}} = lists:keysearch(stdlib, 1, Apps),
+ {value, {kernel, _, KRNL_VSN}} = lists:keysearch(kernel, 1, Apps),
+ StdlDir = filename:join([LibDir, "stdlib-" ++ STDL_VSN]),
+ KrnlDir = filename:join([LibDir, "kernel-" ++ KRNL_VSN]),
+ {ok, _} = file:read_file_info(StdlDir),
+ {ok, _} = file:read_file_info(KrnlDir),
+ SSL_VSN = vsn(ssl),
+ VSN_CRYPTO = vsn(crypto),
+ VSN_PKEY = vsn(public_key),
+
+ SslDir = filename:join([LibDir, "ssl-" ++ SSL_VSN]),
+ {ok, _} = file:read_file_info(SslDir),
+ %% We are using an installed otp system, create the boot script.
+ Script = filename:join(Dir, atom_to_list(?MODULE)),
+ {ok, RelFile} = file:open(Script ++ ".rel", [write]),
+ io:format(RelFile,
+ "{release, ~n"
+ " {\"SSL distribution test release\", \"~s\"},~n"
+ " {erts, \"~s\"},~n"
+ " [{kernel, \"~s\"},~n"
+ " {stdlib, \"~s\"},~n"
+ " {crypto, \"~s\"},~n"
+ " {public_key, \"~s\"},~n"
+ " {ssl, \"~s\"}]}.~n",
+ [case catch erlang:system_info(otp_release) of
+ {'EXIT', _} -> "R11B";
+ Rel -> Rel
+ end,
+ erlang:system_info(version),
+ KRNL_VSN,
+ STDL_VSN,
+ VSN_CRYPTO,
+ VSN_PKEY,
+ SSL_VSN]),
+ ok = file:close(RelFile),
+ ok = systools:make_script(Script, []),
+ [{ssl_opts, "-boot " ++ Script} | Config]
+ catch
+ _:_ ->
+ [{ssl_opts, "-pa " ++ filename:dirname(code:which(ssl))}
+ | add_comment_config(
+ "Bootscript wasn't used since the test wasn't run on an "
+ "installed OTP system.",
+ Config)]
+ end.
+
+%%
+%% Add common comments to config
+%%
+
+add_comment_config(Comment, []) ->
+ [{comment, Comment}];
+add_comment_config(Comment, [{comment, OldComment} | Cs]) ->
+ [{comment, Comment ++ " " ++ OldComment} | Cs];
+add_comment_config(Comment, [C|Cs]) ->
+ [C|add_comment_config(Comment, Cs)].
+
+%%
+%% Call when test case success
+%%
+
+success(Config) ->
+ case lists:keysearch(comment, 1, Config) of
+ {value, {comment, _} = Res} -> Res;
+ _ -> ok
+ end.
+
+vsn(App) ->
+ application:start(App),
+ try
+ {value,
+ {ssl,
+ _,
+ VSN}} = lists:keysearch(App,
+ 1,
+ application:which_applications()),
+ VSN
+ after
+ application:stop(ssl)
+ end.