aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/c_src/Makefile2
-rw-r--r--lib/compiler/src/compile.erl2
-rw-r--r--lib/compiler/src/sys_pre_expand.erl36
-rw-r--r--lib/crypto/c_src/crypto.c48
-rw-r--r--lib/crypto/doc/src/crypto.xml79
-rw-r--r--lib/crypto/src/crypto.erl51
-rw-r--r--lib/crypto/test/crypto_SUITE.erl114
-rw-r--r--lib/diameter/doc/src/depend.sed12
-rw-r--r--lib/diameter/doc/src/diameter.xml21
-rw-r--r--lib/diameter/doc/src/diameter_soc.xml10
-rw-r--r--lib/diameter/doc/src/diameter_tcp.xml50
-rw-r--r--lib/diameter/doc/src/diameter_transport.xml38
-rw-r--r--lib/diameter/src/app/diameter_capx.erl145
-rw-r--r--lib/diameter/src/app/diameter_peer_fsm.erl87
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl89
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl284
-rw-r--r--lib/diameter/test/Makefile2
-rw-r--r--lib/diameter/test/diameter_app_SUITE.erl18
-rw-r--r--lib/diameter/test/diameter_failover_SUITE.erl262
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl193
-rw-r--r--lib/diameter/test/diameter_tls_SUITE.erl411
-rw-r--r--lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca (renamed from lib/ssl/c_src/Makefile)39
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl107
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl74
-rw-r--r--lib/diameter/test/diameter_util.erl153
-rw-r--r--lib/diameter/test/modules.mk4
-rw-r--r--lib/erl_docgen/priv/xsl/db_man.xsl19
-rw-r--r--lib/ic/doc/src/notes.xml16
-rw-r--r--lib/ic/src/ic_pragma.erl6
-rw-r--r--lib/ic/vsn.mk2
-rw-r--r--lib/inets/src/inets_app/inets_service.erl28
-rw-r--r--lib/inets/src/tftp/tftp.erl47
-rw-r--r--lib/kernel/src/application.erl12
-rw-r--r--lib/kernel/src/disk_log.erl22
-rw-r--r--lib/kernel/test/disk_log_SUITE.erl11
-rw-r--r--lib/ssl/Makefile4
-rw-r--r--lib/ssl/c_src/Makefile.dist33
-rw-r--r--lib/ssl/c_src/Makefile.in211
-rw-r--r--lib/ssl/c_src/Makefile.win32147
-rw-r--r--lib/ssl/c_src/Makefile.win32.dist45
-rw-r--r--lib/ssl/c_src/debuglog.c251
-rw-r--r--lib/ssl/c_src/debuglog.h50
-rw-r--r--lib/ssl/c_src/esock.c1904
-rw-r--r--lib/ssl/c_src/esock.h273
-rw-r--r--lib/ssl/c_src/esock_openssl.c1213
-rw-r--r--lib/ssl/c_src/esock_osio.c328
-rw-r--r--lib/ssl/c_src/esock_osio.h34
-rw-r--r--lib/ssl/c_src/esock_poll.c222
-rw-r--r--lib/ssl/c_src/esock_poll.h60
-rw-r--r--lib/ssl/c_src/esock_posix_str.c642
-rw-r--r--lib/ssl/c_src/esock_posix_str.h28
-rw-r--r--lib/ssl/c_src/esock_ssl.h110
-rw-r--r--lib/ssl/c_src/esock_utils.c150
-rw-r--r--lib/ssl/c_src/esock_utils.h32
-rw-r--r--lib/ssl/c_src/esock_winsock.h36
-rw-r--r--lib/ssl/doc/src/Makefile4
-rw-r--r--lib/ssl/doc/src/old_ssl.xml709
-rw-r--r--lib/ssl/doc/src/refman.xml5
-rw-r--r--lib/ssl/doc/src/ssl.xml8
-rw-r--r--lib/ssl/doc/src/ssl_distribution.xml8
-rw-r--r--lib/ssl/src/Makefile7
-rw-r--r--lib/ssl/src/inet_ssl_dist.erl453
-rw-r--r--lib/ssl/src/inet_tls_dist.erl4
-rw-r--r--lib/ssl/src/ssl.app.src7
-rw-r--r--lib/ssl/src/ssl.erl370
-rw-r--r--lib/ssl/src/ssl_broker.erl1188
-rw-r--r--lib/ssl/src/ssl_broker_int.hrl38
-rw-r--r--lib/ssl/src/ssl_broker_sup.erl46
-rw-r--r--lib/ssl/src/ssl_connection.erl1
-rw-r--r--lib/ssl/src/ssl_int.hrl99
-rw-r--r--lib/ssl/src/ssl_internal.hrl3
-rw-r--r--lib/ssl/src/ssl_prim.erl173
-rw-r--r--lib/ssl/src/ssl_server.erl1378
-rw-r--r--lib/ssl/src/ssl_sup.erl7
-rw-r--r--lib/ssl/src/ssl_tls_dist_proxy.erl101
-rw-r--r--lib/ssl/test/Makefile13
-rw-r--r--lib/ssl/test/old_ssl_active_SUITE.erl395
-rw-r--r--lib/ssl/test/old_ssl_active_once_SUITE.erl417
-rw-r--r--lib/ssl/test/old_ssl_dist_SUITE.erl617
-rw-r--r--lib/ssl/test/old_ssl_misc_SUITE.erl117
-rw-r--r--lib/ssl/test/old_ssl_passive_SUITE.erl382
-rw-r--r--lib/ssl/test/old_ssl_peer_cert_SUITE.erl191
-rw-r--r--lib/ssl/test/old_ssl_protocol_SUITE.erl185
-rw-r--r--lib/ssl/test/old_ssl_verify_SUITE.erl153
-rw-r--r--lib/ssl/test/old_transport_accept_SUITE.erl258
-rw-r--r--lib/ssl/test/ssl.cover19
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl88
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl180
-rw-r--r--lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem5
-rw-r--r--lib/ssl/test/ssl_test_MACHINE.erl940
-rw-r--r--lib/ssl/test/ssl_test_MACHINE.hrl39
-rw-r--r--lib/stdlib/doc/src/lists.xml26
-rw-r--r--lib/stdlib/doc/src/random.xml5
-rw-r--r--lib/stdlib/src/dets.erl108
-rw-r--r--lib/stdlib/src/dets.hrl3
-rw-r--r--lib/stdlib/src/dets_v8.erl16
-rw-r--r--lib/stdlib/src/dets_v9.erl118
-rw-r--r--lib/stdlib/src/erl_lint.erl48
-rw-r--r--lib/stdlib/src/erl_parse.yrl10
-rw-r--r--lib/stdlib/src/gen_event.erl75
-rw-r--r--lib/stdlib/src/gen_fsm.erl41
-rw-r--r--lib/stdlib/src/gen_server.erl35
-rw-r--r--lib/stdlib/src/lists.erl29
-rw-r--r--lib/stdlib/src/random.erl42
-rw-r--r--lib/stdlib/src/supervisor.erl16
-rw-r--r--lib/stdlib/src/supervisor_bridge.erl9
-rw-r--r--lib/stdlib/test/dets_SUITE.erl97
107 files changed, 2779 insertions, 14774 deletions
diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile
index f7213b9651..8c06be56f8 100644
--- a/lib/asn1/c_src/Makefile
+++ b/lib/asn1/c_src/Makefile
@@ -62,7 +62,7 @@ NIF_OBJ_FILES = $(OBJDIR)/asn1_erl_nif.o
ifeq ($(TARGET),win32)
-NIF_SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_nif.dll
+NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.dll
CLIB_FLAGS =
LN=cp
else
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 15849957e7..bfa7c6cedd 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1512,6 +1512,8 @@ restore_expand_module([{attribute,Line,opaque,[Type]}|Fs]) ->
[{attribute,Line,opaque,Type}|restore_expand_module(Fs)];
restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) ->
[{attribute,Line,spec,Arg}|restore_expand_module(Fs)];
+restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) ->
+ [{attribute,Line,callback,Arg}|restore_expand_module(Fs)];
restore_expand_module([F|Fs]) ->
[F|restore_expand_module(Fs)];
restore_expand_module([]) -> [].
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 249bd7a8e7..0fa1fea09f 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -43,6 +43,7 @@
mod_imports, %Module Imports
compile=[], %Compile flags
attributes=[], %Attributes
+ callbacks=[], %Callbacks
defined=[], %Defined functions
vcount=0, %Variable counter
func=[], %Current function
@@ -172,10 +173,41 @@ define_functions(Forms, #expand{defined=Predef}=St) ->
end, Predef, Forms),
St#expand{defined=ordsets:from_list(Fs)}.
-module_attrs(St) ->
- {[{attribute,Line,Name,Val} || {Name,Line,Val} <- St#expand.attributes],St}.
+module_attrs(#expand{attributes=Attributes}=St) ->
+ Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
+ Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
+ {Attrs,St#expand{callbacks=Callbacks}}.
module_predef_funcs(St) ->
+ {Mpf1,St1}=module_predef_func_beh_info(St),
+ {Mpf2,St2}=module_predef_funcs_mod_info(St1),
+ {Mpf1++Mpf2,St2}.
+
+module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
+ {[], St};
+module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined,
+ exports=Exports}=St) ->
+ PreDef=[{behaviour_info,1}],
+ PreExp=PreDef,
+ {[gen_beh_info(Callbacks)],
+ St#expand{defined=union(from_list(PreDef), Defined),
+ exports=union(from_list(PreExp), Exports)}}.
+
+gen_beh_info(Callbacks) ->
+ List = make_list(Callbacks),
+ {function,0,behaviour_info,1,
+ [{clause,0,[{atom,0,callbacks}],[],
+ [List]}]}.
+
+make_list([]) -> {nil,0};
+make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
+ {cons,0,
+ {tuple,0,
+ [{atom,0,Name},
+ {integer,0,Arity}]},
+ make_list(Rest)}.
+
+module_predef_funcs_mod_info(St) ->
PreDef = [{module_info,0},{module_info,1}],
PreExp = PreDef,
{[{function,0,module_info,0,
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index c781ccb302..10fe333d18 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -134,8 +134,10 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -210,8 +212,10 @@ static ErlNifFunc nif_funcs[] = {
{"hmac_final", 1, hmac_final},
{"hmac_final_n", 2, hmac_final},
{"des_cbc_crypt", 4, des_cbc_crypt},
+ {"des_cfb_crypt", 4, des_cfb_crypt},
{"des_ecb_crypt", 3, des_ecb_crypt},
{"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt},
+ {"des_ede3_cfb_crypt", 6, des_ede3_cfb_crypt},
{"aes_cfb_128_crypt", 4, aes_cfb_128_crypt},
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
@@ -693,6 +697,25 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
return ret;
}
+static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, Ivec, Text, IsEncrypt) */
+ ErlNifBinary key, ivec, text;
+ DES_key_schedule schedule;
+ DES_cblock ivec_clone; /* writable copy */
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8
+ || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
+ return enif_make_badarg(env);
+ }
+ memcpy(&ivec_clone, ivec.data, 8);
+ DES_set_key((const_DES_cblock*)key.data, &schedule);
+ DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret),
+ 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true));
+ return ret;
+}
+
static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, Text/Cipher, IsEncrypt) */
ErlNifBinary key, text;
@@ -735,6 +758,31 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T
return ret;
}
+static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */
+ ErlNifBinary key1, key2, key3, ivec, text;
+ DES_key_schedule schedule1, schedule2, schedule3;
+ DES_cblock ivec_clone; /* writable copy */
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8
+ || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8
+ || !enif_inspect_iolist_as_binary(env, argv[4], &text)) {
+ return enif_make_badarg(env);
+ }
+
+ memcpy(&ivec_clone, ivec.data, 8);
+ DES_set_key((const_DES_cblock*)key1.data, &schedule1);
+ DES_set_key((const_DES_cblock*)key2.data, &schedule2);
+ DES_set_key((const_DES_cblock*)key3.data, &schedule3);
+ DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret),
+ 8, text.size, &schedule1, &schedule2, &schedule3,
+ &ivec_clone, (argv[5] == atom_true));
+ return ret;
+}
+
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, IVec, Data, IsEncrypt) */
ErlNifBinary key, ivec, text;
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 4c20f81cae..824be09438 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -404,6 +404,51 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</desc>
</func>
<func>
+ <name>des_cfb_encrypt(Key, IVec, Text) -> Cipher</name>
+ <fsummary>Encrypt <c>Text</c>according to DES in CFB mode</fsummary>
+ <type>
+ <v>Key = Text = iolist() | binary()</v>
+ <v>IVec = Cipher = binary()</v>
+ </type>
+ <desc>
+ <p>Encrypts <c>Text</c> according to DES in 8-bit CFB
+ mode. <c>Key</c> is the DES key, and <c>IVec</c> is an
+ arbitrary initializing vector. The lengths of <c>Key</c> and
+ <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
+ <func>
+ <name>des_cfb_decrypt(Key, IVec, Cipher) -> Text</name>
+ <fsummary>Decrypt <c>Cipher</c>according to DES in CFB mode</fsummary>
+ <type>
+ <v>Key = Cipher = iolist() | binary()</v>
+ <v>IVec = Text = binary()</v>
+ </type>
+ <desc>
+ <p>Decrypts <c>Cipher</c> according to DES in 8-bit CFB mode.
+ <c>Key</c> is the DES key, and <c>IVec</c> is an arbitrary
+ initializing vector. <c>Key</c> and <c>IVec</c> must have
+ the same values as those used when encrypting. The lengths of
+ <c>Key</c> and <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
+ <func>
+ <name>des_cfb_ivec(IVec, Data) -> NextIVec</name>
+ <fsummary>Get <c>IVec</c> to be used in next iteration of
+ <c>des_cfb_[ecrypt|decrypt]</c></fsummary>
+ <type>
+ <v>IVec = iolist() | binary()</v>
+ <v>Data = iolist() | binary()</v>
+ <v>NextIVec = binary()</v>
+ </type>
+ <desc>
+ <p>Returns the <c>IVec</c> to be used in a next iteration of
+ <c>des_cfb_[encrypt|decrypt]</c>. <c>IVec</c> is the vector
+ used in the previous iteration step. <c>Data</c> is the encrypted
+ data from the previous iteration step.</p>
+ </desc>
+ </func>
+ <func>
<name>des3_cbc_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name>
<fsummary>Encrypt <c>Text</c>according to DES3 in CBC mode</fsummary>
<type>
@@ -421,7 +466,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</func>
<func>
<name>des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name>
- <fsummary>Decrypt <c>Cipher</c>according to DES in CBC mode</fsummary>
+ <fsummary>Decrypt <c>Cipher</c>according to DES3 in CBC mode</fsummary>
<type>
<v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v>
<v>IVec = Text = binary()</v>
@@ -437,6 +482,38 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
<c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p>
</desc>
</func>
+ <func>
+ <name>des3_cfb_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name>
+ <fsummary>Encrypt <c>Text</c>according to DES3 in CFB mode</fsummary>
+ <type>
+ <v>Key1 =Key2 = Key3 Text = iolist() | binary()</v>
+ <v>IVec = Cipher = binary()</v>
+ </type>
+ <desc>
+ <p>Encrypts <c>Text</c> according to DES3 in 8-bit CFB
+ mode. <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, are the DES
+ keys, and <c>IVec</c> is an arbitrary initializing
+ vector. The lengths of each of <c>Key1</c>, <c>Key2</c>,
+ <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
+ <func>
+ <name>des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name>
+ <fsummary>Decrypt <c>Cipher</c>according to DES3 in CFB mode</fsummary>
+ <type>
+ <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v>
+ <v>IVec = Text = binary()</v>
+ </type>
+ <desc>
+ <p>Decrypts <c>Cipher</c> according to DES3 in 8-bit CFB mode.
+ <c>Key1</c>, <c>Key2</c>, <c>Key3</c> are the DES key, and
+ <c>IVec</c> is an arbitrary initializing vector.
+ <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must
+ and <c>IVec</c> must have the same values as those used when
+ encrypting. The lengths of <c>Key1</c>, <c>Key2</c>,
+ <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p>
+ </desc>
+ </func>
<func>
<name>des_ecb_encrypt(Key, Text) -> Cipher</name>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index c3e13d6b91..e3b921f9fa 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -31,7 +31,9 @@
-export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
-export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]).
-export([des_ecb_encrypt/2, des_ecb_decrypt/2]).
+-export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]).
-export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]).
+-export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]).
-export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]).
-export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]).
-export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]).
@@ -68,8 +70,10 @@
sha_mac, sha_mac_96,
sha_mac_init, sha_mac_update, sha_mac_final,
des_cbc_encrypt, des_cbc_decrypt,
+ des_cfb_encrypt, des_cfb_decrypt,
des_ecb_encrypt, des_ecb_decrypt,
des_ede3_cbc_encrypt, des_ede3_cbc_decrypt,
+ des_ede3_cfb_encrypt, des_ede3_cfb_decrypt,
aes_cfb_128_encrypt, aes_cfb_128_decrypt,
rand_bytes,
strong_rand_bytes,
@@ -294,6 +298,33 @@ des_cbc_ivec(Data) when is_list(Data) ->
des_cbc_ivec(list_to_binary(Data)).
%%
+%% DES - in 8-bits cipher feedback mode (CFB)
+%%
+-spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary().
+-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary().
+
+des_cfb_encrypt(Key, IVec, Data) ->
+ des_cfb_crypt(Key, IVec, Data, true).
+
+des_cfb_decrypt(Key, IVec, Data) ->
+ des_cfb_crypt(Key, IVec, Data, false).
+
+des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
+%%
+%% dec_cfb_ivec(IVec, Data) -> binary()
+%%
+%% Returns the IVec to be used in the next iteration of
+%% des_cfb_[encrypt|decrypt].
+%%
+-spec des_cfb_ivec(iodata(), iodata()) -> binary().
+
+des_cfb_ivec(IVec, Data) ->
+ IVecAndData = list_to_binary([IVec, Data]),
+ {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8),
+ NewIVec.
+
+%%
%% DES - in electronic codebook mode (ECB)
%%
-spec des_ecb_encrypt(iodata(), iodata()) -> binary().
@@ -326,6 +357,26 @@ des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) ->
des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
%%
+%% DES3 - in 8-bits cipher feedback mode (CFB)
+%%
+-spec des3_cfb_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) ->
+ binary().
+-spec des3_cfb_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) ->
+ binary().
+
+des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data).
+des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true).
+
+des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data).
+des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) ->
+ des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false).
+
+des_ede3_cfb_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
+%%
%% Blowfish
%%
-spec blowfish_ecb_encrypt(iodata(), iodata()) -> binary().
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 486751766b..53b4c2a7e1 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -44,7 +44,11 @@
md5_mac_io/1,
des_cbc/1,
des_cbc_iter/1,
+ des_cfb/1,
+ des_cfb_iter/1,
des_ecb/1,
+ des3_cbc/1,
+ des3_cfb/1,
aes_cfb/1,
aes_cbc/1,
aes_cbc_iter/1,
@@ -75,8 +79,8 @@ all() ->
md5_mac_io, sha, sha_update,
hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5,
%% sha256, sha256_update, sha512,sha512_update,
- des_cbc, aes_cfb, aes_cbc,
- aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb,
+ des_cbc, des_cfb, des3_cbc, des3_cfb, aes_cfb, aes_cbc,
+ aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb,
rand_uniform_test, strong_rand_test,
rsa_verify_test, dsa_verify_test, rsa_sign_test,
dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test,
@@ -292,7 +296,7 @@ sha(Config) when is_list(Config) ->
hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")).
-%%
+%%
hmac_update_sha_n(doc) ->
["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. "
"Expected values for examples are generated using crypto:sha_mac." ];
@@ -547,6 +551,40 @@ des_cbc_iter(Config) when is_list(Config) ->
%%
%%
+des_cfb(doc) ->
+ "Encrypt and decrypt according to CFB DES. and check the result. "
+ "Example is from FIPS-81.";
+des_cfb(suite) ->
+ [];
+des_cfb(Config) when is_list(Config) ->
+ ?line Key = hexstr2bin("0123456789abcdef"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain = "Now is the",
+ ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain),
+ ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")),
+ ?line m(list_to_binary(Plain),
+ crypto:des_cfb_decrypt(Key, IVec, Cipher)).
+
+%%
+%%
+des_cfb_iter(doc) ->
+ "Encrypt and decrypt according to CFB DES in two steps, and "
+ "check the result. Example is from FIPS-81.";
+des_cfb_iter(suite) ->
+ [];
+des_cfb_iter(Config) when is_list(Config) ->
+ ?line Key = hexstr2bin("0123456789abcdef"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain1 = "Now i",
+ ?line Plain2 = "s the",
+ ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1),
+ ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1),
+ ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2),
+ ?line Cipher = list_to_binary([Cipher1, Cipher2]),
+ ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")).
+
+%%
+%%
des_ecb(doc) ->
"Encrypt and decrypt according to ECB DES and check the result. "
"Example are from FIPS-81.";
@@ -569,6 +607,66 @@ des_ecb(Config) when is_list(Config) ->
%%
%%
+des3_cbc(doc) ->
+ "Encrypt and decrypt according to CBC 3DES, and check the result.";
+des3_cbc(suite) ->
+ [];
+des3_cbc(Config) when is_list(Config) ->
+ ?line Key1 = hexstr2bin("0123456789abcdef"),
+ ?line Key2 = hexstr2bin("fedcba9876543210"),
+ ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain = "Now is the time for all ",
+ ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain),
+ ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480"
+ "0bac1ae66970fb2b89")),
+ ?line m(list_to_binary(Plain),
+ crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)),
+ ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0],
+ ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2),
+ ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5"
+ "4c83cee22907f7f0041ca1b7abe202bfafe")),
+ ?line m(list_to_binary(Plain2),
+ crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)),
+
+ ?line Key = hexstr2bin("0123456789abcdef"),
+ ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain),
+ ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c"
+ "0f683788499a7c05f6")),
+ ?line m(list_to_binary(Plain),
+ crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)),
+ ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2),
+ ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9"
+ "9484521388fa59ae67d58d2e77e86062733")),
+ ?line m(list_to_binary(Plain2),
+ crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)).
+
+%%
+%%
+des3_cfb(doc) ->
+ "Encrypt and decrypt according to CFB 3DES, and check the result.";
+des3_cfb(suite) ->
+ [];
+des3_cfb(Config) when is_list(Config) ->
+ ?line Key1 = hexstr2bin("0123456789abcdef"),
+ ?line Key2 = hexstr2bin("fedcba9876543210"),
+ ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"),
+ ?line IVec = hexstr2bin("1234567890abcdef"),
+ ?line Plain = "Now is the time for all ",
+ ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain),
+ ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937"
+ "1deab42a00666db02c")),
+ ?line m(list_to_binary(Plain),
+ crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)),
+ ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0],
+ ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2),
+ ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c"
+ "e413f5efab838fce7e41e2ba67705bad5bc")),
+ ?line m(list_to_binary(Plain2),
+ crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)).
+
+%%
+%%
aes_cfb(doc) ->
"Encrypt and decrypt according to AES CFB 128 bit and check "
"the result. Example are from NIST SP 800-38A.";
@@ -1233,8 +1331,8 @@ rc4_test(doc) ->
rc4_test(suite) ->
[];
rc4_test(Config) when is_list(Config) ->
- CT1 = <<"hej p� dig">>,
- R1 = <<71,112,14,44,140,33,212,144,155,47>>,
+ CT1 = <<"Yo baby yo">>,
+ R1 = <<118,122,68,110,157,166,141,212,139,39>>,
K = "apaapa",
R1 = crypto:rc4_encrypt(K, CT1),
CT1 = crypto:rc4_encrypt(K, R1),
@@ -1248,14 +1346,14 @@ rc4_stream_test(doc) ->
rc4_stream_test(suite) ->
[];
rc4_stream_test(Config) when is_list(Config) ->
- CT1 = <<"hej">>,
- CT2 = <<" p� dig">>,
+ CT1 = <<"Yo ">>,
+ CT2 = <<"baby yo">>,
K = "apaapa",
State0 = crypto:rc4_set_key(K),
{State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1),
{_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2),
R = list_to_binary([R1, R2]),
- <<71,112,14,44,140,33,212,144,155,47>> = R,
+ <<118,122,68,110,157,166,141,212,139,39>> = R,
ok.
blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."];
diff --git a/lib/diameter/doc/src/depend.sed b/lib/diameter/doc/src/depend.sed
index 5973c4586e..42de597f15 100644
--- a/lib/diameter/doc/src/depend.sed
+++ b/lib/diameter/doc/src/depend.sed
@@ -21,14 +21,18 @@
# massaged in Makefile.
#
-/^<com>\([^<]*\)<\/com>/b rf
-/^<module>\([^<]*\)<\/module>/b rf
+/^<com>/b c
+/^<module>/b c
/^<chapter>/!d
+# Chapter: html basename is same as xml.
s@@$(HTMLDIR)/%FILE%.html: %FILE%.xml@
q
-:rf
-s@@$(HTMLDIR)/\1.html: %FILE%.xml@
+# Reference: html basename is from contents of com/module element.
+:c
+s@^[^>]*>@@
+s@<.*@@
+s@.*@$(HTMLDIR)/&.html: %FILE%.xml@
q
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 2cad70e3bc..43c497f50a 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -367,6 +367,19 @@ capabilities exchange message.
Optional, defaults to the empty list.</p>
</item>
+<tag><c>{'Inband-Security-Id', [Unsigned32()]}</c></tag>
+<item>
+<p>
+Values of Inband-Security-Id AVPs sent in an outgoing
+capabilities exchange message.
+Optional, defaults to the empty list, which is equivalent to a
+list containing only 0 (= NO_INBAND_SECURITY).</p>
+
+<p>
+If 1 (= TLS) is specified then TLS is selected if the CER/CEA received
+from the peer offers it.</p>
+</item>
+
<tag><c>{'Acct-Application-Id', [Unsigned32()]}</c></tag>
<item>
<p>
@@ -683,6 +696,14 @@ in question.</p>
AVP's used to construct outgoing CER/CEA messages.
Any AVP specified takes precedence over a corresponding value specified
for the service in question.</p>
+
+<p>
+Specifying a capability as a transport option
+may be particularly appropriate for Inband-Security-Id in case
+TLS is desired over TCP as implemented by
+<seealso marker="diameter_tcp">diameter_tcp(3)</seealso> but
+not over SCTP as implemented by
+<seealso marker="diameter_sctp">diameter_sctp(3)</seealso>.</p>
</item>
<tag><c>{watchdog_timer, TwInit}</c></tag>
diff --git a/lib/diameter/doc/src/diameter_soc.xml b/lib/diameter/doc/src/diameter_soc.xml
index 4f8581a904..6b9ef9f756 100644
--- a/lib/diameter/doc/src/diameter_soc.xml
+++ b/lib/diameter/doc/src/diameter_soc.xml
@@ -57,9 +57,13 @@ including the P Flag in the AVP header.</p>
<item>
<p>
-There is no TLS support.
-It's unclear (aka uninvestigated) how TLS would impact
-diameter but IPsec can be used without it needing to know.</p>
+There is no TLS support over SCTP.
+RFC 3588 requires that a Diameter server support TLS but in
+practise this seems to mean TLS over SCTP since there are limitations
+with running over SCTP: see RFC 6083 (DTLS over SCTP), which is a
+response to RFC 3436 (TLS over SCTP).
+The current RFC 3588 draft acknowledges this by equating
+TLS with TLS/TCP and DTLS/SCTP but we do not yet support DTLS.</p>
</item>
<item>
diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml
index a502e53972..e6b53383c0 100644
--- a/lib/diameter/doc/src/diameter_tcp.xml
+++ b/lib/diameter/doc/src/diameter_tcp.xml
@@ -43,7 +43,14 @@ It can be specified as the value of a transport_module option to
<seealso
marker="diameter#add_transport">diameter:add_transport/2</seealso>
and implements the behaviour documented in
-<seealso marker="diameter_transport">diameter_transport(3)</seealso>.</p>
+<seealso marker="diameter_transport">diameter_transport(3)</seealso>.
+TLS security is supported, both as an upgrade following
+capabilities exchange as specified by RFC 3588 and
+at connection establishment as in the current draft standard.</p>
+
+<p>
+Note that the ssl application is required for TLS and must be started
+before configuring TLS capability on diameter transports.</p>
<marker id="start"/>
</description>
@@ -60,10 +67,15 @@ and implements the behaviour documented in
<v>Type = connect | accept</v>
<v>Ref = reference()</v>
<v>Svc = #diameter_service{}</v>
-<v>Opt = {raddr, ip_address()} | {rport, integer()} | term()</v>
+<v>Opt = OwnOpt | SslOpt | OtherOpt</v>
<v>Pid = pid()</v>
<v>LAddr = ip_address()</v>
<v>Reason = term()</v>
+<v>OwnOpt = {raddr, ip_address()}
+ | {rport, integer()}
+ | {port, integer()}</v>
+<v>SslOpt = {ssl_options, true | list()}</v>
+<v>OtherOpt = term()</v>
</type>
<desc>
@@ -74,17 +86,42 @@ marker="diameter_transport#start">diameter_transport(3)</seealso>.</p>
<p>
The only diameter_tcp-specific argument is the options list.
Options <c>raddr</c> and <c>rport</c> specify the remote address
-and port for a connecting transport and not valid for a listening
+and port for a connecting transport and are not valid for a listening
transport.
-Remaining options are any accepted by gen_tcp:connect/3 for
-a connecting transport, or gen_tcp:listen/2 for a listening transport,
-with the exception of <c>binary</c>, <c>packet</c> and <c>active</c>.
+Option <c>ssl_options</c> must be specified for a transport
+that must be able to support TLS: a value of <c>true</c> results in a
+TLS handshake immediately upon connection establishment while
+list() specifies options to be passed to ssl:connect/2 of ssl:ssl_accept/2
+after capabilities exchange if TLS is negotiated.
+Remaining options are any accepted by ssl:connect/3 or gen_tcp:connect/3 for
+a connecting transport, or ssl:listen/3 or gen_tcp:listen/2 for
+a listening transport, depending on whether or not <c>{ssl_options, true}</c>
+has been specified.
+Options <c>binary</c>, <c>packet</c> and <c>active</c> cannot be specified.
Also, option <c>port</c> can be specified for a listening transport
to specify the local listening port, the default being the standardized
3868 if unspecified.
Note that option <c>ip</c> specifies the local address.</p>
<p>
+An <c>ssl_options</c> list must be specified if and only if
+the transport in question has specified an Inband-Security-Id
+AVP with value TLS on the relevant call to
+<seealso
+marker="diameter#start_service">start_service/2</seealso> or
+<seealso
+marker="diameter#add_transport">add_transport/2</seealso>,
+so that the transport process will receive notification of
+whether or not to commence with a TLS handshake following capabilities
+exchange.
+Failing to specify an options list on a TLS-capable transport
+for which TLS is negotiated will cause TLS handshake to fail.
+Failing to specify TLS capability when <c>ssl_options</c> has been
+specified will cause the transport process to wait for a notification
+that will not be forthcoming, which will eventually cause the RFC 3539
+watchdog to take down the connection.</p>
+
+<p>
If the service specifies more than one Host-IP-Address and
option <c>ip</c> is unspecified then then the
first of the service's addresses is used as the local address.</p>
@@ -104,6 +141,7 @@ The returned local address list has length one.</p>
<title>SEE ALSO</title>
<p>
+<seealso marker="diameter">diameter(3)</seealso>,
<seealso marker="diameter_transport">diameter_transport(3)</seealso></p>
</section>
diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml
index 37cc871e75..087a90b099 100644
--- a/lib/diameter/doc/src/diameter_transport.xml
+++ b/lib/diameter/doc/src/diameter_transport.xml
@@ -143,6 +143,34 @@ connection.
Pid is the pid() of the parent process.</p>
</item>
+<tag><c>{diameter, {tls, Ref, Type, Bool}}</c></tag>
+<item>
+<p>
+Indication of whether or not capabilities exchange has selected
+inband security using TLS.
+Ref is a reference() that must be included in the
+<c>{diameter, {tls, Ref}}</c> reply message to the transport's
+parent process (see below).
+Type is either <c>connect</c> or <c>accept</c> depending on
+whether the process has been started for a connecting or listening
+transport respectively.
+Bool is a boolean() indicating whether or not the transport connection
+should be upgraded to TLS.</p>
+
+<p>
+If TLS is requested (Bool = true) then a connecting process should
+initiate a TLS handshake with the peer and an accepting process should
+prepare to accept a handshake.
+A successful handshake should be followed by a <c>{diameter, {tls, Ref}}</c>
+message to the parent process.
+A failed handshake should cause the process to exit.</p>
+
+<p>
+This message is only sent to a transport process over whose
+<c>Inband-Security-Id</c> configuration has indicated support for
+TLS.</p>
+</item>
+
</taglist>
<p>
@@ -184,6 +212,16 @@ How the <c>transport_data</c> is used/interpreted is up to the
transport module.</p>
</item>
+<tag><c>{diameter, {tls, Ref}}</c></tag>
+<item>
+<p>
+Acknowledgment of a successful TLS handshake.
+Ref is the reference() received in the
+<c>{diameter, {tls, Ref, Type, Bool}}</c> message in response
+to which the reply is sent.
+A transport must exit if a handshake is not successful.</p>
+</item>
+
</taglist>
</section>
diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl
index aa5318e79d..138e76411e 100644
--- a/lib/diameter/src/app/diameter_capx.erl
+++ b/lib/diameter/src/app/diameter_capx.erl
@@ -62,6 +62,7 @@
-define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY').
-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
%% ===========================================================================
@@ -80,7 +81,7 @@ recv_CER(CER, Svc) ->
try_it([fun rCER/2, CER, Svc]).
-spec recv_CEA(#diameter_base_CEA{}, #diameter_service{})
- -> tried({['Unsigned32'()], #diameter_caps{}}).
+ -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}).
recv_CEA(CEA, Svc) ->
try_it([fun rCEA/2, CEA, Svc]).
@@ -126,10 +127,11 @@ mk_caps(Caps0, Opts) ->
set_cap({Key, _}, _) ->
?THROW({duplicate, Key}).
-cap(K, V) when K == 'Origin-Host';
- K == 'Origin-Realm';
- K == 'Vendor-Id';
- K == 'Product-Name' ->
+cap(K, V)
+ when K == 'Origin-Host';
+ K == 'Origin-Realm';
+ K == 'Vendor-Id';
+ K == 'Product-Name' ->
V;
cap('Host-IP-Address', Vs)
@@ -139,11 +141,8 @@ cap('Host-IP-Address', Vs)
cap('Firmware-Revision', V) ->
[V];
-%% Not documented but accept it as long as it's what we support.
-cap('Inband-Security-Id', [0] = Vs) -> %% NO_INBAND_SECURITY
- Vs;
-
-cap(K, Vs) when K /= 'Inband-Security-Id', is_list(Vs) ->
+cap(_, Vs)
+ when is_list(Vs) ->
Vs;
cap(K, V) ->
@@ -161,28 +160,10 @@ ipaddr(A) ->
%%
%% Build a CER record to send to a remote peer.
-bCER(#diameter_caps{origin_host = Host,
- origin_realm = Realm,
- host_ip_address = Addrs,
- vendor_id = Vid,
- product_name = Name,
- origin_state_id = OSI,
- supported_vendor_id = SVid,
- auth_application_id = AuId,
- acct_application_id = AcId,
- vendor_specific_application_id = VSA,
- firmware_revision = Rev}) ->
- #diameter_base_CER{'Origin-Host' = Host,
- 'Origin-Realm' = Realm,
- 'Host-IP-Address' = Addrs,
- 'Vendor-Id' = Vid,
- 'Product-Name' = Name,
- 'Origin-State-Id' = OSI,
- 'Supported-Vendor-Id' = SVid,
- 'Auth-Application-Id' = AuId,
- 'Acct-Application-Id' = AcId,
- 'Vendor-Specific-Application-Id' = VSA,
- 'Firmware-Revision' = Rev}.
+%% Use the fact that diameter_caps has the same field names as CER.
+bCER(#diameter_caps{} = Rec) ->
+ #diameter_base_CER{}
+ = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]).
%% rCER/2
%%
@@ -219,19 +200,16 @@ bCER(#diameter_caps{origin_host = Host,
%% That is, each side sends all of its capabilities and is responsible for
%% not sending commands that the peer doesn't support.
-%% TODO: Make it an option to send only common applications in CEA to
-%% allow backwards compatibility, and also because there are likely
-%% servers that expect this. Or maybe a callback.
-
%% 6.10. Inband-Security-Id AVP
%%
%% NO_INBAND_SECURITY 0
%% This peer does not support TLS. This is the default value, if the
%% AVP is omitted.
+%%
+%% TLS 1
+%% This node supports TLS security, as defined by [TLS].
rCER(CER, #diameter_service{capabilities = LCaps} = Svc) ->
- #diameter_base_CER{'Inband-Security-Id' = RIS}
- = CER,
#diameter_base_CEA{}
= CEA
= cea_from_cer(bCER(LCaps)),
@@ -241,56 +219,95 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) ->
{SApps,
RCaps,
- build_CEA([] == SApps,
- RIS,
- lists:member(?NO_INBAND_SECURITY, RIS),
- CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS,
- 'Inband-Security-Id' = []})}.
+ build_CEA(SApps,
+ LCaps,
+ RCaps,
+ CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}.
-%% TODO: 5.3 of RFC3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION
+%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION
%% in the CEA and SHOULD disconnect the transport. However, we have
%% no way to guarantee the send before disconnecting.
-build_CEA(true, _, _, CEA) ->
+build_CEA([], _, _, CEA) ->
CEA#diameter_base_CEA{'Result-Code' = ?NOAPP};
-build_CEA(false, [_|_], false, CEA) ->
- CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY};
-build_CEA(false, [_|_], true, CEA) ->
- CEA#diameter_base_CEA{'Inband-Security-Id' = [?NO_INBAND_SECURITY]};
-build_CEA(false, [], false, CEA) ->
- CEA.
+
+build_CEA(_, LCaps, RCaps, CEA) ->
+ case common_security(LCaps, RCaps) of
+ [] ->
+ CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY};
+ [_] = IS ->
+ CEA#diameter_base_CEA{'Inband-Security-Id' = IS}
+ end.
+
+%% common_security/2
+
+common_security(#diameter_caps{inband_security_id = LS},
+ #diameter_caps{inband_security_id = RS}) ->
+ cs(LS, RS).
+
+%% Unspecified is equivalent to NO_INBAND_SECURITY.
+cs([], RS) ->
+ cs([?NO_INBAND_SECURITY], RS);
+cs(LS, []) ->
+ cs(LS, [?NO_INBAND_SECURITY]);
+
+%% Agree on TLS if both parties support it. When sending CEA, this is
+%% to ensure the peer is clear that we will be expecting a TLS
+%% handshake since there is no ssl:maybe_accept that would allow the
+%% peer to choose between TLS or not upon reception of our CEA. When
+%% receiving CEA it deals with a server that isn't explicit about its choice.
+%% TODO: Make the choice configurable.
+cs(LS, RS) ->
+ Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS),
+ ordsets:from_list(RS))),
+ case lists:member(?TLS, Is) of
+ true ->
+ [?TLS];
+ false when [] == Is ->
+ Is;
+ false ->
+ [hd(Is)] %% probably NO_INBAND_SECURITY
+ end.
+%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and
+%% TLS but don't enforce this. In theory this allows some other
+%% security mechanism we don't have to know about, although in
+%% practice something there may be a need for more synchronization
+%% than notification by way of an event subscription offers.
%% cea_from_cer/1
+%% CER is a subset of CEA, the latter adding Result-Code and a few
+%% more AVP's.
cea_from_cer(#diameter_base_CER{} = CER) ->
lists:foldl(fun(F,A) -> to_cea(CER, F, A) end,
#diameter_base_CEA{},
record_info(fields, diameter_base_CER)).
to_cea(CER, Field, CEA) ->
- try ?BASE:'#info-'(diameter_base_CEA, {index, Field}) of
- N ->
- setelement(N, CEA, ?BASE:'#get-'(Field, CER))
+ try ?BASE:'#get-'(Field, CER) of
+ V -> ?BASE:'#set-'({Field, V}, CEA)
catch
- error: _ ->
- CEA
+ error: _ -> CEA
end.
-
+
%% rCEA/2
-rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc)
- when is_record(CEA, diameter_base_CEA) ->
- #diameter_base_CEA{'Result-Code' = RC}
- = CEA,
-
+rCEA(#diameter_base_CEA{'Result-Code' = RC}
+ = CEA,
+ #diameter_service{capabilities = LCaps}
+ = Svc) ->
RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}),
RCaps = capx_to_caps(CEA),
SApps = common_applications(LCaps, RCaps, Svc),
- [] == SApps andalso ?THROW({no_common_apps, LCaps, RCaps}),
+ [] == SApps andalso ?THROW(no_common_applications),
+
+ IS = common_security(LCaps, RCaps),
+
+ [] == IS andalso ?THROW(no_common_security),
- {SApps, RCaps};
+ {SApps, IS, RCaps};
rCEA(CEA, _Svc) ->
?THROW({invalid, CEA}).
diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl
index 0252fb3809..282fa2742f 100644
--- a/lib/diameter/src/app/diameter_peer_fsm.erl
+++ b/lib/diameter/src/app/diameter_peer_fsm.erl
@@ -52,6 +52,9 @@
-define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU').
-define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING').
+-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
+
-define(LOOP_TIMEOUT, 2000).
%% RFC 3588:
@@ -195,10 +198,8 @@ handle_info(T, #state{} = State) ->
?LOG(stop, T),
x(T, State)
catch
- throw: {?MODULE, close = C, Reason} ->
- ?LOG(C, {Reason, T}),
- x(Reason, State);
- throw: {?MODULE, abort, Reason} ->
+ throw: {?MODULE, Tag, Reason} ->
+ ?LOG(Tag, {Reason, T}),
{stop, {shutdown, Reason}, State}
end.
@@ -281,10 +282,9 @@ transition(shutdown, _) -> %% DPR already send: ensure expected timeout
%% Request to close the transport connection.
transition({close = T, Pid}, #state{parent = Pid,
- transport = TPid}
- = S) ->
+ transport = TPid}) ->
diameter_peer:close(TPid),
- close(T,S);
+ {stop, T};
%% DPA reception has timed out.
transition(dpa_timeout, _) ->
@@ -418,11 +418,11 @@ rcv('CER' = N, Pkt, #state{state = recv_CER} = S) ->
%% Anything but CER/CEA in a non-Open state is an error, as is
%% CER/CEA in anything but recv_CER/Wait-CEA.
-rcv(Name, _, #state{state = PS} = S)
+rcv(Name, _, #state{state = PS})
when PS /= 'Open';
Name == 'CER';
Name == 'CEA' ->
- close({Name, PS}, S);
+ {stop, {Name, PS}};
rcv(N, Pkt, S)
when N == 'DWR';
@@ -497,15 +497,20 @@ build_answer('CER',
#diameter_service{capabilities = #diameter_caps{origin_host = OH}}
= Svc,
- {SupportedApps, #diameter_caps{origin_host = DH} = RCaps, CEA}
+ {SupportedApps,
+ #diameter_caps{origin_host = DH} = RCaps,
+ #diameter_base_CEA{'Result-Code' = RC}
+ = CEA}
= recv_CER(CER, S),
try
- [] == SupportedApps
- andalso ?THROW({no_common_application, 5010}),
+ 2001 == RC %% DIAMETER_SUCCESS
+ orelse ?THROW({sent_CEA, RC}),
register_everywhere({?MODULE, connection, OH, DH})
orelse ?THROW({election_lost, 4003}),
- {CEA, [fun open/4, Pkt, SupportedApps, RCaps]}
+ #diameter_base_CEA{'Inband-Security-Id' = [IS]}
+ = CEA,
+ {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]}
catch
?FAILURE({Reason, RC}) ->
{answer('CER', S) ++ [{'Result-Code', RC}],
@@ -613,7 +618,7 @@ recv_CER(CER, #state{service = Svc}) ->
handle_CEA(#diameter_packet{header = #diameter_header{version = V},
bin = Bin}
= Pkt,
- #state{service = Svc}
+ #state{service = #diameter_service{capabilities = LCaps}}
= S)
when is_binary(Bin) ->
?LOG(recv, 'CEA'),
@@ -626,7 +631,11 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V},
[] == Errors orelse close({errors, Errors}, S),
- {SApps, #diameter_caps{origin_host = DH} = RCaps} = recv_CEA(CEA, S),
+ {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps}
+ = recv_CEA(CEA, S),
+
+ #diameter_caps{origin_host = OH}
+ = LCaps,
%% Ensure that we don't already have a connection to the peer in
%% question. This isn't the peer election of 3588 except in the
@@ -634,40 +643,62 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V},
%% receive a CER/CEA, the first that arrives wins the right to a
%% connection with the peer.
- #diameter_service{capabilities = #diameter_caps{origin_host = OH}}
- = Svc,
-
register_everywhere({?MODULE, connection, OH, DH})
- orelse
- close({'CEA', DH}, S),
+ orelse close({'CEA', DH}, S),
- open(DPkt, SApps, RCaps, S).
+ open(DPkt, SApps, RCaps, {connect, IS}, S).
%% recv_CEA/2
recv_CEA(CEA, #state{service = Svc} = S) ->
case diameter_capx:recv_CEA(CEA, Svc) of
- {ok, {[], _}} ->
+ {ok, {_,_}} -> %% return from old code
+ close({'CEA', update}, S);
+ {ok, {[], _, _}} ->
close({'CEA', no_common_application}, S);
- {ok, T} ->
+ {ok, {_, [], _}} ->
+ close({'CEA', no_common_security}, S);
+ {ok, {_,_,_} = T} ->
T;
{error, Reason} ->
close({'CEA', Reason}, S)
end.
-%% open/4
+%% open/5
-open(Pkt, SupportedApps, RCaps, #state{parent = Pid,
- service = Svc}
- = S) ->
- #diameter_service{capabilities = #diameter_caps{origin_host = OH}
+open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid,
+ service = Svc}
+ = S) ->
+ #diameter_service{capabilities = #diameter_caps{origin_host = OH,
+ inband_security_id = LS}
= LCaps}
= Svc,
#diameter_caps{origin_host = DH}
= RCaps,
+
+ tls_ack(lists:member(?TLS, LS), Type, IS, S),
Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}},
+
S#state{state = 'Open'}.
+%% We've advertised TLS support: tell the transport the result
+%% and expect a reply when the handshake is complete.
+tls_ack(true, Type, IS, #state{transport = TPid} = S) ->
+ Ref = make_ref(),
+ MRef = erlang:monitor(process, TPid),
+ TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}},
+ receive
+ {diameter, {tls, Ref}} ->
+ erlang:demonitor(MRef, [flush]);
+ {'DOWN', MRef, process, _, _} = T ->
+ close({tls_ack, T}, S)
+ end;
+
+%% Or not. Don't send anything to the transport so that transports
+%% not supporting TLS work as before without modification.
+tls_ack(false, _, _, _) ->
+ ok.
+
capz(#diameter_caps{} = L, #diameter_caps{} = R) ->
#diameter_caps{}
= list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)),
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index 46473e7bf1..209f8c01c1 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -37,6 +37,9 @@
code_change/3,
terminate/2]).
+-export([ports/0,
+ ports/1]).
+
-include_lib("kernel/include/inet_sctp.hrl").
-include_lib("diameter/include/diameter.hrl").
@@ -118,8 +121,8 @@ s({accept, Ref} = A, Addrs, Opts) ->
%% gen_sctp in order to be able to accept a new association only
%% *after* an accepting transport has been spawned.
-s({connect = C, _}, Addrs, Opts) ->
- diameter_sctp_sup:start_child({C, self(), Opts, Addrs}).
+s({connect = C, Ref}, Addrs, Opts) ->
+ diameter_sctp_sup:start_child({C, self(), Opts, Addrs, Ref}).
%% start_link/1
@@ -149,28 +152,36 @@ i({listen, Ref, {Opts, Addrs}}) ->
socket = Sock});
%% A connecting transport.
-i({connect, Pid, Opts, Addrs}) ->
+i({connect, Pid, Opts, Addrs, Ref}) ->
{[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]),
RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As],
[RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps],
{LAs, Sock} = open(Addrs, Rest, 0),
+ putr(ref, Ref),
proc_lib:init_ack({ok, self(), LAs}),
erlang:monitor(process, Pid),
#transport{parent = Pid,
mode = {connect, connect(Sock, RAs, RP, [])},
socket = Sock};
+i({connect, _, _, _} = T) -> %% from old code
+ x(T);
%% An accepting transport spawned by diameter.
-i({accept, Pid, LPid, Sock}) ->
+i({accept, Pid, LPid, Sock, Ref})
+ when is_pid(Pid) ->
+ putr(ref, Ref),
proc_lib:init_ack({ok, self()}),
erlang:monitor(process, Pid),
erlang:monitor(process, LPid),
#transport{parent = Pid,
mode = {accept, LPid},
socket = Sock};
+i({accept, _, _, _} = T) -> %% from old code
+ x(T);
%% An accepting transport spawned at association establishment.
i({accept, Ref, LPid, Sock, Id}) ->
+ putr(ref, Ref),
proc_lib:init_ack({ok, self()}),
MRef = erlang:monitor(process, LPid),
%% Wait for a signal that the transport has been started before
@@ -250,13 +261,33 @@ gen_opts(Opts) ->
[binary, {active, once} | Opts].
%% ---------------------------------------------------------------------------
+%% # ports/0-1
+%% ---------------------------------------------------------------------------
+
+ports() ->
+ Ts = diameter_reg:match({?MODULE, '_', '_'}),
+ [{type(T), N, Pid} || {{?MODULE, T, {_, {_, S}}}, Pid} <- Ts,
+ {ok, N} <- [inet:port(S)]].
+
+ports(Ref) ->
+ Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}),
+ [{type(T), N, Pid} || {{?MODULE, T, {R, {_, S}}}, Pid} <- Ts,
+ R == Ref,
+ {ok, N} <- [inet:port(S)]].
+
+type(listener) ->
+ listen;
+type(T) ->
+ T.
+
+%% ---------------------------------------------------------------------------
%% # handle_call/3
%% ---------------------------------------------------------------------------
handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref,
count = N}
= S) ->
- {TPid, NewS} = accept(Pid, S),
+ {TPid, NewS} = accept(Ref, Pid, S),
{reply, {ok, TPid}, NewS#listener{count = N+1}};
handle_call(_, _, State) ->
@@ -306,6 +337,12 @@ terminate(_, #listener{socket = Sock}) ->
%% ---------------------------------------------------------------------------
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
%% start_timer/1
start_timer(#listener{count = 0} = S) ->
@@ -411,27 +448,41 @@ transition({diameter, {send, Msg}}, S) ->
transition({diameter, {close, Pid}}, #transport{parent = Pid}) ->
stop;
+%% TLS over SCTP is described in RFC 3436 but has limitations as
+%% described in RFC 6083. The latter describes DTLS over SCTP, which
+%% addresses these limitations, DTLS itself being described in RFC
+%% 4347. TLS is primarily used over TCP, which the current RFC 3588
+%% draft acknowledges by equating TLS with TLS/TCP and DTLS/SCTP.
+transition({diameter, {tls, _Ref, _Type, _Bool}}, _) ->
+ stop;
+
%% Listener process has died.
transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) ->
stop;
%% Parent process has died.
transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
- stop.
+ stop;
+
+%% Request for the local port number.
+transition({resolve_port, Pid}, #transport{socket = Sock})
+ when is_pid(Pid) ->
+ Pid ! inet:port(Sock),
+ ok.
%% Crash on anything unexpected.
-%% accept/2
+%% accept/3
%%
%% Start a new transport process or use one that's already been
%% started as a consequence of association establishment.
%% No pending associations: spawn a new transport.
-accept(Pid, #listener{socket = Sock,
- tmap = T,
- pending = {0,_} = Q}
- = S) ->
- Arg = {accept, Pid, self(), Sock},
+accept(Ref, Pid, #listener{socket = Sock,
+ tmap = T,
+ pending = {0,_} = Q}
+ = S) ->
+ Arg = {accept, Pid, self(), Sock, Ref},
{ok, TPid} = diameter_sctp_sup:start_child(Arg),
MRef = erlang:monitor(process, TPid),
ets:insert(T, [{MRef, TPid}, {TPid, MRef}]),
@@ -442,12 +493,12 @@ accept(Pid, #listener{socket = Sock,
%% Accepting transport has died. This can happen if a new transport is
%% started before the DOWN has arrived.
-accept(Pid, #listener{pending = [TPid | {0,_} = Q]} = S) ->
+accept(Ref, Pid, #listener{pending = [TPid | {0,_} = Q]} = S) ->
false = is_process_alive(TPid), %% assert
- accept(Pid, S#listener{pending = Q});
+ accept(Ref, Pid, S#listener{pending = Q});
%% Pending associations: attach to the first in the queue.
-accept(Pid, #listener{ref = Ref, pending = {N,Q}} = S) ->
+accept(_, Pid, #listener{ref = Ref, pending = {N,Q}} = S) ->
TPid = ets:first(Q),
TPid ! {Ref, Pid},
ets:delete(Q, TPid),
@@ -499,8 +550,14 @@ recv({[], #sctp_assoc_change{state = comm_up,
outbound_streams = OS,
inbound_streams = IS,
assoc_id = Id}},
- #transport{assoc_id = undefined}
+ #transport{assoc_id = undefined,
+ mode = {T, _},
+ socket = Sock}
= S) ->
+ Ref = getr(ref),
+ is_reference(Ref) %% started in new code
+ andalso
+ (true = diameter_reg:add_new({?MODULE, T, {Ref, {Id, Sock}}})),
up(S#transport{assoc_id = Id,
streams = {IS, OS}});
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 653c114471..78dbda6888 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -37,6 +37,9 @@
code_change/3,
terminate/2]).
+-export([ports/0,
+ ports/1]).
+
-include_lib("diameter/include/diameter.hrl").
-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
@@ -45,6 +48,9 @@
-define(LISTENER_TIMEOUT, 30000).
-define(FRAGMENT_TIMEOUT, 1000).
+%% cb_info passed to ssl.
+-define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}).
+
%% The same gen_server implementation supports three different kinds
%% of processes: an actual transport process, one that will club it to
%% death should the parent die before a connection is established, and
@@ -71,8 +77,8 @@
{socket :: inet:socket(), %% accept or connect socket
parent :: pid(), %% of process that started us
module :: module(), %% gen_tcp-like module
- frag = <<>> :: binary() | {tref(), frag()}}). %% message fragment
-
+ frag = <<>> :: binary() | {tref(), frag()}, %% message fragment
+ ssl :: boolean() | [term()]}). %% ssl options
%% The usual transport using gen_tcp can be replaced by anything
%% sufficiently gen_tcp-like by passing a 'module' option as the first
%% (for simplicity) transport option. The transport_module diameter_etcp
@@ -122,12 +128,18 @@ i({T, Ref, Mod, Pid, Opts, Addrs})
%% that does nothing but kill us with the parent until call
%% returns.
{ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}),
- Sock = i(T, Ref, Mod, Pid, Opts, Addrs),
+ {SslOpts, Rest} = ssl(Opts),
+ Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs),
MPid ! {stop, self()}, %% tell the monitor to die
- setopts(Mod, Sock),
+ M = if SslOpts -> ssl; true -> Mod end,
+ setopts(M, Sock),
+ putr(ref, Ref),
#transport{parent = Pid,
- module = Mod,
- socket = Sock};
+ module = M,
+ socket = Sock,
+ ssl = SslOpts};
+%% Put the reference in the process dictionary since we now use it
+%% advertise the ssl socket after TLS upgrade.
%% A monitor process to kill the transport if the parent dies.
i(#monitor{parent = Pid, transport = TPid} = S) ->
@@ -146,27 +158,51 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) ->
LAddr = get_addr(LA, Addrs),
LPort = get_port(LP),
{ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)),
+ true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
proc_lib:init_ack({ok, self(), {LAddr, LSock}}),
erlang:monitor(process, APid),
- true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}),
start_timer(#listener{socket = LSock}).
-%% i/6
+ssl(Opts) ->
+ {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]),
+ {ssl_opts(SslOpts), Rest}.
+
+ssl_opts([]) ->
+ false;
+ssl_opts([{ssl_options, true}]) ->
+ true;
+ssl_opts([{ssl_options, Opts}])
+ when is_list(Opts) ->
+ Opts;
+ssl_opts(L) ->
+ ?ERROR({ssl_options, L}).
+
+%% i/7
+
+%% Establish a TLS connection before capabilities exchange ...
+i(Type, Ref, Mod, Pid, true, Opts, Addrs) ->
+ i(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs);
+
+%% ... or not.
+i(Type, Ref, Mod, Pid, _, Opts, Addrs) ->
+ i(Type, Ref, Mod, Pid, Opts, Addrs).
-i(accept, Ref, Mod, Pid, Opts, Addrs) ->
+i(accept = T, Ref, Mod, Pid, Opts, Addrs) ->
{LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(accept(Mod, LSock)),
+ true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}),
diameter_peer:up(Pid),
Sock;
-i(connect, _, Mod, Pid, Opts, Addrs) ->
+i(connect = T, Ref, Mod, Pid, Opts, Addrs) ->
{[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]),
LAddr = get_addr(LA, Addrs),
RAddr = get_addr(RA, []),
RPort = get_port(RP),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))),
+ true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}),
diameter_peer:up(Pid, {RAddr, RPort}),
Sock.
@@ -227,6 +263,43 @@ gen_opts(LAddr, Opts) ->
| Opts].
%% ---------------------------------------------------------------------------
+%% # ports/1
+%% ---------------------------------------------------------------------------
+
+ports() ->
+ Ts = diameter_reg:match({?MODULE, '_', '_'}),
+ [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {_,S}}, Pid} <- Ts].
+
+ports(Ref) ->
+ Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}),
+ [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {R,S}}, Pid} <- Ts,
+ R == Ref].
+
+type(listener) ->
+ listen;
+type(T) ->
+ T.
+
+sock(listener, {_LAddr, Sock}) ->
+ Sock;
+sock(_, Sock) ->
+ Sock.
+
+resolve(Type, S) ->
+ Sock = sock(Type, S),
+ try
+ ok(portnr(Sock))
+ catch
+ _:_ -> Sock
+ end.
+
+portnr(Sock)
+ when is_port(Sock) ->
+ portnr(gen_tcp, Sock);
+portnr(Sock) ->
+ portnr(ssl, Sock).
+
+%% ---------------------------------------------------------------------------
%% # handle_call/3
%% ---------------------------------------------------------------------------
@@ -258,6 +331,8 @@ handle_info(T, #monitor{} = S) ->
%% # code_change/3
%% ---------------------------------------------------------------------------
+code_change(_, {transport, _, _, _, _} = S, _) ->
+ {ok, #transport{} = list_to_tuple(tuple_to_list(S) ++ [false])};
code_change(_, State, _) ->
{ok, State}.
@@ -270,6 +345,12 @@ terminate(_, _) ->
%% ---------------------------------------------------------------------------
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
%% start_timer/1
start_timer(#listener{count = 0} = S) ->
@@ -332,17 +413,56 @@ t(T,S) ->
%% transition/2
+%% Initial incoming message when we might need to upgrade to TLS:
+%% don't request another message until we know.
+transition({tcp, Sock, Bin}, #transport{socket = Sock,
+ parent = Pid,
+ frag = Head,
+ module = M,
+ ssl = Opts}
+ = S)
+ when is_list(Opts) ->
+ case recv1(Head, Bin) of
+ {Msg, B} when is_binary(Msg) ->
+ diameter_peer:recv(Pid, Msg),
+ S#transport{frag = B};
+ Frag ->
+ setopts(M, Sock),
+ S#transport{frag = Frag}
+ end;
+
%% Incoming message.
-transition({tcp, Sock, Data}, #transport{socket = Sock,
- module = M}
- = S) ->
+transition({P, Sock, Bin}, #transport{socket = Sock,
+ module = M,
+ ssl = B}
+ = S)
+ when P == tcp, not B;
+ P == ssl, B ->
+ setopts(M, Sock),
+ recv(Bin, S);
+
+%% Capabilties exchange has decided on whether or not to run over TLS.
+transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
+ = S) ->
+ #transport{socket = Sock,
+ module = M}
+ = NS
+ = tls_handshake(Type, B, S),
+ Pid ! {diameter, {tls, Ref}},
setopts(M, Sock),
- recv(Data, S);
+ NS#transport{ssl = B};
-transition({tcp_closed, Sock}, #transport{socket = Sock}) ->
+transition({C, Sock}, #transport{socket = Sock,
+ ssl = B})
+ when C == tcp_closed, not B;
+ C == ssl_closed, B ->
stop;
-transition({tcp_error, Sock, _Reason} = T, #transport{socket = Sock} = S) ->
+transition({E, Sock, _Reason} = T, #transport{socket = Sock,
+ ssl = B}
+ = S)
+ when E == tcp_error, not B;
+ E == ssl_error, B ->
?ERROR({T,S});
%% Outgoing message.
@@ -367,10 +487,10 @@ transition({timeout, TRef, flush}, S) ->
flush(TRef, S);
%% Request for the local port number.
-transition({resolve_port, RPid}, #transport{socket = Sock,
- module = M})
- when is_pid(RPid) ->
- RPid ! lport(M, Sock),
+transition({resolve_port, Pid}, #transport{socket = Sock,
+ module = M})
+ when is_pid(Pid) ->
+ Pid ! portnr(M, Sock),
ok;
%% Parent process has died.
@@ -379,80 +499,122 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
%% Crash on anything unexpected.
+%% tls_handshake/3
+%%
+%% In the case that no tls message is received (eg. the service hasn't
+%% been configured to advertise TLS support) we will simply never ask
+%% for another TCP message, which will force the watchdog to
+%% eventually take us down.
+
+%% TLS has already been established with the connection.
+tls_handshake(_, _, #transport{ssl = true} = S) ->
+ S;
+
+%% Capabilities exchange negotiated TLS but transport was not
+%% configured with an options list.
+tls_handshake(_, true, #transport{ssl = false}) ->
+ ?ERROR(no_ssl_options);
+
+%% Capabilities exchange negotiated TLS: upgrade the connection.
+tls_handshake(Type, true, #transport{socket = Sock,
+ module = M,
+ ssl = Opts}
+ = S) ->
+ {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]),
+ Ref = getr(ref),
+ is_reference(Ref) %% started in new code
+ andalso
+ (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})),
+ S#transport{socket = SSock,
+ module = ssl};
+
+%% Capabilities exchange has not negotiated TLS.
+tls_handshake(_, false, S) ->
+ S.
+
+tls(connect, Sock, Opts) ->
+ ssl:connect(Sock, Opts);
+tls(accept, Sock, Opts) ->
+ ssl:ssl_accept(Sock, Opts).
+
%% recv/2
%%
%% Reassemble fragmented messages and extract multple message sent
%% using Nagle.
recv(Bin, #transport{parent = Pid, frag = Head} = S) ->
- S#transport{frag = recv(Pid, Head, Bin)}.
+ case recv1(Head, Bin) of
+ {Msg, B} when is_binary(Msg) ->
+ diameter_peer:recv(Pid, Msg),
+ recv(B, S#transport{frag = <<>>});
+ Frag ->
+ S#transport{frag = Frag}
+ end.
-%% recv/3
+%% recv1/2
%% No previous fragment.
-recv(Pid, <<>>, Bin) ->
- rcv(Pid, Bin);
+recv1(<<>>, Bin) ->
+ rcv(Bin);
-recv(Pid, {TRef, Head}, Bin) ->
+recv1({TRef, Head}, Bin) ->
erlang:cancel_timer(TRef),
- rcv(Pid, Head, Bin).
+ rcv(Head, Bin).
-%% rcv/3
+%% rcv/2
%% Not even the first four bytes of the header.
-rcv(Pid, Head, Bin)
+rcv(Head, Bin)
when is_binary(Head) ->
- rcv(Pid, <<Head/binary, Bin/binary>>);
+ rcv(<<Head/binary, Bin/binary>>);
%% Or enough to know how many bytes to extract.
-rcv(Pid, {Len, N, Head, Acc}, Bin) ->
- rcv(Pid, Len, N + size(Bin), Head, [Bin | Acc]).
+rcv({Len, N, Head, Acc}, Bin) ->
+ rcv(Len, N + size(Bin), Head, [Bin | Acc]).
-%% rcv/5
+%% rcv/4
%% Extract a message for which we have all bytes.
-rcv(Pid, Len, N, Head, Acc)
+rcv(Len, N, Head, Acc)
when Len =< N ->
- rcv(Pid, rcv1(Pid, Len, bin(Head, Acc)));
+ rcv1(Len, bin(Head, Acc));
%% Wait for more packets.
-rcv(_, Len, N, Head, Acc) ->
+rcv(Len, N, Head, Acc) ->
{start_timer(), {Len, N, Head, Acc}}.
%% rcv/2
%% Nothing left.
-rcv(_, <<>> = Bin) ->
+rcv(<<>> = Bin) ->
Bin;
%% Well, this isn't good. Chances are things will go south from here
%% but if we're lucky then the bytes we have extend to an intended
%% message boundary and we can recover by simply discarding them,
%% which is the result of receiving them.
-rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin)
+rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
when Len < 20 ->
- diameter_peer:recv(Pid, Bin),
- <<>>;
+ {Bin, <<>>};
%% Enough bytes to extract a message.
-rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin)
+rcv(<<_:1/binary, Len:24, _/binary>> = Bin)
when Len =< size(Bin) ->
- rcv(Pid, rcv1(Pid, Len, Bin));
+ rcv1(Len, Bin);
%% Or not: wait for more packets.
-rcv(_, <<_:1/binary, Len:24, _/binary>> = Head) ->
+rcv(<<_:1/binary, Len:24, _/binary>> = Head) ->
{start_timer(), {Len, size(Head), Head, []}};
%% Not even 4 bytes yet.
-rcv(_, Head) ->
+rcv(Head) ->
{start_timer(), Head}.
-%% rcv1/3
+%% rcv1/2
-rcv1(Pid, Len, Bin) ->
+rcv1(Len, Bin) ->
<<Msg:Len/binary, Rest/binary>> = Bin,
- diameter_peer:recv(Pid, Msg),
- Rest.
+ {Msg, Rest}.
%% bin/[12]
@@ -489,15 +651,18 @@ flush(_, S) ->
%% accept/2
-accept(gen_tcp, LSock) ->
- gen_tcp:accept(LSock);
+accept(ssl, LSock) ->
+ case ssl:transport_accept(LSock) of
+ {ok, Sock} ->
+ {ssl:ssl_accept(Sock), Sock};
+ {error, _} = No ->
+ No
+ end;
accept(Mod, LSock) ->
Mod:accept(LSock).
%% connect/4
-connect(gen_tcp, Host, Port, Opts) ->
- gen_tcp:connect(Host, Port, Opts);
connect(Mod, Host, Port, Opts) ->
Mod:connect(Host, Port, Opts).
@@ -505,6 +670,8 @@ connect(Mod, Host, Port, Opts) ->
send(gen_tcp, Sock, Bin) ->
gen_tcp:send(Sock, Bin);
+send(ssl, Sock, Bin) ->
+ ssl:send(Sock, Bin);
send(M, Sock, Bin) ->
M:send(Sock, Bin).
@@ -512,6 +679,8 @@ send(M, Sock, Bin) ->
setopts(gen_tcp, Sock, Opts) ->
inet:setopts(Sock, Opts);
+setopts(ssl, Sock, Opts) ->
+ ssl:setopts(Sock, Opts);
setopts(M, Sock, Opts) ->
M:setopts(Sock, Opts).
@@ -523,9 +692,16 @@ setopts(M, Sock) ->
X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect
end.
-%% lport/2
+%% portnr/2
-lport(gen_tcp, Sock) ->
+portnr(gen_tcp, Sock) ->
inet:port(Sock);
-lport(M, Sock) ->
+portnr(ssl, Sock) ->
+ case ssl:sockname(Sock) of
+ {ok, {_Addr, PortNr}} ->
+ {ok, PortNr};
+ {error, _} = No ->
+ No
+ end;
+portnr(M, Sock) ->
M:port(Sock).
diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile
index dba1f126dc..04e686c969 100644
--- a/lib/diameter/test/Makefile
+++ b/lib/diameter/test/Makefile
@@ -77,7 +77,7 @@ ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \
all: $(SUITES)
-tests debug opt: $(TARGET_FILES)
+beam tests debug opt: $(TARGET_FILES)
clean:
rm -f $(TARGET_FILES)
diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
index 104785b4e6..15a98d4441 100644
--- a/lib/diameter/test/diameter_app_SUITE.erl
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -147,14 +147,13 @@ appvsn(Name) ->
%% ===========================================================================
%% # xref/1
%%
-%% Ensure that no function in our application calls an undefined function.
+%% Ensure that no function in our application calls an undefined function
+%% or one in an application we haven't specified as a dependency. (Almost.)
%% ===========================================================================
xref(Config) ->
App = fetch(app, Config),
- Mods = fetch(modules, App) -- [diameter_codegen, diameter_dbg],
- %% Skip modules that aren't required at runtime and that have
- %% dependencies beyond those applications listed in the app file.
+ Mods = fetch(modules, App),
{ok, XRef} = xref:start(make_name(xref_test_name)),
ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]),
@@ -164,7 +163,10 @@ xref(Config) ->
%% stop xref from complaining about calls to module erlang, which
%% was previously in kernel. Erts isn't an application however, in
%% the sense that there's no .app file, and isn't listed in
- %% applications. Seems less than ideal.
+ %% applications. Seems less than ideal. Also, diameter_tcp does
+ %% call ssl despite ssl not being listed as a dependency in the
+ %% app file since ssl is only required for TLS security: it's up
+ %% to a client who wants TLS it to start ssl.
ok = lists:foreach(fun(A) -> add_application(XRef, A) end,
[?APP, erts | fetch(applications, App)]),
@@ -173,7 +175,11 @@ xref(Config) ->
xref:stop(XRef),
%% Only care about calls from our own application.
- [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs).
+ [] = lists:filter(fun({{F,_,_},{T,_,_}}) ->
+ lists:member(F, Mods)
+ andalso {F,T} /= {diameter_tcp, ssl}
+ end,
+ Undefs).
add_application(XRef, App) ->
add_application(XRef, App, code:lib_dir(App)).
diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl
new file mode 100644
index 0000000000..c25e9682f0
--- /dev/null
+++ b/lib/diameter/test/diameter_failover_SUITE.erl
@@ -0,0 +1,262 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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%
+%%
+
+%%
+%% Tests of traffic between six Diameter nodes in three realms,
+%% connected as follows.
+%%
+%% ----- SERVER1.REALM2
+%% /
+%% / ----- SERVER2.REALM2
+%% | /
+%% CLIENT.REALM1 ------ SERVER3.REALM2
+%% | \
+%% | \
+%% \ ---- SERVER1.REALM3
+%% \
+%% ----- SERVER2.REALM3
+%%
+
+-module(diameter_failover_SUITE).
+
+-export([suite/0,
+ all/0]).
+
+%% testcases
+-export([start/1,
+ start_services/1,
+ connect/1,
+ send_ok/1,
+ send_nok/1,
+ stop_services/1,
+ stop/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/4,
+ prepare_request/3,
+ prepare_retransmit/3,
+ handle_answer/4,
+ handle_error/4,
+ handle_request/3]).
+
+-ifdef(DIAMETER_CT).
+-include("diameter_gen_base_rfc3588.hrl").
+-else.
+-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
+-endif.
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(ADDR, {127,0,0,1}).
+
+-define(CLIENT, "CLIENT.REALM1").
+-define(SERVER1, "SERVER1.REALM2").
+-define(SERVER2, "SERVER2.REALM2").
+-define(SERVER3, "SERVER3.REALM2").
+-define(SERVER4, "SERVER1.REALM3").
+-define(SERVER5, "SERVER2.REALM3").
+
+-define(SERVICES, [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]).
+
+-define(DICT_COMMON, ?DIAMETER_DICT_COMMON).
+
+-define(APP_ALIAS, the_app).
+-define(APP_ID, ?DICT_COMMON:id()).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Host, Dict),
+ [{'Origin-Host', Host},
+ {'Origin-Realm', realm(Host)},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Acct-Application-Id', [Dict:id()]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, Dict},
+ {module, ?MODULE},
+ {answer_errors, callback}]}]).
+
+-define(SUCCESS, 2001).
+
+-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [start,
+ start_services,
+ connect,
+ send_ok,
+ send_nok,
+ stop_services,
+ stop].
+
+%% ===========================================================================
+%% start/stop testcases
+
+start(_Config) ->
+ ok = diameter:start().
+
+start_services(_Config) ->
+ S = [server(N, ?DICT_COMMON) || N <- tl(?SERVICES)],
+
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
+
+ {save_config, [{?CLIENT, S}]}.
+
+connect(Config) ->
+ {_, Conns} = proplists:get_value(saved_config, Config),
+
+ lists:foreach(fun({CN,Ss}) -> connect(CN, Ss) end, Conns).
+
+stop_services(_Config) ->
+ [] = [{H,T} || H <- ?SERVICES,
+ T <- [diameter:stop_service(H)],
+ T /= ok].
+
+stop(_Config) ->
+ ok = diameter:stop().
+
+%% ----------------------------------------
+
+server(Name, Dict) ->
+ ok = diameter:start_service(Name, ?SERVICE(Name, Dict)),
+ {Name, ?util:listen(Name, tcp)}.
+
+connect(Name, Refs) ->
+ [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs].
+
+%% ===========================================================================
+%% traffic testcases
+
+%% Send an STR and expect success after SERVER3 answers after a couple
+%% of failovers.
+send_ok(_Config) ->
+ Req = ['STR', {'Destination-Realm', realm(?SERVER1)},
+ {'Termination-Cause', ?LOGOUT},
+ {'Auth-Application-Id', ?APP_ID}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Origin-Host' = ?SERVER3}
+ = call(Req, [{filter, realm}]).
+
+%% Send an STR and expect failure when both servers fail.
+send_nok(_Config) ->
+ Req = ['STR', {'Destination-Realm', realm(?SERVER4)},
+ {'Termination-Cause', ?LOGOUT},
+ {'Auth-Application-Id', ?APP_ID}],
+ {error, failover} = call(Req, [{filter, realm}]).
+
+%% ===========================================================================
+
+realm(Host) ->
+ tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+
+call(Req, Opts) ->
+ diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts).
+
+set([H|T], Vs) ->
+ [H | Vs ++ T].
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/4
+
+%% Choose a server other than SERVER3 or SERVER5 if possible.
+pick_peer(Peers, _, ?CLIENT, _State) ->
+ case lists:partition(fun({_, #diameter_caps{origin_host = {_, OH}}}) ->
+ OH /= ?SERVER3 andalso OH /= ?SERVER5
+ end,
+ Peers)
+ of
+ {[], [Peer]} ->
+ {ok, Peer};
+ {[Peer | _], _} ->
+ {ok, Peer}
+ end.
+
+%% prepare_request/3
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) ->
+ {send, prepare(Pkt, Caps)}.
+
+prepare(#diameter_packet{msg = Req}, Caps) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR}]).
+
+%% prepare_retransmit/3
+
+prepare_retransmit(Pkt, ?CLIENT, _Peer) ->
+ {send, Pkt}.
+
+%% handle_answer/4
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/4
+
+handle_error(Reason, _Req, ?CLIENT, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+%% Only SERVER3 actually answers.
+handle_request(Pkt, ?SERVER3, {_, Caps}) ->
+ #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId,
+ 'Origin-Host' = ?CLIENT}}
+ = Pkt,
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}};
+
+%% Others kill the transport to force failover.
+handle_request(_, _, {TPid, _}) ->
+ exit(TPid, kill),
+ discard.
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index d3d1fe690a..03f1115496 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -37,20 +37,22 @@
all/0,
groups/0,
init_per_group/2,
- end_per_group/2,
- init_per_suite/1,
- end_per_suite/1]).
+ end_per_group/2]).
%% testcases
--export([send1/1,
+-export([start/1,
+ start_services/1,
+ connect/1,
+ send1/1,
send2/1,
send3/1,
send4/1,
send_loop/1,
send_timeout_1/1,
send_timeout_2/1,
- remove_transports/1,
- stop_services/1]).
+ disconnect/1,
+ stop_services/1,
+ stop/1]).
%% diameter callbacks
-export([peer_up/3,
@@ -73,6 +75,8 @@
%% ===========================================================================
+-define(util, diameter_util).
+
-define(ADDR, {127,0,0,1}).
-define(CLIENT, "CLIENT.REALM1").
@@ -83,6 +87,10 @@
-define(SERVER3, "SERVER1.REALM3").
-define(SERVER4, "SERVER2.REALM3").
+-define(SERVICES, [?CLIENT,
+ ?RELAY1, ?RELAY2,
+ ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4]).
+
-define(DICT_COMMON, ?DIAMETER_DICT_COMMON).
-define(DICT_RELAY, ?DIAMETER_DICT_RELAY).
@@ -102,19 +110,6 @@
{module, ?MODULE},
{answer_errors, callback}]}]).
-%% Config for diameter:add_transport/2. In the listening case, listen
-%% on a free port that we then lookup using the implementation detail
-%% that diameter_tcp registers the port with diameter_reg.
--define(CONNECT(PortNr),
- {connect, [{transport_module, diameter_tcp},
- {transport_config, [{raddr, ?ADDR},
- {rport, PortNr},
- {ip, ?ADDR},
- {port, 0}]}]}).
--define(LISTEN,
- {listen, [{transport_module, diameter_tcp},
- {transport_config, [{ip, ?ADDR}, {port, 0}]}]}).
-
-define(SUCCESS, 2001).
-define(LOOP_DETECTED, 3005).
-define(UNABLE_TO_DELIVER, 3002).
@@ -122,22 +117,21 @@
-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
-define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
--define(A, list_to_atom).
--define(L, atom_to_list).
-
%% ===========================================================================
suite() ->
[{timetrap, {seconds, 10}}].
all() ->
- [{group, N} || {N, _, _} <- groups()]
- ++ [remove_transports, stop_services].
+ [start, start_services, connect]
+ ++ tc()
+ ++ [{group, all},
+ disconnect,
+ stop_services,
+ stop].
groups() ->
- Ts = tc(),
- [{all, [], Ts},
- {p, [parallel], Ts}].
+ [{all, [parallel], tc()}].
init_per_group(_, Config) ->
Config.
@@ -145,32 +139,7 @@ init_per_group(_, Config) ->
end_per_group(_, _) ->
ok.
-init_per_suite(Config) ->
- ok = diameter:start(),
- [S1,S2,S3,S4] = S = [server(N, ?DICT_COMMON) || N <- [?SERVER1,
- ?SERVER2,
- ?SERVER3,
- ?SERVER4]],
- [R1,R2] = R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]],
-
- ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
-
- true = diameter:subscribe(?RELAY1),
- true = diameter:subscribe(?RELAY2),
- true = diameter:subscribe(?CLIENT),
-
- [C1,C2] = connect(?RELAY1, [S1,S2]),
- [C3,C4] = connect(?RELAY2, [S3,S4]),
- [C5,C6] = connect(?CLIENT, [R1,R2]),
-
- C7 = connect(?RELAY1, R2),
-
- [{transports, {S, R, [C1,C2,C3,C4,C5,C6,C7]}} | Config].
-
-end_per_suite(_Config) ->
- ok = diameter:stop().
-
-%% Testcases to run when services are started and connections
+%% Traffic cases run when services are started and connections
%% established.
tc() ->
[send1,
@@ -181,43 +150,56 @@ tc() ->
send_timeout_1,
send_timeout_2].
-server(Host, Dict) ->
- ok = diameter:start_service(Host, ?SERVICE(Host, Dict)),
- {ok, LRef} = diameter:add_transport(Host, ?LISTEN),
- {LRef, portnr(LRef)}.
-
-connect(Host, {_LRef, PortNr}) ->
- {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)),
- ok = receive
- #diameter_event{service = Host,
- info = {up, Ref, _, _, #diameter_packet{}}} ->
- ok
- after 2000 ->
- false
- end,
- Ref;
-connect(Host, Ports) ->
- [connect(Host, P) || P <- Ports].
-
-portnr(LRef) ->
- portnr(LRef, 20).
-
-portnr(LRef, N)
- when 0 < N ->
- case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of
- [{T, _Pid}] ->
- {_, _, {LRef, {_Addr, LSock}}} = T,
- {ok, PortNr} = inet:port(LSock),
- PortNr;
- [] ->
- receive after 50 -> ok end,
- portnr(LRef, N-1)
- end.
+%% ===========================================================================
+%% start/stop testcases
-realm(Host) ->
- tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+start(_Config) ->
+ ok = diameter:start().
+
+start_services(_Config) ->
+ [S1,S2,S3,S4] = [server(N, ?DICT_COMMON) || N <- [?SERVER1,
+ ?SERVER2,
+ ?SERVER3,
+ ?SERVER4]],
+ [R1,R2] = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]],
+
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
+
+ {save_config, [{?RELAY1, [S1,S2,R2]},
+ {?RELAY2, [S3,S4]},
+ {?CLIENT, [R1,R2]}]}.
+
+connect(Config) ->
+ {_, Conns} = proplists:get_value(saved_config, Config),
+
+ ?util:write_priv(Config,
+ "cfg",
+ lists:flatmap(fun({CN,Ss}) -> connect(CN, Ss) end,
+ Conns)).
+
+disconnect(Config) ->
+ lists:foreach(fun({{CN,CR},{SN,SR}}) -> ?util:disconnect(CN,CR,SN,SR) end,
+ ?util:read_priv(Config, "cfg")).
+
+stop_services(_Config) ->
+ [] = [{H,T} || H <- ?SERVICES,
+ T <- [diameter:stop_service(H)],
+ T /= ok].
+
+stop(_Config) ->
+ ok = diameter:stop().
+
+%% ----------------------------------------
+
+server(Name, Dict) ->
+ ok = diameter:start_service(Name, ?SERVICE(Name, Dict)),
+ {Name, ?util:listen(Name, tcp)}.
+
+connect(Name, Refs) ->
+ [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs].
%% ===========================================================================
+%% traffic testcases
%% Send an STR intended for a specific server and expect success.
send1(_Config) ->
@@ -254,40 +236,11 @@ send_timeout(Tmo) ->
{'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
call(Req, [{filter, realm}, {timeout, Tmo}]).
-%% Remove the client transports and expect the corresponding server
-%% transport to go down.
-remove_transports(Config) ->
- {[S1,S2,S3,S4], [R1,R2], [C1,C2,C3,C4,C5,C6,C7]}
- = proplists:get_value(transports, Config),
-
- true = diameter:subscribe(?SERVER1),
- true = diameter:subscribe(?SERVER2),
- true = diameter:subscribe(?SERVER3),
- true = diameter:subscribe(?SERVER4),
- true = diameter:subscribe(?RELAY1),
- true = diameter:subscribe(?RELAY2),
-
- disconnect(S1, ?RELAY1, C1),
- disconnect(S2, ?RELAY1, C2),
- disconnect(S3, ?RELAY2, C3),
- disconnect(S4, ?RELAY2, C4),
- disconnect(R1, ?CLIENT, C5),
- disconnect(R2, ?CLIENT, C6),
- disconnect(R2, ?RELAY1, C7).
-
-disconnect({LRef, _PortNr}, Client, CRef) ->
- ok = diameter:remove_transport(Client, CRef),
- ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
- after 2000 -> false
- end.
-
-stop_services(_Config) ->
- S = [?CLIENT, ?RELAY1, ?RELAY2, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4],
- Ok = [ok || _ <- S],
- Ok = [diameter:stop_service(H) || H <- S].
-
%% ===========================================================================
+realm(Host) ->
+ tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+
call(Server) ->
Realm = realm(Server),
Req = ['STR', {'Destination-Realm', Realm},
@@ -323,7 +276,7 @@ peer_down(_SvcName, _Peer, State) ->
pick_peer([Peer | _], _, Svc, _State)
when Svc == ?RELAY1;
Svc == ?RELAY2;
- Svc == ?CLIENT->
+ Svc == ?CLIENT ->
{ok, Peer}.
%% prepare_request/3
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
new file mode 100644
index 0000000000..99f92ca0e0
--- /dev/null
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -0,0 +1,411 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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%
+%%
+
+%%
+%% Tests of traffic between six Diameter nodes connected as follows.
+%%
+%% ---- SERVER.REALM1 (TLS after capabilities exchange)
+%% /
+%% / ---- SERVER.REALM2 (ditto)
+%% | /
+%% CLIENT.REALM0 ----- SERVER.REALM3 (no security)
+%% | \
+%% \ ---- SERVER.REALM4 (TLS at connection establishment)
+%% \
+%% ---- SERVER.REALM5 (ditto)
+%%
+
+-module(diameter_tls_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([start_ssl/1,
+ start_diameter/1,
+ make_certs/1, make_certs/0,
+ start_services/1,
+ add_transports/1,
+ send1/1,
+ send2/1,
+ send3/1,
+ send4/1,
+ send5/1,
+ remove_transports/1,
+ stop_services/1,
+ stop_diameter/1,
+ stop_ssl/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/4,
+ prepare_request/3,
+ prepare_retransmit/3,
+ handle_answer/4,
+ handle_error/4,
+ handle_request/3]).
+
+-ifdef(DIAMETER_CT).
+-include("diameter_gen_base_rfc3588.hrl").
+-else.
+-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
+-endif.
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(ADDR, {127,0,0,1}).
+
+-define(CLIENT, "CLIENT.REALM0").
+-define(SERVER1, "SERVER.REALM1").
+-define(SERVER2, "SERVER.REALM2").
+-define(SERVER3, "SERVER.REALM3").
+-define(SERVER4, "SERVER.REALM4").
+-define(SERVER5, "SERVER.REALM5").
+
+-define(SERVERS, [?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]).
+
+-define(DICT_COMMON, ?DIAMETER_DICT_COMMON).
+
+-define(APP_ALIAS, the_app).
+-define(APP_ID, ?DICT_COMMON:id()).
+
+-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Host, Dict),
+ [{'Origin-Host', Host},
+ {'Origin-Realm', realm(Host)},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Inband-Security-Id', [?NO_INBAND_SECURITY]},
+ {'Auth-Application-Id', [Dict:id()]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, Dict},
+ {module, ?MODULE},
+ {answer_errors, callback}]}]).
+
+%% Config for diameter:add_transport/2. In the listening case, listen
+%% on a free port that we then lookup using the implementation detail
+%% that diameter_tcp registers the port with diameter_reg.
+-define(CONNECT(PortNr, Caps, Opts),
+ {connect, [{transport_module, diameter_tcp},
+ {transport_config, [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}
+ | Opts]},
+ {capabilities, Caps}]}).
+-define(LISTEN(Caps, Opts),
+ {listen, [{transport_module, diameter_tcp},
+ {transport_config, [{ip, ?ADDR}, {port, 0} | Opts]},
+ {capabilities, Caps}]}).
+
+-define(SUCCESS, 2001).
+-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [start_ssl,
+ start_diameter,
+ make_certs,
+ start_services,
+ add_transports]
+ ++ [{group, N} || {N, _, _} <- groups()]
+ ++ [remove_transports, stop_services, stop_diameter, stop_ssl].
+
+groups() ->
+ Ts = tc(),
+ [{all, [], Ts},
+ {p, [parallel], Ts}].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ case os:find_executable("openssl") of
+ false ->
+ {skip, no_openssl};
+ _ ->
+ Config
+ end.
+
+end_per_suite(_Config) ->
+ ok.
+
+%% Testcases to run when services are started and connections
+%% established.
+tc() ->
+ [send1,
+ send2,
+ send3,
+ send4,
+ send5].
+
+%% ===========================================================================
+%% testcases
+
+start_ssl(_Config) ->
+ ok = ssl:start().
+
+start_diameter(_Config) ->
+ ok = diameter:start().
+
+make_certs() ->
+ [{timetrap, {seconds, 30}}].
+
+make_certs(Config) ->
+ Dir = proplists:get_value(priv_dir, Config),
+
+ [] = ?util:run([[fun make_cert/2, Dir, B] || B <- ["server1",
+ "server2",
+ "server4",
+ "server5",
+ "client"]]).
+
+start_services(Config) ->
+ Dir = proplists:get_value(priv_dir, Config),
+ Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS],
+
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)),
+
+ {save_config, [Dir | Servers]}.
+
+add_transports(Config) ->
+ {_, [Dir | Servers]} = proplists:get_value(saved_config, Config),
+
+ true = diameter:subscribe(?CLIENT),
+
+ Opts = ssl_options(Dir, "client"),
+ Connections = [connect(?CLIENT, S, copts(N, Opts))
+ || {S,N} <- lists:zip(Servers, ?SERVERS)],
+
+ ?util:write_priv(Config, "cfg", lists:zip(Servers, Connections)).
+
+
+%% Remove the client transports and expect the corresponding server
+%% transport to go down.
+remove_transports(Config) ->
+ Ts = ?util:read_priv(Config, "cfg"),
+ [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true],
+ lists:map(fun disconnect/1, Ts).
+
+stop_services(_Config) ->
+ [] = [{H,T} || H <- [?CLIENT | ?SERVERS],
+ T <- [diameter:stop_service(H)],
+ T /= ok].
+
+stop_diameter(_Config) ->
+ ok = diameter:stop().
+
+stop_ssl(_Config) ->
+ ok = ssl:stop().
+
+%% Send an STR intended for a specific server and expect success.
+send1(_Config) ->
+ call(?SERVER1).
+send2(_Config) ->
+ call(?SERVER2).
+send3(_Config) ->
+ call(?SERVER3).
+send4(_Config) ->
+ call(?SERVER4).
+send5(_Config) ->
+ call(?SERVER5).
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/4
+
+pick_peer([Peer], _, ?CLIENT, _State) ->
+ {ok, Peer}.
+
+%% prepare_request/3
+
+prepare_request(#diameter_packet{msg = Req},
+ ?CLIENT,
+ {_Ref, Caps}) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+
+ {send, set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR}])}.
+
+%% prepare_retransmit/3
+
+prepare_retransmit(_Pkt, false, _Peer) ->
+ discard.
+
+%% handle_answer/4
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/4
+
+handle_error(Reason, _Req, ?CLIENT, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}},
+ OH,
+ {_Ref, #diameter_caps{origin_host = {OH,_},
+ origin_realm = {OR, _}}})
+ when OH /= ?CLIENT ->
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}}.
+
+%% ===========================================================================
+%% support functions
+
+call(Server) ->
+ Realm = realm(Server),
+ Req = ['STR', {'Destination-Realm', Realm},
+ {'Termination-Cause', ?LOGOUT},
+ {'Auth-Application-Id', ?APP_ID}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Origin-Host' = Server,
+ 'Origin-Realm' = Realm}
+ = call(Req, [{filter, realm}]).
+
+call(Req, Opts) ->
+ diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts).
+
+set([H|T], Vs) ->
+ [H | Vs ++ T].
+
+disconnect({{LRef, _PortNr}, CRef}) ->
+ ok = diameter:remove_transport(?CLIENT, CRef),
+ ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok
+ after 2000 -> false
+ end.
+
+realm(Host) ->
+ tl(lists:dropwhile(fun(C) -> C /= $. end, Host)).
+
+inband_security(Ids) ->
+ [{'Inband-Security-Id', Ids}].
+
+ssl_options(Dir, Base) ->
+ Root = filename:join([Dir, Base]),
+ [{ssl_options, [{certfile, Root ++ "_ca.pem"},
+ {keyfile, Root ++ "_key.pem"}]}].
+
+make_cert(Dir, Base) ->
+ make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem").
+
+make_cert(Dir, Keyfile, Certfile) ->
+ [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]],
+
+ KCmd = join(["openssl genrsa -out", K, "2048"]),
+ CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7",
+ "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]),
+
+ %% Hope for the best and only check that files are written.
+ os:cmd(KCmd),
+ os:cmd(CCmd),
+
+ [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]],
+
+ {K,C}.
+
+join(Strs) ->
+ string:join(Strs, " ").
+
+%% server/2
+
+server(Host, {Caps, Opts}) ->
+ ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)),
+ {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)),
+ {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}.
+
+sopts(?SERVER1, Dir) ->
+ {inband_security([?TLS]),
+ ssl_options(Dir, "server1")};
+sopts(?SERVER2, Dir) ->
+ {inband_security([?NO_INBAND_SECURITY, ?TLS]),
+ ssl_options(Dir, "server2")};
+sopts(?SERVER3, _) ->
+ {[], []};
+sopts(?SERVER4, Dir) ->
+ {[], ssl(ssl_options(Dir, "server4"))};
+sopts(?SERVER5, Dir) ->
+ {[], ssl(ssl_options(Dir, "server5"))}.
+
+ssl([{ssl_options = T, Opts}]) ->
+ [{T, true} | Opts].
+
+%% connect/3
+
+connect(Host, {_LRef, PortNr}, {Caps, Opts}) ->
+ {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)),
+ ok = receive
+ #diameter_event{service = Host,
+ info = {up, Ref, _, _, #diameter_packet{}}} ->
+ ok
+ after 2000 ->
+ false
+ end,
+ Ref.
+
+copts(S, Opts)
+ when S == ?SERVER1;
+ S == ?SERVER2;
+ S == ?SERVER3 ->
+ {inband_security([?NO_INBAND_SECURITY, ?TLS]), Opts};
+copts(S, Opts)
+ when S == ?SERVER4;
+ S == ?SERVER5 ->
+ {[], ssl(Opts)}.
diff --git a/lib/ssl/c_src/Makefile b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca
index 52d9140153..3f2645add0 100644
--- a/lib/ssl/c_src/Makefile
+++ b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca
@@ -1,26 +1,43 @@
-#
+# -*- makefile -*-
# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2009. All Rights Reserved.
-#
+#
+# Copyright Ericsson AB 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%
-#
-
#
+# %CopyrightEnd%
#
-# Invoke with GNU make or clearmake -C gnu.
+# Certificates are now generated from the suite itself but the
+# makefile itself is still useful.
#
-include $(ERL_TOP)/make/run_make.mk
+KEYS = $(HOSTS:%=%_key.pem)
+CERTS = $(HOSTS:%=%_ca.pem)
+
+all: $(CERTS)
+
+%_ca.pem: %_key.pem
+ openssl req -new -x509 -key $< -out $@ -days 1095 \
+ -subj '/C=SE/ST=./L=Stockholm/CN=www.erlang.org'
+
+%_key.pem:
+ openssl genrsa -out $@ 2048
+
+clean:
+ rm -f $(CERTS)
+
+realclean: clean
+ rm -f $(KEYS)
+
+.PRECIOUS: $(KEYS)
+.PHONY: all clean realclean
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 8c85323222..6704f24532 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -26,15 +26,16 @@
-export([suite/0,
all/0,
groups/0,
- init_per_suite/1,
- end_per_suite/1,
init_per_group/2,
end_per_group/2,
init_per_testcase/2,
end_per_testcase/2]).
%% testcases
--export([result_codes/1,
+-export([start/1,
+ start_services/1,
+ add_transports/1,
+ result_codes/1,
send_ok/1,
send_arbitrary/1,
send_unknown/1,
@@ -73,7 +74,8 @@
send_multiple_filters_3/1,
send_anything/1,
remove_transports/1,
- stop_services/1]).
+ stop_services/1,
+ stop/1]).
%% diameter callbacks
-export([peer_up/3,
@@ -96,6 +98,8 @@
%% ===========================================================================
+-define(util, diameter_util).
+
-define(ADDR, {127,0,0,1}).
-define(CLIENT, "CLIENT").
@@ -123,19 +127,6 @@
{module, ?MODULE},
{answer_errors, callback}]}]).
-%% Config for diameter:add_transport/2. In the listening case, listen
-%% on a free port that we then lookup using the implementation detail
-%% that diameter_tcp registers the port with diameter_reg.
--define(CONNECT(PortNr),
- {connect, [{transport_module, diameter_tcp},
- {transport_config, [{raddr, ?ADDR},
- {rport, PortNr},
- {ip, ?ADDR},
- {port, 0}]}]}).
--define(LISTEN,
- {listen, [{transport_module, diameter_tcp},
- {transport_config, [{ip, ?ADDR}, {port, 0}]}]}).
-
-define(SUCCESS,
?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS').
-define(COMMAND_UNSUPPORTED,
@@ -177,30 +168,18 @@ suite() ->
[{timetrap, {seconds, 10}}].
all() ->
- [result_codes | [{group, N} || {N, _, _} <- groups()]]
- ++ [remove_transports, stop_services].
+ [start, start_services, add_transports, result_codes
+ | [{group, N} || {N, _, _} <- groups()]]
+ ++ [remove_transports, stop_services, stop].
groups() ->
Ts = tc(),
- [{E, [], Ts} || E <- ?ENCODINGS]
- ++ [{?P(E), [parallel], Ts} || E <- ?ENCODINGS].
+ [{grp(E,P), P, Ts} || E <- ?ENCODINGS, P <- [[], [parallel]]].
-init_per_suite(Config) ->
- ok = diameter:start(),
- ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)),
- ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)),
- {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN),
- true = diameter:subscribe(?CLIENT),
- {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())),
- {up, CRef, _Peer, _Config, #diameter_packet{}}
- = receive #diameter_event{service = ?CLIENT, info = I} -> I
- after 2000 -> false
- end,
- true = diameter:unsubscribe(?CLIENT),
- [{transports, {LRef, CRef}} | Config].
-
-end_per_suite(_Config) ->
- ok = diameter:stop().
+grp(E, []) ->
+ E;
+grp(E, [parallel]) ->
+ ?P(E).
init_per_group(Name, Config) ->
E = case ?L(Name) of
@@ -261,20 +240,31 @@ tc() ->
send_multiple_filters_3,
send_anything].
-portnr() ->
- portnr(20).
-
-portnr(N)
- when 0 < N ->
- case diameter_reg:match({diameter_tcp, listener, '_'}) of
- [{T, _Pid}] ->
- {_, _, {_LRef, {_Addr, LSock}}} = T,
- {ok, PortNr} = inet:port(LSock),
- PortNr;
- [] ->
- receive after 50 -> ok end,
- portnr(N-1)
- end.
+%% ===========================================================================
+%% start/stop testcases
+
+start(_Config) ->
+ ok = diameter:start().
+
+start_services(_Config) ->
+ ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)),
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)).
+
+add_transports(Config) ->
+ LRef = ?util:listen(?SERVER, tcp),
+ CRef = ?util:connect(?CLIENT, tcp, LRef),
+ ?util:write_priv(Config, "transport", {LRef, CRef}).
+
+remove_transports(Config) ->
+ {LRef, CRef} = ?util:read_priv(Config, "transport"),
+ ?util:disconnect(?CLIENT, CRef, ?SERVER, LRef).
+
+stop_services(_Config) ->
+ ok = diameter:stop_service(?CLIENT),
+ ok = diameter:stop_service(?SERVER).
+
+stop(_Config) ->
+ ok = diameter:stop().
%% ===========================================================================
@@ -532,21 +522,6 @@ send_anything(Config) ->
#diameter_base_STA{'Result-Code' = ?SUCCESS}
= call(Config, anything).
-%% Remove the client transport and expect the server transport to
-%% go down.
-remove_transports(Config) ->
- {LRef, CRef} = proplists:get_value(transports, Config),
- true = diameter:subscribe(?SERVER),
- ok = diameter:remove_transport(?CLIENT, CRef),
- {down, LRef, _, _}
- = receive #diameter_event{service = ?SERVER, info = I} -> I
- after 2000 -> false
- end.
-
-stop_services(_Config) ->
- {ok, ok} = {diameter:stop_service(?CLIENT),
- diameter:stop_service(?SERVER)}.
-
%% ===========================================================================
call(Config, Req) ->
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
index d545859fe8..a9520ef5bd 100644
--- a/lib/diameter/test/diameter_transport_SUITE.erl
+++ b/lib/diameter/test/diameter_transport_SUITE.erl
@@ -33,10 +33,12 @@
end_per_suite/1]).
%% testcases
--export([tcp_accept/1,
+-export([start/1,
+ tcp_accept/1,
tcp_connect/1,
sctp_accept/1,
- sctp_connect/1]).
+ sctp_connect/1,
+ stop/1]).
-export([accept/1,
connect/1,
@@ -67,16 +69,6 @@
= #diameter_caps{host_ip_address
= Addrs}}).
-%% The term diameter_tcp/sctp registers after opening a listening
-%% socket. This is an implementation detail that should probably be
-%% replaced by some documented way of getting at the port number of
-%% the listening socket, which is what we're after since we specify
-%% port 0 to get something unused.
--define(TCP_LISTENER(Ref, Addr, LSock),
- {diameter_tcp, listener, {Ref, {Addr, LSock}}}).
--define(SCTP_LISTENER(Ref, Addr, LSock),
- {diameter_sctp, listener, {Ref, {[Addr], LSock}}}).
-
%% The term we register after open a listening port with gen_tcp.
-define(TEST_LISTENER(Ref, PortNr),
{?MODULE, listen, Ref, PortNr}).
@@ -101,7 +93,7 @@ suite() ->
[{timetrap, {minutes, 2}}].
all() ->
- [{group, all} | tc()].
+ [start | tc()] ++ [{group, all}, stop].
groups() ->
[{all, [parallel], tc()}].
@@ -119,10 +111,17 @@ end_per_group(_, _) ->
ok.
init_per_suite(Config) ->
- ok = diameter:start(),
[{sctp, have_sctp()} | Config].
end_per_suite(_Config) ->
+ ok.
+
+%% ===========================================================================
+
+start(_Config) ->
+ ok = diameter:start().
+
+stop(_Config) ->
ok = diameter:stop().
%% ===========================================================================
@@ -180,7 +179,9 @@ have_sctp() ->
try gen_sctp:open() of
{ok, Sock} ->
gen_sctp:close(Sock),
- true
+ true;
+ {error, eprotonosupport} -> %% fail on any other reason
+ false
catch
error: badarg ->
false
@@ -216,7 +217,7 @@ init(accept, {Prot, Ref}) ->
init(gen_connect, {Prot, Ref}) ->
%% Lookup the peer's listening socket.
- {ok, PortNr} = inet:port(lsock(Prot, Ref)),
+ [PortNr] = ?util:lport(Prot, Ref, 20),
%% Connect, send a message and receive it back.
{ok, Sock} = gen_connect(Prot, PortNr, Ref),
@@ -253,22 +254,16 @@ init(connect, {Prot, Ref}) ->
MRef = erlang:monitor(process, TPid),
?RECV({'DOWN', MRef, process, _, _}).
-lsock(sctp, Ref) ->
- [{?SCTP_LISTENER(_ , _, LSock), _}]
- = match(?SCTP_LISTENER(Ref, ?ADDR, '_')),
- LSock;
-lsock(tcp, Ref) ->
- [{?TCP_LISTENER(_ , _, LSock), _}]
- = match(?TCP_LISTENER(Ref, ?ADDR, '_')),
- LSock.
-
match(Pat) ->
- case diameter_reg:match(Pat) of
- [] ->
+ match(Pat, 20).
+
+match(Pat, T) ->
+ L = diameter_reg:match(Pat),
+ if [] /= L orelse 1 == T ->
+ L;
+ true ->
?WAIT(50),
- match(Pat);
- L ->
- L
+ match(Pat, T-1)
end.
bin(sctp, #diameter_packet{bin = Bin}) ->
@@ -332,7 +327,7 @@ start_accept(Prot, Ref) ->
%% Configure the same port number for transports on the same
%% reference.
- PortNr = portnr(Prot, Ref),
+ [PortNr | _] = ?util:lport(Prot, Ref) ++ [0],
{Mod, Opts} = tmod(Prot),
try
@@ -362,23 +357,6 @@ tmod(sctp) ->
tmod(tcp) ->
{diameter_tcp, []}.
-portnr(sctp, Ref) ->
- case diameter_reg:match(?SCTP_LISTENER(Ref, ?ADDR, '_')) of
- [{?SCTP_LISTENER(_, _, LSock), _}] ->
- {ok, N} = inet:port(LSock),
- N;
- [] ->
- 0
- end;
-portnr(tcp, Ref) ->
- case diameter_reg:match(?TCP_LISTENER(Ref, ?ADDR, '_')) of
- [{?TCP_LISTENER(_, _, LSock), _}] ->
- {ok, N} = inet:port(LSock),
- N;
- [] ->
- 0
- end.
-
%% ===========================================================================
%% gen_connect/3
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
index 99f4fa1977..3fe8ea5363 100644
--- a/lib/diameter/test/diameter_util.erl
+++ b/lib/diameter/test/diameter_util.erl
@@ -23,15 +23,28 @@
%% Utility functions.
%%
+%% generic
-export([consult/2,
run/1,
fold/3,
foldl/3,
- scramble/1,
- ps/0]).
+ scramble/1]).
+
+%% diameter-specific
+-export([lport/2,
+ lport/3,
+ listen/2,
+ connect/3,
+ disconnect/4]).
+
+%% common_test-specific
+-export([write_priv/3,
+ read_priv/2,
+ map_priv/3]).
-define(L, atom_to_list).
+%% ---------------------------------------------------------------------------
%% consult/2
%%
%% Extract info from the app/appup file (presumably) of the named
@@ -56,6 +69,7 @@ consult(Path) ->
%% Name/Path in the return value distinguish the errors and allow for
%% a useful badmatch.
+%% ---------------------------------------------------------------------------
%% run/1
%%
%% Evaluate functions in parallel and return a list of those that
@@ -71,6 +85,7 @@ cons(true, _, _, Acc) ->
cons(false, F, RC, Acc) ->
[{F, RC} | Acc].
+%% ---------------------------------------------------------------------------
%% fold/3
%%
%% Parallel fold. Results are folded in the order received.
@@ -116,6 +131,7 @@ down(MRef) ->
down() ->
receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end.
+%% ---------------------------------------------------------------------------
%% foldl/3
%%
%% Parallel fold. Results are folded in order of the function list.
@@ -131,6 +147,7 @@ recvl([{MRef, F} | L], Ref, Fun, Acc) ->
R = down(MRef),
recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)).
+%% ---------------------------------------------------------------------------
%% scramble/1
%%
%% Sort a list into random order.
@@ -150,12 +167,10 @@ s(Acc, L) ->
{H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L),
s([T|Acc], H ++ Rest).
-%% ps/0
-
-ps() ->
- [{P, process_info(P)} || P <- erlang:processes()].
-
+%% ---------------------------------------------------------------------------
%% eval/1
+%%
+%% Evaluate a function in one of a number of forms.
eval({M,[F|A]})
when is_atom(F) ->
@@ -175,3 +190,127 @@ eval(L)
eval(F)
when is_function(F,0) ->
F().
+
+%% ---------------------------------------------------------------------------
+%% write_priv/3
+%%
+%% Write an arbitrary term to a named file.
+
+write_priv(Config, Name, Term) ->
+ write(path(Config, Name), Term).
+
+write(Path, Term) ->
+ ok = file:write_file(Path, term_to_binary(Term)).
+
+%% read_priv/2
+%%
+%% Read a term from a file.
+
+read_priv(Config, Name) ->
+ read(path(Config, Name)).
+
+read(Path) ->
+ {ok, Bin} = file:read_file(Path),
+ binary_to_term(Bin).
+
+%% map_priv/3
+%%
+%% Modify a term in a file and return both old and new values.
+
+map_priv(Config, Name, Fun1) ->
+ map(path(Config, Name), Fun1).
+
+map(Path, Fun1) ->
+ T0 = read(Path),
+ T1 = Fun1(T0),
+ write(Path, T1),
+ {T0, T1}.
+
+path(Config, Name)
+ when is_atom(Name) ->
+ path(Config, ?L(Name));
+path(Config, Name) ->
+ Dir = proplists:get_value(priv_dir, Config),
+ filename:join([Dir, Name]).
+
+%% ---------------------------------------------------------------------------
+%% lport/2-3
+%%
+%% Lookup the port number of a tcp/sctp listening transport.
+
+lport(M, Ref) ->
+ lport(M, Ref, 1).
+
+lport(M, Ref, Tries) ->
+ lp(tmod(M), Ref, Tries).
+
+lp(M, Ref, T) ->
+ L = [N || {listen, N, _} <- M:ports(Ref)],
+ if [] /= L orelse T =< 1 ->
+ L;
+ true ->
+ receive after 50 -> ok end,
+ lp(M, Ref, T-1)
+ end.
+
+%% ---------------------------------------------------------------------------
+%% listen/2
+%%
+%% Add a listening transport on the loopback address and a free port.
+
+listen(SvcName, Prot) ->
+ add_transport(SvcName, {listen, opts(Prot, listen)}).
+
+%% ---------------------------------------------------------------------------
+%% connect/3
+%%
+%% Add a connecting transport on and connect to a listening transport
+%% with the specified reference.
+
+connect(Client, Prot, LRef) ->
+ [PortNr] = lport(Prot, LRef, 20),
+ Ref = add_transport(Client, {connect, opts(Prot, PortNr)}),
+ true = diameter:subscribe(Client),
+ ok = receive
+ {diameter_event, Client, {up, Ref, _, _, _}} -> ok
+ after 2000 ->
+ {Client, Prot, PortNr, process_info(self(), messages)}
+ end,
+ Ref.
+
+%% ---------------------------------------------------------------------------
+%% disconnect/4
+%%
+%% Remove the client transport and expect the server transport to go
+%% down.
+
+disconnect(Client, Ref, Server, LRef) ->
+ true = diameter:subscribe(Server),
+ ok = diameter:remove_transport(Client, Ref),
+ ok = receive
+ {diameter_event, Server, {down, LRef, _, _}} -> ok
+ after 2000 ->
+ {Client, Ref, Server, LRef, process_info(self(), messages)}
+ end.
+
+%% ---------------------------------------------------------------------------
+
+-define(ADDR, {127,0,0,1}).
+
+add_transport(SvcName, T) ->
+ {ok, Ref} = diameter:add_transport(SvcName, T),
+ Ref.
+
+tmod(tcp) ->
+ diameter_tcp;
+tmod(sctp) ->
+ diameter_sctp.
+
+opts(Prot, T) ->
+ [{transport_module, tmod(Prot)},
+ {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}].
+
+opts(listen) ->
+ [];
+opts(PortNr) ->
+ [{raddr, ?ADDR}, {rport, PortNr}].
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index c6f709dc36..531aca2799 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -34,7 +34,9 @@ MODULES = \
diameter_watchdog_SUITE \
diameter_transport_SUITE \
diameter_traffic_SUITE \
- diameter_relay_SUITE
+ diameter_relay_SUITE \
+ diameter_tls_SUITE \
+ diameter_failover_SUITE
INTERNAL_HRL_FILES = \
diameter_ct.hrl
diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl
index 1df96caa36..0aca74bc97 100644
--- a/lib/erl_docgen/priv/xsl/db_man.xsl
+++ b/lib/erl_docgen/priv/xsl/db_man.xsl
@@ -137,8 +137,9 @@
(there is no spec with more than one clause) -->
<xsl:if test="count($clause/guard) > 0 or count($type) > 0">
<xsl:text>&#10;.RS</xsl:text>
- <xsl:text>&#10;.TP 3</xsl:text>
+ <xsl:text>&#10;.LP</xsl:text>
<xsl:text>&#10;Types:&#10;</xsl:text>
+ <xsl:text>&#10;.RS 3</xsl:text>
<xsl:choose>
<xsl:when test="$output_subtypes">
@@ -164,6 +165,8 @@
<xsl:with-param name="type_desc" select="$type_desc"/>
<xsl:with-param name="local_types" select="$local_types"/>
</xsl:call-template>
+ <xsl:text>&#10;.RE</xsl:text>
+
<xsl:text>&#10;.RE</xsl:text>
</xsl:if>
@@ -257,8 +260,8 @@
<!-- Similar to <d> -->
<xsl:template match="type_desc">
- <xsl:text>&#10;</xsl:text><xsl:apply-templates/>
- <xsl:text>&#10;.br</xsl:text>
+ <xsl:text>&#10;.RS 2&#10;</xsl:text><xsl:apply-templates/>
+ <xsl:text>&#10;.RE</xsl:text>
</xsl:template>
<!-- Datatypes -->
@@ -757,24 +760,26 @@
<!-- The case where @name != 0 is taken care of in "type_name" -->
<xsl:if test="string-length(@name) = 0 and string-length(@variable) = 0">
<xsl:text>&#10;.RS</xsl:text>
- <xsl:text>&#10;.TP 3</xsl:text>
+ <xsl:text>&#10;.LP</xsl:text>
<xsl:text>&#10;Types:&#10;</xsl:text>
+ <xsl:text>&#10;.RS 3</xsl:text>
<xsl:apply-templates/>
<xsl:text>&#10;.RE</xsl:text>
+ <xsl:text>&#10;.RE</xsl:text>
</xsl:if>
</xsl:template>
<!-- V -->
<xsl:template match="v">
- <xsl:text>&#10;</xsl:text><xsl:value-of select="normalize-space(text())"/>
+ <xsl:text>&#10;</xsl:text><xsl:apply-templates/>
<xsl:text>&#10;.br</xsl:text>
</xsl:template>
<!-- D -->
<xsl:template match="d">
- <xsl:text>&#10;</xsl:text><xsl:apply-templates/>
- <xsl:text>&#10;.br</xsl:text>
+ <xsl:text>&#10;.RS 2&#10;</xsl:text><xsl:apply-templates/>
+ <xsl:text>&#10;.RE</xsl:text>
</xsl:template>
<!-- Desc -->
diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml
index de519d5f84..ff289bd76c 100644
--- a/lib/ic/doc/src/notes.xml
+++ b/lib/ic/doc/src/notes.xml
@@ -31,6 +31,22 @@
</header>
<section>
+ <title>IC 4.2.28</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>
+ Incorrect use of ets:match changed to ets:match_object.</p>
+ <p>
+ Own Id: OTP-9630 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
<title>IC 4.2.27</title>
<section>
diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl
index 7f2216b9dc..beaa2852ab 100644
--- a/lib/ic/src/ic_pragma.erl
+++ b/lib/ic/src/ic_pragma.erl
@@ -1601,7 +1601,7 @@ remove_inheriters(S,RS,InheriterList) ->
ReducedInhList;
_Other ->
CleanList =
- ets:match(S, {inherits,'_','_'}),
+ ets:match_object(S, {inherits,'_','_'}),
% CodeOptList =
% [X || X <- EtsList, element(1,X) == codeopt],
NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList),
@@ -1648,7 +1648,7 @@ remove_inh([X],[Y],List,EtsList) ->
%%%----------------------------------------------
remove_inherited(S,InheriterList) ->
CleanList =
- ets:match(S, {inherits, '_', '_'}),
+ ets:match_object(S, {inherits, '_', '_'}),
remove_inherited(S,InheriterList,CleanList).
@@ -1766,7 +1766,7 @@ inherits2(_X,Y,Z,EtsList) ->
%% false otherwise
%%
is_inherited_by(Interface1,Interface2,PragmaTab) ->
- InheritsList = ets:match(PragmaTab, {inherits, '_', '_'}),
+ InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}),
inherits(Interface2,Interface1,InheritsList).
diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk
index 6561ccd2a7..703c8d29eb 100644
--- a/lib/ic/vsn.mk
+++ b/lib/ic/vsn.mk
@@ -1 +1 @@
-IC_VSN = 4.2.27
+IC_VSN = 4.2.28
diff --git a/lib/inets/src/inets_app/inets_service.erl b/lib/inets/src/inets_app/inets_service.erl
index e9eb9892f2..f89dac195c 100644
--- a/lib/inets/src/inets_app/inets_service.erl
+++ b/lib/inets/src/inets_app/inets_service.erl
@@ -20,24 +20,20 @@
-module(inets_service).
--export([behaviour_info/1]).
-
-behaviour_info(callbacks) ->
- [{start_standalone, 1},
- {start_service, 1},
- {stop_service, 1},
- {services, 0},
- {service_info, 1}];
-behaviour_info(_) ->
- undefined.
-
%% Starts service stand-alone
%% start_standalone(Config) -> % {ok, Pid} | {error, Reason}
%% <service>:start_link(Config).
+-callback start_standalone(Config :: term()) ->
+ {ok, pid()} | {error, Reason :: term()}.
+
%% Starts service as part of inets
%% start_service(Config) -> % {ok, Pid} | {error, Reason}
%% <service_sup>:start_child(Config).
+
+-callback start_service(Config :: term()) ->
+ {ok, pid()} | {error, Reason :: term()}.
+
%% Stop service
%% stop_service(Pid) -> % ok | {error, Reason}
%% <service_sup>:stop_child(maybe_map_pid_to_other_ref(Pid)).
@@ -51,6 +47,9 @@ behaviour_info(_) ->
%% Error
%% end.
+-callback stop_service(Service :: term()) ->
+ ok | {error, Reason :: term()}.
+
%% Returns list of running services. Services started as stand alone
%% are not listed
%% services() -> % [{Service, Pid}]
@@ -59,7 +58,12 @@ behaviour_info(_) ->
%% [{httpc, Pid} || {_, Pid, _, _} <-
%% supervisor:which_children(httpc_profile_sup)].
+-callback services() ->
+ [{Service :: term(), pid()}].
-%% service_info() -> [{Property, Value}] | {error, Reason}
+%% service_info() -> {ok, [{Property, Value}]} | {error, Reason}
%% ex: httpc:service_info() -> [{profile, ProfileName}]
%% httpd:service_info() -> [{host, Host}, {port, Port}]
+
+-callback service_info(Service :: term()) ->
+ {ok, [{Property :: term(), Value :: term()}]} | {error, Reason :: term()}.
diff --git a/lib/inets/src/tftp/tftp.erl b/lib/inets/src/tftp/tftp.erl
index bfdb4c0030..b33c0a98f4 100644
--- a/lib/inets/src/tftp/tftp.erl
+++ b/lib/inets/src/tftp/tftp.erl
@@ -215,8 +215,6 @@
start/0
]).
--export([behaviour_info/1]).
-
%% Application local functions
-export([
start_standalone/1,
@@ -227,13 +225,50 @@
]).
-behaviour_info(callbacks) ->
- [{prepare, 6}, {open, 6}, {read, 1}, {write, 2}, {abort, 3}];
-behaviour_info(_) ->
- undefined.
+-type peer() :: {PeerType :: inet | inet6,
+ PeerHost :: inet:ip_address(),
+ PeerPort :: port()}.
+
+-type access() :: read | write.
+
+-type options() :: [{Key :: string(), Value :: string()}].
+
+-type error_code() :: undef | enoent | eacces | enospc |
+ badop | eexist | baduser | badopt |
+ integer().
+
+-callback prepare(Peer :: peer(),
+ Access :: access(),
+ Filename :: file:name(),
+ Mode :: string(),
+ SuggestedOptions :: options(),
+ InitialState :: [] | [{root_dir, string()}]) ->
+ {ok, AcceptedOptions :: options(), NewState :: term()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback open(Peer :: peer(),
+ Access :: access(),
+ Filename :: file:name(),
+ Mode :: string(),
+ SuggestedOptions :: options(),
+ State :: [] | [{root_dir, string()}] | term()) ->
+ {ok, AcceptedOptions :: options(), NewState :: term()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback read(State :: term()) -> {more, binary(), NewState :: term()} |
+ {last, binary(), integer()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback write(binary(), State :: term()) ->
+ {more, NewState :: term()} |
+ {last, FileSize :: integer()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'.
-include("tftp.hrl").
+
%%-------------------------------------------------------------------
%% read_file(RemoteFilename, LocalFilename, Options) ->
%% {ok, LastCallbackState} | {error, Reason}
diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl
index fa3a4c3d36..caac4d926c 100644
--- a/lib/kernel/src/application.erl
+++ b/lib/kernel/src/application.erl
@@ -28,8 +28,6 @@
-export([get_application/0, get_application/1, info/0]).
-export([start_type/0]).
--export([behaviour_info/1]).
-
%%%-----------------------------------------------------------------
-type start_type() :: 'normal'
@@ -59,12 +57,12 @@
%%------------------------------------------------------------------
--spec behaviour_info(atom()) -> 'undefined' | [{atom(), byte()}].
+-callback start(StartType :: normal | {takeover, node()} | {failover, node()},
+ StartArgs :: term()) ->
+ {ok, pid()} | {ok, pid(), State :: term()} | {error, Reason :: term}.
-behaviour_info(callbacks) ->
- [{start,2},{stop,1}];
-behaviour_info(_Other) ->
- undefined.
+-callback stop(State :: term()) ->
+ term().
%%%-----------------------------------------------------------------
%%% This module is API towards application_controller and
diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl
index 9b8d2db437..d6bc23be6d 100644
--- a/lib/kernel/src/disk_log.erl
+++ b/lib/kernel/src/disk_log.erl
@@ -1240,20 +1240,29 @@ is_owner(Pid, L) ->
%% ok | throw(Error)
rename_file(File, NewFile, halt) ->
- file:rename(File, NewFile);
+ case file:rename(File, NewFile) of
+ ok ->
+ ok;
+ Else ->
+ file_error(NewFile, Else)
+ end;
rename_file(File, NewFile, wrap) ->
rename_file(wrap_file_extensions(File), File, NewFile, ok).
-rename_file([Ext|Exts], File, NewFile, Res) ->
- NRes = case file:rename(add_ext(File, Ext), add_ext(NewFile, Ext)) of
+rename_file([Ext|Exts], File, NewFile0, Res) ->
+ NewFile = add_ext(NewFile0, Ext),
+ NRes = case file:rename(add_ext(File, Ext), NewFile) of
ok ->
Res;
Else ->
- Else
+ file_error(NewFile, Else)
end,
- rename_file(Exts, File, NewFile, NRes);
+ rename_file(Exts, File, NewFile0, NRes);
rename_file([], _File, _NewFiles, Res) -> Res.
+file_error(FileName, {error, Error}) ->
+ {error, {file_error, FileName, Error}}.
+
%% "Old" error messages have been kept, arg_mismatch has been added.
%%-spec compare_arg(dlog_options(), #arg{},
compare_arg([], _A, none, _OrigHead) ->
@@ -1947,7 +1956,8 @@ monitor_request(Pid, Req) ->
receive
{'DOWN', Ref, process, Pid, _Info} ->
{error, no_such_log};
- {disk_log, Pid, Reply} ->
+ {disk_log, Pid, Reply} when not is_tuple(Reply) orelse
+ element(2, Reply) =/= disk_log_stopped ->
erlang:demonitor(Ref),
receive
{'DOWN', Ref, process, Pid, _Reason} ->
diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl
index ee1e2319b5..ad987fe7a7 100644
--- a/lib/kernel/test/disk_log_SUITE.erl
+++ b/lib/kernel/test/disk_log_SUITE.erl
@@ -1831,11 +1831,16 @@ block_queue2(Conf) when is_list(Conf) ->
%% Asynchronous stuff is ignored.
?line ok = disk_log:balog_terms(n, [<<"foo">>,<<"bar">>]),
?line ok = disk_log:balog_terms(n, [<<"more">>,<<"terms">>]),
+ Parent = self(),
?line Fun =
- fun() -> {error,disk_log_stopped} = disk_log:sync(n)
+ fun() ->
+ {error,no_such_log} = disk_log:sync(n),
+ receive {disk_log, _, {error, disk_log_stopped}} -> ok end,
+ Parent ! disk_log_stopped_ok
end,
?line spawn(Fun),
?line ok = sync_do(Pid, close),
+ ?line receive disk_log_stopped_ok -> ok end,
?line sync_do(Pid, terminate),
?line {ok,<<>>} = file:read_file(File ++ ".1"),
?line del(File, No),
@@ -2708,7 +2713,7 @@ error_log(Conf) when is_list(Conf) ->
% reopen (rename) fails, the log is terminated, ./File.2/ exists
?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
{format, external},{size, 100000}]),
- ?line {error, eisdir} = disk_log:reopen(n, LDir),
+ ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, LDir),
?line true = (P0 == pps()),
?line file:delete(File),
@@ -2719,7 +2724,7 @@ error_log(Conf) when is_list(Conf) ->
?line {ok, n} = disk_log:open([{name, n}, {file, File2}, {type, wrap},
{format, external},{size, {100, No}}]),
?line ok = disk_log:blog_terms(n, [B,B,B]),
- ?line {error, eisdir} = disk_log:reopen(n, File),
+ ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, File),
?line {error, no_such_log} = disk_log:close(n),
?line del(File2, No),
?line del(File, No),
diff --git a/lib/ssl/Makefile b/lib/ssl/Makefile
index daad7dc3e6..a7a95004a6 100644
--- a/lib/ssl/Makefile
+++ b/lib/ssl/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
@@ -25,7 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# Macros
#
-SUB_DIRECTORIES = src c_src doc/src examples/certs examples/src
+SUB_DIRECTORIES = src doc/src examples/certs examples/src
include vsn.mk
VSN = $(SSL_VSN)
diff --git a/lib/ssl/c_src/Makefile.dist b/lib/ssl/c_src/Makefile.dist
deleted file mode 100644
index 2468468921..0000000000
--- a/lib/ssl/c_src/Makefile.dist
+++ /dev/null
@@ -1,33 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2009. 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%
-#
-
-# Makefile for SSL on Unix
-#
-# Placed in obj directory.
-#
-CC = gcc
-
-BINDIR = %BINDIR%
-LIBS = %LIBS%
-SSL_LIBDIR = %SSL_LIBDIR%
-OBJS = %OBJS%
-
-$(BINDIR)/ssl_esock: $(OBJS)
- $(CC) -L$(SSL_LIBDIR) -Wl,-R$(SSL_LIBDIR) -o $@ $^ \
- $(LIBS) -lssl -lcrypto
diff --git a/lib/ssl/c_src/Makefile.in b/lib/ssl/c_src/Makefile.in
deleted file mode 100644
index a894e6dcd7..0000000000
--- a/lib/ssl/c_src/Makefile.in
+++ /dev/null
@@ -1,211 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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
-# 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%
-#
-
-#
-# Makefile only for Unix and Win32/Cygwin.
-#
-
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-# ----------------------------------------------------
-# SSL locations and include options from configure
-# ----------------------------------------------------
-SSL_LIBDIR = @SSL_LIBDIR@
-SSL_INCLUDE = @SSL_INCLUDE@
-SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@
-SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(SSL_VSN)
-
-# ----------------------------------------------------
-# Commands
-# ----------------------------------------------------
-CC = @CC@
-LD = @LD@
-SHELL = /bin/sh
-LIBS = @LIBS@
-PLAIN_CFLAGS = @CFLAGS@
-
-# ----------------------------------------------------
-# Includes and libs
-# ----------------------------------------------------
-
-ALL_CFLAGS = @WFLAGS@ @CFLAGS@ @DEFS@ $(TYPE_FLAGS)
-TARGET = @host@
-
-ifeq ($(TYPE),debug)
-TYPEMARKER = .debug
-TYPE_FLAGS = -g -DDEBUG @DEBUG_FLAGS@
-else
-TYPEMARKER =
-TYPE_FLAGS = -O2
-endif
-
-PRIVDIR = ../priv
-BINDIR = $(PRIVDIR)/bin/$(TARGET)
-OBJDIR = $(PRIVDIR)/obj/$(TARGET)
-
-# ----------------------------------------------------
-# File suffixes
-# ----------------------------------------------------
-exe = @EXEEXT@
-obj = .@OBJEXT@
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-OBJS = $(OBJDIR)/esock$(obj) \
- $(OBJDIR)/debuglog$(obj) \
- $(OBJDIR)/esock_poll$(obj) \
- $(OBJDIR)/esock_osio$(obj) \
- $(OBJDIR)/esock_utils$(obj) \
- $(OBJDIR)/esock_posix_str$(obj) \
- $(OBJDIR)/esock_openssl$(obj)
-
-PORT_PROGRAM = $(BINDIR)/ssl_esock$(exe)
-
-SKIP_BUILDING_BINARIES := false
-
-# Try to be BC for R10
-ifeq ($(findstring @SSL_,@SSL_DYNAMIC_ONLY@),@SSL_)
-DYNAMIC_CRYPTO_LIB=yes
-else
-DYNAMIC_CRYPTO_LIB=@SSL_DYNAMIC_ONLY@
-endif
-
-
-ifeq ($(DYNAMIC_CRYPTO_LIB),yes)
-
-ifneq ($(findstring win32,$(TARGET)),win32)
-SSL_MAKEFILE = $(OBJDIR)/Makefile
-else
-SSL_MAKEFILE =
-endif
-
-CC_R_FLAG=@CFLAG_RUNTIME_LIBRARY_PATH@
-
-ifeq ($(findstring @,$(CC_R_FLAG)),@)
-# Old erts configure used which hasn't replaced @CFLAG_RUNTIME_LIBRARY_PATH@;
-# we try our best here instead...
-
-ifeq ($(findstring darwin,$(TARGET)),darwin) # darwin: no flag
-CC_R_FLAG =
-else
-ifeq ($(findstring osf,$(TARGET)),osf) # osf1: -Wl,-rpath,
-CC_R_FLAG = -Wl,-rpath,
-else # Default: -Wl,-R
-CC_R_FLAG = -Wl,-R
-endif
-endif
-endif
-
-ifeq ($(strip $(CC_R_FLAG)),)
-CC_R_OPT =
-else
-CC_R_OPT = $(CC_R_FLAG)$(SSL_LIBDIR)
-endif
-
-SSL_CC_RUNTIME_LIBRARY_PATH=@SSL_CC_RUNTIME_LIBRARY_PATH@
-# Sigh...
-ifeq ($(findstring @,$(SSL_CC_RUNTIME_LIBRARY_PATH)),@)
-SSL_CC_RUNTIME_LIBRARY_PATH = $(CC_R_OPT)
-endif
-
-SSL_LINK_LIB=-L$(SSL_LIBDIR) -l$(SSL_SSL_LIBNAME) -l$(SSL_CRYPTO_LIBNAME)
-else
-# not dynamic crypto lib (default from R11B-5)
-NEED_KERBEROS=@SSL_LINK_WITH_KERBEROS@
-NEED_ZLIB=@SSL_LINK_WITH_ZLIB@
-SSL_MAKEFILE =
-CC_R_OPT =
-SSL_CC_RUNTIME_LIBRARY_PATH=
-SSL_LINK_LIB = $(SSL_LIBDIR)/lib$(SSL_SSL_LIBNAME).a $(SSL_LIBDIR)/lib$(SSL_CRYPTO_LIBNAME).a
-ifeq ($(NEED_KERBEROS),yes)
-SSL_LINK_LIB += @STATIC_KERBEROS_LIBS@
-endif
-ifeq ($(NEED_ZLIB),yes)
-SSL_LINK_LIB += @STATIC_ZLIB_LIBS@
-endif
-endif
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-_create_dirs := $(shell mkdir -p $(OBJDIR) $(BINDIR))
-
-debug opt: $(OBJS) $(PORT_PROGRAM) $(SSL_MAKEFILE)
-
-$(OBJDIR)/esock_openssl$(obj): esock_openssl.c
- $(CC) -c -o $@ $(ALL_CFLAGS) $(SSL_INCLUDE) $<
-
-$(OBJDIR)/%$(obj): %.c
- $(CC) -c -o $@ $(ALL_CFLAGS) $<
-
-# Unix
-$(BINDIR)/ssl_esock: $(OBJS)
- $(CC) $(PLAIN_CFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) $(SSL_CC_RUNTIME_LIBRARY_PATH) $(SSL_LINK_LIB)
-
-# Win32/Cygwin
-$(BINDIR)/ssl_esock.exe: $(OBJS)
- $(LD) $(SSL_CC_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -o $@ $^ -lwsock32 -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME)
-
-# Unix only, and only when linking statically
-$(SSL_MAKEFILE):
- sed -e "s;%BINDIR%;../../bin/$(TARGET);" \
- -e "s;%SSL_LIBDIR%;$(SSL_LIBDIR);" \
- -e "s;%OBJS;$(OBJS);" \
- -e "s;%LIBS%;$(LIBS);" ./Makefile.dist \
- > $(OBJDIR)/Makefile
-
-
-clean:
- rm -f $(PORT_PROGRAM) $(OBJS) core *~ $(SSL_MAKEFILE)
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) $(RELSYSDIR)/priv/bin
- $(INSTALL_PROGRAM) $(PORT_PROGRAM) $(RELSYSDIR)/priv/bin
-ifneq ($(SSL_MAKEFILE),)
- $(INSTALL_DIR) $(RELSYSDIR)/priv/obj
- $(INSTALL_DATA) $(OBJS) $(RELSYSDIR)/priv/obj
- sed -e "s;%BINDIR%;../bin;" \
- -e "s;%SSL_LIBDIR%;$(SSL_LIBDIR);" \
- -e "s;%OBJS;$(OBJS);" \
- -e "s;%LIBS%;$(LIBS);" ./Makefile.dist \
- > $(RELSYSDIR)/priv/obj/Makefile
-endif
-
-release_docs_spec:
-
diff --git a/lib/ssl/c_src/Makefile.win32 b/lib/ssl/c_src/Makefile.win32
deleted file mode 100644
index 668cd2a28d..0000000000
--- a/lib/ssl/c_src/Makefile.win32
+++ /dev/null
@@ -1,147 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2009. 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%
-#
-
-#
-# SSL - Makefile for Windows NT
-#
-# It is assumed that the following environment variables have been set:
-#
-# INCLUDE X:\MSDEV\INCLUDE
-# LIB X:\MSDEV\LIB
-#
-# so that standard include files, and the socket library can be found.
-#
-# When ssl_esock.exe is run, the PATH environment variable must contain
-# the name of a directory that contains ssleay32.dll and libeay32.dll,
-# and windows socket dll.
-#
-
-# Roots
-!ifndef OPENSSL_ROOT
-! error "Makefile.win32: ssl: OPENSSL_ROOT not set"
-!endif
-
-TARGET = win32
-
-BINDIR = ..\priv\bin\$(TARGET)
-OBJDIR = ..\priv\obj\$(TARGET)
-
-!if !exist($(BINDIR))
-! if [mkdir $(BINDIR)]
-! error "SSL: cannot create BINDIR"
-! endif
-!endif
-
-!if !exist($(OBJDIR))
-! if [mkdir $(OBJDIR)]
-! error "SSL: cannot create OBJDIR"
-! endif
-!endif
-
-# Includes
-#
-OPENSSL_INCLUDE = $(OPENSSL_ROOT)\inc32
-
-INCLUDES = /I. /I$(OPENSSL_INCLUDE)
-
-# Libraries
-#
-OPENSSL_LIBDIR = $(OPENSSL_ROOT)\out32dll
-OPENSSL_LIBS = \
- $(OPENSSL_LIBDIR)\ssleay32.lib \
- $(OPENSSL_LIBDIR)\libeay32.lib
-
-!ifdef ESOCK_WINSOCK2
-WINSOCK_LIB = ws2_32.lib
-DEFS = -DESOCK_WINSOCK2
-!else
-WINSOCK_LIB = wsock32.lib
-!endif
-
-# Compiler options
-#
-# NOTE: Size of fd_set is set in esock_winsock.h but can be overridden
-# with a -D option here.
-#
-OPTS = /MDd /G5 /Ox /O2 /Ob2 /Z7
-DEFS = -D__WIN32__ -DWIN32 $(DEFS)
-CFLAGS = $(INCLUDES) /nologo $(OPTS) $(DEFS)
-
-# Object files
-#
-SSL_BASE_OBJS = \
- $(OBJDIR)\esock.obj \
- $(OBJDIR)\debuglog.obj \
- $(OBJDIR)\esock_poll$(obj) \
- $(OBJDIR)\esock_osio.obj \
- $(OBJDIR)\esock_utils.obj \
- $(OBJDIR)\esock_posix_str.obj
-
-OPENSSL_OBJS = \
- $(OBJDIR)\esock_openssl.obj
-
-#
-# Targets
-#
-
-all: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(BINDIR)\ssl_esock.exe
-
-clean:
- del $(BINDIR)\*.exe
- del $(OBJDIR)\*.obj
-
-# Inference rule .c.obj:
-#
-{.}.c{$(OBJDIR)}.obj:
- $(CC) $(CFLAGS) /c /Fo$@ $(*B).c
-
-# Binary
-#
-$(BINDIR)\ssl_esock.exe: $(SSL_BASE_OBJS) $(OPENSSL_OBJS)
- $(CC) /nologo $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(OPENSSL_LIBS) \
- $(WINSOCK_LIB) /Fe$(BINDIR)\ssl_esock.exe
-
-
-
-# Dependencies
-#
-$(OBJDIR)\esock.o: esock.h debuglog.h esock_ssl.h esock_osio.h \
- esock_utils.h esock_winsock.h
-$(OBJDIR)\debuglog.o: debuglog.h esock_ssl.h esock_utils.h
-$(OBJDIR)\esock_osio.o: esock_osio.h esock.h debuglog.h esock_utils.h \
- esock_winsock.h
-$(OBJDIR)\esock_utils.o: esock_utils.h
-$(OBJDIR)\esock_posix_str.o: esock_posix_str.h esock_winsock.h
-
-$(OBJDIR)\esock_openssl.o: esock.h esock_ssl.h debuglog.h esock_utils.h \
- $(OPENSSL_INCLUDE)\crypto.h \
- $(OPENSSL_INCLUDE)\ssl.h \
- $(OPENSSL_INCLUDE)\err.h
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ssl/c_src/Makefile.win32.dist b/lib/ssl/c_src/Makefile.win32.dist
deleted file mode 100644
index 8510c44e08..0000000000
--- a/lib/ssl/c_src/Makefile.win32.dist
+++ /dev/null
@@ -1,45 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2009. 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%
-#
-
-# Makefile.win32.dist for SSL
-#
-# To be placed in obj directory.
-#
-
-CC = cl
-
-BINDIR = %BINDIR%
-
-OPENSSL_LIBS = \
- $(BINDIR)\ssleay32.lib \
- $(BINDIR)\libeay32.lib
-
-WINSOCK_LIB = ws2_32.lib
-
-SSL_BASE_OBJS = esock.obj debuglog.obj esock_osio.obj esock_utils.obj \
- esock_posix_str.obj
-
-OPENSSL_OBJS = esock_openssl.obj
-
-$(BINDIR)\ssl_esock.exe: $(SSL_BASE_OBJS) $(OPENSSL_OBJS)
- $(CC) /nologo $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(OPENSSL_LIBS) \
- $(WINSOCK_LIB) /Fe$(BINDIR)\ssl_esock.exe
-
-
-
diff --git a/lib/ssl/c_src/debuglog.c b/lib/ssl/c_src/debuglog.c
deleted file mode 100644
index e2e55df4b2..0000000000
--- a/lib/ssl/c_src/debuglog.c
+++ /dev/null
@@ -1,251 +0,0 @@
-/*<copyright>
- * <year>1999-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Various routines for debug printouts and logs.
- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <string.h>
-#include <ctype.h>
-#include <time.h>
-#include "debuglog.h"
-#include "esock_utils.h"
-
-#ifndef __WIN32__
-static char tr_format_buf[256];
-static char *tr_format(const char *format);
-static int vfprintclistf(FILE *fp, const char *format, va_list args);
-#endif
-
-int debug = 0;
-int debugmsg = 0;
-FILE *ssllogfp = NULL;
-FILE *__locallogfp = NULL;
-
-void open_ssllog(char *path)
-{
- ssllogfp = openlog(path);
-}
-
-void close_ssllog(void)
-{
- if (ssllogfp)
- closelog(ssllogfp);
-}
-
-FILE *openlog(char *s)
-{
- FILE *fp;
- time_t t = time(NULL);
-
- if ((fp = fopen(s, "a"))) {
- setbuf(fp, NULL);
- fprintf(fp, "===== Opened [%s] %s", s, ctime(&t));
- }
- return fp;
-}
-
-void closelog(FILE *fp)
-{
- time_t t = time(NULL);
-
- if (fp) {
- fprintf(fp, "Closed %s", ctime(&t));
- fclose(fp);
- }
-}
-
-int __debugprintf(const char *format, ...)
-{
- va_list args;
- int ret;
-#ifndef __WIN32__
- char *newformat;
-
- va_start(args, format);
- newformat = tr_format(format);
- ret = vfprintf(stderr, newformat, args);
- if (newformat != format && newformat != tr_format_buf)
- esock_free(newformat);
-#else
- va_start(args, format);
- ret = vfprintf(stderr, format, args);
-#endif
- va_end(args);
- if (ssllogfp) {
- va_start(args, format);
- vfprintf(ssllogfp, format, args);
- va_end(args);
- }
- return ret;
-}
-
-int __debugprintclistf(const char *format, ...)
-{
- va_list args;
- int ret;
-#ifndef __WIN32__
- char *newformat;
-
- va_start(args, format);
- newformat = tr_format(format);
- ret = vfprintclistf(stderr, newformat, args);
- if (newformat != format && newformat != tr_format_buf)
- esock_free(newformat);
-#else
- va_start(args, format);
- ret = vfprintclistf(stderr, format, args);
-#endif
- if (ssllogfp)
- vfprintclistf(ssllogfp, format, args);
- va_end(args);
- return ret;
-}
-
-int __debuglogf(const char *format, ...)
-{
- va_list args;
- int ret;
-
- va_start(args, format);
- ret = vfprintf(__locallogfp, format, args);
- va_end(args);
- return ret;
-}
-
-#ifndef __WIN32__
-
-/* Insert `\r' before each `\n' i format */
-static char *tr_format(const char *format)
-{
- char *newformat, *s, *t;
- int len;
-
- len = strlen(format);
- if ((newformat = (len > 127) ? esock_malloc(len) : tr_format_buf)) {
- for (s = (char *)format, t = newformat; *s; *t++ = *s++)
- if (*s == '\n')
- *t++ = '\r';
- *t = '\0';
- } else
- newformat = (char *)format;
- return newformat;
-}
-
-#endif
-
-/* This function is for printing arrays of characters with formats
- * %FPa or %FPb, where F and P are the ordinary specifiers for
- * field width and precision, respectively.
- *
- * The conversion specifier `a' implies hex-string output, while
- * the `b' specifier provides character output (for non-printable
- * characters a `.' is written.
- *
- * The F specifier contains the width for each character. The
- * P specifier tells how many characters to print.
- *
- * Example: Suppose we have a function myprintf(char *format, ...)
- * that calls our vfprintclistf(), and that
- *
- * char buf[] = "h\r\n";
- * len = 3;
- *
- * Then
- *
- * myprintf("%.2b", buf) prints "h."
- * myprintf("%2.3b", buf) prints "h . . "
- * myprintf("%3.*a", len, buf) prints "68 0d 0a"
- *
- */
-
-static int vfprintclistf(FILE *fp, const char *format, va_list args)
-{
-
- int i, len, width, prec, written = 0;
- char *s, *prevs, *fstart;
- unsigned char *buf;
-
- if (!format || !*format)
- return 0;
-
- /* %{[0-9]*|\*}{.{[0-9]*|\*}{a|b} */
-
- prevs = (char *)format; /* format is const */
- s = strchr(format, '%');
- while (s && *s) {
- if (s - prevs > 0)
- written += fprintf(fp, "%.*s", s - prevs, prevs);
- width = prec = 0;
- fstart = s;
- s++;
- if (*s != '%') { /* otherwise it is not a format */
- if (*s == '*') { /* width in arg */
- s++;
- width = va_arg(args, int);
- } else if ((len = strspn(s, "0123456789"))) { /* const width */
- width = atoi(s);
- s += len;
- } else
- width = 0;
- if (*s == '.') { /* precision specified */
- s++;
- if (*s == '*') { /* precision in arg */
- s++;
- prec = va_arg(args, int);
- } else if ((len = strspn(s, "0123456789"))) { /* const prec */
- prec = atoi(s);
- s += len;
- } else /* no precision value, defaults to zero */
- prec = 0;
- } else
- prec = 0; /* no precision defaults to zero */
- if (*s == 'a' || *s == 'b') { /* only valid specifiers */
- buf = va_arg(args, unsigned char *);
- if (*s == 'a') {
- for (i = 0; i < prec; i++)
- written += fprintf(fp, "%*.2x", width, buf[i]);
- }else if (*s == 'b') {
- for (i = 0; i < prec; i++) {
- if (isprint(buf[i]))
- written += fprintf(fp, "%*c", width, buf[i]);
- else
- written += fprintf(fp, "%*c", width, '.');
- }
- }
- } else {
- fprintf(stderr, "fprintclistf: format \"%s\" invalid.\n",
- format);
- va_end(args);
- return written;
- }
- }
- s++;
- /* Now s points to the next character after the format */
- prevs = s;
- s = strchr(s, '%');
- }
- if (format + strlen(format) + 1 - prevs > 0)
- written += fprintf(fp, "%s", prevs);
- return written;
-}
-
diff --git a/lib/ssl/c_src/debuglog.h b/lib/ssl/c_src/debuglog.h
deleted file mode 100644
index 5699e6b495..0000000000
--- a/lib/ssl/c_src/debuglog.h
+++ /dev/null
@@ -1,50 +0,0 @@
-/*<copyright>
- * <year>1998-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Debug functions and macros.
- *
- */
-
-#ifndef __DEBUGLOG_H_
-#define __DEBUGLOG_H_
-
-#include <stdio.h>
-#include "esock_ssl.h"
-
-#define DEBUGF(x) if (debug) __debugprintf x;
-#define DEBUGMSGF(x) if (debugmsg) __debugprintclistf x;
-#define LOGF(fp, x) if (fp) { __locallogfp = fp; __debuglogf x; }
-#define SSLDEBUGF() if (debug) { esock_ssl_print_errors_fp(stderr); \
- if (ssllogfp) esock_ssl_print_errors_fp(ssllogfp); }
-
-int debug;
-int debugmsg;
-FILE *ssllogfp;
-FILE *__locallogfp;
-
-void open_ssllog(char *path);
-void close_ssllog(void);
-FILE *openlog(char *);
-void closelog(FILE *);
-int __debugprintf(const char *, ...);
-int __debugprintclistf(const char *, ...);
-int __debuglogf(const char *, ...);
-
-#endif
diff --git a/lib/ssl/c_src/esock.c b/lib/ssl/c_src/esock.c
deleted file mode 100644
index 78d08f7c29..0000000000
--- a/lib/ssl/c_src/esock.c
+++ /dev/null
@@ -1,1904 +0,0 @@
-/*<copyright>
- * <year>1999-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-
-/*
- * Purpose: Implementation of Secure Socket Layer (SSL).
- *
- * This is an "SSL proxy" for Erlang in the form of a port
- * program.
- *
- * The implementation has borrowed somewhat from the original
- * implementation of `socket' by Claes Wikstr�m, and the former
- * implementation of `ssl_socket' by Helen Ariyan.
- *
- * All I/O is now non-blocking.
- *
- * When a connection (cp) is in the state JOINED we have the following
- * picture:
- *
- * proxy->fd fd
- * | |
- * proxy->eof | --------> wq -----------> | bp
- * | |
- * Erlang | | SSL
- * | |
- * proxy->bp | <------ proxy->wq --------- | eof
- * | |
- *
- * We read from Erlang (proxy->fd) and write to SSL (fd); and read from
- * SSL (fd) and write to Erlang (proxy->fd).
- *
- * The variables bp (broken pipe) and eof (end of file) take the
- * values 0 and 1.
- *
- * What has been read and cannot be immediately written is put in a
- * write queue (wq). A wq is emptied before reads are continued, which
- * means that at most one chunk that is read can be in a wq.
- *
- * The proxy-to-ssl part of a cp is valid iff
- *
- * !bp && (wq.len > 0 || !proxy->eof).
- *
- * The ssl-to-proxy part of a cp is valid iff
- *
- * !proxy->bp && (proxy->wq.len > 0 || !eof).
- *
- * The connection is valid if any of the above parts are valid, i.e.
- * invalid if both parts are invalid.
- *
- * Every SELECT_TIMEOUT second we try to write to those file
- * descriptors that have non-empty wq's (the only way to detect that a
- * far end has gone away is to write to it).
- *
- * STATE TRANSITIONS
- *
- * Below (*) means that the corresponding file descriptor is published
- * (i.e. kwown outside this port program) when the state is entered,
- * and thus cannot be closed without synchronization with the
- * ssl_server.
- *
- * Listen:
- *
- * STATE_NONE ---> (*) PASSIVE_LISTENING <---> ACTIVE_LISTENING
- *
- * Accept:
- *
- * STATE_NONE ---> SSL_ACCEPT ---> (*) CONNECTED ---> JOINED --->
- * ---> SSL_SHUTDOWN ---> DEFUNCT
- *
- * Connect:
- *
- * STATE_NONE ---> (*) WAIT_CONNECT ---> SSL_CONNECT ---> CONNECTED --->
- * ---> JOINED ---> SSL_SHUTDOWN ---> DEFUNCT
- *
- * In states where file descriptors has been published, and where
- * something goes wrong, the state of the connection is set to
- * DEFUNCT. A connection in such a state can only be closed by a CLOSE
- * message from Erlang (a reception of such a message is registered in
- * cp->closed). The possible states are: WAIT_CONNECT, SSL_CONNECT,
- * CONNECTED, JOINED, and SSL_SHUTDOWN.
- *
- * A connection in state SSL_ACCEPT can be closed and removed without
- * synchronization.
- *
- */
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#ifdef __WIN32__
-#include "esock_winsock.h"
-#endif
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <time.h>
-#include <ctype.h>
-#include <sys/types.h>
-#include <errno.h>
-
-#ifdef __WIN32__
-#include <process.h>
-#else
-#include <unistd.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <netinet/tcp.h>
-#include <sys/time.h>
-#include <netdb.h>
-#include <arpa/inet.h>
-#include <fcntl.h>
-#endif
-
-#ifndef INADDR_NONE
-#define INADDR_NONE 0xffffffff /* Should be in <netinet/in.h>. */
-#endif
-
-#include "esock.h"
-#include "debuglog.h"
-#include "esock_utils.h"
-#include "esock_ssl.h"
-#include "esock_osio.h"
-#include "esock_posix_str.h"
-#include "esock_poll.h"
-
-#define MAJOR_VERSION 2
-#define MINOR_VERSION 0
-#define MAXREPLYBUF 256
-#define RWBUFLEN (32*1024)
-#define IS_CLIENT 0
-#define IS_SERVER 1
-#define SELECT_TIMEOUT 2 /* seconds */
-
-#define psx_errstr() esock_posix_str(sock_errno())
-#define ssl_errstr() esock_ssl_errstr
-
-#define PROXY_TO_SSL_VALID(cp) (!(cp)->bp && \
- ((cp)->wq.len > 0 || !(cp)->proxy->eof))
-
-#define SSL_TO_PROXY_VALID(cp) (!(cp)->proxy->bp && \
- ((cp)->proxy->wq.len > 0 || !(cp)->eof))
-
-#define JOINED_STATE_INVALID(cp) (!(PROXY_TO_SSL_VALID(cp)) && \
- !(SSL_TO_PROXY_VALID(cp)))
-static int loop(void);
-static int set_poll_conns(Connection *cp, EsockPoll *ep, int verbose);
-static Connection *next_polled_conn(Connection *cp, Connection **cpnext,
- EsockPoll *ep, int set_wq_fds);
-
-static void leave_joined_state(Connection *cp);
-static void do_shutdown(Connection *cp);
-static void close_and_remove_connection(Connection *cp);
-static int reply(int cmd, char *fmt, ...);
-static int input(char *fmt, ...);
-static int put_pars(unsigned char *buf, char *fmt, va_list args);
-static int get_pars(unsigned char *buf, char *fmt, va_list args);
-static FD do_connect(char *lipstring, int lport, char *fipstring, int fport);
-static FD do_listen(char *ipstring, int lport, int backlog, int *aport);
-static FD do_accept(FD listensock, struct sockaddr *saddr, int *len);
-static void print_connections(void);
-static void dump_connections(void);
-static int check_num_sock_fds(FD fd);
-static void safe_close(FD fd);
-static Connection *new_connection(int state, FD fd);
-static Connection *get_connection(FD fd);
-static void remove_connection(Connection *conn);
-static Proxy *get_proxy_by_peerport(int port);
-static Proxy *new_proxy(FD fd);
-static void remove_proxy(Proxy *proxy);
-static void ensure_write_queue(WriteQueue *wq, int size);
-static void clean_up(void);
-
-static Connection *connections = NULL;
-static int num_sock_fds; /* On UNIX all file descriptors */
-static Proxy *proxies = NULL;
-static int proxy_listensock = INVALID_FD;
-static int proxy_listenport = 0;
-static int proxy_backlog = 128;
-static int proxysock_last_err = 0;
-static int proxysock_err_cnt = 0;
-static char rwbuf[RWBUFLEN];
-static unsigned char *ebuf = NULL; /* Set by read_ctrl() */
-
-static char *connstr[] = {
- "STATE_NONE",
- "ACTIVE_LISTENING",
- "PASSIVE_LISTENING",
- "CONNECTED",
- "WAIT_CONNECT",
- "SSL_CONNECT",
- "SSL_ACCEPT",
- "TRANSPORT_ACCEPT",
- "JOINED",
- "SSL_SHUTDOWN",
- "DEFUNCT"
-};
-
-static char *originstr[] = {
- "listen",
- "accept",
- "connect"
-};
-
-int main(int argc, char **argv)
-{
- char *logfile = NULL;
- int i;
- esock_version *vsn;
- char *ciphers;
-#ifdef __WIN32__
- int pid;
- WORD version;
- WSADATA wsa_data;
-
- set_binary_mode();
- setvbuf(stderr, NULL, _IONBF, 0);
- /* Two sockets for the stdin socket pipe (local thread). */
- num_sock_fds = 2;
-#else
- pid_t pid;
- num_sock_fds = 3; /* 0, 1, 2 */
-#endif
-
- pid = getpid();
- i = 1;
- while (i < argc) {
- if (strcmp(argv[i], "-d") == 0) {
- debug = 1;
- i++;
- } else if (strcmp(argv[i], "-dm") == 0) {
- debugmsg = 1;
- i++;
- } else if (strcmp(argv[i], "-pp") == 0) {
- i++;
- proxy_listenport = atoi(argv[i]);
- i++;
- } else if (strcmp(argv[i], "-pb") == 0) {
- i++;
- proxy_backlog = atoi(argv[i]);
- i++;
- } else if (strcmp(argv[i], "-pv") == 0) {
- i++;
- protocol_version = atoi(argv[i]);
- i++;
- } else if (strcmp(argv[i], "-dd") == 0) {
- i++;
- logfile = esock_malloc(strlen(argv[i]) + 64);
- sprintf(logfile, "%s/ssl_esock.%d.log", argv[i], (int)pid);
- i++;
- } else if (strcmp(argv[i], "-ersa") == 0) {
- ephemeral_rsa = 1;
- i++;
- } else if (strcmp(argv[i], "-edh") == 0) {
- ephemeral_dh = 1;
- i++;
- }
- }
- if (debug || debugmsg) {
- DEBUGF(("Starting ssl_esock\n"));
- if (logfile) {
- open_ssllog(logfile);
-#ifndef __WIN32__
- num_sock_fds++;
-#endif
- }
- atexit(close_ssllog);
- DEBUGF(("pid = %d\n", getpid()));
- }
- if (esock_ssl_init() < 0) {
- fprintf(stderr, "esock: Could not do esock_ssl_init\n");
- exit(EXIT_FAILURE);
- }
-
- atexit(esock_ssl_finish);
-
-#ifdef __WIN32__
- /* Start Windows' sockets */
- version = MAKEWORD(MAJOR_VERSION, MINOR_VERSION);
- if (WSAStartup(version, &wsa_data) != 0) {
- fprintf(stderr, "esock: Could not start up Windows' sockets\n");
- exit(EXIT_FAILURE);
- }
- atexit((void (*)(void))WSACleanup);
- if (LOBYTE(wsa_data.wVersion) < MAJOR_VERSION ||
- (LOBYTE(wsa_data.wVersion) == MAJOR_VERSION &&
- HIBYTE(wsa_data.wVersion) < MINOR_VERSION)) {
- fprintf(stderr, "esock: Windows socket version error. "
- "Requested version:"
- "%d.%d, version found: %d.%d\n", MAJOR_VERSION,
- MINOR_VERSION, LOBYTE(wsa_data.wVersion),
- HIBYTE(wsa_data.wVersion));
- exit(EXIT_FAILURE);
- }
- DEBUGF(("Using Windows socket version: %d.%d\n",
- LOBYTE(wsa_data.wVersion), HIBYTE(wsa_data.wVersion)));
- DEBUGF(("Maximum number of sockets available: %d\n",
- wsa_data.iMaxSockets));
-
- if (esock_osio_init() < 0) {
- fprintf(stderr, "esock: Could not init osio\n");
- exit(EXIT_FAILURE);
- }
- atexit(esock_osio_finish);
-#endif
-
- /* Create the local proxy listen socket and set it to non-blocking */
- proxy_listensock = do_listen("127.0.0.1", proxy_listenport,
- proxy_backlog, &proxy_listenport);
- if (proxy_listensock == INVALID_FD) {
- fprintf(stderr, "esock: Cannot create local listen socket\n");
- exit(EXIT_FAILURE);
- }
- SET_NONBLOCKING(proxy_listensock);
- DEBUGF(("Local proxy listen socket: fd = %d, port = %d\n",
- proxy_listensock, proxy_listenport));
-
- vsn = esock_ssl_version();
- ciphers = esock_ssl_ciphers();
-
- /* Report: port number of the local proxy listen socket, the native
- * os pid, the compile and lib versions of the ssl library, and
- * the list of available ciphers. */
- reply(ESOCK_PROXY_PORT_REP, "24sss", proxy_listenport, (int)pid,
- vsn->compile_version, vsn->lib_version, ciphers);
-
- atexit(clean_up);
-
- loop();
-
- if (logfile)
- esock_free(logfile);
- exit(EXIT_SUCCESS);
-}
-
-
-/*
- * Local functions
- *
- */
-
-static int loop(void)
-{
- EsockPoll pollfd;
- FD fd, msgsock, listensock, connectsock, proxysock;
- int cc, wc, fport, lport, pport, length, backlog, intref, op;
- int value;
- char *lipstring, *fipstring;
- char *flags;
- char *protocol_vsn, *cipher;
- unsigned char *cert, *bin;
- int certlen, binlen;
- struct sockaddr_in iserv_addr;
- int sret = 1;
- Connection *cp, *cpnext, *newcp;
- Proxy *pp;
- time_t last_time = 0, now = 0;
- int set_wq_fds;
-
- esock_poll_init(&pollfd);
-
- while(1) {
- esock_poll_zero(&pollfd);
- esock_poll_fd_set_read(&pollfd, proxy_listensock);
- esock_poll_fd_set_read(&pollfd, local_read_fd);
-
- set_wq_fds = 0;
-
- if (sret) /* sret == 1 the first time. */
- DEBUGF(("==========LOOP=============\n"));
-
- cc = set_poll_conns(connections, &pollfd, sret) + 1;
-
- if (sret) {
- print_connections();
- DEBUGF(("Before poll/select: %d descriptor%s (total %d)\n",
- cc, (cc == 1) ? "" : "s", num_sock_fds));
- }
-
- sret = esock_poll(&pollfd, SELECT_TIMEOUT);
- if (sret < 0) {
- DEBUGF(("select/poll error: %s\n", psx_errstr()));
- continue;
- }
-
- time(&now);
- if (now >= last_time + SELECT_TIMEOUT) {
- set_wq_fds = 1;
- last_time = now;
- }
- /*
- * First accept as many connections as possible on the
- * proxy listen socket. We record the peer port, which
- * is later used as a reference for joining a proxy
- * connection with a network connection.
- */
-
- if (esock_poll_fd_isset_read(&pollfd, proxy_listensock)) {
- while (1) {
- length = sizeof(iserv_addr);
- proxysock = do_accept(proxy_listensock,
- (struct sockaddr *)&iserv_addr,
- (int*)&length);
- if(proxysock == INVALID_FD) {
- if (sock_errno() != ERRNO_BLOCK) {
- /* We can here for example get the error
- * EMFILE, i.e. no more file descriptors
- * available, but we do not have any specific
- * connection to report the error to. We
- * increment the error counter and saves the
- * last err.
- */
- proxysock_err_cnt++;
- proxysock_last_err = sock_errno();
- DEBUGF(("accept error (proxy_listensock): %s\n",
- psx_errstr()));
- }
- break;
- } else {
- /* Get peer port number */
-/* length = sizeof(iserv_addr); */
-/* if (getpeername(proxysock, (struct sockaddr *)&iserv_addr, */
-/* &length) < 0) { */
-/* DEBUGF(("Can't get peername of proxy socket")); */
-/* safe_close(proxysock); */
-/* } else { */
- /* Add to pending proxy connections */
- SET_NONBLOCKING(proxysock);
- pp = new_proxy(proxysock);
- pp->peer_port = ntohs(iserv_addr.sin_port);
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("[PROXY_LISTEN_SOCK] conn accepted: "
- "proxyfd = %d, "
- "peer port = %d\n", proxysock, pp->peer_port));
-/* } */
- }
- }
- }
-
- /*
- * Read control messages from Erlang
- */
- if (esock_poll_fd_isset_read(&pollfd, local_read_fd)) {
- cc = read_ctrl(&ebuf);
- if ( cc < 0 ) {
- DEBUGF(("Read loop -1 or 0\n"));
- return -1;
- } else if (cc == 0) { /* not eof */
- DEBUGF(("GOT empty string \n"));
-
- } else {
-
- switch((int)*ebuf) {
-
- case ESOCK_SET_SEED_CMD:
- /*
- * ebuf = {cmd(1), binary(N) }
- */
- input("b", &binlen, &bin);
- DEBUGF(("[SET_SEED_CMD]\n"));
- esock_ssl_seed(bin, binlen);
- /* no reply */
- break;
-
- case ESOCK_GETPEERNAME_CMD:
- /*
- * ebuf = {cmd(1), fd(4)}
- */
- input("4", &fd);
- DEBUGF(("[GETPEERNAME_CMD] fd = %d\n", fd));
- cp = get_connection(fd);
- length = sizeof(iserv_addr);
- if (!cp) {
- sock_set_errno(ERRNO_NOTSOCK);
- reply(ESOCK_GETPEERNAME_ERR, "4s", fd, psx_errstr());
- } else if (getpeername(fd,
- (struct sockaddr *) &iserv_addr,
- &length) < 0) {
- reply(ESOCK_GETPEERNAME_ERR, "4s", fd, psx_errstr());
- } else {
- /*
- * reply = {cmd(1), fd(4), port(2),
- * ipstring(N), 0(1)}
- */
- reply(ESOCK_GETPEERNAME_REP, "42s", fd,
- ntohs(iserv_addr.sin_port),
- inet_ntoa(iserv_addr.sin_addr));
- }
- break;
-
- case ESOCK_GETSOCKNAME_CMD:
- /*
- * ebuf = {cmd(1), fd(4)}
- */
- input("4", &fd);
- DEBUGF(("[GETSOCKNAME_CMD] fd = %d\n", fd));
- cp = get_connection(fd);
- length = sizeof(iserv_addr);
- if (!cp) {
- sock_set_errno(ERRNO_NOTSOCK);
- reply(ESOCK_GETSOCKNAME_ERR, "4s", fd, psx_errstr());
- } else if (getsockname(fd,
- (struct sockaddr *)&iserv_addr,
- &length) < 0) {
- reply(ESOCK_GETSOCKNAME_ERR, "4s", fd, psx_errstr());
- } else {
- /*
- * reply = {cmd(1), fd(4), port(2),
- * ipstring(N), 0(1)}
- */
- reply(ESOCK_GETSOCKNAME_REP, "42s", fd,
- ntohs(iserv_addr.sin_port),
- inet_ntoa(iserv_addr.sin_addr));
- }
- break;
-
- case ESOCK_GETCONNINFO_CMD:
- /*
- * ebuf = {cmd(1), fd(4)}
- */
- input("4", &fd);
- DEBUGF(("[GETCONNINFO_CMD] fd = %d\n", fd));
- cp = get_connection(fd);
- if (!cp) {
- sock_set_errno(ERRNO_NOTSOCK);
- reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr());
- } else {
- if (esock_ssl_getprotocol_version(cp,
- &protocol_vsn) < 0)
- reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr());
- else if (esock_ssl_getcipher(cp, &cipher) < 0)
- reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr());
- else
- /*
- * reply = {cmd(1), fd(4), protocol(N), 0(1),
- * cipher(N), 0(1)}
- */
- reply(ESOCK_GETCONNINFO_REP, "4ss", fd,
- protocol_vsn, cipher);
- }
- break;
-
- case ESOCK_GETPEERCERT_CMD:
- /*
- * ebuf = {cmd(1), fd(4)}
- */
- input("4", &fd);
- DEBUGF(("[GETPEERCERT_CMD] fd = %d\n", fd));
- cp = get_connection(fd);
- if (!cp) {
- sock_set_errno(ERRNO_NOTSOCK);
- reply(ESOCK_GETPEERCERT_ERR, "4s", fd, psx_errstr());
- } else {
- if ((certlen = esock_ssl_getpeercert(cp, &cert)) < 0)
- reply(ESOCK_GETPEERCERT_ERR, "4s", fd, psx_errstr());
- else {
- /*
- * reply = {cmd(1), fd(4), certlen(4), cert(N)}
- */
- reply(ESOCK_GETPEERCERT_REP, "4b", fd,
- certlen, cert);
- esock_free(cert);
- }
- }
- break;
-
- case ESOCK_CONNECT_CMD:
- /*
- * ebuf = {cmd(1), intref(4),
- * lport(2), lipstring(N), 0(1), -- local
- * fport(2), fipstring(N), 0(1), -- foreign
- * flags(N), 0(1)}
- */
- input("42s2ss", &intref, &lport, &lipstring,
- &fport, &fipstring, &flags);
- DEBUGF(("[CONNECT_CMD] intref = %d, "
- "lipstring = %s lport = %d, "
- "fipstring = %s fport = %d, "
- "flags = %s\n", intref, lipstring, lport,
- fipstring, fport, flags));
- connectsock = do_connect(lipstring, lport,
- fipstring, fport);
- if(connectsock == INVALID_FD) {
- reply(ESOCK_CONNECT_SYNC_ERR, "4s", intref, psx_errstr());
- break;
- }
- DEBUGF((" fd = %d\n", connectsock));
- cp = new_connection(ESOCK_WAIT_CONNECT, connectsock);
- cp->origin = ORIG_CONNECT;
- length = strlen(flags);
- cp->flags = esock_malloc(length + 1);
- strcpy(cp->flags, flags);
- DEBUGF(("-> WAIT_CONNECT fd = %d\n", connectsock));
- /* Publish connectsock */
- reply(ESOCK_CONNECT_WAIT_REP, "44", intref, connectsock);
- break;
-
- case ESOCK_TERMINATE_CMD:
- /*
- * ebuf = {cmd(1)}
- */
- exit(EXIT_SUCCESS);
- break;
-
- case ESOCK_CLOSE_CMD:
- /*
- * ebuf = {cmd(1), fd(4)}
- */
- input("4", &fd);
- if ((cp = get_connection(fd))) {
- DEBUGF(("%s[CLOSE_CMD]: fd = %d\n",
- connstr[cp->state], fd));
- if (cp->proxy)
- cp->proxy->bp = 1;
- switch (cp->state) {
- case ESOCK_JOINED:
- cp->close = 1;
- if (JOINED_STATE_INVALID(cp))
- leave_joined_state(cp);
- break;
- case ESOCK_SSL_SHUTDOWN:
- cp->close = 1;
- DEBUGF((" close flag set\n"));
- break;
- default:
- DEBUGF(("-> (removal)\n"));
- close_and_remove_connection(cp);
- }
- } else
- DEBUGF(("[CLOSE_CMD]: ERROR: fd = %d not found\n", fd));
- break;
-
- case ESOCK_SET_SOCKOPT_CMD:
- /*
- * ebuf = {cmd(1), fd(4), op(1), on(1)}
- */
- input("411", &fd, &op, &value);
- switch(op) {
- case ESOCK_SET_TCP_NODELAY:
- if(setsockopt(fd, IPPROTO_TCP, TCP_NODELAY,
- (void *)&value, sizeof(value)) < 0) {
- DEBUGF(("Error: setsockopt TCP_NODELAY\n"));
- reply(ESOCK_IOCTL_ERR, "4s", fd, psx_errstr());
- } else {
- reply(ESOCK_IOCTL_OK, "4", fd);
- }
- break;
- default:
- DEBUGF(("Error: set_sock_opt - Not implemented\n"));
- sock_set_errno(ERRNO_OPNOTSUPP);
- reply(ESOCK_IOCTL_ERR, "4", fd, psx_errstr());
- break;
- }
- break;
-
- case ESOCK_LISTEN_CMD:
- /*
- * ebuf = {cmd(1), intref(4), lport(2), ipstring(N), 0(1),
- * backlog(2), flags(N), 0(1)}
- */
- input("42s2s", &intref, &lport, &lipstring, &backlog,
- &flags);
- DEBUGF(("[LISTEN_CMD] intref = %d, port = %d, "
- "ipstring = %s, backlog = %d, flags = %s\n",
- intref, lport, lipstring, backlog, flags));
-
- listensock = do_listen(lipstring, lport, backlog, &lport);
- if(listensock == INVALID_FD) {
- reply(ESOCK_LISTEN_SYNC_ERR, "4s", intref, psx_errstr());
- break;
- }
- cp = new_connection(ESOCK_PASSIVE_LISTENING, listensock);
- /* Flags may be an empty string */
- length = strlen(flags);
- cp->flags = esock_malloc(length + 1);
- strcpy(cp->flags, flags);
-
- cp->origin = ORIG_LISTEN;
- if (esock_ssl_listen_init(cp) < 0) {
- DEBUGF(("esock_ssl_listen_init() failed.\n"));
- reply(ESOCK_LISTEN_SYNC_ERR, "4s", intref,
- ssl_errstr());
- close_and_remove_connection(cp);
- break;
- }
- DEBUGF(("-> PASSIVE_LISTENING (fd = %d)\n", listensock));
- /* Publish listensock */
- reply(ESOCK_LISTEN_REP, "442", intref, listensock,
- ntohs(iserv_addr.sin_port));
- break;
-
- case ESOCK_TRANSPORT_ACCEPT_CMD:
- /*
- * ebuf = { op(1), fd(4), flags(N), 0(1)}
- */
- input("4s", &fd, &flags);
- DEBUGF(("[TRANSPORT_ACCEPT_CMD] listenfd = %d, flags = %s\n", fd,
- flags));
- cp = get_connection(fd);
- if (cp) {
- /* We store the flags in the listen socket's
- * connection, and overwrite previous flags.
- */
- if ((length = strlen(flags)) > 0) {
- if (cp->flags)
- cp->flags = esock_realloc(cp->flags,
- length + 1);
- else
- cp->flags = esock_malloc(length + 1);
- strcpy(cp->flags, flags);
- }
- if (cp->flags && cp->flags[0] != '\0') {
- cp->acceptors++;
- cp->state = ESOCK_ACTIVE_LISTENING;
- DEBUGF(("-> ACTIVE_LISTENING\n"));
- break;
- }
- DEBUGF(("ERROR: flags empty\n"));
- }
- reply(ESOCK_TRANSPORT_ACCEPT_ERR, "4s", fd, "ebadf");
- break;
-
- case ESOCK_SSL_ACCEPT_CMD:
- input("4s", &fd, &flags);
- DEBUGF(("[SSL_ACCEPT_CMD] fd = %d, flags = %s\n", fd, flags));
- cp = get_connection(fd);
- if (cp)
- cp->state = ESOCK_SSL_ACCEPT;
- //reply(ESOCK_SSL_ACCEPT_REP, "4", fd);
- break;
-
- case ESOCK_NOACCEPT_CMD:
- /*
- * ebuf = {cmd(1), fd(4)}
- */
- input("4", &fd);
- DEBUGF(("[NOACCEPT_CMD] listenfd = %d\n", fd));
- cp = get_connection(fd);
- if (cp && (--cp->acceptors <= 0)) {
- cp->acceptors = 0;
- cp->state = ESOCK_PASSIVE_LISTENING;
- esock_poll_clear_event(&pollfd, fd);
- DEBUGF(("-> PASSIVE_LISTENING\n"));
- }
- break;
-
- case ESOCK_PROXY_JOIN_CMD:
- /*
- * ebuf = {cmd(1), fd(4), portnum(2)}
- *
- * fd - file descriptor of a connection in state
- * CONNECTED
- * portnum - port number of the Erlang proxy peer
- */
- input("42", &fd, &pport);
- cp = get_connection(fd);
- pp = get_proxy_by_peerport(pport);
- if (cp && cp->state == ESOCK_CONNECTED && pp) {
- DEBUGF(("CONNECTED[PROXY_JOIN_CMD] fd = %d "
- "portnum = %d\n", fd, pport));
- cp->proxy = pp;
- pp->conn = cp;
- reply(ESOCK_PROXY_JOIN_REP, "4", fd);
- cp->state = ESOCK_JOINED;
- DEBUGF(("-> JOINED\n"));
- break;
- }
- if (!cp) {
- DEBUGF(("[PROXY_JOIN_CMD] ERROR: No connection "
- "having fd = %d\n", fd));
- reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, "ebadsocket");
- } else if (cp->state != ESOCK_CONNECTED) {
- DEBUGF(("%s[PROXY_JOIN_CMD] ERROR: Bad state: "
- "fd = %d\n", connstr[cp->state], cp->fd));
- reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, "ebadstate");
- } else {
- DEBUGF(("ERROR: No proxy: fd = %d, pport = %d\n",
- fd, pport));
- if (proxysock_err_cnt > 0) {
- proxysock_err_cnt--;
- reply(ESOCK_PROXY_JOIN_ERR, "4s", fd,
- esock_posix_str(proxysock_last_err));
- } else {
- reply(ESOCK_PROXY_JOIN_ERR, "4s", fd,
- "enoproxysocket");
- }
- cp->state = ESOCK_DEFUNCT;
- }
- break;
-
- case ESOCK_DUMP_STATE_CMD:
- dump_connections();
- break;
-
- case ESOCK_SET_DEBUG_CMD:
- /*
- * ebuf = {cmd(1), debug(1)}
- */
- input("1", &debug);
- break;
-
- case ESOCK_SET_DEBUGMSG_CMD:
- /*
- * ebuf = {cmd(1), debugmsg(1)}
- */
- input("1", &debugmsg);
- break;
-
- default:
- fprintf(stderr, "esock: default value in loop %c\n",
- *ebuf);
- exit(EXIT_FAILURE);
- break;
- }
- }
- }
-
- /* Go through all connections that have their file descriptors
- set. */
-
- /* Note: We may remove the current connection (cp). Thus we
- * must be careful not to read cp->next after cp has been
- * removed. */
- for (cp = next_polled_conn(connections, &cpnext, &pollfd, set_wq_fds);
- cp != NULL;
- cp = next_polled_conn(cpnext, &cpnext, &pollfd, set_wq_fds)
- ) {
-
- switch(cp->state) {
-
- case ESOCK_PASSIVE_LISTENING:
- DEBUGF(("-----------------------------------\n"));
- fprintf(stderr, "esock: Got connect request while PASSIVE\n");
- exit(EXIT_FAILURE);
- break;
-
- case ESOCK_ACTIVE_LISTENING:
- /* new connect from network */
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("ACTIVE_LISTENING - trying to accept on %d\n",
- cp->fd));
- length = sizeof(iserv_addr);
- msgsock = do_accept(cp->fd, (struct sockaddr*)&iserv_addr,
- (int*)&length);
- if(msgsock == INVALID_FD) {
- DEBUGF(("accept error: %s\n", psx_errstr()));
- reply(ESOCK_TRANSPORT_ACCEPT_ERR, "4s", cp->fd, psx_errstr());
- break;
- }
- SET_NONBLOCKING(msgsock);
- if (--cp->acceptors <= 0) {
- cp->acceptors = 0;
- cp->state = ESOCK_PASSIVE_LISTENING;
- DEBUGF(("-> PASSIVE_LISTENING\n"));
- }
- DEBUGF(("server accepted connection on fd %d\n", msgsock));
- newcp = new_connection(ESOCK_TRANSPORT_ACCEPT, msgsock);
- newcp->origin = ORIG_ACCEPT;
- reply(ESOCK_TRANSPORT_ACCEPT_REP, "44", cp->fd, msgsock);
- newcp->listen_fd = cp->fd; /* Needed for ESOCK_ACCEPT_ERR */
- length = strlen(cp->flags);
- /* XXX new flags are not needed */
- newcp->flags = esock_malloc(length + 1);
- strcpy(newcp->flags, cp->flags); /* XXX Why? */
- if (esock_ssl_accept_init(newcp, cp->opaque) < 0) {
- cp->errstr = ssl_errstr();
- break;
- }
- newcp->ssl_want = ESOCK_SSL_WANT_READ;
- break;
-
- case ESOCK_SSL_ACCEPT:
- /* SSL accept handshake. msgsock is *not* published yet. */
- msgsock = cp->fd;
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("SSL_ACCEPT fd = %d\n", msgsock));
- if (cp->errstr != NULL) { /* this means we got an error in ssl_accept_init */
- /* N.B.: The *listen fd* is reported. */
- reply(ESOCK_SSL_ACCEPT_ERR, "4s", msgsock, cp->errstr);
- close_and_remove_connection(cp);
- break;
- }
- if (esock_ssl_accept(cp) < 0) {
- if (sock_errno() != ERRNO_BLOCK) {
- /* Handshake failed. */
- reply(ESOCK_SSL_ACCEPT_ERR, "4s", msgsock,
- ssl_errstr());
- DEBUGF(("ERROR: handshake: %s\n", ssl_errstr()));
- close_and_remove_connection(cp);
- }
- } else {
- /* SSL handshake successful: publish */
- reply(ESOCK_SSL_ACCEPT_REP, "4", msgsock);
- DEBUGF(("-> CONNECTED\n"));
- DEBUGF((" Session was %sreused.\n",
- (esock_ssl_session_reused(cp)) ? "" : "NOT "));
- cp->state = ESOCK_CONNECTED;
- }
- break;
-
- case ESOCK_CONNECTED:
- /* Should not happen. We do not read or write until
- the connection is in state JOINED. */
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("CONNECTED: Error: should not happen. fd = %d\n",
- cp->fd));
- break;
-
- case ESOCK_JOINED:
- /*
- * Reading from Proxy, writing to SSL
- */
- if (esock_poll_fd_isset_write(&pollfd, cp->fd)) {
- /* If there is a write queue, write to ssl only */
- if (cp->wq.len > 0) {
- /* The write retry semantics of SSL_write in
- * the OpenSSL package is strange. Partial
- * writes never occur, only complete writes or
- * failures. A failure, however, still
- * consumes all data written, although not all
- * encrypted data could be written to the
- * underlying socket. To retry a write we have
- * to provide the same buf and length as in
- * the original call, in our case rwbuf and
- * the original buffer length. Hence the
- * strange memcpy(). Note that wq.offset will
- * always be zero when we use OpenSSL.
- */
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("JOINED: writing to ssl "
- "fd = %d, from write queue only, wc = %d\n",
- cp->fd, cp->wq.len - cp->wq.offset));
- memcpy(rwbuf, cp->wq.buf, cp->wq.len - cp->wq.offset);
-
- /* esock_ssl_write sets cp->eof, cp->bp when return
- * value is zero */
- wc = esock_ssl_write(cp, rwbuf,
- cp->wq.len - cp->wq.offset);
- if (wc < 0) {
- if (sock_errno() != ERRNO_BLOCK) {
- /* Assume broken SSL pipe */
- DEBUGF(("broken SSL pipe\n"));
- cp->bp = 1;
- shutdown(cp->proxy->fd, SHUTDOWN_READ);
- cp->proxy->eof = 1;
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- }
- } else if (wc == 0) {
- /* SSL broken pipe */
- DEBUGF(("broken SSL pipe\n"));
- cp->bp = 1;
- shutdown(cp->proxy->fd, SHUTDOWN_READ);
- cp->proxy->eof = 1;
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- } else {
- cp->wq.offset += wc;
- if (cp->wq.offset == cp->wq.len)
- cp->wq.len = 0;
- }
- }
- } else if (esock_poll_fd_isset_read(&pollfd, cp->proxy->fd)) {
- /* Read from proxy and write to SSL */
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("JOINED: reading from proxy, "
- "proxyfd = %d\n", cp->proxy->fd));
- cc = sock_read(cp->proxy->fd, rwbuf, RWBUFLEN);
- DEBUGF(("read from proxyfd = %d, cc = %d\n",
- cp->proxy->fd, cc));
- if (cc > 0) {
- /* esock_ssl_write sets cp->eof, cp->bp when return
- * value is zero */
- wc = esock_ssl_write(cp, rwbuf, cc);
- if (wc < 0) {
- if (sock_errno() != ERRNO_BLOCK) {
- /* Assume broken pipe */
- DEBUGF(("broken SSL pipe\n"));
- cp->bp = 1;
- shutdown(cp->proxy->fd, SHUTDOWN_READ);
- cp->proxy->eof = 1;
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- } else {
- /* add to write queue */
- DEBUGF(("adding all to write queue "
- "%d bytes\n", cc));
- ensure_write_queue(&cp->wq, cc);
- memcpy(cp->wq.buf, rwbuf, cc);
- cp->wq.len = cc;
- cp->wq.offset = 0;
- }
- } else if (wc == 0) {
- /* Broken SSL pipe */
- DEBUGF(("broken SSL pipe\n"));
- cp->bp = 1;
- shutdown(cp->proxy->fd, SHUTDOWN_READ);
- cp->proxy->eof = 1;
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- } else if (wc < cc) {
- /* add remainder to write queue */
- DEBUGF(("adding remainder to write queue "
- "%d bytes\n", cc - wc));
- ensure_write_queue(&cp->wq, cc - wc);
- memcpy(cp->wq.buf, rwbuf + wc, cc - wc);
- cp->wq.len = cc - wc;
- cp->wq.offset = 0;
- }
- } else {
- /* EOF proxy or error */
- DEBUGF(("proxy eof or error %d\n", errno));
- cp->proxy->eof = 1;
- if (cp->wq.len == 0) {
- esock_ssl_shutdown(cp);
- cp->bp = 1;
- }
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- }
- }
- /*
- * Reading from SSL, writing to proxy
- */
- if (esock_poll_fd_isset_write(&pollfd, cp->proxy->fd)) {
- /* If there is a write queue, write to proxy only */
- if (cp->proxy->wq.len > 0) {
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("JOINED: writing to proxyfd = %d, "
- "from write queue only, wc = %d\n",
- cp->proxy->fd, cp->proxy->wq.len -
- cp->proxy->wq.offset));
- wc = sock_write(cp->proxy->fd, cp->proxy->wq.buf +
- cp->proxy->wq.offset,
- cp->proxy->wq.len -
- cp->proxy->wq.offset);
- if (wc < 0) {
- if (sock_errno() != ERRNO_BLOCK) {
- /* Assume broken pipe */
- DEBUGF(("broken proxy pipe\n"));
- cp->proxy->bp = 1;
- /* There is no SSL shutdown for read */
- cp->eof = 1;
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- }
- } else {
- cp->proxy->wq.offset += wc;
- if (cp->proxy->wq.offset == cp->proxy->wq.len)
- cp->proxy->wq.len = 0;
- }
- }
- } else if (esock_poll_fd_isset_read(&pollfd, cp->fd)) {
- /* Read from SSL and write to proxy */
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("JOINED: read from ssl fd = %d\n",
- cp->fd));
- cc = esock_ssl_read(cp, rwbuf, RWBUFLEN);
- DEBUGF(("read from fd = %d, cc = %d\n", cp->fd, cc));
- if (cc > 0) {
- wc = sock_write(cp->proxy->fd, rwbuf, cc);
- if (wc < 0) {
- if (sock_errno() != ERRNO_BLOCK) {
- DEBUGF(("broken proxy pipe\n"));
- /* Assume broken pipe */
- cp->proxy->bp = 1;
- /* There is no SSL shutdown for read */
- cp->eof = 1;
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- } else {
- /* add all to write queue */
- DEBUGF(("adding to write queue %d bytes\n",
- cc));
- ensure_write_queue(&cp->proxy->wq, cc);
- memcpy(cp->proxy->wq.buf, rwbuf, cc);
- cp->proxy->wq.len = cc;
- cp->proxy->wq.offset = 0;
- }
- } else if (wc < cc) {
- /* add to write queue */
- DEBUGF(("adding to write queue %d bytes\n",
- cc - wc));
- ensure_write_queue(&cp->proxy->wq, cc - wc);
- memcpy(cp->proxy->wq.buf, rwbuf + wc, cc - wc);
- cp->proxy->wq.len = cc - wc;
- cp->proxy->wq.offset = 0;
- }
- } else if (cc == 0) {
- /* SSL eof */
- DEBUGF(("SSL eof\n"));
- cp->eof = 1;
- if (cp->proxy->wq.len == 0) {
- shutdown(cp->proxy->fd, SHUTDOWN_WRITE);
- cp->proxy->bp = 1;
- }
- if (JOINED_STATE_INVALID(cp)) {
- leave_joined_state(cp);
- break;
- }
- } else {
- /* This may very well happen when reading from SSL. */
- DEBUGF(("NOTE: readmask set, cc < 0, fd = %d, "
- "is ok\n", cp->fd));
- }
- }
- break;
-
- case ESOCK_SSL_SHUTDOWN:
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("SSL_SHUTDOWN: fd = %d\n", cp->fd));
- do_shutdown(cp);
- break;
-
- case ESOCK_DEFUNCT:
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("DEFUNCT: ERROR: should not happen. fd = %d\n",
- cp->fd));
- break;
-
- case ESOCK_WAIT_CONNECT:
- /* New connection shows up */
- connectsock = cp->fd;/* Is published */
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("WAIT_CONNECT fd = %d\n", connectsock));
-
- /* If the connection did succeed it's possible to
- * fetch the peer name (UNIX); or failure shows in
- * exceptmask (WIN32). Sorry for the mess below, but
- * we have to have balanced paren's in #ifdefs in
- * order not to confuse Emacs' indentation. */
- length = sizeof(iserv_addr);
- if (
-#ifdef __WIN32__
- esock_poll_fd_isset_exception(&pollfd, connectsock)
-#else
- getpeername(connectsock, (struct sockaddr *)&iserv_addr,
- &length) < 0
-#endif
- ) {
- sock_set_errno(ERRNO_CONNREFUSED);
- DEBUGF(("connect error: %s\n", psx_errstr()));
- reply(ESOCK_CONNECT_ERR, "4s", connectsock, psx_errstr());
- cp->state = ESOCK_DEFUNCT;
- break;
- }
- if (esock_ssl_connect_init(cp) < 0) {
- DEBUGF(("esock_ssl_connect_init() failed\n"));
- reply(ESOCK_CONNECT_ERR, "4s", connectsock, ssl_errstr());
- cp->state = ESOCK_DEFUNCT;
- break;
- }
- DEBUGF(("-> SSL_CONNECT\n"));
- cp->state = ESOCK_SSL_CONNECT;
- cp->ssl_want = ESOCK_SSL_WANT_WRITE;
- break;
-
- case ESOCK_SSL_CONNECT:
- /* SSL connect handshake. connectsock is published. */
- connectsock = cp->fd;
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("SSL_CONNECT fd = %d\n", connectsock));
- if (esock_ssl_connect(cp) < 0) {
- if (sock_errno() != ERRNO_BLOCK) {
- /* Handshake failed */
- DEBUGF(("ERROR: handshake: %s\n", ssl_errstr()));
- reply(ESOCK_CONNECT_ERR, "4s", connectsock,
- ssl_errstr());
- cp->state = ESOCK_DEFUNCT;
- }
- } else {
- /* SSL connect handshake successful */
- DEBUGF(("-> CONNECTED\n"));
- reply(ESOCK_CONNECT_REP, "4", connectsock);
- cp->state = ESOCK_CONNECTED;
- }
- break;
-
- default:
- DEBUGF(("ERROR: Connection in unknown state.\n"));
- }
- }
- }
-}
-
-static int set_poll_conns(Connection *cp, EsockPoll *ep, int verbose)
-{
- int i = 0;
-
- if (verbose)
- DEBUGF(("MASKS SET FOR FD: "));
- while (cp) {
- switch (cp->state) {
- case ESOCK_ACTIVE_LISTENING:
- if (verbose)
- DEBUGF(("%d (read) ", cp->fd));
- esock_poll_fd_set_read(ep, cp->fd);
- break;
- case ESOCK_WAIT_CONNECT:
- if (verbose)
- DEBUGF(("%d (write) ", cp->fd));
- esock_poll_fd_set_write(ep, cp->fd);
-#ifdef __WIN32__
- esock_poll_fd_set_exception(ep, cp->fd); /* Failure shows in exceptions */
-#endif
- break;
- case ESOCK_SSL_CONNECT:
- case ESOCK_SSL_ACCEPT:
- if (cp->ssl_want == ESOCK_SSL_WANT_READ) {
- if (verbose)
- DEBUGF(("%d (read) ", cp->fd));
- esock_poll_fd_set_read(ep, cp->fd);
- } else if (cp->ssl_want == ESOCK_SSL_WANT_WRITE) {
- if (verbose)
- DEBUGF(("%d (write) ", cp->fd));
- esock_poll_fd_set_write(ep, cp->fd);
- }
- break;
- case ESOCK_JOINED:
- if (!cp->bp) {
- if (cp->wq.len) {
- if (verbose)
- DEBUGF(("%d (write) ", cp->fd));
- esock_poll_fd_set_write(ep, cp->fd);
- } else if (!cp->proxy->eof) {
- if (verbose)
- DEBUGF(("%d (read) ", cp->proxy->fd));
- esock_poll_fd_set_read(ep, cp->proxy->fd);
- }
- }
- if (!cp->proxy->bp) {
- if (cp->proxy->wq.len) {
- if (verbose)
- DEBUGF(("%d (write) ", cp->proxy->fd));
- esock_poll_fd_set_write(ep, cp->proxy->fd);
- } else if (!cp->eof) {
- if (verbose)
- DEBUGF(("%d (read) ", cp->fd));
- esock_poll_fd_set_read(ep, cp->fd);
- }
- }
- break;
- case ESOCK_SSL_SHUTDOWN:
- if (cp->ssl_want == ESOCK_SSL_WANT_READ) {
- if (verbose)
- DEBUGF(("%d (read) ", cp->fd));
- esock_poll_fd_set_read(ep, cp->fd);
- } else if (cp->ssl_want == ESOCK_SSL_WANT_WRITE) {
- if (verbose)
- DEBUGF(("%d (write) ", cp->fd));
- esock_poll_fd_set_write(ep, cp->fd);
- }
- break;
- default:
- break;
- }
- i++;
- cp = cp->next;
- }
- if (verbose)
- DEBUGF(("\n"));
- return i;
-}
-
-
-static Connection *next_polled_conn(Connection *cp, Connection **cpnext,
- EsockPoll *ep, int set_wq_fds)
-{
- while(cp) {
- if (esock_poll_fd_isset_read(ep, cp->fd) ||
- (cp->proxy && esock_poll_fd_isset_read(ep, cp->proxy->fd)) ||
- (esock_poll_fd_isset_write(ep, cp->fd)) ||
- (cp->proxy && esock_poll_fd_isset_write(ep, cp->proxy->fd))
-#ifdef __WIN32__
- || esock_poll_fd_isset_exception(ep, cp->fd) /* Connect failure in WIN32 */
-#endif
- || (set_wq_fds && (cp->wq.len ||
- (cp->proxy && cp->proxy->wq.len)))
- || cp->errstr != NULL) {
- *cpnext = cp->next;
- return cp;
- }
- cp = cp->next;
- }
- *cpnext = NULL;
- return NULL;
-}
-
-static void leave_joined_state(Connection *cp)
-{
- shutdown(cp->proxy->fd, SHUTDOWN_ALL);
- if (((cp->bp || cp->eof) && cp->clean) ||
- (!cp->bp && !cp->eof)) {
- DEBUGF(("-> SSL_SHUTDOWN\n"));
- cp->state = ESOCK_SSL_SHUTDOWN;
- cp->ssl_want = ESOCK_SSL_WANT_WRITE;
- do_shutdown(cp);
- } else if (cp->close) {
- DEBUGF(("-> (removal)\n"));
- close_and_remove_connection(cp);
- } else {
- DEBUGF(("-> DEFUNCT\n"));
- cp->state = ESOCK_DEFUNCT;
- }
-}
-
-/* We are always in state SHUTDOWN here */
-static void do_shutdown(Connection *cp)
-{
- int ret;
-
- ret = esock_ssl_shutdown(cp);
- if (ret < 0) {
- if (sock_errno() == ERRNO_BLOCK) {
- return;
- } else {
- /* Something is wrong -- close and remove or move to DEFUNCT */
- DEBUGF(("Error in SSL shutdown\n"));
- if (cp->close) {
- DEBUGF(("-> (removal)\n"));
- close_and_remove_connection(cp);
- } else {
- DEBUGF(("-> DEFUNCT\n"));
- cp->state = ESOCK_DEFUNCT;
- }
- }
- } else if (ret == 0) {
- /* `close_notify' has been sent. Wait for reception of
- same. */
- return;
- } else if (ret == 1) {
- /* `close_notify' has been sent, and received. */
- if (cp->close) {
- DEBUGF(("-> (removal)\n"));
- close_and_remove_connection(cp);
- } else {
- DEBUGF(("-> DEFUNCT\n"));
- cp->state = ESOCK_DEFUNCT;
- }
- }
-}
-
-static void close_and_remove_connection(Connection *cp)
-{
- safe_close(cp->fd);
- remove_connection(cp);
-}
-
-static int reply(int cmd, char *fmt, ...)
-{
- static unsigned char replybuf[MAXREPLYBUF];
- unsigned char *buf = replybuf;
- va_list args;
- int len;
-
- va_start(args, fmt);
- len = put_pars(NULL, fmt, args);
- va_end(args);
- len++;
- if (len > sizeof(replybuf))
- buf = esock_malloc(len);
-
- PUT_INT8(cmd, buf);
- va_start(args, fmt);
- (void) put_pars(buf + 1, fmt, args);
- va_end(args);
- write_ctrl(buf, len);
- if (buf != replybuf)
- esock_free(buf);
- return len;
-}
-
-static int input(char *fmt, ...)
-{
- va_list args;
- int len;
-
- va_start(args, fmt);
- len = get_pars(ebuf + 1, fmt, args);
- va_end(args);
- return len + 1;
-}
-
-static int put_pars(unsigned char *buf, char *fmt, va_list args)
-{
- char *s, *str, *bin;
- int val, len, pos = 0;
-
- s = fmt;
- while (*s) {
- switch (*s) {
- case '1':
- val = va_arg(args, int);
- if (buf)
- PUT_INT8(val, buf + pos);
- pos++;
- break;
- case '2':
- val = va_arg(args, int);
- if (buf)
- PUT_INT16(val, buf + pos);
- pos += 2;
- break;
- case '4':
- val = va_arg(args, int);
- if (buf)
- PUT_INT32(val, buf + pos);
- pos += 4;
- break;
- case 's': /* string */
- str = va_arg(args, char *);
- if (buf)
- strcpy((char *)(buf + pos), str);
- pos += strlen(str) + 1;
- break;
- case 'b': /* binary */
- len = va_arg(args, int);
- if (buf)
- PUT_INT32(len, buf + pos);
- pos += 4;
- bin = va_arg(args, char *);
- if (buf)
- memcpy(buf + pos, bin, len);
- pos += len;
- break;
- default:
- fprintf(stderr, "esock: Invalid format character: %c\n", *s);
- exit(EXIT_FAILURE);
- break;
- }
- s++;
- }
- return pos;
-}
-
-
-static int get_pars(unsigned char *buf, char *fmt, va_list args)
-{
- int *ip;
- char *s, **strp, **bin;
- int pos = 0;
-
- s = fmt;
- while (*s) {
- switch (*s) {
- case '1':
- ip = va_arg(args, int *);
- *ip = GET_INT8(buf + pos);
- pos++;
- break;
- case '2':
- ip = va_arg(args, int *);
- *ip = GET_INT16(buf + pos);
- pos += 2;
- break;
- case '4':
- ip = va_arg(args, int *);
- *ip = GET_INT32(buf + pos);
- pos += 4;
- break;
- case 's':
- strp = va_arg(args, char **);
- *strp = (char *)(buf + pos);
- pos += strlen(*strp) + 1;
- break;
- case 'b':
- ip = va_arg(args, int *);
- *ip = GET_INT32(buf + pos);
- pos += 4;
- bin = va_arg(args, char **);
- *bin = (char *)(buf + pos);
- pos += *ip;
- break;
- default:
- fprintf(stderr, "esock: Invalid format character: %c\n", *s);
- exit(EXIT_FAILURE);
- break;
- }
- s++;
- }
- return pos;
-}
-
-static FD do_connect(char *lipstring, int lport, char *fipstring, int fport)
-{
- struct sockaddr_in sock_addr;
- long inaddr;
- FD fd;
-
- if ((fd = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_FD) {
- DEBUGF(("Error calling socket()\n"));
- return fd;
- }
- if (check_num_sock_fds(fd) < 0)
- return INVALID_FD;
- DEBUGF((" fd = %d\n", fd));
-
- /* local */
- if ((inaddr = inet_addr(lipstring)) == INADDR_NONE) {
- DEBUGF(("Error in inet_addr(): lipstring = %s\n", lipstring));
- safe_close(fd);
- sock_set_errno(ERRNO_ADDRNOTAVAIL);
- return INVALID_FD;
- }
- memset(&sock_addr, 0, sizeof(sock_addr));
- sock_addr.sin_family = AF_INET;
- sock_addr.sin_addr.s_addr = inaddr;
- sock_addr.sin_port = htons(lport);
- if(bind(fd, (struct sockaddr*) &sock_addr, sizeof(sock_addr)) < 0) {
- DEBUGF(("Error in bind()\n"));
- safe_close(fd);
- /* XXX Set error code for bind error */
- return INVALID_FD;
- }
-
- /* foreign */
- if ((inaddr = inet_addr(fipstring)) == INADDR_NONE) {
- DEBUGF(("Error in inet_addr(): fipstring = %s\n", fipstring));
- safe_close(fd);
- sock_set_errno(ERRNO_ADDRNOTAVAIL);
- return INVALID_FD;
- }
- memset(&sock_addr, 0, sizeof(sock_addr));
- sock_addr.sin_family = AF_INET;
- sock_addr.sin_addr.s_addr = inaddr;
- sock_addr.sin_port = htons(fport);
-
- SET_NONBLOCKING(fd);
-
- if(connect(fd, (struct sockaddr*)&sock_addr, sizeof(sock_addr)) < 0) {
- if (sock_errno() != ERRNO_PROGRESS && /* UNIX */
- sock_errno() != ERRNO_BLOCK) { /* WIN32 */
- DEBUGF(("Error in connect()\n"));
- safe_close(fd);
- return INVALID_FD;
- }
- }
- return fd;
-}
-
-static FD do_listen(char *ipstring, int lport, int backlog, int *aport)
-{
- static int one = 1; /* Type must be int, not long */
- struct sockaddr_in sock_addr;
- long inaddr;
- int length;
- FD fd;
-
- if ((fd = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_FD) {
- DEBUGF(("Error calling socket()\n"));
- return fd;
- }
- if (check_num_sock_fds(fd) < 0)
- return INVALID_FD;
- DEBUGF((" fd = %d\n", fd));
- if ((inaddr = inet_addr(ipstring)) == INADDR_NONE) {
- DEBUGF(("Error in inet_addr(): ipstring = %s\n", ipstring));
- safe_close(fd);
- sock_set_errno(ERRNO_ADDRNOTAVAIL);
- return INVALID_FD;
- }
- memset(&sock_addr, 0, sizeof(sock_addr));
- sock_addr.sin_family = AF_INET;
- sock_addr.sin_addr.s_addr = inaddr;
- sock_addr.sin_port = htons(lport);
-
- setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, (void *)&one, sizeof(one));
-
- if(bind(fd, (struct sockaddr*) &sock_addr, sizeof(sock_addr)) < 0) {
- DEBUGF(("Error in bind()\n"));
- safe_close(fd);
- return INVALID_FD;
- }
- if (listen(fd, backlog) < 0) {
- DEBUGF(("Error in listen()\n"));
- safe_close(fd);
- return INVALID_FD;
- }
- /* find out assigned local port number */
- length = sizeof(sock_addr);
- if (getsockname(fd, (struct sockaddr *)&sock_addr, &length) < 0) {
- DEBUGF(("Error in getsockname()\n"));
- safe_close(fd);
- return INVALID_FD;
- }
- if (aport)
- *aport = ntohs(sock_addr.sin_port);
- return fd;
-}
-
-static FD do_accept(FD listensock, struct sockaddr *saddr, int *len)
-{
- FD fd;
-
- if ((fd = accept(listensock, saddr, len)) == INVALID_FD) {
- DEBUGF(("Error calling accept()\n"));
- return fd;
- }
- if (check_num_sock_fds(fd) < 0)
- return INVALID_FD;
- return fd;
-}
-
-static Connection *new_connection(int state, FD fd)
-{
- Connection *cp;
-
- if (!(cp = esock_malloc(sizeof(Connection))))
- return NULL;
- cp->state = state;
- cp->acceptors = 0;
- cp->fd = fd;
- cp->listen_fd = INVALID_FD;
- cp->proxy = NULL;
- cp->opaque = NULL;
- cp->ssl_want = 0;
- cp->eof = 0;
- cp->bp = 0;
- cp->clean = 0; /* XXX Used? */
- cp->close = 0;
- cp->origin = -1;
- cp->flags = NULL;
- cp->logfp = NULL;
- cp->wq.size = 0;
- cp->wq.buf = NULL;
- cp->wq.len = 0;
- cp->wq.offset = 0;
- cp->next = connections;
- cp->errstr = NULL;
- connections = cp;
- return cp;
-}
-
-
-static void print_connections(void)
-{
- if (debug) {
- Connection *cp = connections;
- DEBUGF(("CONNECTIONS:\n"));
- while (cp) {
- if (cp->state == ESOCK_JOINED) {
- DEBUGF((" - %s [%8p] (origin = %s)\n"
- " (fd = %d, eof = %d, wq = %d, bp = %d)\n"
- " (proxyfd = %d, eof = %d, wq = %d, bp = %d)\n",
- connstr[cp->state], cp, originstr[cp->origin],
- cp->fd, cp->eof, cp->wq.len, cp->bp,
- cp->proxy->fd, cp->proxy->eof, cp->proxy->wq.len,
- cp->proxy->bp));
- } else if (cp->state == ESOCK_ACTIVE_LISTENING) {
- DEBUGF((" - %s [%8p] (fd = %d, acceptors = %d)\n",
- connstr[cp->state], cp, cp->fd, cp->acceptors));
- } else {
- DEBUGF((" - %s [%8p] (fd = %d)\n", connstr[cp->state], cp,
- cp->fd));
- }
- cp= cp->next;
- }
- }
-}
-
-static void dump_connections(void)
-{
- Connection *cp = connections;
- Proxy *pp = proxies;
- time_t t = time(NULL);
- int length = 0;
- struct sockaddr_in iserv_addr;
-
- __debugprintf("CONNECTIONS %s", ctime(&t));
- while (cp) {
- if (cp->state == ESOCK_JOINED) {
- __debugprintf(" - %s [%8p] (origin = %s)\n"
- " (fd = %d, eof = %d, wq = %d, bp = %d), close = %d\n"
- " (proxyfd = %d, eof = %d, wq = %d, bp = %d)\n",
- connstr[cp->state], cp, originstr[cp->origin],
- cp->fd, cp->eof, cp->wq.len, cp->bp, cp->close,
- cp->proxy->fd, cp->proxy->eof, cp->proxy->wq.len,
- cp->proxy->bp);
- } else if (cp->state == ESOCK_ACTIVE_LISTENING) {
- __debugprintf(" - %s [%8p] (fd = %d, acceptors = %d)\n",
- connstr[cp->state], cp, cp->fd, cp->acceptors);
- } else {
- __debugprintf(" - %s [%8p] (fd = %d)\n", connstr[cp->state], cp,
- cp->fd);
- }
- length = sizeof(iserv_addr);
- if ((cp->state == ESOCK_ACTIVE_LISTENING) ||
- (cp->state == ESOCK_PASSIVE_LISTENING)) {
- getsockname(cp->fd, (struct sockaddr *) &iserv_addr, &length);
- __debugprintf(" (ip = %s, port = %d)\n",
- inet_ntoa(iserv_addr.sin_addr),
- ntohs(iserv_addr.sin_port));
- }
- else {
- getsockname(cp->fd, (struct sockaddr *) &iserv_addr, &length);
- __debugprintf(" (local_ip = %s, local_port = %d)\n",
- inet_ntoa(iserv_addr.sin_addr),
- ntohs(iserv_addr.sin_port));
- length = sizeof(iserv_addr);
- getpeername(cp->fd, (struct sockaddr *) &iserv_addr, &length);
- __debugprintf(" (remote_ip = %s, remote_port = %d)\n",
- inet_ntoa(iserv_addr.sin_addr),
- ntohs(iserv_addr.sin_port));
- }
- cp=cp->next;
- }
-
- __debugprintf("PROXIES\n");
- while (pp) {
- __debugprintf(" - fd = %d [%8p] (external_fd = %d, peer_port = %d,"
- " eof = %d)\n", pp->fd, pp, pp->conn->fd, pp->peer_port,
- pp->eof);
-
- pp= pp->next;
- }
-}
-
-static Connection *get_connection(FD fd)
-{
- Connection *cp = connections;
-
- while(cp) {
- if(cp->fd == fd)
- return cp;
- cp = cp->next;
- }
- return NULL;
-}
-
-/*
- * Remove a connection from the list of connection, close the proxy
- * socket and free all resources. The main socket (fd) is *not*
- * closed here, because the closing of that socket has to be synchronized
- * with the Erlang process controlling this port program.
- */
-static void remove_connection(Connection *conn)
-{
- Connection **prev = &connections;
- Connection *cp = connections;
-
- while (cp) {
- if(cp == conn) {
- DEBUGF(("remove_connection: fd = %d\n", cp->fd));
- esock_ssl_free(cp); /* frees cp->opaque only */
- esock_free(cp->flags);
- closelog(cp->logfp); /* XXX num_sock_fds */
- esock_free(cp->wq.buf);
- if (cp->proxy) {
- safe_close(cp->proxy->fd);
- remove_proxy(cp->proxy);
- }
- *prev = cp->next;
- esock_free(cp);
- return;
- }
- prev = &cp->next;
- cp = cp->next;
- }
-}
-
-static Proxy *get_proxy_by_peerport(int port)
-{
- Proxy *p = proxies;
-
- while(p) {
- if (p->peer_port == port)
- return p;
- p = p->next;
- }
- return NULL;
-}
-
-static Proxy *new_proxy(FD fd)
-{
- Proxy *p;
-
- if (!(p = esock_malloc(sizeof(Proxy))))
- return NULL;
-
- p->fd = fd;
- p->peer_port = -1;
- p->eof = 0;
- p->bp = 0;
- p->conn = NULL;
- p->wq.size = 0;
- p->wq.buf = NULL;
- p->wq.len = 0;
- p->wq.offset = 0;
- p->next = proxies;
- proxies = p;
- return p;
-}
-
-static void remove_proxy(Proxy *proxy)
-{
- Proxy *p = proxies, **pp = &proxies;
-
- while(p) {
- if (p == proxy) {
- DEBUGF(("remove_proxyfd = %d\n", p->fd));
- esock_free(p->wq.buf);
- *pp = p->next;
- esock_free(p);
- return;
- }
- pp = &p->next;
- p = p->next;
- }
-}
-
-static int check_num_sock_fds(FD fd)
-{
- num_sock_fds++; /* fd is valid */
-#ifdef USE_SELECT
- if (num_sock_fds > FD_SETSIZE) {
- num_sock_fds--;
- sock_set_errno(ERRNO_MFILE);
- safe_close(fd);
- return -1;
- }
-#endif
- return 0;
-}
-
-static void safe_close(FD fd)
-{
- int err;
-
- err = sock_errno();
- DEBUGF(("safe_close fd = %d\n", fd));
- if (sock_close(fd) < 0) {
- DEBUGF(("safe_close failed\n"));
- } else {
- num_sock_fds--;
- }
- sock_set_errno(err);
-}
-
-static void clean_up(void)
-{
- Connection *cp, *cpnext;
- Proxy *pp, *ppnext;
-
- cp = connections;
- while (cp) {
- safe_close(cp->fd);
- cpnext = cp->next;
- remove_connection(cp);
- cp = cpnext;
- }
-
- pp = proxies;
- while (pp) {
- safe_close(pp->fd);
- ppnext = pp->next;
- remove_proxy(pp);
- pp = ppnext;
- }
-}
-
-static void ensure_write_queue(WriteQueue *wq, int size)
-{
- if (wq->size < size) {
- wq->buf = esock_realloc(wq->buf, size);
- wq->size = size;
- }
-}
-
-
-
-
-
-
-
diff --git a/lib/ssl/c_src/esock.h b/lib/ssl/c_src/esock.h
deleted file mode 100644
index 16c9faa530..0000000000
--- a/lib/ssl/c_src/esock.h
+++ /dev/null
@@ -1,273 +0,0 @@
-/*<copyright>
- * <year>1999-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Implementation of Secure Socket Layer (SSL).
- *
- */
-
-#ifndef ESOCK_H
-#define ESOCK_H
-
-#ifdef __WIN32__
-#include "esock_winsock.h"
-#endif
-#include <stdio.h>
-
-#ifdef __WIN32__
-#define INVALID_FD INVALID_SOCKET
-
-#define sock_read(fd, buf, len) recv((fd), (buf), (len), 0)
-#define sock_write(fd, buf, len) send((fd), (buf), (len), 0)
-#define sock_close(fd) closesocket(fd)
-#define sock_errno() WSAGetLastError()
-#define sock_set_errno(err) WSASetLastError(err)
-
-#define ERRNO_NONE 0
-#define ERRNO_BLOCK WSAEWOULDBLOCK
-#define ERRNO_CONNREFUSED WSAECONNREFUSED
-#define ERRNO_PROGRESS WSAEINPROGRESS
-#define ERRNO_PROTONOSUPPORT WSAEPROTONOSUPPORT
-#define ERRNO_INVAL WSAEINVAL
-#define ERRNO_ADDRNOTAVAIL WSAEADDRNOTAVAIL
-#define ERRNO_NOTSOCK WSAENOTSOCK
-#define ERRNO_OPNOTSUPP WSAEOPNOTSUPP
-#define ERRNO_MFILE WSAEMFILE
-#define SET_BLOCKING(fd) do { \
- unsigned long zeroval = 0; \
- ioctlsocket((fd), FIONBIO, &zeroval); \
- } while (0)
-#define SET_NONBLOCKING(fd) do { \
- unsigned long oneval = 1; \
- ioctlsocket((fd), FIONBIO, &oneval); \
- } while (0)
-#else
-#define INVALID_FD (-1)
-
-#define sock_read(fd, buf, len) read((fd), (buf), (len))
-#define sock_write(fd, buf, len) write((fd), (buf), (len))
-#define sock_close(fd) close(fd)
-#define sock_errno() errno
-#define sock_set_errno(err) do {errno = (err);} while(0)
-
-#define ERRNO_NONE 0
-#define ERRNO_BLOCK EAGAIN
-#define ERRNO_CONNREFUSED ECONNREFUSED
-#define ERRNO_PROGRESS EINPROGRESS
-#define ERRNO_PROTONOSUPPORT EPROTONOSUPPORT
-#define ERRNO_INVAL EINVAL
-#define ERRNO_ADDRNOTAVAIL EADDRNOTAVAIL
-#define ERRNO_NOTSOCK ENOTSOCK
-#define ERRNO_OPNOTSUPP EOPNOTSUPP
-#define ERRNO_MFILE EMFILE
-#define SET_BLOCKING(fd) fcntl((fd), F_SETFL, \
- fcntl((fd), F_GETFL, 0) & ~O_NONBLOCK)
-#define SET_NONBLOCKING(fd) fcntl((fd), F_SETFL, \
- fcntl((fd), F_GETFL, 0) | O_NONBLOCK)
-#endif
-
-#define GET_INT8(s) ((s)[0])
-#define GET_INT16(s) (((s)[0] << 8) | (s)[1])
-#define GET_INT32(s) (((s)[0] << 24) | ((s)[1] << 16) | \
- ((s)[2] << 8) | (s)[3])
-
-#define PUT_INT8(x, s) do { (s)[0] = x; } while(0)
-#define PUT_INT16(x, s) do { (s)[0] = ((x) >> 8) & 0xff; \
- (s)[1] = ((x) & 0xff); } while(0)
-#define PUT_INT32(x, s) do { (s)[0] = ((x) >> 24) & 0xff; \
- (s)[1] = ((x) >> 16) & 0xff; \
- (s)[2] = ((x) >> 8) & 0xff; \
- (s)[3] = (x) & 0xff; } while(0)
-
-/* type for Connections */
-#define ESOCK_STATE_NONE 0
-#define ESOCK_ACTIVE_LISTENING 1
-#define ESOCK_PASSIVE_LISTENING 2
-#define ESOCK_CONNECTED 3
-#define ESOCK_WAIT_CONNECT 4
-#define ESOCK_SSL_CONNECT 5
-#define ESOCK_SSL_ACCEPT 6
-#define ESOCK_TRANSPORT_ACCEPT 7
-#define ESOCK_JOINED 8
-#define ESOCK_SSL_SHUTDOWN 9
-#define ESOCK_DEFUNCT 10
-
-#ifdef __WIN32__
- typedef SOCKET FD;
-#else
- typedef int FD;
-#endif
-
-/* For the shutdown(fd, how) call */
-#ifdef __WIN32__
-#define SHUTDOWN_READ SD_RECEIVE
-#define SHUTDOWN_WRITE SD_SEND
-#define SHUTDOWN_ALL SD_BOTH
-#else
-#define SHUTDOWN_READ 0
-#define SHUTDOWN_WRITE 1
-#define SHUTDOWN_ALL 2
-#endif
-
-#define ORIG_LISTEN 0
-#define ORIG_ACCEPT 1
-#define ORIG_CONNECT 2
-
-typedef struct {
- int size; /* Total size of buf */
- unsigned char *buf;
- int len; /* Current number of bytes in buf */
- int offset; /* Bytes already written */
-} WriteQueue;
-
-typedef struct _proxy Proxy;
-
-typedef struct Connection {
- FD fd;
- FD listen_fd; /* Needed for async listen error */
- unsigned char state;
- int acceptors; /* Count acceptors for listen socket */
- Proxy *proxy;
- void *opaque; /* Any suitable ssl structure */
- int ssl_want; /* read/write flags */
- int eof; /* end of file (read) */
- int bp; /* broken pipe (write) */
- int clean; /* Clean SSL shutdown initiated */
- int close; /* Close if set */
- int origin; /* listen, accept or connect */
- int encrypted; /* 1 = SSL encrypted, 0 = normal, unencrypted tcp */
- char *flags; /* ssl parameters */
- FILE *logfp; /* connection log file (not used) */
- WriteQueue wq;
- struct Connection* next;
- const char* errstr; /* only used to report errors from ssl_accept_init in SSL_ACCEPT */
-} Connection;
-
-struct _proxy {
- FD fd;
- int peer_port;
- int eof; /* end of file (read) */
- int bp; /* broken pipe (write) */
- Connection *conn;
- WriteQueue wq;
- Proxy *next;
-};
-
-/* Commands, replies, and error responses */
-
-#define ESOCK_CONNECT_CMD 1
-#define ESOCK_CONNECT_WAIT_REP 2
-#define ESOCK_CONNECT_REP 3
-#define ESOCK_CONNECT_ERR 4
-
-#define ESOCK_TERMINATE_CMD 5
-#define ESOCK_CLOSE_CMD 6
-
-#define ESOCK_LISTEN_CMD 7
-#define ESOCK_LISTEN_REP 8
-#define ESOCK_LISTEN_ERR 9
-
-#define ESOCK_TRANSPORT_ACCEPT_CMD 10
-#define ESOCK_NOACCEPT_CMD 11
-#define ESOCK_TRANSPORT_ACCEPT_REP 12
-#define ESOCK_TRANSPORT_ACCEPT_ERR 13
-
-#define ESOCK_FROMNET_CLOSE_REP 14
-
-#define ESOCK_CONNECT_SYNC_ERR 15
-#define ESOCK_LISTEN_SYNC_ERR 16
-
-#define ESOCK_PROXY_PORT_REP 23
-#define ESOCK_PROXY_JOIN_CMD 24
-#define ESOCK_PROXY_JOIN_REP 25
-#define ESOCK_PROXY_JOIN_ERR 26
-
-#define ESOCK_SET_SOCKOPT_CMD 27
-#define ESOCK_IOCTL_OK 28
-#define ESOCK_IOCTL_ERR 29
-
-#define ESOCK_GETPEERNAME_CMD 30
-#define ESOCK_GETPEERNAME_REP 31
-#define ESOCK_GETPEERNAME_ERR 32
-
-#define ESOCK_GETSOCKNAME_CMD 33
-#define ESOCK_GETSOCKNAME_REP 34
-#define ESOCK_GETSOCKNAME_ERR 35
-
-#define ESOCK_GETPEERCERT_CMD 36
-#define ESOCK_GETPEERCERT_REP 37
-#define ESOCK_GETPEERCERT_ERR 38
-
-#define ESOCK_GETVERSION_CMD 39
-#define ESOCK_GETVERSION_REP 40
-
-#define ESOCK_SET_SEED_CMD 41
-
-#define ESOCK_GETCONNINFO_CMD 42
-#define ESOCK_GETCONNINFO_REP 43
-#define ESOCK_GETCONNINFO_ERR 44
-
-#define ESOCK_SSL_ACCEPT_CMD 45
-#define ESOCK_SSL_ACCEPT_REP 46
-#define ESOCK_SSL_ACCEPT_ERR 47
-
-#define ESOCK_DUMP_STATE_CMD 48
-#define ESOCK_SET_DEBUG_CMD 49
-#define ESOCK_SET_DEBUGMSG_CMD 50
-
-
-/* Option codes for ESOCK_SET_SOCKOPT_CMD */
-#define ESOCK_SET_TCP_NODELAY 1
-
-/* SSL want to read or write */
-#define ESOCK_SSL_WANT_READ 1
-#define ESOCK_SSL_WANT_WRITE 2
-
-/* Protocol version according to ssl_server */
-#define ESOCK_SSLv2 1
-#define ESOCK_SSLv3 2
-#define ESOCK_TLSv1 4
-
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ssl/c_src/esock_openssl.c b/lib/ssl/c_src/esock_openssl.c
deleted file mode 100644
index 0bc42958f0..0000000000
--- a/lib/ssl/c_src/esock_openssl.c
+++ /dev/null
@@ -1,1213 +0,0 @@
-/*<copyright>
- * <year>1999-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Adaptions for the OpenSSL package.
- *
- * This file implements the functions defined in esock_ssl.h for
- * the OpenSSL package.
- *
- * The following holds true for non-blockling I/O:
- *
- * Function Return values
- * -------- -------------
- * SSL_accept() success: 1, failure: =<0
- * SSL_connect() success: 1, failure: =<0
- * SSL_read() success: >0, eof: 0, failure: <0
- * SSL_write() success: > 0, failure: =<0
- * SSL_shutdown() success: 1, not finished: 0
- *
- * If the return value of any of the above functions is `ret' and the
- * ssl connection is `ssl', the call
- *
- * ssl_error = SSL_get_error(ssl, ret);
- *
- * returns one of the following eight values:
- *
- * SSL_ERROR_NONE ret > 0
- * SSL_ERROR_ZERO_RETURN ret = 0
- * SSL_ERROR_WANT_READ ret < 0 and ssl wants to read
- * SSL_ERROR_WANT_WRITE ret < 0 and ssl wants to write
- * SSL_ERROR_SYSCALL ret < 0 or ret = 0
- * SSL_ERROR_SSL if there was an ssl internal error
- * SSL_ERROR_WANT_X509_LOOKUP ret < 0 and ssl wants x509 lookup
- * SSL_ERROR_WANT_CONNECT ret < 0 and ssl wants connect
- *
- * It is the case that SSL_read() sometimes returns -1, even when the
- * underlying file descriptor is ready for reading.
- *
- * Also, sometimes we may have SSL_ERROR_SSL in SSL_accept() and SSL_connect()
- * when a retry should be done.
- *
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <errno.h>
-#ifndef __WIN32__
-# include <fcntl.h>
-# include <unistd.h>
-#endif
-
-#include "esock.h"
-#include "esock_ssl.h"
-#include "debuglog.h"
-#include "esock_utils.h"
-#include "esock_posix_str.h"
-
-#include <openssl/crypto.h>
-#include <openssl/ssl.h>
-#include <openssl/err.h>
-#include <openssl/rand.h>
-
-int ephemeral_rsa = 0;
-int ephemeral_dh = 0; /* XXX Not used yet */
-int protocol_version = 0;
-
-char *esock_ssl_errstr = "";
-
-#define FLAGSBUFSIZE 512
-#define X509BUFSIZE 256
-#define DEFAULT_VERIFY_DEPTH 1
-
-#define SET_WANT(cp, ssl_error) \
- switch((ssl_error)) { \
- case SSL_ERROR_WANT_READ: \
- (cp)->ssl_want = ESOCK_SSL_WANT_READ; \
- break; \
- case SSL_ERROR_WANT_WRITE: \
- (cp)->ssl_want = ESOCK_SSL_WANT_WRITE; \
- break; \
- default: \
- (cp)->ssl_want = 0; \
- break; \
- }
-
-#define RESET_ERRSTR() \
- esock_ssl_errstr = "";
-
-#define MAYBE_SET_ERRSTR(s) \
- if (!esock_ssl_errstr[0]) \
- esock_ssl_errstr = (s);
-
-typedef struct {
- int code;
- char *text;
-} err_entry;
-
-typedef struct {
- SSL_CTX *ctx;
- char *passwd;
- int verify_depth;
-} callback_data;
-
-static char *ssl_error_str(int error);
-static void end_ssl_call(int ret, Connection *cp, int ssl_error);
-static void check_shutdown(Connection *cp);
-static int set_ssl_parameters(Connection *cp, SSL_CTX *ctx);
-static int verify_callback(int ok, X509_STORE_CTX *ctx);
-static int passwd_callback(char *buf, int num, int rwflag, void *userdata);
-static void info_callback(const SSL *ssl, int where, int ret);
-static void callback_data_free(void *parent, void *ptr,
- CRYPTO_EX_DATA *ad,
- int idx, long arg1, void *argp);
-static RSA *tmp_rsa_callback(SSL *ssl, int is_export, int keylen);
-static void restrict_protocols(SSL_CTX *ctx);
-
-static err_entry errs[] = {
- {SSL_ERROR_NONE, "SSL_ERROR_NONE"},
- {SSL_ERROR_ZERO_RETURN, "SSL_ERROR_ZERO_RETURN"},
- {SSL_ERROR_WANT_READ, "SSL_ERROR_WANT_READ"},
- {SSL_ERROR_WANT_WRITE, "SSL_ERROR_WANT_WRITE"},
- {SSL_ERROR_SYSCALL, "SSL_ERROR_SYSCALL"},
- {SSL_ERROR_SSL, "SSL_ERROR_SSL"},
- {SSL_ERROR_WANT_X509_LOOKUP, "SSL_ERROR_WANT_X509_LOOKUP"},
- {SSL_ERROR_WANT_CONNECT, "SSL_ERROR_WANT_CONNECT"}
-};
-
-static SSL_METHOD *method; /* for listen and connect init */
-static char x509_buf[X509BUFSIZE]; /* for verify_callback */
-static int callback_data_index = -1; /* for ctx ex_data */
-static unsigned char randvec[1024]; /* XXX */
-
-#if defined(__WIN32__) || OPEN_MAX > 256
-# define FOPEN_WORKAROUND(var, expr) var = (expr)
-# define VOID_FOPEN_WORKAROUND(expr) expr
-#else
-/*
- * This is an ugly workaround. On Solaris, fopen() will return NULL if
- * it gets a file descriptor > 255. To avoid that, we'll make sure that
- * there is always one low-numbered file descriptor available when
- * fopen() is called.
- */
-static int reserved_fd; /* Reserve a low-numbered file descriptor */
-# define USE_FOPEN_WORKAROUND 1
-
-# define FOPEN_WORKAROUND(var, expr) \
-do { \
- close(reserved_fd); \
- var = (expr); \
- reserved_fd = open("/dev/null", O_RDONLY); \
-} while (0)
-
-# define VOID_FOPEN_WORKAROUND(expr) \
-do { \
- close(reserved_fd); \
- expr; \
- reserved_fd = open("/dev/null", O_RDONLY); \
-} while (0)
-#endif
-
-esock_version *esock_ssl_version(void)
-{
- static esock_version vsn;
-
- vsn.compile_version = OPENSSL_VERSION_TEXT;
- vsn.lib_version = SSLeay_version(SSLEAY_VERSION);
- return &vsn;
-}
-
-char *esock_ssl_ciphers(void)
-{
- SSL_CTX *ctx;
- SSL *ssl;
- char *ciphers;
- const char *cp;
- int i = 0, used = 0, len, incr = 1024;
-
- if (!(ctx = SSL_CTX_new(method)))
- return NULL;
- restrict_protocols(ctx);
- if (!(ssl = SSL_new(ctx))) {
- SSL_CTX_free(ctx);
- return NULL;
- }
-
- ciphers = esock_malloc(incr);
- len = incr;
- *ciphers = '\0';
-
- while (1) {
- if (!(cp = SSL_get_cipher_list(ssl, i)))
- break;
- if (i > 0) {
- if (used == len) {
- len += incr;
- ciphers = esock_realloc(ciphers, len);
- }
- strcat(ciphers, ":");
- used++;
- }
- if (strlen(cp) + used >= len) {
- len += incr;
- ciphers = esock_realloc(ciphers, len);
- }
- strcat(ciphers, cp);
- used += strlen(cp);
- i++;
- }
- SSL_free(ssl);
- SSL_CTX_free(ctx);
- return ciphers;
-}
-
-void esock_ssl_seed(void *buf, int len)
-{
- RAND_seed(buf, len);
-
- /* XXX Maybe we should call RAND_status() and check if we have got
- * enough randomness.
- */
-}
-
-int esock_ssl_init(void)
-{
- method = SSLv23_method(); /* SSLv2, SSLv3 and TLSv1, may be restricted
- in listen and connect */
- SSL_load_error_strings();
- SSL_library_init();
- esock_ssl_seed(randvec, sizeof(randvec));
- callback_data_index = SSL_CTX_get_ex_new_index(0, "callback_data",
- NULL, NULL,
- callback_data_free);
-#ifdef USE_FOPEN_WORKAROUND
- reserved_fd = open("/dev/null", O_RDONLY);
- DEBUGF(("init: reserved_fd=%d\r\n", reserved_fd));
-#endif
- return 0;
-}
-
-
-void esock_ssl_finish(void)
-{
- /* Nothing */
-}
-
-
-void esock_ssl_free(Connection *cp)
-{
- SSL *ssl = cp->opaque;
- SSL_CTX *ctx;
-
- if (ssl) {
- ctx = SSL_get_SSL_CTX(ssl);
- SSL_free(ssl);
- if (cp->origin != ORIG_ACCEPT)
- SSL_CTX_free(ctx);
- cp->opaque = NULL;
- }
-}
-
-
-/*
- * Print SSL specific errors.
- */
-void esock_ssl_print_errors_fp(FILE *fp)
-{
- ERR_print_errors_fp(fp);
-}
-
-
-int esock_ssl_accept_init(Connection *cp, void *listenssl)
-{
- SSL_CTX *listenctx;
- SSL *ssl;
-
- RESET_ERRSTR();
- MAYBE_SET_ERRSTR("esslacceptinit");
-
- if(!listenssl) {
- DEBUGF(("esock_ssl_accept_init: listenssl null\n"));
- return -1;
- }
- if (!(listenctx = SSL_get_SSL_CTX(listenssl))) {
- DEBUGF(("esock_ssl_accept_init: SSL_get_SSL_CTX\n"));
- return -1;
- }
- if (!(ssl = cp->opaque = SSL_new(listenctx))) {
- DEBUGF(("esock_ssl_accept_init: SSL_new(listenctx)\n"));
- return -1;
- }
- SSL_set_fd(ssl, cp->fd);
- return 0;
-
-}
-
-
-int esock_ssl_connect_init(Connection *cp)
-{
- SSL_CTX *ctx;
- SSL *ssl;
-
- RESET_ERRSTR();
- MAYBE_SET_ERRSTR("esslconnectinit");
-
- if (!(ctx = SSL_CTX_new(method)))
- return -1;
- if (set_ssl_parameters(cp, ctx) < 0) {
- SSL_CTX_free(ctx);
- return -1;
- }
- restrict_protocols(ctx);
- if (!(ssl = cp->opaque = SSL_new(ctx))) {
- SSL_CTX_free(ctx);
- return -1;
- }
- SSL_set_fd(ssl, cp->fd);
- return 0;
-}
-
-
-int esock_ssl_listen_init(Connection *cp)
-{
- SSL_CTX *ctx;
- SSL *ssl;
-
- RESET_ERRSTR();
- MAYBE_SET_ERRSTR("essllisteninit");
-
- if (!(ctx = SSL_CTX_new(method)))
- return -1;
- if (set_ssl_parameters(cp, ctx) < 0) {
- SSL_CTX_free(ctx);
- return -1;
- }
- restrict_protocols(ctx);
-
- /* The allocation of ctx is for setting ssl parameters, so that
- * accepts can inherit them. We allocate ssl to be able to
- * refer to it via cp->opaque, but will not be used otherwise.
- */
- if (!(ssl = cp->opaque = SSL_new(ctx))) {
- SSL_CTX_free(ctx);
- return -1;
- }
- /* Set callback for temporary ephemeral RSA key generation.
- * Note: for servers only. */
- SSL_CTX_set_tmp_rsa_callback(ctx, tmp_rsa_callback);
- return 0;
-}
-
-/*
- * esock_ssl_accept(Connection *cp)
- *
- */
-int esock_ssl_accept(Connection *cp)
-{
- int ret, ssl_error;
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
-
- DEBUGF(("esock_ssl_accept: calling SSL_accept fd = %d\n"
- " state before: %s\n", cp->fd, SSL_state_string(ssl)));
- ret = SSL_accept(ssl);
- DEBUGF((" sock_errno %d errno %d \n", sock_errno(), errno));
- ssl_error = SSL_get_error(ssl, ret);
- DEBUGF((" SSL_accept = %d\n"
- " ssl_error: %s\n"
- " state after: %s\n",
- ret, ssl_error_str(ssl_error), SSL_state_string(ssl)));
- DEBUGF((" ret %d os error %s\n", ret, strerror(errno)));
- if (ret > 0)
- return ret;
- else if (ret == 0) {
- const char* f; int l; unsigned int e;
- while ((e = ERR_get_error_line(&f, &l))) {
- DEBUGF((" error %s:%d %s\n", f, l, ssl_error_str(e)));
- }
- /* permanent accept error */
- sock_set_errno(ERRNO_NONE);
- MAYBE_SET_ERRSTR("esslaccept");
- return -1;
- }
- end_ssl_call(ret, cp, ssl_error);
- return ret;
-}
-
-/*
- * esock_ssl_connect(Connection *cp)
- *
- */
-int esock_ssl_connect(Connection *cp)
-{
- int ret, ssl_error;
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
-
- DEBUGF(("esock_ssl_connect: calling SSL_connect fd = %d\n"
- " state before: %s\n", cp->fd, SSL_state_string(ssl)));
- ret = SSL_connect(ssl);
- ssl_error = SSL_get_error(ssl, ret);
- DEBUGF((" SSL_connect() = %d\n"
- " ssl_error: %s\n"
- " state after: %s\n",
- ret, ssl_error_str(ssl_error), SSL_state_string(ssl)));
- if (ret > 0)
- return ret;
- else if (ret == 0) {
- /* permanent connect error */
- sock_set_errno(ERRNO_NONE);
- MAYBE_SET_ERRSTR("esslconnect");
- return -1;
- }
- end_ssl_call(ret, cp, ssl_error);
- return ret;
-}
-
-
-int esock_ssl_session_reused(Connection *cp)
-{
- SSL *ssl = cp->opaque;
-
- return SSL_session_reused(ssl);
-}
-
-
-/* esock_ssl_read(Connection *cp, char *buf, int len)
- *
- * Read at most `len' chars into `buf'. Returns number of chars
- * read ( > 0), or 0 at EOF, or -1 on error. Sets cp->eof, cp->bp if
- * appropriate.
- */
-
-int esock_ssl_read(Connection *cp, char *buf, int len)
-{
- int ret, ssl_error;
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
- DEBUGF(("esock_ssl_read: calling SSL_read fd = %d\n"
- " state before: %s\n", cp->fd, SSL_state_string(ssl)));
-
- ret = SSL_read(ssl, buf, len);
- ssl_error = SSL_get_error(ssl, ret);
-
- DEBUGF((" SSL_read = %d\n"
- " ssl_error: %s\n"
- " state after: %s\n",
- ret, ssl_error_str(ssl_error), SSL_state_string(ssl)));
-
- if (ssl_error == SSL_ERROR_NONE) {
- DEBUGMSGF(("message (hex) : [%3.*a]\n", ret, buf));
- DEBUGMSGF(("message (char): [%3.*b]\n", ret, buf));
- }
- if (ret > 0)
- return ret;
- if (ret == 0) {
- check_shutdown(cp);
- return ret;
- }
- end_ssl_call(ret, cp, ssl_error);
- return ret;
-}
-
-/*
- * esock_ssl_write(Connection *cp, char *buf, int len)
- *
- * Writes at most `len' chars from `buf'. Returns number of chars
- * written, or -1 on error.
- */
-int esock_ssl_write(Connection *cp, char *buf, int len)
-{
- int ret, ssl_error;
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
- DEBUGF(("esock_ssl_write: calling SSL_write fd = %d\n"
- " state before: %s\n", cp->fd, SSL_state_string(ssl)));
- ret = SSL_write(ssl, buf, len);
- ssl_error = SSL_get_error(ssl, ret);
- DEBUGF((" SSL_write = %d\n"
- " ssl_error: %s\n"
- " state after: %s\n",
- ret, ssl_error_str(ssl_error), SSL_state_string(ssl)));
- if (ssl_error == SSL_ERROR_NONE) {
- DEBUGMSGF(("message (hex) : [%3.*a]\n", ret, buf));
- DEBUGMSGF(("message (char): [%3.*b]\n", ret, buf));
- }
- if (ret > 0)
- return ret;
- if (ret == 0) {
- check_shutdown(cp);
- return ret;
- }
- end_ssl_call(ret, cp, ssl_error);
- return ret;
-}
-
-
-int esock_ssl_shutdown(Connection *cp)
-{
- int ret, ssl_error;
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
- DEBUGF(("esock_ssl_shutdown: calling SSL_shutdown fd = %d\n"
- " state before: %s\n", cp->fd, SSL_state_string(ssl)));
- ret = SSL_shutdown(ssl);
- ssl_error = SSL_get_error(ssl, ret);
- DEBUGF((" SSL_shutdown = %d\n"
- " ssl_error: %s\n"
- " state after: %s\n",
- ret, ssl_error_str(ssl_error), SSL_state_string(ssl)));
- if (ret >= 0) {
- check_shutdown(cp);
- return ret;
- }
- end_ssl_call(ret, cp, ssl_error);
- return ret;
-}
-
-
-/* Returns total number of bytes in DER encoded cert pointed to by
- * *buf, which is allocated by this function, unless return < 0.
- * XXX X509_free ??
- */
-int esock_ssl_getpeercert(Connection *cp, unsigned char **buf)
-{
- int len;
- SSL *ssl = cp->opaque;
- X509 *x509;
- unsigned char *tmp;
-
- RESET_ERRSTR();
- if((x509 = SSL_get_peer_certificate(ssl)) == NULL) {
- MAYBE_SET_ERRSTR("enopeercert"); /* XXX doc */
- return -1;
- }
-
- if ((len = i2d_X509(x509, NULL)) <= 0) {
- MAYBE_SET_ERRSTR("epeercert");
- return -1;
- }
-
- tmp = *buf = esock_malloc(len);
-
- /* We must use a temporary value here, since i2d_X509(X509 *x,
- * unsigned char **out) increments *out.
- */
- if (i2d_X509(x509, &tmp) < 0) {
- esock_free(tmp);
- MAYBE_SET_ERRSTR("epeercert");
- return -1;
- }
- return len;
-}
-
-/* Returns total number of bytes in chain of certs. Each cert begins
- * with a 4-bytes length. The last cert is ended with 4-bytes of
- * zeros. The result is returned in *buf, which is allocated unless
- * the return value is < 0.
- * XXX X509_free ? sk_X509_free ?
- * XXX X509_free is reference counting.
- */
-int esock_ssl_getpeercertchain(Connection *cp, unsigned char **buf)
-{
- SSL *ssl = cp->opaque;
- STACK_OF(X509) *x509_stack;
- X509 *x509;
- int num, i, totlen, pos, *der_len;
- unsigned char *vbuf;
-
- RESET_ERRSTR();
- if((x509_stack = SSL_get_peer_cert_chain(ssl)) == NULL) {
- MAYBE_SET_ERRSTR("enopeercertchain"); /* XXX doc */
- return -1;
- }
-
- num = sk_X509_num(x509_stack);
- der_len = esock_malloc(num * sizeof(int));
- totlen = 0;
-
- for (i = 0; i < num; i++) {
- x509 = sk_X509_value(x509_stack, i);
- totlen += 4;
- if ((der_len[i] = i2d_X509(x509, NULL)) < 0) {
- MAYBE_SET_ERRSTR("epeercertchain");
- esock_free(der_len);
- return -1;
- }
- totlen += der_len[i];
- }
- totlen += 4;
-
- vbuf = *buf = esock_malloc(totlen);
- pos = 0;
-
- for (i = 0; i < num; i++) {
- x509 = sk_X509_value(x509_stack, i);
- PUT_INT32(der_len[i], vbuf);
- vbuf += 4;
- /* Note: i2d_X509 increments vbuf */
- if (i2d_X509(x509, &vbuf) < 0) {
- MAYBE_SET_ERRSTR("epeercertchain");
- esock_free(*buf);
- esock_free(der_len);
- return -1;
- }
- }
- esock_free(der_len);
- return totlen;
-}
-
-
-int esock_ssl_getprotocol_version(Connection *cp, char **buf)
-{
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
- if (!ssl) {
- MAYBE_SET_ERRSTR("enoent");
- return -1;
- }
- *buf = (char *) SSL_get_version(ssl);
-
- return 0;
-}
-
-
-int esock_ssl_getcipher(Connection *cp, char **buf)
-{
- SSL *ssl = cp->opaque;
-
- RESET_ERRSTR();
- if (!ssl) {
- MAYBE_SET_ERRSTR("enoent");
- return -1;
- }
- *buf = (char *) SSL_get_cipher(ssl);
-
- return 0;
-}
-
-/* Local functions */
-
-static char *ssl_error_str(int ssl_error)
-{
- int i;
- static char buf[128];
-
- for (i = 0; i < sizeof(errs)/sizeof(err_entry); i ++) {
- if (ssl_error == errs[i].code)
- return errs[i].text;
- }
- sprintf(buf, "esock_openssl: SSL_error unknown: %d", ssl_error);
- return buf;
-}
-
-void end_ssl_call(int ret, Connection *cp, int ssl_error)
-{
- SET_WANT(cp, ssl_error);
- switch (ssl_error) {
- case SSL_ERROR_SYSCALL:
- /* Typically sock_errno() is equal to ERRNO_BLOCK */
- MAYBE_SET_ERRSTR(esock_posix_str(sock_errno()));
- break;
- case SSL_ERROR_SSL:
- sock_set_errno(ERRNO_NONE);
- MAYBE_SET_ERRSTR("esslerrssl");
- break;
- case SSL_ERROR_WANT_X509_LOOKUP:
- SSLDEBUGF();
- sock_set_errno(ERRNO_NONE);
- MAYBE_SET_ERRSTR("ex509lookup");
- break;
- case SSL_ERROR_WANT_CONNECT:
- SSLDEBUGF();
- sock_set_errno(ERRNO_NONE);
- MAYBE_SET_ERRSTR("ewantconnect");
- break;
- default:
- break;
- }
-}
-
-void check_shutdown(Connection *cp)
-{
- int sd_mode;
- SSL *ssl = cp->opaque;
-
- sd_mode = SSL_get_shutdown(ssl);
- if (sd_mode & SSL_RECEIVED_SHUTDOWN)
- cp->eof = 1;
- if (sd_mode & SSL_SENT_SHUTDOWN) {
- DEBUGF(("check_shutdown SSL_SENT_SHUTDOWN\n"));
- cp->bp = 1;
- }
-}
-
-/*
- * set_ssl_parameters
- *
- * Set ssl parameters from connection structure. Only called for
- * listen and connect.
- *
- * Note: The -cacertdir option is not documented.
- */
-static int set_ssl_parameters(Connection *cp, SSL_CTX *ctx)
-{
- char *cacertfile = NULL, *cacertdir = NULL, *certfile = NULL;
- char *keyfile = NULL, *ciphers = NULL, *password = NULL;
- int verify = 0, verify_depth = DEFAULT_VERIFY_DEPTH, verify_mode;
- int i, argc;
- char **argv;
- callback_data *cb_data;
-
- RESET_ERRSTR();
-
- argc = esock_build_argv(cp->flags, &argv);
-
- DEBUGF(("Argv:\n"));
- for (i = 0; i < argc; i++) {
- DEBUGF(("%d: %s\n", i, argv[i]));
- }
-
- for (i = 0; i < argc; i++) {
- if (strcmp(argv[i], "-verify") == 0) {
- verify = atoi(argv[++i]);
- } else if (strcmp(argv[i], "-depth") == 0) {
- verify_depth = atoi(argv[++i]);
- } else if (strcmp(argv[i], "-log") == 0) {
- /* XXX ignored: logging per connection not supported */
- i++;
- } else if (strcmp(argv[i], "-certfile") == 0) {
- certfile = argv[++i];
- } else if (strcmp(argv[i], "-keyfile") == 0) {
- keyfile = argv[++i];
- } else if (strcmp(argv[i], "-password") == 0) {
- password = argv[++i];
- } else if (strcmp(argv[i], "-cacertfile") == 0) {
- cacertfile = argv[++i];
- } else if (strcmp(argv[i], "-cacertdir") == 0) {
- cacertdir = argv[++i];
- } else if (strcmp(argv[i], "-d") == 0) {
- /* XXX ignored: debug per connection not supported */
- i++;
- } else if (strcmp(argv[i], "-ciphers") == 0) {
- ciphers = argv[++i];
- } else {
- /* XXX Error: now ignored */
- }
- }
- DEBUGF(("set_ssl_parameters: all arguments read\n"));
-
- if (cp->origin == ORIG_LISTEN && !certfile) {
- DEBUGF(("ERROR: Server must have certificate\n"));
- MAYBE_SET_ERRSTR("enoservercert");
- goto err_end;
- }
-
- /* Define callback data */
- /* XXX Check for NULL */
- cb_data = esock_malloc(sizeof(callback_data));
- cb_data->ctx = ctx;
- if (password) {
- cb_data->passwd = esock_malloc(strlen(password) + 1);
- strcpy(cb_data->passwd, password);
- } else
- cb_data->passwd = NULL;
- cb_data->verify_depth = verify_depth;
- SSL_CTX_set_ex_data(ctx, callback_data_index, cb_data);
-
- /* password callback */
- SSL_CTX_set_default_passwd_cb(ctx, passwd_callback);
- SSL_CTX_set_default_passwd_cb_userdata(ctx, cb_data);
-
- /* Set location for "trusted" certificates */
- if (cacertfile || cacertdir) {
- int res;
- DEBUGF(("set_ssl_parameters: SSL_CTX_load_verify_locations\n"));
- FOPEN_WORKAROUND(res, SSL_CTX_load_verify_locations(ctx, cacertfile,
- cacertdir));
- if (!res) {
- DEBUGF(("ERROR: Cannot load verify locations\n"));
- MAYBE_SET_ERRSTR("ecacertfile");
- goto err_end;
- }
- } else {
- int res;
- DEBUGF(("set_ssl_parameters: SSL_CTX_set_default_verify_paths\n"));
- FOPEN_WORKAROUND(res, SSL_CTX_set_default_verify_paths(ctx));
- if (!res) {
- DEBUGF(("ERROR: Cannot set default verify paths\n"));
- MAYBE_SET_ERRSTR("ecacertfile");
- goto err_end;
- }
- }
-
- /* For a server the following sets the list of CA distinguished
- * names that it sends to its client when it requests the
- * certificate from the client.
- * XXX The names of certs in cacertdir ignored.
- */
- if (cp->origin == ORIG_LISTEN && cacertfile) {
- DEBUGF(("set_ssl_parameters: SSL_CTX_set_client_CA_list\n"));
- VOID_FOPEN_WORKAROUND(SSL_CTX_set_client_CA_list(ctx,
- SSL_load_client_CA_file(cacertfile)));
- if (!SSL_CTX_get_client_CA_list(ctx)) {
- DEBUGF(("ERROR: Cannot set client CA list\n"));
- MAYBE_SET_ERRSTR("ecacertfile");
- goto err_end;
- }
- }
-
- /* Use certificate file if key file has not been set. */
- if (!keyfile)
- keyfile = certfile;
-
- if (certfile) {
- int res;
- DEBUGF(("set_ssl_parameters: SSL_CTX_use_certificate_file\n"));
- FOPEN_WORKAROUND(res, SSL_CTX_use_certificate_file(ctx, certfile,
- SSL_FILETYPE_PEM));
- if (res <= 0) {
- DEBUGF(("ERROR: Cannot set certificate file\n"));
- MAYBE_SET_ERRSTR("ecertfile");
- goto err_end;
- }
- }
- if (keyfile) {
- int res;
- DEBUGF(("set_ssl_parameters: SSL_CTX_use_PrivateKey_file\n"));
- FOPEN_WORKAROUND(res, SSL_CTX_use_PrivateKey_file(ctx, keyfile,
- SSL_FILETYPE_PEM));
- if (res <= 0) {
- DEBUGF(("ERROR: Cannot set private key file\n"));
- MAYBE_SET_ERRSTR("ekeyfile");
- goto err_end;
- }
- }
- if(certfile && keyfile) {
- DEBUGF(("set_ssl_parameters: SSL_CTX_check_private_key\n"));
- if (!SSL_CTX_check_private_key(ctx)) {
- DEBUGF(("ERROR: Private key does not match the certificate\n"));
- MAYBE_SET_ERRSTR("ekeymismatch");
- goto err_end;
- }
- }
-
- /* Ciphers */
- if (ciphers) {
- DEBUGF(("set_ssl_parameters: SSL_CTX_set_cipher_list\n"));
- if (!SSL_CTX_set_cipher_list(ctx, ciphers)) {
- DEBUGF(("ERROR: Cannot set cipher list\n"));
- MAYBE_SET_ERRSTR("ecipher");
- goto err_end;
- }
- }
-
- /* Verify depth */
- DEBUGF(("set_ssl_parameters: SSL_CTX_set_verify_depth (depth = %d)\n",
- verify_depth));
- SSL_CTX_set_verify_depth(ctx, verify_depth);
-
- /* Verify mode and callback */
- /* XXX Why precisely these modes? */
- switch (verify) {
- case 0:
- verify_mode = SSL_VERIFY_NONE;
- break;
- case 1:
- verify_mode = SSL_VERIFY_PEER|SSL_VERIFY_CLIENT_ONCE;
- break;
- case 2:
- verify_mode = SSL_VERIFY_PEER|SSL_VERIFY_CLIENT_ONCE|
- SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
- break;
- default:
- verify_mode = SSL_VERIFY_NONE;
- }
- DEBUGF(("set_ssl_parameters: SSL_CTX_set_verify (verify = %d)\n",
- verify));
- SSL_CTX_set_verify(ctx, verify_mode, verify_callback);
-
- /* Session id context. Should be an option really. */
- if (cp->origin == ORIG_LISTEN) {
- unsigned char *sid = "Erlang/OTP/ssl";
- SSL_CTX_set_session_id_context(ctx, sid, strlen(sid));
- }
-
- /* info callback */
- if (debug)
- SSL_CTX_set_info_callback(ctx, info_callback);
-
- DEBUGF(("set_ssl_parameters: done\n"));
- /* Free arg list */
- for (i = 0; argv[i]; i++)
- esock_free(argv[i]);
- esock_free(argv);
- return 0;
-
- err_end:
- DEBUGF(("set_ssl_parameters: error\n"));
- /* Free arg list */
- for (i = 0; argv[i]; i++)
- esock_free(argv[i]);
- esock_free(argv);
- return -1;
-}
-
-/* Call back functions */
-
-static int verify_callback(int ok, X509_STORE_CTX *x509_ctx)
-{
- X509 *cert;
- int cert_err, depth;
- SSL *ssl;
- SSL_CTX *ctx;
- callback_data *cb_data;
-
- cert = X509_STORE_CTX_get_current_cert(x509_ctx);
- cert_err = X509_STORE_CTX_get_error(x509_ctx);
- depth = X509_STORE_CTX_get_error_depth(x509_ctx);
-
- ssl = X509_STORE_CTX_get_ex_data(x509_ctx,
- SSL_get_ex_data_X509_STORE_CTX_idx());
- ctx = SSL_get_SSL_CTX(ssl);
- cb_data = SSL_CTX_get_ex_data(ctx, callback_data_index);
-
- X509_NAME_oneline(X509_get_subject_name(cert), x509_buf, sizeof(x509_buf));
- DEBUGF((" +vfy: depth = %d\n", depth));
- DEBUGF((" subject = %s\n", x509_buf));
- X509_NAME_oneline(X509_get_issuer_name(cert), x509_buf, sizeof(x509_buf));
- DEBUGF((" issuer = %s\n", x509_buf));
-
- if (!ok) {
- DEBUGF((" +vfy: error = %d [%s]\n", cert_err,
- X509_verify_cert_error_string(cert_err)));
- if (depth >= cb_data->verify_depth)
- ok = 1;
- }
-
- switch (cert_err) {
- case X509_V_OK:
- case X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT:
- ok = 1;
- break;
- case X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT:
- case X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY:
- MAYBE_SET_ERRSTR("enoissuercert");
- break;
- case X509_V_ERR_CERT_HAS_EXPIRED:
- MAYBE_SET_ERRSTR("epeercertexpired");
- break;
- case X509_V_ERR_CERT_NOT_YET_VALID:
- case X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD:
- case X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD:
- MAYBE_SET_ERRSTR("epeercertinvalid");
- break;
- case X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN:
- MAYBE_SET_ERRSTR("eselfsignedcert");
- break;
- case X509_V_ERR_CERT_CHAIN_TOO_LONG:
- MAYBE_SET_ERRSTR("echaintoolong");
- break;
- default:
- MAYBE_SET_ERRSTR("epeercert");
- break;
- }
- DEBUGF((" +vfy: return = %d\n",ok));
- return ok;
-}
-
-static int passwd_callback(char *buf, int num, int rwflag, void *userdata)
-{
- callback_data *cb_data = userdata;
- int len;
-
- if (cb_data && cb_data->passwd) {
- DEBUGF((" +passwd: %s\n", cb_data->passwd));
- strncpy(buf, cb_data->passwd, num);
- len = strlen(cb_data->passwd);
- return len;
- }
- DEBUGF((" +passwd: ERROR: No password set.\n"));
- return 0;
-}
-
-static void info_callback(const SSL *ssl, int where, int ret)
-{
- char *str;
-
- if (where & SSL_CB_LOOP) {
- DEBUGF((" info: %s\n",SSL_state_string_long(ssl)));
- } else if (where & SSL_CB_ALERT) {
- str = (where & SSL_CB_READ) ? "read" : "write";
- DEBUGF((" info: SSL3 alert %s:%s:%s\n", str,
- SSL_alert_type_string_long(ret),
- SSL_alert_desc_string_long(ret)));
- } else if (where & SSL_CB_EXIT) {
- if (ret == 0) {
- DEBUGF((" info: failed in %s\n", SSL_state_string_long(ssl)));
- } else if (ret < 0) {
- DEBUGF((" info: error in %s\n", SSL_state_string_long(ssl)));
- }
- }
-}
-
-/* This function is called whenever an SSL_CTX *ctx structure is
- * freed.
-*/
-static void callback_data_free(void *parent, void *ptr, CRYPTO_EX_DATA *ad,
- int idx, long arg1, void *argp)
-{
- callback_data *cb_data = ptr;
-
- if (cb_data) {
- if (cb_data->passwd)
- esock_free(cb_data->passwd);
- esock_free(cb_data);
- }
-}
-
-static RSA *tmp_rsa_callback(SSL *ssl, int is_export, int keylen)
-{
- static RSA *rsa512 = NULL;
- static RSA *rsa1024 = NULL;
-
- switch (keylen) {
- case 512:
- if (!rsa512)
- rsa512 = RSA_generate_key(keylen, RSA_F4, NULL, NULL);
- return rsa512;
- break;
- case 1024:
- if (!rsa1024)
- rsa1024 = RSA_generate_key(keylen, RSA_F4, NULL, NULL);
- return rsa1024;
- break;
- default:
- if (rsa1024)
- return rsa1024;
- if (rsa512)
- return rsa512;
- rsa512 = RSA_generate_key(keylen, RSA_F4, NULL, NULL);
- return rsa512;
- }
-}
-
-/* Restrict protocols (SSLv2, SSLv3, TLSv1) */
-static void restrict_protocols(SSL_CTX *ctx)
-{
- long options = 0;
-
- if (protocol_version) {
- if ((protocol_version & ESOCK_SSLv2) == 0)
- options |= SSL_OP_NO_SSLv2;
- if ((protocol_version & ESOCK_SSLv3) == 0)
- options |= SSL_OP_NO_SSLv3;
- if ((protocol_version & ESOCK_TLSv1) == 0)
- options |= SSL_OP_NO_TLSv1;
- SSL_CTX_set_options(ctx, options);
- }
-}
-
-
-static unsigned char randvec [] = {
- 181, 177, 237, 240, 107, 24, 43, 148,
- 105, 4, 248, 13, 199, 255, 23, 58,
- 71, 181, 57, 151, 156, 25, 165, 7,
- 73, 80, 80, 231, 70, 110, 96, 162,
- 24, 205, 178, 178, 67, 122, 210, 180,
- 92, 6, 156, 182, 84, 159, 85, 6,
- 175, 66, 165, 167, 137, 34, 179, 237,
- 77, 90, 87, 185, 21, 106, 92, 115,
- 137, 65, 233, 42, 164, 153, 208, 133,
- 160, 172, 129, 202, 46, 220, 98, 66,
- 115, 66, 46, 28, 226, 200, 140, 145,
- 207, 194, 58, 71, 56, 203, 113, 34,
- 221, 116, 63, 114, 188, 210, 45, 238,
- 200, 123, 35, 150, 2, 78, 160, 22,
- 226, 167, 162, 10, 182, 75, 109, 97,
- 86, 252, 93, 125, 117, 214, 220, 37,
- 105, 160, 56, 158, 97, 57, 22, 14,
- 73, 169, 111, 190, 222, 176, 14, 82,
- 111, 42, 87, 90, 136, 236, 22, 209,
- 156, 207, 40, 251, 88, 141, 51, 211,
- 31, 158, 153, 91, 119, 83, 255, 60,
- 55, 94, 5, 115, 119, 210, 224, 185,
- 163, 163, 5, 3, 197, 106, 110, 206,
- 109, 132, 50, 190, 177, 133, 175, 129,
- 225, 161, 156, 244, 77, 150, 99, 38,
- 17, 111, 46, 230, 152, 64, 50, 164,
- 19, 78, 3, 164, 169, 175, 104, 97,
- 103, 158, 91, 168, 186, 191, 73, 88,
- 118, 112, 41, 188, 219, 0, 198, 209,
- 206, 7, 5, 169, 127, 180, 80, 74,
- 124, 4, 4, 108, 197, 67, 204, 29,
- 101, 95, 174, 147, 64, 163, 89, 160,
- 10, 5, 56, 134, 209, 69, 209, 55,
- 214, 136, 45, 212, 113, 85, 159, 133,
- 141, 249, 75, 40, 175, 91, 142, 13,
- 179, 179, 51, 0, 136, 63, 148, 175,
- 103, 162, 8, 214, 4, 24, 59, 71,
- 9, 185, 48, 127, 159, 165, 8, 8,
- 135, 151, 92, 214, 132, 151, 204, 169,
- 24, 112, 229, 59, 236, 81, 238, 64,
- 150, 196, 97, 213, 140, 159, 20, 24,
- 79, 210, 191, 53, 130, 33, 157, 87,
- 16, 180, 175, 217, 56, 123, 115, 196,
- 130, 6, 155, 37, 220, 80, 232, 129,
- 240, 57, 199, 249, 196, 152, 28, 111,
- 124, 192, 59, 46, 29, 21, 178, 51,
- 156, 17, 248, 61, 254, 80, 201, 131,
- 203, 59, 227, 191, 71, 121, 134, 181,
- 55, 79, 130, 225, 246, 36, 179, 224,
- 189, 243, 200, 75, 73, 41, 251, 41,
- 71, 251, 78, 146, 99, 101, 104, 69,
- 18, 122, 65, 24, 232, 84, 246, 242,
- 209, 18, 241, 114, 3, 65, 177, 99,
- 49, 99, 215, 59, 9, 175, 195, 11,
- 25, 46, 43, 120, 109, 179, 159, 250,
- 239, 246, 135, 78, 2, 238, 214, 237,
- 64, 170, 50, 44, 68, 67, 111, 232,
- 225, 230, 224, 124, 76, 32, 52, 158,
- 151, 54, 184, 135, 122, 66, 211, 215,
- 121, 90, 124, 158, 55, 73, 116, 137,
- 240, 15, 38, 31, 183, 86, 93, 49,
- 148, 184, 125, 250, 155, 216, 84, 246,
- 27, 172, 141, 54, 80, 158, 227, 254,
- 189, 164, 238, 229, 68, 26, 231, 11,
- 198, 222, 15, 141, 98, 8, 124, 219,
- 60, 125, 170, 213, 114, 24, 189, 65,
- 80, 186, 71, 126, 223, 153, 20, 141,
- 110, 73, 173, 218, 214, 63, 205, 177,
- 132, 115, 184, 28, 122, 232, 210, 72,
- 237, 41, 93, 17, 152, 95, 242, 138,
- 79, 98, 47, 197, 36, 17, 137, 230,
- 15, 73, 193, 1, 181, 123, 0, 186,
- 185, 135, 142, 200, 139, 78, 57, 145,
- 191, 32, 98, 250, 113, 188, 71, 32,
- 205, 81, 219, 99, 60, 87, 42, 95,
- 249, 252, 121, 125, 246, 230, 74, 162,
- 73, 59, 179, 142, 178, 47, 163, 161,
- 236, 14, 123, 219, 18, 6, 102, 140,
- 215, 210, 76, 9, 119, 147, 252, 63,
- 13, 51, 161, 172, 180, 116, 212, 129,
- 116, 237, 38, 64, 213, 222, 35, 14,
- 183, 237, 78, 204, 250, 250, 5, 41,
- 142, 5, 207, 154, 65, 183, 108, 82,
- 1, 43, 149, 233, 89, 195, 25, 233,
- 4, 34, 19, 122, 16, 58, 121, 5,
- 118, 168, 22, 213, 49, 226, 163, 169,
- 21, 78, 179, 232, 125, 216, 198, 147,
- 245, 196, 199, 138, 185, 167, 179, 82,
- 175, 53, 6, 162, 5, 141, 180, 212,
- 95, 201, 234, 169, 111, 175, 138, 197,
- 177, 246, 154, 41, 185, 201, 134, 187,
- 88, 99, 231, 23, 190, 36, 72, 174,
- 244, 185, 205, 50, 230, 226, 210, 119,
- 175, 107, 109, 244, 12, 122, 84, 51,
- 146, 95, 68, 74, 76, 212, 221, 103,
- 244, 71, 63, 133, 149, 233, 48, 3,
- 176, 168, 6, 98, 88, 226, 120, 190,
- 205, 249, 38, 157, 205, 148, 250, 203,
- 147, 62, 195, 229, 219, 109, 177, 119,
- 120, 43, 165, 99, 253, 210, 180, 32,
- 227, 180, 174, 64, 156, 139, 251, 53,
- 205, 132, 210, 208, 3, 199, 115, 64,
- 59, 27, 249, 164, 224, 191, 124, 241,
- 142, 10, 19, 120, 227, 46, 174, 231,
- 48, 65, 41, 56, 51, 38, 185, 95,
- 250, 182, 100, 40, 196, 124, 173, 119,
- 162, 148, 170, 34, 51, 68, 175, 60,
- 242, 201, 225, 34, 146, 157, 159, 0,
- 144, 148, 82, 72, 149, 53, 201, 10,
- 248, 206, 154, 126, 33, 153, 56, 48,
- 5, 90, 194, 22, 251, 173, 211, 202,
- 203, 253, 112, 147, 188, 200, 142, 206,
- 206, 175, 233, 76, 93, 104, 125, 41,
- 64, 145, 202, 53, 130, 251, 23, 90,
- 28, 199, 13, 128, 185, 154, 53, 194,
- 195, 55, 80, 56, 151, 216, 195, 138,
- 7, 170, 143, 236, 74, 141, 229, 174,
- 32, 165, 131, 68, 174, 104, 35, 143,
- 183, 41, 80, 191, 120, 79, 166, 240,
- 123, 55, 60, 2, 128, 56, 4, 199,
- 122, 85, 90, 76, 246, 29, 13, 6,
- 126, 229, 14, 203, 244, 73, 121, 42,
- 169, 35, 44, 202, 18, 69, 153, 120,
- 141, 77, 124, 191, 215, 18, 115, 187,
- 108, 246, 135, 151, 225, 192, 50, 89,
- 128, 45, 39, 253, 149, 234, 203, 84,
- 51, 174, 15, 237, 17, 57, 76, 81,
- 39, 107, 40, 36, 22, 52, 92, 39};
diff --git a/lib/ssl/c_src/esock_osio.c b/lib/ssl/c_src/esock_osio.c
deleted file mode 100644
index 41c5271c16..0000000000
--- a/lib/ssl/c_src/esock_osio.c
+++ /dev/null
@@ -1,328 +0,0 @@
-/*<copyright>
- * <year>1999-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Std filedescriptors, break handler
- *
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#ifdef __WIN32__
-#include "esock_winsock.h"
-#include <process.h>
-#include <io.h>
-#include <fcntl.h>
-#else
-#include <unistd.h>
-#include <signal.h>
-#endif
-
-#include "esock.h"
-#include "debuglog.h"
-#include "esock_utils.h"
-#include "esock_osio.h"
-
-#ifdef __WIN32__
-#define write _write
-#define read _read
-#define LOCALHOSTADDR "127.0.0.1"
-#define LOCBUFSIZE 1024
-#endif
-
-#define PACKET_SIZE 4
-#define EBUFSIZE 256
-
-FD local_read_fd = 0;
-
-static int inc_rbuf(int size);
-static void free_rbuf(void);
-static int read_fill(unsigned char *buf, int len);
-#ifdef __WIN32__
-static int create_local_thread(void);
-static DWORD WINAPI local_thread(LPVOID lpvParam);
-static BOOL WINAPI signal_handler(DWORD ctrl);
-#endif
-
-static unsigned char *rbuf = NULL;
-static int rbuf_malloced = 0;
-#ifdef __WIN32__
-static unsigned long one = 1, zero = 0;
-static int local_portno;
-static char *local_buf;
-#endif
-
-int set_break_handler(void)
-{
-#ifndef __WIN32__
- struct sigaction act;
-
- /* Ignore SIGPIPE signal */
- sigemptyset(&act.sa_mask);
- act.sa_flags = 0;
- act.sa_handler = SIG_IGN;
- sigaction(SIGPIPE, &act, NULL);
- return 0;
-#else
- SetConsoleCtrlHandler(signal_handler, TRUE);
- return 0;
-#endif
-}
-
-
-#ifdef __WIN32__
-
-int set_binary_mode(void)
-{
- _setmode(0, _O_BINARY);
- _setmode(1, _O_BINARY);
- return 0;
-}
-
-int esock_osio_init(void)
-{
- return create_local_thread();
-}
-
-void esock_osio_finish(void)
-{
- sock_close(local_read_fd);
-}
-
-#endif
-
-int read_ctrl(unsigned char **ebufp)
-{
- int tbh, cc;
- unsigned char *mbuf;
-
- if (inc_rbuf(EBUFSIZE) < 0) {
- fprintf(stderr, "read_ctrl: cannot alloc rbuf\n");
- return -1;
- }
- cc = read_fill(rbuf, PACKET_SIZE);
- if (cc < 0) {
- free_rbuf();
- return -1;
- }
- if (cc == 0) {
- free_rbuf();
- return -1; /* XXX 0 ?? */
- }
- tbh = GET_INT32(rbuf);
-
- if (tbh > rbuf_malloced - 4) {
- if (inc_rbuf(tbh + 4) < 0)
- return -1;
- }
-
- mbuf = rbuf + PACKET_SIZE;
- cc = read_fill(mbuf, tbh);
- DEBUGF(("-----------------------------------\n"));
- DEBUGF(("read_ctrl: cc = %d\n", cc));
- if(cc > 0) {
- DEBUGMSGF(("message (hex) : [%3.*a]\n", cc, mbuf));
- DEBUGMSGF(("message (char): [%3.*b]\n", cc, mbuf));
- }
- *ebufp = mbuf;
- return cc;
-}
-
-int write_ctrl(unsigned char *buf, int len)
-{
- unsigned char lb[4];
-
- PUT_INT32(len, lb);
- DEBUGF(("write_ctrl: len = %d\n", len));
- DEBUGMSGF(("message (hex) : [%3.*a] [%3.*a]\n", PACKET_SIZE, lb,
- len, buf));
- DEBUGMSGF(("message (char): [%3.*b] [%3.*b]\n", PACKET_SIZE, lb,
- len, buf));
-
- if (write(1, lb, PACKET_SIZE) != PACKET_SIZE) { /* XXX */
- fprintf(stderr, "write_ctrl: Bad write \n");
- return -1;
- }
- if (write(1, buf, len) != len) { /* XXX */
- fprintf(stderr, "write_ctrl: Bad write \n");
- return -1;
- }
- return len;
-}
-
-
-/*
- * Local functions
- *
- */
-
-static int inc_rbuf(int size)
-{
- unsigned char *nbuf;
-
- if (rbuf_malloced >= size)
- return 0;
- if (rbuf != NULL)
- nbuf = esock_realloc(rbuf, size);
- else
- nbuf = esock_malloc(size);
- if(nbuf != NULL) {
- rbuf = nbuf;
- rbuf_malloced = size;
- return 0;
- }
- return -1;
-}
-
-static void free_rbuf(void)
-{
- if (rbuf != NULL) {
- esock_free(rbuf);
- rbuf = NULL;
- rbuf_malloced = 0;
- }
-}
-
-/* Fill buffer, return buffer length, 0 for EOF, < 0 for error. */
-
-static int read_fill(unsigned char *buf, int len)
-{
- int i, got = 0;
-
- do {
- if ((i = sock_read(local_read_fd, buf+got, len-got)) <= 0)
- return i;
- got += i;
- } while (got < len);
- return len;
-}
-
-
-#ifdef __WIN32__
-
-/*
- * This routine creates a local thread, which reads from standard input
- * and writes to a socket.
- */
-
-static int create_local_thread(void)
-{
- struct sockaddr_in iserv_addr;
- SOCKET tmpsock;
- int length;
- unsigned threadaddr;
-
- local_buf = esock_malloc(LOCBUFSIZE);
- if ((tmpsock = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET) {
- fprintf(stderr, "create_local_thread could not create socket.\n");
- return -1;
- }
- memset(&iserv_addr, 0, sizeof(iserv_addr));
- iserv_addr.sin_family = AF_INET;
- iserv_addr.sin_addr.s_addr = inet_addr(LOCALHOSTADDR);
- iserv_addr.sin_port = htons(0); /* Have any port */
-
- if (bind(tmpsock, (struct sockaddr *) &iserv_addr,
- sizeof(iserv_addr)) < 0) {
- fprintf(stderr, "create_local_thread could not bind.\n");
- closesocket(tmpsock);
- return -1;
- }
- listen(tmpsock, 1);
- length = sizeof(iserv_addr);
- if (getsockname(tmpsock, (struct sockaddr *) &iserv_addr, &length) < 0) {
- fprintf(stderr, "create_local_thread could not getsockname.\n");
- closesocket(tmpsock);
- return -1;
- }
- local_portno = ntohs(iserv_addr.sin_port);
-
- if (_beginthreadex(NULL, 0, local_thread, NULL, 0, &threadaddr) == 0) {
- fprintf(stderr, "create_local_thread could not _beginthreadex().\n");
- closesocket(tmpsock);
- return -1;
- }
- local_read_fd = accept(tmpsock, (struct sockaddr *) NULL, (int *) NULL);
- if (local_read_fd == INVALID_FD) {
- fprintf(stderr, "create_local_thread could not accept.\n");
- closesocket(tmpsock);
- return -1;
- }
- closesocket(tmpsock);
- return 0;
-}
-
-static DWORD WINAPI local_thread(LPVOID lpvParam)
-{
- SOCKET sock;
- struct hostent *host;
- char hostname[64];
- struct sockaddr_in iserv_addr;
- unsigned long addr;
- int len;
- HANDLE thread;
-
- sock = socket(AF_INET, SOCK_STREAM, 0);
- memset(&iserv_addr, 0, sizeof(struct sockaddr_in));
- iserv_addr.sin_family = AF_INET;
- iserv_addr.sin_addr.s_addr = inet_addr(LOCALHOSTADDR);
- iserv_addr.sin_port = htons(local_portno);
- if(connect(sock, (struct sockaddr*)&iserv_addr, sizeof iserv_addr) ==
- SOCKET_ERROR) {
- fprintf(stderr, "local_thread thread could not connect\n");
- closesocket(sock);
- return 0;
- }
- setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, &one, sizeof(one));
-
- /* read from 0 and write to sock */
- while (1) {
- if ((len = read(0, local_buf, LOCBUFSIZE)) <= 0) {
- closesocket(sock);
- close(0);
- return 0;
- }
- if (send(sock, local_buf, len, 0) != len ) {
- closesocket(sock);
- close(0);
- return 0;
- }
- }
- return 0;
-}
-
-/* Signal handler */
-
-static BOOL WINAPI signal_handler(DWORD ctrl)
-{
- switch (ctrl) {
- case CTRL_C_EVENT:
- case CTRL_BREAK_EVENT:
- break;
- case CTRL_LOGOFF_EVENT:
- if (!getenv("ERLSRV_SERVICE_NAME"))
- return FALSE;
- break;
- default:
- exit(1);
- }
- return TRUE;
-}
-
-#endif
diff --git a/lib/ssl/c_src/esock_osio.h b/lib/ssl/c_src/esock_osio.h
deleted file mode 100644
index 8742c3b05b..0000000000
--- a/lib/ssl/c_src/esock_osio.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2009. 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%
- */
-
-#ifndef ESOCK_OSIO_H
-#define ESOCK_OSIO_H
-
-extern FD local_read_fd;
-
-#ifdef __WIN32__
-int set_binary_mode(void);
-int esock_osio_init(void);
-void esock_osio_finish(void);
-#endif
-int set_break_handler(void);
-int read_ctrl(unsigned char **ebufp);
-int write_ctrl(unsigned char *buf, int len);
-
-#endif
diff --git a/lib/ssl/c_src/esock_poll.c b/lib/ssl/c_src/esock_poll.c
deleted file mode 100644
index e982eba881..0000000000
--- a/lib/ssl/c_src/esock_poll.c
+++ /dev/null
@@ -1,222 +0,0 @@
-/*<copyright>
- * <year>2005-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-
-/*
- * Purpose: Hide poll() and select() behind an API so that we
- * can use either one.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#ifdef __WIN32__
-#include "esock_winsock.h"
-#endif
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <time.h>
-#include <ctype.h>
-#include <sys/types.h>
-#include <errno.h>
-
-#ifdef __WIN32__
-#include <process.h>
-#else
-#include <unistd.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <netinet/tcp.h>
-#include <sys/time.h>
-#include <netdb.h>
-#include <arpa/inet.h>
-#include <fcntl.h>
-#endif
-
-#include "esock.h"
-#include "esock_ssl.h"
-#include "esock_utils.h"
-#include "esock_poll.h"
-#include "debuglog.h"
-
-#if !defined(USE_SELECT)
-
-/* At least on FreeBSD, we need POLLRDNORM for normal files, not POLLIN. */
-/* Whether this is a bug in FreeBSD, I don't know. */
-#ifdef POLLRDNORM
-#define POLL_INPUT (POLLIN | POLLRDNORM)
-#else
-#define POLL_INPUT POLLIN
-#endif
-
-static void poll_fd_set(EsockPoll *ep, FD fd, short events)
-{
- int i, j;
- int prev_num_fds = ep->num_fds;
-
- if (ep->num_fds <= fd) {
- ep->num_fds = fd + 64;
- ep->fd_to_poll = (int *) esock_realloc(ep->fd_to_poll,
- ep->num_fds*sizeof(int));
- for (j = prev_num_fds; j < ep->num_fds; j++)
- ep->fd_to_poll[j] = -1;
- }
- i = ep->fd_to_poll[fd];
- if (i > 0 && i < ep->active && ep->fds[i].fd == fd) {
- /* Already present in poll array */
- ep->fds[i].events |= events;
- } else {
- /* Append to poll array */
- if (ep->active >= ep->allocated) {
- ep->allocated *= 2;
- ep->fds = (struct pollfd *)
- esock_realloc(ep->fds, ep->allocated*sizeof(struct pollfd));
- }
- ep->fd_to_poll[fd] = ep->active;
- ep->fds[ep->active].fd = fd;
- ep->fds[ep->active].events = events;
- ep->fds[ep->active].revents = 0;
- ep->active++;
- }
-}
-
-static int poll_is_set(EsockPoll *ep, FD fd, short mask)
-{
- if (fd >= ep->num_fds) {
- return 0;
- } else {
- int i = ep->fd_to_poll[fd];
- return 0 <= i && i < ep->active && ep->fds[i].fd == fd &&
- (ep->fds[i].revents & mask) != 0;
- }
-}
-
-#endif
-
-void esock_poll_init(EsockPoll *ep)
-{
-#ifdef USE_SELECT
- /* Nothing to do here */
-#else
- ep->allocated = 2;
- ep->fds = (struct pollfd *) esock_malloc(ep->allocated*sizeof(struct pollfd));
- ep->num_fds = 1;
- ep->fd_to_poll = esock_malloc(ep->num_fds*sizeof(int));
-#endif
-}
-
-void esock_poll_zero(EsockPoll *ep)
-{
-#ifdef USE_SELECT
- FD_ZERO(&ep->readmask);
- FD_ZERO(&ep->writemask);
- FD_ZERO(&ep->exceptmask);
-#else
- int i;
-
- for (i = 0; i < ep->num_fds; i++)
- ep->fd_to_poll[i] = -1;
- ep->active = 0;
-#endif
-}
-
-void esock_poll_fd_set_read(EsockPoll *ep, FD fd)
-{
-#ifdef USE_SELECT
- FD_SET(fd, &ep->readmask);
-#else
- poll_fd_set(ep, fd, POLL_INPUT);
-#endif
-}
-
-void esock_poll_fd_set_write(EsockPoll *ep, FD fd)
-{
-#ifdef USE_SELECT
- FD_SET(fd, &ep->writemask);
-#else
- poll_fd_set(ep, fd, POLLOUT);
-#endif
-}
-
-int esock_poll_fd_isset_read(EsockPoll *ep, FD fd)
-{
-#ifdef USE_SELECT
- return FD_ISSET(fd, &ep->readmask);
-#else
- return poll_is_set(ep, fd, (POLL_INPUT|POLLHUP|POLLERR|POLLNVAL));
-#endif
-}
-
-int esock_poll_fd_isset_write(EsockPoll *ep, FD fd)
-{
-#ifdef USE_SELECT
- return FD_ISSET(fd, &ep->writemask);
-#else
- return poll_is_set(ep, fd, (POLLOUT|POLLHUP|POLLERR|POLLNVAL));
-#endif
-}
-
-#ifdef __WIN32__
-void esock_poll_fd_set_exception(EsockPoll *ep, FD fd)
-{
- FD_SET(fd, &ep->exceptmask);
-}
-
-int esock_poll_fd_isset_exception(EsockPoll *ep, FD fd)
-{
- return FD_ISSET(fd, &ep->exceptmask);
-}
-#endif
-
-int esock_poll(EsockPoll *ep, int seconds)
-{
- int sret;
-
-#ifdef USE_SELECT
- struct timeval tv;
-
- tv.tv_sec = seconds;
- tv.tv_usec = 0;
- sret = select(FD_SETSIZE, &ep->readmask, &ep->writemask, &ep->exceptmask, &tv);
- if (sret == 0) {
- FD_ZERO(&ep->readmask);
- FD_ZERO(&ep->writemask);
- FD_ZERO(&ep->exceptmask);
- }
-#else
- sret = poll(ep->fds, ep->active, 1000*seconds);
-#endif
- return sret;
-}
-
-void esock_poll_clear_event(EsockPoll* ep, FD fd)
-{
-#ifdef USE_SELECT
- FD_CLR(fd, &ep->readmask);
- FD_CLR(fd, &ep->writemask);
- FD_CLR(fd, &ep->exceptmask);
-#else
- int i = ep->fd_to_poll[fd];
- if (i > 0 && ep->fds[i].fd == fd)
- ep->fds[i].revents = 0;
-#endif
-}
diff --git a/lib/ssl/c_src/esock_poll.h b/lib/ssl/c_src/esock_poll.h
deleted file mode 100644
index 639976dfa9..0000000000
--- a/lib/ssl/c_src/esock_poll.h
+++ /dev/null
@@ -1,60 +0,0 @@
-/*<copyright>
- * <year>2005-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-#ifndef ESOCK_POLL_SELECT_H
-#define ESOCK_POLL_SELECT_H
-
-#if !defined(USE_SELECT)
-#include <poll.h>
-#endif
-
-typedef struct esock_poll {
-#ifdef USE_SELECT
- fd_set readmask;
- fd_set writemask;
- fd_set exceptmask;
-#else
- int* fd_to_poll; /* Map from fd to index into poll
- * descriptor array.
- */
- int num_fds; /* Number of entries in fd_to_poll. */
- struct pollfd* fds; /* Array of poll descriptors. */
- int allocated; /* Allocated number of fds. */
- int active; /* Active number of fds */
-#endif
-} EsockPoll;
-
-void esock_poll_init(EsockPoll *ep);
-void esock_poll_zero(EsockPoll *ep);
-
-void esock_poll_fd_set_read(EsockPoll *ep, FD fd);
-void esock_poll_fd_set_write(EsockPoll *ep, FD fd);
-
-void esock_poll_clear_event(EsockPoll *ep, FD fd);
-
-int esock_poll_fd_isset_read(EsockPoll *ep, FD fd);
-int esock_poll_fd_isset_write(EsockPoll *ep, FD fd);
-
-#ifdef __WIN32__
-void esock_poll_fd_set_exception(EsockPoll *ep, FD fd);
-int esock_poll_fd_isset_exception(EsockPoll *ep, FD fd);
-#endif
-
-int esock_poll(EsockPoll *ep, int seconds);
-#endif
diff --git a/lib/ssl/c_src/esock_posix_str.c b/lib/ssl/c_src/esock_posix_str.c
deleted file mode 100644
index 31062baaaf..0000000000
--- a/lib/ssl/c_src/esock_posix_str.c
+++ /dev/null
@@ -1,642 +0,0 @@
-/*
- * %ExternalCopyright%
- */
-
-/*
- * Original: tclPosixStr.c --
- *
- * This file contains procedures that generate strings
- * corresponding to various POSIX-related codes, such
- * as errno and signals.
- *
- * Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclPosixStr.c 1.32 96/10/10 10:09:42
- */
-
-/* Copy of erl_posix_str.c */
-
-#ifdef __WIN32__
-#include "esock_winsock.h"
-#endif
-
-#include <stdio.h>
-#include <errno.h>
-#include "esock_posix_str.h"
-
-/*
- *----------------------------------------------------------------------
- *
- * esock_posix_str --
- *
- * Return a textual identifier for the given errno value.
- *
- * Results:
- * This procedure returns a machine-readable textual identifier
- * that corresponds to the current errno value (e.g. "eperm").
- * The identifier is the same as the #define name in errno.h,
- * except that it is in lowercase.
- *
- *----------------------------------------------------------------------
- */
-
-static char errstrbuf[32];
-
-char *esock_posix_str(int error)
-{
- switch (error) {
-#ifdef E2BIG
- case E2BIG: return "e2big";
-#endif
-#ifdef EACCES
- case EACCES: return "eacces";
-#endif
-#ifdef EADDRINUSE
- case EADDRINUSE: return "eaddrinuse";
-#endif
-#ifdef EADDRNOTAVAIL
- case EADDRNOTAVAIL: return "eaddrnotavail";
-#endif
-#ifdef EADV
- case EADV: return "eadv";
-#endif
-#ifdef EAFNOSUPPORT
- case EAFNOSUPPORT: return "eafnosupport";
-#endif
-#ifdef EAGAIN
- case EAGAIN: return "eagain";
-#endif
-#ifdef EALIGN
- case EALIGN: return "ealign";
-#endif
-#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
- case EALREADY: return "ealready";
-#endif
-#ifdef EBADE
- case EBADE: return "ebade";
-#endif
-#ifdef EBADF
- case EBADF: return "ebadf";
-#endif
-#ifdef EBADFD
- case EBADFD: return "ebadfd";
-#endif
-#ifdef EBADMSG
- case EBADMSG: return "ebadmsg";
-#endif
-#ifdef EBADR
- case EBADR: return "ebadr";
-#endif
-#ifdef EBADRPC
- case EBADRPC: return "ebadrpc";
-#endif
-#ifdef EBADRQC
- case EBADRQC: return "ebadrqc";
-#endif
-#ifdef EBADSLT
- case EBADSLT: return "ebadslt";
-#endif
-#ifdef EBFONT
- case EBFONT: return "ebfont";
-#endif
-#ifdef EBUSY
- case EBUSY: return "ebusy";
-#endif
-#ifdef ECHILD
- case ECHILD: return "echild";
-#endif
-#ifdef ECHRNG
- case ECHRNG: return "echrng";
-#endif
-#ifdef ECOMM
- case ECOMM: return "ecomm";
-#endif
-#ifdef ECONNABORTED
- case ECONNABORTED: return "econnaborted";
-#endif
-#ifdef ECONNREFUSED
- case ECONNREFUSED: return "econnrefused";
-#endif
-#ifdef ECONNRESET
- case ECONNRESET: return "econnreset";
-#endif
-#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
- case EDEADLK: return "edeadlk";
-#endif
-#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
- case EDEADLOCK: return "edeadlock";
-#endif
-#ifdef EDESTADDRREQ
- case EDESTADDRREQ: return "edestaddrreq";
-#endif
-#ifdef EDIRTY
- case EDIRTY: return "edirty";
-#endif
-#ifdef EDOM
- case EDOM: return "edom";
-#endif
-#ifdef EDOTDOT
- case EDOTDOT: return "edotdot";
-#endif
-#ifdef EDQUOT
- case EDQUOT: return "edquot";
-#endif
-#ifdef EDUPPKG
- case EDUPPKG: return "eduppkg";
-#endif
-#ifdef EEXIST
- case EEXIST: return "eexist";
-#endif
-#ifdef EFAULT
- case EFAULT: return "efault";
-#endif
-#ifdef EFBIG
- case EFBIG: return "efbig";
-#endif
-#ifdef EHOSTDOWN
- case EHOSTDOWN: return "ehostdown";
-#endif
-#ifdef EHOSTUNREACH
- case EHOSTUNREACH: return "ehostunreach";
-#endif
-#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
- case EIDRM: return "eidrm";
-#endif
-#ifdef EINIT
- case EINIT: return "einit";
-#endif
-#ifdef EINPROGRESS
- case EINPROGRESS: return "einprogress";
-#endif
-#ifdef EINTR
- case EINTR: return "eintr";
-#endif
-#ifdef EINVAL
- case EINVAL: return "einval";
-#endif
-#ifdef EIO
- case EIO: return "eio";
-#endif
-#ifdef EISCONN
- case EISCONN: return "eisconn";
-#endif
-#ifdef EISDIR
- case EISDIR: return "eisdir";
-#endif
-#ifdef EISNAME
- case EISNAM: return "eisnam";
-#endif
-#ifdef ELBIN
- case ELBIN: return "elbin";
-#endif
-#ifdef EL2HLT
- case EL2HLT: return "el2hlt";
-#endif
-#ifdef EL2NSYNC
- case EL2NSYNC: return "el2nsync";
-#endif
-#ifdef EL3HLT
- case EL3HLT: return "el3hlt";
-#endif
-#ifdef EL3RST
- case EL3RST: return "el3rst";
-#endif
-#ifdef ELIBACC
- case ELIBACC: return "elibacc";
-#endif
-#ifdef ELIBBAD
- case ELIBBAD: return "elibbad";
-#endif
-#ifdef ELIBEXEC
- case ELIBEXEC: return "elibexec";
-#endif
-#ifdef ELIBMAX
- case ELIBMAX: return "elibmax";
-#endif
-#ifdef ELIBSCN
- case ELIBSCN: return "elibscn";
-#endif
-#ifdef ELNRNG
- case ELNRNG: return "elnrng";
-#endif
-#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
- case ELOOP: return "eloop";
-#endif
-#ifdef EMFILE
- case EMFILE: return "emfile";
-#endif
-#ifdef EMLINK
- case EMLINK: return "emlink";
-#endif
-#ifdef EMSGSIZE
- case EMSGSIZE: return "emsgsize";
-#endif
-#ifdef EMULTIHOP
- case EMULTIHOP: return "emultihop";
-#endif
-#ifdef ENAMETOOLONG
- case ENAMETOOLONG: return "enametoolong";
-#endif
-#ifdef ENAVAIL
- case ENAVAIL: return "enavail";
-#endif
-#ifdef ENET
- case ENET: return "enet";
-#endif
-#ifdef ENETDOWN
- case ENETDOWN: return "enetdown";
-#endif
-#ifdef ENETRESET
- case ENETRESET: return "enetreset";
-#endif
-#ifdef ENETUNREACH
- case ENETUNREACH: return "enetunreach";
-#endif
-#ifdef ENFILE
- case ENFILE: return "enfile";
-#endif
-#ifdef ENOANO
- case ENOANO: return "enoano";
-#endif
-#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
- case ENOBUFS: return "enobufs";
-#endif
-#ifdef ENOCSI
- case ENOCSI: return "enocsi";
-#endif
-#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
- case ENODATA: return "enodata";
-#endif
-#ifdef ENODEV
- case ENODEV: return "enodev";
-#endif
-#ifdef ENOENT
- case ENOENT: return "enoent";
-#endif
-#ifdef ENOEXEC
- case ENOEXEC: return "enoexec";
-#endif
-#ifdef ENOLCK
- case ENOLCK: return "enolck";
-#endif
-#ifdef ENOLINK
- case ENOLINK: return "enolink";
-#endif
-#ifdef ENOMEM
- case ENOMEM: return "enomem";
-#endif
-#ifdef ENOMSG
- case ENOMSG: return "enomsg";
-#endif
-#ifdef ENONET
- case ENONET: return "enonet";
-#endif
-#ifdef ENOPKG
- case ENOPKG: return "enopkg";
-#endif
-#ifdef ENOPROTOOPT
- case ENOPROTOOPT: return "enoprotoopt";
-#endif
-#ifdef ENOSPC
- case ENOSPC: return "enospc";
-#endif
-#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
- case ENOSR: return "enosr";
-#endif
-#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
- case ENOSTR: return "enostr";
-#endif
-#ifdef ENOSYM
- case ENOSYM: return "enosym";
-#endif
-#ifdef ENOSYS
- case ENOSYS: return "enosys";
-#endif
-#ifdef ENOTBLK
- case ENOTBLK: return "enotblk";
-#endif
-#ifdef ENOTCONN
- case ENOTCONN: return "enotconn";
-#endif
-#ifdef ENOTDIR
- case ENOTDIR: return "enotdir";
-#endif
-#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
- case ENOTEMPTY: return "enotempty";
-#endif
-#ifdef ENOTNAM
- case ENOTNAM: return "enotnam";
-#endif
-#ifdef ENOTSOCK
- case ENOTSOCK: return "enotsock";
-#endif
-#ifdef ENOTSUP
- case ENOTSUP: return "enotsup";
-#endif
-#ifdef ENOTTY
- case ENOTTY: return "enotty";
-#endif
-#ifdef ENOTUNIQ
- case ENOTUNIQ: return "enotuniq";
-#endif
-#ifdef ENXIO
- case ENXIO: return "enxio";
-#endif
-#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || EOPNOTSUPP != ENOTSUP)
- case EOPNOTSUPP: return "eopnotsupp";
-#endif
-#ifdef EPERM
- case EPERM: return "eperm";
-#endif
-#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
- case EPFNOSUPPORT: return "epfnosupport";
-#endif
-#ifdef EPIPE
- case EPIPE: return "epipe";
-#endif
-#ifdef EPROCLIM
- case EPROCLIM: return "eproclim";
-#endif
-#ifdef EPROCUNAVAIL
- case EPROCUNAVAIL: return "eprocunavail";
-#endif
-#ifdef EPROGMISMATCH
- case EPROGMISMATCH: return "eprogmismatch";
-#endif
-#ifdef EPROGUNAVAIL
- case EPROGUNAVAIL: return "eprogunavail";
-#endif
-#ifdef EPROTO
- case EPROTO: return "eproto";
-#endif
-#ifdef EPROTONOSUPPORT
- case EPROTONOSUPPORT: return "eprotonosupport";
-#endif
-#ifdef EPROTOTYPE
- case EPROTOTYPE: return "eprototype";
-#endif
-#ifdef ERANGE
- case ERANGE: return "erange";
-#endif
-#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
- case EREFUSED: return "erefused";
-#endif
-#ifdef EREMCHG
- case EREMCHG: return "eremchg";
-#endif
-#ifdef EREMDEV
- case EREMDEV: return "eremdev";
-#endif
-#ifdef EREMOTE
- case EREMOTE: return "eremote";
-#endif
-#ifdef EREMOTEIO
- case EREMOTEIO: return "eremoteio";
-#endif
-#ifdef EREMOTERELEASE
- case EREMOTERELEASE: return "eremoterelease";
-#endif
-#ifdef EROFS
- case EROFS: return "erofs";
-#endif
-#ifdef ERPCMISMATCH
- case ERPCMISMATCH: return "erpcmismatch";
-#endif
-#ifdef ERREMOTE
- case ERREMOTE: return "erremote";
-#endif
-#ifdef ESHUTDOWN
- case ESHUTDOWN: return "eshutdown";
-#endif
-#ifdef ESOCKTNOSUPPORT
- case ESOCKTNOSUPPORT: return "esocktnosupport";
-#endif
-#ifdef ESPIPE
- case ESPIPE: return "espipe";
-#endif
-#ifdef ESRCH
- case ESRCH: return "esrch";
-#endif
-#ifdef ESRMNT
- case ESRMNT: return "esrmnt";
-#endif
-#ifdef ESTALE
- case ESTALE: return "estale";
-#endif
-#ifdef ESUCCESS
- case ESUCCESS: return "esuccess";
-#endif
-#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
- case ETIME: return "etime";
-#endif
-#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
- case ETIMEDOUT: return "etimedout";
-#endif
-#ifdef ETOOMANYREFS
- case ETOOMANYREFS: return "etoomanyrefs";
-#endif
-#ifdef ETXTBSY
- case ETXTBSY: return "etxtbsy";
-#endif
-#ifdef EUCLEAN
- case EUCLEAN: return "euclean";
-#endif
-#ifdef EUNATCH
- case EUNATCH: return "eunatch";
-#endif
-#ifdef EUSERS
- case EUSERS: return "eusers";
-#endif
-#ifdef EVERSION
- case EVERSION: return "eversion";
-#endif
-#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
- case EWOULDBLOCK: return "ewouldblock";
-#endif
-#ifdef EXDEV
- case EXDEV: return "exdev";
-#endif
-#ifdef EXFULL
- case EXFULL: return "exfull";
-#endif
-#ifdef WSAEINTR
- case WSAEINTR: return "eintr";
-#endif
-#ifdef WSAEBADF
- case WSAEBADF: return "ebadf";
-#endif
-#ifdef WSAEACCES
- case WSAEACCES: return "eacces";
-#endif
-#ifdef WSAEFAULT
- case WSAEFAULT: return "efault";
-#endif
-#ifdef WSAEINVAL
- case WSAEINVAL: return "einval";
-#endif
-#ifdef WSAEMFILE
- case WSAEMFILE: return "emfile";
-#endif
-#ifdef WSAEWOULDBLOCK
- case WSAEWOULDBLOCK: return "ewouldblock";
-#endif
-#ifdef WSAEINPROGRESS
- case WSAEINPROGRESS: return "einprogress";
-#endif
-#ifdef WSAEALREADY
- case WSAEALREADY: return "ealready";
-#endif
-#ifdef WSAENOTSOCK
- case WSAENOTSOCK: return "enotsock";
-#endif
-#ifdef WSAEDESTADDRREQ
- case WSAEDESTADDRREQ: return "edestaddrreq";
-#endif
-#ifdef WSAEMSGSIZE
- case WSAEMSGSIZE: return "emsgsize";
-#endif
-#ifdef WSAEPROTOTYPE
- case WSAEPROTOTYPE: return "eprototype";
-#endif
-#ifdef WSAENOPROTOOPT
- case WSAENOPROTOOPT: return "enoprotoopt";
-#endif
-#ifdef WSAEPROTONOSUPPORT
- case WSAEPROTONOSUPPORT: return "eprotonosupport";
-#endif
-#ifdef WSAESOCKTNOSUPPORT
- case WSAESOCKTNOSUPPORT: return "esocktnosupport";
-#endif
-#ifdef WSAEOPNOTSUPP
- case WSAEOPNOTSUPP: return "eopnotsupp";
-#endif
-#ifdef WSAEPFNOSUPPORT
- case WSAEPFNOSUPPORT: return "epfnosupport";
-#endif
-#ifdef WSAEAFNOSUPPORT
- case WSAEAFNOSUPPORT: return "eafnosupport";
-#endif
-#ifdef WSAEADDRINUSE
- case WSAEADDRINUSE: return "eaddrinuse";
-#endif
-#ifdef WSAEADDRNOTAVAIL
- case WSAEADDRNOTAVAIL: return "eaddrnotavail";
-#endif
-#ifdef WSAENETDOWN
- case WSAENETDOWN: return "enetdown";
-#endif
-#ifdef WSAENETUNREACH
- case WSAENETUNREACH: return "enetunreach";
-#endif
-#ifdef WSAENETRESET
- case WSAENETRESET: return "enetreset";
-#endif
-#ifdef WSAECONNABORTED
- case WSAECONNABORTED: return "econnaborted";
-#endif
-#ifdef WSAECONNRESET
- case WSAECONNRESET: return "econnreset";
-#endif
-#ifdef WSAENOBUFS
- case WSAENOBUFS: return "enobufs";
-#endif
-#ifdef WSAEISCONN
- case WSAEISCONN: return "eisconn";
-#endif
-#ifdef WSAENOTCONN
- case WSAENOTCONN: return "enotconn";
-#endif
-#ifdef WSAESHUTDOWN
- case WSAESHUTDOWN: return "eshutdown";
-#endif
-#ifdef WSAETOOMANYREFS
- case WSAETOOMANYREFS: return "etoomanyrefs";
-#endif
-#ifdef WSAETIMEDOUT
- case WSAETIMEDOUT: return "etimedout";
-#endif
-#ifdef WSAECONNREFUSED
- case WSAECONNREFUSED: return "econnrefused";
-#endif
-#ifdef WSAELOOP
- case WSAELOOP: return "eloop";
-#endif
-#ifdef WSAENAMETOOLONG
- case WSAENAMETOOLONG: return "enametoolong";
-#endif
-#ifdef WSAEHOSTDOWN
- case WSAEHOSTDOWN: return "ehostdown";
-#endif
-#ifdef WSAEHOSTUNREACH
- case WSAEHOSTUNREACH: return "ehostunreach";
-#endif
-#ifdef WSAENOTEMPTY
- case WSAENOTEMPTY: return "enotempty";
-#endif
-#ifdef WSAEPROCLIM
- case WSAEPROCLIM: return "eproclim";
-#endif
-#ifdef WSAEUSERS
- case WSAEUSERS: return "eusers";
-#endif
-#ifdef WSAEDQUOT
- case WSAEDQUOT: return "edquot";
-#endif
-#ifdef WSAESTALE
- case WSAESTALE: return "estale";
-#endif
-#ifdef WSAEREMOTE
- case WSAEREMOTE: return "eremote";
-#endif
-#ifdef WSASYSNOTREADY
- case WSASYSNOTREADY: return "sysnotready";
-#endif
-#ifdef WSAVERNOTSUPPORTED
- case WSAVERNOTSUPPORTED: return "vernotsupported";
-#endif
-#ifdef WSANOTINITIALISED
- case WSANOTINITIALISED: return "notinitialised";
-#endif
-#ifdef WSAEDISCON
- case WSAEDISCON: return "ediscon";
-#endif
-#ifdef WSAENOMORE
- case WSAENOMORE: return "enomore";
-#endif
-#ifdef WSAECANCELLED
- case WSAECANCELLED: return "ecancelled";
-#endif
-#ifdef WSAEINVALIDPROCTABLE
- case WSAEINVALIDPROCTABLE: return "einvalidproctable";
-#endif
-#ifdef WSAEINVALIDPROVIDER
- case WSAEINVALIDPROVIDER: return "einvalidprovider";
-#endif
-#ifdef WSAEPROVIDERFAILEDINIT
- case WSAEPROVIDERFAILEDINIT: return "eproviderfailedinit";
-#endif
-#ifdef WSASYSCALLFAILURE
- case WSASYSCALLFAILURE: return "syscallfailure";
-#endif
-#ifdef WSASERVICE_NOT_FOUND
- case WSASERVICE_NOT_FOUND: return "service_not_found";
-#endif
-#ifdef WSATYPE_NOT_FOUND
- case WSATYPE_NOT_FOUND: return "type_not_found";
-#endif
-#ifdef WSA_E_NO_MORE
- case WSA_E_NO_MORE: return "e_no_more";
-#endif
-#ifdef WSA_E_CANCELLED
- case WSA_E_CANCELLED: return "e_cancelled";
-#endif
- default:
- sprintf(errstrbuf, "unknown:%d", error);
- return errstrbuf;
- }
-}
-
diff --git a/lib/ssl/c_src/esock_posix_str.h b/lib/ssl/c_src/esock_posix_str.h
deleted file mode 100644
index 53916c888a..0000000000
--- a/lib/ssl/c_src/esock_posix_str.h
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2009. 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%
- */
-
-/* esock_posix_str.h */
-
-#ifndef ESOCK_POSIX_STR_H
-#define ESOCK_POSIX_STR_H
-
-char *esock_posix_str(int error);
-
-#endif
-
diff --git a/lib/ssl/c_src/esock_ssl.h b/lib/ssl/c_src/esock_ssl.h
deleted file mode 100644
index 535e9a6491..0000000000
--- a/lib/ssl/c_src/esock_ssl.h
+++ /dev/null
@@ -1,110 +0,0 @@
-/*<copyright>
- * <year>1999-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Header file for adaptions to various SSL packages.
- */
-
-#ifndef ESOCK_SSL_H
-#define ESOCK_SSL_H
-
-#include <sys/types.h>
-#include <stdio.h>
-#include "esock.h"
-
-typedef struct {
- const char *compile_version;/* version of OpenSSL when compiling esock */
- const char *lib_version; /* version of OpenSSL in library */
-} esock_version;
-
-/* Variables to be set by certain functions (see below) */
-char *esock_ssl_errstr;
-
-/* Ephemeral RSA and DH */
-int ephemeral_rsa, ephemeral_dh;
-
-/* Protocol version (sslv2, sslv3, tlsv1) */
-int protocol_version;
-
-/* version info */
-esock_version *esock_ssl_version(void);
-
-/* ciphers info */
-char *esock_ssl_ciphers(void);
-
-/* seeding */
-void esock_ssl_seed(void *buf, int len);
-
-/* Initialization and finalization of SSL */
-
-int esock_ssl_init(void);
-void esock_ssl_finish(void);
-
-/* Freeing of SSL resources for a connection */
-
-void esock_ssl_free(Connection *cp);
-
-/* Print error diagnostics to a file pointer */
-
-void esock_ssl_print_errors_fp(FILE *fp);
-
-/* All functions below have to return >= 0 on success, and < 0 on
- * failure.
- *
- * If the return indicates a failure (return value < 0) and the failure
- * is temporary the error context (sock_errno()/sock_set_errno()) must
- * be set to ERRNO_BLOCK.
- *
- * If the failure is permanent, the error context must be set to something
- * else than ERRNO_BLOCK, and `esock_ssl_errstr' must be set to point to
- * short diagnostic string describing the error.
- */
-
-int esock_ssl_accept_init(Connection *cp, void *listenssl);
-int esock_ssl_connect_init(Connection *cp);
-int esock_ssl_listen_init(Connection *cp);
-
-/* All functions below may involve non-blocking I/O with a temporary
- * failure. Hence they have to have the error context set to
- * ERRNO_BLOCK, or else have esock_ssl_errstr set to point to a
- * diagnostic string, in case the return value is < 0. If the return
- * value is 0, cp->eof and cp->bp are set, if appropritate.
- */
-
-int esock_ssl_accept(Connection *cp);
-int esock_ssl_connect(Connection *cp);
-
-int esock_ssl_read(Connection *cp, char *buf, int len);
-int esock_ssl_write(Connection *cp, char *buf, int len);
-
-int esock_ssl_shutdown(Connection *cp);
-
-/* Peer certificate */
-
-int esock_ssl_getpeercert(Connection *cp, unsigned char **buf);
-int esock_ssl_getpeercertchain(Connection *cp, unsigned char **buf);
-
-/* Sessions */
-int esock_ssl_session_reused(Connection *cp);
-
-/* Protocol version and cipher of established connection */
-int esock_ssl_getprotocol_version(Connection *cp, char **buf);
-int esock_ssl_getcipher(Connection *cp, char **buf);
-
-#endif
diff --git a/lib/ssl/c_src/esock_utils.c b/lib/ssl/c_src/esock_utils.c
deleted file mode 100644
index 0098a4f5f6..0000000000
--- a/lib/ssl/c_src/esock_utils.c
+++ /dev/null
@@ -1,150 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2009. 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%
- */
-
-/*
- * Purpose: Safe memory allocation and other utilities.
- *
- */
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include "esock_utils.h"
-
-static char *strtok_quote(char *s1, const char *s2);
-
-
-void *esock_malloc(size_t size)
-{
- void *p;
-
- p = malloc(size);
- if (!p) {
- fprintf(stderr, "esock_malloc: cannot alloc %d bytes\n", size);
- exit(EXIT_FAILURE);
- }
- return p;
-}
-
-void *esock_realloc(void *p, size_t size)
-{
- void *np;
-
- np = realloc(p, size);
- if (!np) {
- fprintf(stderr, "esock_realloc: cannot realloc %d bytes\n", size);
- exit(EXIT_FAILURE);
- }
- return np;
-}
-
-void esock_free(void *p)
-{
- free(p);
-}
-
-/* Builds an argv array from cmd. Spaces and tabs within double quotes
- * are not considered delimiters. Double quotes are removed.
- *
- * The return value is argc, and the pointer to char ** is set. argc
- * is non-negative, argv[0], ..., argv[argc - 1] are pointers to
- * strings, and argv[argc] == NULL. All argv[0], ..., argv[argc - 1]
- * must be freed by the user, and also the argv pointer itself.
- *
- * Example: cmd = abc"/program files/"olle nisse, results in
- * argv[0] = abc/program files/olle, argv[1] = nisse, argc = 2.
- *
- */
-int esock_build_argv(char *cmd, char ***argvp)
-{
- int argvsize = 10, argc = 0;
- char *args, *tokp, *argp;
- char **argv;
-
- argv = esock_malloc(argvsize * sizeof(char *));
- args = esock_malloc(strlen(cmd) + 1);
- strcpy(args, cmd);
- tokp = strtok_quote(args, " \t");
- while (tokp != NULL) {
- if (argc + 1 >= argvsize) {
- argvsize += 10;
- argv = esock_realloc(argv, argvsize * sizeof(char *));
- }
- argp = esock_malloc(strlen(tokp) + 1);
- strcpy(argp, tokp);
- argv[argc++] = argp;
- tokp = strtok_quote(NULL, " \t");
- }
- esock_free(args);
- argv[argc] = NULL;
- *argvp = argv;
- return argc;
-}
-
-/* strtok_quote
- * Works as strtok, but characters within pairs of double quotes are not
- * considered as delimiters. Quotes are removed.
- */
-static char *strtok_quote(char *s1, const char *s2)
-{
- static char *last;
- char *s, *t, *u;
-
- s = (s1) ? s1 : last;
- if (!s)
- return last = NULL;
-
- while (*s != '"' && *s != '\0' && strchr(s2, *s))
- s++;
- t = s;
-
- while (1) {
- if (*t == '"') {
- t++;
- while (*t != '"' && *t != '\0')
- t++;
- if (*t == '\0') {
- last = NULL;
- goto end;
- }
- t++;
- }
- while(*t != '"' && *t != '\0' && !strchr(s2, *t))
- t++;
- if (*t == '\0') {
- last = NULL;
- goto end;
- } else if (*t != '"') {
- *t = '\0';
- last = t + 1;
- goto end;
- }
- }
-end:
- /* Remove quotes */
- u = t = s;
- while (*u) {
- if (*u == '"')
- u++;
- else
- *t++ = *u++;
- }
- *t = '\0';
- return s;
-}
-
diff --git a/lib/ssl/c_src/esock_utils.h b/lib/ssl/c_src/esock_utils.h
deleted file mode 100644
index 99ed6c23e3..0000000000
--- a/lib/ssl/c_src/esock_utils.h
+++ /dev/null
@@ -1,32 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2009. 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%
- */
-
-#ifndef ESOCK_UTILS_H
-#define ESOCK_UTILS_H
-
-#include <stdlib.h>
-
-void *esock_malloc(size_t size);
-void *esock_realloc(void *p, size_t size);
-void esock_free(void *p);
-int esock_build_argv(char *cmd, char ***argvp);
-
-#endif
-
-
diff --git a/lib/ssl/c_src/esock_winsock.h b/lib/ssl/c_src/esock_winsock.h
deleted file mode 100644
index 069782a18d..0000000000
--- a/lib/ssl/c_src/esock_winsock.h
+++ /dev/null
@@ -1,36 +0,0 @@
-/*<copyright>
- * <year>2003-2008</year>
- * <holder>Ericsson AB, All Rights Reserved</holder>
- *</copyright>
- *<legalnotice>
- * 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.
- *
- * The Initial Developer of the Original Code is Ericsson AB.
- *</legalnotice>
- */
-/*
- * Purpose: Control winsock version and setting of FD_SETSIZE.
- *
- */
-
-/* Maybe set FD_SETSIZE */
-
-#ifdef ESOCK_WINSOCK2
-#include <winsock2.h>
-#else
-#include <winsock.h>
-/* These are defined in winsock2.h but not in winsock.h */
-#define SD_RECEIVE 0x00
-#define SD_SEND 0x01
-#define SD_BOTH 0x02
-#endif
-
diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile
index 3119d37af0..5d808d6727 100644
--- a/lib/ssl/doc/src/Makefile
+++ b/lib/ssl/doc/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
@@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
# Target Specs
# ----------------------------------------------------
XML_APPLICATION_FILES = refman.xml
-XML_REF3_FILES = ssl.xml old_ssl.xml ssl_session_cache_api.xml
+XML_REF3_FILES = ssl.xml ssl_session_cache_api.xml
XML_REF6_FILES = ssl_app.xml
XML_PART_FILES = release_notes.xml usersguide.xml
diff --git a/lib/ssl/doc/src/old_ssl.xml b/lib/ssl/doc/src/old_ssl.xml
deleted file mode 100644
index 0d2e1afdbd..0000000000
--- a/lib/ssl/doc/src/old_ssl.xml
+++ /dev/null
@@ -1,709 +0,0 @@
-<?xml version="1.0" encoding="latin1" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year><year>2010</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- 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.
-
- </legalnotice>
-
- <title>ssl</title>
- <prepared>Peter H&ouml;gfeldt</prepared>
- <responsible>Peter H&ouml;gfeldt</responsible>
- <docno></docno>
- <approved>Peter H&ouml;gfeldt</approved>
- <checked></checked>
- <date>2003-03-25</date>
- <rev>D</rev>
- <file>old_ssl.xml</file>
- </header>
- <module>old_ssl</module>
- <modulesummary>Interface Functions for Secure Socket Layer</modulesummary>
- <description>
- <p>This module contains interface functions to the Secure Socket Layer.</p>
- </description>
-
- <section>
- <title>General</title>
-
- <p>This manual page describes functions that are defined
- in the ssl module and represents the old ssl implementation
- that coexists with the new one until it has been
- totally phased out. </p>
-
- <p>The old implementation can be
- accessed by providing the option {ssl_imp, old} to the
- ssl:connect and ssl:listen functions.</p>
-
- <p>The reader is advised to also read the <c>ssl(6)</c> manual page
- describing the SSL application.
- </p>
- <warning>
- <p>It is strongly advised to seed the random generator after
- the ssl application has been started (see <c>seed/1</c>
- below), and before any connections are established. Although
- the port program interfacing to the ssl libraries does a
- "random" seeding of its own in order to make everything work
- properly, that seeding is by no means random for the world
- since it has a constant value which is known to everyone
- reading the source code of the port program.</p>
- </warning>
- </section>
-
- <section>
- <title>Common data types</title>
- <p>The following datatypes are used in the functions below:
- </p>
- <list type="bulleted">
- <item>
- <p><c>options() = [option()]</c></p>
- </item>
- <item>
- <p><c>option() = socketoption() | ssloption()</c></p>
- </item>
- <item>
- <p><c>socketoption() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {nodelay, boolean()} | {active, activetype()} | {backlog, integer()} | {ip, ipaddress()} | {port, integer()}</c></p>
- </item>
- <item>
- <p><c>ssloption() = {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</c></p>
- </item>
- <item>
- <p><c>packettype()</c> (see inet(3))</p>
- </item>
- <item>
- <p><c>activetype()</c> (see inet(3))</p>
- </item>
- <item>
- <p><c>reason() = atom() | {atom(), string()}</c></p>
- </item>
- <item>
- <p><c>bytes() = [byte()]</c></p>
- </item>
- <item>
- <p><c>string() = [byte()]</c></p>
- </item>
- <item>
- <p><c>byte() = 0 | 1 | 2 | ... | 255</c></p>
- </item>
- <item>
- <p><c>code() = 0 | 1 | 2</c></p>
- </item>
- <item>
- <p><c>depth() = byte()</c></p>
- </item>
- <item>
- <p><c>address() = hostname() | ipstring() | ipaddress()</c></p>
- </item>
- <item>
- <p><c>ipaddress() = ipstring() | iptuple()</c></p>
- </item>
- <item>
- <p><c>hostname() = string()</c></p>
- </item>
- <item>
- <p><c>ipstring() = string()</c></p>
- </item>
- <item>
- <p><c>iptuple() = {byte(), byte(), byte(), byte()}</c></p>
- </item>
- <item>
- <p><c>sslsocket()</c></p>
- </item>
- <item>
- <p><c>protocol() = sslv2 | sslv3 | tlsv1</c></p>
- </item>
- <item>
- <p><c></c></p>
- </item>
- </list>
- <p>The socket option <c>{backlog, integer()}</c> is for
- <c>listen/2</c> only, and the option <c>{port, integer()}</c>
- is for <c>connect/3/4</c> only.
- </p>
- <p>The following socket options are set by default: <c>{mode, list}</c>, <c>{packet, 0}</c>, <c>{header, 0}</c>, <c>{nodelay, false}</c>, <c>{active, true}</c>, <c>{backlog, 5}</c>,
- <c>{ip, {0,0,0,0}}</c>, and <c>{port, 0}</c>.
- </p>
- <p>Note that the options <c>{mode, binary}</c> and <c>binary</c>
- are equivalent. Similarly <c>{mode, list}</c> and the absence of
- option <c>binary</c> are equivalent.
- </p>
- <p>The ssl options are for setting specific SSL parameters as follows:
- </p>
- <list type="bulleted">
- <item>
- <p><c>{verify, code()}</c> Specifies type of verification:
- 0 = do not verify peer; 1 = verify peer, 2 = verify peer,
- fail if no peer certificate. The default value is 0.
- </p>
- </item>
- <item>
- <p><c>{depth, depth()}</c> Specifies the maximum
- verification depth, i.e. how far in a chain of certificates
- the verification process can proceed before the verification
- is considered to fail.
- </p>
- <p>Peer certificate = 0, CA certificate = 1, higher level CA
- certificate = 2, etc. The value 2 thus means that a chain
- can at most contain peer cert, CA cert, next CA cert, and an
- additional CA cert.
- </p>
- <p>The default value is 1.
- </p>
- </item>
- <item>
- <p><c>{certfile, path()}</c> Path to a file containing the
- user's certificate.
- chain of PEM encoded certificates.</p>
- </item>
- <item>
- <p><c>{keyfile, path()}</c> Path to file containing user's
- private PEM encoded key.</p>
- </item>
- <item>
- <p><c>{password, string()}</c> String containing the user's
- password. Only used if the private keyfile is password protected.</p>
- </item>
- <item>
- <p><c>{cacertfile, path()}</c> Path to file containing PEM encoded
- CA certificates (trusted certificates used for verifying a peer
- certificate).</p>
- </item>
- <item>
- <p><c>{ciphers, string()}</c> String of ciphers as a colon
- separated list of ciphers. The function <c>ciphers/0</c> can
- be used to find all available ciphers.</p>
- </item>
- </list>
- <p>The type <c>sslsocket()</c> is opaque to the user.
- </p>
- <p>The owner of a socket is the one that created it by a call to
- <c>transport_accept/[1,2]</c>, <c>connect/[3,4]</c>,
- or <c>listen/2</c>.
- </p>
- <p>When a socket is in active mode (the default), data from the
- socket is delivered to the owner of the socket in the form of
- messages:
- </p>
- <list type="bulleted">
- <item>
- <p><c>{ssl, Socket, Data}</c></p>
- </item>
- <item>
- <p><c>{ssl_closed, Socket}</c></p>
- </item>
- <item>
- <p><c>{ssl_error, Socket, Reason}</c></p>
- </item>
- </list>
- <p>A <c>Timeout</c> argument specifies a timeout in milliseconds. The
- default value for a <c>Timeout</c> argument is <c>infinity</c>.
- </p>
- <p>Functions listed below may return the value <c>{error, closed}</c>, which only indicates that the SSL socket is
- considered closed for the operation in question. It is for
- instance possible to have <c>{error, closed}</c> returned from
- an call to <c>send/2</c>, and a subsequent call to <c>recv/3</c>
- returning <c>{ok, Data}</c>.
- </p>
- <p>Hence a return value of <c>{error, closed}</c> must not be
- interpreted as if the socket was completely closed. On the
- contrary, in order to free all resources occupied by an SSL
- socket, <c>close/1</c> must be called, or else the process owning
- the socket has to terminate.
- </p>
- <p>For each SSL socket there is an Erlang process representing the
- socket. When a socket is opened, that process links to the
- calling client process. Implementations that want to detect
- abnormal exits from the socket process by receiving <c>{'EXIT', Pid, Reason}</c> messages, should use the function <c>pid/1</c>
- to retrieve the process identifier from the socket, in order to
- be able to match exit messages properly.</p>
- </section>
- <funcs>
- <func>
- <name>ciphers() -> {ok, string()} | {error, enotstarted}</name>
- <fsummary>Get supported ciphers.</fsummary>
- <desc>
- <p>Returns a string consisting of colon separated cipher
- designations that are supported by the current SSL library
- implementation.
- </p>
- <p>The SSL application has to be started to return the string
- of ciphers.</p>
- </desc>
- </func>
- <func>
- <name>close(Socket) -> ok | {error, Reason}</name>
- <fsummary>Close a socket returned by <c>transport_accept/[1,2]</c>, <c>connect/3/4</c>, or <c>listen/2</c>.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- </type>
- <desc>
- <p>Closes a socket returned by <c>transport_accept/[1,2]</c>,
- <c>connect/[3,4]</c>, or <c>listen/2</c></p>
- </desc>
- </func>
- <func>
- <name>connect(Address, Port, Options) -> {ok, Socket} | {error, Reason}</name>
- <name>connect(Address, Port, Options, Timeout) -> {ok, Socket} | {error, Reason}</name>
- <fsummary>Connect to <c>Port</c>at <c>Address</c>.</fsummary>
- <type>
- <v>Address = address()</v>
- <v>Port = integer()</v>
- <v>Options = [connect_option()]</v>
- <v>connect_option() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {nodelay, boolean()} | {active, activetype()} | {ip, ipaddress()} | {port, integer()} | {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</v>
- <v>Timeout = integer()</v>
- <v>Socket = sslsocket()</v>
- </type>
- <desc>
- <p>Connects to <c>Port</c> at <c>Address</c>. If the optional
- <c>Timeout</c> argument is specified, and a connection could not
- be established within the given time, <c>{error, timeout}</c> is
- returned. The default value for <c>Timeout</c> is <c>infinity</c>.
- </p>
- <p>The <c>ip</c> and <c>port</c> options are for binding to a
- particular <em>local</em> address and port, respectively.</p>
- </desc>
- </func>
- <func>
- <name>connection_info(Socket) -> {ok, {Protocol, Cipher}} | {error, Reason}</name>
- <fsummary>Get current protocol version and cipher.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Protocol = protocol()</v>
- <v>Cipher = string()</v>
- </type>
- <desc>
- <p>Gets the chosen protocol version and cipher for an established
- connection (accepted och connected). </p>
- </desc>
- </func>
- <func>
- <name>controlling_process(Socket, NewOwner) -> ok | {error, Reason}</name>
- <fsummary>Assign a new controlling process to the socket.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>NewOwner = pid()</v>
- </type>
- <desc>
- <p>Assigns a new controlling process to <c>Socket</c>. A controlling
- process is the owner of a socket, and receives all messages from
- the socket.</p>
- </desc>
- </func>
- <func>
- <name>format_error(ErrorCode) -> string()</name>
- <fsummary>Return an error string.</fsummary>
- <type>
- <v>ErrorCode = term()</v>
- </type>
- <desc>
- <p>Returns a diagnostic string describing an error.</p>
- </desc>
- </func>
- <func>
- <name>getopts(Socket, OptionsTags) -> {ok, Options} | {error, Reason}</name>
- <fsummary>Get options set for socket</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>OptionTags = [optiontag()]()</v>
- </type>
- <desc>
- <p>Returns the options the tags of which are <c>OptionTags</c> for
- for the socket <c>Socket</c>. </p>
- </desc>
- </func>
- <func>
- <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name>
- <fsummary>Set up a socket to listen on a port on the local host.</fsummary>
- <type>
- <v>Port = integer()</v>
- <v>Options = [listen_option()]</v>
- <v>listen_option() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {active, activetype()} | {backlog, integer()} | {ip, ipaddress()} | {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</v>
- <v>ListenSocket = sslsocket()</v>
- </type>
- <desc>
- <p>Sets up a socket to listen on port <c>Port</c> at the local host.
- If <c>Port</c> is zero, <c>listen/2</c> picks an available port
- number (use <c>port/1</c> to retrieve it).
- </p>
- <p>The listen queue size defaults to 5. If a different value is
- wanted, the option <c>{backlog, Size}</c> should be added to the
- list of options.
- </p>
- <p>An empty <c>Options</c> list is considered an error, and
- <c>{error, enooptions}</c> is returned.
- </p>
- <p>The returned <c>ListenSocket</c> can only be used in calls to
- <c>transport_accept/[1,2]</c>.</p>
- </desc>
- </func>
- <func>
- <name>peercert(Socket) -> {ok, Cert} | {error, Reason}</name>
- <fsummary>Return the peer certificate.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Cert = binary()()</v>
- <v>Subject = term()()</v>
- </type>
- <desc>
- <p>Returns the DER encoded peer certificate, the certificate can be decoded with
- <c>public_key:pkix_decode_cert/2</c>.
- </p>
- </desc>
- </func>
- <func>
- <name>peername(Socket) -> {ok, {Address, Port}} | {error, Reason}</name>
- <fsummary>Return peer address and port.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Address = ipaddress()</v>
- <v>Port = integer()</v>
- </type>
- <desc>
- <p>Returns the address and port number of the peer.</p>
- </desc>
- </func>
- <func>
- <name>pid(Socket) -> pid()</name>
- <fsummary>Return the pid of the socket process.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- </type>
- <desc>
- <p>Returns the pid of the socket process. The returned pid should
- only be used for receiving exit messages.</p>
- </desc>
- </func>
- <func>
- <name>recv(Socket, Length) -> {ok, Data} | {error, Reason}</name>
- <name>recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason}</name>
- <fsummary>Receive data on socket.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Length = integer() >= 0</v>
- <v>Timeout = integer()</v>
- <v>Data = bytes() | binary()</v>
- </type>
- <desc>
- <p>Receives data on socket <c>Socket</c> when the socket is in
- passive mode, i.e. when the option <c>{active, false}</c>
- has been specified.
- </p>
- <p>A notable return value is <c>{error, closed}</c> which
- indicates that the socket is closed.
- </p>
- <p>A positive value of the <c>Length</c> argument is only
- valid when the socket is in raw mode (option <c>{packet, 0}</c> is set, and the option <c>binary</c> is <em>not</em>
- set); otherwise it should be set to 0, whence all available
- bytes are returned.
- </p>
- <p>If the optional <c>Timeout</c> parameter is specified, and
- no data was available within the given time, <c>{error, timeout}</c> is returned. The default value for
- <c>Timeout</c> is <c>infinity</c>.</p>
- </desc>
- </func>
- <func>
- <name>seed(Data) -> ok | {error, Reason}</name>
- <fsummary>Seed the ssl random generator.</fsummary>
- <type>
- <v>Data = iolist() | binary()</v>
- </type>
- <desc>
- <p>Seeds the ssl random generator.
- </p>
- <p>It is strongly advised to seed the random generator after
- the ssl application has been started, and before any
- connections are established. Although the port program
- interfacing to the OpenSSL libraries does a "random" seeding
- of its own in order to make everything work properly, that
- seeding is by no means random for the world since it has a
- constant value which is known to everyone reading the source
- code of the seeding.
- </p>
- <p>A notable return value is <c>{error, edata}}</c> indicating that
- <c>Data</c> was not a binary nor an iolist.</p>
- </desc>
- </func>
- <func>
- <name>send(Socket, Data) -> ok | {error, Reason}</name>
- <fsummary>Write data to a socket.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Data = iolist() | binary()</v>
- </type>
- <desc>
- <p>Writes <c>Data</c> to <c>Socket</c>. </p>
- <p>A notable return value is <c>{error, closed}</c> indicating that
- the socket is closed.</p>
- </desc>
- </func>
- <func>
- <name>setopts(Socket, Options) -> ok | {error, Reason}</name>
- <fsummary>Set socket options.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Options = [socketoption]()</v>
- </type>
- <desc>
- <p>Sets options according to <c>Options</c> for the socket
- <c>Socket</c>. </p>
- </desc>
- </func>
- <func>
- <name>ssl_accept(Socket) -> ok | {error, Reason}</name>
- <name>ssl_accept(Socket, Timeout) -> ok | {error, Reason}</name>
- <fsummary>Perform server-side SSL handshake and key exchange</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Timeout = integer()</v>
- <v>Reason = atom()</v>
- </type>
- <desc>
- <p>The <c>ssl_accept</c> function establish the SSL connection
- on the server side. It should be called directly after
- <c>transport_accept</c>, in the spawned server-loop.</p>
- <p>Note that the ssl connection is not complete until <c>ssl_accept</c>
- has returned <c>true</c>, and if an error is returned, the socket
- is unavailable and for instance <c>close/1</c> will crash.</p>
- </desc>
- </func>
- <func>
- <name>sockname(Socket) -> {ok, {Address, Port}} | {error, Reason}</name>
- <fsummary>Return the local address and port.</fsummary>
- <type>
- <v>Socket = sslsocket()</v>
- <v>Address = ipaddress()</v>
- <v>Port = integer()</v>
- </type>
- <desc>
- <p>Returns the local address and port number of the socket
- <c>Socket</c>.</p>
- </desc>
- </func>
- <func>
- <name>transport_accept(Socket) -> {ok, NewSocket} | {error, Reason}</name>
- <name>transport_accept(Socket, Timeout) -> {ok, NewSocket} | {error, Reason}</name>
- <fsummary>Accept an incoming connection and prepare for <c>ssl_accept</c></fsummary>
- <type>
- <v>Socket = NewSocket = sslsocket()</v>
- <v>Timeout = integer()</v>
- <v>Reason = atom()</v>
- </type>
- <desc>
- <p>Accepts an incoming connection request on a listen socket.
- <c>ListenSocket</c> must be a socket returned from <c>listen/2</c>.
- The socket returned should be passed to <c>ssl_accept</c> to
- complete ssl handshaking and establishing the connection.</p>
- <warning>
- <p>The socket returned can only be used with <c>ssl_accept</c>,
- no traffic can be sent or received before that call.</p>
- </warning>
- <p>The accepted socket inherits the options set for <c>ListenSocket</c>
- in <c>listen/2</c>.</p>
- <p>The default value for <c>Timeout</c> is <c>infinity</c>. If
- <c>Timeout</c> is specified, and no connection is accepted within
- the given time, <c>{error, timeout}</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>version() -> {ok, {SSLVsn, CompVsn, LibVsn}}</name>
- <fsummary>Return the version of SSL.</fsummary>
- <type>
- <v>SSLVsn = CompVsn = LibVsn = string()()</v>
- </type>
- <desc>
- <p>Returns the SSL application version (<c>SSLVsn</c>), the library
- version used when compiling the SSL application port program
- (<c>CompVsn</c>), and the actual library version used when
- dynamically linking in runtime (<c>LibVsn</c>).
- </p>
- <p>If the SSL application has not been started, <c>CompVsn</c> and
- <c>LibVsn</c> are empty strings.
- </p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>ERRORS</title>
- <p>The possible error reasons and the corresponding diagnostic strings
- returned by <c>format_error/1</c> are either the same as those defined
- in the <c>inet(3)</c> reference manual, or as follows:
- </p>
- <taglist>
- <tag><c>closed</c></tag>
- <item>
- <p>Connection closed for the operation in question.
- </p>
- </item>
- <tag><c>ebadsocket</c></tag>
- <item>
- <p>Connection not found (internal error).
- </p>
- </item>
- <tag><c>ebadstate</c></tag>
- <item>
- <p>Connection not in connect state (internal error).
- </p>
- </item>
- <tag><c>ebrokertype</c></tag>
- <item>
- <p>Wrong broker type (internal error).
- </p>
- </item>
- <tag><c>ecacertfile</c></tag>
- <item>
- <p>Own CA certificate file is invalid.
- </p>
- </item>
- <tag><c>ecertfile</c></tag>
- <item>
- <p>Own certificate file is invalid.
- </p>
- </item>
- <tag><c>echaintoolong</c></tag>
- <item>
- <p>The chain of certificates provided by peer is too long.
- </p>
- </item>
- <tag><c>ecipher</c></tag>
- <item>
- <p>Own list of specified ciphers is invalid.
- </p>
- </item>
- <tag><c>ekeyfile</c></tag>
- <item>
- <p>Own private key file is invalid.
- </p>
- </item>
- <tag><c>ekeymismatch</c></tag>
- <item>
- <p>Own private key does not match own certificate.
- </p>
- </item>
- <tag><c>enoissuercert</c></tag>
- <item>
- <p>Cannot find certificate of issuer of certificate provided
- by peer.
- </p>
- </item>
- <tag><c>enoservercert</c></tag>
- <item>
- <p>Attempt to do accept without having set own certificate.
- </p>
- </item>
- <tag><c>enotlistener</c></tag>
- <item>
- <p>Attempt to accept on a non-listening socket.
- </p>
- </item>
- <tag><c>enoproxysocket</c></tag>
- <item>
- <p>No proxy socket found (internal error).
- </p>
- </item>
- <tag><c>enooptions</c></tag>
- <item>
- <p>The list of options is empty.
- </p>
- </item>
- <tag><c>enotstarted</c></tag>
- <item>
- <p>The SSL application has not been started.
- </p>
- </item>
- <tag><c>eoptions</c></tag>
- <item>
- <p>Invalid list of options.
- </p>
- </item>
- <tag><c>epeercert</c></tag>
- <item>
- <p>Certificate provided by peer is in error.
- </p>
- </item>
- <tag><c>epeercertexpired</c></tag>
- <item>
- <p>Certificate provided by peer has expired.
- </p>
- </item>
- <tag><c>epeercertinvalid</c></tag>
- <item>
- <p>Certificate provided by peer is invalid.
- </p>
- </item>
- <tag><c>eselfsignedcert</c></tag>
- <item>
- <p>Certificate provided by peer is self signed.
- </p>
- </item>
- <tag><c>esslaccept</c></tag>
- <item>
- <p>Server SSL handshake procedure between client and server failed.
- </p>
- </item>
- <tag><c>esslconnect</c></tag>
- <item>
- <p>Client SSL handshake procedure between client and server failed.
- </p>
- </item>
- <tag><c>esslerrssl</c></tag>
- <item>
- <p>SSL protocol failure. Typically because of a fatal alert
- from peer.
- </p>
- </item>
- <tag><c>ewantconnect</c></tag>
- <item>
- <p>Protocol wants to connect, which is not supported in
- this version of the SSL application.
- </p>
- </item>
- <tag><c>ex509lookup</c></tag>
- <item>
- <p>Protocol wants X.509 lookup, which is not supported in
- this version of the SSL application.
- </p>
- </item>
- <tag><c>{badcall, Call}</c></tag>
- <item>
- <p>Call not recognized for current mode (active or passive) and
- state of socket.
- </p>
- </item>
- <tag><c>{badcast, Cast}</c></tag>
- <item>
- <p>Call not recognized for current mode (active or passive) and
- state of socket.
- </p>
- </item>
- <tag><c>{badinfo, Info}</c></tag>
- <item>
- <p>Call not recognized for current mode (active or passive) and
- state of socket.
- </p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>SEE ALSO</title>
- <p>gen_tcp(3), inet(3) public_key(3) </p>
- </section>
-
-</erlref>
-
-
diff --git a/lib/ssl/doc/src/refman.xml b/lib/ssl/doc/src/refman.xml
index 68f84660f3..011819e82b 100644
--- a/lib/ssl/doc/src/refman.xml
+++ b/lib/ssl/doc/src/refman.xml
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="iso-8859-1" ?>
<!DOCTYPE application SYSTEM "application.dtd">
<application xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>1999</year><year>2010</year>
+ <year>1999</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -45,7 +45,6 @@
</description>
<xi:include href="ssl_app.xml"/>
<xi:include href="ssl.xml"/>
- <xi:include href="old_ssl.xml"/>
<xi:include href="ssl_session_cache_api.xml"/>
</application>
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 47991ca477..70122e4393 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -121,8 +121,6 @@
<p> <c>hash() = md5 | sha
</c></p>
- <p><c>ssl_imp() = new | old - default is new.</c></p>
-
</section>
<section>
@@ -177,9 +175,9 @@
by the peer also.
</item>
- <tag>{ssl_imp, ssl_imp()}</tag>
- <item>Specify which ssl implementation you want to use. Defaults to
- new.
+ <tag>{ssl_imp, new | old}</tag>
+ <item>No longer has any meaning as the old implementation has
+ been removed, it will be ignored.
</item>
<tag>{secure_renegotiate, boolean()}</tag>
diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml
index a2c7370ddc..4ae4ead3ee 100644
--- a/lib/ssl/doc/src/ssl_distribution.xml
+++ b/lib/ssl/doc/src/ssl_distribution.xml
@@ -175,7 +175,7 @@ Eshell V5.0 (abort with ^G)
<p>One can specify the simpler SSL options certfile, keyfile,
password, cacertfile, verify, reuse_sessions,
- secure_renegotiation, depth, hibernate_after and ciphers (use old
+ secure_renegotiate, 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).
@@ -201,7 +201,7 @@ Eshell V5.0 (abort with ^G)
<code type="none">
$ erl -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
+ -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true
-sname ssl_test
Erlang (BEAM) emulator version 5.0 [source]
@@ -224,7 +224,7 @@ Eshell V5.0 (abort with ^G)
<code type="none">
$ 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"
+ -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true"
$ export ERL_FLAGS
$ erl -sname ssl_test
Erlang (BEAM) emulator version 5.0 [source]
@@ -237,7 +237,7 @@ Eshell V5.0 (abort with ^G)
{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",
+ {ssl_dist_opt,["server_secure_renegotiate","true",
"client_secure_renegotiate","true"]
{home,["/home/me"]}] </code>
<p>The <c>init:get_arguments()</c> call verifies that the correct
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 9c40d4ea53..dc69b53b28 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -41,13 +41,8 @@ MODULES= \
ssl \
ssl_alert \
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\
@@ -67,7 +62,7 @@ MODULES= \
ssl_tls_dist_proxy
INTERNAL_HRL_FILES = \
- ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \
+ ssl_debug.hrl \
ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \
ssl_record.hrl
diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl
deleted file mode 100644
index 42a03a4879..0000000000
--- a/lib/ssl/src/inet_ssl_dist.erl
+++ /dev/null
@@ -1,453 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-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_ssl_dist).
-
-%% Handles the connection setup phase with other Erlang nodes.
-
--export([childspecs/0, listen/1, accept/1, accept_connection/5,
- setup/5, close/1, select/1, is_node_name/1]).
-
-%% internal exports
-
--export([accept_loop/2,do_accept/6,do_setup/6, getstat/1,tick/1]).
-
--import(error_logger,[error_msg/2]).
-
--include_lib("kernel/include/net_address.hrl").
-
--define(to_port(Socket, Data, Opts),
- case ssl_prim:send(Socket, Data, Opts) of
- {error, closed} ->
- self() ! {ssl_closed, Socket},
- {error, closed};
- R ->
- R
- end).
-
--include_lib("kernel/include/dist.hrl").
--include_lib("kernel/include/dist_util.hrl").
-
-%% -------------------------------------------------------------
-%% This function should return a valid childspec, so that
-%% the primitive ssl_server gets supervised
-%% -------------------------------------------------------------
-childspecs() ->
- {ok, [{ssl_server_prim,{ssl_server, start_link_prim, []},
- permanent, 2000, worker, [ssl_server]}]}.
-
-
-%% ------------------------------------------------------------
-%% Select this protocol based on node name
-%% select(Node) => Bool
-%% ------------------------------------------------------------
-
-select(Node) ->
- case split_node(atom_to_list(Node), $@, []) of
- [_,_Host] -> true;
- _ -> false
- end.
-
-%% ------------------------------------------------------------
-%% Create the listen socket, i.e. the port that this erlang
-%% node is accessible through.
-%% ------------------------------------------------------------
-
-listen(Name) ->
- case ssl_prim:listen(0, [{active, false}, {packet,4}] ++
- get_ssl_options(server)) of
- {ok, Socket} ->
- TcpAddress = get_tcp_address(Socket),
- {_,Port} = TcpAddress#net_address.address,
- {ok, Creation} = erl_epmd:register_node(Name, Port),
- {ok, {Socket, TcpAddress, Creation}};
- Error ->
- Error
- end.
-
-%% ------------------------------------------------------------
-%% Accepts new connection attempts from other Erlang nodes.
-%% ------------------------------------------------------------
-
-accept(Listen) ->
- spawn_link(?MODULE, accept_loop, [self(), Listen]).
-
-accept_loop(Kernel, Listen) ->
- process_flag(priority, max),
- case ssl_prim:accept(Listen) of
- {ok, Socket} ->
- Kernel ! {accept,self(),Socket,inet,ssl},
- controller(Kernel, Socket),
- accept_loop(Kernel, Listen);
- Error ->
- exit(Error)
- end.
-
-controller(Kernel, Socket) ->
- receive
- {Kernel, controller, Pid} ->
- flush_controller(Pid, Socket),
- ssl_prim:controlling_process(Socket, Pid),
- flush_controller(Pid, Socket),
- Pid ! {self(), controller};
- {Kernel, unsupported_protocol} ->
- exit(unsupported_protocol)
- end.
-
-flush_controller(Pid, Socket) ->
- receive
- {ssl, Socket, Data} ->
- Pid ! {ssl, Socket, Data},
- flush_controller(Pid, Socket);
- {ssl_closed, Socket} ->
- Pid ! {ssl_closed, Socket},
- flush_controller(Pid, Socket)
- after 0 ->
- ok
- end.
-
-%% ------------------------------------------------------------
-%% Accepts a new connection attempt from another Erlang node.
-%% Performs the handshake with the other side.
-%% ------------------------------------------------------------
-
-accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
- spawn_link(?MODULE, do_accept,
- [self(), AcceptPid, Socket, MyNode,
- Allowed, SetupTime]).
-
-%% Suppress dialyzer warning, we do not really care about old ssl code
-%% as we intend to remove it.
--spec(do_accept(_,_,_,_,_,_) -> no_return()).
-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 = #hs_data{
- kernel_pid = Kernel,
- this_node = MyNode,
- socket = Socket,
- timer = Timer,
- this_flags = 0,
- allowed = Allowed,
- f_send = fun(S,D) -> ssl_prim:send(S,D) end,
- f_recv = fun(S,N,T) -> ssl_prim:recv(S,N,T)
- end,
- f_setopts_pre_nodeup =
- fun(S) ->
- ssl_prim:setopts(S,
- [{active, false}])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- ssl_prim:setopts(S,
- [{deliver, port},
- {active, true}])
- end,
- f_getll = fun(S) ->
- ssl_prim:getll(S)
- end,
- f_address = fun get_remote_id/2,
- mf_tick = fun ?MODULE:tick/1,
- mf_getstat = fun ?MODULE:getstat/1
- },
- dist_util:handshake_other_started(HSData);
- {false,IP} ->
- error_msg("** Connection attempt from "
- "disallowed IP ~w ** ~n", [IP]),
- ?shutdown(no_node)
- end
- end.
-
-%% ------------------------------------------------------------
-%% Get remote information about a Socket.
-%% ------------------------------------------------------------
-
-get_remote_id(Socket, Node) ->
- {ok, Address} = ssl_prim:peername(Socket),
- [_, Host] = split_node(atom_to_list(Node), $@, []),
- #net_address {
- address = Address,
- host = Host,
- protocol = ssl,
- family = inet }.
-
-%% ------------------------------------------------------------
-%% Setup a new connection to another Erlang node.
-%% Performs the handshake with the other side.
-%% ------------------------------------------------------------
-
-setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
- spawn_link(?MODULE, do_setup, [self(),
- Node,
- Type,
- MyNode,
- LongOrShortNames,
- SetupTime]).
-
-%% Suppress dialyzer warning, we do not really care about old ssl code
-%% as we intend to remove it.
--spec(do_setup(_,_,_,_,_,_) -> no_return()).
-do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) ->
- process_flag(priority, max),
- ?trace("~p~n",[{inet_ssl_dist,self(),setup,Node}]),
- [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_prim:connect(Ip, TcpPort,
- [{active, false},
- {packet,4}] ++
- get_ssl_options(client)) 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) ->
- ssl_prim:send(S,D)
- end,
- f_recv = fun(S,N,T) ->
- ssl_prim:recv(S,N,T)
- end,
- f_setopts_pre_nodeup =
- fun(S) ->
- ssl_prim:setopts
- (S,
- [{active, false}])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- ssl_prim:setopts
- (S,
- [{deliver, port},{active, true}])
- end,
- f_getll = fun(S) ->
- ssl_prim:getll(S)
- end,
- f_address =
- fun(_,_) ->
- #net_address {
- address = {Ip,TcpPort},
- host = Address,
- protocol = ssl,
- family = inet}
- end,
- mf_tick = fun ?MODULE:tick/1,
- mf_getstat = fun ?MODULE:getstat/1,
- 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 a socket.
-%%
-close(Socket) ->
- ssl_prim:close(Socket).
-
-
-%% 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)].
-
-%% ------------------------------------------------------------
-%% Fetch local information about a Socket.
-%% ------------------------------------------------------------
-get_tcp_address(Socket) ->
- {ok, Address} = ssl_prim:sockname(Socket),
- {ok, Host} = inet:gethostname(),
- #net_address {
- address = Address,
- host = Host,
- protocol = ssl,
- family = inet
- }.
-
-%% ------------------------------------------------------------
-%% 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}.
-
-is_node_name(Node) when is_atom(Node) ->
- case split_node(atom_to_list(Node), $@, []) of
- [_, _Host] -> true;
- _ -> false
- end;
-is_node_name(_Node) ->
- false.
-tick(Sock) ->
- ?to_port(Sock,[],[force]).
-getstat(Socket) ->
- case ssl_prim:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of
- {ok, Stat} ->
- split_stat(Stat,0,0,0);
- Error ->
- Error
- end.
-
-split_stat([{recv_cnt, R}|Stat], _, W, P) ->
- split_stat(Stat, R, W, P);
-split_stat([{send_cnt, W}|Stat], R, _, P) ->
- split_stat(Stat, R, W, P);
-split_stat([{send_pend, P}|Stat], R, W, _) ->
- split_stat(Stat, R, W, P);
-split_stat([], R, W, P) ->
- {ok, R, W, P}.
-
-
-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/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
index f42c076460..115527aae0 100644
--- a/lib/ssl/src/inet_tls_dist.erl
+++ b/lib/ssl/src/inet_tls_dist.erl
@@ -136,9 +136,9 @@ check_ip(Socket) ->
end.
get_ifs(Socket) ->
- case ssl_prim:peername(Socket) of
+ case inet:peername(Socket) of
{ok, {IP, _}} ->
- case ssl_prim:getif(Socket) of
+ case inet:getif(Socket) of
{ok, IFs} -> {ok, IFs, IP};
Error -> Error
end;
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index afe19da900..13d5eaf4d7 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -4,14 +4,9 @@
{modules, [ssl,
ssl_app,
ssl_sup,
- ssl_server,
- ssl_broker,
- ssl_broker_sup,
- ssl_prim,
inet_tls_dist,
ssl_tls_dist_proxy,
ssl_dist_sup,
- inet_ssl_dist,
ssl_tls1,
ssl_ssl3,
ssl_ssl2,
@@ -29,7 +24,7 @@
ssl_certificate,
ssl_alert
]},
- {registered, [ssl_sup, ssl_server, ssl_broker_sup]},
+ {registered, [ssl_sup, ssl_manager]},
{applications, [crypto, public_key, kernel, stdlib]},
{env, []},
{mod, {ssl_app, []}}]}.
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 57e0570bee..35f9410562 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -25,18 +25,15 @@
-export([start/0, start/1, stop/0, transport_accept/1,
transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3,
- ciphers/0, cipher_suites/0, cipher_suites/1, close/1, shutdown/2,
+ cipher_suites/0, cipher_suites/1, close/1, shutdown/2,
connect/3, connect/2, connect/4, connection_info/1,
- controlling_process/2, listen/2, pid/1, peername/1, recv/2, recv/3,
- send/2, getopts/2, setopts/2, seed/1, sockname/1, peercert/1,
- peercert/2, version/0, versions/0, session_info/1, format_error/1,
+ controlling_process/2, listen/2, pid/1, peername/1, peercert/1,
+ recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1,
+ versions/0, session_info/1, format_error/1,
renegotiate/1]).
-%% Should be deprecated as soon as old ssl is removed
-%%-deprecated({pid, 1, next_major_release}).
--deprecated({peercert, 2, next_major_release}).
+-deprecated({pid, 1, next_major_release}).
--include("ssl_int.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
-include("ssl_cipher.hrl").
@@ -134,20 +131,13 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) ->
connect(Host, Port, Options) ->
connect(Host, Port, Options, infinity).
-connect(Host, Port, Options0, Timeout) ->
- case proplists:get_value(ssl_imp, Options0, new) of
- new ->
- new_connect(Host, Port, Options0, Timeout);
- old ->
- %% Allow the option reuseaddr to be present
- %% so that new and old ssl can be run by the same
- %% code, however the option will be ignored by old ssl
- %% that hardcodes reuseaddr to true in its portprogram.
- Options1 = proplists:delete(reuseaddr, Options0),
- Options = proplists:delete(ssl_imp, Options1),
- old_connect(Host, Port, Options, Timeout);
- Value ->
- {error, {eoptions, {ssl_imp, Value}}}
+connect(Host, Port, Options, Timeout) ->
+ try handle_options(Options, client) of
+ {ok, Config} ->
+ do_connect(Host,Port,Config,Timeout)
+ catch
+ throw:Error ->
+ Error
end.
%%--------------------------------------------------------------------
@@ -159,21 +149,19 @@ connect(Host, Port, Options0, Timeout) ->
listen(_Port, []) ->
{error, enooptions};
listen(Port, Options0) ->
- case proplists:get_value(ssl_imp, Options0, new) of
- new ->
- new_listen(Port, Options0);
- old ->
- %% Allow the option reuseaddr to be present
- %% so that new and old ssl can be run by the same
- %% code, however the option will be ignored by old ssl
- %% that hardcodes reuseaddr to true in its portprogram.
- Options1 = proplists:delete(reuseaddr, Options0),
- Options = proplists:delete(ssl_imp, Options1),
- old_listen(Port, Options);
- Value ->
- {error, {eoptions, {ssl_imp, Value}}}
+ try
+ {ok, Config} = handle_options(Options0, server),
+ #config{cb={CbModule, _, _, _},inet_user=Options} = Config,
+ case CbModule:listen(Port, Options) of
+ {ok, ListenSocket} ->
+ {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}};
+ Err = {error, _} ->
+ Err
+ end
+ catch
+ Error = {error, _} ->
+ Error
end.
-
%%--------------------------------------------------------------------
-spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} |
{error, reason()}.
@@ -185,8 +173,7 @@ listen(Port, Options0) ->
transport_accept(ListenSocket) ->
transport_accept(ListenSocket, infinity).
-transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}},
- fd = new_ssl}, Timeout) ->
+transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}}, Timeout) ->
%% The setopt could have been invoked on the listen socket
%% and options should be inherited.
@@ -208,12 +195,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}
end;
{error, Reason} ->
{error, Reason}
- end;
-
-transport_accept(#sslsocket{} = ListenSocket, Timeout) ->
- ensure_old_ssl_started(),
- {ok, Pid} = ssl_broker:start_broker(acceptor),
- ssl_broker:transport_accept(Pid, ListenSocket, Timeout).
+ end.
%%--------------------------------------------------------------------
-spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}.
@@ -227,16 +209,11 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) ->
ssl_accept(ListenSocket) ->
ssl_accept(ListenSocket, infinity).
-ssl_accept(#sslsocket{fd = new_ssl} = Socket, Timeout) ->
+ssl_accept(#sslsocket{} = Socket, Timeout) ->
ssl_connection:handshake(Socket, Timeout);
ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
- ssl_accept(ListenSocket, SslOptions, infinity);
-
-%% Old ssl
-ssl_accept(#sslsocket{} = Socket, Timeout) ->
- ensure_old_ssl_started(),
- ssl_broker:ssl_accept(Socket, Timeout).
+ ssl_accept(ListenSocket, SslOptions, infinity).
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
EmulatedOptions = emulated_options(),
@@ -257,25 +234,18 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
%%
%% Description: Close an ssl connection
%%--------------------------------------------------------------------
-close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) ->
+close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) ->
CbMod:close(ListenSocket);
-close(#sslsocket{pid = Pid, fd = new_ssl}) ->
- ssl_connection:close(Pid);
-close(Socket = #sslsocket{}) ->
- ensure_old_ssl_started(),
- ssl_broker:close(Socket).
+close(#sslsocket{pid = Pid}) ->
+ ssl_connection:close(Pid).
%%--------------------------------------------------------------------
-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}.
%%
%% Description: Sends data over the ssl connection
%%--------------------------------------------------------------------
-send(#sslsocket{pid = Pid, fd = new_ssl}, Data) ->
- ssl_connection:send(Pid, Data);
-
-send(#sslsocket{} = Socket, Data) ->
- ensure_old_ssl_started(),
- ssl_broker:send(Socket, Data).
+send(#sslsocket{pid = Pid}, Data) ->
+ ssl_connection:send(Pid, Data).
%%--------------------------------------------------------------------
-spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}.
@@ -286,11 +256,7 @@ send(#sslsocket{} = Socket, Data) ->
recv(Socket, Length) ->
recv(Socket, Length, infinity).
recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) ->
- ssl_connection:recv(Pid, Length, Timeout);
-
-recv(Socket = #sslsocket{}, Length, Timeout) ->
- ensure_old_ssl_started(),
- ssl_broker:recv(Socket, Length, Timeout).
+ ssl_connection:recv(Pid, Length, Timeout).
%%--------------------------------------------------------------------
-spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}.
@@ -298,13 +264,8 @@ recv(Socket = #sslsocket{}, Length, Timeout) ->
%% Description: Changes process that receives the messages when active = true
%% or once.
%%--------------------------------------------------------------------
-controlling_process(#sslsocket{pid = Pid, fd = new_ssl}, NewOwner)
- when is_pid(Pid) ->
- ssl_connection:new_user(Pid, NewOwner);
-
-controlling_process(Socket, NewOwner) when is_pid(NewOwner) ->
- ensure_old_ssl_started(),
- ssl_broker:controlling_process(Socket, NewOwner).
+controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) ->
+ ssl_connection:new_user(Pid, NewOwner).
%%--------------------------------------------------------------------
-spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} |
@@ -312,81 +273,30 @@ controlling_process(Socket, NewOwner) when is_pid(NewOwner) ->
%%
%% Description: Returns ssl protocol and cipher used for the connection
%%--------------------------------------------------------------------
-connection_info(#sslsocket{pid = Pid, fd = new_ssl}) ->
- ssl_connection:info(Pid);
+connection_info(#sslsocket{pid = Pid}) ->
+ ssl_connection:info(Pid).
-connection_info(#sslsocket{} = Socket) ->
- ensure_old_ssl_started(),
- ssl_broker:connection_info(Socket).
+%%--------------------------------------------------------------------
+-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
+%%
+%% Description: same as inet:peername/1.
+%%--------------------------------------------------------------------
+peername(#sslsocket{pid = Pid}) ->
+ ssl_connection:peername(Pid).
%%--------------------------------------------------------------------
--spec peercert(#sslsocket{}) ->{ok, der_cert()} | {error, reason()}.
+-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}.
%%
%% Description: Returns the peercert.
%%--------------------------------------------------------------------
-peercert(Socket) ->
- peercert(Socket, []).
-
-peercert(#sslsocket{pid = Pid, fd = new_ssl}, Opts) ->
+peercert(#sslsocket{pid = Pid}) ->
case ssl_connection:peer_certificate(Pid) of
{ok, undefined} ->
{error, no_peercert};
- {ok, BinCert} ->
- decode_peercert(BinCert, Opts);
- {error, Reason} ->
- {error, Reason}
- end;
-
-peercert(#sslsocket{} = Socket, Opts) ->
- ensure_old_ssl_started(),
- case ssl_broker:peercert(Socket) of
- {ok, Bin} ->
- decode_peercert(Bin, Opts);
- {error, Reason} ->
- {error, Reason}
- end.
-
-
-decode_peercert(BinCert, Opts) ->
- PKOpts = [case Opt of ssl -> otp; pkix -> plain end ||
- Opt <- Opts, Opt =:= ssl orelse Opt =:= pkix],
- case PKOpts of
- [Opt] ->
- select_part(Opt, public_key:pkix_decode_cert(BinCert, Opt), Opts);
- [] ->
- {ok, BinCert}
+ Result ->
+ Result
end.
-select_part(otp, Cert, Opts) ->
- case lists:member(subject, Opts) of
- true ->
- TBS = Cert#'OTPCertificate'.tbsCertificate,
- {ok, TBS#'OTPTBSCertificate'.subject};
- false ->
- {ok, Cert}
- end;
-
-select_part(plain, Cert, Opts) ->
- case lists:member(subject, Opts) of
- true ->
- TBS = Cert#'Certificate'.tbsCertificate,
- {ok, TBS#'TBSCertificate'.subject};
- false ->
- {ok, Cert}
- end.
-
-%%--------------------------------------------------------------------
--spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
-%%
-%% Description: same as inet:peername/1.
-%%--------------------------------------------------------------------
-peername(#sslsocket{fd = new_ssl, pid = Pid}) ->
- ssl_connection:peername(Pid);
-
-peername(#sslsocket{} = Socket) ->
- ensure_old_ssl_started(),
- ssl_broker:peername(Socket).
-
%%--------------------------------------------------------------------
-spec cipher_suites() -> [erl_cipher_suite()].
-spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()].
@@ -410,9 +320,9 @@ cipher_suites(openssl) ->
%%
%% Description: Gets options
%%--------------------------------------------------------------------
-getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
+getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
ssl_connection:get_opts(Pid, OptionTags);
-getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) ->
+getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) ->
try inet:getopts(ListenSocket, OptionTags) of
{ok, _} = Result ->
Result;
@@ -422,18 +332,15 @@ getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_l
_:_ ->
{error, {eoptions, {inet_options, OptionTags}}}
end;
-getopts(#sslsocket{fd = new_ssl}, OptionTags) ->
- {error, {eoptions, {inet_options, OptionTags}}};
-getopts(#sslsocket{} = Socket, OptionTags) ->
- ensure_old_ssl_started(),
- ssl_broker:getopts(Socket, OptionTags).
+getopts(#sslsocket{}, OptionTags) ->
+ {error, {eoptions, {inet_options, OptionTags}}}.
%%--------------------------------------------------------------------
-spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}.
%%
%% Description: Sets options
%%--------------------------------------------------------------------
-setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
+setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
try proplists:expand([{binary, [{mode, binary}]},
{list, [{mode, list}]}], Options0) of
Options ->
@@ -443,7 +350,7 @@ setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list
{error, {eoptions, {not_a_proplist, Options0}}}
end;
-setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list(Options) ->
+setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) ->
try inet:setopts(ListenSocket, Options) of
ok ->
ok;
@@ -453,20 +360,17 @@ setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list
_:Error ->
{error, {eoptions, {inet_options, Options, Error}}}
end;
-setopts(#sslsocket{fd = new_ssl}, Options) ->
- {error, {eoptions,{not_a_proplist, Options}}};
-setopts(#sslsocket{} = Socket, Options) ->
- ensure_old_ssl_started(),
- ssl_broker:setopts(Socket, Options).
+setopts(#sslsocket{}, Options) ->
+ {error, {eoptions,{not_a_proplist, Options}}}.
%%---------------------------------------------------------------
-spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}.
%%
%% Description: Same as gen_tcp:shutdown/2
%%--------------------------------------------------------------------
-shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}, How) ->
+shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}, How) ->
CbMod:shutdown(ListenSocket, How);
-shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) ->
+shutdown(#sslsocket{pid = Pid}, How) ->
ssl_connection:shutdown(Pid, How).
%%--------------------------------------------------------------------
@@ -474,25 +378,11 @@ shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) ->
%%
%% Description: Same as inet:sockname/1
%%--------------------------------------------------------------------
-sockname(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}) ->
+sockname(#sslsocket{pid = {ListenSocket, _}}) ->
inet:sockname(ListenSocket);
-sockname(#sslsocket{fd = new_ssl, pid = Pid}) ->
- ssl_connection:sockname(Pid);
-
-sockname(#sslsocket{} = Socket) ->
- ensure_old_ssl_started(),
- ssl_broker:sockname(Socket).
-
-%%---------------------------------------------------------------
--spec seed(term()) ->term().
-%%
-%% Description: Only used by old ssl.
-%%--------------------------------------------------------------------
-%% TODO: crypto:seed ?
-seed(Data) ->
- ensure_old_ssl_started(),
- ssl_server:seed(Data).
+sockname(#sslsocket{pid = Pid}) ->
+ ssl_connection:sockname(Pid).
%%---------------------------------------------------------------
-spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}.
@@ -548,63 +438,6 @@ format_error(esslconnect) ->
format_error({eoptions, Options}) ->
lists:flatten(io_lib:format("Error in options list: ~p~n", [Options]));
-%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-format_error(ebadsocket) ->
- "Connection not found (internal error).";
-format_error(ebadstate) ->
- "Connection not in connect state (internal error).";
-format_error(ebrokertype) ->
- "Wrong broker type (internal error).";
-format_error(echaintoolong) ->
- "The chain of certificates provided by peer is too long.";
-format_error(ecipher) ->
- "Own list of specified ciphers is invalid.";
-format_error(ekeymismatch) ->
- "Own private key does not match own certificate.";
-format_error(enoissuercert) ->
- "Cannot find certificate of issuer of certificate provided by peer.";
-format_error(enoservercert) ->
- "Attempt to do accept without having set own certificate.";
-format_error(enotlistener) ->
- "Attempt to accept on a non-listening socket.";
-format_error(enoproxysocket) ->
- "No proxy socket found (internal error or max number of file "
- "descriptors exceeded).";
-format_error(enooptions) ->
- "List of options is empty.";
-format_error(enotstarted) ->
- "The SSL application has not been started.";
-format_error(eoptions) ->
- "Invalid list of options.";
-format_error(epeercert) ->
- "Certificate provided by peer is in error.";
-format_error(epeercertexpired) ->
- "Certificate provided by peer has expired.";
-format_error(epeercertinvalid) ->
- "Certificate provided by peer is invalid.";
-format_error(eselfsignedcert) ->
- "Certificate provided by peer is self signed.";
-format_error(esslerrssl) ->
- "SSL protocol failure. Typically because of a fatal alert from peer.";
-format_error(ewantconnect) ->
- "Protocol wants to connect, which is not supported in this "
- "version of the SSL application.";
-format_error(ex509lookup) ->
- "Protocol wants X.509 lookup, which is not supported in this "
- "version of the SSL application.";
-format_error({badcall, _Call}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-format_error({badcast, _Cast}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-
-format_error({badinfo, _Info}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-
-%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
format_error(Error) ->
case (catch inet:format_error(Error)) of
"unkknown POSIX" ++ _ ->
@@ -618,16 +451,7 @@ format_error(Error) ->
%%%--------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
-new_connect(Address, Port, Options, Timeout) when is_list(Options) ->
- try handle_options(Options, client) of
- {ok, Config} ->
- do_new_connect(Address,Port,Config,Timeout)
- catch
- throw:Error ->
- Error
- end.
-
-do_new_connect(Address, Port,
+do_connect(Address, Port,
#config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts,
emulated=EmOpts,inet_ssl=SocketOpts},
Timeout) ->
@@ -647,35 +471,9 @@ do_new_connect(Address, Port,
{error, {eoptions, {inet_options, UserOpts}}}
end.
-old_connect(Address, Port, Options, Timeout) ->
- ensure_old_ssl_started(),
- {ok, Pid} = ssl_broker:start_broker(connector),
- ssl_broker:connect(Pid, Address, Port, Options, Timeout).
-
-new_listen(Port, Options0) ->
- try
- {ok, Config} = handle_options(Options0, server),
- #config{cb={CbModule, _, _, _},inet_user=Options} = Config,
- case CbModule:listen(Port, Options) of
- {ok, ListenSocket} ->
- {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}};
- Err = {error, _} ->
- Err
- end
- catch
- Error = {error, _} ->
- Error
- end.
-
-old_listen(Port, Options) ->
- ensure_old_ssl_started(),
- {ok, Pid} = ssl_broker:start_broker(listener),
- ssl_broker:listen(Pid, Port, Options).
-
handle_options(Opts0, _Role) ->
Opts = proplists:expand([{binary, [{mode, binary}]},
{list, [{mode, list}]}], Opts0),
-
ReuseSessionFun = fun(_, _, _, _) -> true end,
DefaultVerifyNoneFun =
@@ -769,8 +567,6 @@ handle_option(OptionName, Opts, Default) ->
validate_option(versions, Versions) ->
validate_versions(Versions, Versions);
-validate_option(ssl_imp, Value) when Value == new; Value == old ->
- Value;
validate_option(verify, Value)
when Value == verify_none; Value == verify_peer ->
Value;
@@ -913,7 +709,6 @@ emulated_options() ->
internal_inet_values() ->
[{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}].
- %%[{packet, ssl},{header, 0},{active, false},{mode,binary}].
socket_options(InetValues) ->
#socket_options{
@@ -974,47 +769,14 @@ cipher_suites(Version, Ciphers0) ->
no_format(Error) ->
lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])).
-
-%% Start old ssl port program if needed.
-ensure_old_ssl_started() ->
- case whereis(ssl_server) of
- undefined ->
- (catch supervisor:start_child(ssl_sup,
- {ssl_server, {ssl_server, start_link, []},
- permanent, 2000, worker, [ssl_server]}));
- _ ->
- ok
- end.
-
-%%%%%%%%%%%%%%%% Deprecated %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-ciphers() ->
- ensure_old_ssl_started(),
- case (catch ssl_server:ciphers()) of
- {'EXIT', _} ->
- {error, enotstarted};
- Res = {ok, _} ->
- Res
- end.
-
-version() ->
- ensure_old_ssl_started(),
- SSLVsn = ?VSN,
- {CompVsn, LibVsn} = case (catch ssl_server:version()) of
- {'EXIT', _} ->
- {"", ""};
- {ok, Vsns} ->
- Vsns
- end,
- {ok, {SSLVsn, CompVsn, LibVsn}}.
-
%% Only used to remove exit messages from old ssl
%% First is a nonsense clause to provide some
%% backward compatibility for orber that uses this
%% function in a none recommended way, but will
%% work correctly if a valid pid is returned.
+%% Deprcated to be removed in r16
pid(#sslsocket{fd = new_ssl}) ->
- whereis(ssl_connection_sup);
+ whereis(ssl_connection_sup);
pid(#sslsocket{pid = Pid}) ->
- Pid.
+ Pid.
diff --git a/lib/ssl/src/ssl_broker.erl b/lib/ssl/src/ssl_broker.erl
deleted file mode 100644
index 7ef88baf2b..0000000000
--- a/lib/ssl/src/ssl_broker.erl
+++ /dev/null
@@ -1,1188 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2010. 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%
-%%
-
-%%
-
-%%% Purpose : SSL broker
-
--module(ssl_broker).
--behaviour(gen_server).
-
-%% This module implements brokers for ssl. A broker is either a connector,
-%% an acceptor, or a listener. All brokers are children to ssl_broker_sup,
-%% to which they are linked. Each broker is also linked to ssl_server, and
-%% to its client.
-%%
-%% The purpose of the broker is to set up SSL connections through calls to
-%% ssl_server and gen_tcp. All control information goes to the server,
-%% while all data is exchanged directly between gen_tcp and the port program
-%% of the ssl_server.
-%%
-%% A broker is created by a call to start_broker/3 (do *not* use start_link/4
-%% - it is for ssl_broker_sup to call that one), and then call listen/3,
-%% accept/4, or connect/5.
-%%
-%% The following table shows all functions dependency on status, active
-%% mode etc.
-%%
-%% Permitted status transitions:
-%%
-%% nil -> open
-%% open -> closing | closed (termination)
-%% closing -> closed (termination)
-%%
-%% We are rather sloppy about nil, and consider open/closing == !closed,
-%% open/closing/closed === any etc.
-%%
-%%
-%% function/ valid mode new
-%% message status state
-%%
-%% calls
-%% -----
-%% recv open passive ditto
-%% send open any ditto
-%% transport_accept nil any open
-%% ssl_accept nil any open
-%% connect nil any open
-%% listen nil any open
-%% peername open/closing any ditto
-%% setopts open/closing any ditto
-%% getopts open/closing any ditto
-%% sockname open/closing any ditto
-%% peercert open/closing any ditto
-%% inhibit any any ditto
-%% release any any ditto
-%% close any any closed (1)
-%%
-%% info
-%% ----
-%% tcp open active ditto
-%% tcp_closed open | closing active closing
-%% tcp_error open | closing active closing
-%%
-%% (1) We just terminate.
-%%
-%% TODO
-%%
-%% XXX Timeouts are not checked (integer or infinity).
-%%
-%% XXX The collector thing is not gen_server compliant.
-%%
-%% NOTE: There are three different "modes": (a) passive or active mode,
-%% specified as {active, bool()}, and (b) list or binary mode, specified
-%% as {mode, list | binary}, and (c) encrypted or clear mode
-%%
-
--include("ssl_int.hrl").
-
-%% External exports
-
--export([start_broker/1, start_broker/2, start_link/3,
- transport_accept/3, ssl_accept/2,
- close/1, connect/5, connection_info/1, controlling_process/2,
- listen/3, recv/3, send/2, getopts/2, getopts/3, setopts/2,
- sockname/1, peername/1, peercert/1]).
-
--export([listen_prim/5, connect_prim/8,
- transport_accept_prim/5, ssl_accept_prim/6]).
-
-%% Internal exports
-
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- code_change/3, terminate/2, collector_init/1]).
-
--include("ssl_broker_int.hrl").
-
-%% start_broker(Type) -> {ok, Pid} | {error, Reason}
-%% start_broker(Type, GenOpts) -> {ok, Pid} | {error, Reason}
-%% Type = accept | connect | listen
-%% GenOpts = /standard gen_server options/
-%%
-%% This is the function to be called from the interface module ssl.erl.
-%% Links to the caller.
-%%
-start_broker(Type) ->
- start_broker(Type, []).
-
-start_broker(Type, GenOpts) ->
- case lists:member(Type, [listener, acceptor, connector]) of
- true ->
- case supervisor:start_child(ssl_broker_sup,
- [self(), Type, GenOpts]) of
- {ok, Pid} ->
- link(Pid),
- {ok, Pid};
- {error, Reason} ->
- {error, Reason}
- end;
- false ->
- {error, ebrokertype}
- end.
-
-%% start_link(Client, Type, GenOpts) -> {ok, Pid} | {error, Reason}
-%%
-%% Type = accept | connect | listen
-%% GenOpts = /standard gen_server options/
-%%
-%% This function is called by ssl_broker_sup and must *not* be called
-%% from an interface module (ssl.erl).
-
-start_link(Client, Type, GenOpts) ->
- gen_server:start_link(?MODULE, [Client, Type], GenOpts).
-
-
-%% accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | {error, Reason}
-%%
-%% Types: Pid = pid() of acceptor
-%% ListenSocket = Socket = sslsocket()
-%% Timeout = timeout()
-%%
-%% accept(Pid, ListenSocket, Timeout)
-%% when is_pid(Pid), is_record(ListenSocket, sslsocket) ->
-%% Req = {accept, self(), ListenSocket, Timeout},
-%% gen_server:call(Pid, Req, infinity).
-
-%% transport_accept(Pid, ListenSocket, Timeout) -> {ok, Socket} |
-%% {error, Reason}
-%%
-%% Types: Pid = pid() of acceptor
-%% ListenSocket = Socket = sslsocket()
-%% Timeout = timeout()
-%%
-transport_accept(Pid, #sslsocket{} = ListenSocket, Timeout) when is_pid(Pid) ->
- Req = {transport_accept, self(), ListenSocket, Timeout},
- gen_server:call(Pid, Req, infinity).
-
-%% ssl_accept(Pid, Socket, Timeout) -> {ok, Socket} | {error, Reason}
-%%
-%% Types: Pid = pid() of acceptor
-%% ListenSocket = Socket = sslsocket()
-%% Timeout = timeout()
-%%
-ssl_accept(#sslsocket{pid = Pid} = Socket, Timeout) ->
- Req = {ssl_accept, self(), Socket, Timeout},
- gen_server:call(Pid, Req, infinity).
-
-%% close(Socket) -> ok | {error, Reason}
-%%
-%% Types: Socket = sslsocket() | pid()
-%%
-close(#sslsocket{pid = Pid}) ->
- close(Pid);
-close(Pid) when is_pid(Pid) ->
- gen_server:call(Pid, {close, self()}, infinity).
-
-%% connect(Pid, Address, Port, Opts, Timeout) -> {ok, Socket} | {error, Reason}
-%%
-%% Types: Pid = pid() of connector
-%% Address = string() | {byte(), byte(), byte(), byte()}
-%% Port = int()
-%% Opts = options()
-%% Timeout = timeout()
-%% Socket = sslsocket()
-%%
-connect(Pid, Address, Port, Opts, Timeout) when is_pid(Pid), is_list(Opts) ->
- case are_connect_opts(Opts) of
- true ->
- Req = {connect, self(), Address, Port, Opts, Timeout},
- gen_server:call(Pid, Req, infinity);
- false ->
- {error, eoptions}
- end.
-
-%%
-%% connection_info(Socket) -> {ok, {Protocol, Cipher} | {error, Reason}
-%%
-connection_info(#sslsocket{pid = Pid}) ->
- Req = {connection_info, self()},
- gen_server:call(Pid, Req, infinity).
-
-%% controlling_process(Socket, NewOwner) -> ok | {error, Reason}
-
-controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(NewOwner) ->
- case gen_server:call(Pid, {inhibit_msgs, self()}, infinity) of
- ok ->
- transfer_messages(Pid, NewOwner),
- gen_server:call(Pid, {release_msgs, self(), NewOwner}, infinity);
- Error ->
- Error
- end.
-
-%% listen(Pid, Port, Opts) -> {ok, ListenSocket} | {error, Reason}
-%%
-%% Types: Pid = pid() of listener
-%% Port = int()
-%% Opts = options()
-%% ListenSocket = sslsocket()
-%%
-listen(Pid, Port, Opts) when is_pid(Pid) ->
- case are_listen_opts(Opts) of
- true ->
- Req = {listen, self(), Port, Opts},
- gen_server:call(Pid, Req, infinity);
- false ->
- {error, eoptions}
- end.
-
-
-%%
-%% peername(Socket) -> {ok, {Address, Port}} | {error, Reason}
-%%
-peername(#sslsocket{pid = Pid}) ->
- Req = {peername, self()},
- gen_server:call(Pid, Req, infinity).
-
-
-%% recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason}
-%%
-%% Types: Socket = sslsocket()
-%% Length = Timeout = integer()
-%% Data = bytes() | binary()
-%%
-recv(#sslsocket{pid = Pid}, Length, Timeout) ->
- Req = {recv, self(), Length, Timeout},
- gen_server:call(Pid, Req, infinity).
-
-
-%% send(Socket, Data) -> ok | {error, Reason}
-%%
-%% Types: Socket = sslsocket()
-%%
-send(#sslsocket{pid = Pid}, Data) ->
- gen_server:call(Pid, {send, self(), Data}, infinity).
-
-
-%% getopts(Socket, OptTags) -> {ok, Opts} | {error, einval}
-%%
-%% Types: Pid = pid() of broker
-%% Timeout = timeout()
-%% OptTags = option_tags()
-%% Opts = options()
-%%
-getopts(Socket, OptTags) ->
- getopts(Socket, OptTags, infinity).
-
-getopts(#sslsocket{pid = Pid}, OptTags, Timeout) when is_list(OptTags) ->
- Req = {getopts, self(), OptTags},
- gen_server:call(Pid, Req, Timeout).
-
-
-%%
-%% setopts(Socket, Opts) -> ok | {error, Reason}
-%%
-setopts(#sslsocket{pid = Pid}, Opts) ->
- Req = {setopts, self(), Opts},
- gen_server:call(Pid, Req, infinity).
-
-%%
-%% sockname(Socket) -> {ok, {Address, Port}} | {error, Reason}
-%%
-sockname(#sslsocket{pid = Pid}) ->
- Req = {sockname, self()},
- gen_server:call(Pid, Req, infinity).
-
-
-%%
-%% peercert(Socket) -> {ok, Cert} | {error, Reason}
-%%
-peercert(#sslsocket{pid = Pid}) ->
- Req = {peercert, self()},
- gen_server:call(Pid, Req, infinity).
-
-%%
-%% INIT
-%%
-
-%% init
-%%
-init([Client, Type]) ->
- process_flag(trap_exit, true),
- link(Client),
- Debug = case application:get_env(ssl, edebug) of
- {ok, true} ->
- true;
- _ ->
- case application:get_env(ssl, debug) of
- {ok, true} ->
- true;
- _ ->
- os:getenv("ERL_SSL_DEBUG") =/= false
- end
- end,
- Server = whereis(ssl_server),
- if
- is_pid(Server) ->
- link(Server),
- debug1(Debug, Type, "in start, client = ~w", [Client]),
- {ok, #st{brokertype = Type, server = Server, client = Client,
- collector = Client, debug = Debug}};
- true ->
- {stop, no_ssl_server}
- end.
-
-
-%%
-%% HANDLE CALL
-%%
-
-%% recv - passive mode
-%%
-handle_call({recv, Client, Length, Timeout}, _From,
- #st{active = false, proxysock = Proxysock, status = Status} = St) ->
- debug(St, "recv: client = ~w~n", [Client]),
- if
- Status =/= open ->
- {reply, {error, closed}, St};
- true ->
- case gen_tcp:recv(Proxysock, Length, Timeout) of
- {ok, Data} ->
- {reply, {ok, Data}, St};
- {error, timeout} ->
- {reply, {error, timeout}, St};
- {error, Reason} ->
- {reply, {error, Reason}, St#st{status = closing}}
- end
- end;
-
-%% send
-%%
-handle_call({send, Client, Data}, _From, St) ->
- debug(St, "send: client = ~w~n", [Client]),
- if
- St#st.status =/= open ->
- {reply, {error, closed}, St};
- true ->
- case gen_tcp:send(St#st.proxysock, Data) of
- ok ->
- {reply, ok, St};
- {error, _Reason} ->
- {reply, {error, closed}, St#st{status = closing}}
- end
- end;
-
-%% transport_accept
-%%
-%% Client = pid of client
-%% ListenSocket = sslsocket()
-%%
-handle_call({transport_accept, Client, ListenSocket, Timeout}, _From, St) ->
- debug(St, "transport_accept: client = ~w, listensocket = ~w~n",
- [Client, ListenSocket]),
- case getopts(ListenSocket, tcp_listen_opt_tags(), ?DEF_TIMEOUT) of
- {ok, LOpts} ->
- case transport_accept_prim(
- ssl_server, ListenSocket#sslsocket.fd, LOpts, Timeout, St) of
- {ok, ThisSocket, NSt} ->
- {reply, {ok, ThisSocket}, NSt};
- {error, Reason, St} ->
- What = what(Reason),
- {stop, normal, {error, What}, St}
- end;
- {error, Reason} ->
- What = what(Reason),
- {stop, normal, {error, What}, St}
- end;
-
-%% ssl_accept
-%%
-%% Client = pid of client
-%% ListenSocket = sslsocket()
-%%
-handle_call({ssl_accept, Client, Socket, Timeout}, _From, St) ->
- debug(St, "ssl_accept: client = ~w, socket = ~w~n", [Client, Socket]),
- case ssl_accept_prim(ssl_server, gen_tcp, Client, St#st.opts, Timeout, St#st{thissock=Socket}) of
- {ok, Socket, NSt} ->
- {reply, ok, NSt};
- {error, Reason, St} ->
- What = what(Reason),
- {stop, normal, {error, What}, St}
- end;
-
-%% connect
-%%
-%% Client = client pid
-%% Address = hostname | ipstring | IP
-%% Port = integer()
-%% Opts = options()
-%%
-handle_call({connect, Client, Address, Port, Opts, Timeout}, _From, St) ->
- debug(St, "connect: client = ~w, address = ~p, port = ~w~n",
- [Client, Address, Port]),
- case connect_prim(ssl_server, gen_tcp, Client, Address, Port, Opts,
- Timeout, St) of
- {ok, Res, NSt} ->
- {reply, {ok, Res}, NSt};
- {error, Reason, NSt} ->
- What = what(Reason),
- {stop, normal, {error, What}, NSt}
- end;
-
-%% connection_info
-%%
-handle_call({connection_info, Client}, _From, St) ->
- debug(St, "connection_info: client = ~w~n", [Client]),
- Reply = ssl_server:connection_info(St#st.fd),
- {reply, Reply, St};
-
-%% close from client
-%%
-handle_call({close, Client}, _From, St) ->
- debug(St, "close: client = ~w~n", [Client]),
- %% Terminate
- {stop, normal, ok, St#st{status = closed}};
-
-%% listen
-%%
-%% Client = pid of client
-%% Port = int()
-%% Opts = options()
-%%
-handle_call({listen, Client, Port, Opts}, _From, St) ->
- debug(St, "listen: client = ~w, port = ~w~n",
- [Client, Port]),
- case listen_prim(ssl_server, Client, Port, Opts, St) of
- {ok, Res, NSt} ->
- {reply, {ok, Res}, NSt};
- {error, Reason, NSt} ->
- What = what(Reason),
- {stop, normal, {error, What}, NSt}
- end;
-
-%% peername
-%%
-handle_call({peername, Client}, _From, St) ->
- debug(St, "peername: client = ~w~n", [Client]),
- Reply = case ssl_server:peername(St#st.fd) of
- {ok, {Address, Port}} ->
- {ok, At} = inet_parse:ipv4_address(Address),
- {ok, {At, Port}};
- Error ->
- Error
- end,
- {reply, Reply, St};
-
-%% setopts
-%%
-handle_call({setopts, Client, Opts0}, _From, St0) ->
- debug(St0, "setopts: client = ~w~n", [Client]),
- OptsOK = case St0#st.brokertype of
- listener ->
- are_opts(fun is_tcp_listen_opt/1, Opts0);
- acceptor ->
- are_opts(fun is_tcp_accept_opt/1, Opts0);
- connector ->
- are_opts(fun is_tcp_connect_opt/1, Opts0)
- end,
- if
- OptsOK =:= false ->
- {reply, {error, eoptions}, St0};
- true ->
- Opts1 = lists:keydelete(nodelay, 1, Opts0),
- case inet:setopts(St0#st.proxysock, Opts1) of
- ok ->
- Opts2 = replace_opts(Opts1, St0#st.opts),
- Active = get_active(Opts2),
- St2 = St0#st{opts = Opts2,
- active = Active},
- case get_nodelay(Opts0) of
- empty ->
- {reply, ok, St2};
- Bool ->
- case setnodelay(ssl_server, St0, Bool) of
- ok ->
- Opts3 = replace_opts([{nodelay, Bool}],
- Opts2),
- St3 = St0#st{opts = Opts3,
- active = Active},
- {reply, ok, St3};
- {error, Reason} ->
- {reply, {error, Reason}, St2}
- end
- end;
- {error, Reason} ->
- {reply, {error, Reason}, St0}
- end
- end;
-
-%% sockname
-%%
-handle_call({sockname, Client}, _From, St) ->
- debug(St, "sockname: client = ~w~n", [Client]),
- Reply = case ssl_server:sockname(St#st.fd) of
- {ok, {Address, Port}} ->
- {ok, At} = inet_parse:ipv4_address(Address),
- {ok, {At, Port}};
- Error ->
- Error
- end,
- {reply, Reply, St};
-
-%% peercert
-%%
-handle_call({peercert, Client}, _From, St) ->
- debug(St, "peercert: client = ~w~n", [Client]),
- Reply = ssl_server:peercert(St#st.fd),
- {reply, Reply, St};
-
-%% inhibit msgs
-%%
-handle_call({inhibit_msgs, Client}, _From, #st{client = Client} = St) ->
- debug(St, "inhibit_msgs: client = ~w~n", [Client]),
- {ok, Collector} = start_collector(),
- {reply, ok, St#st{collector = Collector}};
-
-%% release msgs
-%%
-handle_call({release_msgs, Client, NewClient}, _From,
- #st{client = Client, collector = Collector} = St) ->
- debug(St, "release_msgs: client = ~w~n", [Client]),
- unlink(Client),
- link(NewClient),
- release_collector(Collector, NewClient),
- NSt = St#st{client = NewClient, collector = NewClient},
- {reply, ok, NSt};
-
-%% getopts
-%%
-handle_call({getopts, Client, OptTags}, _From, St) ->
- debug(St, "getopts: client = ~w~n", [Client]),
- Reply = case are_opt_tags(St#st.brokertype, OptTags) of
- true ->
- {ok, extract_opts(OptTags, St#st.opts)};
- _ ->
- {error, einval}
- end,
- {reply, Reply, St};
-
-%% bad call
-%%
-handle_call(Request, _From, St) ->
- debug(St, "++++ ssl_broker: bad call: ~w~n", [Request]),
- {reply, {error, {badcall, Request}}, St}.
-
-%%
-%% HANDLE CAST
-%%
-
-handle_cast(Request, St) ->
- debug(St, "++++ ssl_broker: bad cast: ~w~n", [Request]),
- {stop, {error, {badcast, Request}}, St}.
-
-%%
-%% HANDLE INFO
-%%
-
-%% tcp - active mode
-%%
-%% The collector is different from client only during change of
-%% controlling process.
-%%
-handle_info({tcp, Socket, Data},
- #st{active = Active, collector = Collector, status = open,
- proxysock = Socket, thissock = Thissock} = St)
- when Active =/= false ->
- debug(St, "tcp: socket = ~w~n", [Socket]),
- Msg = {ssl, Thissock, Data},
- Collector ! Msg,
- if
- Active =:= once ->
- {noreply, St#st{active = false}};
- true ->
- {noreply, St}
- end;
-
-%% tcp_closed - from proxy socket, active mode
-%%
-%%
-handle_info({tcp_closed, Socket},
- #st{active = Active, collector = Collector,
- proxysock = Socket, thissock = Thissock} = St)
- when Active =/= false ->
- debug(St, "tcp_closed: socket = ~w~n", [Socket]),
- Msg = {ssl_closed, Thissock},
- Collector ! Msg,
- if
- Active =:= once ->
- {noreply, St#st{status = closing, active = false}};
- true ->
- {noreply, St#st{status = closing}}
- end;
-
-%% tcp_error - from proxy socket, active mode
-%%
-%%
-handle_info({tcp_error, Socket, Reason},
- #st{active = Active, collector = Collector,
- proxysock = Socket} = St)
- when Active =/= false ->
- debug(St, "tcp_error: socket = ~w, reason = ~w~n", [Socket, Reason]),
- Msg = {ssl_error, Socket, Reason},
- Collector ! Msg,
- if
- Active =:= once ->
- {noreply, St#st{status = closing, active = false}};
- true ->
- {noreply, St#st{status = closing}}
- end;
-
-%% EXIT - from client
-%%
-%%
-handle_info({'EXIT', Client, Reason}, #st{client = Client} = St) ->
- debug(St, "exit client: client = ~w, reason = ~w~n", [Client, Reason]),
- {stop, normal, St#st{status = closed}}; % do not make noise
-
-%% EXIT - from server
-%%
-%%
-handle_info({'EXIT', Server, Reason}, #st{server = Server} = St) ->
- debug(St, "exit server: reason = ~w~n", [Reason]),
- {stop, Reason, St};
-
-%% handle info catch all
-%%
-handle_info(Info, St) ->
- debug(St, " bad info: ~w~n", [Info]),
- {stop, {error, {badinfo, Info}}, St}.
-
-
-%% terminate
-%%
-%%
-terminate(Reason, St) ->
- debug(St, "in terminate reason: ~w, state: ~w~n", [Reason, St]),
- ok.
-
-%% code_change
-%%
-%%
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%
-%% Primitive interface
-%%
-listen_prim(ServerName, Client, Port, Opts, St) ->
- LOpts = get_tcp_listen_opts(Opts),
- SSLOpts = get_ssl_opts(Opts),
- FlagStr =mk_ssl_optstr(SSLOpts),
- BackLog = get_backlog(LOpts),
- IP = get_ip(LOpts),
- case ssl_server:listen_prim(ServerName, IP, Port, FlagStr, BackLog) of
- {ok, ListenFd, _Port0} ->
- ThisSocket = #sslsocket{fd = ListenFd, pid = self()},
- StOpts = add_default_tcp_listen_opts(LOpts) ++
- add_default_ssl_opts(SSLOpts),
- NSt = St#st{fd = ListenFd,
- active = get_active(LOpts), % irrelevant for listen
- opts = StOpts,
- thissock = ThisSocket,
- status = open},
- debug(St, "listen: ok: client = ~w, listenfd = ~w~n",
- [Client, ListenFd]),
- {ok, ThisSocket, NSt};
- {error, Reason} ->
- {error, Reason, St}
- end.
-
-connect_prim(ServerName, TcpModule, Client, FAddress, FPort, Opts,
- Timeout, St) ->
- COpts = get_tcp_connect_opts(Opts),
- SSLOpts = get_ssl_opts(Opts),
- FlagStr = mk_ssl_optstr(SSLOpts),
- case inet:getaddr(FAddress, inet) of
- {ok, FIP} ->
- %% Timeout is gen_server timeout - hence catch
- LIP = get_ip(COpts),
- LPort = get_port(COpts),
- case (catch ssl_server:connect_prim(ServerName,
- LIP, LPort, FIP, FPort,
- FlagStr, Timeout)) of
- {ok, Fd, ProxyPort} ->
- case connect_proxy(ServerName, TcpModule, Fd,
- ProxyPort, COpts, Timeout) of
- {ok, Socket} ->
- ThisSocket = #sslsocket{fd = Fd, pid = self()},
- StOpts = add_default_tcp_connect_opts(COpts) ++
- add_default_ssl_opts(SSLOpts),
- NSt = St#st{fd = Fd,
- active = get_active(COpts),
- opts = StOpts,
- thissock = ThisSocket,
- proxysock = Socket,
- status = open},
- case get_nodelay(COpts) of
- true -> setnodelay(ServerName, NSt, true);
- _ -> ok
- end,
- debug(St, "connect: ok: client = ~w, fd = ~w~n",
- [Client, Fd]),
- {ok, ThisSocket, NSt};
- {error, Reason} ->
- {error, Reason, St}
- end;
- {'EXIT', Reason} ->
- {error, Reason, St};
- {error, Reason} ->
- {error, Reason, St}
- end;
- {error, Reason} ->
- {error, Reason, St}
- end.
-
-transport_accept_prim(ServerName, ListenFd, LOpts, Timeout, St) ->
- AOpts = get_tcp_accept_opts(LOpts),
- FlagStr = "",
- %% Timeout is gen_server timeout - hence catch.
- case (catch ssl_server:transport_accept_prim(ServerName, ListenFd,
- FlagStr, Timeout)) of
- {ok, Fd, ProxyPort} ->
- ThisSocket = #sslsocket{fd = Fd, pid = self()},
- NSt = St#st{fd = Fd,
- active = get_active(AOpts),
- opts = AOpts,
- thissock = ThisSocket,
- proxyport = ProxyPort,
- encrypted = false},
- debug(St, "transport_accept: ok: fd = ~w~n", [Fd]),
- {ok, ThisSocket, NSt};
- {'EXIT', Reason} ->
- debug(St, "transport_accept: EXIT: Reason = ~w~n", [Reason]),
- {error, Reason, St};
- {error, Reason} ->
- debug(St, "transport_accept: error: Reason = ~w~n", [Reason]),
- {error, Reason, St}
- end.
-
-ssl_accept_prim(ServerName, TcpModule, Client, LOpts, Timeout, St) ->
- FlagStr = [],
- SSLOpts = [],
- AOpts = get_tcp_accept_opts(LOpts),
- %% Timeout is gen_server timeout - hence catch.
- debug(St, "ssl_accept_prim: self() ~w Client ~w~n", [self(), Client]),
- Socket = St#st.thissock,
- Fd = Socket#sslsocket.fd,
- A = (catch ssl_server:ssl_accept_prim(ServerName, Fd, FlagStr, Timeout)),
- debug(St, "ssl_accept_prim: ~w~n", [A]),
- case A of
- ok ->
- B = connect_proxy(ServerName, TcpModule, Fd,
- St#st.proxyport, AOpts, Timeout),
- debug(St, "ssl_accept_prim: connect_proxy ~w~n", [B]),
- case B of
- {ok, Socket2} ->
- StOpts = add_default_tcp_accept_opts(AOpts) ++
- add_default_ssl_opts(SSLOpts),
- NSt = St#st{opts = StOpts,
- proxysock = Socket2,
- encrypted = true,
- status = open},
- case get_nodelay(AOpts) of
- true -> setnodelay(ServerName, NSt, true);
- _ -> ok
- end,
- debug(St, "transport_accept: ok: client = ~w, fd = ~w~n",
- [Client, Fd]),
- {ok, St#st.thissock, NSt};
- {error, Reason} ->
- {error, Reason, St}
- end;
- {'EXIT', Reason} ->
- {error, Reason, St};
- {error, Reason} ->
- {error, Reason, St}
- end.
-
-
-%%
-%% LOCAL FUNCTIONS
-%%
-
-%%
-%% connect_proxy(Fd, ProxyPort, TOpts, Timeout) -> {ok, Socket} |
-%% {error, Reason}
-%%
-connect_proxy(ServerName, TcpModule, Fd, ProxyPort, TOpts, Timeout) ->
- case TcpModule:connect({127, 0, 0, 1}, ProxyPort, TOpts, Timeout) of
- {ok, Socket} ->
- {ok, Port} = inet:port(Socket),
- A = ssl_server:proxy_join_prim(ServerName, Fd, Port),
- case A of
- ok ->
- {ok, Socket};
- Error ->
- Error
- end;
- Error ->
- Error
- end.
-
-
-setnodelay(ServerName, St, Bool) ->
- case ssl_server:setnodelay_prim(ServerName, St#st.fd, Bool) of
- ok ->
- case inet:setopts(St#st.proxysock, [{nodelay, Bool}]) of
- ok ->
- ok;
- {error, Reason} ->
- {error, Reason}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
-
-%%
-%% start_collector()
-%%
-%% A collector is a little process that keeps messages during change of
-%% controlling process.
-%% XXX This is not gen_server compliant :-(.
-%%
-start_collector() ->
- Pid = spawn_link(?MODULE, collector_init, [self()]),
- {ok, Pid}.
-
-%%
-%% release_collector(Collector, NewOwner)
-%%
-release_collector(Collector, NewOwner) ->
- Collector ! {release, self(), NewOwner},
- receive
- %% Reap collector
- {'EXIT', Collector, normal} ->
- ok
- end.
-
-%%
-%% collector_init(Broker) -> void()
-%%
-collector_init(Broker) ->
- receive
- {release, Broker, NewOwner} ->
- transfer_messages(Broker, NewOwner)
- end.
-
-%%
-%% transfer_messages(Pid, NewOwner) -> void()
-%%
-transfer_messages(Pid, NewOwner) ->
- receive
- {ssl, Sock, Data} ->
- NewOwner ! {ssl, Sock, Data},
- transfer_messages(Pid, NewOwner);
- {ssl_closed, Sock} ->
- NewOwner ! {ssl_closed, Sock},
- transfer_messages(Pid, NewOwner);
- {ssl_error, Sock, Reason} ->
- NewOwner ! {ssl_error, Sock, Reason},
- transfer_messages(Pid, NewOwner)
- after 0 ->
- ok
- end.
-
-%%
-%% debug(St, Format, Args) -> void() - printouts
-%%
-debug(St, Format, Args) ->
- debug1(St#st.debug, St#st.brokertype, Format, Args).
-
-debug1(true, Type, Format0, Args) ->
- {_MS, S, MiS} = erlang:now(),
- Secs = S rem 100,
- MiSecs = MiS div 1000,
- Format = "++++ ~3..0w:~3..0w ssl_broker (~w)[~w]: " ++ Format0,
- io:format(Format, [Secs, MiSecs, self(), Type| Args]);
-debug1(_, _, _, _) ->
- ok.
-
-%%
-%% what(Reason) -> What
-%%
-what(Reason) when is_atom(Reason) ->
- Reason;
-what({'EXIT', Reason}) ->
- what(Reason);
-what({What, _Where}) when is_atom(What) ->
- What;
-what(Reason) ->
- Reason.
-
-
-%%
-%% OPTIONS
-%%
-%% Note that `accept' has no options when invoked, but get all its options
-%% by inheritance from `listen'.
-%%
-
-are_opt_tags(listener, OptTags) ->
- is_subset(OptTags, listen_opt_tags());
-are_opt_tags(acceptor, OptTags) ->
- is_subset(OptTags, accept_opt_tags());
-are_opt_tags(connector, OptTags) ->
- is_subset(OptTags, connect_opt_tags()).
-
-listen_opt_tags() ->
- tcp_listen_opt_tags() ++ ssl_opt_tags().
-
-accept_opt_tags() ->
- tcp_gen_opt_tags().
-
-connect_opt_tags() ->
- tcp_gen_opt_tags() ++ ssl_opt_tags().
-
-tcp_listen_opt_tags() ->
- tcp_gen_opt_tags() ++ tcp_listen_only_opt_tags().
-
-tcp_gen_opt_tags() ->
- %% All except `reuseaddr' and `deliver'.
- [nodelay, active, packet, mode, header].
-
-tcp_listen_only_opt_tags() ->
- [ip, backlog].
-
-ssl_opt_tags() ->
- %% XXX Should remove cachetimeout.
- [verify, depth, certfile, password, cacertfile, ciphers, cachetimeout].
-
-%% Options
-
-%%
-%% are_*_opts(Opts) -> boolean()
-%%
-are_connect_opts(Opts) ->
- are_opts(fun is_connect_opt/1, Opts).
-
-are_listen_opts(Opts) ->
- are_opts(fun is_listen_opt/1, Opts).
-
-are_opts(F, Opts) ->
- lists:all(F, transform_opts(Opts)).
-
-%%
-%% get_*_opts(Opts) -> Value
-%%
-get_tcp_accept_opts(Opts) ->
- [O || O <- transform_opts(Opts), is_tcp_accept_opt(O)].
-
-get_tcp_connect_opts(Opts) ->
- [O || O <- transform_opts(Opts), is_tcp_connect_opt(O)].
-
-get_tcp_listen_opts(Opts) ->
- [O || O <- transform_opts(Opts), is_tcp_listen_opt(O)].
-
-get_ssl_opts(Opts) ->
- [O || O <- transform_opts(Opts), is_ssl_opt(O)].
-
-get_active(Opts) ->
- get_tagged_opt(active, Opts, true).
-
-get_backlog(Opts) ->
- get_tagged_opt(backlog, Opts, ?DEF_BACKLOG).
-
-get_ip(Opts) ->
- get_tagged_opt(ip, Opts, {0, 0, 0, 0}).
-
-get_port(Opts) ->
- get_tagged_opt(port, Opts, 0).
-
-get_nodelay(Opts) ->
- get_tagged_opt(nodelay, Opts, empty).
-
-%%
-%% add_default_*_opts(Opts) -> NOpts
-%%
-
-add_default_tcp_accept_opts(Opts) ->
- add_default_opts(Opts, default_tcp_accept_opts()).
-
-add_default_tcp_connect_opts(Opts) ->
- add_default_opts(Opts, default_tcp_connect_opts()).
-
-add_default_tcp_listen_opts(Opts) ->
- add_default_opts(Opts, default_tcp_listen_opts()).
-
-add_default_ssl_opts(Opts) ->
- add_default_opts(Opts, default_ssl_opts()).
-
-add_default_opts(Opts, DefOpts) ->
- TOpts = transform_opts(Opts),
- TOpts ++ [DP || {DTag, _DVal} = DP <- DefOpts,
- not lists:keymember(DTag, 1, TOpts)].
-
-default_tcp_accept_opts() ->
- [O || O <- default_opts(), is_tcp_accept_opt(O)].
-
-default_tcp_connect_opts() ->
- [O || O <- default_opts(), is_tcp_connect_opt(O)].
-
-default_tcp_listen_opts() ->
- [O || O <- default_opts(), is_tcp_listen_opt(O)].
-
-default_ssl_opts() ->
- [O || O <- default_opts(), is_ssl_opt(O)].
-
-default_opts() ->
- [{mode, list}, {packet, 0}, {nodelay, false}, {active, true},
- {backlog, ?DEF_BACKLOG}, {ip, {0, 0, 0, 0}},
- {verify, 0}, {depth, 1}].
-
-
-%% Transform from old to new options, and also from old gen_tcp
-%% options to new ones. All returned options are tagged options.
-%%
-transform_opts(Opts) ->
- lists:flatmap(fun transform_opt/1, Opts).
-
-transform_opt(binary) -> [{mode, binary}];
-transform_opt(list) -> [{mode, list}];
-transform_opt({packet, raw}) -> [{packet, 0}];
-transform_opt(raw) -> [];
-transform_opt(Opt) -> [Opt].
-
-%% NOTE: The is_*_opt/1 functions must be applied on transformed options
-%% only.
-
-is_connect_opt(Opt) ->
- is_tcp_connect_opt(Opt) or is_ssl_opt(Opt).
-
-is_listen_opt(Opt) ->
- is_tcp_listen_opt(Opt) or is_ssl_opt(Opt).
-
-is_tcp_accept_opt(Opt) ->
- is_tcp_gen_opt(Opt).
-
-is_tcp_connect_opt(Opt) ->
- is_tcp_gen_opt(Opt) or is_tcp_connect_only_opt(Opt).
-
-is_tcp_listen_opt(Opt) ->
- is_tcp_gen_opt(Opt) or is_tcp_listen_only_opt(Opt).
-
-%% General options supported by gen_tcp: All except `reuseaddr' and
-%% `deliver'.
-is_tcp_gen_opt({mode, list}) -> true;
-is_tcp_gen_opt({mode, binary}) -> true;
-is_tcp_gen_opt({header, Sz}) when is_integer(Sz), 0 =< Sz -> true;
-is_tcp_gen_opt({packet, Sz}) when is_integer(Sz), 0 =< Sz, Sz =< 4-> true;
-is_tcp_gen_opt({packet, sunrm}) -> true;
-is_tcp_gen_opt({packet, asn1}) -> true;
-is_tcp_gen_opt({packet, cdr}) -> true;
-is_tcp_gen_opt({packet, fcgi}) -> true;
-is_tcp_gen_opt({packet, line}) -> true;
-is_tcp_gen_opt({packet, tpkt}) -> true;
-is_tcp_gen_opt({packet, http}) -> true;
-is_tcp_gen_opt({packet, httph}) -> true;
-is_tcp_gen_opt({nodelay, true}) -> true;
-is_tcp_gen_opt({nodelay, false}) -> true;
-is_tcp_gen_opt({active, true}) -> true;
-is_tcp_gen_opt({active, false}) -> true;
-is_tcp_gen_opt({active, once}) -> true;
-is_tcp_gen_opt({keepalive, true}) -> true;
-is_tcp_gen_opt({keepalive, false}) -> true;
-is_tcp_gen_opt({ip, Addr}) -> is_ip_address(Addr);
-is_tcp_gen_opt(_Opt) -> false.
-
-is_tcp_listen_only_opt({backlog, Size}) when is_integer(Size), 0 =< Size ->
- true;
-is_tcp_listen_only_opt({reuseaddr, Bool}) when is_boolean(Bool) ->
- true;
-is_tcp_listen_only_opt(_Opt) -> false.
-
-is_tcp_connect_only_opt({port, Port}) when is_integer(Port), 0 =< Port -> true;
-is_tcp_connect_only_opt(_Opt) -> false.
-
-%% SSL options
-
-is_ssl_opt({verify, Code}) when 0 =< Code, Code =< 2 -> true;
-is_ssl_opt({depth, Depth}) when 0 =< Depth -> true;
-is_ssl_opt({certfile, String}) -> is_string(String);
-is_ssl_opt({keyfile, String}) -> is_string(String);
-is_ssl_opt({password, String}) -> is_string(String);
-is_ssl_opt({cacertfile, String}) -> is_string(String);
-is_ssl_opt({ciphers, String}) -> is_string(String);
-is_ssl_opt({cachetimeout, Timeout}) when Timeout >= 0 -> true;
-is_ssl_opt(_Opt) -> false.
-
-%% Various types
-is_string(String) when is_list(String) ->
- lists:all(fun (C) when is_integer(C), 0 =< C, C =< 255 -> true;
- (_C) -> false end,
- String);
-is_string(_) ->
- false.
-
-is_ip_address(Addr) when tuple_size(Addr) =:= 4 ->
- is_string(tuple_to_list(Addr));
-is_ip_address(Addr) when is_list(Addr) ->
- is_string(Addr);
-is_ip_address(_) ->
- false.
-
-get_tagged_opt(Tag, Opts, Default) ->
- case lists:keysearch(Tag, 1, Opts) of
- {value, {_, Value}} ->
- Value;
- _Other ->
- Default
- end.
-
-%%
-%% mk_ssl_optstr(Opts) -> string()
-%%
-%% Makes a "command line" string of SSL options
-%%
-mk_ssl_optstr(Opts) ->
- lists:flatten([mk_one_ssl_optstr(O) || O <- Opts]).
-
-mk_one_ssl_optstr({verify, Code}) ->
- [" -verify ", integer_to_list(Code)];
-mk_one_ssl_optstr({depth, Depth}) ->
- [" -depth ", integer_to_list(Depth)];
-mk_one_ssl_optstr({certfile, String}) ->
- [" -certfile ", String];
-mk_one_ssl_optstr({keyfile, String}) ->
- [" -keyfile ", String];
-mk_one_ssl_optstr({password, String}) ->
- [" -password ", String];
-mk_one_ssl_optstr({cacertfile, String}) ->
- [" -cacertfile ", String];
-mk_one_ssl_optstr({ciphers, String}) ->
- [" -ciphers ", String];
-mk_one_ssl_optstr({cachetimeout, Timeout}) ->
- [" -cachetimeout ", integer_to_list(Timeout)];
-mk_one_ssl_optstr(_) ->
- "".
-
-extract_opts(OptTags, Opts) ->
- [O || O = {Tag,_} <- Opts, lists:member(Tag, OptTags)].
-
-replace_opts(NOpts, Opts) ->
- lists:foldl(fun({Key, Val}, Acc) ->
- lists:keyreplace(Key, 1, Acc, {Key, Val});
- %% XXX Check. Patch from Chandrashekhar Mullaparthi.
- (binary, Acc) ->
- lists:keyreplace(mode, 1, Acc, {mode, binary})
- end,
- Opts, NOpts).
-
-%% Misc
-
-is_subset(A, B) ->
- [] =:= A -- B.
diff --git a/lib/ssl/src/ssl_broker_int.hrl b/lib/ssl/src/ssl_broker_int.hrl
deleted file mode 100644
index b791485725..0000000000
--- a/lib/ssl/src/ssl_broker_int.hrl
+++ /dev/null
@@ -1,38 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2009. 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%
-%%
-
-%%
-
-%% Purpose: record definitions shared between ssl_prim.erl and ssl_broker.erl
-
--record(st, {brokertype = nil, % connector | listener | acceptor
- server = nil, % pid of ssl_server
- client = nil, % client pid
- collector = nil, % client pid, or collector during change of
- % controlling process
- fd = nil, % fd of "external" socket in port program
- active = true, % true | false | once
- opts = [], % options
- thissock = nil, % this sslsocket
- proxysock = nil, % local proxy socket within Erlang
- proxyport = nil, % local port for proxy within Erlang
- status = nil, % open | closing | closed
- encrypted = false, %
- debug = false %
- }).
diff --git a/lib/ssl/src/ssl_broker_sup.erl b/lib/ssl/src/ssl_broker_sup.erl
deleted file mode 100644
index 6d56a5fcf6..0000000000
--- a/lib/ssl/src/ssl_broker_sup.erl
+++ /dev/null
@@ -1,46 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. 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%
-%%
-
-%%
-
-%%% Purpose : Supervisor for brokers
-
--module(ssl_broker_sup).
-
--behaviour(supervisor).
-
--export([start_link/0]).
-
-%% supervisor callbacks
--export([init/1]).
-
-start_link() ->
- supervisor:start_link({local, ssl_broker_sup}, ssl_broker_sup,
- []).
-
-init([]) ->
- {ok, {{simple_one_for_one, 10, 3600},
- [{ssl_broker,
- {ssl_broker, start_link, []},
- temporary,
- 100,
- worker,
- [ssl_broker]}
- ]}}.
-
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 79ee054200..c772697f1d 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -34,7 +34,6 @@
-include("ssl_record.hrl").
-include("ssl_cipher.hrl").
-include("ssl_internal.hrl").
--include("ssl_int.hrl").
-include_lib("public_key/include/public_key.hrl").
%% Internal application API
diff --git a/lib/ssl/src/ssl_int.hrl b/lib/ssl/src/ssl_int.hrl
deleted file mode 100644
index 3686deffce..0000000000
--- a/lib/ssl/src/ssl_int.hrl
+++ /dev/null
@@ -1,99 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. 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%
-%%
-
-%%
-
-%% op codes commands are in capital and reply codes in lower case
-
--define(CONNECT, 1).
--define(CONNECT_WAIT, 2).
--define(CONNECT_REP, 3).
--define(CONNECT_ERR, 4).
-
--define(TERMINATE, 5).
--define(CLOSE, 6).
-
--define(LISTEN, 7).
--define(LISTEN_REP, 8).
--define(LISTEN_ERR, 9).
-
--define(TRANSPORT_ACCEPT, 10).
--define(NOACCEPT, 11).
--define(TRANSPORT_ACCEPT_REP, 12).
--define(TRANSPORT_ACCEPT_ERR, 13).
-
--define(FROMNET_CLOSE, 14).
-
--define(CONNECT_SYNC_ERR, 15).
--define(LISTEN_SYNC_ERR, 16).
-
--define(PROXY_PORT, 23).
--define(PROXY_JOIN, 24).
--define(PROXY_JOIN_REP, 25).
--define(PROXY_JOIN_ERR, 26).
-
--define(SET_SOCK_OPT, 27).
--define(IOCTL_OK, 28).
--define(IOCTL_ERR, 29).
-
--define(GETPEERNAME, 30).
--define(GETPEERNAME_REP, 31).
--define(GETPEERNAME_ERR, 32).
-
--define(GETSOCKNAME, 33).
--define(GETSOCKNAME_REP, 34).
--define(GETSOCKNAME_ERR, 35).
-
--define(GETPEERCERT, 36).
--define(GETPEERCERT_REP, 37).
--define(GETPEERCERT_ERR, 38).
-
--define(GETVERSION, 39).
--define(GETVERSION_REP, 40).
-
--define(SET_SEED, 41).
-
--define(GETCONNINFO, 42).
--define(GETCONNINFO_REP, 43).
--define(GETCONNINFO_ERR, 44).
-
--define(SSL_ACCEPT, 45).
--define(SSL_ACCEPT_REP, 46).
--define(SSL_ACCEPT_ERR, 47).
-
--define(DUMP_CMD, 48).
--define(DEBUG_CMD, 49).
--define(DEBUGMSG_CMD, 50).
-
-%% --------------
-
--define(SSLv2, 1).
--define(SSLv3, 2).
--define(TLSv1, 4).
-
-
-%% Set socket options codes 'SET_SOCK_OPT'
--define(SET_TCP_NODELAY, 1).
-
--define(DEF_BACKLOG, 128).
-
--define(DEF_TIMEOUT, 10000).
-
--record(sslsocket, { fd = nil, pid = nil}).
-
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 483e06067c..18cfcdcd68 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -24,6 +24,9 @@
-include_lib("public_key/include/public_key.hrl").
+%% Looks like it does for backwards compatibility reasons
+-record(sslsocket, {fd = nil, pid = nil}).
+
-type reason() :: term().
-type reply() :: term().
-type msg() :: term().
diff --git a/lib/ssl/src/ssl_prim.erl b/lib/ssl/src/ssl_prim.erl
deleted file mode 100644
index e3140a89d1..0000000000
--- a/lib/ssl/src/ssl_prim.erl
+++ /dev/null
@@ -1,173 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2009. 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%
-%%
-
-%%
-
-%% Purpose: Primitive interface to SSL, without broker process (used by
-%% SSL distribution).
-
--module(ssl_prim).
-
--export([listen/2, connect/3, accept/1, close/1, send/2, send/3, recv/2, recv/3,
- getll/1, getstat/2, setopts/2, controlling_process/2, peername/1,
- sockname/1, getif/1]).
-
--include("ssl_int.hrl").
--include("ssl_broker_int.hrl").
-
-%-define(filter(Call), filter((catch Call))).
--define(filter(Call), filter(Call)).
-
-listen(Port, Opts) ->
- St = newstate(listener),
- ?filter(ssl_broker:listen_prim(ssl_server_prim, self(), Port, nonactive(Opts), St)).
-
-connect(Address, Port, Opts) ->
- St = newstate(connector),
- ?filter(ssl_broker:connect_prim(ssl_server_prim, inet_tcp, self(), Address,
- Port, nonactive(Opts), infinity, St)).
-
-accept(#st{} = ListenSt0) ->
- case transport_accept(ListenSt0) of
- {ok, ListenSt1} ->
- ssl_accept(ListenSt0, ListenSt1);
- Error ->
- Error
- end.
-
-transport_accept(#st{opts = ListenOpts, thissock = ListenSocket}) ->
- NewSt = newstate(acceptor),
- ListenFd = ListenSocket#sslsocket.fd,
- ?filter(ssl_broker:transport_accept_prim(ssl_server_prim, ListenFd,
- ListenOpts, infinity, NewSt)).
-
-ssl_accept(#st{opts = LOpts}, ListenSt1) ->
- ?filter(ssl_broker:ssl_accept_prim(ssl_server_prim, gen_tcp, self(),
- LOpts, infinity, ListenSt1)).
-
-close(#st{fd = Fd}) when is_integer(Fd) ->
- ssl_server:close_prim(ssl_server_prim, Fd),
- ok;
-close(_) ->
- ok.
-
-send(St, Data) ->
- send(St, Data, []).
-
-send(#st{proxysock = Proxysock, status = open}, Data, Opts) ->
- case inet_tcp:send(Proxysock, Data, Opts) of
- ok ->
- ok;
- {error, _} ->
- {error, closed}
- end;
-send(#st{}, _Data, _Opts) ->
- {error, closed}.
-
-recv(St, Length) ->
- recv(St, Length, infinity).
-
-recv(#st{proxysock = Proxysock, status = open}, Length, Tmo) ->
- inet_tcp:recv(Proxysock, Length, Tmo);
-recv(#st{}, _Length, _Tmo) ->
- {error, closed}.
-
-getll(#st{proxysock = Proxysock, status = open}) ->
- inet:getll(Proxysock);
-getll(#st{}) ->
- {error, closed}.
-
-getstat(#st{proxysock = Proxysock, status = open}, Opts) ->
- inet:getstat(Proxysock, Opts);
-getstat(#st{}, _Opts) ->
- {error, closed}.
-
-setopts(#st{proxysock = Proxysock, status = open}, Opts) ->
- case remove_supported(Opts) of
- [] ->
- inet:setopts(Proxysock, Opts);
- _ ->
- {error, enotsup}
- end;
-setopts(#st{}, _Opts) ->
- {error, closed}.
-
-
-controlling_process(#st{proxysock = Proxysock, status = open}, Pid)
- when is_pid(Pid) ->
- inet_tcp:controlling_process(Proxysock, Pid);
-controlling_process(#st{}, Pid) when is_pid(Pid) ->
- {error, closed}.
-
-peername(#st{fd = Fd, status = open}) ->
- case ssl_server:peername_prim(ssl_server_prim, Fd) of
- {ok, {Address, Port}} ->
- {ok, At} = inet_parse:ipv4_address(Address),
- {ok, {At, Port}};
- Error ->
- Error
- end;
-peername(#st{}) ->
- {error, closed}.
-
-sockname(#st{fd = Fd, status = open}) ->
- case ssl_server:sockname_prim(ssl_server_prim, Fd) of
- {ok, {Address, Port}} ->
- {ok, At} = inet_parse:ipv4_address(Address),
- {ok, {At, Port}};
- Error ->
- Error
- end;
-sockname(#st{}) ->
- {error, closed}.
-
-getif(#st{proxysock = Proxysock, status = open}) ->
- inet:getif(Proxysock);
-getif(#st{}) ->
- {error, closed}.
-
-remove_supported([{active, _}|T]) ->
- remove_supported(T);
-remove_supported([{packet,_}|T]) ->
- remove_supported(T);
-remove_supported([{deliver,_}|T]) ->
- remove_supported(T);
-remove_supported([H|T]) ->
- [H | remove_supported(T)];
-remove_supported([]) ->
- [].
-
-filter(Result) ->
- case Result of
- {ok, _Sock,St} ->
- {ok, St};
- {error, Reason, _St} ->
- {error,Reason}
- end.
-
-nonactive([{active,_}|T]) ->
- nonactive(T);
-nonactive([H|T]) ->
- [H | nonactive(T)];
-nonactive([]) ->
- [{active, false}].
-
-newstate(Type) ->
- #st{brokertype = Type, server = whereis(ssl_server_prim),
- client = undefined, collector = undefined, debug = false}.
diff --git a/lib/ssl/src/ssl_server.erl b/lib/ssl/src/ssl_server.erl
deleted file mode 100644
index b66e20a397..0000000000
--- a/lib/ssl/src/ssl_server.erl
+++ /dev/null
@@ -1,1378 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. 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%
-%%
-
-%%
-
-%%% Purpose : SSL server
-
-%%
-%% TODO
-%%
-%% XXX The ip option in listen is not general enough. It is assumed
-%% to be a tuple, which is not always the case.
-
--module(ssl_server).
--behaviour(gen_server).
-
-%% External exports
--export([start_link/0]).
-
--export([transport_accept/2, transport_accept/3, ssl_accept/2, ssl_accept/3,
- ciphers/0, connect/5, connect/6,
- connection_info/1, close/1, listen/3, listen/4, peercert/1,
- peername/1, proxy_join/2, seed/1, setnodelay/2, sockname/1,
- version/0]).
-
--export([start_link_prim/0]).
--export([ssl_accept_prim/4, transport_accept_prim/4,
- connect_prim/7, close_prim/2,
- listen_prim/5, proxy_join_prim/3, peername_prim/2, setnodelay_prim/3,
- sockname_prim/2]).
-
--export([dump/0, dump/1]).
--export([enable_debug/0, disable_debug/0, set_debug/1]).
--export([enable_debugmsg/0, disable_debugmsg/0, set_debugmsg/1]).
-
-%% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- code_change/3, terminate/2]).
-
--include("ssl_int.hrl").
-
--record(st, {
- port = [], % port() of port program
- progpid = [], % OS pid of port program
- debug = false, % debug printout flag
- cons = [], % All brokers except pending accepts
- paccepts = [], % Pending accept brokers
- proxylsport = [], % proxy listen socket port
- intref = 0, % internal reference counter
- compvsn = "", % ssl compile library version
- libvsn = "", % ssl library version
- ciphers = [] % available ciphers
- }).
-
-
-%% In all functions below IP is a four tuple, e.g. {192, 236, 52, 7}.
-%% Port, Fd and ListenFd are integers; Flags is a string of characters.
-%%
-%% The prefixes F and L mean foreign and local, respectively.
-%% Example: FIP (IP address for foreign end).
-
-%%
-%% start_link() -> {ok, Pid} | {error, Reason}
-%%
-start_link() ->
- gen_server:start_link({local, ssl_server}, ssl_server, [], []).
-
-start_link_prim() ->
- gen_server:start_link({local, ssl_server_prim}, ssl_server, [], []).
-
-%%
-%% transport_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} |
-%% {error, Reason}
-%%
-transport_accept(ListenFd, Flags) ->
- transport_accept(ListenFd, Flags, infinity).
-transport_accept(ListenFd, Flags, Timeout) ->
- transport_accept_prim(ssl_server,ListenFd, Flags, Timeout).
-
-transport_accept_prim(ServerName, ListenFd, Flags, Timeout) ->
- Req = {transport_accept, self(), ListenFd, Flags},
- gen_server:call(ServerName, Req, Timeout).
-
-%%
-%% ssl_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} |
-%% {error, Reason}
-%%
-ssl_accept(ListenFd, Flags) ->
- ssl_accept(ListenFd, Flags, infinity).
-ssl_accept(ListenFd, Flags, Timeout) ->
- ssl_accept_prim(ssl_server, ListenFd, Flags, Timeout).
-
-ssl_accept_prim(ServerName, Fd, Flags, Timeout) ->
- Req = {ssl_accept, Fd, Flags},
- gen_server:call(ServerName, Req, Timeout).
-
-%%
-%% ciphers() -> {ok, Ciphers}
-%%
-ciphers() ->
- gen_server:call(ssl_server, ciphers, infinity).
-
-%%
-%% close(Fd) -> ok
-%%
-close(Fd) ->
- close_prim(ssl_server, Fd).
-close_prim(ServerName, Fd) ->
- gen_server:call(ServerName, {close, self(), Fd}, infinity),
- ok.
-
-%%
-%% connect(LIP, LPort, FIP, FPort, Flags) -> {ok, Fd, ProxyLFPort} |
-%% {error, Reason}
-%%
-connect(LIP, LPort, FIP, FPort, Flags) ->
- connect(LIP, LPort, FIP, FPort, Flags, infinity).
-connect(LIP, LPort, FIP, FPort, Flags, Timeout) ->
- connect_prim(ssl_server, LIP, LPort, FIP, FPort, Flags, Timeout).
-
-connect_prim(ServerName, LIP, LPort, FIP, FPort, Flags, Timeout) ->
- Req = {connect, self(), LIP, LPort, FIP, FPort, Flags},
- gen_server:call(ServerName, Req, Timeout).
-
-%%
-%% connection_info(Fd) -> {ok, {Protocol, Cipher}} | {error, Reason}
-%%
-connection_info(Fd) ->
- Req = {connection_info, self(), Fd},
- gen_server:call(ssl_server, Req, infinity).
-
-%%
-%% listen(IP, LPort, Flags),
-%% listen(IP, LPort, Flags, BackLog) -> {ok, ListenFd, LPort0} |
-%% {error, Reason}
-%%
-listen(IP, LPort, Flags) ->
- listen(IP, LPort, Flags, ?DEF_BACKLOG).
-listen(IP, LPort, Flags, BackLog) ->
- listen_prim(ssl_server, IP, LPort, Flags, BackLog).
-listen_prim(ServerName, IP, LPort, Flags, BackLog) ->
- Req = {listen, self(), IP, LPort, Flags, BackLog},
- gen_server:call(ServerName, Req, infinity).
-
-%%
-%% peercert(Fd) -> {ok, Cert} | {error, Reason}
-%%
-peercert(Fd) ->
- Req = {peercert, self(), Fd},
- gen_server:call(ssl_server, Req, infinity).
-
-%%
-%% peername(Fd) -> {ok, {Address, Port}} | {error, Reason}
-%%
-peername(Fd) ->
- peername_prim(ssl_server, Fd).
-peername_prim(ServerName, Fd) ->
- Req = {peername, self(), Fd},
- gen_server:call(ServerName, Req, infinity).
-
-%%
-%% proxy_join(Fd, LPort) -> ok | {error, Reason}
-%%
-proxy_join(Fd, LPort) ->
- proxy_join_prim(ssl_server, Fd, LPort).
-proxy_join_prim(ServerName, Fd, LPort) ->
- Req = {proxy_join, self(), Fd, LPort},
- gen_server:call(ServerName, Req, infinity).
-
-%%
-%% seed(Data)
-%%
-seed(Data) ->
- Req = {seed, Data},
- gen_server:call(ssl_server, Req, infinity).
-
-%%
-%% set_nodelay(Fd, Boolean)
-%%
-setnodelay(Fd, Boolean) ->
- setnodelay_prim(ssl_server, Fd, Boolean).
-setnodelay_prim(ServerName, Fd, Boolean) ->
- Req = {setnodelay, self(), Fd, Boolean},
- gen_server:call(ServerName, Req, infinity).
-
-%%
-%% sockname(Fd) -> {ok, {Address, Port}} | {error, Reason}
-%%
-sockname(Fd) ->
- sockname_prim(ssl_server, Fd).
-sockname_prim(ServerName, Fd) ->
- Req = {sockname, self(), Fd},
- gen_server:call(ServerName, Req, infinity).
-
-%%
-%% version() -> {ok, {CompVsn, LibVsn}}
-%%
-version() ->
- gen_server:call(ssl_server, version, infinity).
-
-
-enable_debug() ->
- set_debug(true).
-
-disable_debug() ->
- set_debug(false).
-
-set_debug(Bool) ->
- set_debug(Bool, infinity).
-
-set_debug(Bool, Timeout) when is_boolean(Bool) ->
- Req = {set_debug, Bool, self()},
- gen_server:call(ssl_server, Req, Timeout).
-
-enable_debugmsg() ->
- set_debugmsg(true).
-
-disable_debugmsg() ->
- set_debugmsg(false).
-
-set_debugmsg(Bool) ->
- set_debugmsg(Bool, infinity).
-
-set_debugmsg(Bool, Timeout) when is_boolean(Bool) ->
- Req = {set_debugmsg, Bool, self()},
- gen_server:call(ssl_server, Req, Timeout).
-
-dump() ->
- dump(infinity).
-
-dump(Timeout) ->
- Req = {dump, self()},
- gen_server:call(ssl_server, Req, Timeout).
-
-%%
-%% init
-%%
-init([]) ->
- Debug = case application:get_env(ssl, edebug) of
- {ok, true} ->
- true;
- _ ->
- case application:get_env(ssl, debug) of
- {ok, true} ->
- true;
- _ ->
- os:getenv("ERL_SSL_DEBUG") =/= false
- end
- end,
- ProgDir =
- case init:get_argument(ssl_portprogram_dir) of
- {ok, [[D]]} ->
- D;
- _ ->
- find_priv_bin()
- end,
- {Program, Flags} = mk_cmd_line("ssl_esock"),
- Cmd = filename:join(ProgDir, Program) ++ " " ++ Flags,
- debug1(Debug, " start, Cmd = ~s~n", [Cmd]),
- case (catch open_port({spawn, Cmd}, [binary, {packet, 4}])) of
- Port when is_port(Port) ->
- process_flag(trap_exit, true),
- receive
- {Port, {data, Bin}} ->
- {ProxyLLPort, ProgPid, CompVsn, LibVsn, Ciphers} =
- decode_msg(Bin, [int16, int32, string, string,
- string]),
- debug1(Debug, "port program pid = ~w~n",
- [ProgPid]),
- {ok, #st{port = Port,
- proxylsport = ProxyLLPort,
- progpid = ProgPid,
- debug = Debug,
- compvsn = CompVsn,
- libvsn = LibVsn,
- ciphers = Ciphers}};
- {'EXIT', Port, Reason} ->
- {stop, Reason}
- end;
- {'EXIT', Reason} ->
- {stop, Reason}
- end.
-
-%%
-%% transport_accept
-%%
-handle_call({transport_accept, Broker, ListenFd, Flags}, From, St) ->
- debug(St, "transport_accept: broker = ~w, listenfd = ~w~n",
- [Broker, ListenFd]),
- case get_by_fd(ListenFd, St#st.cons) of
- {ok, {ListenFd, _, _}} ->
- send_cmd(St#st.port, ?TRANSPORT_ACCEPT, [int32(ListenFd), Flags, 0]),
- PAccepts = add({ListenFd, Broker, From}, St#st.paccepts),
- %%
- %% We reply when we get TRANSPORT_ACCEPT_REP or ASYNC_ACCEPT_ERR
- %%
- {noreply, St#st{paccepts = PAccepts}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% ssl_accept
-%%
-handle_call({ssl_accept, Fd, Flags}, From, St) ->
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} = _Rep ->
- send_cmd(St#st.port, ?SSL_ACCEPT, [int32(Fd), Flags, 0]),
- %% We reply when we get SSL_ACCEPT_REP or ASYNC_ACCEPT_ERR
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% version
-%%
-handle_call(ciphers, From, St) ->
- debug(St, "ciphers: from = ~w~n", [From]),
- {reply, {ok, St#st.ciphers}, St};
-
-%%
-%% connect
-%%
-handle_call({connect, Broker, LIP, LPort, FIP, FPort, Flags}, From, St) ->
- debug(St, "connect: broker = ~w, ip = ~w, "
- "sport = ~w~n", [Broker, FIP, FPort]),
- Port = St#st.port,
- LIPStr = ip_to_string(LIP),
- FIPStr = ip_to_string(FIP),
- IntRef = new_intref(St),
- send_cmd(Port, ?CONNECT, [int32(IntRef),
- int16(LPort), LIPStr, 0,
- int16(FPort), FIPStr, 0,
- Flags, 0]),
- Cons = add({{intref, IntRef}, Broker, From}, St#st.cons),
- %% We reply when we have got CONNECT_SYNC_ERR, or CONNECT_WAIT
- %% and CONNECT_REP, or CONNECT_ERR.
- {noreply, St#st{cons = Cons, intref = IntRef}};
-
-%%
-%% connection_info
-%%
-handle_call({connection_info, Broker, Fd}, From, St) ->
- debug(St, "connection_info: broker = ~w, fd = ~w~n",
- [Broker, Fd]),
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} ->
- send_cmd(St#st.port, ?GETCONNINFO, [int32(Fd)]),
- %% We reply when we get GETCONNINFO_REP or GETCONNINFO_ERR.
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% close
-%%
-handle_call({close, Broker, Fd}, _From, St) ->
- debug(St, "close: broker = ~w, fd = ~w~n",
- [Broker, Fd]),
- #st{port = Port, cons = Cons0, paccepts = PAccepts0} = St,
- case delete_by_fd(Fd, Cons0) of
- %% Must match Broker pid; fd may be reused already.
- {ok, {Fd, Broker, _}, Cons} ->
- send_cmd(Port, ?CLOSE, int32(Fd)),
- %% If Fd is a listen socket fd, there might be pending
- %% accepts for that fd.
- case delete_all_by_fd(Fd, PAccepts0) of
- {ok, DelAccepts, RemAccepts} ->
- %% Reply {error, closed} to all pending accepts
- lists:foreach(fun({_, _, AccFrom}) ->
- gen_server:reply(AccFrom,
- {error, closed})
- end, DelAccepts),
- {reply, ok,
- St#st{cons = Cons, paccepts = RemAccepts}};
- _ ->
- {reply, ok, St#st{cons = Cons}}
- end;
- _ ->
- {reply, ok, St}
- end;
-
-%%
-%% listen
-%%
-handle_call({listen, Broker, IP, LPort, Flags, BackLog}, From, St) ->
- debug(St, "listen: broker = ~w, IP = ~w, "
- "sport = ~w~n", [Broker, IP, LPort]),
- Port = St#st.port,
- IPStr = ip_to_string(IP),
- IntRef = new_intref(St),
- send_cmd(Port, ?LISTEN, [int32(IntRef), int16(LPort), IPStr, 0,
- int16(BackLog), Flags, 0]),
- Cons = add({{intref, IntRef}, Broker, From}, St#st.cons),
- %% We reply when we have got LISTEN_REP.
- {noreply, St#st{cons = Cons, intref = IntRef}};
-
-%%
-%% peercert
-%%
-handle_call({peercert, Broker, Fd}, From, St) ->
- debug(St, "peercert: broker = ~w, fd = ~w~n",
- [Broker, Fd]),
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} ->
- send_cmd(St#st.port, ?GETPEERCERT, [int32(Fd)]),
- %% We reply when we get GETPEERCERT_REP or GETPEERCERT_ERR.
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-
-%%
-%% peername
-%%
-handle_call({peername, Broker, Fd}, From, St) ->
- debug(St, "peername: broker = ~w, fd = ~w~n",
- [Broker, Fd]),
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} ->
- send_cmd(St#st.port, ?GETPEERNAME, [int32(Fd)]),
- %% We reply when we get GETPEERNAME_REP or GETPEERNAME_ERR.
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% proxy join
-%%
-handle_call({proxy_join, Broker, Fd, LPort}, From, St) ->
- debug(St, "proxy_join: broker = ~w, fd = ~w, "
- "sport = ~w~n", [Broker, Fd, LPort]),
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} ->
- send_cmd(St#st.port, ?PROXY_JOIN, [int32(Fd),
- int16(LPort)]),
- %% We reply when we get PROXY_JOIN_REP, or PROXY_JOIN_ERR.
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% seed
-%%
-handle_call({seed, Data}, _From, St) when is_binary(Data) ->
- send_cmd(St#st.port, ?SET_SEED, [int32(byte_size(Data)), Data]),
- {reply, ok, St};
-
-handle_call({seed, Data}, From, St) ->
- case catch list_to_binary(Data) of
- {'EXIT', _} ->
- {reply, {error, edata}, St};
- Bin ->
- handle_call({seed, Bin}, From, St)
- end;
-
-%%
-%% setnodelay
-%%
-handle_call({setnodelay, Broker, Fd, Boolean}, From, St) ->
- debug(St, "setnodelay: broker = ~w, fd = ~w, "
- "boolean = ~w~n", [Broker, Fd, Boolean]),
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} ->
- Val = if Boolean == true -> 1; true -> 0 end,
- send_cmd(St#st.port, ?SET_SOCK_OPT,
- [int32(Fd), ?SET_TCP_NODELAY, Val]),
- %% We reply when we get IOCTL_OK or IOCTL_ERR.
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% sockname
-%%
-handle_call({sockname, Broker, Fd}, From, St) ->
- debug(St, "sockname: broker = ~w, fd = ~w~n",
- [Broker, Fd]),
- case replace_from_by_fd(Fd, St#st.cons, From) of
- {ok, _, Cons} ->
- send_cmd(St#st.port, ?GETSOCKNAME, [int32(Fd)]),
- %% We reply when we get GETSOCKNAME_REP or GETSOCKNAME_ERR.
- {noreply, St#st{cons = Cons}};
- _Other ->
- {reply, {error, ebadf}, St}
- end;
-
-%%
-%% version
-%%
-handle_call(version, From, St) ->
- debug(St, "version: from = ~w~n", [From]),
- {reply, {ok, {St#st.compvsn, St#st.libvsn}}, St};
-
-%%
-%% dump
-%%
-handle_call({dump, Broker}, _From, St) ->
- debug(St, "dump: broker = ~w", [Broker]),
- Port = St#st.port,
- send_cmd(Port, ?DUMP_CMD, []),
- {reply, ok, St};
-
-%%
-%% set_debug
-%%
-handle_call({set_debug, Bool, Broker}, _From, St) ->
- debug(St, "set_debug: broker = ~w", [Broker]),
- Value = case Bool of
- true ->
- 1;
- false ->
- 0
- end,
- Port = St#st.port,
- send_cmd(Port, ?DEBUG_CMD, [Value]),
- {reply, ok, St};
-
-%%
-%% set_debugmsg
-%%
-handle_call({set_debugmsg, Bool, Broker}, _From, St) ->
- debug(St, "set_debugmsg: broker = ~w", [Broker]),
- Value = case Bool of
- true ->
- 1;
- false ->
- 0
- end,
- Port = St#st.port,
- send_cmd(Port, ?DEBUGMSG_CMD, [Value]),
- {reply, ok, St};
-
-handle_call(Request, _From, St) ->
- debug(St, "unexpected call: ~w~n", [Request]),
- Reply = {error, {badcall, Request}},
- {reply, Reply, St}.
-
-%%
-%% handle_cast(Msg, St)
-%%
-
-
-handle_cast(Msg, St) ->
- debug(St, "unexpected cast: ~w~n", [Msg]),
- {noreply, St}.
-
-%%
-%% handle_info(Info, St)
-%%
-
-%% Data from port
-%%
-handle_info({Port, {data, Bin}},
- #st{cons = StCons, paccepts = Paccepts,
- port = Port, proxylsport = Proxylsport} = St)
- when is_binary(Bin) ->
- %% io:format("++++ ssl_server got from port: ~w~n", [Bin]),
- <<OpCode:8, _/binary>> = Bin,
- case OpCode of
- %%
- %% transport_accept
- %%
- ?TRANSPORT_ACCEPT_ERR when byte_size(Bin) >= 5 ->
- {ListenFd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "transport_accept_err: listenfd = ~w, "
- "reason = ~w~n", [ListenFd, Reason]),
- case delete_last_by_fd(ListenFd, Paccepts) of
- {ok, {_, _, From}, PAccepts} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{paccepts = PAccepts}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?TRANSPORT_ACCEPT_REP when byte_size(Bin) >= 9 ->
- {ListenFd, Fd} = decode_msg(Bin, [int32, int32]),
- debug(St, "transport_accept_rep: listenfd = ~w, "
- "fd = ~w~n", [ListenFd, Fd]),
- case delete_last_by_fd(ListenFd, Paccepts) of
- {ok, {_, Broker, From}, PAccepts} ->
- Reply = {ok, Fd, Proxylsport},
- gen_server:reply(From, Reply),
- debug(St, "transport_accept_rep: From = ~w\n", [From]),
- Cons = add({Fd, Broker, From}, StCons),
- {noreply, St#st{cons = Cons, paccepts = PAccepts}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% ssl_accept
- %%
- ?SSL_ACCEPT_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "ssl_accept_err: listenfd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- %% JC: remove this?
- case delete_last_by_fd(Fd, StCons) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?SSL_ACCEPT_REP when byte_size(Bin) >= 5 ->
- Fd = decode_msg(Bin, [int32]),
- debug(St, "ssl_accept_rep: Fd = ~w\n", [Fd]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, ok),
- {noreply, St#st{cons = Cons}};
- _ ->
- {noreply, St}
- end;
-
- %%
- %% connect
- %%
- ?CONNECT_SYNC_ERR when byte_size(Bin) >= 5 ->
- {IntRef, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "connect_sync_err: intref = ~w, "
- "reason = ~w~n", [IntRef, Reason]),
- case delete_by_intref(IntRef, StCons) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- {noreply, St}
- end;
- ?CONNECT_WAIT when byte_size(Bin) >= 9 ->
- {IntRef, Fd} = decode_msg(Bin, [int32, int32]),
- debug(St, "connect_wait: intref = ~w, "
- "fd = ~w~n", [IntRef, Fd]),
- case replace_fd_by_intref(IntRef, StCons, Fd) of
- {ok, _, Cons} ->
- %% We reply when we get CONNECT_REP or CONNECT_ERR
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% We have a new Fd which must be closed
- send_cmd(Port, ?CLOSE, int32(Fd)),
- {noreply, St}
- end;
- ?CONNECT_REP when byte_size(Bin) >= 5 ->
- %% after CONNECT_WAIT
- Fd = decode_msg(Bin, [int32]),
- debug(St, "connect_rep: fd = ~w~n", [Fd]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {ok, Fd, Proxylsport}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- {noreply, St}
- end;
- ?CONNECT_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "connect_err: fd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- case delete_by_fd(Fd, StCons) of
- {ok, {_, _, From}, Cons} ->
- %% Fd not yet published - hence close ourselves
- send_cmd(Port, ?CLOSE, int32(Fd)),
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% connection_info
- %%
- ?GETCONNINFO_REP when byte_size(Bin) >= 5 ->
- {Fd, Protocol, Cipher} = decode_msg(Bin, [int32, string, string]),
- debug(St, "connection_info_rep: fd = ~w, "
- "protcol = ~p, ip = ~p~n", [Fd, Protocol, Cipher]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {ok, {protocol_name(Protocol),
- Cipher}}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?GETCONNINFO_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "connection_info_err: fd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% listen
- %%
- ?LISTEN_SYNC_ERR when byte_size(Bin) >= 5 ->
- {IntRef, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "listen_sync_err: intref = ~w, "
- "reason = ~w~n", [IntRef, Reason]),
- case delete_by_intref(IntRef, StCons) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- {noreply, St}
- end;
- ?LISTEN_REP when byte_size(Bin) >= 11 ->
- {IntRef, ListenFd, LPort} = decode_msg(Bin, [int32, int32, int16]),
- debug(St, "listen_rep: intref = ~w, "
- "listenfd = ~w, sport = ~w~n", [IntRef, ListenFd, LPort]),
- case replace_fd_from_by_intref(IntRef, StCons, ListenFd, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {ok, ListenFd, LPort}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% ListenFd has to be closed.
- send_cmd(Port, ?CLOSE, int32(ListenFd)),
- {noreply, St}
- end;
-
- %%
- %% proxy join
- %%
- ?PROXY_JOIN_REP when byte_size(Bin) >= 5 ->
- Fd = decode_msg(Bin, [int32]),
- debug(St, "proxy_join_rep: fd = ~w~n",
- [Fd]),
- case get_by_fd(Fd, StCons) of
- {ok, {_, _, From}} ->
- gen_server:reply(From, ok),
- {noreply, St};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?PROXY_JOIN_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "proxy_join_rep: fd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- case delete_by_fd(Fd, StCons) of
- {ok, {_, _, From}, Cons} ->
- case Reason of
- enoproxysocket ->
- send_cmd(Port, ?CLOSE, int32(Fd));
- _ ->
- ok
- %% Must not close Fd since it is published
- end,
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% peername
- %%
- ?GETPEERNAME_REP when byte_size(Bin) >= 5 ->
- {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]),
- debug(St, "getpeername_rep: fd = ~w, "
- "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {ok, {IPString, LPort}}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?GETPEERNAME_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "getpeername_err: fd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% ioctl
- %%
- ?IOCTL_OK when byte_size(Bin) >= 5 ->
- Fd = decode_msg(Bin, [int32]),
- debug(St, "ioctl_ok: fd = ~w~n",
- [Fd]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, ok),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?IOCTL_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "ioctl_err: fd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% sockname
- %%
- ?GETSOCKNAME_REP when byte_size(Bin) >= 5 ->
- {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]),
- debug(St, "getsockname_rep: fd = ~w, "
- "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {ok, {IPString, LPort}}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?GETSOCKNAME_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "getsockname_err: fd = ~w, "
- "reason = ~w~n", [Fd, Reason]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
-
- %%
- %% peercert
- %%
- ?GETPEERCERT_REP when byte_size(Bin) >= 5 ->
- {Fd, Cert} = decode_msg(Bin, [int32, bin]),
- debug(St, "getpeercert_rep: fd = ~w~n", [Fd]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {ok, Cert}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end;
- ?GETPEERCERT_ERR when byte_size(Bin) >= 5 ->
- {Fd, Reason} = decode_msg(Bin, [int32, atom]),
- debug(St, "getpeercert_err: fd = ~w, reason = ~w~n",
- [Fd, Reason]),
- case replace_from_by_fd(Fd, StCons, []) of
- {ok, {_, _, From}, Cons} ->
- gen_server:reply(From, {error, Reason}),
- {noreply, St#st{cons = Cons}};
- _Other ->
- %% Already closed
- {noreply, St}
- end
- end;
-
-%%
-%% EXIT
-%%
-handle_info({'EXIT', Pid, Reason}, St) when is_pid(Pid) ->
- debug(St, "exit pid = ~w, "
- "reason = ~w~n", [Pid, Reason]),
- case delete_by_pid(Pid, St#st.cons) of
- {ok, {{intref, _}, Pid, _}, Cons} ->
- {noreply, St#st{cons = Cons}};
- {ok, {Fd, Pid, _}, Cons} ->
- send_cmd(St#st.port, ?CLOSE, int32(Fd)),
- %% If Fd is a listen socket fd, there might be pending
- %% accepts for that fd.
- case delete_all_by_fd(Fd, St#st.paccepts) of
- {ok, DelAccepts, RemAccepts} ->
- %% Reply {error, closed} to all pending accepts.
- lists:foreach(fun({_, _, From}) ->
- gen_server:reply(From,
- {error, closed})
- end, DelAccepts),
- {noreply,
- St#st{cons = Cons, paccepts = RemAccepts}};
- _ ->
- {noreply, St#st{cons = Cons}}
- end;
- _ ->
- case delete_by_pid(Pid, St#st.paccepts) of
- {ok, {ListenFd, _, _}, PAccepts} ->
- %% decrement ref count in port program
- send_cmd(St#st.port, ?NOACCEPT, int32(ListenFd)),
- {noreply, St#st{paccepts = PAccepts}};
- _ ->
- {noreply, St}
- end
- end;
-
-%%
-%% 'badsig' means bad message to port. Port program is unaffected.
-%%
-handle_info({'EXIT', Port, badsig}, #st{port = Port} = St) ->
- debug(St, "badsig!!!~n", []),
- {noreply, St};
-
-handle_info({'EXIT', Port, Reason}, #st{port = Port} = St) ->
- {stop, Reason, St};
-
-handle_info(Info, St) ->
- debug(St, "unexpected info: ~w~n", [Info]),
- {noreply, St}.
-
-%%
-%% terminate(Reason, St) -> any
-%%
-terminate(_Reason, _St) ->
- ok.
-
-%%
-%% code_change(OldVsn, St, Extra) -> {ok, NSt}
-%%
-code_change(_OldVsn, St, _Extra) ->
- {ok, St}.
-
-%%%----------------------------------------------------------------------
-%%% Internal functions
-%%%----------------------------------------------------------------------
-
-%%
-%% Send binary command to sock
-%%
-send_cmd(Port, Cmd, Args) ->
- Port ! {self(), {command, [Cmd| Args]}}.
-
-%%
-%% add(Descr, Cons) -> NCons
-%%
-add(D, L) ->
- [D| L].
-
-%%
-%% get_by_fd(Fd, Cons) -> {ok, Descr} | not_found
-%%
-get_by_fd(Fd, Cons) ->
- get_by_pos(Fd, 1, Cons).
-
-%%
-%% delete_by_fd(Fd, Cons) -> {ok, OldDesc, NewCons} | not_found.
-%%
-delete_by_fd(Fd, Cons) ->
- delete_by_pos(Fd, 1, Cons).
-
-%%
-%% delete_all_by_fd(Fd, Cons) -> {ok, DelCons, RemCons} | not_found.
-%%
-delete_all_by_fd(Fd, Cons) ->
- delete_all_by_pos(Fd, 1, Cons).
-
-%%
-%% delete_by_intref(IntRef, Cons) -> {ok, OldDesc, NewCons} | not_found.
-%%
-delete_by_intref(IntRef, Cons) ->
- delete_by_pos({intref, IntRef}, 1, Cons).
-
-%%
-%% delete_by_pid(Pid, Cons) -> {ok, OldDesc, NewCons} | not_found.
-%%
-delete_by_pid(Pid, Cons) ->
- delete_by_pos(Pid, 2, Cons).
-
-%%
-%% delete_last_by_fd(Fd, Cons) -> {ok, OldDesc, NCons} | not_found
-%%
-delete_last_by_fd(Fd, Cons) ->
- case dlbf(Fd, Cons) of
- {X, L} ->
- {ok, X, L};
- _Other ->
- not_found
- end.
-
-dlbf(Fd, [H]) ->
- last_elem(Fd, H, []);
-dlbf(Fd, [H|T]) ->
- case dlbf(Fd, T) of
- {X, L} ->
- {X, [H|L]};
- L ->
- last_elem(Fd, H, L)
- end;
-dlbf(_Fd, []) ->
- [].
-
-last_elem(Fd, H, L) when element(1, H) == Fd ->
- {H, L};
-last_elem(_, H, L) ->
- [H|L].
-
-
-%%
-%% replace_from_by_fd(Fd, Cons, From) -> {ok, OldDesc, NewList} | not_found
-%%
-replace_from_by_fd(Fd, Cons, From) ->
- replace_posn_by_pos(Fd, 1, Cons, [{From, 3}]).
-
-%%
-%% replace_fd_by_intref(IntRef, Cons, Fd) -> {ok, OldDesc, NewList} | not_f.
-%%
-replace_fd_by_intref(IntRef, Cons, Fd) ->
- replace_posn_by_pos({intref, IntRef}, 1, Cons, [{Fd, 1}]).
-
-%%
-%% replace_fd_from_by_intref(IntRef, Cons, NFd, From) ->
-%% {ok, OldDesc, NewList} | not_found
-%%
-replace_fd_from_by_intref(IntRef, Cons, NFd, From) ->
- replace_posn_by_pos({intref, IntRef}, 1, Cons, [{NFd, 1}, {From, 3}]).
-
-
-%%
-%% All *_by_pos functions
-%%
-
-get_by_pos(Key, Pos, [H|_]) when element(Pos, H) == Key ->
- {ok, H};
-get_by_pos(Key, Pos, [_|T]) ->
- get_by_pos(Key, Pos, T);
-get_by_pos(_, _, []) ->
- not_found.
-
-delete_by_pos(Key, Pos, Cons) ->
- case delete_by_pos1(Key, Pos, {not_found, Cons}) of
- {not_found, _} ->
- not_found;
- {ODesc, NCons} ->
- {ok, ODesc, NCons}
- end.
-delete_by_pos1(Key, Pos, {_R, [H|T]}) when element(Pos, H) == Key ->
- {H, T};
-delete_by_pos1(Key, Pos, {R, [H|T]}) ->
- {R0, T0} = delete_by_pos1(Key, Pos, {R, T}),
- {R0, [H| T0]};
-delete_by_pos1(_, _, {R, []}) ->
- {R, []}.
-
-delete_all_by_pos(Key, Pos, Cons) ->
- case lists:foldl(fun(H, {Ds, Rs}) when element(Pos, H) == Key ->
- {[H|Ds], Rs};
- (H, {Ds, Rs}) ->
- {Ds, [H|Rs]}
- end, {[], []}, Cons) of
- {[], _} ->
- not_found;
- {DelCons, RemCons} ->
- {ok, DelCons, RemCons}
- end.
-
-replace_posn_by_pos(Key, Pos, Cons, Repls) ->
- replace_posn_by_pos1(Key, Pos, Cons, Repls, []).
-
-replace_posn_by_pos1(Key, Pos, [H0| T], Repls, Acc)
- when element(Pos, H0) =:= Key ->
- H = lists:foldl(fun({Val, VPos}, Tuple) ->
- setelement(VPos, Tuple, Val)
- end, H0, Repls),
- {ok, H0, lists:reverse(Acc, [H| T])};
-replace_posn_by_pos1(Key, Pos, [H|T], Repls, Acc) ->
- replace_posn_by_pos1(Key, Pos, T, Repls, [H| Acc]);
-replace_posn_by_pos1(_, _, [], _, _) ->
- not_found.
-
-%%
-%% Binary/integer conversions
-%%
-int16(I) ->
- %%[(I bsr 8) band 255, I band 255].
- <<I:16>>.
-
-int32(I) ->
- %% [(I bsr 24) band 255,
- %% (I bsr 16) band 255,
- %% (I bsr 8) band 255,
- %% I band 255].
- <<I:32>>.
-
-%% decode_msg(Bin, Format) -> Tuple | integer() | atom() | string() |
-%% list of binaries()
-%%
-%% Decode message from binary
-%% Format = [spec()]
-%% spec() = int16 | int32 | string | atom | bin | bins
-%%
-%% Notice: The first byte (op code) of the binary message is removed.
-%% Notice: bins returns a *list* of binaries.
-%%
-decode_msg(<<_, Bin/binary>>, Format) ->
- Dec = dec(Format, Bin),
- case Dec of
- [Dec1] -> Dec1;
- _ -> list_to_tuple(Dec)
- end.
-
-dec([], _) ->
- [];
-dec([int16| F], <<N:16, Bin/binary>>) ->
- [N| dec(F, Bin)];
-dec([int32| F], <<N:32, Bin/binary>>) ->
- [N| dec(F, Bin)];
-dec([string| F], Bin0) ->
- {Cs, Bin1} = dec_string(Bin0),
- [Cs| dec(F, Bin1)];
-dec([atom|F], Bin0) ->
- {Cs, Bin1} = dec_string(Bin0),
- [list_to_atom(Cs)| dec(F, Bin1)];
-
-dec([bin|F], Bin) ->
- {Bin1, Bin2} = dec_bin(Bin),
- [Bin1| dec(F, Bin2)].
-
-%% NOTE: This clause is not actually used yet.
-%% dec([bins|F], <<N:32, Bin0/binary>>) ->
-%% {Bins, Bin1} = dec_bins(N, Bin0),
-%% [Bins| dec(F, Bin1)].
-
-dec_string(Bin) ->
- dec_string(Bin, []).
-
-dec_string(<<0, Bin/binary>>, RCs) ->
- {lists:reverse(RCs), Bin};
-dec_string(<<C, Bin/binary>>, RCs) ->
- dec_string(Bin, [C| RCs]).
-
-dec_bin(<<L:32, Bin0/binary>>) ->
- <<Bin1:L/binary, Bin2/binary>> = Bin0,
- {Bin1, Bin2}.
-
-%% dec_bins(N, Bin) ->
-%% dec_bins(N, Bin, []).
-
-%% dec_bins(0, Bin, Acc) ->
-%% {lists:reverse(Acc), Bin};
-%% dec_bins(N, Bin0, Acc) when N > 0 ->
-%% {Bin1, Bin2} = dec_bin(Bin0),
-%% dec_bins(N - 1, Bin2, [Bin1| Acc]).
-
-%%
-%% new_intref
-%%
-new_intref(St) ->
- (St#st.intref + 1) band 16#ffffffff.
-
-%%
-%% {Program, Flags} = mk_cmd_line(DefaultProgram)
-%%
-mk_cmd_line(Default) ->
- {port_program(Default),
- lists:flatten([debug_flag(), " ", debug_port_flag(), " ",
- debugdir_flag(), " ",
- msgdebug_flag(), " ", proxylsport_flag(), " ",
- proxybacklog_flag(), " ", ephemeral_rsa_flag(), " ",
- ephemeral_dh_flag(), " ",
- protocol_version_flag(), " "])}.
-
-port_program(Default) ->
- case application:get_env(ssl, port_program) of
- {ok, Program} when is_list(Program) ->
- Program;
- _Other ->
- Default
- end.
-
-%%
-%% As this server may be started by the distribution, it is not safe to assume
-%% a working code server, neither a working file server.
-%% I try to utilize the most primitive interfaces available to determine
-%% the directory of the port_program.
-%%
-find_priv_bin() ->
- PrivDir = case (catch code:priv_dir(ssl)) of
- {'EXIT', _} ->
- %% Code server probably not startet yet
- {ok, P} = erl_prim_loader:get_path(),
- ModuleFile = atom_to_list(?MODULE) ++ extension(),
- Pd = (catch lists:foldl
- (fun(X,Acc) ->
- M = filename:join([X, ModuleFile]),
- %% The file server probably not started
- %% either, has to use raw interface.
- case file:raw_read_file_info(M) of
- {ok,_} ->
- %% Found our own module in the
- %% path, lets bail out with
- %% the priv_dir of this directory
- Y = filename:split(X),
- throw(filename:join
- (lists:sublist
- (Y,length(Y) - 1)
- ++ ["priv"]));
- _ ->
- Acc
- end
- end,
- false,P)),
- case Pd of
- false ->
- exit(ssl_priv_dir_indeterminate);
- _ ->
- Pd
- end;
- Dir ->
- Dir
- end,
- filename:join([PrivDir, "bin"]).
-
-extension() ->
- %% erlang:info(machine) returns machine name as text in all uppercase
- "." ++ string:to_lower(erlang:system_info(machine)).
-
-debug_flag() ->
- case os:getenv("ERL_SSL_DEBUG") of
- false ->
- get_env(debug, "-d");
- _ ->
- "-d"
- end.
-
-debug_port_flag() ->
- case os:getenv("ERL_SSL_DEBUGPORT") of
- false ->
- get_env(debug, "-d");
- _ ->
- "-d"
- end.
-
-msgdebug_flag() ->
- case os:getenv("ERL_SSL_MSGDEBUG") of
- false ->
- get_env(msgdebug, "-dm");
- _ ->
- "-dm"
- end.
-
-proxylsport_flag() ->
- case application:get_env(ssl, proxylsport) of
- {ok, PortNum} ->
- "-pp " ++ integer_to_list(PortNum);
- _Other ->
- ""
- end.
-
-proxybacklog_flag() ->
- case application:get_env(ssl, proxylsbacklog) of
- {ok, Size} ->
- "-pb " ++ integer_to_list(Size);
- _Other ->
- ""
- end.
-
-debugdir_flag() ->
- case os:getenv("ERL_SSL_DEBUG") of
- false ->
- case application:get_env(ssl, debugdir) of
- {ok, Dir} when is_list(Dir) ->
- "-dd " ++ Dir;
- _Other ->
- ""
- end;
- _ ->
- "-dd ./"
- end.
-
-ephemeral_rsa_flag() ->
- case application:get_env(ssl, ephemeral_rsa) of
- {ok, true} ->
- "-ersa ";
- _Other ->
- ""
- end.
-
-ephemeral_dh_flag() ->
- case application:get_env(ssl, ephemeral_dh) of
- {ok, true} ->
- "-edh ";
- _Other ->
- ""
- end.
-
-protocol_version_flag() ->
- case application:get_env(ssl, protocol_version) of
- {ok, []} ->
- "";
- {ok, Vsns} when is_list(Vsns) ->
- case transform_vsns(Vsns) of
- N when (N > 0) ->
- "-pv " ++ integer_to_list(N);
- _ ->
- ""
- end;
- _Other ->
- ""
- end.
-
-transform_vsns(Vsns) ->
- transform_vsns(Vsns, 0).
-
-transform_vsns([sslv2| Vsns], I) ->
- transform_vsns(Vsns, I bor ?SSLv2);
-transform_vsns([sslv3| Vsns], I) ->
- transform_vsns(Vsns, I bor ?SSLv3);
-transform_vsns([tlsv1| Vsns], I) ->
- transform_vsns(Vsns, I bor ?TLSv1);
-transform_vsns([_ | Vsns], I) ->
- transform_vsns(Vsns, I);
-transform_vsns([], I) ->
- I.
-
-protocol_name("SSLv2") -> sslv2;
-protocol_name("SSLv3") -> sslv3;
-protocol_name("TLSv1") -> tlsv1.
-
-get_env(Key, Val) ->
- case application:get_env(ssl, Key) of
- {ok, true} ->
- Val;
- _Other ->
- ""
- end.
-
-ip_to_string({A,B,C,D}) ->
- [integer_to_list(A),$.,integer_to_list(B),$.,
- integer_to_list(C),$.,integer_to_list(D)].
-
-debug(St, Format, Args) ->
- debug1(St#st.debug, Format, Args).
-
-debug1(true, Format0, Args) ->
- {_MS, S, MiS} = erlang:now(),
- Secs = S rem 100,
- MiSecs = MiS div 1000,
- Format = "++++ ~3..0w:~3..0w ssl_server (~w): " ++ Format0,
- io:format(Format, [Secs, MiSecs, self()| Args]);
-debug1(_, _, _) ->
- ok.
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index a008682b89..cb10b1362a 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -51,16 +51,15 @@ init([]) ->
%% Does not start any port programs so it does matter
%% so much if it is not used!
- Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []},
- permanent, 2000, supervisor, [ssl_broker_sup]},
+ %% Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []},
+ %% permanent, 2000, supervisor, [ssl_broker_sup]},
%% New ssl
SessionCertManager = session_and_cert_manager_child_spec(),
ConnetionManager = connection_manager_child_spec(),
- {ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager,
- ConnetionManager]}}.
+ {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager]}}.
manager_opts() ->
diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl
index 1a998a0f34..d63eada571 100644
--- a/lib/ssl/src/ssl_tls_dist_proxy.erl
+++ b/lib/ssl/src/ssl_tls_dist_proxy.erl
@@ -126,11 +126,9 @@ get_tcp_address(Socket) ->
family = inet
}.
-accept_loop(Proxy, Type, Listen, Extra) ->
+accept_loop(Proxy, erts = Type, Listen, Extra) ->
process_flag(priority, max),
- case Type of
- erts ->
- case gen_tcp:accept(Listen) of
+ case gen_tcp:accept(Listen) of
{ok, Socket} ->
Extra ! {accept,self(),Socket,inet,proxy},
receive
@@ -142,30 +140,31 @@ accept_loop(Proxy, Type, Listen, Extra) ->
exit(unsupported_protocol)
end;
Error ->
- exit(Error)
+ exit(Error)
+ end,
+ accept_loop(Proxy, Type, Listen, Extra);
+
+accept_loop(Proxy, world = Type, Listen, Extra) ->
+ process_flag(priority, max),
+ 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;
- 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
+ Error ->
+ exit(Error)
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} ->
@@ -244,60 +243,60 @@ loop_conn(World, Erts) ->
get_ssl_options(Type) ->
case init:get_argument(ssl_dist_opt) of
{ok, Args} ->
- [{erl_dist, true} | ssl_options(Type, Args)];
+ [{erl_dist, true} | ssl_options(Type, lists:append(Args))];
_ ->
[{erl_dist, true}]
end.
ssl_options(_,[]) ->
[];
-ssl_options(server, [["client_" ++ _, _Value]|T]) ->
+ssl_options(server, ["client_" ++ _, _Value |T]) ->
ssl_options(server,T);
-ssl_options(client, [["server_" ++ _, _Value]|T]) ->
+ssl_options(client, ["server_" ++ _, _Value|T]) ->
ssl_options(client,T);
-ssl_options(server, [["server_certfile", Value]|T]) ->
+ssl_options(server, ["server_certfile", Value|T]) ->
[{certfile, Value} | ssl_options(server,T)];
-ssl_options(client, [["client_certfile", Value]|T]) ->
+ssl_options(client, ["client_certfile", Value | T]) ->
[{certfile, Value} | ssl_options(client,T)];
-ssl_options(server, [["server_cacertfile", Value]|T]) ->
+ssl_options(server, ["server_cacertfile", Value|T]) ->
[{cacertfile, Value} | ssl_options(server,T)];
-ssl_options(client, [["client_cacertfile", Value]|T]) ->
+ssl_options(client, ["client_cacertfile", Value|T]) ->
[{cacertfile, Value} | ssl_options(client,T)];
-ssl_options(server, [["server_keyfile", Value]|T]) ->
+ssl_options(server, ["server_keyfile", Value|T]) ->
[{keyfile, Value} | ssl_options(server,T)];
-ssl_options(client, [["client_keyfile", Value]|T]) ->
+ssl_options(client, ["client_keyfile", Value|T]) ->
[{keyfile, Value} | ssl_options(client,T)];
-ssl_options(server, [["server_password", Value]|T]) ->
+ssl_options(server, ["server_password", Value|T]) ->
[{password, Value} | ssl_options(server,T)];
-ssl_options(client, [["client_password", Value]|T]) ->
+ssl_options(client, ["client_password", Value|T]) ->
[{password, Value} | ssl_options(client,T)];
-ssl_options(server, [["server_verify", Value]|T]) ->
+ssl_options(server, ["server_verify", Value|T]) ->
[{verify, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, [["client_verify", Value]|T]) ->
+ssl_options(client, ["client_verify", Value|T]) ->
[{verify, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, [["server_reuse_sessions", Value]|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]) ->
+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]) ->
+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]) ->
+ssl_options(client, ["client_depth", Value|T]) ->
[{depth, list_to_integer(Value)} | ssl_options(client,T)];
-ssl_options(server, [["server_hibernate_after", Value]|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]) ->
+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]) ->
+ssl_options(server, ["server_ciphers", Value|T]) ->
[{ciphers, Value} | ssl_options(server,T)];
-ssl_options(client, [["client_ciphers", Value]|T]) ->
+ssl_options(client, ["client_ciphers", Value|T]) ->
[{ciphers, Value} | ssl_options(client,T)];
-ssl_options(server, [["server_dhfile", Value]|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]) ->
+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).
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 38bc529445..23a9a23190 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -43,26 +43,15 @@ MODULES = \
ssl_to_openssl_SUITE \
ssl_session_cache_SUITE \
ssl_dist_SUITE \
- ssl_test_MACHINE \
- old_ssl_active_SUITE \
- old_ssl_active_once_SUITE \
- old_ssl_passive_SUITE \
- old_ssl_verify_SUITE \
- old_ssl_peer_cert_SUITE \
- old_ssl_misc_SUITE \
- old_ssl_protocol_SUITE \
- old_transport_accept_SUITE \
- old_ssl_dist_SUITE \
make_certs\
erl_make_certs
ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = ssl_test_MACHINE.hrl
+HRL_FILES =
HRL_FILES_SRC = \
- ssl_int.hrl \
ssl_internal.hrl\
ssl_alert.hrl \
ssl_handshake.hrl \
diff --git a/lib/ssl/test/old_ssl_active_SUITE.erl b/lib/ssl/test/old_ssl_active_SUITE.erl
deleted file mode 100644
index 52ff0bcc5d..0000000000
--- a/lib/ssl/test/old_ssl_active_SUITE.erl
+++ /dev/null
@@ -1,395 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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
-%% 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(old_ssl_active_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- cinit_return_chkclose/1,
- sinit_return_chkclose/1,
- cinit_big_return_chkclose/1,
- sinit_big_return_chkclose/1,
- cinit_big_echo_chkclose/1,
- cinit_huge_echo_chkclose/1,
- sinit_big_echo_chkclose/1,
- cinit_few_echo_chkclose/1,
- cinit_many_echo_chkclose/1,
- cinit_cnocert/1
- ]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
-
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
--define(MANYCONNS, ssl_test_MACHINE:many_conns()).
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [cinit_return_chkclose, sinit_return_chkclose,
- cinit_big_return_chkclose, sinit_big_return_chkclose,
- cinit_big_echo_chkclose, cinit_huge_echo_chkclose,
- sinit_big_echo_chkclose, cinit_few_echo_chkclose,
- cinit_many_echo_chkclose, cinit_cnocert].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains, and record the number of available "
- "file descriptors";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
- case os:type() of
- {unix, _} ->
- ?line io:format("Max fd value: ~s", [os:cmd("ulimit -n")]);
- _ ->
- ok
- end,
- %% XXX Also record: Erlang/SSL version, version of OpenSSL,
- %% operating system, version of OTP, Erts, kernel and stdlib.
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto!"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no mission other than closing the conf case";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-cinit_return_chkclose(doc) ->
- "Client sends 1000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-cinit_return_chkclose(suite) ->
- [];
-cinit_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_return_chkclose(doc) ->
- "Server sends 1000 bytes to client, that receives them, sends them "
- "back, and closes. Server waits for close. Both have certs.";
-sinit_return_chkclose(suite) ->
- [];
-sinit_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, [{ssl_imp, old}|SsslOpts]},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sslopts, [{ssl_imp, old}|CsslOpts]},
- {connect, {Host, LPort}},
- {recv, DataSize}, {send, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_big_return_chkclose(doc) ->
- "Client sends 50000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-cinit_big_return_chkclose(suite) ->
- [];
-cinit_big_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_big_return_chkclose(doc) ->
- "Server sends 50000 bytes to client, that receives them, sends them "
- "back, and closes. Server waits for close. Both have certs.";
-sinit_big_return_chkclose(suite) ->
- [];
-sinit_big_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {recv, DataSize}, {send, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_big_echo_chkclose(doc) ->
- "Client sends 50000 bytes to server, that echoes them back "
- "and closes. Client waits for close. Both have certs.";
-cinit_big_echo_chkclose(suite) ->
- [];
-cinit_big_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_huge_echo_chkclose(doc) ->
- "Client sends 500000 bytes to server, that echoes them back "
- "and closes. Client waits for close. Both have certs.";
-cinit_huge_echo_chkclose(suite) ->
- [];
-cinit_huge_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 500000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_big_echo_chkclose(doc) ->
- "Server sends 50000 bytes to client, that echoes them back "
- "and closes. Server waits for close. Both have certs.";
-sinit_big_echo_chkclose(suite) ->
- [];
-sinit_big_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {echo, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-
-%% This case is repeated several times.
-
-cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7).
-
-cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS).
-
-cinit_many_echo_chkclose(doc, _NConns) ->
- "N client sends 10000 bytes to server, that echoes them back "
- "and closes. Clients wait for close. All have certs.";
-cinit_many_echo_chkclose(suite, _NConns) ->
- [];
-cinit_many_echo_chkclose(Config, NConns) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 10000, LPort = 3456,
- Timeout = 80000,
-
- io:format("~w connections", [NConns]),
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-
-cinit_cnocert(doc) ->
- "Client sends 1000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Client has no cert, "
- "but server has.";
-cinit_cnocert(suite) ->
- [];
-cinit_cnocert(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3457,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-
diff --git a/lib/ssl/test/old_ssl_active_once_SUITE.erl b/lib/ssl/test/old_ssl_active_once_SUITE.erl
deleted file mode 100644
index c7beadb301..0000000000
--- a/lib/ssl/test/old_ssl_active_once_SUITE.erl
+++ /dev/null
@@ -1,417 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-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(old_ssl_active_once_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- server_accept_timeout/1,
- cinit_return_chkclose/1,
- sinit_return_chkclose/1,
- cinit_big_return_chkclose/1,
- sinit_big_return_chkclose/1,
- cinit_big_echo_chkclose/1,
- cinit_huge_echo_chkclose/1,
- sinit_big_echo_chkclose/1,
- cinit_few_echo_chkclose/1,
- cinit_many_echo_chkclose/1,
- cinit_cnocert/1
- ]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
--define(MANYCONNS, ssl_test_MACHINE:many_conns()).
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [server_accept_timeout, cinit_return_chkclose,
- sinit_return_chkclose, cinit_big_return_chkclose,
- sinit_big_return_chkclose, cinit_big_echo_chkclose,
- cinit_huge_echo_chkclose, sinit_big_echo_chkclose,
- cinit_few_echo_chkclose, cinit_many_echo_chkclose,
- cinit_cnocert].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains.";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no mission other than closing the conf case";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-server_accept_timeout(doc) ->
- "Server has one pending accept with timeout. Checks that return "
- "value is {error, timeout}.";
-server_accept_timeout(suite) ->
- [];
-server_accept_timeout(Config) when list(Config) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- Timeout = 40000, NConns = 1,
- AccTimeout = 3000,
-
- ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, AccTimeout},
- accept_timeout],
- ?line test_server_only(NConns, LCmds, ACmds, Timeout, ?MODULE,
- Config).
-
-cinit_return_chkclose(doc) ->
- "Client sends 1000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-cinit_return_chkclose(suite) ->
- [];
-cinit_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_return_chkclose(doc) ->
- "Server sends 1000 bytes to client, that receives them, sends them "
- "back, and closes. Server waits for close. Both have certs.";
-sinit_return_chkclose(suite) ->
- [];
-sinit_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {recv, DataSize}, {send, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_big_return_chkclose(doc) ->
- "Client sends 50000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-cinit_big_return_chkclose(suite) ->
- [];
-cinit_big_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- %% Set {active, false} so that accept is passive to begin with.
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {sockopts, [{active, once}]}, % {active, once} here.
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_big_return_chkclose(doc) ->
- "Server sends 50000 bytes to client, that receives them, sends them "
- "back, and closes. Server waits for close. Both have certs.";
-sinit_big_return_chkclose(suite) ->
- [];
-sinit_big_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {recv, DataSize}, {send, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_big_echo_chkclose(doc) ->
- "Client sends 50000 bytes to server, that echoes them back "
- "and closes. Client waits for close. Both have certs.";
-cinit_big_echo_chkclose(suite) ->
- [];
-cinit_big_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_huge_echo_chkclose(doc) ->
- "Client sends 500000 bytes to server, that echoes them back "
- "and closes. Client waits for close. Both have certs.";
-cinit_huge_echo_chkclose(suite) ->
- [];
-cinit_huge_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 500000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_big_echo_chkclose(doc) ->
- "Server sends 50000 bytes to client, that echoes them back "
- "and closes. Server waits for close. Both have certs.";
-sinit_big_echo_chkclose(suite) ->
- [];
-sinit_big_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {echo, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7).
-
-cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS).
-
-cinit_many_echo_chkclose(doc, _NConns) ->
- "client send 10000 bytes to server, that echoes them back "
- "and closes. Clients wait for close. All have certs.";
-cinit_many_echo_chkclose(suite, _NConns) ->
- [];
-cinit_many_echo_chkclose(Config, NConns) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 10000, LPort = 3456,
- Timeout = 80000,
-
- io:format("~w connections", [NConns]),
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_cnocert(doc) ->
- "Client sends 1000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Client has no cert, "
- "but server has.";
-cinit_cnocert(suite) ->
- [];
-cinit_cnocert(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3457,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, once}]},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-
diff --git a/lib/ssl/test/old_ssl_dist_SUITE.erl b/lib/ssl/test/old_ssl_dist_SUITE.erl
deleted file mode 100644
index 4544fb616a..0000000000
--- a/lib/ssl/test/old_ssl_dist_SUITE.erl
+++ /dev/null
@@ -1,617 +0,0 @@
-%%
-%% %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%
-%%
-
-%%
-
-
-%%%-------------------------------------------------------------------
-%%% File : ssl_dist_SUITE.erl
-%%% Author : Rickard Green
-%%% Description : Test that the Erlang distribution works over ssl.
-%%%
-%%% Created : 15 Nov 2007 by Rickard Green
-%%%-------------------------------------------------------------------
--module(old_ssl_dist_SUITE).
-
--include_lib("test_server/include/test_server.hrl").
-
--define(DEFAULT_TIMETRAP_SECS, 240).
-
--define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000).
-
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
--export([init_per_suite/1,
- end_per_suite/1,
- init_per_testcase/2,
- end_per_testcase/2]).
--export([cnct2tstsrvr/1]).
-
--export([basic/1]).
-
--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) ->
- ?line NH1 = start_ssl_node(Config),
- ?line Node1 = NH1#node_handle.nodename,
- ?line NH2 = start_ssl_node(Config),
- ?line Node2 = NH2#node_handle.nodename,
-
- ?line pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
-
- ?line [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end),
- ?line [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.
- ?line pang = net_adm:ping(Node1),
- ?line pang = net_adm:ping(Node2),
-
-
- %%
- %% Check that we are able to communicate over the erlang
- %% distribution between the ssl nodes.
- %%
- ?line Ref = make_ref(),
- ?line spawn(fun () ->
- apply_on_ssl_node(
- NH1,
- fun () ->
- tstsrvr_format("Hi from ~p!~n",
- [node()]),
- send_to_tstcntrl({Ref, self()}),
- receive
- {From, ping} ->
- From ! {self(), pong}
- end
- end)
- end),
- ?line receive
- {Ref, SslPid} ->
- ?line ok = apply_on_ssl_node(
- NH2,
- fun () ->
- tstsrvr_format("Hi from ~p!~n",
- [node()]),
- SslPid ! {self(), ping},
- receive
- {SslPid, pong} ->
- ok
- end
- end)
- end,
-
- ?line stop_ssl_node(NH1),
- ?line stop_ssl_node(NH2),
- ?line 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} ->
- 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_ssl "
- ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " "
- ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " "
-.% ++ "-ssl_dist_opt verify 1 depth 1".
-
-%%
-%% 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.
diff --git a/lib/ssl/test/old_ssl_misc_SUITE.erl b/lib/ssl/test/old_ssl_misc_SUITE.erl
deleted file mode 100644
index ea03e83867..0000000000
--- a/lib/ssl/test/old_ssl_misc_SUITE.erl
+++ /dev/null
@@ -1,117 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-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(old_ssl_misc_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- seed/1,
- app/1
- ]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
--define(MANYCONNS, 5).
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [seed, app].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains.";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto!"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no mission other than closing the conf case";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-seed(doc) ->
- "Test that ssl:seed/1 works.";
-seed(suite) ->
- [];
-seed(Config) when list(Config) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config),
-
- LCmds = [{seed, "tjosan"},
- {sockopts, [{backlog, NConns}, {active, once}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ?line test_server_only(NConns, LCmds, [], Timeout, ?MODULE,
- Config).
-
-app(doc) ->
- "Test that the ssl app file is ok";
-app(suite) ->
- [];
-app(Config) when list(Config) ->
- ?line ok = test_server:app_test(ssl).
-
-
diff --git a/lib/ssl/test/old_ssl_passive_SUITE.erl b/lib/ssl/test/old_ssl_passive_SUITE.erl
deleted file mode 100644
index 7b54fe876a..0000000000
--- a/lib/ssl/test/old_ssl_passive_SUITE.erl
+++ /dev/null
@@ -1,382 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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
-%% 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(old_ssl_passive_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1,
- end_per_suite/1, init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- server_accept_timeout/1,
- cinit_return_chkclose/1,
- sinit_return_chkclose/1,
- cinit_big_return_chkclose/1,
- sinit_big_return_chkclose/1,
- cinit_big_echo_chkclose/1,
- sinit_big_echo_chkclose/1,
- cinit_few_echo_chkclose/1,
- cinit_many_echo_chkclose/1,
- cinit_cnocert/1
- ]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
-
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
--define(MANYCONNS, ssl_test_MACHINE:many_conns()).
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [server_accept_timeout, cinit_return_chkclose,
- sinit_return_chkclose, cinit_big_return_chkclose,
- sinit_big_return_chkclose, cinit_big_echo_chkclose,
- sinit_big_echo_chkclose, cinit_few_echo_chkclose,
- cinit_many_echo_chkclose, cinit_cnocert].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains.";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no mission other than closing the conf case";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-server_accept_timeout(doc) ->
- "Server has one pending accept with timeout. Checks that return "
- "value is {error, timeout}.";
-server_accept_timeout(suite) ->
- [];
-server_accept_timeout(Config) when list(Config) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- Timeout = 40000, NConns = 1,
- AccTimeout = 3000,
-
- ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, AccTimeout},
- accept_timeout],
- ?line test_server_only(NConns, LCmds, ACmds, Timeout, ?MODULE, Config).
-
-cinit_return_chkclose(doc) ->
- "Client sends 1000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-cinit_return_chkclose(suite) ->
- [];
-cinit_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_return_chkclose(doc) ->
- "Server sends 1000 bytes to client, that receives them, sends them "
- "back, and closes. Server waits for close. Both have certs.";
-sinit_return_chkclose(suite) ->
- [];
-sinit_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {recv, DataSize}, {send, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_big_return_chkclose(doc) ->
- "Client sends 50000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-cinit_big_return_chkclose(suite) ->
- [];
-cinit_big_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_big_return_chkclose(doc) ->
- "Server sends 50000 bytes to client, that receives them, sends them "
- "back, and closes. Server waits for close. Both have certs.";
-sinit_big_return_chkclose(suite) ->
- [];
-sinit_big_return_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {recv, DataSize}, {send, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_big_echo_chkclose(doc) ->
- "Client sends 50000 bytes to server, that echoes them back "
- "and closes. Client waits for close. Both have certs.";
-cinit_big_echo_chkclose(suite) ->
- [];
-cinit_big_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-sinit_big_echo_chkclose(doc) ->
- "Server sends 50000 bytes to client, that echoes them back "
- "and closes. Server waits for close. Both have certs.";
-sinit_big_echo_chkclose(suite) ->
- [];
-sinit_big_echo_chkclose(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 50000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {send, DataSize}, {recv, DataSize},
- await_close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {echo, DataSize},
- close],
-
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-
-cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7).
-
-cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS).
-
-cinit_many_echo_chkclose(doc, _NConns) ->
- "clients send 10000 bytes to server, that echoes them back "
- "and closes. Clients wait for close. All have certs.";
-cinit_many_echo_chkclose(suite, _NConns) ->
- [];
-cinit_many_echo_chkclose(Config, NConns) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 10000, LPort = 3456,
- Timeout = 80000,
-
- io:format("~w connections", [NConns]),
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {echo, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
-cinit_cnocert(doc) ->
- "Client sends 1000 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Client has no cert, "
- "but server has.";
-cinit_cnocert(suite) ->
- [];
-cinit_cnocert(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3457,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}, {active, false}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize}, {send, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sockopts, [{active, false}]},
- {connect, {Host, LPort}},
- {send, DataSize}, {recv, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE,
- Config).
-
diff --git a/lib/ssl/test/old_ssl_peer_cert_SUITE.erl b/lib/ssl/test/old_ssl_peer_cert_SUITE.erl
deleted file mode 100644
index ee19bad175..0000000000
--- a/lib/ssl/test/old_ssl_peer_cert_SUITE.erl
+++ /dev/null
@@ -1,191 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-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(old_ssl_peer_cert_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- cinit_plain/1,
- cinit_both_verify/1,
- cinit_cnocert/1
- ]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [cinit_plain, cinit_both_verify, cinit_cnocert].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains.";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no mission other than closing the conf case";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-cinit_plain(doc) ->
- "Server closes after accept, Client waits for close. Both have certs "
- "but both use the defaults for verify and depth, but still tries "
- "to retreive each others certificates.";
-cinit_plain(suite) ->
- [];
-cinit_plain(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config),
-
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- nopeercert,
- {recv, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- peercert,
- {send, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout,
- ?MODULE, Config).
-
-cinit_both_verify(doc) ->
- "Server closes after accept, Client waits for close. Both have certs "
- "and both verify each other.";
-cinit_both_verify(suite) ->
- [];
-cinit_both_verify(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts0, SsslOpts0}} = mk_ssl_cert_opts(Config),
- ?line CsslOpts = [{verify, 2}, {depth, 2} | CsslOpts0],
- ?line SsslOpts = [{verify, 2}, {depth, 3} | SsslOpts0],
-
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- peercert,
- {recv, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- peercert,
- {send, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout,
- ?MODULE, Config).
-
-cinit_cnocert(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close.";
-cinit_cnocert(suite) ->
- [];
-cinit_cnocert(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3457,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config),
- ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0],
-
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {connect, {Host, LPort}},
- peercert,
- {send, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout,
- ?MODULE, Config).
-
-
diff --git a/lib/ssl/test/old_ssl_protocol_SUITE.erl b/lib/ssl/test/old_ssl_protocol_SUITE.erl
deleted file mode 100644
index 9b9937c210..0000000000
--- a/lib/ssl/test/old_ssl_protocol_SUITE.erl
+++ /dev/null
@@ -1,185 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-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(old_ssl_protocol_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2,
- sslv2/1, sslv3/1, tlsv1/1, sslv2_sslv3/1,
- sslv2_tlsv1/1, sslv3_tlsv1/1, sslv2_sslv3_tlsv1/1]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
-
-init_per_testcase(_Case, Config) ->
- WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [sslv2, sslv3, tlsv1, sslv2_sslv3, sslv2_tlsv1,
- sslv3_tlsv1, sslv2_sslv3_tlsv1].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains.";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no other purpose than closing the conf case.";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-%%%%%
-
-sslv2(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose SSLv2.";
-sslv2(suite) ->
- [];
-sslv2(Config) when list(Config) ->
- do_run_test(Config, [sslv2]).
-
-sslv3(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose SSLv3.";
-sslv3(suite) ->
- [];
-sslv3(Config) when list(Config) ->
- do_run_test(Config, [sslv3]).
-
-tlsv1(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose TLSv1.";
-tlsv1(suite) ->
- [];
-tlsv1(Config) when list(Config) ->
- do_run_test(Config, [tlsv1]).
-
-sslv2_sslv3(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose between SSLv2 and SSLv3.";
-sslv2_sslv3(suite) ->
- [];
-sslv2_sslv3(Config) when list(Config) ->
- do_run_test(Config, [sslv2, sslv3]).
-
-sslv2_tlsv1(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose between SSLv2 and TLSv1.";
-sslv2_tlsv1(suite) ->
- [];
-sslv2_tlsv1(Config) when list(Config) ->
- do_run_test(Config, [sslv2, tlsv1]).
-
-sslv3_tlsv1(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose between SSLv3 and TLSv1.";
-sslv3_tlsv1(suite) ->
- [];
-sslv3_tlsv1(Config) when list(Config) ->
- do_run_test(Config, [sslv3, tlsv1]).
-
-sslv2_sslv3_tlsv1(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close. "
- "Client and server choose between SSLv2, SSLv3, and TLSv1.";
-sslv2_sslv3_tlsv1(suite) ->
- [];
-sslv2_sslv3_tlsv1(Config) when list(Config) ->
- do_run_test(Config, [sslv2, sslv3, tlsv1]).
-
-%%%%
-
-do_run_test(Config0, Protocols) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- Timeout = 40000, NConns = 1,
- DataSize = 10,
-
- ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config0),
- ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0],
-
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- connection_info,
- {recv, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {connect, {Host, LPort}},
- connection_info,
- {send, DataSize},
- await_close],
- Config1 = [{env, [{protocol_version, Protocols}]} | Config0],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout,
- ?MODULE, Config1).
-
-
diff --git a/lib/ssl/test/old_ssl_verify_SUITE.erl b/lib/ssl/test/old_ssl_verify_SUITE.erl
deleted file mode 100644
index 4c11ea6850..0000000000
--- a/lib/ssl/test/old_ssl_verify_SUITE.erl
+++ /dev/null
@@ -1,153 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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
-%% 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(old_ssl_verify_SUITE).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- cinit_both_verify/1,
- cinit_cnocert/1
- ]).
-
--import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
--include_lib("test_server/include/test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [cinit_both_verify, cinit_cnocert].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(doc) ->
- "Want to se what Config contains.";
-init_per_suite(suite) ->
- [];
-init_per_suite(Config) ->
- io:format("Config: ~p~n", [Config]),
-
- %% Check if SSL exists. If this case fails, all other cases are skipped
- case catch crypto:start() of
- ok ->
- application:start(public_key),
- case ssl:start() of
- ok -> ssl:stop();
- {error, {already_started, _}} -> ssl:stop();
- Error -> ?t:fail({failed_starting_ssl,Error})
- end,
- Config;
- _Else ->
- {skip,"Could not start crypto"}
- end.
-
-end_per_suite(doc) ->
- "This test case has no mission other than closing the conf case";
-end_per_suite(suite) ->
- [];
-end_per_suite(Config) ->
- crypto:stop(),
- Config.
-
-cinit_both_verify(doc) ->
- "Server closes after accept, Client waits for close. Both have certs "
- "and both verify each other.";
-cinit_both_verify(suite) ->
- [];
-cinit_both_verify(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3456,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {CsslOpts0, SsslOpts0}} = mk_ssl_cert_opts(Config),
- ?line CsslOpts = [{verify, 2}, {depth, 2} | CsslOpts0],
- ?line SsslOpts = [{verify, 2}, {depth, 3} | SsslOpts0],
-
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {sslopts, CsslOpts},
- {connect, {Host, LPort}},
- {send, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout,
- ?MODULE, Config).
-
-cinit_cnocert(doc) ->
- "Client has no cert. Nor the client, nor the server is verifying its "
- "peer. Server closes, client waits for close.";
-cinit_cnocert(suite) ->
- [];
-cinit_cnocert(Config) when list(Config) ->
- process_flag(trap_exit, true),
- DataSize = 1000, LPort = 3457,
- Timeout = 40000, NConns = 1,
-
- ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config),
- ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0],
-
- ?line {ok, Host} = inet:gethostname(),
-
- LCmds = [{sockopts, [{backlog, NConns}]},
- {sslopts, SsslOpts},
- {listen, LPort},
- wait_sync,
- lclose],
- ACmds = [{timeout, Timeout},
- accept,
- {recv, DataSize},
- close],
- CCmds = [{timeout, Timeout},
- {connect, {Host, LPort}},
- {send, DataSize},
- await_close],
- ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout,
- ?MODULE, Config).
-
-
diff --git a/lib/ssl/test/old_transport_accept_SUITE.erl b/lib/ssl/test/old_transport_accept_SUITE.erl
deleted file mode 100644
index 6f0c8e456b..0000000000
--- a/lib/ssl/test/old_transport_accept_SUITE.erl
+++ /dev/null
@@ -1,258 +0,0 @@
-%%
-%% %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(old_transport_accept_SUITE).
--include_lib("common_test/include/ct.hrl").
--include("test_server_line.hrl").
-
-%% Default timetrap timeout (set in init_per_testcase).
--define(default_timeout, ?t:minutes(1)).
--define(application, ssh).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
- config/1,
- echo_once/1,
- echo_twice/1,
- close_before_ssl_accept/1,
- server/5,
- tolerant_server/5,
- client/5
- ]).
-
-init_per_testcase(_Case, Config) ->
- WatchDog = ssl_test_lib:timetrap(?default_timeout),
- [{watchdog, WatchDog}, {protomod, gen_tcp}, {serialize_accept, true}|
- Config].
-
-end_per_testcase(_Case, Config) ->
- WatchDog = ?config(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [config, echo_once, echo_twice, close_before_ssl_accept].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- try crypto:start() of
- ok ->
- Config
- catch _:_ ->
- {skip, "Crypto did not start"}
- end.
-
-end_per_suite(_Config) ->
- application:stop(crypto),
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-config(doc) ->
- "Want to se what Config contains.";
-config(suite) ->
- [];
-config(Config) ->
- io:format("Config: ~p~n", [Config]),
- ok.
-
-echo_once(doc) ->
- "Client sends 256 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-echo_once(suite) ->
- [];
-echo_once(Config) when list(Config) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- {ok, Host} = inet:gethostname(),
- {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config),
- N = 1,
- Msg = lists:seq(0, 255),
- Self = self(),
- Params = "-pa " ++ filename:dirname(code:which(?MODULE)),
- Node = start_node(server, Params),
- CNode = start_node(client, Params),
- Server = spawn_link(Node, ?MODULE, server, [Self, LPort, SOpts, Msg, N]),
- Client = spawn_link(Node, ?MODULE, client, [Host, LPort, COpts, Msg, N]),
- ok = receive
- {Server, listening} ->
- Client ! {Server, listening},
- ok;
- E ->
- io:format("bad receive (1) ~p\n", [E]),
- E
- end,
- receive
- {Server, done} ->
- ok
- end,
- test_server:stop_node(Node),
- test_server:stop_node(CNode).
-
-close_before_ssl_accept(doc) ->
- "Client sends 256 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-close_before_ssl_accept(suite) ->
- [];
-close_before_ssl_accept(Config) when list(Config) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- {ok, Host} = inet:gethostname(),
- {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config),
- Msg = lists:seq(0, 255),
- Self = self(),
- Params = "-pa " ++ filename:dirname(code:which(?MODULE)),
- Node = start_node(server, Params),
- CNode = start_node(client, Params),
- Server = spawn_link(Node, ?MODULE, tolerant_server,
- [Self, LPort, SOpts, Msg, 2]),
- Client = spawn_link(Node, ?MODULE, client,
- [Host, LPort, COpts, Msg, 1]),
- ok = receive
- {Server, listening} ->
- {ok, S} = gen_tcp:connect(Host, LPort, []),
- gen_tcp:close(S),
- Client ! {Server, listening},
- ok;
- E ->
- io:format("bad receive (1) ~p\n", [E]),
- E
- end,
- receive
- {Server, done} ->
- ok
- end,
- test_server:stop_node(Node),
- test_server:stop_node(CNode).
-
-client(Host, LPort, COpts, Msg, N) ->
- ok = receive
- {_Server, listening} ->
- ok;
- E ->
- io:format("bad receive (2) ~p\n", [E]),
- E
- end,
- Opts = COpts ++ [{packet, raw}, {active, false}],
- app(),
- lists:foreach(fun(_) ->
- {ok, S} = ssl:connect(Host, LPort, Opts),
- ssl:send(S, Msg),
- {ok, Msg} = ssl:recv(S, length(Msg)),
- ssl:close(S)
- end, lists:seq(1, N)).
-
-echo_twice(doc) ->
- "Two clients sends 256 bytes to server, that receives them, sends them "
- "back, and closes. Client waits for close. Both have certs.";
-echo_twice(suite) ->
- [];
-echo_twice(Config) when list(Config) ->
- process_flag(trap_exit, true),
- LPort = 3456,
- {ok, Host} = inet:gethostname(),
- {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config),
- N = 2,
- Msg = lists:seq(0, 255),
- Self = self(),
- Params = "-pa " ++ filename:dirname(code:which(?MODULE)),
- Node = start_node(server, Params),
- CNode = start_node(client, Params),
- Server = spawn_link(Node, ?MODULE, server,
- [Self, LPort, SOpts, Msg, N]),
- Client = spawn_link(Node, ?MODULE, client,
- [Host, LPort, COpts, Msg, N]),
- ok = receive
- {Server, listening} ->
- Client ! {Server, listening},
- ok;
- E ->
- io:format("bad receive (3) ~p\n", [E]),
- E
- end,
- receive
- {Server, done} ->
- ok
- end,
- test_server:stop_node(Node),
- test_server:stop_node(CNode).
-
-server(Client, Port, SOpts, Msg, N) ->
- app(),
- process_flag(trap_exit, true),
- Opts = SOpts ++ [{packet, raw}, {active, false}],
- {ok, LSock} = ssl:listen(Port, Opts),
- Client ! {self(), listening},
- server_loop(Client, LSock, Msg, N).
-
-server_loop(Client, _, _, 0) ->
- Client ! {self(), done};
-server_loop(Client, LSock, Msg, N) ->
- {ok, S} = ssl:transport_accept(LSock),
- ok = ssl:ssl_accept(S),
- %% P = ssl:controlling_process(S, Proxy),
- {ok, Msg} = ssl:recv(S, length(Msg)),
- ok = ssl:send(S, Msg),
- ok = ssl:close(S),
- server_loop(Client, LSock, Msg, N-1).
-
-tolerant_server(Client, Port, SOpts, Msg, N) ->
- app(),
- process_flag(trap_exit, true),
- Opts = SOpts ++ [{packet, raw}, {active, false}],
- {ok, LSock} = ssl:listen(Port, Opts),
- Client ! {self(), listening},
- tolerant_server_loop(Client, LSock, Msg, N).
-
-tolerant_server_loop(Client, _, _, 0) ->
- Client ! {self(), done};
-tolerant_server_loop(Client, LSock, Msg, N) ->
- {ok, S} = ssl:transport_accept(LSock),
- case ssl:ssl_accept(S) of
- ok ->
- %% P = ssl:controlling_process(S, Proxy),
- {ok, Msg} = ssl:recv(S, length(Msg)),
- ok = ssl:send(S, Msg),
- ok = ssl:close(S);
- E ->
- io:format("ssl_accept error: ~p\n", [E])
- end,
- tolerant_server_loop(Client, LSock, Msg, N-1).
-
-app() ->
- crypto:start(),
- application:start(public_key),
- ssl:start().
-
-start_node(Kind, Params) ->
- S = atom_to_list(?MODULE)++"_" ++ atom_to_list(Kind),
- {ok, Node} = test_server:start_node(list_to_atom(S), slave, [{args, Params}]),
- Node.
-
diff --git a/lib/ssl/test/ssl.cover b/lib/ssl/test/ssl.cover
index 60774cc0f1..6b13e07a37 100644
--- a/lib/ssl/test/ssl.cover
+++ b/lib/ssl/test/ssl.cover
@@ -1,21 +1,4 @@
{incl_app,ssl,details}.
-{excl_mods, ssl, [ssl_pkix_oid,
- 'PKIX1Algorithms88',
- 'PKIX1Explicit88',
- 'PKIX1Implicit88',
- 'PKIXAttributeCertificate',
- 'SSL-PKIX',
- ssl_pem,
- ssl_pkix,
- ssl_base64,
- ssl_broker,
- ssl_broker_int,
- ssl_broker_sup,
- ssl_debug,
- ssl_server,
- ssl_prim,
- inet_ssl_dist,
- 'OTP-PKIX'
- ]}.
+{excl_mods, ssl, [ssl_debug]}.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 8da1d947d3..a9109c5a6e 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -28,7 +28,6 @@
-include_lib("public_key/include/public_key.hrl").
-include("ssl_alert.hrl").
--include("ssl_int.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
@@ -207,8 +206,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[app, alerts, connection_info, protocol_versions,
empty_protocol_versions, controlling_process,
- controller_dies, client_closes_socket, peercert,
- connect_dist, peername, sockname, socket_options,
+ controller_dies, client_closes_socket,
+ connect_dist, peername, peercert, sockname, socket_options,
invalid_inet_get_option, invalid_inet_get_option_not_list,
invalid_inet_get_option_improper_list,
invalid_inet_set_option, invalid_inet_set_option_not_list,
@@ -584,50 +583,6 @@ client_closes_socket(Config) when is_list(Config) ->
ssl_test_lib:check_result(Server, {error,closed}).
%%--------------------------------------------------------------------
-
-peercert(doc) ->
- [""];
-
-peercert(suite) ->
- [];
-
-peercert(Config) when is_list(Config) ->
- ClientOpts = ?config(client_opts, Config),
- ServerOpts = ?config(server_opts, Config),
- {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
- Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, peercert_result, []}},
- {options, ServerOpts}]),
- Port = ssl_test_lib:inet_port(Server),
- Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE, peercert_result, []}},
- {options, ClientOpts}]),
-
- CertFile = proplists:get_value(certfile, ServerOpts),
- [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile),
- ErlCert = public_key:pkix_decode_cert(BinCert, otp),
-
- ServerMsg = {{error, no_peercert}, {error, no_peercert}},
- ClientMsg = {{ok, BinCert}, {ok, ErlCert}},
-
- test_server:format("Testcase ~p, Client ~p Server ~p ~n",
- [self(), Client, Server]),
-
- ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg),
-
- ssl_test_lib:close(Server),
- ssl_test_lib:close(Client).
-
-peercert_result(Socket) ->
- Result1 = ssl:peercert(Socket),
- Result2 = ssl:peercert(Socket, [ssl]),
- {Result1, Result2}.
-
-%%--------------------------------------------------------------------
connect_dist(doc) ->
["Test a simple connect as is used by distribution"];
@@ -708,6 +663,44 @@ peername_result(S) ->
ssl:peername(S).
%%--------------------------------------------------------------------
+peercert(doc) ->
+ [""];
+peercert(suite) ->
+ [];
+peercert(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, peercert_result, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, peercert_result, []}},
+ {options, ClientOpts}]),
+
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile),
+
+ ServerMsg = {error, no_peercert},
+ ClientMsg = {ok, BinCert},
+
+ test_server:format("Testcase ~p, Client ~p Server ~p ~n",
+ [self(), Client, Server]),
+
+ ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+peercert_result(Socket) ->
+ ssl:peercert(Socket).
+
+%%--------------------------------------------------------------------
sockname(doc) ->
["Test API function sockname/1"];
@@ -1528,7 +1521,6 @@ eoptions(Config) when is_list(Config) ->
end,
TestOpts = [{versions, [sslv2, sslv3]},
- {ssl_imp, cool},
{verify, 4},
{verify_fun, function},
{fail_if_no_peer_cert, 0},
diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl
index 7325e97ff5..23e9268f9b 100644
--- a/lib/ssl/test/ssl_dist_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_SUITE.erl
@@ -35,11 +35,12 @@
nodename}
).
+%% Test server callback functions
suite() ->
[{ct_hooks,[ts_install_cth]}].
all() ->
- [basic].
+ [basic, payload, plain_options, plain_verify_options].
groups() ->
[].
@@ -50,10 +51,12 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-init_per_suite(Config) ->
+init_per_suite(Config0) ->
try crypto:start() of
ok ->
- add_ssl_opts_config(Config)
+ Config = add_ssl_opts_config(Config0),
+ setup_certs(Config),
+ Config
catch _:_ ->
{skip, "Crypto did not start"}
end.
@@ -62,24 +65,19 @@ end_per_suite(Config) ->
application:stop(crypto),
Config.
-init_per_testcase(Case, Config) when list(Config) ->
+init_per_testcase(Case, Config) when is_list(Config) ->
Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)),
[{watchdog, Dog},{testcase, Case}|Config].
-end_per_testcase(_Case, Config) when list(Config) ->
+end_per_testcase(_Case, Config) when is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Testcases %%
-%% %%
-
+%%--------------------------------------------------------------------
+%% Test cases starts here.
+%%--------------------------------------------------------------------
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,
@@ -132,12 +130,99 @@ basic(Config) when is_list(Config) ->
stop_ssl_node(NH2),
success(Config).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Internal functions %%
-%% %%
+%%--------------------------------------------------------------------
+payload(doc) ->
+ ["Test that send a lot of data between the ssl distributed noes"];
+payload(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),
+
+ Ref = make_ref(),
+ spawn(fun () ->
+ apply_on_ssl_node(
+ NH1,
+ fun () ->
+ send_to_tstcntrl({Ref, self()}),
+ receive
+ {From, Msg} ->
+ From ! {self(), Msg}
+ end
+ end)
+ end),
+ receive
+ {Ref, SslPid} ->
+ ok = apply_on_ssl_node(
+ NH2,
+ fun () ->
+ Msg = crypto:rand_bytes(100000),
+ SslPid ! {self(), Msg},
+ receive
+ {SslPid, Msg} ->
+ ok
+ end
+ end)
+ end,
+ stop_ssl_node(NH1),
+ stop_ssl_node(NH2),
+ success(Config).
+%%--------------------------------------------------------------------
+plain_options(doc) ->
+ ["Test specifying additional options"];
+plain_options(Config) when is_list(Config) ->
+ DistOpts = "-ssl_dist_opt server_secure_renegotiate true "
+ "client_secure_renegotiate true "
+ "server_reuse_sessions true client_reuse_sessions true "
+ "client_verify verify_none server_verify verify_none "
+ "server_depth 1 client_depth 1 "
+ "server_hibernate_after 500 client_hibernate_after 500",
+
+ NH1 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]),
+ Node1 = NH1#node_handle.nodename,
+ NH2 = start_ssl_node([{additional_dist_opts, DistOpts} | 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),
+
+ stop_ssl_node(NH1),
+ stop_ssl_node(NH2),
+ success(Config).
+%%--------------------------------------------------------------------
+plain_verify_options(doc) ->
+ ["Test specifying additional options"];
+plain_verify_options(Config) when is_list(Config) ->
+ DistOpts = "-ssl_dist_opt server_secure_renegotiate true "
+ "client_secure_renegotiate true "
+ "server_reuse_sessions true client_reuse_sessions true "
+ "server_hibernate_after 500 client_hibernate_after 500",
+
+ NH1 = start_ssl_node([{additional_dist_opts, DistOpts}, {many_verify_opts, true} | Config]),
+ Node1 = NH1#node_handle.nodename,
+ NH2 = start_ssl_node([{additional_dist_opts, DistOpts}, {many_verify_opts, true} | 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),
+
+ stop_ssl_node(NH1),
+ stop_ssl_node(NH2),
+ success(Config).
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
-%%
%% ssl_node side api
%%
@@ -152,7 +237,7 @@ send_to_tstcntrl(Message) ->
%% test_server side api
%%
-apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) ->
+apply_on_ssl_node(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
Ref = make_ref(),
send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}),
receive
@@ -194,7 +279,7 @@ 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)),
+ SSLDistOpts = setup_dist_opts(Config),
start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs).
start_ssl_node_raw(Name, Args) ->
@@ -204,7 +289,7 @@ start_ssl_node_raw(Name, Args) ->
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) ->
+ Port when is_port(Port) ->
unlink(Port),
erlang:port_close(Port),
case await_ssl_node_up(Name, LSock) of
@@ -363,7 +448,7 @@ tstsrvr_con_loop(Name, Socket, Parent) ->
%%
% cnct2tstsrvr() is called via command line arg -run ...
-cnct2tstsrvr([Host, Port]) when list(Host), list(Port) ->
+cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) ->
%% Spawn connection handler on ssl node side
ConnHandler
= spawn(fun () ->
@@ -406,7 +491,7 @@ notify_ssl_node_up(Socket) ->
send_to_tstsrvr(Term) ->
case catch ets:lookup_element(test_server_info, test_server_handler, 2) of
- Hndlr when pid(Hndlr) ->
+ Hndlr when is_pid(Hndlr) ->
Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok;
_ ->
receive after 200 -> ok end,
@@ -487,8 +572,9 @@ do_append_files([F|Fs], RF) ->
ok = file:write(RF, Data),
do_append_files(Fs, RF).
-setup_dist_opts(Name, PrivDir) ->
- NodeDir = filename:join([PrivDir, Name]),
+setup_certs(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ NodeDir = filename:join([PrivDir, "Certs"]),
RGenDir = filename:join([NodeDir, "rand_gen"]),
ok = file:make_dir(NodeDir),
ok = file:make_dir(RGenDir),
@@ -503,10 +589,46 @@ setup_dist_opts(Name, PrivDir) ->
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 ++ " ".
+ append_files([CK, CC], CKC).
+
+setup_dist_opts(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ DataDir = ?config(data_dir, Config),
+ Dhfile = filename:join([DataDir, "dHParam.pem"]),
+ NodeDir = filename:join([PrivDir, "Certs"]),
+ SDir = filename:join([NodeDir, "server"]),
+ CDir = filename:join([NodeDir, "client"]),
+ SC = filename:join([SDir, "cert.pem"]),
+ SK = filename:join([SDir, "key.pem"]),
+ SKC = filename:join([SDir, "keycert.pem"]),
+ SCA = filename:join([CDir, "cacerts.pem"]),
+ CC = filename:join([CDir, "cert.pem"]),
+ CK = filename:join([CDir, "key.pem"]),
+ CKC = filename:join([CDir, "keycert.pem"]),
+ CCA = filename:join([SDir, "cacerts.pem"]),
+
+ DistOpts = case proplists:get_value(many_verify_opts, Config, false) of
+ false ->
+ "-proto_dist inet_tls "
+ ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " "
+ ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " ";
+ true ->
+ "-proto_dist inet_tls "
+ ++ "-ssl_dist_opt server_certfile " ++ SC ++ " "
+ ++ "-ssl_dist_opt server_keyfile " ++ SK ++ " "
+ ++ "-ssl_dist_opt server_cacertfile " ++ SCA ++ " "
+ ++ "-ssl_dist_opt server_verify verify_peer "
+ ++ "-ssl_dist_opt server_fail_if_no_peer_cert true "
+ ++ "-ssl_dist_opt server_ciphers DHE-RSA-AES256-SHA:DHE-RSA-AES128-SHA "
+ ++ "-ssl_dist_opt server_dhfile " ++ Dhfile ++ " "
+ ++ "-ssl_dist_opt client_certfile " ++ CC ++ " "
+ ++ "-ssl_dist_opt client_keyfile " ++ CK ++ " "
+ ++ "-ssl_dist_opt client_cacertfile " ++ CCA ++ " "
+ ++ "-ssl_dist_opt client_verify verify_peer "
+ ++ "-ssl_dist_opt client_ciphers DHE-RSA-AES256-SHA:DHE-RSA-AES128-SHA "
+ end,
+ MoreOpts = proplists:get_value(additional_dist_opts, Config, []),
+ DistOpts ++ MoreOpts.
%%
%% Start scripts etc...
diff --git a/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem b/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem
new file mode 100644
index 0000000000..feb581da30
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem
@@ -0,0 +1,5 @@
+-----BEGIN DH PARAMETERS-----
+MIGHAoGBAMY5VmCZ22ZEy/KO8kjt94PH7ZtSG0Z0zitlMlvd4VsNkDzXsVeu+wkH
+FGDC3h3vgv6iwXGCbmrSOVk/FPZbzLhwZ8aLnkUFOBbOvVvb1JptQwOt8mf+eScG
+M2gGBktheQV5Nf1IrzOctG7VGt+neiqb/Y86uYCcDdL+M8++0qnLAgEC
+-----END DH PARAMETERS-----
diff --git a/lib/ssl/test/ssl_test_MACHINE.erl b/lib/ssl/test/ssl_test_MACHINE.erl
deleted file mode 100644
index e0ffa15d80..0000000000
--- a/lib/ssl/test/ssl_test_MACHINE.erl
+++ /dev/null
@@ -1,940 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2010. 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_test_MACHINE).
-
--export([many_conns/0, mk_ssl_cert_opts/1, test_one_listener/7,
- test_server_only/6]).
-
--export([process_init/3, do_start/1]).
-
-
--include("test_server.hrl").
--include("ssl_test_MACHINE.hrl").
-
--define(WAIT_TIMEOUT, 10000).
--define(CLOSE_WAIT, 1000).
-
-%%
-%% many_conns() -> ManyConnections
-%%
-%% Choose a suitable number of "many connections" depending on platform
-%% and current limit for file descriptors.
-%%
-many_conns() ->
- case os:type() of
- {unix,_} -> many_conns_1();
- _ -> 10
- end.
-
-many_conns_1() ->
- N0 = os:cmd("ulimit -n"),
- N1 = lists:reverse(N0),
- N2 = lists:dropwhile(fun($\r) -> true;
- ($\n) -> true;
- (_) -> false
- end, N1),
- N = list_to_integer(lists:reverse(N2)),
- lists:min([(N - 10) div 2, 501]).
-
-%%
-%% mk_ssl_cert_opts(Config) -> {ok, {COpts, SOpts}}
-%%
-%%
-mk_ssl_cert_opts(_Config) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- COpts = [{ssl_imp, old},
- {cacertfile, filename:join([Dir, "client", "cacerts.pem"])},
- {certfile, filename:join([Dir, "client", "cert.pem"])},
- {keyfile, filename:join([Dir, "client", "key.pem"])}],
- SOpts = [{ssl_imp, old},
- {cacertfile, filename:join([Dir, "server", "cacerts.pem"])},
- {certfile, filename:join([Dir, "server", "cert.pem"])},
- {keyfile, filename:join([Dir, "server", "key.pem"])}],
- {ok, {COpts, SOpts}}.
-
-%%
-%% Cmds:
-%% {protomod, gen_tcp | ssl} default = ssl
-%% {serialize_accept, true | false} default = false
-%% {timeout, Timeout}
-%% {sockopts, Opts}
-%% {sslopts, Opts}
-%% {protocols, Protocols} [sslv2|sslv3|tlsv1]
-%% {listen, Port}
-%% {lsock, LSock} listen socket for acceptor
-%% peercert
-%% accept
-%% {connect, {Host, Port}}
-%% {recv, N}
-%% {send, N}
-%% {echo, N} async echo back
-%% close close connection socket
-%% {close, Time} wait time and then close socket
-%% lclose close listen socket
-%% await_close wait for close
-%% wait_sync listener's wait for sync from parent
-%% connection_info
-%% {exit, Reason} exit
-%%
-%%
-%% We cannot have more than `backlog' acceptors at the same time.
-%%
-
-
-%%
-%% test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, Suite, Config)
-%%
-%% Creates one client and one server node, and runs one listener on
-%% the server node (according to LCmds), and creates NConns acceptors
-%% on the server node, and the same number of connectors on the client
-%% node. The acceptors and and connectors execute according to ACmds
-%% and CCmds, respectively.
-%%
-%% It is a good idea to have the backlog size in LCmds set to
-%% be at least as large as NConns.
-%%
-test_one_listener(NConns, LCmds0, ACmds0, CCmds0, Timeout, Suite, Config) ->
- ProtoMod = get_protomod(Config),
- SerializeAccept = get_serialize_accept(Config),
- ?line {ok, {CNode, SNode}} = start_client_server_nodes(Suite),
- case ProtoMod of
- ssl ->
- ?line ok = start_ssl([CNode, SNode], Config);
- gen_tcp ->
- ok
- end,
- LCmds = [{protomod, ProtoMod}| LCmds0],
- ACmds = [{protomod, ProtoMod}, {serialize_accept, SerializeAccept}|
- ACmds0],
- CCmds = [{protomod, ProtoMod}| CCmds0],
-
- ?line {ok, Listener} = start_process(SNode, self(), LCmds, listener),
- ?line {ok, LSock} = wait_lsock(Listener, ?WAIT_TIMEOUT),
- ?line {ok, Accs0} = start_processes(NConns, SNode, self(),
- [{lsock, LSock}| ACmds], acceptor),
- Accs = case ProtoMod of
- gen_tcp ->
- [Acc1| Accs1] = Accs0,
- Acc1 ! {continue_accept, self()},
- Accs1;
- ssl ->
- Accs0
- end,
- ?line {ok, Conns} = start_processes(NConns, CNode, self(),
- CCmds, connector),
- ?line case wait_ack(Accs, Accs0 ++ Conns, Timeout) of
- ok ->
- ?line sync([Listener]),
- ?line wait_ack([], [Listener], ?WAIT_TIMEOUT);
- {error, Reason} ->
- ?line stop_node(SNode),
- ?line stop_node(CNode),
- exit(Reason)
- end,
- ?line stop_node(SNode),
- ?line stop_node(CNode),
- ok.
-
-%%
-%% test_server_only(NConns, LCmds, ACmds, Timeout, Suite, Config)
-%%
-%% Creates only one server node, and runs one listener on
-%% the server node (according to LCmds), and creates NConns acceptors
-%% on the server node. The acceptors execute according to ACmds.
-%% There are no connectors.
-%%
-test_server_only(NConns, LCmds0, ACmds0, Timeout, Suite, Config) ->
- ProtoMod = get_protomod(Config),
- ?line {ok, SNode} = start_server_node(Suite),
- case ProtoMod of
- ssl ->
- ?line ok = start_ssl([SNode], Config);
- gen_tcp ->
- ok
- end,
- LCmds = [{protomod, ProtoMod}| LCmds0],
- ACmds = [{protomod, ProtoMod}| ACmds0],
- ?line {ok, Listener} = start_process(SNode, self(), LCmds, listener),
- ?line {ok, LSock} = wait_lsock(Listener, ?WAIT_TIMEOUT),
- ?line {ok, Accs0} = start_processes(NConns, SNode, self(),
- [{lsock, LSock}| ACmds], acceptor),
- Accs = case ProtoMod of
- gen_tcp ->
- [Acc1| Accs1] = Accs0,
- Acc1 ! {continue_accept, self()},
- Accs1;
- ssl ->
- Accs0
- end,
- ?line case wait_ack(Accs, Accs0, Timeout) of
- ok ->
- ?line sync([Listener]),
- ?line wait_ack([], [Listener], ?WAIT_TIMEOUT);
- {error, Reason} ->
- ?line stop_node(SNode),
- exit(Reason)
- end,
- ?line stop_node(SNode),
- ok.
-
-%%
-%% start_client_server_nodes(Suite) -> {ok, {CNode, SNode}}
-%%
-start_client_server_nodes(Suite) ->
- {ok, CNode} = start_client_node(Suite),
- {ok, SNode} = start_server_node(Suite),
- {ok, {CNode, SNode}}.
-
-start_client_node(Suite) ->
- start_node(lists:concat([Suite, "_client"])).
-
-start_server_node(Suite) ->
- start_node(lists:concat([Suite, "_server"])).
-
-%%
-%% start_ssl(Nodes, Config)
-%%
-start_ssl(Nodes, Config) ->
- Env0 = lists:flatten([Env00 || {env, Env00} <- Config]),
- Env1 = case os:getenv("SSL_DEBUG") of
- false ->
- [];
- _ ->
- Dir = ?config(priv_dir, Config),
- [{debug, true}, {debugdir, Dir}]
- end,
- Env = Env0 ++ Env1,
- lists:foreach(
- fun(Node) -> rpc:call(Node, ?MODULE, do_start, [Env]) end, Nodes),
- ok.
-
-do_start(Env) ->
- application:start(crypto),
- application:start(public_key),
- application:load(ssl),
- lists:foreach(
- fun({Par, Val}) -> application:set_env(ssl, Par, Val) end, Env),
- application:start(ssl).
-
-
-%%
-%% start_node(Name) -> {ok, Node}
-%% start_node(Name, ExtraParams) -> {ok, Node}
-%%
-start_node(Name) ->
- start_node(Name, []).
-start_node(Name, ExtraParams) ->
- Params = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++
- ExtraParams,
- test_server:start_node(Name, slave, [{args, Params}]).
-
-stop_node(Node) ->
- test_server:stop_node(Node).
-
-%%
-%% start_processes(N, Node, Parent, Cmds, Type) -> {ok, Pids}
-%%
-start_processes(M, Node, Parent, Cmds, Type) ->
- start_processes1(0, M, Node, Parent, Cmds, Type, []).
-start_processes1(M, M, _, _, _, _, Pids) ->
- {ok, lists:reverse(Pids)};
-start_processes1(N, M, Node, Parent, Cmds, Type, Pids) ->
- {ok, Pid} = start_process(Node, Parent, Cmds, {Type, N + 1}),
- start_processes1(N + 1, M, Node, Parent, Cmds, Type, [Pid| Pids]).
-
-%%
-%% start_process(Node, Parent, Cmds, Type) -> {ok, Pid}
-%%
-start_process(Node, Parent, Cmds0, Type) ->
- Cmds = case os:type() of
- {win32, _} ->
- lists:map(fun(close) -> {close, ?CLOSE_WAIT};
- (Term) -> Term end, Cmds0);
- _ ->
- Cmds0
- end,
- Pid = spawn_link(Node, ?MODULE, process_init, [Parent, Cmds, Type]),
- {ok, Pid}.
-
-process_init(Parent, Cmds, Type) ->
- ?debug("#### ~w start~n", [{Type, self()}]),
- pre_main_loop(Cmds, #st{parent = Parent, type = Type}).
-
-%%
-%% pre_main_loop
-%%
-pre_main_loop([], St) ->
- ?debug("#### ~w end~n", [{St#st.type, self()}]),
- main_loop([], St);
-pre_main_loop(Cmds, St) ->
- ?debug("#### ~w -> ~w~n",
- [{St#st.type, self(), St#st.sock, St#st.port,
- St#st.peer, St#st.active}, hd(Cmds)]),
- main_loop(Cmds, St).
-
-%%
-%% main_loop(Cmds, St)
-%%
-main_loop([{protomod, ProtoMod}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{protomod = ProtoMod});
-
-main_loop([{serialize_accept, Bool}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{serialize_accept = Bool});
-
-main_loop([{sockopts, Opts}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{sockopts = Opts});
-
-main_loop([{sslopts, Opts}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{sslopts = Opts});
-
-main_loop([{protocols, Protocols}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{protocols = Protocols});
-
-main_loop([{timeout, T}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{timeout = T});
-
-main_loop([{lsock, LSock}| Cmds], St) ->
- pre_main_loop(Cmds, St#st{lsock = LSock});
-
-main_loop([{seed, Data}| Cmds], St) ->
- case ssl:seed("tjosan") of
- ok ->
- pre_main_loop(Cmds, St);
- {error, Reason} ->
- ?error("#### ~w(~w) in seed: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([{listen, Port}| Cmds], St) ->
- case listen(St, Port) of
- {ok, LSock} ->
- ack_lsock(St#st.parent, LSock),
- NSt = get_active(St#st{port = Port, sock = LSock, lsock = LSock}),
- pre_main_loop(Cmds, St);
- {error, Reason} ->
- ?error("#### ~w(~w) in listen: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([accept| Cmds], St) ->
- case St#st.serialize_accept of
- true ->
- Parent = St#st.parent,
- receive
- {continue_accept, Parent} ->
- ok
- end;
- false ->
- ok
- end,
- case accept(St) of
- {ok, Sock, Port, Peer} ->
- case St#st.serialize_accept of
- true ->
- St#st.parent ! {one_accept_done, self()};
- false ->
- ok
- end,
- NSt = get_active(St#st{sock = Sock, port = Port, peer = Peer}),
- pre_main_loop(Cmds, NSt);
- {error, Reason} ->
- ?error("#### ~w(~w) in accept: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([accept_timeout| Cmds], St) ->
- case accept(St) of
- {error, timeout} ->
- pre_main_loop(Cmds, St);
- {error, Reason} ->
- ?error("#### ~w(~w) in accept_timeout: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-
-main_loop([{connect, {Host, Port}}| Cmds], St) ->
- case connect(St, Host, Port) of
- {ok, Sock, LPort, Peer} ->
- NSt = get_active(St#st{sock = Sock, port = LPort, peer = Peer}),
- pre_main_loop(Cmds, NSt);
- {error, Reason} ->
- ?error("#### ~w(~w) in connect: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([connection_info| Cmds], St) ->
- case connection_info(St) of
- {ok, ProtoInfo} ->
- io:fwrite("Got connection_info:~n~p~n", [ProtoInfo]),
- pre_main_loop(Cmds, St);
- {error, Reason} ->
- ?error("#### ~w(~w) in connection_info: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([peercert| Cmds], St) ->
- case peercert(St) of
- {ok, Cert} ->
- io:fwrite("Got cert:~n~p~n", [Cert]),
- pre_main_loop(Cmds, St);
- {error, Reason} ->
- ?error("#### ~w(~w) in peercert: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([nopeercert| Cmds], St) ->
- case peercert(St) of
- {error, Reason} ->
- io:fwrite("Got no cert as expected. reason:~n~p~n", [Reason]),
- pre_main_loop(Cmds, St);
- {ok, Cert} ->
- ?error("#### ~w(~w) in peercert: error: got cert: ~p~n",
- [St#st.type, self(), Cert]),
- exit(peercert)
- end;
-
-main_loop([{recv, N}| Cmds], St) ->
- recv_loop([{recv, N}| Cmds], fun recv/1, St); % Returns to main_loop/2.
-
-main_loop([{send, N}| Cmds], St) ->
- Msg = mk_msg(N),
- case send(St, Msg) of
- ok ->
- pre_main_loop(Cmds, St);
- {error, Reason} ->
- ?error("#### ~w(~w) in send: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([{echo, N}| Cmds], St) ->
- recv_loop([{echo, N}| Cmds], fun echo/1, St); % Returns to main_loop/2.
-
-main_loop([{close, WaitTime}| Cmds], St) ->
- wait(WaitTime),
- pre_main_loop([close| Cmds], St);
-
-main_loop([close| Cmds], St) ->
- case close(St) of
- ok ->
- pre_main_loop(Cmds, St#st{sock = nil});
- {error, Reason} ->
- ?error("#### ~w(~w) in close: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([lclose| Cmds], St) ->
- case lclose(St) of
- ok ->
- pre_main_loop(Cmds, St#st{lsock = nil});
- {error, Reason} ->
- ?error("#### ~w(~w) in lclose: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([await_close| Cmds], St) ->
- case await_close(St) of
- ok ->
- pre_main_loop(Cmds, St#st{sock = nil});
- {error, Reason} ->
- ?error("#### ~w(~w) in await_close: error: ~w~n",
- [St#st.type, self(), Reason]),
- exit(Reason)
- end;
-
-main_loop([wait_sync| Cmds], St) ->
- wait_sync(St),
- pre_main_loop(Cmds, St);
-
-main_loop({exit, Reason}, _St) ->
- exit(Reason);
-
-main_loop([], _St) ->
- ok.
-
-%%
-%% recv_loop(Cmds, F, St)
-%%
-%% F = recv/1 | echo/1
-%%
-recv_loop([{_Tag, 0}| Cmds], _, St) ->
- pre_main_loop(Cmds, St);
-recv_loop([{_Tag, N}| _Cmds], _, St) when N < 0 ->
- ?error("#### ~w(~w) in recv_loop: error: too much: ~w~n",
- [St#st.type, self(), N]),
- exit(toomuch); % XXX or {error, Reason}?
-recv_loop([{Tag, N}| Cmds], F, St) ->
- case F(St) of
- {ok, Len} ->
- NSt = St#st{active = new_active(St#st.active)},
- if
- Len == N ->
- pre_main_loop(Cmds, NSt);
- true ->
- ?debug("#### ~w -> ~w~n",
- [{NSt#st.type, self(), NSt#st.sock, NSt#st.port,
- NSt#st.peer, NSt#st.active}, {Tag, N - Len}]),
- recv_loop([{Tag, N - Len}| Cmds], F, NSt)
- end;
- {error, Reason} ->
- ?error("#### ~w(~w) in recv_loop: error: ~w, ~w bytes remain~n",
- [St#st.type, self(), Reason, N]),
- exit(Reason)
- end.
-
-new_active(once) ->
- false;
-new_active(A) ->
- A.
-
-get_active(St) ->
- A = case proplists:get_value(active, St#st.sockopts, undefined) of
- undefined ->
- Mod = case St#st.protomod of
- ssl ->
- ssl;
- gen_tcp ->
- inet
- end,
- {ok, [{active, Ax}]} = Mod:getopts(St#st.sock, [active]),
- Ax;
- Ay ->
- Ay
- end,
- ?debug("#### ~w(~w) get_active: ~p\n", [St#st.type, self(), A]),
- St#st{active = A}.
-
-
-%%
-%% SOCKET FUNCTIONS
-%%
-
-%%
-%% ssl
-%%
-
-%%
-%% listen(St, LPort) -> {ok, LSock} | {error, Reason}
-%%
-listen(St, LPort) ->
- case St#st.protomod of
- ssl ->
- ssl:listen(LPort, [{ssl_imp, old} | St#st.sockopts ++ St#st.sslopts]);
- gen_tcp ->
- gen_tcp:listen(LPort, St#st.sockopts)
- end.
-
-%%
-%% accept(St) -> {ok, Sock} | {error, Reason}
-%%
-accept(St) ->
- case St#st.protomod of
- ssl ->
- case ssl:transport_accept(St#st.lsock, St#st.timeout) of
- {ok, Sock} ->
- case ssl:ssl_accept(Sock, St#st.timeout) of
- ok ->
- {ok, Port} = ssl:sockname(Sock),
- {ok, Peer} = ssl:peername(Sock),
- {ok, Sock, Port, Peer};
- Other ->
- Other
- end;
- Other ->
- Other
- end;
- gen_tcp ->
- case gen_tcp:accept(St#st.lsock, St#st.timeout) of
- {ok, Sock} ->
- {ok, Port} = inet:port(Sock),
- {ok, Peer} = inet:peername(Sock),
- {ok, Sock, Port, Peer};
- Other ->
- Other
- end
- end.
-
-%%
-%% connect(St, Host, Port) -> {ok, Sock} | {error, Reason}
-%%
-connect(St, Host, Port) ->
-
- case St#st.protomod of
- ssl ->
- case ssl:connect(Host, Port,
- [{ssl_imp, old} | St#st.sockopts ++ St#st.sslopts],
- St#st.timeout) of
- {ok, Sock} ->
- {ok, LPort} = ssl:sockname(Sock),
- {ok, Peer} = ssl:peername(Sock),
- {ok, Sock, LPort, Peer};
- Other ->
- Other
- end;
- gen_tcp ->
- case gen_tcp:connect(Host, Port, St#st.sockopts, St#st.timeout) of
- {ok, Sock} ->
- {ok, LPort} = inet:port(Sock),
- {ok, Peer} = inet:peername(Sock),
- {ok, Sock, LPort, Peer};
- Other ->
- Other
- end
- end.
-
-%%
-%% peercert(St) -> {ok, Cert} | {error, Reason}
-%%
-peercert(St) ->
- case St#st.protomod of
- ssl ->
- ssl:peercert(St#st.sock, [ssl]);
- gen_tcp ->
- {ok, <<>>}
- end.
-
-%%
-%% connection_info(St) -> {ok, ProtoInfo} | {error, Reason}
-%%
-connection_info(St) ->
- case St#st.protomod of
- ssl ->
- case ssl:connection_info(St#st.sock) of
- Res = {ok, {Proto, _}} ->
- case St#st.protocols of
- [] ->
- Res;
- Protocols ->
- case lists:member(Proto, Protocols) of
- true ->
- Res;
- false ->
- {error, Proto}
- end
- end;
- Error ->
- Error
- end;
- gen_tcp ->
- {ok, <<>>}
- end.
-
-%%
-%% close(St) -> ok | {error, Reason}
-%%
-
-close(St) ->
- Mod = St#st.protomod,
- case St#st.sock of
- nil ->
- ok;
- _ ->
- Mod:close(St#st.sock)
- end.
-
-%%
-%% lclose(St) -> ok | {error, Reason}
-%%
-lclose(St) ->
- Mod = St#st.protomod,
- case St#st.lsock of
- nil ->
- ok;
- _ ->
- Mod:close(St#st.lsock)
- end.
-
-%%
-%% recv(St) = {ok, Len} | {error, Reason}
-%%
-recv(St) ->
- case do_recv(St) of
- {ok, Msg} ->
- {ok, length(Msg)};
- {error, Reason} ->
- {error, Reason}
- end.
-
-do_recv(St) when St#st.active == false ->
- %% First check that we do *not* have any ssl/gen_tcp messages in the
- %% message queue, then call the receive function.
- Sock = St#st.sock,
- case St#st.protomod of
- ssl ->
- receive
- M = {ssl, Sock, _Msg} ->
- {error, {unexpected_messagex, M}};
- M = {ssl_closed, Sock} ->
- {error, {unexpected_message, M}};
- M = {ssl_error, Sock, _Reason} ->
- {error, {unexpected_message, M}}
- after 0 ->
- ssl:recv(St#st.sock, 0, St#st.timeout)
- end;
- gen_tcp ->
- receive
- M = {tcp, Sock, _Msg} ->
- {error, {unexpected_message, M}};
- M = {tcp_closed, Sock} ->
- {error, {unexpected_message, M}};
- M = {tcp_error, Sock, _Reason} ->
- {error, {unexpected_message, M}}
- after 0 ->
- gen_tcp:recv(St#st.sock, 0, St#st.timeout)
- end
- end;
-do_recv(St) ->
- Sock = St#st.sock,
- Timeout = St#st.timeout,
- case St#st.protomod of
- ssl ->
- receive
- {ssl, Sock, Msg} ->
- {ok, Msg};
- {ssl_closed, Sock} ->
- {error, closed};
- {ssl_error, Sock, Reason} ->
- {error, Reason}
- after Timeout ->
- {error, timeout}
- end;
- gen_tcp ->
- receive
- {tcp, Sock, Msg} ->
- {ok, Msg};
- {tcp_closed, Sock} ->
- {error, closed};
- {tcp_error, Sock, Reason} ->
- {error, Reason}
- after Timeout ->
- {error, timeout}
- end
- end.
-
-%%
-%% echo(St) = {ok, Len} | {error, Reason}
-%%
-echo(St) ->
- Sock = St#st.sock,
- case do_recv(St) of
- {ok, Msg} ->
- Mod = St#st.protomod,
- case Mod:send(Sock, Msg) of
- ok ->
- {ok, length(Msg)};
- {error, Reason} ->
- {error, Reason}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
-
-%%
-%% send(St, Msg) -> ok | {error, Reason}
-%%
-send(St, Msg) ->
- Mod = St#st.protomod,
- Mod:send(St#st.sock, Msg).
-
-%%
-%% await_close(St) -> ok | {error, Reason}
-%%
-await_close(St) when St#st.active == false ->
- %% First check that we do *not* have any ssl/gen_tcp messages in the
- %% message queue, then call the receive function.
- Sock = St#st.sock,
- Res = case St#st.protomod of
- ssl ->
- receive
- M = {ssl, Sock, _Msg0} ->
- {error, {unexpected_message, M}};
- M = {ssl_closed, Sock} ->
- {error, {unexpected_message, M}};
- M = {ssl_error, Sock, _Reason} ->
- {error, {unexpected_message, M}}
- after 0 ->
- ok
- end;
- gen_tcp ->
- receive
- M = {tcp, Sock, _Msg0} ->
- {error, {unexpected_message, M}};
- M = {tcp_closed, Sock} ->
- {error, {unexpected_message, M}};
- M = {tcp_error, Sock, _Reason} ->
- {error, {unexpected_message, M}}
- after 0 ->
- ok
- end
- end,
- case Res of
- ok ->
- Mod = St#st.protomod,
- case Mod:recv(St#st.sock, 0, St#st.timeout) of
- {ok, _Msg} ->
- {error, toomuch};
- {error, _} ->
- ok
- end;
- _ ->
- Res
- end;
-await_close(St) ->
- Sock = St#st.sock,
- Timeout = St#st.timeout,
- case St#st.protomod of
- ssl ->
- receive
- {ssl, Sock, _Msg} ->
- {error, toomuch};
- {ssl_closed, Sock} ->
- ok;
- {ssl_error, Sock, Reason} ->
- {error, Reason}
- after Timeout ->
- {error, timeout}
- end;
- gen_tcp ->
- receive
- {tcp, Sock, _Msg} ->
- {error, toomuch};
- {tcp_closed, Sock} ->
- ok;
- {tcp_error, Sock, Reason} ->
- {error, Reason}
- after Timeout ->
- {error, timeout}
- end
- end.
-
-
-%%
-%% HELP FUNCTIONS
-%%
-
-wait_ack(_, [], _) ->
- ok;
-wait_ack(AccPids0, Pids, Timeout) ->
- ?debug("#### CONTROLLER: waiting for ~w~n", [Pids]),
- receive
- {one_accept_done, Pid} ->
- case lists:delete(Pid, AccPids0) of
- [] ->
- wait_ack([], Pids, Timeout);
- [AccPid| AccPids1] ->
- AccPid ! {continue_accept, self()},
- wait_ack(AccPids1, Pids, Timeout)
- end;
- {'EXIT', Pid, normal} ->
- wait_ack(AccPids0, lists:delete(Pid, Pids), Timeout);
- {'EXIT', Pid, Reason} ->
- ?error("#### CONTROLLER got abnormal exit: ~w, ~w~n",
- [Pid, Reason]),
- {error, Reason}
- after Timeout ->
- ?error("#### CONTROLLER exiting because of timeout = ~w~n",
- [Timeout]),
- {error, Timeout}
- end.
-
-
-%%
-%% ack_lsock(Pid, LSock)
-%%
-ack_lsock(Pid, LSock) ->
- Pid ! {lsock, self(), LSock}.
-
-wait_lsock(Pid, Timeout) ->
- receive
- {lsock, Pid, LSock} ->
- {ok, LSock}
- after Timeout ->
- exit(timeout)
- end.
-
-%%
-%% sync(Pids)
-%%
-sync(Pids) ->
- lists:foreach(fun (Pid) -> Pid ! {self(), sync} end, Pids).
-
-%%
-%% wait_sync(St)
-%%
-wait_sync(St) ->
- Pid = St#st.parent,
- receive
- {Pid, sync} ->
- ok
- end.
-
-%%
-%% wait(Time)
-%%
-wait(Time) ->
- receive
- after Time ->
- ok
- end.
-
-%%
-%% mk_msg(Size)
-%%
-mk_msg(Size) ->
- mk_msg(0, Size, []).
-
-mk_msg(_, 0, Acc) ->
- Acc;
-mk_msg(Pos, Size, Acc) ->
- C = (((Pos + Size) rem 256) - 1) band 255,
- mk_msg(Pos, Size - 1, [C| Acc]).
-
-%%
-%% get_protomod(Config)
-%%
-get_protomod(Config) ->
- case lists:keysearch(protomod, 1, Config) of
- {value, {_, ProtoMod}} ->
- ProtoMod;
- false ->
- ssl
- end.
-
-%%
-%% get_serialize_accept(Config)
-%%
-get_serialize_accept(Config) ->
- case lists:keysearch(serialize_accept, 1, Config) of
- {value, {_, Val}} ->
- Val;
- false ->
- false
- end.
-
diff --git a/lib/ssl/test/ssl_test_MACHINE.hrl b/lib/ssl/test/ssl_test_MACHINE.hrl
deleted file mode 100644
index e78b33f505..0000000000
--- a/lib/ssl/test/ssl_test_MACHINE.hrl
+++ /dev/null
@@ -1,39 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2010. 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%
-%%
-
--record(st, {protomod = ssl,
- serialize_accept = false,
- parent = nil,
- type = nil,
- active = nil,
- port = 0,
- peer = nil,
- lsock = nil,
- sock = nil,
- timeout = infinity,
- sockopts = [],
- sslopts = [],
- protocols = []}).
-
-%%-define(debug(X, Y), io:format(X, Y)).
--define(debug(X, Y), ok).
--define(error(X, Y), io:format(X, Y)).
-
--define(DEFAULT_TIMEOUT, 240000).
-
diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml
index 6f3ed7af98..7042c84437 100644
--- a/lib/stdlib/doc/src/lists.xml
+++ b/lib/stdlib/doc/src/lists.xml
@@ -240,7 +240,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keydelete" arity="3"/>
<fsummary>Delete an element from a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a copy of <c><anno>TupleList1</anno></c> where the first
occurrence of a tuple whose <c><anno>N</anno></c>th element compares equal to
@@ -266,7 +266,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keymap" arity="3"/>
<fsummary>Map a function over a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a list of tuples where, for each tuple in
<c><anno>TupleList1</anno></c>, the <c><anno>N</anno></c>th element <c><anno>Term1</anno></c> of the tuple
@@ -298,7 +298,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keymerge" arity="3"/>
<fsummary>Merge two key-sorted lists of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c>
and <c><anno>TupleList2</anno></c>. The merge is performed on
@@ -312,7 +312,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keyreplace" arity="4"/>
<fsummary>Replace an element in a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a copy of <c><anno>TupleList1</anno></c> where the first
occurrence of a <c>T</c> tuple whose <c><anno>N</anno></c>th element
@@ -342,7 +342,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keysort" arity="2"/>
<fsummary>Sort a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a list containing the sorted elements of the list
<c><anno>TupleList1</anno></c>. Sorting is performed on the <c><anno>N</anno></c>th
@@ -352,7 +352,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keystore" arity="4"/>
<fsummary>Store an element in a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a copy of <c><anno>TupleList1</anno></c> where the first
occurrence of a tuple <c>T</c> whose <c><anno>N</anno></c>th element
@@ -366,7 +366,7 @@ flatmap(Fun, List1) ->
<func>
<name name="keytake" arity="3"/>
<fsummary>Extract an element from a list of tuples</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Searches the list of tuples <c><anno>TupleList1</anno></c> for a tuple
whose <c><anno>N</anno></c>th element compares equal to <c><anno>Key</anno></c>.
@@ -500,7 +500,7 @@ flatmap(Fun, List1) ->
<func>
<name name="nth" arity="2"/>
<fsummary>Return the Nth element of a list</fsummary>
- <type_desc variable="N">1..length(List)</type_desc>
+ <type_desc variable="N">1..length(<anno>List</anno>)</type_desc>
<desc>
<p>Returns the <c><anno>N</anno></c>th element of <c><anno>List</anno></c>. For example:</p>
<pre>
@@ -511,7 +511,7 @@ c</pre>
<func>
<name name="nthtail" arity="2"/>
<fsummary>Return the Nth tail of a list</fsummary>
- <type_desc variable="N">0..length(List)</type_desc>
+ <type_desc variable="N">0..length(<anno>List</anno>)</type_desc>
<desc>
<p>Returns the <c><anno>N</anno></c>th tail of <c><anno>List</anno></c>, that is, the sublist of
<c><anno>List</anno></c> starting at <c><anno>N</anno>+1</c> and continuing up to
@@ -630,7 +630,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr</code>
<func>
<name name="split" arity="2"/>
<fsummary>Split a list into two lists</fsummary>
- <type_desc variable="N">0..length(List1)</type_desc>
+ <type_desc variable="N">0..length(<anno>List1</anno>)</type_desc>
<desc>
<p>Splits <c><anno>List1</anno></c> into <c><anno>List2</anno></c> and <c><anno>List3</anno></c>.
<c><anno>List2</anno></c> contains the first <c><anno>N</anno></c> elements and
@@ -670,7 +670,7 @@ splitwith(Pred, List) ->
<func>
<name name="sublist" arity="3"/>
<fsummary>Return a sub-list starting at a given position and with a given number of elements</fsummary>
- <type_desc variable="Start">1..(length(List1)+1)</type_desc>
+ <type_desc variable="Start">1..(length(<anno>List1</anno>)+1)</type_desc>
<desc>
<p>Returns the sub-list of <c><anno>List1</anno></c> starting at <c><anno>Start</anno></c>
and with (max) <c><anno>Len</anno></c> elements. It is not an error for
@@ -732,7 +732,7 @@ splitwith(Pred, List) ->
<func>
<name name="ukeymerge" arity="3"/>
<fsummary>Merge two key-sorted lists of tuples, removing duplicates</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c>
and <c><anno>TupleList2</anno></c>. The merge is performed on the
@@ -746,7 +746,7 @@ splitwith(Pred, List) ->
<func>
<name name="ukeysort" arity="2"/>
<fsummary>Sort a list of tuples, removing duplicates</fsummary>
- <type_desc variable="N">1..tuple_size(Tuple)</type_desc>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns a list containing the sorted elements of the list
<c><anno>TupleList1</anno></c> where all but the first tuple of the
diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml
index 93affc3191..1b8fa44883 100644
--- a/lib/stdlib/doc/src/random.xml
+++ b/lib/stdlib/doc/src/random.xml
@@ -136,6 +136,11 @@
<c>random_seed</c> to remember the current seed.</p>
<p>If a process calls <c>uniform/0</c> or <c>uniform/1</c> without
setting a seed first, <c>seed/0</c> is called automatically.</p>
+ <p>The implementation changed in R15. Upgrading to R15 will break
+ applications that expect a specific output for a given seed. The output
+ is still deterministic number series, but different compared to releases
+ older than R15. The seed <c>{0,0,0}</c> will for example no longer
+ produce a flawed series of only zeros.</p>
</section>
</erlref>
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index fa0641ffd9..c0f9ce34b0 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) ->
%%% Internal functions
%%%----------------------------------------------------------------------
-constants(FH, FileName) ->
- Version = FH#fileheader.version,
- if
- Version =< 8 ->
- dets_v8:constants();
- Version =:= 9 ->
- dets_v9:constants();
- true ->
- throw({error, {not_a_dets_file, FileName}})
- end.
-
%% -> {ok, Fd, fileheader()} | throw(Error)
read_file_header(FileName, Access, RamFile) ->
BF = if
@@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) ->
{H2, {error, old_version}};
Parms ->
L = dets_utils:all_allocated(H2),
- C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L},
+ Bin = if
+ L =:= <<>> -> eof;
+ true -> <<>>
+ end,
+ C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L},
BinParms = term_to_binary(Parms),
{H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk},
[BinParms]}}
@@ -2475,10 +2468,23 @@ fopen2(Fname, Tab) ->
%% Fd is not always closed upon error, but exit is soon called.
{ok, Fd, FH} = read_file_header(Fname, Acc, Ram),
Mod = FH#fileheader.mod,
- case Mod:check_file_header(FH, Fd) of
- {error, not_closed} ->
- io:format(user,"dets: file ~p not properly closed, "
- "repairing ...~n", [Fname]),
+ Do = case Mod:check_file_header(FH, Fd) of
+ {ok, Head1, ExtraInfo} ->
+ Head2 = Head1#head{filename = Fname},
+ try {ok, Mod:init_freelist(Head2, ExtraInfo)}
+ catch
+ throw:_ ->
+ {repair, " has bad free lists, repairing ..."}
+ end;
+ {error, not_closed} ->
+ M = " not properly closed, repairing ...",
+ {repair, M};
+ Else ->
+ Else
+ end,
+ case Do of
+ {repair, Mess} ->
+ io:format(user, "dets: file ~p~s~n", [Fname, Mess]),
Version = default,
case fsck(Fd, Tab, Fname, FH, default, default, Version) of
ok ->
@@ -2486,9 +2492,9 @@ fopen2(Fname, Tab) ->
Error ->
throw(Error)
end;
- {ok, Head, ExtraInfo} ->
+ {ok, Head} ->
open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE,
- Tab, ExtraInfo, false);
+ Tab, false);
{error, Reason} ->
throw({error, {Reason, Fname}})
end;
@@ -2520,12 +2526,13 @@ fopen_existing_file(Tab, OpenArgs) ->
V9 = (Version =:= 9) or (Version =:= default),
MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots),
MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots),
- Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of
+ Mod = (FH#fileheader.mod),
+ Wh = case Mod:check_file_header(FH, Fd) of
{ok, Head, true} when Rep =:= force, Acc =:= read_write,
FH#fileheader.version =:= 9,
FH#fileheader.no_colls =/= undefined,
MinF, MaxF, V9 ->
- {compact, Head};
+ {compact, Head, true};
{ok, _Head, _Extra} when Rep =:= force, Acc =:= read ->
throw({error, {access_mode, Fname}});
{ok, Head, need_compacting} when Acc =:= read ->
@@ -2555,6 +2562,17 @@ fopen_existing_file(Tab, OpenArgs) ->
{error, Reason} ->
throw({error, {Reason, Fname}})
end,
+ Do = case Wh of
+ {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact ->
+ Hd1 = Hd#head{filename = Fname},
+ try {Tag, Mod:init_freelist(Hd1, Extra)}
+ catch
+ throw:_ ->
+ {repair, " has bad free lists, repairing ..."}
+ end;
+ Else ->
+ Else
+ end,
case Do of
_ when FH#fileheader.type =/= Type ->
throw({error, {type_mismatch, Fname}});
@@ -2563,8 +2581,7 @@ fopen_existing_file(Tab, OpenArgs) ->
{compact, SourceHead} ->
io:format(user, "dets: file ~p is now compacted ...~n", [Fname]),
{ok, NewSourceHead} = open_final(SourceHead, Fname, read, false,
- ?DEFAULT_CACHE, Tab, true,
- Debug),
+ ?DEFAULT_CACHE, Tab, Debug),
case catch compact(NewSourceHead) of
ok ->
erlang:garbage_collect(),
@@ -2584,9 +2601,9 @@ fopen_existing_file(Tab, OpenArgs) ->
Version, OpenArgs);
_ when FH#fileheader.version =/= Version, Version =/= default ->
throw({error, {version_mismatch, Fname}});
- {final, H, EI} ->
+ {final, H} ->
H1 = H#head{auto_save = Auto},
- open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug)
+ open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug)
end.
do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) ->
@@ -2600,19 +2617,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) ->
end.
%% -> {ok, head()} | throw(Error)
-open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) ->
+open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) ->
Head1 = Head#head{access = Acc,
ram_file = Ram,
filename = Fname,
name = Tab,
cache = dets_utils:new_cache(CacheSz)},
init_disk_map(Head1#head.version, Tab, Debug),
- Mod = Head#head.mod,
- Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next),
- Ftab = Mod:init_freelist(Head1, ExtraInfo),
+ (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next),
check_growth(Head1),
- NewHead = Head1#head{freelists = Ftab},
- {ok, NewHead}.
+ {ok, Head1}.
%% -> {ok, head()} | throw(Error)
fopen_init_file(Tab, OpenArgs) ->
@@ -3139,8 +3153,12 @@ init_scan(Head, NoObjs) ->
check_safe_fixtable(Head),
FreeLists = dets_utils:get_freelists(Head),
Base = Head#head.base,
- {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base),
- #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}.
+ case dets_utils:find_next_allocated(FreeLists, Base, Base) of
+ {From, To} ->
+ #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}};
+ none ->
+ #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>}
+ end.
check_safe_fixtable(Head) ->
case (Head#head.fixed =:= false) andalso
@@ -3241,18 +3259,20 @@ view(FileName) ->
case catch read_file_header(FileName, read, false) of
{ok, Fd, FH} ->
Mod = FH#fileheader.mod,
- case Mod:check_file_header(FH, Fd) of
- {ok, H0, ExtraInfo} ->
- Ftab = Mod:init_freelist(H0, ExtraInfo),
- {_Bump, Base} = constants(FH, FileName),
- H = H0#head{freelists=Ftab, base = Base},
- v_free_list(H),
- Mod:v_segments(H),
- file:close(Fd);
- X ->
- file:close(Fd),
- X
- end;
+ try Mod:check_file_header(FH, Fd) of
+ {ok, H0, ExtraInfo} ->
+ Mod = FH#fileheader.mod,
+ case Mod:check_file_header(FH, Fd) of
+ {ok, H0, ExtraInfo} ->
+ H = Mod:init_freelist(H0, ExtraInfo),
+ v_free_list(H),
+ Mod:v_segments(H),
+ ok;
+ X ->
+ X
+ end
+ after file:close(Fd)
+ end;
X ->
X
end.
diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl
index fbffc9d008..a3f99357a2 100644
--- a/lib/stdlib/src/dets.hrl
+++ b/lib/stdlib/src/dets.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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
@@ -92,6 +92,7 @@
%% Info extracted from the file header.
-record(fileheader, {
freelist,
+ fl_base,
cookie,
closed_properly,
type,
diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl
index cdd38d5604..3e962a1c8b 100644
--- a/lib/stdlib/src/dets_v8.erl
+++ b/lib/stdlib/src/dets_v8.erl
@@ -21,7 +21,7 @@
%% Dets files, implementation part. This module handles versions up to
%% and including 8(c). To be called from dets.erl only.
--export([constants/0, mark_dirty/1, read_file_header/2,
+-export([mark_dirty/1, read_file_header/2,
check_file_header/2, do_perform_save/1, initiate_file/11,
init_freelist/2, fsck_input/4,
bulk_input/3, output_objs/4, write_cache/1, may_grow/3,
@@ -196,10 +196,6 @@
%%-define(DEBUGF(X,Y), io:format(X, Y)).
-define(DEBUGF(X,Y), void).
-%% {Bump}
-constants() ->
- {?BUMP, ?BASE}.
-
%% -> ok | throw({NewHead,Error})
mark_dirty(Head) ->
Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}],
@@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) ->
Pos = Head#head.freelists_p,
case catch prterm(Head, Pos, ?OHDSZ) of
{0, _Sz, Term} ->
- FreeList = lists:reverse(Term),
- dets_utils:init_slots_from_old_file(FreeList, Ftab);
+ FreeList1 = lists:reverse(Term),
+ FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab),
+ Head#head{freelists = FreeList, base = ?BASE};
_ ->
throw({error, {bad_freelists, Head#head.filename}})
end;
@@ -318,7 +315,7 @@ init_freelist(Head, _) ->
Pos = Head#head.freelists_p,
case catch prterm(Head, Pos, ?OHDSZ) of
{0, _Sz, Term} ->
- Term;
+ Head#head{freelists = Term, base = ?BASE};
_ ->
throw({error, {bad_freelists, Head#head.filename}})
end.
@@ -331,6 +328,7 @@ read_file_header(Fd, FileName) ->
{ok, EOF} = dets_utils:position_close(Fd, FileName, eof),
{ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4),
FH = #fileheader{freelist = Freelist,
+ fl_base = ?BASE,
cookie = Cookie,
closed_properly = CP,
type = dets_utils:code_to_type(Type2),
@@ -413,7 +411,7 @@ check_file_header(FH, Fd) ->
version = ?FILE_FORMAT_VERSION,
mod = ?MODULE,
bump = ?BUMP,
- base = ?BASE},
+ base = FH#fileheader.fl_base},
{ok, H, ExtraInfo};
Error ->
Error
diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl
index 132af01f79..f577b4410f 100644
--- a/lib/stdlib/src/dets_v9.erl
+++ b/lib/stdlib/src/dets_v9.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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
@@ -21,7 +21,7 @@
%% Dets files, implementation part. This module handles version 9.
%% To be called from dets.erl only.
--export([constants/0, mark_dirty/1, read_file_header/2,
+-export([mark_dirty/1, read_file_header/2,
check_file_header/2, do_perform_save/1, initiate_file/11,
prep_table_copy/9, init_freelist/2, fsck_input/4,
bulk_input/3, output_objs/4, bchunk_init/2,
@@ -70,6 +70,17 @@
%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum.
%% (FreelistsPointer, Cookie and ClosedProperly are not digested.)
%% 128 Reserved for future versions. Initially zeros.
+%% Version 9(d), introduced in R15A, has instead:
+%% 112 28 counters for the buddy system sizes (as for 9(b)).
+%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum.
+%% (FreelistsPointer, Cookie and ClosedProperly are not digested.)
+%% 4 Base of the buddy system.
+%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B.
+%% File size at the end of the file is RealFileSize - Base.
+%% The reason for modifying file size is that when a file created
+%% by R15 is read by R14 a repair takes place immediately, which
+%% is acceptable when downgrading.
+%% 124 Reserved for future versions. Initially zeros.
%% ---
%% ------------------ end of file header
%% 4*256 SegmentArray Pointers.
@@ -86,7 +97,7 @@
%% -----------------------------
%% ??? Free lists
%% -----------------------------
-%% 4 File size, in bytes.
+%% 4 File size, in bytes. See 9(d) obove.
%% Before we can find an object we must find the slot where the
%% object resides. Each slot is a (possibly empty) list (or chain) of
@@ -177,14 +188,14 @@
%%% File header
%%%
--define(RESERVED, 128). % Reserved for future use.
+-define(RESERVED, 124). % Reserved for future use.
-define(COLL_CNTRS, (28*4)). % Counters for the buddy system.
-define(MD5SZ, 16).
+-define(FL_BASE, 4).
--define(HEADSZ,
- 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes,
- % not including the reserved part.
+-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes,
+ +?MD5SZ+?FL_BASE). % not including the reserved part.
-define(HEADEND, (?HEADSZ+?RESERVED)).
% End of header and reserved area.
-define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP.
@@ -270,10 +281,6 @@
%%-define(DEBUGF(X,Y), io:format(X, Y)).
-define(DEBUGF(X,Y), void).
-%% {Bump}
-constants() ->
- {?BUMP, ?BASE}.
-
%% -> ok | throw({NewHead,Error})
mark_dirty(Head) ->
Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}],
@@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz,
cache = dets_utils:new_cache(CacheSz),
version = ?FILE_FORMAT_VERSION,
bump = ?BUMP,
- base = ?BASE,
+ base = ?BASE, % to be overwritten
mod = ?MODULE
},
@@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz,
{Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []),
NoSegs = no_segs(Next),
- {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []),
+ {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []),
Ws2 = if
DoInitSegments -> WsP ++ WsI;
true -> WsP
end,
dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]),
- true = hash_invars(Head),
+ true = hash_invars(Head2),
+ %% The allocations that have been made so far (parts, segments)
+ %% are permanent; the table will never shrink. Therefore the base
+ %% of the Buddy system can be set to the first free object.
+ %% This is used in allocate_all(), see below.
+ {_, Where, _} = dets_utils:alloc(Head2, ?BUMP),
+ NewFtab = dets_utils:init_alloc(Where),
+ Head = Head2#head{freelists = NewFtab, base = Where},
{ok, Head}.
%% Returns a power of two not less than 256.
@@ -451,8 +465,9 @@ read_file_header(Fd, FileName) ->
Version:32, M:32, Next:32, Kp:32,
NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32,
HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary,
- MD5:?MD5SZ/binary>> = Bin,
- <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin,
+ MD5:?MD5SZ/binary, FlBase:32>> = Bin,
+ <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary,
+ _/binary>> = Bin,
{ok, EOF} = dets_utils:position_close(Fd, FileName, eof),
{ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4),
{CL, <<>>} = lists:foldl(fun(LSz, {Acc,<<NN:32,R/binary>>}) ->
@@ -468,8 +483,12 @@ read_file_header(Fd, FileName) ->
true ->
lists:reverse(CL)
end,
-
+ Base = case FlBase of
+ 0 -> ?BASE;
+ _ -> FlBase
+ end,
FH = #fileheader{freelist = FreeList,
+ fl_base = Base,
cookie = Cookie,
closed_properly = CP,
type = dets_utils:code_to_type(Type2),
@@ -486,7 +505,7 @@ read_file_header(Fd, FileName) ->
read_md5 = MD5,
has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5,
md5 = erlang:md5(MD5DigestedPart),
- trailer = FileSize,
+ trailer = FileSize + FlBase,
eof = EOF,
n = N,
mod = ?MODULE},
@@ -544,7 +563,7 @@ check_file_header(FH, Fd) ->
version = ?FILE_FORMAT_VERSION,
mod = ?MODULE,
bump = ?BUMP,
- base = ?BASE},
+ base = FH#fileheader.fl_base},
{ok, H, ExtraInfo};
Error ->
Error
@@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) ->
write_loop(Head, BytesToWrite, SmallBin).
%% By allocating bigger objects before smaller ones, holes in the
-%% buddy system memory map are avoided. Unfortunately, the segments
-%% are always allocated first, so if there are objects bigger than a
-%% segment, there is a hole to handle. (Haven't considered placing the
-%% segments among other objects of the same size.)
+%% buddy system memory map are avoided.
allocate_all_objects(Head, SizeT) ->
DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))),
MaxSz = element(1, hd(DTL)),
- SegSize = ?ACTUAL_SEG_SIZE,
- {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize),
- {Head2, NL} = allocate_all(Head1, DTL, []),
+ {Head1, NL} = allocate_all(Head, DTL, []),
%% Find the position that will be the end of the file by allocating
%% a minimal object.
- {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP),
- Head3 = free_hole(Head2, HSz, HN, HA),
- NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)},
+ {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP),
+ NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)},
{NewHead, NL, MaxSz, EndOfFile}.
-alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz ->
- Size = ?POW(LSize-1),
- {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)),
- {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)),
- N = (Addr - SegAddr) div SegSz,
- Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr),
- {Head1, SegSz, N, SegAddr};
-alloc_hole(_MaxSz, Head, _SegSz) ->
- {Head, 0, 0, 0}.
-
-free_hole(Head, _Size, 0, _Addr) ->
- Head;
-free_hole(Head, Size, N, Addr) ->
- {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)),
- free_hole(Head1, Size, N-1, Addr+Size).
-
%% One (temporary) file for each buddy size, write all objects of that
%% size to the file.
+%%
+%% Before R15 a "hole" was needed before the first bucket if the size
+%% of the biggest bucket was greater than the size of a segment. The
+%% hole proved to be a problem with almost full tables with huge
+%% buckets. Since R15 the hole is no longer needed due to the fact
+%% that the base of the Buddy system is flexible.
allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) ->
%% And one file for the segments...
%% Note that space for the array parts and the segments has
@@ -1593,23 +1596,28 @@ do_perform_save(H) ->
H1 = H#head{freelists_p = FreeListsPointer},
{FLW, FLSize} = free_lists_to_file(H1),
FileSize = FreeListsPointer + FLSize + 4,
- ok = dets_utils:write(H1, [FLW | <<FileSize:32>>]),
+ AdjustedFileSize = case H#head.base of
+ ?BASE -> FileSize;
+ Base -> FileSize - Base
+ end,
+ ok = dets_utils:write(H1, [FLW | <<AdjustedFileSize:32>>]),
FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY),
case dets_utils:debug_mode() of
true ->
- TmpHead = H1#head{freelists = init_freelist(H1, true),
- fixed = false},
+ TmpHead0 = init_freelist(H1#head{fixed = false}, true),
+ TmpHead = TmpHead0#head{base = H1#head.base},
case
catch dets_utils:all_allocated_as_list(TmpHead)
=:= dets_utils:all_allocated_as_list(H1)
- of
+ of
true ->
dets_utils:pwrite(H1, [{0, FileHeader}]);
_ ->
+ throw(
dets_utils:corrupt_reason(H1, {failed_to_save_free_lists,
FreeListsPointer,
TmpHead#head.freelists,
- H1#head.freelists})
+ H1#head.freelists}))
end;
false ->
dets_utils:pwrite(H1, [{0, FileHeader}])
@@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) ->
true -> erlang:md5(DigH);
false -> <<0:?MD5SZ/unit:8>>
end,
- [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>].
+ Base = case Head#head.base of
+ ?BASE -> <<0:32>>;
+ FlBase -> <<FlBase:32>>
+ end,
+ [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>].
%% Going through some trouble to avoid creating one single binary for
%% the free lists. If the free lists are huge, binary_to_term and
@@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) ->
case catch bin_to_tree([], H, start, FL, -1, []) of
{'EXIT', _} ->
throw({error, {bad_freelists, H#head.filename}});
- Reply ->
- Reply
+ Ftab ->
+ H#head{freelists = Ftab, base = ?BASE}
end.
bin_to_tree(Bin, H, LastPos, Ftab, A0, L) ->
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index dd0b9bc2ab..78b996d94b 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -123,6 +123,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
called= [] :: [{fa(),line()}], %Called functions
usage = #usage{} :: #usage{},
specs = dict:new() :: dict(), %Type specifications
+ callbacks = dict:new() :: dict(), %Callback types
types = dict:new() :: dict(), %Type definitions
exp_types=gb_sets:empty():: gb_set() %Exported types
}).
@@ -310,8 +311,6 @@ format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) ->
format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}) ->
io_lib:format("undefined callback function ~w/~w (behaviour '~w')",
[Func,Arity,Behaviour]);
-format_error({undefined_behaviour_func, {Func,Arity,_Spec}, Behaviour}) ->
- format_error({undefined_behaviour_func, {Func,Arity}, Behaviour});
format_error({undefined_behaviour,Behaviour}) ->
io_lib:format("behaviour ~w undefined", [Behaviour]);
format_error({undefined_behaviour_callbacks,Behaviour}) ->
@@ -320,6 +319,9 @@ format_error({undefined_behaviour_callbacks,Behaviour}) ->
format_error({ill_defined_behaviour_callbacks,Behaviour}) ->
io_lib:format("behaviour ~w callback functions erroneously defined",
[Behaviour]);
+format_error({behaviour_info, {_M,F,A}}) ->
+ io_lib:format("cannot define callback attibute for ~w/~w when "
+ "behaviour_info is defined",[F,A]);
%% --- types and specs ---
format_error({singleton_typevar, Name}) ->
io_lib:format("type variable ~w is only used once (is unbound)", [Name]);
@@ -348,12 +350,16 @@ format_error({type_syntax, Constr}) ->
io_lib:format("bad ~w type", [Constr]);
format_error({redefine_spec, {M, F, A}}) ->
io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]);
+format_error({redefine_callback, {M, F, A}}) ->
+ io_lib:format("callback ~w:~w/~w already defined", [M, F, A]);
format_error({spec_fun_undefined, {M, F, A}}) ->
io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]);
format_error({missing_spec, {F,A}}) ->
io_lib:format("missing specification for function ~w/~w", [F, A]);
format_error(spec_wrong_arity) ->
"spec has the wrong arity";
+format_error(callback_wrong_arity) ->
+ "callback has the wrong arity";
format_error({imported_predefined_type, Name}) ->
io_lib:format("referring to built-in type ~w as a remote type; "
"please take out the module name", [Name]);
@@ -747,6 +753,8 @@ attribute_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) ->
type_def(opaque, L, TypeName, TypeDef, Args, St);
attribute_state({attribute,L,spec,{Fun,Types}}, St) ->
spec_decl(L, Fun, Types, St);
+attribute_state({attribute,L,callback,{Fun,Types}}, St) ->
+ callback_decl(L, Fun, Types, St);
attribute_state({attribute,L,on_load,Val}, St) ->
on_load(L, Val, St);
attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others
@@ -840,7 +848,8 @@ post_traversal_check(Forms, St0) ->
StB = check_unused_types(Forms, StA),
StC = check_untyped_records(Forms, StB),
StD = check_on_load(StC),
- check_unused_records(Forms, StD).
+ StE = check_unused_records(Forms, StD),
+ check_callback_information(StE).
%% check_behaviour(State0) -> State
%% Check that the behaviour attribute is valid.
@@ -1139,6 +1148,23 @@ check_unused_records(Forms, St0) ->
St0
end.
+check_callback_information(#lint{callbacks = Callbacks,
+ defined = Defined} = State) ->
+ case gb_sets:is_member({behaviour_info,1}, Defined) of
+ false -> State;
+ true ->
+ case dict:size(Callbacks) of
+ 0 -> State;
+ _ ->
+ CallbacksList = dict:to_list(Callbacks),
+ FoldL =
+ fun({Fa,Line},St) ->
+ add_error(Line, {behaviour_info, Fa}, St)
+ end,
+ lists:foldl(FoldL, State, CallbacksList)
+ end
+ end.
+
%% For storing the import list we use the orddict module.
%% We know an empty set is [].
@@ -2770,6 +2796,20 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
false -> check_specs(TypeSpecs, Arity, St1)
end.
+%% callback_decl(Line, Fun, Types, State) -> State.
+
+callback_decl(Line, MFA0, TypeSpecs,
+ St0 = #lint{callbacks = Callbacks, module = Mod}) ->
+ MFA = case MFA0 of
+ {F, Arity} -> {Mod, F, Arity};
+ {_M, _F, Arity} -> MFA0
+ end,
+ St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)},
+ case dict:is_key(MFA, Callbacks) of
+ true -> add_error(Line, {redefine_callback, MFA}, St1);
+ false -> check_specs(TypeSpecs, Arity, St1)
+ end.
+
check_specs([FunType|Left], Arity, St0) ->
{FunType1, CTypes} =
case FunType of
@@ -3275,6 +3315,8 @@ modify_line1({attribute,L,record,{Name,Fields}}, Mf) ->
{attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}};
modify_line1({attribute,L,spec,{Fun,Types}}, Mf) ->
{attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}};
+modify_line1({attribute,L,callback,{Fun,Types}}, Mf) ->
+ {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}};
modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) ->
{attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf),
modify_line1(Args, Mf)}};
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index bd5d65a1e1..709bd83e6f 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -62,7 +62,7 @@ char integer float atom string var
'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<='
'<<' '>>'
'!' '=' '::' '..' '...'
-'spec' % helper
+'spec' 'callback' % helper
dot.
Expect 2.
@@ -77,6 +77,7 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3').
attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3').
attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4').
attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3').
+attribute -> '-' 'callback' type_spec : build_type_spec('$2', '$3').
type_spec -> spec_fun type_sigs : {'$1', '$2'}.
type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}.
@@ -549,6 +550,8 @@ Erlang code.
ErrorInfo :: error_info().
parse_form([{'-',L1},{atom,L2,spec}|Tokens]) ->
parse([{'-',L1},{'spec',L2}|Tokens]);
+parse_form([{'-',L1},{atom,L2,callback}|Tokens]) ->
+ parse([{'-',L1},{'callback',L2}|Tokens]);
parse_form(Tokens) ->
parse(Tokens).
@@ -603,7 +606,8 @@ build_typed_attribute({atom,La,Attr},_) ->
_ -> ret_err(La, "bad attribute")
end.
-build_type_spec({spec,La}, {SpecFun, TypeSpecs}) ->
+build_type_spec({Kind,La}, {SpecFun, TypeSpecs})
+ when (Kind =:= spec) or (Kind =:= callback) ->
NewSpecFun =
case SpecFun of
{atom, _, Fun} ->
@@ -617,7 +621,7 @@ build_type_spec({spec,La}, {SpecFun, TypeSpecs}) ->
%% Old style spec. Allow this for now.
{Mod,Fun,Arity}
end,
- {attribute,La,spec,{NewSpecFun, TypeSpecs}}.
+ {attribute,La,Kind,{NewSpecFun, TypeSpecs}}.
find_arity_from_specs([Spec|_]) ->
%% Use the first spec to find the arity. If all are not the same,
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index d1dd074fba..9879b76391 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -36,8 +36,6 @@
add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3,
swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]).
--export([behaviour_info/1]).
-
-export([init_it/6,
system_continue/3,
system_terminate/4,
@@ -60,14 +58,6 @@
%%% API
%%%=========================================================================
--spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}].
-
-behaviour_info(callbacks) ->
- [{init,1},{handle_event,2},{handle_call,2},{handle_info,2},
- {terminate,2},{code_change,3}];
-behaviour_info(_Other) ->
- undefined.
-
%% gen_event:start(Handler) -> {ok, Pid} | {error, What}
%% gen_event:add_handler(Handler, Mod, Args) -> ok | Other
%% gen_event:notify(Handler, Event) -> ok
@@ -78,41 +68,36 @@ behaviour_info(_Other) ->
%% gen_event:which_handler(Handler) -> [Mod]
%% gen_event:stop(Handler) -> ok
-
-%% handlers must export
-%% Mod:init(Args) -> {ok, State} | Other
-%% Mod:handle_event(Event, State) ->
-%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2}
-%% Mod:handle_info(Info, State) ->
-%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2}
-%% Mod:handle_call(Query, State) ->
-%% {ok, Reply, State'} | {remove_handler, Reply} |
-%% {swap_handler, Reply, Args1,State1,Mod2,Args2}
-%% Mod:terminate(Args, State) -> Val
-
-
-%% add_handler(H, Mod, Args) -> ok | Other
-%% Mod:init(Args) -> {ok, State} | Other
-
-%% delete_handler(H, Mod, Args) -> Val
-%% Mod:terminate(Args, State) -> Val
-
-%% notify(H, Event)
-%% Mod:handle_event(Event, State) ->
-%% {ok, State1}
-%% remove_handler
-%% Mod:terminate(remove_handler, State) is called
-%% the return value is ignored
-%% {swap_handler, Args1, State1, Mod2, Args2}
-%% State2 = Mod:terminate(Args1, State1) is called
-%% the return value is chained into the new module and
-%% Mod2:init({Args2, State2}) is called
-%% Other
-%% Mod:terminate({error, Other}, State) is called
-%% The return value is ignored
-%% call(H, Mod, Query) -> Val
-%% call(H, Mod, Query, Timeout) -> Val
-%% Mod:handle_call(Query, State) -> as above
+-callback init(InitArgs :: term()) ->
+ {ok, State :: term()} |
+ {ok, State :: term(), hibernate}.
+-callback handle_event(Event :: term(), State :: term()) ->
+ {ok, NewState :: term()} |
+ {ok, NewState :: term(), hibernate} |
+ {swap_handler, Args1 :: term(), NewState :: term(),
+ Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} |
+ remove_handler.
+-callback handle_call(Request :: term(), State :: term()) ->
+ {ok, Reply :: term(), NewState :: term()} |
+ {ok, Reply :: term(), NewState :: term(), hibernate} |
+ {swap_handler, Reply :: term(), Args1 :: term(), NewState :: term(),
+ Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} |
+ {remove_handler, Reply :: term()}.
+-callback handle_info(Info :: term(), State :: term()) ->
+ {ok, NewState :: term()} |
+ {ok, NewState :: term(), hibernate} |
+ {swap_handler, Args1 :: term(), NewState :: term(),
+ Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} |
+ remove_handler.
+-callback terminate(Args :: (term() | {stop, Reason :: term()} |
+ stop | remove_handler |
+ {error, {'EXIT', Reason :: term()}} |
+ {error, term()}),
+ State :: term()) ->
+ term().
+-callback code_change(OldVsn :: (term() | {down, term()}),
+ State :: term(), Extra :: term()) ->
+ {ok, NewState :: term()}.
%%---------------------------------------------------------------------------
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index ea21136bdb..3db8c9f4f2 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -113,8 +113,6 @@
start_timer/2,send_event_after/2,cancel_timer/1,
enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/6]).
--export([behaviour_info/1]).
-
%% Internal exports
-export([init_it/6,
system_continue/3,
@@ -128,13 +126,38 @@
%%% Interface functions.
%%% ---------------------------------------------------
--spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}].
-
-behaviour_info(callbacks) ->
- [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3},
- {terminate,3},{code_change,4}];
-behaviour_info(_Other) ->
- undefined.
+-callback init(Args :: term()) ->
+ {ok, StateName :: atom(), StateData :: term()} |
+ {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} |
+ {stop, Reason :: term()} | ignore.
+-callback handle_event(Event :: term(), StateName :: atom(),
+ StateData :: term()) ->
+ {next_state, NextStateName :: atom(), NewStateData :: term()} |
+ {next_state, NextStateName :: atom(), NewStateData :: term(),
+ timeout() | hibernate} |
+ {stop, Reason :: term(), NewStateData :: term()}.
+-callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()},
+ StateName :: atom(), StateData :: term()) ->
+ {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} |
+ {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(),
+ timeout() | hibernate} |
+ {next_state, NextStateName :: atom(), NewStateData :: term()} |
+ {next_state, NextStateName :: atom(), NewStateData :: term(),
+ timeout() | hibernate} |
+ {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} |
+ {stop, Reason :: term(), NewStateData :: term()}.
+-callback handle_info(Info :: term(), StateName :: atom(),
+ StateData :: term()) ->
+ {next_state, NextStateName :: atom(), NewStateData :: term()} |
+ {next_state, NextStateName :: atom(), NewStateData :: term(),
+ timeout() | hibernate} |
+ {stop, Reason :: normal | term(), NewStateData :: term()}.
+-callback terminate(Reason :: normal | shutdown | {shutdown, term()}
+ | term(), StateName :: atom(), StateData :: term()) ->
+ term().
+-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(),
+ StateData :: term(), Extra :: term()) ->
+ {ok, NextStateName :: atom(), NewStateData :: term()}.
%%% ---------------------------------------------------
%%% Starts a generic state machine.
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index b8ea3a4de2..dd0ef74f30 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -94,8 +94,6 @@
multi_call/2, multi_call/3, multi_call/4,
enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/5]).
--export([behaviour_info/1]).
-
%% System exports
-export([system_continue/3,
system_terminate/4,
@@ -111,13 +109,32 @@
%%% API
%%%=========================================================================
--spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}].
-
-behaviour_info(callbacks) ->
- [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2},
- {terminate,2},{code_change,3}];
-behaviour_info(_Other) ->
- undefined.
+-callback init(Args :: term()) ->
+ {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
+ {stop, Reason :: term()} | ignore.
+-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()},
+ State :: term()) ->
+ {reply, Reply :: term(), NewState :: term()} |
+ {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate} |
+ {stop, Reason :: term(), Reply :: term(), NewState :: term()} |
+ {stop, Reason :: term(), NewState :: term()}.
+-callback handle_cast(Request :: term(), State :: term()) ->
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate} |
+ {stop, Reason :: term(), NewState :: term()}.
+-callback handle_info(Info :: timeout() | term(), State :: term()) ->
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate} |
+ {stop, Reason :: term(), NewState :: term()}.
+-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} |
+ term()),
+ State :: term()) ->
+ term().
+-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(),
+ Extra :: term()) ->
+ {ok, NewState :: term()}.
%%% -----------------------------------------------------------------
%%% Starts a generic server.
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index bba46e4cb6..e73c087753 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -628,9 +628,10 @@ keydelete3(_, _, []) -> [].
-spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when
Key :: term(),
N :: pos_integer(),
- TupleList1 :: [tuple()],
- TupleList2 :: [tuple()],
- NewTuple :: tuple().
+ TupleList1 :: [Tuple],
+ TupleList2 :: [Tuple],
+ NewTuple :: Tuple,
+ Tuple :: tuple().
keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) ->
keyreplace3(K, N, L, New).
@@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false.
-spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when
Key :: term(),
N :: pos_integer(),
- TupleList1 :: [tuple()],
- TupleList2 :: [tuple(), ...],
- NewTuple :: tuple().
+ TupleList1 :: [Tuple],
+ TupleList2 :: [Tuple, ...],
+ NewTuple :: Tuple,
+ Tuple :: tuple().
keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) ->
keystore2(K, N, L, New).
@@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) ->
TupleList1 :: [T1],
TupleList2 :: [T2],
TupleList3 :: [(T1 | T2)],
- T1 :: tuple(),
- T2 :: tuple().
+ T1 :: Tuple,
+ T2 :: Tuple,
+ Tuple :: tuple().
keymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
case L2 of
@@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) ->
TupleList1 :: [T1],
TupleList2 :: [T2],
TupleList3 :: [(T1 | T2)],
- T1 :: tuple(),
- T2 :: tuple().
+ T1 :: Tuple,
+ T2 :: Tuple,
+ Tuple :: tuple().
ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 ->
case L1 of
@@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 ->
-spec keymap(Fun, N, TupleList1) -> TupleList2 when
Fun :: fun((Term1 :: term()) -> Term2 :: term()),
N :: pos_integer(),
- TupleList1 :: [tuple()],
- TupleList2 :: [tuple()].
+ TupleList1 :: [Tuple],
+ TupleList2 :: [Tuple],
+ Tuple :: tuple().
keymap(Fun, Index, [Tup|Tail]) ->
[setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)];
diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl
index dbb524cc74..d7b51a151c 100644
--- a/lib/stdlib/src/random.erl
+++ b/lib/stdlib/src/random.erl
@@ -26,6 +26,10 @@
-export([seed/0, seed/1, seed/3, uniform/0, uniform/1,
uniform_s/1, uniform_s/2, seed0/0]).
+-define(PRIME1, 30269).
+-define(PRIME2, 30307).
+-define(PRIME3, 30323).
+
%%-----------------------------------------------------------------------
%% The type of the state
@@ -44,7 +48,11 @@ seed0() ->
-spec seed() -> ran().
seed() ->
- reseed(seed0()).
+ case seed_put(seed0()) of
+ undefined -> seed0();
+ {_,_,_} = Tuple -> Tuple
+ end.
+
%% seed({A1, A2, A3})
%% Seed random number generation
@@ -66,17 +74,15 @@ seed({A1, A2, A3}) ->
A3 :: integer().
seed(A1, A2, A3) ->
- put(random_seed,
- {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}).
+ seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are
+ (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the
+ (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes.
--spec reseed(ran()) -> ran().
-
-reseed({A1, A2, A3}) ->
- case seed(A1, A2, A3) of
- undefined -> seed0();
- {_,_,_} = Tuple -> Tuple
- end.
+-spec seed_put(ran()) -> 'undefined' | ran().
+
+seed_put(Seed) ->
+ put(random_seed, Seed).
%% uniform()
%% Returns a random float between 0 and 1.
@@ -88,11 +94,11 @@ uniform() ->
undefined -> seed0();
Tuple -> Tuple
end,
- B1 = (A1*171) rem 30269,
- B2 = (A2*172) rem 30307,
- B3 = (A3*170) rem 30323,
+ B1 = (A1*171) rem ?PRIME1,
+ B2 = (A2*172) rem ?PRIME2,
+ B3 = (A3*170) rem ?PRIME3,
put(random_seed, {B1,B2,B3}),
- R = A1/30269 + A2/30307 + A3/30323,
+ R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3,
R - trunc(R).
%% uniform(N) -> I
@@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 ->
State1 :: ran().
uniform_s({A1, A2, A3}) ->
- B1 = (A1*171) rem 30269,
- B2 = (A2*172) rem 30307,
- B3 = (A3*170) rem 30323,
- R = A1/30269 + A2/30307 + A3/30323,
+ B1 = (A1*171) rem ?PRIME1,
+ B2 = (A2*172) rem ?PRIME2,
+ B3 = (A3*170) rem ?PRIME3,
+ R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3,
{R - trunc(R), {B1,B2,B3}}.
%% uniform_s(N, State) -> {I, NewState}
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 36cc7f4f4b..9da0d52f8c 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -27,8 +27,6 @@
which_children/1, count_children/1,
check_childspecs/1]).
--export([behaviour_info/1]).
-
%% Internal exports
-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]).
-export([handle_cast/2]).
@@ -90,14 +88,12 @@
-define(is_simple(State), State#state.strategy =:= simple_one_for_one).
-%%--------------------------------------------------------------------------
-
--spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}].
-
-behaviour_info(callbacks) ->
- [{init,1}];
-behaviour_info(_Other) ->
- undefined.
+-callback init(Args :: term()) ->
+ {ok, {{RestartStrategy :: strategy(),
+ MaxR :: non_neg_integer(),
+ MaxT :: non_neg_integer()},
+ [ChildSpec :: child_spec()]}}
+ | ignore.
%%% ---------------------------------------------------
%%% This is a general process supervisor built upon gen_server.erl.
diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl
index 555cb5a66f..e8405ab9a4 100644
--- a/lib/stdlib/src/supervisor_bridge.erl
+++ b/lib/stdlib/src/supervisor_bridge.erl
@@ -22,15 +22,14 @@
%% External exports
-export([start_link/2, start_link/3]).
--export([behaviour_info/1]).
%% Internal exports
-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]).
-export([code_change/3]).
-behaviour_info(callbacks) ->
- [{init,1},{terminate,2}];
-behaviour_info(_Other) ->
- undefined.
+-callback init(Args :: term()) ->
+ {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}.
+-callback terminate(Reason :: (shutdown | term()), State :: term()) ->
+ Ignored :: term().
%%%-----------------------------------------------------------------
%%% This is a rewrite of supervisor_bridge from BS.3.
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index b569ed9003..63767aeda6 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -34,6 +34,8 @@
-define(datadir(Conf), ?config(data_dir, Conf)).
-endif.
+-compile(r13). % OTP-9607
+
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
not_run/1, newly_started/1, basic_v8/1, basic_v9/1,
@@ -53,7 +55,7 @@
simultaneous_open/1, insert_new/1, repair_continuation/1,
otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1,
otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1,
- otp_8923/1, otp_9282/1]).
+ otp_8923/1, otp_9282/1, otp_9607/1]).
-export([dets_dirty_loop/0]).
@@ -112,7 +114,7 @@ all() ->
many_clients, otp_4906, otp_5402, simultaneous_open,
insert_new, repair_continuation, otp_5487, otp_6206,
otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898,
- otp_8899, otp_8903, otp_8923, otp_9282]
+ otp_8899, otp_8903, otp_8923, otp_9282, otp_9607]
end.
groups() ->
@@ -554,7 +556,11 @@ dets_dirty_loop() ->
{From, [write, Name, Value]} ->
Ret = dets:insert(Name, Value),
From ! {self(), Ret},
- dets_dirty_loop()
+ dets_dirty_loop();
+ {From, [close, Name]} ->
+ Ret = dets:close(Name),
+ From ! {self(), Ret},
+ dets_dirty_loop()
end.
@@ -1568,8 +1574,10 @@ repair(Config, V) ->
?line FileSize = dets:info(TabRef, memory),
?line ok = dets:close(TabRef),
crash(Fname, FileSize+20),
- ?line {error, {bad_freelists, Fname}} =
+ %% Used to return bad_freelists, but that changed in OTP-9622
+ ?line {ok, TabRef} =
dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ ?line ok = dets:close(TabRef),
?line file:delete(Fname),
%% File not closed, opening with read and read_write access tried.
@@ -3880,10 +3888,91 @@ some_calls(Tab, Config) ->
?line ok = dets:close(T),
file:delete(File).
+otp_9607(doc) ->
+ ["OTP-9607. Test downgrading the slightly changed format."];
+otp_9607(suite) ->
+ [];
+otp_9607(Config) when is_list(Config) ->
+ %% Note: the bug is about almost full tables. The fix of that
+ %% problem is *not* tested here.
+ Version = r13b,
+ case ?t:is_release_available(atom_to_list(Version)) of
+ true ->
+ T = otp_9607,
+ File = filename(T, Config),
+ Key = a,
+ Value = 1,
+ Args = [{file,File}],
+ ?line {ok, T} = dets:open_file(T, Args),
+ ?line ok = dets:insert(T, {Key, Value}),
+ ?line ok = dets:close(T),
+
+ ?line Call = fun(P, A) ->
+ P ! {self(), A},
+ receive
+ {P, Ans} ->
+ Ans
+ after 5000 ->
+ exit(other_process_dead)
+ end
+ end,
+ %% Create a file on the modified format, read the file
+ %% with an emulator that doesn't know about the modified
+ %% format.
+ ?line {ok, Node} = start_node_rel(Version, Version, slave),
+ ?line Pid = rpc:call(Node, erlang, spawn,
+ [?MODULE, dets_dirty_loop, []]),
+ ?line {error,{needs_repair, File}} =
+ Call(Pid, [open, T, Args++[{repair,false}]]),
+ io:format("Expect repair:~n"),
+ ?line {ok, T} = Call(Pid, [open, T, Args]),
+ ?line [{Key,Value}] = Call(Pid, [read, T, Key]),
+ ?line ok = Call(Pid, [close, T]),
+ file:delete(File),
+
+ %% Create a file on the unmodified format. Modify the file
+ %% using an emulator that must not turn the file into the
+ %% modified format. Read the file and make sure it is not
+ %% repaired.
+ ?line {ok, T} = Call(Pid, [open, T, Args]),
+ ?line ok = Call(Pid, [write, T, {Key,Value}]),
+ ?line [{Key,Value}] = Call(Pid, [read, T, Key]),
+ ?line ok = Call(Pid, [close, T]),
+
+ Key2 = b,
+ Value2 = 2,
+
+ ?line {ok, T} = dets:open_file(T, Args),
+ ?line [{Key,Value}] = dets:lookup(T, Key),
+ ?line ok = dets:insert(T, {Key2,Value2}),
+ ?line ok = dets:close(T),
+
+ ?line {ok, T} = Call(Pid, [open, T, Args++[{repair,false}]]),
+ ?line [{Key2,Value2}] = Call(Pid, [read, T, Key2]),
+ ?line ok = Call(Pid, [close, T]),
+
+ ?t:stop_node(Node),
+ file:delete(File),
+ ok;
+ false ->
+ {skipped, "No support for old node"}
+ end.
+
+
+
%%
%% Parts common to several test cases
%%
+start_node_rel(Name, Rel, How) ->
+ Release = [{release, atom_to_list(Rel)}],
+ ?line Pa = filename:dirname(code:which(?MODULE)),
+ ?line test_server:start_node(Name, How,
+ [{args,
+ " -kernel net_setuptime 100 "
+ " -pa " ++ Pa},
+ {erl, Release}]).
+
crash(File, Where) ->
crash(File, Where, 10).