aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/src/ct.erl2
-rw-r--r--lib/common_test/src/ct_framework.erl15
-rw-r--r--lib/common_test/src/ct_telnet.erl11
-rw-r--r--lib/common_test/src/ct_util.erl25
-rw-r--r--lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl42
-rw-r--r--lib/common_test/test/telnet_server.erl8
-rw-r--r--lib/crypto/c_src/crypto.c26
-rw-r--r--lib/crypto/doc/src/crypto.xml4
-rw-r--r--lib/crypto/src/crypto.erl26
-rw-r--r--lib/crypto/test/crypto_SUITE.erl24
-rw-r--r--lib/debugger/src/dbg_ieval.erl4
-rw-r--r--lib/debugger/test/int_eval_SUITE.erl1
-rw-r--r--lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl5
-rw-r--r--lib/dialyzer/src/Makefile2
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl9
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl31
-rw-r--r--lib/dialyzer/src/dialyzer_races.erl16
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl148
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl9
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl17
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl531
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl19
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl16
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/remote_field.erl11
-rw-r--r--lib/erl_interface/aclocal.m44
-rw-r--r--lib/hipe/cerl/erl_types.erl60
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl139
-rw-r--r--lib/hipe/test/Makefile3
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl20
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl17
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl40
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl16
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl23
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl7
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_export.erl11
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl23
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl31
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl36
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl54
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl35
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_guard_update.erl14
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl46
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_is_map.erl24
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl6
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_size.erl29
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl41
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl24
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl23
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl28
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl22
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_exact.erl32
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_literals.erl13
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl32
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_values.erl28
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl27
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl9
-rw-r--r--lib/inets/src/http_server/httpd.erl12
-rw-r--r--lib/inets/src/http_server/httpd_manager.erl36
-rw-r--r--lib/inets/test/httpd_block.erl6
-rw-r--r--lib/inets/test/inets_sup_SUITE.erl130
-rw-r--r--lib/inets/test/inets_sup_SUITE_data/mime.types3
-rw-r--r--lib/inets/test/inets_sup_SUITE_data/simple.conf6
-rw-r--r--lib/inets/test/old_httpd_SUITE.erl34
-rw-r--r--lib/kernel/doc/src/inet.xml2
-rw-r--r--lib/kernel/doc/src/kernel_app.xml43
-rw-r--r--lib/kernel/src/application_controller.erl31
-rw-r--r--lib/kernel/src/erts_debug.erl21
-rw-r--r--lib/kernel/test/application_SUITE.erl20
-rw-r--r--lib/kernel/test/application_SUITE_data/t4.config1
-rw-r--r--lib/kernel/test/kernel_SUITE.erl12
-rw-r--r--lib/kernel/test/sendfile_SUITE.erl7
-rw-r--r--lib/megaco/aclocal.m44
-rw-r--r--lib/odbc/aclocal.m44
-rw-r--r--lib/reltool/test/reltool_server_SUITE.erl9
-rw-r--r--lib/reltool/test/reltool_test_lib.erl7
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl39
-rw-r--r--lib/sasl/test/sasl_SUITE.erl12
-rw-r--r--lib/sasl/test/systools_SUITE.erl24
-rw-r--r--lib/ssh/doc/src/ssh.xml21
-rw-r--r--lib/ssh/src/ssh.erl9
-rw-r--r--lib/ssh/src/ssh_acceptor.erl47
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl3
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl137
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/internal_doc/ssl-implementation.txt52
-rw-r--r--lib/ssl/src/Makefile3
-rw-r--r--lib/ssl/src/dtls_connection.erl3
-rw-r--r--lib/ssl/src/ssl.app.src1
-rw-r--r--lib/ssl/src/ssl.erl122
-rw-r--r--lib/ssl/src/ssl_alert.erl29
-rw-r--r--lib/ssl/src/ssl_alert.hrl2
-rw-r--r--lib/ssl/src/ssl_cipher.erl8
-rw-r--r--lib/ssl/src/ssl_connection.erl91
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl16
-rw-r--r--lib/ssl/src/ssl_handshake.erl79
-rw-r--r--lib/ssl/src/ssl_internal.hrl17
-rw-r--r--lib/ssl/src/ssl_listen_tracker_sup.erl71
-rw-r--r--lib/ssl/src/ssl_record.erl2
-rw-r--r--lib/ssl/src/ssl_socket.erl195
-rw-r--r--lib/ssl/src/ssl_sup.erl19
-rw-r--r--lib/ssl/src/tls_connection.erl35
-rw-r--r--lib/ssl/src/tls_connection_sup.erl4
-rw-r--r--lib/ssl/src/tls_record.erl33
-rw-r--r--lib/ssl/test/make_certs.erl5
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl269
-rw-r--r--lib/ssl/test/ssl_crl_SUITE.erl30
-rw-r--r--lib/ssl/test/ssl_handshake_SUITE.erl14
-rw-r--r--lib/ssl/test/ssl_test_lib.erl33
-rw-r--r--lib/stdlib/doc/src/erl_tar.xml27
-rw-r--r--lib/stdlib/src/erl_eval.erl8
-rw-r--r--lib/stdlib/src/erl_lint.erl5
-rw-r--r--lib/stdlib/src/erl_parse.yrl21
-rw-r--r--lib/stdlib/src/erl_tar.erl38
-rw-r--r--lib/stdlib/src/filelib.erl2
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl7
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl27
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl40
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl12
-rw-r--r--lib/stdlib/test/tar_SUITE.erl66
-rw-r--r--lib/test_server/src/test_server.erl4
-rw-r--r--lib/test_server/src/test_server_node.erl10
-rw-r--r--lib/typer/Makefile2
-rw-r--r--lib/typer/doc/Makefile39
-rw-r--r--lib/typer/doc/html/.gitignore0
-rw-r--r--lib/typer/doc/pdf/.gitignore0
-rw-r--r--lib/typer/doc/src/Makefile117
-rw-r--r--lib/typer/doc/src/book.xml41
-rw-r--r--lib/typer/doc/src/fascicules.xml12
-rw-r--r--lib/typer/doc/src/notes.xml51
-rw-r--r--lib/typer/doc/src/part_notes.xml35
-rw-r--r--lib/typer/doc/src/ref_man.xml35
-rw-r--r--lib/typer/doc/src/typer_app.xml43
-rw-r--r--lib/typer/info2
-rw-r--r--lib/typer/src/Makefile2
-rw-r--r--lib/typer/vsn.mk2
-rw-r--r--lib/wx/aclocal.m44
137 files changed, 3713 insertions, 679 deletions
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 241cd928b7..85afdc7834 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -773,7 +773,7 @@ comment(Format, Args) when is_list(Format), is_list(Args) ->
send_html_comment(Comment) ->
Html = "<font color=\"green\">" ++ Comment ++ "</font>",
- ct_util:set_testdata({comment,Html}),
+ ct_util:set_testdata({{comment,group_leader()},Html}),
test_server:comment(Html).
%%%-----------------------------------------------------------------
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 9ef917a507..20903607dc 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -657,7 +657,18 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) ->
_ ->
ok
end,
- ct_util:delete_testdata(comment),
+ if Func == end_per_group; Func == end_per_suite ->
+ %% clean up any saved comments
+ ct_util:match_delete_testdata({comment,'_'});
+ true ->
+ %% attemp to delete any saved comment for this TC
+ case process_info(TCPid, group_leader) of
+ {group_leader,TCGL} ->
+ ct_util:delete_testdata({comment,TCGL});
+ _ ->
+ ok
+ end
+ end,
ct_util:delete_suite_data(last_saved_config),
FuncSpec = group_or_func(Func,Args),
@@ -850,7 +861,7 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
_ ->
%% this notification comes from the test case process, so
%% we can add error info to comment with test_server:comment/1
- case ct_util:get_testdata(comment) of
+ case ct_util:get_testdata({comment,group_leader()}) of
undefined ->
test_server:comment(ErrorHtml);
Comment ->
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index c9dc2338cd..3b2652d06c 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.erl
@@ -604,9 +604,12 @@ handle_msg({cmd,Cmd,Timeout},State) ->
end_gen_log(),
{Return,State#state{buffer=NewBuffer,prompt=Prompt}};
handle_msg({send,Cmd},State) ->
+ start_gen_log(heading(send,State#state.name)),
log(State,send,"Sending: ~p",[Cmd]),
+
debug_cont_gen_log("Throwing Buffer:",[]),
debug_log_lines(State#state.buffer),
+
case {State#state.type,State#state.prompt} of
{ts,_} ->
silent_teln_expect(State#state.name,
@@ -626,6 +629,7 @@ handle_msg({send,Cmd},State) ->
ok
end,
ct_telnet_client:send_data(State#state.teln_pid,Cmd),
+ end_gen_log(),
{ok,State#state{buffer=[],prompt=false}};
handle_msg(get_data,State) ->
start_gen_log(heading(get_data,State#state.name)),
@@ -869,14 +873,13 @@ teln_cmd(Pid,Cmd,Prx,Timeout) ->
teln_receive_until_prompt(Pid,Prx,Timeout).
teln_get_all_data(Pid,Prx,Data,Acc,LastLine) ->
- case check_for_prompt(Prx,lists:reverse(LastLine) ++ Data) of
+ case check_for_prompt(Prx,LastLine++Data) of
{prompt,Lines,_PromptType,Rest} ->
teln_get_all_data(Pid,Prx,Rest,[Lines|Acc],[]);
{noprompt,Lines,LastLine1} ->
case ct_telnet_client:get_data(Pid) of
{ok,[]} ->
- {ok,lists:reverse(lists:append([Lines|Acc])),
- lists:reverse(LastLine1)};
+ {ok,lists:reverse(lists:append([Lines|Acc])),LastLine1};
{ok,Data1} ->
teln_get_all_data(Pid,Prx,Data1,[Lines|Acc],LastLine1)
end
@@ -1334,7 +1337,7 @@ teln_receive_until_prompt(Pid,Prx,Timeout) ->
teln_receive_until_prompt(Pid,Prx,Acc,LastLine) ->
{ok,Data} = ct_telnet_client:get_data(Pid),
- case check_for_prompt(Prx,LastLine ++ Data) of
+ case check_for_prompt(Prx,LastLine++Data) of
{prompt,Lines,PromptType,Rest} ->
Return = lists:reverse(lists:append([Lines|Acc])),
{ok,Return,PromptType,Rest};
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index f5eb3a72f0..56027586d1 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -37,7 +37,7 @@
save_suite_data_async/3, save_suite_data_async/2,
read_suite_data/1,
delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1,
- delete_testdata/0, delete_testdata/1,
+ delete_testdata/0, delete_testdata/1, match_delete_testdata/1,
set_testdata/1, get_testdata/1, get_testdata/2,
set_testdata_async/1, update_testdata/2, update_testdata/3,
set_verbosity/1, get_verbosity/1]).
@@ -270,6 +270,9 @@ delete_testdata() ->
delete_testdata(Key) ->
call({delete_testdata, Key}).
+match_delete_testdata(KeyPat) ->
+ call({match_delete_testdata, KeyPat}).
+
update_testdata(Key, Fun) ->
update_testdata(Key, Fun, []).
@@ -361,7 +364,25 @@ loop(Mode,TestData,StartDir) ->
{{delete_testdata,Key},From} ->
TestData1 = lists:keydelete(Key,1,TestData),
return(From,ok),
- loop(From,TestData1,StartDir);
+ loop(From,TestData1,StartDir);
+ {{match_delete_testdata,{Key1,Key2}},From} ->
+ %% handles keys with 2 elements
+ TestData1 =
+ lists:filter(fun({Key,_}) when not is_tuple(Key) ->
+ true;
+ ({Key,_}) when tuple_size(Key) =/= 2 ->
+ true;
+ ({{_,KeyB},_}) when Key1 == '_' ->
+ KeyB =/= Key2;
+ ({{KeyA,_},_}) when Key2 == '_' ->
+ KeyA =/= Key1;
+ (_) when Key1 == '_' ; Key2 == '_' ->
+ false;
+ (_) ->
+ true
+ end, TestData),
+ return(From,ok),
+ loop(From,TestData1,StartDir);
{{set_testdata,New = {Key,_Val}},From} ->
TestData1 = lists:keydelete(Key,1,TestData),
return(From,ok),
diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
index 0ee0525216..c0f79d0f10 100644
--- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
+++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
@@ -16,7 +16,8 @@ suite() ->
].
all() ->
- [expect,
+ [
+ expect,
expect_repeat,
expect_sequence,
expect_error_prompt,
@@ -31,8 +32,10 @@ all() ->
ignore_prompt_repeat,
ignore_prompt_sequence,
ignore_prompt_timeout,
+ large_string,
server_speaks,
- server_disconnects].
+ server_disconnects
+ ].
groups() ->
[].
@@ -214,6 +217,41 @@ no_prompt_check_timeout(_) ->
ok = ct_telnet:close(Handle),
ok.
+%% Check that it's possible to receive multiple chunks of data sent from
+%% the server with one get_data call
+large_string(_) ->
+ {ok, Handle} = ct_telnet:open(telnet_server_conn1),
+ String = "abcd efgh ijkl mnop qrst uvwx yz ",
+ BigString = lists:flatmap(fun(S) -> S end,
+ [String || _ <- lists:seq(1,10)]),
+ VerifyStr = [C || C <- BigString, C/=$ ],
+
+ {ok,Data} = ct_telnet:cmd(Handle, "echo_sep "++BigString),
+ ct:log("[CMD] Received ~w chars: ~s", [length(lists:flatten(Data)),Data]),
+ VerifyStr = [C || C <- lists:flatten(Data), C/=$ , C/=$\r, C/=$\n, C/=$>],
+
+ %% Test #1: With a long sleep value, all data gets gets buffered and
+ %% ct_telnet can receive it with one single request to ct_telnet_client.
+ %% Test #2: With a short sleep value, ct_telnet needs multiple calls to
+ %% ct_telnet_client to collect the data. This iterative operation should
+ %% yield the same result as the single request case.
+
+ ok = ct_telnet:send(Handle, "echo_sep "++BigString),
+ timer:sleep(1000),
+ {ok,Data1} = ct_telnet:get_data(Handle),
+ ct:log("[GET DATA #1] Received ~w chars: ~s",
+ [length(lists:flatten(Data1)),Data1]),
+ VerifyStr = [C || C <- lists:flatten(Data1), C/=$ , C/=$\r, C/=$\n, C/=$>],
+
+ ok = ct_telnet:send(Handle, "echo_sep "++BigString),
+ timer:sleep(50),
+ {ok,Data2} = ct_telnet:get_data(Handle),
+ ct:log("[GET DATA #2] Received ~w chars: ~s", [length(lists:flatten(Data2)),Data2]),
+ VerifyStr = [C || C <- lists:flatten(Data2), C/=$ , C/=$\r, C/=$\n, C/=$>],
+
+ ok = ct_telnet:close(Handle),
+ ok.
+
%% The server says things. Manually check that it gets printed correctly
%% in the general IO log.
server_speaks(_) ->
diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl
index ae56787819..1d341d6106 100644
--- a/lib/common_test/test/telnet_server.erl
+++ b/lib/common_test/test/telnet_server.erl
@@ -198,6 +198,14 @@ do_handle_data(Data,#state{authorized={user,_}}=State) ->
do_handle_data("echo " ++ Data,State) ->
send(Data++"\r\n> ",State),
{ok,State};
+do_handle_data("echo_sep " ++ Data,State) ->
+ Msgs = string:tokens(Data," "),
+ lists:foreach(fun(Msg) ->
+ send(Msg,State),
+ timer:sleep(10)
+ end, Msgs),
+ send("\r\n> ",State),
+ {ok,State};
do_handle_data("echo_no_prompt " ++ Data,State) ->
send(Data,State),
{ok,State};
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index fca08c4eed..3020cadc56 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -215,6 +215,7 @@ static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
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_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM aes_cfb_8_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[]);
@@ -344,6 +345,7 @@ static ErlNifFunc nif_funcs[] = {
{"des_ecb_crypt", 3, des_ecb_crypt},
{"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt},
{"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif},
+ {"aes_cfb_8_crypt", 4, aes_cfb_8_crypt},
{"aes_cfb_128_crypt", 4, aes_cfb_128_crypt},
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
@@ -1600,6 +1602,30 @@ static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_N
#endif
}
+static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key, IVec, Data, IsEncrypt) */
+ ErlNifBinary key, ivec, text;
+ AES_KEY aes_key;
+ unsigned char ivec_clone[16]; /* writable copy */
+ int new_ivlen = 0;
+ ERL_NIF_TERM ret;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16
+ || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
+ || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
+ return enif_make_badarg(env);
+ }
+
+ memcpy(ivec_clone, ivec.data, 16);
+ AES_set_encrypt_key(key.data, 128, &aes_key);
+ AES_cfb8_encrypt((unsigned char *) text.data,
+ enif_make_new_binary(env, text.size, &ret),
+ text.size, &aes_key, ivec_clone, &new_ivlen,
+ (argv[3] == atom_true));
+ CONSUME_REDS(env,text);
+ 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 e88bf01491..7712173ed8 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -128,7 +128,7 @@
<p><code>stream_cipher() = rc4 | aes_ctr </code></p>
- <p><code>block_cipher() = aes_cbc128 | aes_cfb128 | aes_ige256 | blowfish_cbc |
+ <p><code>block_cipher() = aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc |
blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf
| des_ede3 | rc2_cbc </code></p>
@@ -152,7 +152,7 @@
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
<p><code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 |
- blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p>
+ blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p>
<p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 5bf52fc8a4..e1fbbf9ab8 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -210,7 +210,7 @@ supports()->
[{hashs, Hashs},
{ciphers, [des_cbc, des_cfb, des3_cbc, des_ede3, blowfish_cbc,
- blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb128,
+ blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb8, aes_cfb128,
aes_cbc256, rc2_cbc, aes_ctr, rc4] ++ Ciphers},
{public_keys, [rsa, dss, dh, srp] ++ PubKeys}
].
@@ -281,7 +281,7 @@ hmac_final_n(_Context, _HashLen) -> ? nif_stub.
%% Ecrypt/decrypt %%%
-spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
- blowfish_cfb64 | aes_cbc128 | aes_cfb128 | aes_cbc256 | rc2_cbc,
+ blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc,
Key::iodata(), Ivec::binary(), Data::iodata()) -> binary().
block_encrypt(des_cbc, Key, Ivec, Data) ->
@@ -306,6 +306,8 @@ block_encrypt(aes_cbc256, Key, Ivec, Data) ->
aes_cbc_256_encrypt(Key, Ivec, Data);
block_encrypt(aes_ige256, Key, Ivec, Data) ->
aes_ige_256_encrypt(Key, Ivec, Data);
+block_encrypt(aes_cfb8, Key, Ivec, Data) ->
+ aes_cfb_8_encrypt(Key, Ivec, Data);
block_encrypt(aes_cfb128, Key, Ivec, Data) ->
aes_cfb_128_encrypt(Key, Ivec, Data);
block_encrypt(rc2_cbc, Key, Ivec, Data) ->
@@ -313,7 +315,7 @@ block_encrypt(rc2_cbc, Key, Ivec, Data) ->
-spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 |
- aes_cfb128 | rc2_cbc,
+ aes_cfb8 | aes_cfb128 | rc2_cbc,
Key::iodata(), Ivec::binary(), Data::iodata()) -> binary().
block_decrypt(des_cbc, Key, Ivec, Data) ->
@@ -338,6 +340,8 @@ block_decrypt(aes_cbc256, Key, Ivec, Data) ->
aes_cbc_256_decrypt(Key, Ivec, Data);
block_decrypt(aes_ige256, Key, Ivec, Data) ->
aes_ige_256_decrypt(Key, Ivec, Data);
+block_decrypt(aes_cfb8, Key, Ivec, Data) ->
+ aes_cfb_8_decrypt(Key, Ivec, Data);
block_decrypt(aes_cfb128, Key, Ivec, Data) ->
aes_cfb_128_decrypt(Key, Ivec, Data);
block_decrypt(rc2_cbc, Key, Ivec, Data) ->
@@ -1159,7 +1163,21 @@ blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub.
%%
-%% AES in cipher feedback mode (CFB)
+%% AES in cipher feedback mode (CFB) - 8 bit shift
+%%
+-spec aes_cfb_8_encrypt(iodata(), binary(), iodata()) -> binary().
+-spec aes_cfb_8_decrypt(iodata(), binary(), iodata()) -> binary().
+
+aes_cfb_8_encrypt(Key, IVec, Data) ->
+ aes_cfb_8_crypt(Key, IVec, Data, true).
+
+aes_cfb_8_decrypt(Key, IVec, Data) ->
+ aes_cfb_8_crypt(Key, IVec, Data, false).
+
+aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
+%%
+%% AES in cipher feedback mode (CFB) - 128 bit shift
%%
-spec aes_cfb_128_encrypt(iodata(), binary(), iodata()) -> binary().
-spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary().
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 63552d2e70..479c947029 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -55,6 +55,7 @@ all() ->
{group, blowfish_cfb64},
{group, blowfish_ofb64},
{group, aes_cbc128},
+ {group, aes_cfb8},
{group, aes_cfb128},
{group, aes_cbc256},
{group, aes_ige256},
@@ -90,6 +91,7 @@ groups() ->
{des3_cbf,[], [block]},
{rc2_cbc,[], [block]},
{aes_cbc128,[], [block]},
+ {aes_cfb8,[], [block]},
{aes_cfb128,[], [block]},
{aes_cbc256,[], [block]},
{aes_ige256,[], [block]},
@@ -723,6 +725,9 @@ group_config(aes_cbc256, Config) ->
group_config(aes_ige256, Config) ->
Block = aes_ige256(),
[{block, Block} | Config];
+group_config(aes_cfb8, Config) ->
+ Block = aes_cfb8(),
+ [{block, Block} | Config];
group_config(aes_cfb128, Config) ->
Block = aes_cfb128(),
[{block, Block} | Config];
@@ -1164,6 +1169,25 @@ aes_ige256() ->
hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}
].
+aes_cfb8() ->
+ [{aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("000102030405060708090a0b0c0d0e0f"),
+ hexstr2bin("6bc1bee22e409f96e93d7e117393172a")},
+ {aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("3B3FD92EB72DAD20333449F8E83CFB4A"),
+ hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")},
+ {aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("C8A64537A0B3A93FCDE3CDAD9F1CE58B"),
+ hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")},
+ {aes_cfb8,
+ hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ hexstr2bin("26751F67A3CBB140B1808CF187A4F4DF"),
+ hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}
+ ].
+
aes_cfb128() ->
[{aes_cfb128,
hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl
index 0653ce4c00..77297de0f3 100644
--- a/lib/debugger/src/dbg_ieval.erl
+++ b/lib/debugger/src/dbg_ieval.erl
@@ -665,11 +665,11 @@ expr({map,Line,E0,Fs0}, Bs0, Ieval0) ->
{value,E,Bs1} = expr(E0, Bs0, Ieval),
case E of
#{} ->
- {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval),
+ {Fs,Bs2} = eval_map_fields(Fs0, Bs0, Ieval),
Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi);
({map_exact,K,V}, Mi) -> maps:update(K,V,Mi)
end, E, Fs),
- {value,Value,Bs2};
+ {value,Value,merge_bindings(Bs2, Bs1, Ieval)};
_ ->
exception(error, {badarg,E}, Bs1, Ieval)
end;
diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl
index ecbd68ab40..9d7ef238e3 100644
--- a/lib/debugger/test/int_eval_SUITE.erl
+++ b/lib/debugger/test/int_eval_SUITE.erl
@@ -294,6 +294,7 @@ stacktrace(Config) when is_list(Config) ->
maps(Config) when is_list(Config) ->
Fun = fun () -> ?IM:empty_map_update([camembert]) end,
{'EXIT',{{badarg,[camembert]},_}} = spawn_eval(Fun),
+ [#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end),
ok.
diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
index e047a33d8c..7f55360f48 100644
--- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
+++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
@@ -29,7 +29,7 @@
-export([more_catch/1,more_nocatch/1,exit_me/0]).
-export([f/1, f_try/1, f_catch/1]).
-export([otp_5837/1, otp_8310/0]).
--export([empty_map_update/1]).
+-export([empty_map_update/1, update_in_fun/0]).
%% Internal exports.
-export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]).
@@ -244,3 +244,6 @@ otp_8310() ->
ok.
empty_map_update(Map) -> Map#{}.
+
+update_in_fun() ->
+ lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]).
diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile
index d7265ba31a..91fbdca5bd 100644
--- a/lib/dialyzer/src/Makefile
+++ b/lib/dialyzer/src/Makefile
@@ -88,7 +88,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
ifeq ($(NATIVE_LIBS_ENABLED),yes)
ERL_COMPILE_FLAGS += +native
endif
-ERL_COMPILE_FLAGS += +warn_exported_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +warnings_as_errors
+ERL_COMPILE_FLAGS += +warn_export_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +warnings_as_errors
# ----------------------------------------------------
# Targets
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 283031eb9a..1d2dfc7b2d 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -752,14 +752,7 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) ->
t_from_forms_without_remote([{FType, []}], RecDict) ->
Type0 = erl_types:t_from_form(FType, RecDict),
- Map =
- fun(Type) ->
- case erl_types:t_is_remote(Type) of
- true -> erl_types:t_none();
- false -> Type
- end
- end,
- {ok, erl_types:t_map(Map, Type0)};
+ {ok, erl_types:subst_all_remote(Type0, erl_types:t_none())};
t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) ->
%% 'When' constraints
unsupported;
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index 7070fa240d..868857d675 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -699,8 +699,7 @@ handle_add_files(#gui_state{chosen_box = ChosenBox, file_box = FileBox,
end.
handle_add_dir(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox,
- files_to_analyze = FileList,
- mode = Mode} = State) ->
+ files_to_analyze = FileList, mode = Mode} = State) ->
case wxDirPickerCtrl:getPath(DirBox) of
"" ->
State;
@@ -714,8 +713,8 @@ handle_add_dir(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox,
State#gui_state{files_to_analyze = add_files(filter_mods(NewDir1,Ext), FileList, ChosenBox, Ext)}
end.
-handle_add_rec(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, files_to_analyze = FileList,
- mode = Mode} = State) ->
+handle_add_rec(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox,
+ files_to_analyze = FileList, mode = Mode} = State) ->
case wxDirPickerCtrl:getPath(DirBox) of
"" ->
State;
@@ -723,11 +722,11 @@ handle_add_rec(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, files_to_a
NewDir = ordsets:new(),
NewDir1 = ordsets:add_element(Dir,NewDir),
TargetDirs = ordsets:union(NewDir1, all_subdirs(NewDir1)),
- case wxRadioBox:getSelection(Mode) of
- 0 -> Ext = ".beam";
- 1-> Ext = ".erl"
- end,
- State#gui_state{files_to_analyze = add_files(filter_mods(TargetDirs,Ext), FileList, ChosenBox, Ext)}
+ Ext = case wxRadioBox:getSelection(Mode) of
+ 0 -> ".beam";
+ 1 -> ".erl"
+ end,
+ State#gui_state{files_to_analyze = add_files(filter_mods(TargetDirs, Ext), FileList, ChosenBox, Ext)}
end.
handle_file_delete(#gui_state{chosen_box = ChosenBox,
@@ -886,13 +885,10 @@ config_gui_start(State) ->
wxRadioBox:disable(State#gui_state.mode).
save_file(#gui_state{frame = Frame, warnings_box = WBox, log = Log} = State, Type) ->
- case Type of
- warnings ->
- Message = "Save Warnings",
- Box = WBox;
- log -> Message = "Save Log",
- Box = Log
- end,
+ {Message, Box} = case Type of
+ warnings -> {"Save Warnings", WBox};
+ log -> {"Save Log", Log}
+ end,
case wxTextCtrl:getValue(Box) of
"" -> error_sms(State,"There is nothing to save...\n");
_ ->
@@ -936,8 +932,7 @@ include_dialog(#gui_state{gui = Wx, frame = Frame, options = Options}) ->
wxButton:connect(DeleteAllButton, command_button_clicked),
wxButton:connect(Ok, command_button_clicked),
wxButton:connect(Cancel, command_button_clicked),
- Dirs = [io_lib:format("~s", [X])
- || X <- Options#options.include_dirs],
+ Dirs = [io_lib:format("~s", [X]) || X <- Options#options.include_dirs],
wxListBox:set(Box, Dirs),
Layout = wxBoxSizer:new(?wxVERTICAL),
Buttons = wxBoxSizer:new(?wxHORIZONTAL),
diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl
index b1f849b16f..28c2ad2c0b 100644
--- a/lib/dialyzer/src/dialyzer_races.erl
+++ b/lib/dialyzer/src/dialyzer_races.erl
@@ -990,8 +990,7 @@ fixup_race_forward_helper(CurrFun, CurrFunLabel, Fun, FunLabel,
NewRaceVarMap, Args, NewFunArgs, NewFunTypes, NestingLevel};
{CurrFun, Fun} ->
NewCallsToAnalyze = lists:delete(Head, CallsToAnalyze),
- NewRaceVarMap =
- race_var_map(Args, NewFunArgs, RaceVarMap, bind),
+ NewRaceVarMap = race_var_map(Args, NewFunArgs, RaceVarMap, bind),
RetC =
case Fun of
InitFun ->
@@ -1018,8 +1017,7 @@ fixup_race_forward_helper(CurrFun, CurrFunLabel, Fun, FunLabel,
label = FunLabel, var_map = NewRaceVarMap,
def_vars = Args, call_vars = NewFunArgs,
arg_types = NewFunTypes}|
- lists:reverse(StateRaceList)] ++
- RetC;
+ lists:reverse(StateRaceList)] ++ RetC;
_ ->
[#curr_fun{status = in, mfa = Fun,
label = FunLabel, var_map = NewRaceVarMap,
@@ -1054,13 +1052,9 @@ fixup_race_backward(CurrFun, Calls, CallsToAnalyze, Parents, Height) ->
false -> [CurrFun|Parents]
end;
[Head|Tail] ->
- MorePaths =
- case Head of
- {Parent, CurrFun} -> true;
- {Parent, _TupleB} -> false
- end,
- case MorePaths of
- true ->
+ {Parent, TupleB} = Head,
+ case TupleB =:= CurrFun of
+ true -> % more paths are needed
NewCallsToAnalyze = lists:delete(Head, CallsToAnalyze),
NewParents =
fixup_race_backward(Parent, NewCallsToAnalyze,
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl
new file mode 100644
index 0000000000..f362a06bca
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl
@@ -0,0 +1,6 @@
+-type host() :: nonempty_string().
+-type path() :: nonempty_string().
+-type url() :: binary().
+
+% The host portion of a url, if available.
+-type url_host() :: host() | none.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl
new file mode 100644
index 0000000000..8cab65fc9c
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl
@@ -0,0 +1,148 @@
+
+-define(SECOND, 1000).
+-define(MINUTE, (60 * ?SECOND)).
+-define(HOUR, (60 * ?MINUTE)).
+-define(DAY, (24 * ?HOUR)).
+-define(MB, (1024 * 1024)).
+
+% Maximum length of tag/blob prefix
+-define(NAME_MAX, 511).
+
+% How long ddfs node startup can take. The most time-consuming part
+% is the scanning of the tag objects in the node's DDFS volumes.
+-define(NODE_STARTUP, (1 * ?MINUTE)).
+
+% How long to wait on the master for replies from nodes.
+-define(NODE_TIMEOUT, (10 * ?SECOND)).
+
+% How long to wait for a reply from an operation coordinated by the
+% master that accesses nodes. This value should be larger than
+% NODE_TIMEOUT.
+-define(NODEOP_TIMEOUT, (1 * ?MINUTE)).
+
+% The minimum amount of free space a node must have, to be considered
+% a primary candidate host for a new blob.
+-define(MIN_FREE_SPACE, (1024 * ?MB)).
+
+% The maximum number of active HTTP connections on a system (this
+% applies separately for GET and PUT operations).
+-define(HTTP_MAX_ACTIVE, 3).
+
+% The maximum number of waiting HTTP connections to queue up on a busy system.
+-define(HTTP_QUEUE_LENGTH, 100).
+
+% The maximum number of simultaneous HTTP connections. Note that
+% HTTP_MAX_CONNS * 2 * 2 + 32 < Maximum number of file descriptors, where
+% 2 = Get and put, 2 = two FDs required for each connection (connection
+% itself + a file it accesses), 32 = a guess how many extra fds is needed.
+-define(HTTP_MAX_CONNS, 128).
+
+% How long to keep a PUT request in queue if the system is busy.
+-define(PUT_WAIT_TIMEOUT, (1 * ?MINUTE)).
+
+% How long to keep a GET request in queue if the system is busy.
+-define(GET_WAIT_TIMEOUT, (1 * ?MINUTE)).
+
+% An unused loaded tag expires in TAG_EXPIRES milliseconds. Note that
+% if TAG_EXPIRES is not smaller than GC_INTERVAL, tags will never
+% expire from the memory cache and will always take up memory.
+-define(TAG_EXPIRES, (10 * ?HOUR)).
+
+% How often the master's cache of all known tag names is refreshed.
+% This refresh is only needed to purge deleted tags eventually from
+% the tag cache. It doesn't harm to have a long interval.
+-define(TAG_CACHE_INTERVAL, (10 * ?MINUTE)).
+
+% How soon a tag object initialized in memory expires if it's content
+% cannot be fetched from the cluster.
+-define(TAG_EXPIRES_ONERROR, (1 * ?SECOND)).
+
+% How often a DDFS node should refresh its tag cache from disk.
+-define(FIND_TAGS_INTERVAL, ?DAY).
+
+% How often buffered (delayed) updates to a tag need to be
+% flushed. Tradeoff: The longer the interval, the more updates are
+% bundled in a single commit. On the other hand, in the worst case
+% the requester has to wait for the full interval before getting a
+% reply. A long interval also increases the likelihood that the server
+% crashes before the commit has finished successfully, making requests
+% more unreliable.
+-define(DELAYED_FLUSH_INTERVAL, (1 * ?SECOND)).
+
+% How long to wait between garbage collection runs.
+-define(GC_INTERVAL, ?DAY).
+
+% Max duration for a GC run. This should be smaller than
+% min(ORPHANED_{BLOB,TAG}_EXPIRES).
+-define(GC_MAX_DURATION, (3 * ?DAY)).
+
+% How long to wait after startup for cluster to stabilize before
+% starting the first GC run.
+-define(GC_DEFAULT_INITIAL_WAIT, (5 * ?MINUTE)).
+
+% The longest potential interval between messages in the GC protocol;
+% used to ensure GC makes forward progress. This can be set to the
+% estimated time to traverse all the volumes on a DDFS node.
+-define(GC_PROGRESS_INTERVAL, (30 * ?MINUTE)).
+
+% Number of extra replicas (i.e. lost replicas recovered during GC) to
+% allow before deleting extra replicas.
+-define(NUM_EXTRA_REPLICAS, 1).
+
+% Permissions for files backing blobs and tags.
+-define(FILE_MODE, 8#00400).
+
+% How often to check available disk space in ddfs_node.
+-define(DISKSPACE_INTERVAL, (10 * ?SECOND)).
+
+% The maximum size of payloads of HTTP requests to the /ddfs/tag/
+% prefix.
+-define(MAX_TAG_BODY_SIZE, (512 * ?MB)).
+
+% Tag attribute names and values have a limited size, and there
+% can be only a limited number of them.
+-define(MAX_TAG_ATTRIB_NAME_SIZE, 1024).
+-define(MAX_TAG_ATTRIB_VALUE_SIZE, 1024).
+-define(MAX_NUM_TAG_ATTRIBS, 1000).
+
+% How long HTTP requests that perform tag updates should wait to
+% finish (a long time).
+-define(TAG_UPDATE_TIMEOUT, ?DAY).
+
+% Timeout for re-replicating a single blob over HTTP PUT. This
+% depends on the largest blobs hosted by DDFS, and the speed of the
+% cluster network.
+-define(GC_PUT_TIMEOUT, (180 * ?MINUTE)).
+
+% Delete !partial files after this many milliseconds.
+-define(PARTIAL_EXPIRES, ?DAY).
+
+% When orphaned blob can be deleted. This should be large enough that
+% you can upload all the new blobs of a tag and perform the tag update
+% within this time.
+-define(ORPHANED_BLOB_EXPIRES, (5 * ?DAY)).
+
+% When orphaned tag can be deleted.
+-define(ORPHANED_TAG_EXPIRES, (5 * ?DAY)).
+
+% How long a tag has to stay on the deleted list before
+% we can permanently forget it, after all known instances
+% of the tag object have been removed. This quarantine period
+% ensures that a node that was temporarily unavailable
+% and reactivates can't resurrect deleted tags. You
+% must ensure that all temporarily inactive nodes
+% are reactivated (or cleaned) within the ?DELETED_TAG_EXPIRES
+% time frame.
+%
+% This value _must_ be larger than the other time-related DDFS
+% parameters listed in this file. In particular, it must be larger
+% than ORPHANED_TAG_EXPIRES.
+-define(DELETED_TAG_EXPIRES, (30 * ?DAY)).
+
+% How many times a tag operation should be retried before aborting.
+-define(MAX_TAG_OP_RETRIES, 3).
+
+% How long to wait before timing out a tag retrieval. This should be
+% large enough to read a large tag object off the disk and send it
+% over the network.
+-define(GET_TAG_TIMEOUT, (5 * ?MINUTE)).
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl
new file mode 100644
index 0000000000..e43ec23fe1
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl
@@ -0,0 +1,9 @@
+-type volume_name() :: nonempty_string().
+
+% Diskinfo is {FreeSpace, UsedSpace}.
+-type diskinfo() :: {non_neg_integer(), non_neg_integer()}.
+-type volume() :: {diskinfo(), volume_name()}.
+
+-type object_type() :: 'blob' | 'tag'.
+-type object_name() :: binary().
+-type taginfo() :: {erlang:timestamp(), volume_name()}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl
new file mode 100644
index 0000000000..dc43f7586b
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl
@@ -0,0 +1,17 @@
+-type local_object() :: {object_name(), node()}.
+-type phase() :: 'start' | 'build_map' | 'map_wait' | 'gc'
+ | 'rr_blobs' | 'rr_blobs_wait' | 'rr_tags'.
+-type protocol_msg() :: {'check_blob', object_name()} | 'start_gc' | 'end_rr'.
+
+-type blob_update() :: {object_name(), 'filter' | [url()]}.
+
+-type check_blob_result() :: 'false' | {'true', volume_name()}.
+
+% GC statistics
+
+% {Files, Bytes}
+-type gc_stat() :: {non_neg_integer(), non_neg_integer()}.
+% {Kept, Deleted}
+-type obj_stats() :: {gc_stat(), gc_stat()}.
+% {Tags, Blobs}.
+-type gc_run_stats() :: {obj_stats(), obj_stats()}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl
new file mode 100644
index 0000000000..2be2773dc5
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl
@@ -0,0 +1,531 @@
+-module(ddfs_master).
+-behaviour(gen_server).
+
+-export([start_link/0]).
+-export([get_tags/1, get_tags/3,
+ get_nodeinfo/1,
+ get_read_nodes/0,
+ get_hosted_tags/1,
+ gc_blacklist/0, gc_blacklist/1,
+ gc_stats/0,
+ choose_write_nodes/3,
+ new_blob/4, new_blob/5,
+ safe_gc_blacklist/0, safe_gc_blacklist/1,
+ refresh_tag_cache/0,
+ tag_notify/2,
+ tag_operation/2, tag_operation/3,
+ update_gc_stats/1,
+ update_nodes/1
+ ]).
+-export([init/1,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ terminate/2,
+ code_change/3]).
+
+-define(WEB_PORT, 8011).
+
+-compile(nowarn_deprecated_type).
+
+-include("common_types.hrl").
+-include("gs_util.hrl").
+-include("config.hrl").
+-include("ddfs.hrl").
+-include("ddfs_tag.hrl").
+-include("ddfs_gc.hrl").
+
+-type node_info() :: {node(), {non_neg_integer(), non_neg_integer()}}.
+-type gc_stats() :: none | gc_run_stats().
+
+-record(state, {tags = gb_trees:empty() :: gb_trees:tree(),
+ tag_cache = false :: false | gb_sets:set(),
+ cache_refresher :: pid(),
+
+ nodes = [] :: [node_info()],
+ write_blacklist = [] :: [node()],
+ read_blacklist = [] :: [node()],
+ gc_blacklist = [] :: [node()],
+ safe_gc_blacklist = gb_sets:empty() :: gb_sets:set(),
+ gc_stats = none :: none | {gc_stats(), erlang:timestamp()}}).
+-type state() :: #state{}.
+-type replyto() :: {pid(), reference()}.
+
+-export_type([gc_stats/0, node_info/0]).
+
+%% ===================================================================
+%% API functions
+
+-spec start_link() -> {ok, pid()}.
+start_link() ->
+ lager:info("DDFS master starts"),
+ case gen_server:start_link({local, ?MODULE}, ?MODULE, [], []) of
+ {ok, Server} -> {ok, Server};
+ {error, {already_started, Server}} -> {ok, Server}
+ end.
+
+-spec tag_operation(term(), tagname()) -> term().
+tag_operation(Op, Tag) ->
+ gen_server:call(?MODULE, {tag, Op, Tag}).
+-spec tag_operation(term(), tagname(), non_neg_integer() | infinity) ->
+ term().
+tag_operation(Op, Tag, Timeout) ->
+ gen_server:call(?MODULE, {tag, Op, Tag}, Timeout).
+
+-spec tag_notify(term(), tagname()) -> ok.
+tag_notify(Op, Tag) ->
+ gen_server:cast(?MODULE, {tag_notify, Op, Tag}).
+
+-spec get_nodeinfo(all) -> {ok, [node_info()]}.
+get_nodeinfo(all) ->
+ gen_server:call(?MODULE, {get_nodeinfo, all}).
+
+-spec get_read_nodes() -> {ok, [node()], non_neg_integer()} | {error, term()}.
+get_read_nodes() ->
+ gen_server:call(?MODULE, get_read_nodes, infinity).
+
+-spec gc_blacklist() -> {ok, [node()]}.
+gc_blacklist() ->
+ gen_server:call(?MODULE, gc_blacklist).
+
+-spec gc_blacklist([node()]) -> ok.
+gc_blacklist(Nodes) ->
+ gen_server:cast(?MODULE, {gc_blacklist, Nodes}).
+
+-spec gc_stats() -> {ok, none | {gc_stats(), erlang:timestamp()}} | {error, term()}.
+gc_stats() ->
+ gen_server:call(?MODULE, gc_stats).
+
+-spec get_hosted_tags(host()) -> {ok, [tagname()]} | {error, term()}.
+get_hosted_tags(Host) ->
+ gen_server:call(?MODULE, {get_hosted_tags, Host}).
+
+-spec choose_write_nodes(non_neg_integer(), [node()], [node()]) -> {ok, [node()]}.
+choose_write_nodes(K, Include, Exclude) ->
+ gen_server:call(?MODULE, {choose_write_nodes, K, Include, Exclude}).
+
+-spec get_tags(gc) -> {ok, [tagname()], [node()]} | too_many_failed_nodes;
+ (safe) -> {ok, [binary()]} | too_many_failed_nodes.
+get_tags(Mode) ->
+ get_tags(?MODULE, Mode, ?GET_TAG_TIMEOUT).
+
+-spec get_tags(server(), gc, non_neg_integer()) ->
+ {ok, [tagname()], [node()]} | too_many_failed_nodes;
+ (server(), safe, non_neg_integer()) ->
+ {ok, [binary()]} | too_many_failed_nodes.
+get_tags(Server, Mode, Timeout) ->
+ disco_profile:timed_run(
+ fun() -> gen_server:call(Server, {get_tags, Mode}, Timeout) end,
+ get_tags).
+
+-spec new_blob(string()|object_name(), non_neg_integer(), [node()], [node()]) ->
+ too_many_replicas | {ok, [nonempty_string()]}.
+new_blob(Obj, K, Include, Exclude) ->
+ gen_server:call(?MODULE, {new_blob, Obj, K, Include, Exclude}, infinity).
+
+-spec new_blob(server(), string()|object_name(), non_neg_integer(), [node()], [node()]) ->
+ too_many_replicas | {ok, [nonempty_string()]}.
+new_blob(Master, Obj, K, Include, Exclude) ->
+ gen_server:call(Master, {new_blob, Obj, K, Include, Exclude}, infinity).
+
+-spec safe_gc_blacklist() -> {ok, [node()]} | {error, term()}.
+safe_gc_blacklist() ->
+ gen_server:call(?MODULE, safe_gc_blacklist).
+
+-spec safe_gc_blacklist(gb_sets:set()) -> ok.
+safe_gc_blacklist(SafeGCBlacklist) ->
+ gen_server:cast(?MODULE, {safe_gc_blacklist, SafeGCBlacklist}).
+
+-spec update_gc_stats(gc_run_stats()) -> ok.
+update_gc_stats(Stats) ->
+ gen_server:cast(?MODULE, {update_gc_stats, Stats}).
+
+-type nodes_update() :: [{node(), boolean(), boolean()}].
+-spec update_nodes(nodes_update()) -> ok.
+update_nodes(DDFSNodes) ->
+ gen_server:cast(?MODULE, {update_nodes, DDFSNodes}).
+
+-spec update_nodestats(gb_trees:tree()) -> ok.
+update_nodestats(NewNodes) ->
+ gen_server:cast(?MODULE, {update_nodestats, NewNodes}).
+
+-spec update_tag_cache(gb_sets:set()) -> ok.
+update_tag_cache(TagCache) ->
+ gen_server:cast(?MODULE, {update_tag_cache, TagCache}).
+
+-spec refresh_tag_cache() -> ok.
+refresh_tag_cache() ->
+ gen_server:cast(?MODULE, refresh_tag_cache).
+
+%% ===================================================================
+%% gen_server callbacks
+
+-spec init(_) -> gs_init().
+init(_Args) ->
+ _ = [disco_profile:new_histogram(Name)
+ || Name <- [get_tags, do_get_tags_all, do_get_tags_filter,
+ do_get_tags_safe, do_get_tags_gc]],
+ spawn_link(fun() -> monitor_diskspace() end),
+ spawn_link(fun() -> ddfs_gc:start_gc(disco:get_setting("DDFS_DATA")) end),
+ Refresher = spawn_link(fun() -> refresh_tag_cache_proc() end),
+ put(put_port, disco:get_setting("DDFS_PUT_PORT")),
+ {ok, #state{cache_refresher = Refresher}}.
+
+-type choose_write_nodes_msg() :: {choose_write_nodes, non_neg_integer(), [node()], [node()]}.
+-type new_blob_msg() :: {new_blob, string() | object_name(), non_neg_integer(), [node()]}.
+-type tag_msg() :: {tag, ddfs_tag:call_msg(), tagname()}.
+-spec handle_call(dbg_state_msg(), from(), state()) ->
+ gs_reply(state());
+ ({get_nodeinfo, all}, from(), state()) ->
+ gs_reply({ok, [node_info()]});
+ (get_read_nodes, from(), state()) ->
+ gs_reply({ok, [node()], non_neg_integer});
+ (gc_blacklist, from(), state()) ->
+ gs_reply({ok, [node()]});
+ (gc_stats, from(), state()) ->
+ gs_reply({ok, gc_stats(), erlang:timestamp()});
+ (choose_write_nodes_msg(), from(), state()) ->
+ gs_reply({ok, [node()]});
+ (new_blob_msg(), from(), state()) ->
+ gs_reply(new_blob_result());
+ (tag_msg(), from(), state()) ->
+ gs_reply({error, nonodes}) | gs_noreply();
+ ({get_tags, gc | safe}, from(), state()) ->
+ gs_noreply();
+ ({get_hosted_tags, host()}, from(), state()) ->
+ gs_noreply();
+ (safe_gc_blacklist, from(), state()) ->
+ gs_reply({ok, [node()]}).
+handle_call(dbg_get_state, _, S) ->
+ {reply, S, S};
+
+handle_call({get_nodeinfo, all}, _From, #state{nodes = Nodes} = S) ->
+ {reply, {ok, Nodes}, S};
+
+handle_call(get_read_nodes, _F, #state{nodes = Nodes, read_blacklist = RB} = S) ->
+ {reply, do_get_readable_nodes(Nodes, RB), S};
+
+handle_call(gc_blacklist, _F, #state{gc_blacklist = Nodes} = S) ->
+ {reply, {ok, Nodes}, S};
+
+handle_call(gc_stats, _F, #state{gc_stats = Stats} = S) ->
+ {reply, {ok, Stats}, S};
+
+handle_call({choose_write_nodes, K, Include, Exclude}, _,
+ #state{nodes = N, write_blacklist = WBL, gc_blacklist = GBL} = S) ->
+ BL = lists:umerge(WBL, GBL),
+ {reply, do_choose_write_nodes(N, K, Include, Exclude, BL), S};
+
+handle_call({new_blob, Obj, K, Include, Exclude}, _,
+ #state{nodes = N, gc_blacklist = GBL, write_blacklist = WBL} = S) ->
+ BL = lists:umerge(WBL, GBL),
+ {reply, do_new_blob(Obj, K, Include, Exclude, BL, N), S};
+
+handle_call({tag, _M, _Tag}, _From, #state{nodes = []} = S) ->
+ {reply, {error, no_nodes}, S};
+
+handle_call({tag, M, Tag}, From, S) ->
+ {noreply, do_tag_request(M, Tag, From, S)};
+
+handle_call({get_tags, Mode}, From, #state{nodes = Nodes} = S) ->
+ spawn(fun() ->
+ gen_server:reply(From, do_get_tags(Mode, [N || {N, _} <- Nodes]))
+ end),
+ {noreply, S};
+
+handle_call({get_hosted_tags, Host}, From, S) ->
+ spawn(fun() -> gen_server:reply(From, ddfs_gc:hosted_tags(Host)) end),
+ {noreply, S};
+
+handle_call(safe_gc_blacklist, _From, #state{safe_gc_blacklist = SBL} = S) ->
+ {reply, {ok, gb_sets:to_list(SBL)}, S}.
+
+-spec handle_cast({tag_notify, ddfs_tag:cast_msg(), tagname()}
+ | {gc_blacklist, [node()]}
+ | {safe_gc_blacklist, gb_sets:set()}
+ | {update_gc_stats, gc_stats()}
+ | {update_tag_cache, gb_sets:set()}
+ | refresh_tag_cache
+ | {update_nodes, nodes_update()}
+ | {update_nodestats, gb_trees:tree()},
+ state()) -> gs_noreply().
+handle_cast({tag_notify, M, Tag}, S) ->
+ {noreply, do_tag_notify(M, Tag, S)};
+
+handle_cast({gc_blacklist, Nodes}, #state{safe_gc_blacklist = SBL} = S) ->
+ BLSet = gb_sets:from_list(Nodes),
+ NewSBL = gb_sets:intersection(BLSet, SBL),
+ {noreply, S#state{gc_blacklist = gb_sets:to_list(BLSet),
+ safe_gc_blacklist = NewSBL}};
+
+handle_cast({safe_gc_blacklist, SafeBlacklist}, #state{gc_blacklist = BL} = S) ->
+ SBL = gb_sets:intersection(SafeBlacklist, gb_sets:from_list(BL)),
+ {noreply, S#state{safe_gc_blacklist = SBL}};
+
+handle_cast({update_gc_stats, Stats}, S) ->
+ {noreply, S#state{gc_stats = {Stats, now()}}};
+
+handle_cast({update_tag_cache, TagCache}, S) ->
+ {noreply, S#state{tag_cache = TagCache}};
+
+handle_cast(refresh_tag_cache, #state{cache_refresher = Refresher} = S) ->
+ Refresher ! refresh,
+ {noreply, S};
+
+handle_cast({update_nodes, NewNodes}, S) ->
+ {noreply, do_update_nodes(NewNodes, S)};
+
+handle_cast({update_nodestats, NewNodes}, S) ->
+ {noreply, do_update_nodestats(NewNodes, S)}.
+
+-spec handle_info({'DOWN', _, _, pid(), _}, state()) -> gs_noreply().
+handle_info({'DOWN', _, _, Pid, _}, S) ->
+ {noreply, do_tag_exit(Pid, S)}.
+
+%% ===================================================================
+%% gen_server callback stubs
+
+-spec terminate(term(), state()) -> ok.
+terminate(Reason, _State) ->
+ lager:warning("DDFS master died: ~p", [Reason]).
+
+-spec code_change(term(), state(), term()) -> {ok, state()}.
+code_change(_OldVsn, State, _Extra) -> {ok, State}.
+
+%% ===================================================================
+%% internal functions
+
+-spec do_get_readable_nodes([node_info()], [node()]) ->
+ {ok, [node()], non_neg_integer()}.
+do_get_readable_nodes(Nodes, ReadBlacklist) ->
+ NodeSet = gb_sets:from_ordset(lists:sort([Node || {Node, _} <- Nodes])),
+ BlackSet = gb_sets:from_ordset(ReadBlacklist),
+ ReadableNodeSet = gb_sets:subtract(NodeSet, BlackSet),
+ {ok, gb_sets:to_list(ReadableNodeSet), gb_sets:size(BlackSet)}.
+
+-spec do_choose_write_nodes([node_info()], non_neg_integer(), [node()], [node()], [node()]) ->
+ {ok, [node()]}.
+do_choose_write_nodes(Nodes, K, Include, Exclude, BlackList) ->
+ % Include is the list of nodes that must be included
+ %
+ % Node selection algorithm:
+ % 1. try to choose K nodes randomly from all the nodes which have
+ % more than ?MIN_FREE_SPACE bytes free space available and which
+ % are not excluded or blacklisted.
+ % 2. if K nodes cannot be found this way, choose the K emptiest
+ % nodes which are not excluded or blacklisted.
+ Primary = ([N || {N, {Free, _Total}} <- Nodes, Free > ?MIN_FREE_SPACE / 1024]
+ -- (Exclude ++ BlackList)),
+ if length(Primary) >= K ->
+ {ok, Include ++ disco_util:choose_random(Primary -- Include , K - length(Include))};
+ true ->
+ Preferred = [N || {N, _} <- lists:reverse(lists:keysort(2, Nodes))],
+ Secondary = Include ++ lists:sublist(Preferred -- (Include ++ Exclude ++ BlackList),
+ K - length(Include)),
+ {ok, Secondary}
+ end.
+
+-type new_blob_result() :: too_many_replicas | {ok, [nonempty_string()]}.
+-spec do_new_blob(string()|object_name(), non_neg_integer(), [node()], [node()], [node()], [node_info()]) ->
+ new_blob_result().
+do_new_blob(_Obj, K, _Include, _Exclude, _BlackList, Nodes) when K > length(Nodes) ->
+ too_many_replicas;
+do_new_blob(Obj, K, Include, Exclude, BlackList, Nodes) ->
+ {ok, WriteNodes} = do_choose_write_nodes(Nodes, K, Include, Exclude, BlackList),
+ Urls = [["http://", disco:host(N), ":", get(put_port), "/ddfs/", Obj]
+ || N <- WriteNodes],
+ {ok, Urls}.
+
+% Tag request: Start a new tag server if one doesn't exist already. Forward
+% the request to the tag server.
+
+-spec get_tag_pid(tagname(), gb_trees:tree(), false | gb_sets:set()) ->
+ {pid(), gb_trees:tree()}.
+get_tag_pid(Tag, Tags, Cache) ->
+ case gb_trees:lookup(Tag, Tags) of
+ none ->
+ NotFound = (Cache =/= false
+ andalso not gb_sets:is_element(Tag, Cache)),
+ {ok, Server} = ddfs_tag:start(Tag, NotFound),
+ erlang:monitor(process, Server),
+ {Server, gb_trees:insert(Tag, Server, Tags)};
+ {value, P} ->
+ {P, Tags}
+ end.
+
+-spec do_tag_request(term(), tagname(), replyto(), state()) ->
+ state().
+do_tag_request(M, Tag, From, #state{tags = Tags, tag_cache = Cache} = S) ->
+ {Pid, TagsN} = get_tag_pid(Tag, Tags, Cache),
+ gen_server:cast(Pid, {M, From}),
+ S#state{tags = TagsN,
+ tag_cache = Cache =/= false andalso gb_sets:add(Tag, Cache)}.
+
+-spec do_tag_notify(term(), tagname(), state()) -> state().
+do_tag_notify(M, Tag, #state{tags = Tags, tag_cache = Cache} = S) ->
+ {Pid, TagsN} = get_tag_pid(Tag, Tags, Cache),
+ gen_server:cast(Pid, {notify, M}),
+ S#state{tags = TagsN,
+ tag_cache = Cache =/= false andalso gb_sets:add(Tag, Cache)}.
+
+-spec do_update_nodes(nodes_update(), state()) -> state().
+do_update_nodes(NewNodes, #state{nodes = Nodes, tags = Tags} = S) ->
+ WriteBlacklist = lists:sort([Node || {Node, false, _} <- NewNodes]),
+ ReadBlacklist = lists:sort([Node || {Node, _, false} <- NewNodes]),
+ OldNodes = gb_trees:from_orddict(Nodes),
+ UpdatedNodes = lists:keysort(1, [case gb_trees:lookup(Node, OldNodes) of
+ none ->
+ {Node, {0, 0}};
+ {value, OldStats} ->
+ {Node, OldStats}
+ end || {Node, _WB, _RB} <- NewNodes]),
+ if
+ UpdatedNodes =/= Nodes ->
+ _ = [gen_server:cast(Pid, {die, none}) || Pid <- gb_trees:values(Tags)],
+ spawn(fun() ->
+ {ok, ReadableNodes, RBSize} =
+ do_get_readable_nodes(UpdatedNodes, ReadBlacklist),
+ refresh_tag_cache(ReadableNodes, RBSize)
+ end),
+ S#state{nodes = UpdatedNodes,
+ write_blacklist = WriteBlacklist,
+ read_blacklist = ReadBlacklist,
+ tag_cache = false,
+ tags = gb_trees:empty()};
+ true ->
+ S#state{write_blacklist = WriteBlacklist,
+ read_blacklist = ReadBlacklist}
+ end.
+
+-spec do_update_nodestats(gb_trees:tree(), state()) -> state().
+do_update_nodestats(NewNodes, #state{nodes = Nodes} = S) ->
+ UpdatedNodes = [case gb_trees:lookup(Node, NewNodes) of
+ none ->
+ {Node, Stats};
+ {value, NewStats} ->
+ {Node, NewStats}
+ end || {Node, Stats} <- Nodes],
+ S#state{nodes = UpdatedNodes}.
+
+-spec do_tag_exit(pid(), state()) -> state().
+do_tag_exit(Pid, S) ->
+ NewTags = [X || {_, V} = X <- gb_trees:to_list(S#state.tags), V =/= Pid],
+ S#state{tags = gb_trees:from_orddict(NewTags)}.
+
+-spec do_get_tags(all | filter, [node()]) -> {[node()], [node()], [binary()]};
+ (safe, [node()]) -> {ok, [binary()]} | too_many_failed_nodes;
+ (gc, [node()]) -> {ok, [binary()], [node()]} | too_many_failed_nodes.
+do_get_tags(all, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ {Replies, Failed} =
+ gen_server:multi_call(Nodes, ddfs_node, get_tags, ?NODE_TIMEOUT),
+ {OkNodes, Tags} = lists:unzip(Replies),
+ {OkNodes, Failed, lists:usort(lists:flatten(Tags))}
+ end, do_get_tags_all);
+
+do_get_tags(filter, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ {OkNodes, Failed, Tags} = do_get_tags(all, Nodes),
+ case tag_operation(get_tagnames, <<"+deleted">>, ?NODEOP_TIMEOUT) of
+ {ok, Deleted} ->
+ TagSet = gb_sets:from_ordset(Tags),
+ DelSet = gb_sets:insert(<<"+deleted">>, Deleted),
+ NotDeleted = gb_sets:to_list(gb_sets:subtract(TagSet, DelSet)),
+ {OkNodes, Failed, NotDeleted};
+ E ->
+ E
+ end
+ end, do_get_tags_filter);
+
+do_get_tags(safe, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")),
+ case do_get_tags(filter, Nodes) of
+ {_OkNodes, Failed, Tags} when length(Failed) < TagMinK ->
+ {ok, Tags};
+ _ ->
+ too_many_failed_nodes
+ end
+ end, do_get_tags_safe);
+
+% The returned tag list may include +deleted.
+do_get_tags(gc, Nodes) ->
+ disco_profile:timed_run(
+ fun() ->
+ {OkNodes, Failed, Tags} = do_get_tags(all, Nodes),
+ TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")),
+ case length(Failed) < TagMinK of
+ false ->
+ too_many_failed_nodes;
+ true ->
+ case tag_operation(get_tagnames, <<"+deleted">>, ?NODEOP_TIMEOUT) of
+ {ok, Deleted} ->
+ TagSet = gb_sets:from_ordset(Tags),
+ NotDeleted = gb_sets:subtract(TagSet, Deleted),
+ {ok, gb_sets:to_list(NotDeleted), OkNodes};
+ E ->
+ E
+ end
+ end
+ end, do_get_tags_gc).
+
+% Timeouts in this call by the below processes can cause ddfs_master
+% itself to crash, since the processes are linked to it.
+-spec safe_get_read_nodes() -> {ok, [node()], non_neg_integer()} | error.
+safe_get_read_nodes() ->
+ try get_read_nodes() of
+ {ok, _ReadableNodes, _RBSize} = RN ->
+ RN;
+ E ->
+ lager:error("unexpected response retrieving readable nodes: ~p", [E]),
+ error
+ catch
+ K:E ->
+ lager:error("error retrieving readable nodes: ~p:~p", [K, E]),
+ error
+ end.
+
+-spec monitor_diskspace() -> no_return().
+monitor_diskspace() ->
+ case safe_get_read_nodes() of
+ {ok, ReadableNodes, _RBSize} ->
+ {Space, _F} = gen_server:multi_call(ReadableNodes,
+ ddfs_node,
+ get_diskspace,
+ ?NODE_TIMEOUT),
+ update_nodestats(gb_trees:from_orddict(lists:keysort(1, Space)));
+ error ->
+ ok
+ end,
+ timer:sleep(?DISKSPACE_INTERVAL),
+ monitor_diskspace().
+
+-spec refresh_tag_cache_proc() -> no_return().
+refresh_tag_cache_proc() ->
+ case safe_get_read_nodes() of
+ {ok, ReadableNodes, RBSize} ->
+ refresh_tag_cache(ReadableNodes, RBSize);
+ error ->
+ ok
+ end,
+ receive
+ refresh ->
+ ok
+ after ?TAG_CACHE_INTERVAL ->
+ ok
+ end,
+ refresh_tag_cache_proc().
+
+-spec refresh_tag_cache([node()], non_neg_integer()) -> ok.
+refresh_tag_cache(Nodes, BLSize) ->
+ TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")),
+ {Replies, Failed} =
+ gen_server:multi_call(Nodes, ddfs_node, get_tags, ?NODE_TIMEOUT),
+ if Nodes =/= [], length(Failed) + BLSize < TagMinK ->
+ {_OkNodes, Tags} = lists:unzip(Replies),
+ update_tag_cache(gb_sets:from_list(lists:flatten(Tags)));
+ true -> ok
+ end.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl
new file mode 100644
index 0000000000..2920b67fc5
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl
@@ -0,0 +1,19 @@
+
+-type tokentype() :: 'read' | 'write'.
+-type user_attr() :: [{binary(), binary()}].
+% An 'internal' token is also used by internal consumers, but never stored.
+-type token() :: 'null' | binary().
+
+-type tagname() :: binary().
+-type tagid() :: binary().
+
+-type attrib() :: 'urls' | 'read_token' | 'write_token' | {'user', binary()}.
+
+-record(tagcontent, {id :: tagid(),
+ last_modified :: binary(),
+ read_token = null :: token(),
+ write_token = null :: token(),
+ urls = [] :: [[binary()]],
+ user = [] :: user_attr()}).
+
+-type tagcontent() :: #tagcontent{}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl
new file mode 100644
index 0000000000..d579e9a7d7
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl
@@ -0,0 +1,16 @@
+% This is a set of type utilities to be used when spec-cing the
+% callbacks of a gen_server implementation. It should be included in
+% the impl module, which needs to define the state() type.
+
+-type gs_init() :: {ok, state()}.
+-type gs_reply(T) :: {reply, (T), state()}.
+-type gs_noreply() :: {noreply, state()}.
+-type gs_noreply_t() :: {noreply, state(), non_neg_integer()}.
+-type gs_stop(T) :: {stop, (T), state()}.
+
+% Generic utilities.
+
+-type server() :: pid() | atom() | {atom(), node()}.
+-type from() :: {pid(), term()}.
+
+-type dbg_state_msg() :: dbg_get_state.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl
new file mode 100644
index 0000000000..c34fa1b9dd
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl
@@ -0,0 +1,11 @@
+-module(remote_field).
+
+-type f(T) :: {ssl:sslsocket(), T}.
+
+-record(r1, { f1 :: f(_) }).
+-type r1(T) :: #r1{ f1 :: fun((ssl:sslsocket(), T) -> any()) }.
+
+-record(state, {
+ r :: r1(T),
+ arg :: T
+ }).
diff --git a/lib/erl_interface/aclocal.m4 b/lib/erl_interface/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/erl_interface/aclocal.m4
+++ b/lib/erl_interface/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 47b8dc766a..06c0d10296 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -209,6 +209,7 @@
type_is_defined/4,
record_field_diffs_to_string/2,
subst_all_vars_to_any/1,
+ subst_all_remote/2,
lift_list_to_pos_empty/1,
is_opaque_type/2,
is_erl_type/1,
@@ -2985,16 +2986,19 @@ inf_union(U1, U2, Opaques) ->
List = [A,B,F,I,L,N,T,M,Map],
inf_union_collect(List, Opaque, InfFun, [], [])
end,
- O1 = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end),
- O2 = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end),
- Union = inf_union(U1, U2, 0, [], Opaques),
- t_sup([O1, O2, Union]).
+ {O1, ThrowList1} =
+ OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end),
+ {O2, ThrowList2}
+ = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end),
+ {Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques),
+ ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3),
+ case t_sup([O1, O2, Union]) of
+ ?none when ThrowList =/= [] -> throw(hd(ThrowList));
+ Sup -> Sup
+ end.
inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) ->
- case t_sup(InfList) of
- ?none when ThrowList =/= [] -> throw(hd(lists:flatten(ThrowList)));
- Sup -> Sup
- end;
+ {t_sup(InfList), lists:usort(ThrowList)};
inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) ->
inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList);
inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) ->
@@ -3005,19 +3009,21 @@ inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) ->
inf_union_collect(L, Opaque, InfFun, InfList, [N|ThrowList])
end.
-inf_union([?none|Left1], [?none|Left2], N, Acc, Opaques) ->
- inf_union(Left1, Left2, N, [?none|Acc], Opaques);
-inf_union([T1|Left1], [T2|Left2], N, Acc, Opaques) ->
- case t_inf(T1, T2, Opaques) of
- ?none -> inf_union(Left1, Left2, N, [?none|Acc], Opaques);
- T -> inf_union(Left1, Left2, N+1, [T|Acc], Opaques)
+inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) ->
+ inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
+inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) ->
+ try t_inf(T1, T2, Opaques) of
+ ?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
+ T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques)
+ catch throw:N when is_integer(N) ->
+ inf_union(Left1, Left2, N, [?none|Acc], [N|ThrowList], Opaques)
end;
-inf_union([], [], N, Acc, _Opaques) ->
- if N =:= 0 -> ?none;
+inf_union([], [], N, Acc, ThrowList, _Opaques) ->
+ if N =:= 0 -> {?none, ThrowList};
N =:= 1 ->
[Type] = [T || T <- Acc, T =/= ?none],
- Type;
- N >= 2 -> ?union(lists:reverse(Acc))
+ {Type, ThrowList};
+ N >= 2 -> {?union(lists:reverse(Acc)), ThrowList}
end.
inf_bitstr(U1, B1, U2, B2) ->
@@ -3156,6 +3162,18 @@ t_subst_aux(?union(List), VarMap) ->
t_subst_aux(T, _VarMap) ->
T.
+-spec subst_all_remote(erl_type(), erl_type()) -> erl_type().
+
+subst_all_remote(Type0, Substitute) ->
+ Map =
+ fun(Type) ->
+ case erl_types:t_is_remote(Type) of
+ true -> Substitute;
+ false -> Type
+ end
+ end,
+ erl_types:t_map(Map, Type0).
+
%%-----------------------------------------------------------------------------
%% Unification
%%
@@ -4469,7 +4487,7 @@ get_mod_record([{FieldName, DeclType}|Left1],
[{FieldName, ModType}|Left2], Acc) ->
ModTypeNoVars = subst_all_vars_to_any(ModType),
case
- t_is_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType)
+ contains_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType)
of
false -> {error, FieldName};
true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc])
@@ -4483,6 +4501,10 @@ get_mod_record(DeclFields, [], Acc) ->
get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) ->
{error, FieldName2}.
+contains_remote(Type) ->
+ TypeNoRemote = subst_all_remote(Type, t_none()),
+ not t_is_equal(Type, TypeNoRemote).
+
fields_from_form([], _TypeNames, _RecDict, _VarDict) ->
{[], []};
fields_from_form([{Name, Type}|Tail], TypeNames, RecDict,
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index dcd547fd5f..4691662f9f 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -1125,6 +1125,49 @@ trans_fun([{trim,N,NY}|Instructions], Env) ->
trans_fun([{line,_}|Instructions], Env) ->
trans_fun(Instructions,Env);
%%--------------------------------------------------------------------
+%% Map instructions added in Spring 2014 (17.0).
+%%--------------------------------------------------------------------
+trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ %% We assume that hipe_icode:mk_call has no side-effects, and reuse
+ %% the help function of get_map_elements below, discarding the value
+ %% assignment instruction list.
+ {TestInstructions, _GetInstructions, Env2} =
+ trans_map_query(MapVar, map_label(Lbl), Env1,
+ lists:flatten([[K, {r, 0}] || K <- Keys])),
+ [MapMove, TestInstructions | trans_fun(Instructions, Env2)];
+trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ {TestInstructions, GetInstructions, Env2} =
+ trans_map_query(MapVar, map_label(Lbl), Env1, KVPs),
+ [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)];
+%%--- put_map_assoc ---
+trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ TempMapVar = mk_var(new),
+ TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar),
+ {PutInstructions, Env2}
+ = case Lbl > 0 of
+ true ->
+ gen_put_map_instrs(exists, assoc, TempMapVar, Dst, Lbl, Pairs, Env1);
+ false ->
+ gen_put_map_instrs(new, assoc, TempMapVar, Dst, new, Pairs, Env1)
+ end,
+ [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
+%%--- put_map_exact ---
+trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) ->
+ {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env),
+ TempMapVar = mk_var(new),
+ TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar),
+ {PutInstructions, Env2}
+ = case Lbl > 0 of
+ true ->
+ gen_put_map_instrs(exists, exact, TempMapVar, Dst, Lbl, Pairs, Env1);
+ false ->
+ gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1)
+ end,
+ [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
+%%--------------------------------------------------------------------
%%--- ERROR HANDLING ---
%%--------------------------------------------------------------------
trans_fun([X|_], _) ->
@@ -1504,6 +1547,102 @@ trans_type_test2(function2, Lbl, Arg, Arity, Env) ->
hipe_icode:label_name(True), map_label(Lbl)),
{[Move1,Move2,I,True],Env2}.
+%%
+%% Handles the get_map_elements instruction and the has_map_fields
+%% test instruction.
+%%
+trans_map_query(_MapVar, _FailLabel, Env, []) ->
+ {[], [], Env};
+trans_map_query(MapVar, FailLabel, Env, [Key,Val|KVPs]) ->
+ {Move,KeyVar,Env1} = mk_move_and_var(Key,Env),
+ PassLabel = mk_label(new),
+ BoolVar = hipe_icode:mk_new_var(),
+ ValVar = mk_var(Val),
+ IsKeyCall = hipe_icode:mk_call([BoolVar], maps, is_key, [KeyVar, MapVar],
+ remote),
+ TrueTest = hipe_icode:mk_if('=:=', [BoolVar, hipe_icode:mk_const(true)],
+ hipe_icode:label_name(PassLabel), FailLabel),
+ GetCall = hipe_icode:mk_call([ValVar], maps, get, [KeyVar, MapVar], remote),
+ {TestList, GetList, Env2} = trans_map_query(MapVar, FailLabel, Env1, KVPs),
+ {[Move, IsKeyCall, TrueTest, PassLabel|TestList], [GetCall|GetList], Env2}.
+
+%%
+%% Generates a fail label if necessary when translating put_map_* instructions.
+%%
+gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) ->
+ TrueLabel = mk_label(new),
+ IsMapCode = hipe_icode:mk_type([TempMapVar], map,
+ hipe_icode:label_name(TrueLabel), map_label(FailLbl)),
+ DstMapVar = mk_var(Dst),
+ {ReturnLbl, PutInstructions, Env1}
+ = case Op of
+ assoc ->
+ trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
+ exact ->
+ trans_put_map_exact(TempMapVar, DstMapVar,
+ map_label(FailLbl), Pairs, Env, [])
+ end,
+ {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1};
+gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) ->
+ TrueLabel = mk_label(new),
+ FailLbl = mk_label(new),
+ IsMapCode = hipe_icode:mk_type([TempMapVar], map,
+ hipe_icode:label_name(TrueLabel),
+ hipe_icode:label_name(FailLbl)),
+ DstMapVar = mk_var(Dst),
+ {ReturnLbl, PutInstructions, Env1}
+ = case Op of
+ assoc ->
+ trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
+ exact ->
+ trans_put_map_exact(TempMapVar, DstMapVar,
+ hipe_icode:label_name(FailLbl), Pairs, Env, [])
+ end,
+ Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error),
+ {[IsMapCode, TrueLabel, PutInstructions, FailLbl, Fail, ReturnLbl], Env1}.
+
+%%-----------------------------------------------------------------------
+%% This function generates the instructions needed to insert several
+%% (Key, Value) pairs into an existing map, each recursive call inserts
+%% one (Key, Value) pair.
+%%-----------------------------------------------------------------------
+trans_put_map_assoc(MapVar, DestMapVar, [], Env, Acc) ->
+ MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar),
+ ReturnLbl = mk_label(new),
+ GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
+ {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
+trans_put_map_assoc(MapVar, DestMapVar, [Key, Value | Rest], Env, Acc) ->
+ {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
+ {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
+ BifCall = hipe_icode:mk_call([MapVar], maps, put,
+ [KeyVar, ValVar, MapVar], remote),
+ trans_put_map_assoc(MapVar, DestMapVar, Rest, Env2,
+ [BifCall, MoveVal, MoveKey | Acc]).
+
+%%-----------------------------------------------------------------------
+%% This function generates the instructions needed to update several
+%% (Key, Value) pairs in an existing map, each recursive call inserts
+%% one (Key, Value) pair.
+%%-----------------------------------------------------------------------
+trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) ->
+ MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar),
+ ReturnLbl = mk_label(new),
+ GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
+ {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
+trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) ->
+ SuccLbl = mk_label(new),
+ {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
+ {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
+ IsKey = hipe_icode:mk_new_var(),
+ BifCallIsKey = hipe_icode:mk_call([IsKey], maps, is_key,
+ [KeyVar, MapVar], remote),
+ IsKeyTest = hipe_icode:mk_if('=:=', [IsKey, hipe_icode:mk_const(true)],
+ hipe_icode:label_name(SuccLbl), FLbl),
+ BifCallPut = hipe_icode:mk_call([MapVar], maps, put,
+ [KeyVar, ValVar, MapVar], remote),
+ Acc1 = [BifCallPut, SuccLbl, IsKeyTest, BifCallIsKey, MoveVal, MoveKey | Acc],
+ trans_put_map_exact(MapVar, DestMapVar, FLbl, Rest, Env2, Acc1).
+
%%-----------------------------------------------------------------------
%% trans_puts(Code, Environment) ->
%% {Movs, Code, Vars, NewEnv}
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile
index acb2849d0d..009f503abb 100644
--- a/lib/hipe/test/Makefile
+++ b/lib/hipe/test/Makefile
@@ -10,7 +10,8 @@ MODULES= \
# .erl files for these modules are automatically generated
GEN_MODULES= \
- bs_SUITE
+ bs_SUITE \
+ maps_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl
new file mode 100644
index 0000000000..14d8320cdf
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl
@@ -0,0 +1,20 @@
+-module(maps_build_and_match_aliasing).
+-export([test/0]).
+
+test() ->
+ M1 = id(#{a=>1,b=>2,c=>3,d=>4}),
+ #{c:=C1=_=_=C2} = M1,
+ true = C1 =:= C2,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1,
+ #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1,
+ #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1,
+ #{c:=C=_=3=_=C} = M1,
+
+ M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}),
+ #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2,
+ #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2,
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl
new file mode 100644
index 0000000000..2abfa4e5b3
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl
@@ -0,0 +1,17 @@
+-module(maps_build_and_match_empty_val).
+-export([test/0]).
+
+test() ->
+ F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end,
+ ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl
new file mode 100644
index 0000000000..dc2c63fab2
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl
@@ -0,0 +1,40 @@
+-module(maps_build_and_match_literals).
+-export([test/0]).
+
+test() ->
+ #{} = id(#{}),
+ #{1:=a} = id(#{1=>a}),
+ #{1:=a,2:=b} = id(#{1=>a,2=>b}),
+ #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}),
+ #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}),
+ #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} =
+ id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}),
+
+ #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}),
+
+ #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =)
+
+ #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} =
+ id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}),
+
+ M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first},
+ M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} =
+ id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}),
+
+ %% nil key
+ #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}),
+
+ %% error case
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl
new file mode 100644
index 0000000000..dae6f64e5f
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl
@@ -0,0 +1,16 @@
+-module(maps_build_and_match_over_alloc).
+-export([test/0]).
+
+test() ->
+ Ls = id([1,2,3]),
+ V0 = [a|Ls],
+ M0 = id(#{ "a" => V0 }),
+ #{ "a" := V1 } = M0,
+ V2 = id([c|Ls]),
+ M2 = id(#{ "a" => V2 }),
+ #{ "a" := V3 } = M2,
+ {[a,1,2,3],[c,1,2,3]} = id({V1,V3}),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl
new file mode 100644
index 0000000000..284f69e06c
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl
@@ -0,0 +1,23 @@
+-module(maps_build_and_match_val).
+-export([test/0]).
+
+test() ->
+ F = fun
+ (#{ "hi" := first, v := V}) -> {1,V};
+ (#{ "hi" := second, v := V}) -> {2,V}
+ end,
+
+
+ {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})),
+ {2,"second"} = F(id(#{"hi"=>second,v=>"second"})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl
new file mode 100644
index 0000000000..df0f77ea47
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl
@@ -0,0 +1,7 @@
+-module(maps_expand_map_update).
+-export([test/0]).
+
+test() ->
+ M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>},
+ #{<<"hello">> := <<"les gens">>} = M,
+ ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_export.erl b/lib/hipe/test/maps_SUITE_data/maps_export.erl
new file mode 100644
index 0000000000..4d43fc96ed
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_export.erl
@@ -0,0 +1,11 @@
+-module(maps_export).
+-export([test/0]).
+
+test() ->
+ Raclette = id(#{}),
+ case brie of brie -> Fromage = Raclette end,
+ Raclette = Fromage#{},
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl
new file mode 100644
index 0000000000..b2d749796a
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl
@@ -0,0 +1,23 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_get_map_elements).
+
+-export([test/0]).
+
+test() ->
+ {A, B} = id({"hej", <<123>>}),
+ Map = maps:from_list([{a, A}, {b, B}]),
+ #{a := A, b := B} = id(Map),
+ false = test_pattern(Map),
+ true = test_pattern(#{b => 1, a => "hej"}),
+ case Map of
+ #{a := C, b := <<124>>} -> yay;
+ _ -> C = B, nay
+ end,
+ C = id(B),
+ ok.
+
+id(X) -> X.
+
+test_pattern(#{a := _, b := 1}) -> true;
+test_pattern(#{}) -> false.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl
new file mode 100644
index 0000000000..61a0eaa1e7
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl
@@ -0,0 +1,31 @@
+-module(maps_guard_bifs).
+-export([test/0]).
+
+test() ->
+ true = map_guard_empty(),
+ true = map_guard_empty_2(),
+ true = map_guard_head(#{a=>1}),
+ false = map_guard_head([]),
+ true = map_guard_body(#{a=>1}),
+ false = map_guard_body({}),
+ true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }),
+ false = map_guard_pattern("list"),
+ true = map_guard_tautology(),
+ true = map_guard_ill_map_size(),
+ ok.
+
+map_guard_empty() when is_map(#{}); false -> true.
+
+map_guard_empty_2() when true; #{} andalso false -> true.
+
+map_guard_head(M) when is_map(M) -> true;
+map_guard_head(_) -> false.
+
+map_guard_body(M) -> is_map(M).
+
+map_guard_pattern(#{}) -> true;
+map_guard_pattern(_) -> false.
+
+map_guard_tautology() when #{} =:= #{}; true -> true.
+
+map_guard_ill_map_size() when true; map_size(0) -> true.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl
new file mode 100644
index 0000000000..9f6eb3a04e
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl
@@ -0,0 +1,36 @@
+-module(maps_guard_fun).
+-export([test/0]).
+
+test() ->
+ F1 = fun
+ (#{s:=v,v:=V}) -> {v,V};
+ (#{s:=t,v:={V,V}}) -> {t,V};
+ (#{s:=l,v:=[V,V]}) -> {l,V}
+ end,
+
+ F2 = fun
+ (#{s:=T,v:={V,V}}) -> {T,V};
+ (#{s:=T,v:=[V,V]}) -> {T,V};
+ (#{s:=T,v:=V}) -> {T,V}
+ end,
+ V = <<"hi">>,
+
+ {v,V} = F1(#{s=>v,v=>V}),
+ {t,V} = F1(#{s=>t,v=>{V,V}}),
+ {l,V} = F1(#{s=>l,v=>[V,V]}),
+
+ {v,V} = F2(#{s=>v,v=>V}),
+ {t,V} = F2(#{s=>t,v=>{V,V}}),
+ {l,V} = F2(#{s=>l,v=>[V,V]}),
+
+ %% error case
+ case (catch F1(#{s=>none,v=>none})) of
+ {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok;
+ {'EXIT', {function_clause,[{?MODULE,_,1,[#{s:=none,v:=none}]}|_]}} -> ok;
+ {'EXIT', {function_clause,[Frame|_]}}
+ when is_tuple(Frame), element(1, Frame) =:= ?MODULE ->
+ test_server:comment("Unexpected trace format, probably using HiPE");
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl
new file mode 100644
index 0000000000..f84ba19c86
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl
@@ -0,0 +1,54 @@
+-module(maps_guard_receive).
+-export([test/0]).
+
+test() ->
+ M0 = #{ id => 0 },
+ Pid = spawn_link(fun() -> guard_receive_loop() end),
+ Big = 36893488147419103229,
+ B1 = <<"some text">>,
+ B2 = <<"was appended">>,
+ B3 = <<B1/binary, B2/binary>>,
+
+ #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}),
+ #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}),
+ #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}),
+ #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}),
+ #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}),
+ #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}),
+ #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}),
+
+
+ %% update old maps and check id update
+ #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}),
+ #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}),
+
+ %% cleanup
+ done = call(Pid, done),
+ ok.
+
+call(Pid, M) ->
+ Pid ! {self(), M}, receive {Pid, Res} -> Res end.
+
+guard_receive_loop() ->
+ receive
+ {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) ->
+ Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=add, in:={X,Y}}} ->
+ Pid ! {self(), #{ id=>Id+1, res=>X+Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X-Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X div Y}},
+ guard_receive_loop();
+ {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} ->
+ Pid ! {self(), M#{ id=>Id+1, res=>X * Y}},
+ guard_receive_loop();
+ {Pid, done} ->
+ Pid ! {self(), done};
+ {Pid, Other} ->
+ Pid ! {error, Other},
+ guard_receive_loop()
+ end.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl
new file mode 100644
index 0000000000..4eb18dcea1
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl
@@ -0,0 +1,35 @@
+-module(maps_guard_sequence).
+-export([test/0]).
+
+test() ->
+ {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}),
+ {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}),
+ {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}),
+ {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}),
+ {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}),
+
+ {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})),
+ {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})),
+ {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})),
+ {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})),
+ {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})),
+
+ %% error case
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})),
+ {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})),
+ ok.
+
+map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val};
+map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}.
+
+map_guard_sequence_2(#{ a:=3 }=M) -> {1, M};
+map_guard_sequence_2(#{ a:=4 }=M) -> {2, M};
+map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M};
+map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M};
+map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl
new file mode 100644
index 0000000000..254c1c2984
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl
@@ -0,0 +1,14 @@
+-module(maps_guard_update).
+-export([test/0]).
+
+test() ->
+ error = map_guard_update(#{},#{}),
+ first = map_guard_update(#{}, #{x=>first}),
+ second = map_guard_update(#{y=>old}, #{x=>second,y=>old}),
+ third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}),
+ ok.
+
+map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first;
+map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second;
+map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third;
+map_guard_update(_, _) -> error.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl
new file mode 100644
index 0000000000..61653aa519
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl
@@ -0,0 +1,46 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_has_map_fields).
+
+-export([test/0]).
+
+test() ->
+ false = has_a_field(#{}),
+ false = has_a_field(#{b => 2}),
+ true = has_a_field(#{a => 3}),
+ true = has_a_field(#{b => c, a => false}),
+
+ false = has_a_b_field(#{a => true}),
+ false = has_a_b_field(#{b => a}),
+ true = has_a_b_field(#{a => 1, b => 2}),
+ true = has_a_b_field(#{b => 3, a => 4}),
+
+ false = has_binary_field(#{}),
+ false = has_binary_field(#{#{} => yay}),
+ true = has_binary_field(#{<<"true">> => false}),
+
+ false = has_binary_but_no_map_field(#{}),
+ false = has_map_but_no_binary_field(#{}),
+ false = has_binary_but_no_map_field(#{#{} => 1}),
+ false = has_map_but_no_binary_field(#{<<"true">> => true}),
+ true = has_binary_but_no_map_field(#{<<"true">> => false}),
+ true = has_map_but_no_binary_field(#{#{} => 1}),
+ false = has_binary_but_no_map_field(#{<<"true">> => true, #{} => 1}),
+ false = has_map_but_no_binary_field(#{<<"true">> => true, #{} => 1}),
+ ok.
+
+has_a_field(#{a := _}) -> true;
+has_a_field(#{}) -> false.
+
+has_a_b_field(#{a := _, b := _}) -> true;
+has_a_b_field(#{}) -> false.
+
+has_binary_field(#{<<"true">> := _}) -> true;
+has_binary_field(#{}) -> false.
+
+has_map_but_no_binary_field(#{<<"true">> := _}) -> false;
+has_map_but_no_binary_field(#{} = M) -> maps:is_key(#{}, M).
+
+has_binary_but_no_map_field(#{<<"true">> := _} = M) ->
+ not maps:is_key(#{}, M);
+has_binary_but_no_map_field(#{}) -> false.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_is_map.erl b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl
new file mode 100644
index 0000000000..e84f4b8c44
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl
@@ -0,0 +1,24 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_is_map).
+
+-export([test/0]).
+
+test() ->
+ true = test_is_map(#{}),
+ false = test_is_map(<<"hej">>),
+ true = test_is_map_guard(#{a => b}),
+ false = test_is_map_guard(3),
+ true = test_is_map_with_binary_guard(#{"a" => <<"b">>}),
+ false = test_is_map_with_binary_guard(12),
+ ok.
+
+test_is_map(X) ->
+ is_map(X).
+
+test_is_map_guard(Map) when is_map(Map) -> true;
+test_is_map_guard(_) -> false.
+
+test_is_map_with_binary_guard(B) when is_binary(B) -> false;
+test_is_map_with_binary_guard(#{}) -> true;
+test_is_map_with_binary_guard(_) -> false.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl
new file mode 100644
index 0000000000..ad2c726d65
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl
@@ -0,0 +1,6 @@
+-module(maps_list_comprehension).
+-export([test/0]).
+
+test() ->
+ [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]],
+ ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
new file mode 100644
index 0000000000..25c8e5d4c7
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
@@ -0,0 +1,29 @@
+-module(maps_map_size).
+-export([test/0]).
+
+test() ->
+ 0 = map_size(id(#{})),
+ 1 = map_size(id(#{a=>1})),
+ 1 = map_size(id(#{a=>"wat"})),
+ 2 = map_size(id(#{a=>1, b=>2})),
+ 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})),
+
+ true = map_is_size(#{a=>1}, 1),
+ true = map_is_size(#{a=>1, a=>2}, 1),
+ M = #{ "a" => 1, "b" => 2},
+ true = map_is_size(M, 2),
+ false = map_is_size(M, 3),
+ true = map_is_size(M#{ "a" => 2}, 2),
+ false = map_is_size(M#{ "c" => 2}, 2),
+
+ %% Error cases.
+ {'EXIT',{badarg,_}} = (catch map_size([])),
+ {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)),
+ {'EXIT',{badarg,_}} = (catch map_size(1)),
+ ok.
+
+map_is_size(M,N) when map_size(M) =:= N -> true;
+map_is_size(_,_) -> false.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
new file mode 100644
index 0000000000..31abf15d49
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
@@ -0,0 +1,41 @@
+-module(maps_map_sort_literals).
+-export([test/0]).
+
+test() ->
+ % test relation
+
+ %% size order
+ true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}),
+ true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}),
+ false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}),
+
+ %% key order
+ true = id(#{ a => 1 }) < id(#{ b => 1}),
+ false = id(#{ b => 1 }) < id(#{ a => 1}),
+ true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}),
+ true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}),
+ true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}),
+ true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}),
+ false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}),
+ false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
+ false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}),
+
+ %% value order
+ true = id(#{ a => 1 }) < id(#{ a => 2}),
+ false = id(#{ a => 2 }) < id(#{ a => 1}),
+ false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}),
+ true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}),
+
+ true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}),
+
+ %% lists:sort
+
+ SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}],
+ [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]),
+ [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs),
+ [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)),
+
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl
new file mode 100644
index 0000000000..29a6a29290
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl
@@ -0,0 +1,24 @@
+-module(maps_match_and_update_literals).
+-export([test/0]).
+
+test() ->
+ Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1},
+ #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [
+ {1,2},{3,4},{5,6},{7,8}
+ ]),
+ M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat}),
+ M1 = id(#{}),
+ M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>,
+ 4 => number, 18446744073709551629 => wat},
+ M0 = M2,
+
+ #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number },
+ ok.
+
+loop_match_and_update_literals_x_q(Map, []) -> Map;
+loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) ->
+ loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs).
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
new file mode 100644
index 0000000000..72ac9ce078
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
@@ -0,0 +1,23 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_put_map_assoc).
+
+-export([test/0]).
+
+test() ->
+ true = assoc_guard(#{}),
+ false = assoc_guard(not_a_map),
+ #{a := true} = assoc_update(#{}),
+ {'EXIT', {badarg, [{?MODULE, assoc_update, 1, _}|_]}}
+ = (catch assoc_update(not_a_map)),
+ ok = assoc_guard_clause(#{}),
+ {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}}
+ = (catch assoc_guard_clause(not_a_map)),
+ ok.
+
+assoc_guard(M) when is_map(M#{a => b}) -> true;
+assoc_guard(_) -> false.
+
+assoc_update(M) -> M#{a => true}.
+
+assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
new file mode 100644
index 0000000000..1cfcd80180
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
@@ -0,0 +1,28 @@
+%% -*- erlang-indent-level: 2 -*-
+%%-------------------------------------------------------------------------
+-module(maps_put_map_exact).
+
+-export([test/0]).
+
+test() ->
+ false = exact_guard(#{b => a}),
+ false = exact_guard(not_a_map),
+ true = exact_guard(#{a => false}),
+ #{a := true} = exact_update(#{a => false}),
+ {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}}
+ = (catch exact_update(not_a_map)),
+ {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}}
+ = (catch exact_update(#{})),
+ ok = exact_guard_clause(#{a => yes}),
+ {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}}
+ = (catch exact_guard_clause(#{})),
+ {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}}
+ = (catch exact_guard_clause(not_a_map)),
+ ok.
+
+exact_guard(M) when is_map(M#{a := b}) -> true;
+exact_guard(_) -> false.
+
+exact_update(M) -> M#{a := true}.
+
+exact_guard_clause(M) when is_map(M#{a := 42}) -> ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
new file mode 100644
index 0000000000..cc7c1353de
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
@@ -0,0 +1,22 @@
+-module(maps_update_assoc).
+-export([test/0]).
+
+test() ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1=>42,2=>100,4=>[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{3.0=>new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,3.0=>new},
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
new file mode 100644
index 0000000000..6e5acb3283
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
@@ -0,0 +1,32 @@
+-module(maps_update_exact).
+-export([test/0]).
+
+test() ->
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{1:=42,2:=100,4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]},
+
+ M2 = M0#{3.0:=new},
+ #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,3.0:=new},
+ true = M2 =/= M0#{3=>right,3.0:=new},
+ #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new},
+
+ M3 = id(#{ 1 => val}),
+ #{1 := update2,1.0 := new_val4} = M3#{
+ 1.0 => new_val1, 1 := update, 1=> update3,
+ 1 := update2, 1.0 := new_val2, 1.0 => new_val3,
+ 1.0 => new_val4 },
+
+ %% Errors cases.
+ {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })),
+ {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl
new file mode 100644
index 0000000000..87aea3d8e1
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl
@@ -0,0 +1,13 @@
+-module(maps_update_literals).
+-export([test/0]).
+
+test() ->
+ Map = #{x=>1,y=>2,z=>3,q=>4},
+ #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [
+ {"a","1"},{"b","2"},{"c","3"},{"d","4"}
+ ]),
+ ok.
+
+loop_update_literals_x_q(Map, []) -> Map;
+loop_update_literals_x_q(Map, [{X,Q}|Vs]) ->
+ loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs).
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
new file mode 100644
index 0000000000..181e3f18f7
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
@@ -0,0 +1,32 @@
+-module(maps_update_map_expressions).
+-export([test/0]).
+
+test() ->
+ M = maps:new(),
+ X = id(fondue),
+ M1 = #{ a := 1 } = M#{a => 1},
+ #{ b := {X} } = M1#{ a := 1, b => {X} },
+
+ #{ b := 2 } = (maps:new())#{ b => 2 },
+
+ #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 },
+ #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 },
+
+ %% Test need to be in a fun.
+ %% This tests that let expr optimisation in sys_core_fold
+ %% covers maps correctly.
+ F = fun() ->
+ M0 = id(#{ "a" => [1,2,3] }),
+ #{ "a" := _ } = M0,
+ M0#{ "a" := b }
+ end,
+
+ #{ "a" := b } = F(),
+
+ %% Error cases, FIXME: should be 'badmap'?
+ {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }),
+ {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_values.erl b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl
new file mode 100644
index 0000000000..bbad5ac19e
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl
@@ -0,0 +1,28 @@
+-module(maps_update_values).
+-export([test/0]).
+
+test() ->
+ V0 = id(1337),
+ M0 = #{ a => 1, val => V0},
+ V1 = get_val(M0),
+ M1 = M0#{ val := [V0,V1], "wazzup" => 42 },
+ [1337, {some_val, 1337}] = get_val(M1),
+
+ N = 110,
+ List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)],
+
+ {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun
+ ({V2,V3},{Old2,Old3,Mi}) ->
+ ok = check_val(Mi,Old2,Old3),
+ #{ val1 := Old2, val2 := Old3 } = Mi,
+ {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}}
+ end, {none, none, #{val1=>none,val2=>none}},List),
+ ok.
+
+get_val(#{ "wazzup" := _, val := V}) -> V;
+get_val(#{ val := V }) -> {some_val, V}.
+
+check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl
new file mode 100644
index 0000000000..76b2a91f94
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl
@@ -0,0 +1,27 @@
+-module(maps_warn_pair_key_overloaded).
+-export([test/0]).
+
+test() ->
+ #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }),
+
+ #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{
+ "hi1" => erlang:atom_to_binary(?MODULE,utf8),
+ "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8),
+ "hi1" => erlang:binary_to_float(<<"3.1416">>),
+ "hi1" => erlang:float_to_binary(3.1416),
+ "hi2" => erlang:pid_to_list(self()),
+ "hi3" => erlang:float_to_binary(3.1416),
+ "hi2" => lists:subtract([1,2],[1]),
+ "hi3" => +3,
+ "hi1" => erlang:min(1,2),
+ "hi1" => erlang:hash({1,2},35),
+ "hi1" => erlang:phash({1,2},33),
+ "hi1" => erlang:phash2({1,2},34),
+ "hi1" => erlang:integer_to_binary(1337),
+ "hi1" => erlang:binary_to_integer(<<"1337">>),
+ "hi4" => erlang:float_to_binary(3.1416)
+ }),
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl
new file mode 100644
index 0000000000..6cb0366314
--- /dev/null
+++ b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl
@@ -0,0 +1,9 @@
+-module(maps_warn_useless_build).
+-export([test/0]).
+
+test() ->
+ [#{ a => id(I)} || I <- [1,2,3]],
+ ok.
+
+%% Use this function to avoid compile-time evaluation of an expression.
+id(I) -> I.
diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
index 6052ae9022..e8148ea362 100644
--- a/lib/inets/src/http_server/httpd.erl
+++ b/lib/inets/src/http_server/httpd.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2014. 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
@@ -294,9 +294,13 @@ do_reload_config(ConfigList, Mode) ->
{ok, Config} ->
Address = proplists:get_value(bind_address, Config, any),
Port = proplists:get_value(port, Config, 80),
- block(Address, Port, Mode),
- reload(Config, Address, Port),
- unblock(Address, Port);
+ case block(Address, Port, Mode) of
+ ok ->
+ reload(Config, Address, Port),
+ unblock(Address, Port);
+ Error ->
+ Error
+ end;
Error ->
Error
end.
diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl
index e155498bb8..3da0343401 100644
--- a/lib/inets/src/http_server/httpd_manager.erl
+++ b/lib/inets/src/http_server/httpd_manager.erl
@@ -210,9 +210,10 @@ handle_call({block , Blocker, Mode, Timeout}, From,
handle_call({block , _, _, _}, _, State) ->
{reply, {error, blocked}, State};
-handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker,_},
+handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker, Monitor},
admin_state = blocked} = State) ->
-
+
+ erlang:demonitor(Monitor),
{reply, ok,
State#state{admin_state = unblocked, blocker_ref = undefined}};
@@ -247,37 +248,36 @@ handle_cast(Message, State) ->
handle_info(connections_terminated, #state{admin_state = shutting_down,
blocking_from = From} = State) ->
gen_server:reply(From, ok),
- {noreply, State#state{admin_state = blocked, blocking_from = undefined,
- blocker_ref = undefined}};
+ {noreply, State#state{admin_state = blocked, blocking_from = undefined}};
handle_info(connections_terminated, State) ->
{noreply, State};
-handle_info({block_timeout, non_disturbing},
+handle_info({block_timeout, non_disturbing, Blocker},
#state{admin_state = shutting_down,
blocking_from = From,
- blocker_ref = {_, Monitor}} = State) ->
+ blocker_ref = {_, Monitor} = Blocker} = State) ->
erlang:demonitor(Monitor),
gen_server:reply(From, {error, timeout}),
{noreply, State#state{admin_state = unblocked, blocking_from = undefined,
blocker_ref = undefined}};
-handle_info({block_timeout, disturbing},
+handle_info({block_timeout, disturbing, Blocker},
#state{admin_state = shutting_down,
blocking_from = From,
- blocker_ref = {_, Monitor},
+ blocker_ref = Blocker,
connection_sup = Sup} = State) ->
SupPid = whereis(Sup),
shutdown_connections(SupPid),
- erlang:demonitor(Monitor),
gen_server:reply(From, ok),
- {noreply, State#state{admin_state = blocked, blocker_ref = undefined,
+ {noreply, State#state{admin_state = blocked,
blocking_from = undefined}};
handle_info({block_timeout, _, _}, State) ->
{noreply, State};
handle_info({'DOWN', _, process, Pid, _Info},
#state{admin_state = Admin,
- blocker_ref = {Pid, _}} = State) when
+ blocker_ref = {Pid, Monitor}} = State) when
Admin =/= unblocked ->
+ erlang:demonitor(Monitor),
{noreply, State#state{admin_state = unblocked,
blocking_from = undefined,
blocker_ref = undefined}};
@@ -333,18 +333,16 @@ handle_new_connection(_UsageState, _AdminState, State, _Handler) ->
handle_block(disturbing, infinity,
#state{connection_sup = CSup,
- blocking_from = From,
- blocker_ref = {_, Monitor}} = State) ->
+ blocking_from = From} = State) ->
SupPid = whereis(CSup),
shutdown_connections(SupPid),
- erlang:demonitor(Monitor),
gen_server:reply(From, ok),
- {noreply, State#state{admin_state = blocked, blocker_ref = undefined,
+ {noreply, State#state{admin_state = blocked,
blocking_from = undefined}};
-handle_block(disturbing, Timeout, #state{connection_sup = CSup} = State) ->
+handle_block(disturbing, Timeout, #state{connection_sup = CSup, blocker_ref = Blocker} = State) ->
Manager = self(),
spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end),
- erlang:send_after(Timeout, self(), {block_timeout, disturbing}),
+ erlang:send_after(Timeout, self(), {block_timeout, disturbing, Blocker}),
{noreply, State#state{admin_state = shutting_down}};
handle_block(non_disturbing, infinity,
@@ -354,10 +352,10 @@ handle_block(non_disturbing, infinity,
{noreply, State#state{admin_state = shutting_down}};
handle_block(non_disturbing, Timeout,
- #state{connection_sup = CSup} = State) ->
+ #state{connection_sup = CSup, blocker_ref = Blocker} = State) ->
Manager = self(),
spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end),
- erlang:send_after(Timeout, self(), {block_timeout, non_disturbing}),
+ erlang:send_after(Timeout, self(), {block_timeout, non_disturbing, Blocker}),
{noreply, State#state{admin_state = shutting_down}}.
handle_reload(undefined, #state{config_file = undefined} = State) ->
diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl
index 706d014bda..9790623b6f 100644
--- a/lib/inets/test/httpd_block.erl
+++ b/lib/inets/test/httpd_block.erl
@@ -111,8 +111,7 @@ block_disturbing_active_timeout_not_released(Type, Port, Host, Node) ->
process_flag(trap_exit, true),
Poller = long_poll(Type, Host, Port, Node, 200, 60000),
ct:sleep(15000),
- Blocker = blocker(Node, Host, Port, 50000),
- await_normal_process_exit(Blocker, "blocker", 50000),
+ ok = httpd_block(undefined, Port, disturbing, 50000),
await_normal_process_exit(Poller, "poller", 30000),
blocked = get_admin_state(Node, Host, Port),
process_flag(trap_exit, false),
@@ -123,8 +122,7 @@ block_disturbing_active_timeout_released(Type, Port, Host, Node) ->
process_flag(trap_exit, true),
Poller = long_poll(Type, Host, Port, Node, 200, 40000),
ct:sleep(5000),
- Blocker = blocker(Node, Host, Port, 10000),
- await_normal_process_exit(Blocker, "blocker", 15000),
+ ok = httpd_block(undefined, Port, disturbing, 10000),
await_suite_failed_process_exit(Poller, "poller", 40000,
connection_closed),
blocked = get_admin_state(Node, Host, Port),
diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl
index cf28f5a245..60979278fc 100644
--- a/lib/inets/test/inets_sup_SUITE.erl
+++ b/lib/inets/test/inets_sup_SUITE.erl
@@ -77,75 +77,32 @@ end_per_suite(_) ->
%% variable, but should NOT alter/remove any existing entries.
%%--------------------------------------------------------------------
init_per_testcase(httpd_subtree, Config) ->
- io:format("init_per_testcase(httpd_subtree) -> entry with"
- "~n Config: ~p"
- "~n", [Config]),
Dog = test_server:timetrap(?t:minutes(1)),
NewConfig = lists:keydelete(watchdog, 1, Config),
-
- DataDir = ?config(data_dir, Config),
PrivDir = ?config(priv_dir, Config),
- ServerROOT = filename:join(PrivDir, "server_root"),
- DocROOT = filename:join(PrivDir, "htdocs"),
- ConfDir = filename:join(ServerROOT, "conf"),
-
- io:format("init_per_testcase(httpd_subtree) -> create dir(s)"
- "~n", []),
- file:make_dir(ServerROOT), %% until http_test is cleaned up!
- ok = file:make_dir(DocROOT),
- ok = file:make_dir(ConfDir),
-
- io:format("init_per_testcase(httpd_subtree) -> copy file(s)"
- "~n", []),
- {ok, _} = inets_test_lib:copy_file("simple.conf", DataDir, PrivDir),
- {ok, _} = inets_test_lib:copy_file("mime.types", DataDir, ConfDir),
-
- io:format("init_per_testcase(httpd_subtree) -> write file(s)"
- "~n", []),
- ConfFile = filename:join(PrivDir, "simple.conf"),
- {ok, Fd} = file:open(ConfFile, [append]),
- ok = file:write(Fd, "ServerRoot " ++ ServerROOT ++ "\n"),
- ok = file:write(Fd, "DocumentRoot " ++ DocROOT ++ "\n"),
- ok = file:close(Fd),
-
- %% To make sure application:set_env is not overwritten by any
- %% app-file settings.
- io:format("init_per_testcase(httpd_subtree) -> load inets app"
- "~n", []),
- application:load(inets),
- io:format("init_per_testcase(httpd_subtree) -> update inets env"
- "~n", []),
- ok = application:set_env(inets, services, [{httpd, ConfFile}]),
-
+
+ SimpleConfig = [{port, 0},
+ {server_name,"www.test"},
+ {modules, [mod_get]},
+ {server_root, PrivDir},
+ {document_root, PrivDir},
+ {bind_address, any},
+ {ipfamily, inet}],
try
- io:format("init_per_testcase(httpd_subtree) -> start inets app"
- "~n", []),
- ok = inets:start(),
- io:format("init_per_testcase(httpd_subtree) -> done"
- "~n", []),
- [{watchdog, Dog}, {server_root, ServerROOT}, {doc_root, DocROOT},
- {conf_dir, ConfDir}| NewConfig]
+ inets:start(),
+ inets:start(httpd, SimpleConfig),
+ [{watchdog, Dog} | NewConfig]
catch
_:Reason ->
- io:format("init_per_testcase(httpd_subtree) -> "
- "failed starting inets - cleanup"
- "~n Reason: ~p"
- "~n", [Reason]),
- application:unset_env(inets, services),
- application:unload(inets),
+ inets:stop(),
exit({failed_starting_inets, Reason})
end;
-init_per_testcase(Case, Config) ->
- io:format("init_per_testcase(~p) -> entry with"
- "~n Config: ~p"
- "~n", [Case, Config]),
+init_per_testcase(_Case, Config) ->
Dog = test_server:timetrap(?t:minutes(5)),
NewConfig = lists:keydelete(watchdog, 1, Config),
- Stop = inets:stop(),
- io:format("init_per_testcase(~p) -> Stop: ~p"
- "~n", [Case, Stop]),
+ inets:stop(),
ok = inets:start(),
[{watchdog, Dog} | NewConfig].
@@ -280,30 +237,21 @@ httpd_subtree(doc) ->
httpd_subtree(suite) ->
[];
httpd_subtree(Config) when is_list(Config) ->
- io:format("httpd_subtree -> entry with"
- "~n Config: ~p"
- "~n", [Config]),
-
%% Check that we have the httpd top supervisor
- io:format("httpd_subtree -> verify inets~n", []),
{ok, _} = verify_child(inets_sup, httpd_sup, supervisor),
%% Check that we have the httpd instance supervisor
- io:format("httpd_subtree -> verify httpd~n", []),
{ok, Id} = verify_child(httpd_sup, httpd_instance_sup, supervisor),
{httpd_instance_sup, Addr, Port} = Id,
Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port),
%% Check that we have the expected httpd instance children
- io:format("httpd_subtree -> verify httpd instance children "
- "(acceptor, misc and manager)~n", []),
{ok, _} = verify_child(Instance, httpd_connection_sup, supervisor),
{ok, _} = verify_child(Instance, httpd_acceptor_sup, supervisor),
{ok, _} = verify_child(Instance, httpd_misc_sup, supervisor),
{ok, _} = verify_child(Instance, httpd_manager, worker),
%% Check that the httpd instance acc supervisor has children
- io:format("httpd_subtree -> verify acc~n", []),
InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port),
case supervisor:which_children(InstanceAcc) of
[_ | _] ->
@@ -328,15 +276,7 @@ httpd_subtree(Config) when is_list(Config) ->
verify_child(Parent, Child, Type) ->
-%% io:format("verify_child -> entry with"
-%% "~n Parent: ~p"
-%% "~n Child: ~p"
-%% "~n Type: ~p"
-%% "~n", [Parent, Child, Type]),
Children = supervisor:which_children(Parent),
-%% io:format("verify_child -> which children"
-%% "~n Children: ~p"
-%% "~n", [Children]),
verify_child(Children, Parent, Child, Type).
verify_child([], Parent, Child, _Type) ->
@@ -344,21 +284,12 @@ verify_child([], Parent, Child, _Type) ->
verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) ->
case lists:member(Child, Mods) of
true when (Type2 =:= Type) ->
-%% io:format("verify_child -> found with expected type"
-%% "~n Id: ~p"
-%% "~n", [Id]),
{ok, Id};
true when (Type2 =/= Type) ->
-%% io:format("verify_child -> found with unexpected type"
-%% "~n Type2: ~p"
-%% "~n Id: ~p"
-%% "~n", [Type2, Id]),
{error, {wrong_type, Type2, Child, Parent}};
false ->
verify_child(Children, Parent, Child, Type)
end.
-
-
%%-------------------------------------------------------------------------
%% httpc_subtree
@@ -368,40 +299,19 @@ httpc_subtree(doc) ->
httpc_subtree(suite) ->
[];
httpc_subtree(Config) when is_list(Config) ->
- tsp("httpc_subtree -> entry with"
- "~n Config: ~p", [Config]),
+ {ok, Foo} = inets:start(httpc, [{profile, foo}]),
- tsp("httpc_subtree -> start inets service httpc with profile foo"),
- {ok, _Foo} = inets:start(httpc, [{profile, foo}]),
+ {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone),
- tsp("httpc_subtree -> "
- "start stand-alone inets service httpc with profile bar"),
- {ok, _Bar} = inets:start(httpc, [{profile, bar}], stand_alone),
-
- tsp("httpc_subtree -> retreive list of httpc instances"),
HttpcChildren = supervisor:which_children(httpc_profile_sup),
- tsp("httpc_subtree -> HttpcChildren: ~n~p", [HttpcChildren]),
-
- tsp("httpc_subtree -> verify httpc stand-alone instances"),
+
{value, {httpc_manager, _, worker, [httpc_manager]}} =
lists:keysearch(httpc_manager, 1, HttpcChildren),
- tsp("httpc_subtree -> verify httpc (named) instances"),
- {value,{{httpc,foo}, Pid, worker, [httpc_manager]}} =
+ {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} =
lists:keysearch({httpc, foo}, 1, HttpcChildren),
false = lists:keysearch({httpc, bar}, 1, HttpcChildren),
- tsp("httpc_subtree -> stop inets"),
- inets:stop(httpc, Pid),
-
- tsp("httpc_subtree -> done"),
- ok.
-
-tsp(F) ->
- tsp(F, []).
-tsp(F, A) ->
- test_server:format("~p ~p:" ++ F ++ "~n", [self(), ?MODULE | A]).
-
-tsf(Reason) ->
- test_server:fail(Reason).
+ inets:stop(httpc, Foo),
+ exit(Bar, normal).
diff --git a/lib/inets/test/inets_sup_SUITE_data/mime.types b/lib/inets/test/inets_sup_SUITE_data/mime.types
deleted file mode 100644
index e52d345ff7..0000000000
--- a/lib/inets/test/inets_sup_SUITE_data/mime.types
+++ /dev/null
@@ -1,3 +0,0 @@
-# MIME type Extension
-text/html html htm
-text/plain asc txt
diff --git a/lib/inets/test/inets_sup_SUITE_data/simple.conf b/lib/inets/test/inets_sup_SUITE_data/simple.conf
deleted file mode 100644
index e1429b4a28..0000000000
--- a/lib/inets/test/inets_sup_SUITE_data/simple.conf
+++ /dev/null
@@ -1,6 +0,0 @@
-Port 8888
-ServerName www.test
-SocketType ip_comm
-Modules mod_get
-ServerAdmin [email protected]
-
diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl
index 3e1a1a3845..19c2bc129e 100644
--- a/lib/inets/test/old_httpd_SUITE.erl
+++ b/lib/inets/test/old_httpd_SUITE.erl
@@ -182,22 +182,24 @@ groups() ->
%% ip_load_medium,
%% ip_load_heavy,
%%ip_dos_hostname,
- ip_time_test
- %% Replaced by load_config
- %% ip_restart_no_block,
- %% ip_restart_disturbing_block,
- %% ip_restart_non_disturbing_block,
- %% ip_block_disturbing_idle,
- %% ip_block_non_disturbing_idle,
- %% ip_block_503,
- %% ip_block_disturbing_active,
- %% ip_block_non_disturbing_active,
- %% ip_block_disturbing_active_timeout_not_released,
- %% ip_block_disturbing_active_timeout_released,
- %% ip_block_non_disturbing_active_timeout_not_released,
- %% ip_block_non_disturbing_active_timeout_released,
- %% ip_block_disturbing_blocker_dies,
- %% ip_block_non_disturbing_blocker_dies
+ ip_time_test,
+ %% Only used through load_config
+ %% but we still need these tests
+ %% should be cleaned up and moved to new test suite
+ ip_restart_no_block,
+ ip_restart_disturbing_block,
+ ip_restart_non_disturbing_block,
+ ip_block_disturbing_idle,
+ ip_block_non_disturbing_idle,
+ ip_block_503,
+ ip_block_disturbing_active,
+ ip_block_non_disturbing_active,
+ ip_block_disturbing_active_timeout_not_released,
+ ip_block_disturbing_active_timeout_released,
+ ip_block_non_disturbing_active_timeout_not_released,
+ ip_block_non_disturbing_active_timeout_released,
+ ip_block_disturbing_blocker_dies,
+ ip_block_non_disturbing_blocker_dies
]},
{ssl, [], [{group, essl}]},
{essl, [],
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index 4a48a5c3d8..50e1cc290c 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -361,7 +361,7 @@ fe80::204:acff:fe17:bf38
</item>
<tag><c>send_dvi</c></tag>
<item>
- <p>Average packet size deviation in bytes received sent from the socket.</p>
+ <p>Average packet size deviation in bytes sent from the socket.</p>
</item>
<tag><c>send_max</c></tag>
<item>
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index 49a93d2c70..00c6bc33d6 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -4,7 +4,7 @@
<appref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -35,7 +35,7 @@
Erlang/OTP consists of Kernel and STDLIB. The Kernel application
contains the following services:</p>
<list type="bulleted">
- <item>application controller, see <c>application(3)</c></item>
+ <item>application controller, see <seealso marker="application">application(3)</seealso></item>
<item><c>code</c></item>
<item><c>disk_log</c></item>
<item><c>dist_ac</c>, distributed application controller</item>
@@ -66,8 +66,8 @@
<section>
<title>Configuration</title>
<p>The following configuration parameters are defined for the Kernel
- application. See <c>app(3)</c> for more information about
- configuration parameters.</p>
+ application. See <seealso marker="app">app(4)</seealso> for more
+ information about configuration parameters.</p>
<taglist>
<tag><c>browser_cmd = string() | {M,F,A}</c></tag>
<item>
@@ -93,7 +93,8 @@
<item><c>Time = integer()>0</c></item>
<item><c>Nodes = [node() | {node(),...,node()}]</c></item>
</list>
- <p>The parameter is described in <c>application(3)</c>, function
+ <p>The parameter is described in
+ <seealso marker="application">application(3)</seealso>, function
<c>load/2</c>.</p>
</item>
<tag><c>dist_auto_connect = Value</c></tag>
@@ -105,11 +106,13 @@
<taglist>
<tag><c>never</c></tag>
<item>Connections are never automatically established, they
- must be explicitly connected. See <c>net_kernel(3)</c>.</item>
+ must be explicitly connected. See
+ <seealso marker="net_kernel">net_kernel(3)</seealso>.</item>
<tag><c>once</c></tag>
<item>Connections will be established automatically, but only
once per node. If a node goes down, it must thereafter be
- explicitly connected. See <c>net_kernel(3)</c>.</item>
+ explicitly connected. See
+ <seealso marker="net_kernel">net_kernel(3)</seealso>.</item>
</taglist>
</item>
<tag><c>permissions = [Perm]</c></tag>
@@ -121,7 +124,8 @@
<item><c>ApplName = atom()</c></item>
<item><c>Bool = boolean()</c></item>
</list>
- <p>Permissions are described in <c>application(3)</c>, function
+ <p>Permissions are described in
+ <seealso marker="application">application(3)</seealso>, function
<c>permit/2</c>.</p>
</item>
<tag><c>error_logger = Value</c></tag>
@@ -149,7 +153,8 @@
</item>
<tag><c>global_groups = [GroupTuple]</c></tag>
<item>
- <p>Defines global groups, see <c>global_group(3)</c>.</p>
+ <p>Defines global groups, see
+ <seealso marker="global_group">global_group(3)</seealso>.</p>
<list type="bulleted">
<item><c>GroupTuple = {GroupName, [Node]} | {GroupName, PublishType, [Node]}</c></item>
<item><c>GroupName = atom()</c></item>
@@ -160,18 +165,19 @@
<tag><c>inet_default_connect_options = [{Opt, Val}]</c></tag>
<item>
<p>Specifies default options for <c>connect</c> sockets,
- see <c>inet(3)</c>.</p>
+ see <seealso marker="inet">inet(3)</seealso>.</p>
</item>
<tag><c>inet_default_listen_options = [{Opt, Val}]</c></tag>
<item>
<p>Specifies default options for <c>listen</c> (and
- <c>accept</c>) sockets, see <c>inet(3)</c>.</p>
+ <c>accept</c>) sockets, see <seealso marker="inet">inet(3)</seealso>.</p>
</item>
<tag><c>{inet_dist_use_interface, ip_address()}</c></tag>
<item>
<p>If the host of an Erlang node has several network interfaces,
this parameter specifies which one to listen on. See
- <c>inet(3)</c> for the type definition of <c>ip_address()</c>.</p>
+ <seealso marker="inet">inet(3)</seealso> for the type definition
+ of <c>ip_address()</c>.</p>
</item>
<tag><c>{inet_dist_listen_min, First}</c></tag>
<item>
@@ -276,7 +282,8 @@ MaxT = TickTime + TickTime / 4</code>
<tag><c>start_boot_server = true | false</c></tag>
<item>
<p>Starts the <c>boot_server</c> if the parameter is <c>true</c>
- (see <c>erl_boot_server(3)</c>). This parameter should be
+ (see <seealso marker="erl_boot_server">erl_boot_server(3)</seealso>).
+ This parameter should be
set to <c>true</c> in an embedded system which uses this
service.</p>
<p>The default value is <c>false</c>.</p>
@@ -296,13 +303,15 @@ MaxT = TickTime + TickTime / 4</code>
<tag><c>start_disk_log = true | false</c></tag>
<item>
<p>Starts the <c>disk_log_server</c> if the parameter is
- <c>true</c> (see <c>disk_log(3)</c>). This parameter should be
+ <c>true</c> (see <seealso marker="disk_log">disk_log(3)</seealso>).
+ This parameter should be
set to true in an embedded system which uses this service.</p>
<p>The default value is <c>false</c>.</p>
</item>
<tag><c>start_pg2 = true | false</c></tag>
<item>
- <p>Starts the <c>pg2</c> server (see <c>pg2(3)</c>) if
+ <p>Starts the <c>pg2</c> server (see
+ <seealso marker="pg2">pg2(3)</seealso>) if
the parameter is <c>true</c>. This parameter should be set to
<c>true</c> in an embedded system which uses this service.</p>
<p>The default value is <c>false</c>.</p>
@@ -310,7 +319,8 @@ MaxT = TickTime + TickTime / 4</code>
<tag><c>start_timer = true | false</c></tag>
<item>
<p>Starts the <c>timer_server</c> if the parameter is
- <c>true</c> (see <c>timer(3)</c>). This parameter should be
+ <c>true</c> (see <seealso marker="stdlib:timer">timer(3)</seealso>).
+ This parameter should be
set to <c>true</c> in an embedded system which uses this
service.</p>
<p>The default value is <c>false</c>.</p>
@@ -351,6 +361,7 @@ MaxT = TickTime + TickTime / 4</code>
<seealso marker="pg2">pg2(3)</seealso>,
<seealso marker="rpc">rpc(3)</seealso>,
<seealso marker="seq_trace">seq_trace(3)</seealso>,
+ <seealso marker="stdlib:timer">timer(3)</seealso>,
<seealso marker="user">user(3)</seealso></p>
</section>
</appref>
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
index ed13035104..daad45b6c2 100644
--- a/lib/kernel/src/application_controller.erl
+++ b/lib/kernel/src/application_controller.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. 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
@@ -829,12 +829,12 @@ handle_call({change_application_data, Applications, Config}, _From, S) ->
{reply, Error, S};
{'EXIT', R} ->
{reply, {error, R}, S};
- NewAppls ->
+ {NewAppls, NewConfig} ->
lists:foreach(fun(Appl) ->
ets:insert(ac_tab, {{loaded, Appl#appl.name},
Appl})
end, NewAppls),
- {reply, ok, S#state{conf_data = Config}}
+ {reply, ok, S#state{conf_data = NewConfig}}
end;
handle_call(prep_config_change, _From, S) ->
@@ -1550,18 +1550,19 @@ do_change_apps(Applications, Config, OldAppls) ->
end,
Errors),
- map(fun(Appl) ->
- AppName = Appl#appl.name,
- case is_loaded_app(AppName, Applications) of
- {true, Application} ->
- do_change_appl(make_appl(Application),
- Appl, SysConfig);
-
- %% ignored removed apps - handled elsewhere
- false ->
- Appl
- end
- end, OldAppls).
+ {map(fun(Appl) ->
+ AppName = Appl#appl.name,
+ case is_loaded_app(AppName, Applications) of
+ {true, Application} ->
+ do_change_appl(make_appl(Application),
+ Appl, SysConfig);
+
+ %% ignored removed apps - handled elsewhere
+ false ->
+ Appl
+ end
+ end, OldAppls),
+ SysConfig}.
is_loaded_app(AppName, [{application, AppName, App} | _]) ->
{true, {application, AppName, App}};
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index f7a815882b..ef605d0bfe 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -182,6 +182,11 @@ size(Tuple, Seen0, Sum0) when is_tuple(Tuple) ->
Sum = Sum0 + 1 + tuple_size(Tuple),
tuple_size(1, tuple_size(Tuple), Tuple, Seen, Sum)
end;
+size(Map, Seen0, Sum) when is_map(Map) ->
+ case remember_term(Map, Seen0) of
+ seen -> {Sum,Seen0};
+ Seen -> map_size(Map, Seen, Sum)
+ end;
size(Fun, Seen0, Sum) when is_function(Fun) ->
case remember_term(Fun, Seen0) of
seen -> {Sum,Seen0};
@@ -203,6 +208,12 @@ tuple_size(I, Sz, Tuple, Seen0, Sum0) ->
{Sum,Seen} = size(element(I, Tuple), Seen0, Sum0),
tuple_size(I+1, Sz, Tuple, Seen, Sum).
+map_size(Map,Seen0,Sum0) ->
+ Kt = erts_internal:map_to_tuple_keys(Map),
+ Vs = maps:values(Map),
+ {Sum1,Seen1} = size(Kt,Seen0,Sum0),
+ fold_size(Vs,Seen1,Sum1+length(Vs)+3).
+
fun_size(Fun, Seen, Sum) ->
case erlang:fun_info(Fun, type) of
{type,external} ->
@@ -210,14 +221,14 @@ fun_size(Fun, Seen, Sum) ->
{type,local} ->
Sz = erts_debug:flat_size(fun() -> ok end),
{env,Env} = erlang:fun_info(Fun, env),
- fun_size_1(Env, Seen, Sum+Sz+length(Env))
+ fold_size(Env, Seen, Sum+Sz+length(Env))
end.
-fun_size_1([H|T], Seen0, Sum0) ->
+fold_size([H|T], Seen0, Sum0) ->
{Sum,Seen} = size(H, Seen0, Sum0),
- fun_size_1(T, Seen, Sum);
-fun_size_1([], Seen, Sum) -> {Sum,Seen}.
-
+ fold_size(T, Seen, Sum);
+fold_size([], Seen, Sum) -> {Sum,Seen}.
+
remember_term(Term, Seen) ->
case gb_trees:lookup(Term, Seen) of
none -> gb_trees:insert(Term, [Term], Seen);
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index c6cbd1a0ef..036e238c85 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -1949,14 +1949,22 @@ config_change(Conf) when is_list(Conf) ->
%% Find out application data from boot script
Boot = filename:join([code:root_dir(), "bin", "start.boot"]),
{ok, Bin} = file:read_file(Boot),
- Appls = get_appls(binary_to_term(Bin)),
+ Appls0 = get_appls(binary_to_term(Bin)),
+
+ %% And add app1 in order to test OTP-11864 - included config files
+ %% not read for new (not already loaded) applications
+ Appls = [app1() | Appls0],
%% Simulate contents of "sys.config"
Config = [{stdlib, [{par1,sys},{par2,sys}]},
"t1",
"t2.config",
filename:join([DataDir, "subdir", "t3"]),
- {stdlib, [{par6,sys}]}],
+ {stdlib, [{par6,sys}]},
+ "t4.config"],
+
+ %% Check that app1 is not loaded
+ false = lists:keymember(app1,1,application:loaded_applications()),
%% Order application_controller to update configuration
ok = application_controller:change_application_data(Appls,
@@ -1971,6 +1979,13 @@ config_change(Conf) when is_list(Conf) ->
{value, {par5,t3}} = lists:keysearch(par5, 1, Env),
{value, {par6,sys}} = lists:keysearch(par6, 1, Env),
+ %% Check that app1 parameters are correctly set after loading
+ [] = application:get_all_env(app1),
+ application:load(app1()),
+ App1Env = application:get_all_env(app1),
+ {value, {par1,t4}} = lists:keysearch(par1, 1, App1Env),
+ application:unload(app1),
+
ok = file:set_cwd(CWD).
%% This function is stolen from SASL module release_handler, OTP R10B
@@ -1989,6 +2004,7 @@ get_appls([_ | T], Res) ->
get_appls([], Res) ->
Res.
+
persistent_env(suite) ->
[];
persistent_env(doc) ->
diff --git a/lib/kernel/test/application_SUITE_data/t4.config b/lib/kernel/test/application_SUITE_data/t4.config
new file mode 100644
index 0000000000..8b2bc52c01
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/t4.config
@@ -0,0 +1 @@
+[{app1, [{par1,t4}]}]. \ No newline at end of file
diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl
index 78f5e93fc3..1884e8cf58 100644
--- a/lib/kernel/test/kernel_SUITE.erl
+++ b/lib/kernel/test/kernel_SUITE.erl
@@ -95,10 +95,10 @@ appup_tests(App,{OkVsns,NokVsns}) ->
ok.
create_test_vsns(App) ->
- This = erlang:system_info(otp_release),
- FirstMajor = previous_major(This),
+ ThisMajor = erlang:system_info(otp_release),
+ FirstMajor = previous_major(ThisMajor),
SecondMajor = previous_major(FirstMajor),
- Ok = app_vsn(App,[FirstMajor]),
+ Ok = app_vsn(App,[ThisMajor,FirstMajor]),
Nok0 = app_vsn(App,[SecondMajor]),
Nok = case Ok of
[Ok1|_] ->
@@ -109,9 +109,9 @@ create_test_vsns(App) ->
{Ok,Nok}.
previous_major("17") ->
- "r16";
-previous_major("r"++Rel) ->
- "r"++previous_major(Rel);
+ "r16b";
+previous_major("r16b") ->
+ "r15b";
previous_major(Rel) ->
integer_to_list(list_to_integer(Rel)-1).
diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl
index 2c741232c4..123e849ccb 100644
--- a/lib/kernel/test/sendfile_SUITE.erl
+++ b/lib/kernel/test/sendfile_SUITE.erl
@@ -72,7 +72,12 @@ end_per_suite(Config) ->
file:delete(proplists:get_value(big_file, Config)).
init_per_group(async_threads,Config) ->
- [{sendfile_opts,[{use_threads,true}]}|Config];
+ case erlang:system_info(thread_pool_size) of
+ 0 ->
+ {skip,"No async threads"};
+ _ ->
+ [{sendfile_opts,[{use_threads,true}]}|Config]
+ end;
init_per_group(no_async_threads,Config) ->
[{sendfile_opts,[{use_threads,false}]}|Config].
diff --git a/lib/megaco/aclocal.m4 b/lib/megaco/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/megaco/aclocal.m4
+++ b/lib/megaco/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/odbc/aclocal.m4 b/lib/odbc/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/odbc/aclocal.m4
+++ b/lib/odbc/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index bfe5d39d53..b3b7afd1a9 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2014. 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
@@ -1205,14 +1205,9 @@ create_slim(Config) ->
RootDir = code:root_dir(),
Erl = filename:join([RootDir, "bin", "erl"]),
- EscapedQuote =
- case os:type() of
- {win32,_} -> "\\\"";
- _ -> "\""
- end,
Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir,
"-boot", filename:join(TargetRelVsnDir,RelName),
- "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote],
+ "-sasl", "releases_dir", "\""++TargetRelDir++"\""],
{ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)),
?msym(RootDir, rpc:call(Node, code, root_dir, [])),
wait_for_app(Node,sasl,50),
diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl
index 530d0a9985..fa12f19aa7 100644
--- a/lib/reltool/test/reltool_test_lib.erl
+++ b/lib/reltool/test/reltool_test_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2014. 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
@@ -20,12 +20,13 @@
-compile(export_all).
-include("reltool_test_lib.hrl").
+-define(timeout, 20). % minutes
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
init_per_suite(Config) when is_list(Config)->
global:register_name(reltool_global_logger, group_leader()),
- incr_timetrap(Config, 10).
+ incr_timetrap(Config, ?timeout).
end_per_suite(Config) when is_list(Config)->
global:unregister_name(reltool_global_logger),
@@ -51,7 +52,7 @@ set_kill_timer(Config) ->
Time =
case lookup_config(tc_timeout, Config) of
[] ->
- timer:minutes(10);
+ timer:minutes(?timeout);
ConfigTime when is_integer(ConfigTime) ->
ConfigTime
end,
diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl
index 1d8bf45289..bd7414fbb4 100644
--- a/lib/sasl/test/release_handler_SUITE.erl
+++ b/lib/sasl/test/release_handler_SUITE.erl
@@ -1410,18 +1410,41 @@ upgrade_supervisor_fail(Conf) when is_list(Conf) ->
{error,{code_change_failed,_Pid,a_sup,_Vsn,
{error,{invalid_shutdown,brutal_kil}}}} =
- rpc:call(Node, release_handler, install_release, [RelVsn2]),
-
- %% Check that the upgrade is terminated - normally this would mean
- %% rollback, but since this testcase is very simplified the node
- %% is not started with heart supervision and will therefore not be
- %% restarted. So we just check that the node goes down.
+ rpc:call(Node, release_handler, install_release,
+ [RelVsn2, [{error_action,reboot}]]),
+
+ %% Check that the upgrade is terminated - normally this would be a
+ %% rollback, but
+ %%
+ %% 1. Default rollback is done with init:restart(), which does not
+ %% reboot the emulator, it only restarts the system inside the
+ %% running erlang node.
+ %%
+ %% 2. This does not work well on a slave node since, if timing is
+ %% right (bad), the slave node will get the nodedown from its
+ %% master (because distribution is terminated as part of
+ %% init:restart()) and then it will do halt() and thus never be
+ %% restarted (see slave:wloop/1)
+ %%
+ %% 3. Sometimes, though, init:restart() will manage to finish its
+ %% job before the nodedown is received, making the node
+ %% actually restart - in which case it might very well confuse
+ %% the next test case.
+ %%
+ %% 4. So, to avoid unstability we use {error_action,reboot} above,
+ %% to ensure that the node is actually stopped. Of course, in a
+ %% real system this must be used together with heart
+ %% supervision, and then the node will be restarted anyway. But
+ %% here in this simple test case we are satisfied to see that
+ %% the node terminates.
receive {nodedown,Node} -> ok
after 10000 -> ct:fail(failed_upgrade_never_restarted_node)
end,
ok.
+upgrade_supervisor_fail(cleanup,_Condf) ->
+ stop_node(node_name(upgrade_supervisor_fail)).
%% Test upgrade and downgrade of applications
eval_appup(Conf) when is_list(Conf) ->
@@ -2269,8 +2292,8 @@ create_p1g(Conf,TargetDir) ->
ok.
fix_version(SystemLib,App) ->
- FromVsn = vsn(App,current),
- ToVsn = vsn(App,old),
+ FromVsn = re:replace(vsn(App,current),"\\.","\\\\.",[{return,binary}]),
+ ToVsn = re:replace(vsn(App,old),"\\.","\\\\.",[{return,binary}]),
Rootname = filename:join([SystemLib,app_dir(App,old),ebin,atom_to_list(App)]),
AppFile = Rootname ++ ".app",
diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl
index f4455f7e9b..e91d220daf 100644
--- a/lib/sasl/test/sasl_SUITE.erl
+++ b/lib/sasl/test/sasl_SUITE.erl
@@ -73,10 +73,10 @@ appup_tests(App,{OkVsns,NokVsns}) ->
ok.
create_test_vsns(App) ->
- This = erlang:system_info(otp_release),
- FirstMajor = previous_major(This),
+ ThisMajor = erlang:system_info(otp_release),
+ FirstMajor = previous_major(ThisMajor),
SecondMajor = previous_major(FirstMajor),
- Ok = app_vsn(App,[FirstMajor]),
+ Ok = app_vsn(App,[ThisMajor,FirstMajor]),
Nok0 = app_vsn(App,[SecondMajor]),
Nok = case Ok of
[Ok1|_] ->
@@ -87,9 +87,9 @@ create_test_vsns(App) ->
{Ok,Nok}.
previous_major("17") ->
- "r16";
-previous_major("r"++Rel) ->
- "r"++previous_major(Rel);
+ "r16b";
+previous_major("r16b") ->
+ "r15b";
previous_major(Rel) ->
integer_to_list(list_to_integer(Rel)-1).
diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index 1d3a71e94e..49a4303e0b 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2014. 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
@@ -1615,9 +1615,19 @@ no_sasl_relup(Config) when is_list(Config) ->
%% make_relup: Check that application start type is used in relup
app_start_type_relup(Config) when is_list(Config) ->
+ %% This might fail if some applications are not available, if so
+ %% skip the test case.
+ try create_script(latest_app_start_type2,Config) of
+ {Dir2,Name2} ->
+ app_start_type_relup(Dir2,Name2,Config)
+ catch throw:{error,Reason} ->
+ {skip,Reason}
+ end.
+
+app_start_type_relup(Dir2,Name2,Config) ->
PrivDir = ?config(priv_dir, Config),
{Dir1,Name1} = create_script(latest_app_start_type1,Config),
- {Dir2,Name2} = create_script(latest_app_start_type2,Config),
+
Release1 = filename:join(Dir1,Name1),
Release2 = filename:join(Dir2,Name2),
@@ -2242,9 +2252,13 @@ app_vsns(AppVsns) ->
[{App,app_vsn(App,Vsn)} || {App,Vsn} <- AppVsns] ++
[{App,app_vsn(App,Vsn),Type} || {App,Vsn,Type} <- AppVsns].
app_vsn(App,current) ->
- application:load(App),
- {ok,Vsn} = application:get_key(App,vsn),
- Vsn;
+ case application:load(App) of
+ Ok when Ok==ok; Ok=={error,{already_loaded,App}} ->
+ {ok,Vsn} = application:get_key(App,vsn),
+ Vsn;
+ Error ->
+ throw(Error)
+ end;
app_vsn(_App,Vsn) ->
Vsn.
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 7fbd70c87e..5a141ced3c 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -307,18 +307,31 @@
<tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag>
<item>
- <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes.
+ <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes. If the client fails to login within this time, the connection is closed.
+ </p>
+ </item>
+
+ <tag><c><![CDATA[{max_sessions, pos_integer()}]]></c></tag>
+ <item>
+ <p>The maximum number of simultaneous sessions that are accepted at any time for this daemon. This includes sessions that are being authorized. So if set to <c>N</c>, and <c>N</c> clients have connected but not started the login process, the <c>N+1</c> connection attempt will be aborted. If <c>N</c> connections are authenticated and still logged in, no more loggins will be accepted until one of the existing ones log out.
+ </p>
+ <p>The counter is per listening port, so if two daemons are started, one with <c>{max_sessions,N}</c> and the other with <c>{max_sessions,M}</c> there will be in total <c>N+M</c> connections accepted for the whole ssh application.
+ </p>
+ <p>Note that if <c>parallel_login</c> is <c>false</c>, only one client at a time may be in the authentication phase.
+ </p>
+ <p>As default, the option is not set. This means that the number is not limited.
</p>
</item>
<tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag>
<item>
- <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited logins will be allowed simultanously. Note that this affects only the connections with authentication in progress, not the already authenticated connections.
+ <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited number of login attempts will be allowed simultanously.
+ </p>
+ <p>If the <c>max_sessions</c> option is set to <c>N</c> and <c>parallel_login</c> is set to <c>true</c>, the max number of simultaneous login attempts at any time is limited to <c>N-K</c> where <c>K</c> is the number of authenticated connections present at this daemon.
</p>
<warning>
- <p>Do not enable parallel_logins without protecting the server by other means like a firewall. If set to true, there is no protection against dos attacs.</p>
+ <p>Do not enable <c>parallel_logins</c> without protecting the server by other means, for example the <c>max_sessions</c> option or a firewall configuration. If set to <c>true</c>, there is no protection against DOS attacks.</p>
</warning>
-
</item>
<tag><c><![CDATA[{key_cb, atom()}]]></c></tag>
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index de6e8cc421..240de69eff 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -1,7 +1,7 @@
%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2014. 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
@@ -73,8 +73,9 @@ connect(Host, Port, Options, Timeout) ->
{SocketOptions, SshOptions} ->
{_, Transport, _} = TransportOpts =
proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}),
+ ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity),
Inet = proplists:get_value(inet, SshOptions, inet),
- try Transport:connect(Host, Port, [ {active, false}, Inet | SocketOptions], Timeout) of
+ try Transport:connect(Host, Port, [ {active, false}, Inet | SocketOptions], ConnectionTimeout) of
{ok, Socket} ->
Opts = [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)],
ssh_connection_handler:start_connection(client, Socket, Opts, Timeout);
@@ -332,6 +333,8 @@ handle_option([{idle_time, _} = Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{rekey_limit, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{max_sessions, _} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{negotiation_timeout, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) ->
@@ -366,6 +369,8 @@ handle_ssh_option({pref_public_key_algs, Value} = Opt) when is_list(Value), leng
end;
handle_ssh_option({connect_timeout, Value} = Opt) when is_integer(Value); Value == infinity ->
Opt;
+handle_ssh_option({max_sessions, Value} = Opt) when is_integer(Value), Value>0 ->
+ Opt;
handle_ssh_option({negotiation_timeout, Value} = Opt) when is_integer(Value); Value == infinity ->
Opt;
handle_ssh_option({parallel_login, Value} = Opt) when Value==true ; Value==false ->
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index e57b07cee8..7302196674 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -80,18 +80,36 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) ->
ListenSocket, AcceptTimeout)
end.
-handle_connection(_Callback, Address, Port, Options, Socket) ->
+handle_connection(Callback, Address, Port, Options, Socket) ->
SystemSup = ssh_system_sup:system_supervisor(Address, Port),
- {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options),
- ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup),
- Timeout = proplists:get_value(negotiation_timeout,
- proplists:get_value(ssh_opts, Options, []),
- 2*60*1000),
- ssh_connection_handler:start_connection(server, Socket,
- [{supervisors, [{system_sup, SystemSup},
- {subsystem_sup, SubSysSup},
- {connection_sup, ConnectionSup}]}
- | Options], Timeout).
+ SSHopts = proplists:get_value(ssh_opts, Options, []),
+ MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity),
+ case number_of_connections(SystemSup) < MaxSessions of
+ true ->
+ {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options),
+ ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup),
+ Timeout = proplists:get_value(negotiation_timeout, SSHopts, 2*60*1000),
+ ssh_connection_handler:start_connection(server, Socket,
+ [{supervisors, [{system_sup, SystemSup},
+ {subsystem_sup, SubSysSup},
+ {connection_sup, ConnectionSup}]}
+ | Options], Timeout);
+ false ->
+ Callback:close(Socket),
+ IPstr = if is_tuple(Address) -> inet:ntoa(Address);
+ true -> Address
+ end,
+ Str = try io_lib:format('~s:~p',[IPstr,Port])
+ catch _:_ -> "port "++integer_to_list(Port)
+ end,
+ error_logger:info_report("Ssh login attempt to "++Str++" denied due to option "
+ "max_sessions limits to "++ io_lib:write(MaxSessions) ++
+ " sessions."
+ ),
+ {error,max_sessions}
+ end.
+
+
handle_error(timeout) ->
ok;
@@ -117,3 +135,10 @@ handle_error(Reason) ->
String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])),
error_logger:error_report(String),
exit({accept_failed, String}).
+
+
+number_of_connections(SystemSup) ->
+ length([X ||
+ {R,X,supervisor,[ssh_subsystem_sup]} <- supervisor:which_children(SystemSup),
+ is_reference(R)
+ ]).
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 322da50f21..06866392da 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1482,8 +1482,7 @@ ssh_channel_info([ _ | Rest], Channel, Acc) ->
log_error(Reason) ->
Report = io_lib:format("Erlang ssh connection handler failed with reason: "
- "~p ~n, Stacktace: ~p ~n"
- "please report this to [email protected] \n",
+ "~p ~n, Stacktrace: ~p ~n",
[Reason, erlang:get_stacktrace()]),
error_logger:error_report(Report),
"Internal error".
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index d2e52379fa..37a307d783 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -47,21 +47,27 @@ all() ->
daemon_already_started,
server_password_option,
server_userpassword_option,
- double_close].
+ double_close,
+ ssh_connect_timeout,
+ {group, hardening_tests}
+ ].
groups() ->
[{dsa_key, [], basic_tests()},
{rsa_key, [], basic_tests()},
{dsa_pass_key, [], [pass_phrase]},
{rsa_pass_key, [], [pass_phrase]},
- {internal_error, [], [internal_error]}
+ {internal_error, [], [internal_error]},
+ {hardening_tests, [], [max_sessions]}
].
+
basic_tests() ->
[send, close, peername_sockname,
exec, exec_compressed, shell, cli, known_hosts,
idle_time, rekey, openssh_zlib_basic_test].
+
%%--------------------------------------------------------------------
init_per_suite(Config) ->
case catch crypto:start() of
@@ -74,6 +80,8 @@ end_per_suite(_Config) ->
ssh:stop(),
crypto:stop().
%%--------------------------------------------------------------------
+init_per_group(hardening_tests, Config) ->
+ init_per_group(dsa_key, Config);
init_per_group(dsa_key, Config) ->
DataDir = ?config(data_dir, Config),
PrivDir = ?config(priv_dir, Config),
@@ -103,6 +111,8 @@ init_per_group(internal_error, Config) ->
init_per_group(_, Config) ->
Config.
+end_per_group(hardening_tests, Config) ->
+ end_per_group(dsa_key, Config);
end_per_group(dsa_key, Config) ->
PrivDir = ?config(priv_dir, Config),
ssh_test_lib:clean_dsa(PrivDir),
@@ -620,6 +630,86 @@ double_close(Config) when is_list(Config) ->
ok = ssh:close(CM).
%%--------------------------------------------------------------------
+ssh_connect_timeout() ->
+ [{doc, "Test connect_timeout option in ssh:connect/4"}].
+ssh_connect_timeout(_Config) ->
+ ConnTimeout = 2000,
+ {error,{faked_transport,connect,TimeoutToTransport}} =
+ ssh:connect("localhost", 12345,
+ [{transport,{tcp,?MODULE,tcp_closed}},
+ {connect_timeout,ConnTimeout}],
+ 1000),
+ case TimeoutToTransport of
+ ConnTimeout -> ok;
+ Other ->
+ ct:log("connect_timeout is ~p but transport received ~p",[ConnTimeout,Other]),
+ {fail,"ssh:connect/4 wrong connect_timeout received in transport"}
+ end.
+
+%% Help for the test above
+connect(_Host, _Port, _Opts, Timeout) ->
+ {error, {faked_transport,connect,Timeout}}.
+
+
+%%--------------------------------------------------------------------
+ssh_connect_arg4_timeout() ->
+ [{doc, "Test fourth argument in ssh:connect/4"}].
+ssh_connect_arg4_timeout(_Config) ->
+ Timeout = 1000,
+ Parent = self(),
+ %% start the server
+ Server = spawn(fun() ->
+ {ok,Sl} = gen_tcp:listen(0,[]),
+ {ok,{_,Port}} = inet:sockname(Sl),
+ Parent ! {port,self(),Port},
+ Rsa = gen_tcp:accept(Sl),
+ ct:log("Server gen_tcp:accept got ~p",[Rsa]),
+ receive after 2*Timeout -> ok end %% let client timeout first
+ end),
+
+ %% Get listening port
+ Port = receive
+ {port,Server,ServerPort} -> ServerPort
+ end,
+
+ %% try to connect with a timeout, but "supervise" it
+ Client = spawn(fun() ->
+ T0 = now(),
+ Rc = ssh:connect("localhost",Port,[],Timeout),
+ ct:log("Client ssh:connect got ~p",[Rc]),
+ Parent ! {done,self(),Rc,T0}
+ end),
+
+ %% Wait for client reaction on the connection try:
+ receive
+ {done, Client, {error,_E}, T0} ->
+ Msp = ms_passed(T0, now()),
+ exit(Server,hasta_la_vista___baby),
+ Low = 0.9*Timeout,
+ High = 1.1*Timeout,
+ ct:log("Timeout limits: ~p--~p, timeout was ~p, expected ~p",[Low,High,Msp,Timeout]),
+ if
+ Low<Msp, Msp<High -> ok;
+ true -> {fail, "timeout not within limits"}
+ end;
+ {done, Client, {ok,_Ref}, _T0} ->
+ {fail,"ssh-connected ???"}
+ after
+ 5000 ->
+ exit(Server,hasta_la_vista___baby),
+ exit(Client,hasta_la_vista___baby),
+ {fail, "Didn't timeout"}
+ end.
+
+
+%% Help function
+%% N2-N1
+ms_passed(N1={_,_,M1}, N2={_,_,M2}) ->
+ {0,{0,Min,Sec}} = calendar:time_difference(calendar:now_to_local_time(N1),
+ calendar:now_to_local_time(N2)),
+ 1000 * (Min*60 + Sec + (M2-M1)/1000000).
+
+%%--------------------------------------------------------------------
openssh_zlib_basic_test() ->
[{doc, "Test basic connection with openssh_zlib"}].
@@ -639,6 +729,49 @@ openssh_zlib_basic_test(Config) ->
ssh:stop_daemon(Pid).
%%--------------------------------------------------------------------
+
+max_sessions(Config) ->
+ SystemDir = filename:join(?config(priv_dir, Config), system),
+ UserDir = ?config(priv_dir, Config),
+ MaxSessions = 2,
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{"carni", "meat"}]},
+ {parallel_login, true},
+ {max_sessions, MaxSessions}
+ ]),
+
+ Connect = fun() ->
+ R=ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {user, "carni"},
+ {password, "meat"}
+ ]),
+ ct:log("Connection ~p up",[R])
+ end,
+
+ try [Connect() || _ <- lists:seq(1,MaxSessions)]
+ of
+ _ ->
+ ct:pal("Expect Info Report:",[]),
+ try Connect()
+ of
+ _ConnectionRef ->
+ ssh:stop_daemon(Pid),
+ {fail,"Too many connections accepted"}
+ catch
+ error:{badmatch,{error,"Connection closed"}} ->
+ ssh:stop_daemon(Pid),
+ ok
+ end
+ catch
+ error:{badmatch,{error,"Connection closed"}} ->
+ ssh:stop_daemon(Pid),
+ {fail,"Too few connections accepted"}
+ end.
+
+%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 9ffc59dbaf..c8cac3e852 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 3.0.1
+SSH_VSN = 3.1
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/internal_doc/ssl-implementation.txt b/lib/ssl/internal_doc/ssl-implementation.txt
deleted file mode 100644
index e5d6ac8cd0..0000000000
--- a/lib/ssl/internal_doc/ssl-implementation.txt
+++ /dev/null
@@ -1,52 +0,0 @@
-
-Important modules:
-
- module behaviour children
- ------ ---------
- ssl_app application ssl_sup
- ssl_sup supervisor ssl_server, ssl_broker_sup
- ssl_server gen_server -
- ssl_broker_sup supervisor ssl_broker
- ssl_broker gen_server -
-
-The ssl_server controls a port program that implements the SSL functionality.
-That port program uses the OpenSSL package.
-
-Each socket has a corresponding broker (listen, accept or connect). A broker
-is created and supervised by the ssl_broker_sup.
-
-All communication is between a user and a broker. The broker communicates
-with the ssl_server, that sends its commands to the port program and handles
-the port program responses, that are distributed to users through the
-brokers.
-
-There is a distinction between commands and data flow between the ssl_server
-and the port program. Each established connection between the user and the
-outside world consists of a local erlang socket (owned by the broker) that
-is read from and written to by the broker. At the other end of the local
-connection is a local socket in the port program.
-
-The "real" socket that connects to the outside world is in the port program
-(including listen sockets). The main purpose of the port program is to
-shuffle data between local sockets and outside world sockets, and detect and
-propagate read and write errors (including detection of closed sockets) to
-the ssl_server.
-
-There is documentation in the ssl_broker.erl module.
-
-There is also documentation in the esock.c and esock_openssl.c files.
-
-The ssl_pem.erl, ssl_pkix.erl and ssl_base64.erl modules are support
-modules for reading SSL certificates. Modules for parsing certificates
-are generated from ASN.1 modules in the `pkix' directory.
-
-The `examples' directory contains functions for generating certificates.
-Those certificates are used in the test suites.
-
-
-
-
-
-
-
-
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 131b615277..7c4c8ec2cc 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2013. All Rights Reserved.
+# Copyright Ericsson AB 1999-2014. 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
@@ -66,6 +66,7 @@ MODULES= \
ssl_session \
ssl_session_cache \
ssl_socket \
+ ssl_listen_tracker_sup \
tls_record \
dtls_record \
ssl_record \
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 57f8dd86d3..508983ddac 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -202,13 +202,14 @@ hello(Hello = #client_hello{client_version = ClientVersion,
session_cache = Cache,
session_cache_cb = CacheCb,
ssl_options = SslOpts}) ->
- HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, Session},
ConnectionStates,
#hello_extensions{ec_point_formats = EcPointFormats,
elliptic_curves = EllipticCurves} = ServerHelloExt} ->
+ HashSign = ssl_handshake:select_hashsign(HashSigns, Cert,
+ dtls_v1:corresponding_tls_version(Version)),
ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign},
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 99839f6149..36681e2897 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -28,6 +28,7 @@
ssl_srp_primes,
ssl_alert,
ssl_socket,
+ ssl_listen_tracker_sup,
%% Erlang Distribution over SSL/TLS
inet_tls_dist,
ssl_tls_dist_proxy,
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 743753bf7d..234db21443 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -97,17 +97,17 @@ connect(Socket, SslOptions) when is_port(Socket) ->
connect(Socket, SslOptions0, Timeout) when is_port(Socket) ->
{Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0,
{gen_tcp, tcp, tcp_closed, tcp_error}),
- EmulatedOptions = emulated_options(),
+ EmulatedOptions = ssl_socket:emulated_options(),
{ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
try handle_options(SslOptions0 ++ SocketValues, client) of
{ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts,
connection_cb = ConnectionCb}} ->
- ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
+ ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()),
case ssl_socket:peername(Transport, Socket) of
{ok, {Address, Port}} ->
ssl_connection:connect(ConnectionCb, Address, Port, Socket,
- {SslOptions, EmOpts},
+ {SslOptions, emulated_socket_options(EmOpts, #socket_options{})},
self(), CbInfo, Timeout);
{error, Error} ->
{error, Error}
@@ -141,10 +141,13 @@ listen(Port, Options0) ->
try
{ok, Config} = handle_options(Options0, server),
ConnectionCb = connection_cb(Options0),
- #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb} = Config,
+ #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb,
+ ssl = SslOpts, emulated = EmOpts} = Config,
case Transport:listen(Port, Options) of
{ok, ListenSocket} ->
- {ok, #sslsocket{pid = {ListenSocket, Config}}};
+ ok = ssl_socket:setopts(Transport, ListenSocket, ssl_socket:internal_inet_values()),
+ {ok, Tracker} = ssl_socket:inherit_tracker(ListenSocket, EmOpts, SslOpts),
+ {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}};
Err = {error, _} ->
Err
end
@@ -164,21 +167,16 @@ transport_accept(ListenSocket) ->
transport_accept(ListenSocket, infinity).
transport_accept(#sslsocket{pid = {ListenSocket,
- #config{transport_info = CbInfo,
+ #config{transport_info = {Transport,_,_, _} =CbInfo,
connection_cb = ConnectionCb,
- ssl = SslOpts}}}, Timeout) ->
- %% The setopt could have been invoked on the listen socket
- %% and options should be inherited.
- EmOptions = emulated_options(),
- {Transport,_,_, _} = CbInfo,
- {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions),
- ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()),
+ ssl = SslOpts,
+ emulated = Tracker}}}, Timeout) ->
case Transport:accept(ListenSocket, Timeout) of
{ok, Socket} ->
- ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues),
+ {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker),
{ok, Port} = ssl_socket:port(Transport, Socket),
ConnArgs = [server, "localhost", Port, Socket,
- {SslOpts, socket_options(SocketValues)}, self(), CbInfo],
+ {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, self(), CbInfo],
ConnectionSup = connection_sup(ConnectionCb),
case ConnectionSup:start_child(ConnArgs) of
{ok, Pid} ->
@@ -223,16 +221,16 @@ ssl_accept(#sslsocket{} = Socket, SslOptions, Timeout) ->
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
{Transport,_,_,_} =
proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}),
- EmulatedOptions = emulated_options(),
+ EmulatedOptions = ssl_socket:emulated_options(),
{ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions),
ConnetionCb = connection_cb(SslOptions),
try handle_options(SslOptions ++ SocketValues, server) of
{ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} ->
- ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()),
+ ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()),
{ok, Port} = ssl_socket:port(Transport, Socket),
ssl_connection:ssl_accept(ConnetionCb, Port, Socket,
- {SslOpts, EmOpts},
- self(), CbInfo, Timeout)
+ {SslOpts, emulated_socket_options(EmOpts, #socket_options{})},
+ self(), CbInfo, Timeout)
catch
Error = {error, _Reason} -> Error
end.
@@ -357,11 +355,7 @@ cipher_suites(openssl) ->
[ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)];
cipher_suites(all) ->
Version = tls_record:highest_protocol_version([]),
- Supported = ssl_cipher:suites(Version)
- ++ ssl_cipher:anonymous_suites()
- ++ ssl_cipher:psk_suites(Version)
- ++ ssl_cipher:srp_suites(),
- [suite_definition(S) || S <- Supported].
+ [suite_definition(S) || S <- ssl_cipher:all_suites(Version)].
%%--------------------------------------------------------------------
-spec getopts(#sslsocket{}, [gen_tcp:option_name()]) ->
@@ -371,7 +365,7 @@ cipher_suites(all) ->
%%--------------------------------------------------------------------
getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
ssl_connection:get_opts(Pid, OptionTags);
-getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}},
+getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket,
OptionTags) when is_list(OptionTags) ->
try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of
{ok, _} = Result ->
@@ -379,8 +373,8 @@ getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_
{error, InetError} ->
{error, {options, {socket_options, OptionTags, InetError}}}
catch
- _:_ ->
- {error, {options, {socket_options, OptionTags}}}
+ _:Error ->
+ {error, {options, {socket_options, OptionTags, Error}}}
end;
getopts(#sslsocket{}, OptionTags) ->
{error, {options, {socket_options, OptionTags}}}.
@@ -400,7 +394,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
{error, {options, {not_a_proplist, Options0}}}
end;
-setopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, Options) when is_list(Options) ->
+setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) ->
try ssl_socket:setopts(Transport, ListenSocket, Options) of
ok ->
ok;
@@ -551,7 +545,8 @@ do_connect(Address, Port,
{Transport, _, _, _} = CbInfo,
try Transport:connect(Address, Port, SocketOpts, Timeout) of
{ok, Socket} ->
- ssl_connection:connect(ConnetionCb, Address, Port, Socket, {SslOpts,EmOpts},
+ ssl_connection:connect(ConnetionCb, Address, Port, Socket,
+ {SslOpts, emulated_socket_options(EmOpts, #socket_options{})},
self(), CbInfo, Timeout);
{error, Reason} ->
{error, Reason}
@@ -641,7 +636,8 @@ handle_options(Opts0, _Role) ->
user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined),
psk_identity = handle_option(psk_identity, Opts, undefined),
srp_identity = handle_option(srp_identity, Opts, undefined),
- ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), hd(Versions)),
+ ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []),
+ RecordCb:highest_protocol_version(Versions)),
%% Server side option
reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
reuse_sessions = handle_option(reuse_sessions, Opts, true),
@@ -904,40 +900,24 @@ ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) ->
%% some trusted certs.
ca_cert_default(verify_peer, undefined, _) ->
"".
-
-emulated_options() ->
- [mode, packet, active, header, packet_size].
-
-internal_inet_values() ->
- [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}].
-
-socket_options(InetValues) ->
- #socket_options{
- mode = proplists:get_value(mode, InetValues, lists),
- header = proplists:get_value(header, InetValues, 0),
- active = proplists:get_value(active, InetValues, active),
- packet = proplists:get_value(packet, InetValues, 0),
- packet_size = proplists:get_value(packet_size, InetValues)
- }.
-
emulated_options(Opts) ->
- emulated_options(Opts, internal_inet_values(), #socket_options{}).
-
-emulated_options([{mode,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(mode,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt});
-emulated_options([{header,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(header,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{header=Opt});
-emulated_options([{active,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(active,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{active=Opt});
-emulated_options([{packet,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(packet,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt});
-emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) ->
- validate_inet_option(packet_size,Opt),
- emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt});
+ emulated_options(Opts, ssl_socket:internal_inet_values(), ssl_socket:default_inet_values()).
+
+emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) ->
+ validate_inet_option(mode, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]);
+emulated_options([{header, Value} = Opt | Opts], Inet, Emulated) ->
+ validate_inet_option(header, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(header, Emulated)]);
+emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) ->
+ validate_inet_option(active, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]);
+emulated_options([{packet, Value} = Opt |Opts], Inet, Emulated) ->
+ validate_inet_option(packet, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(packet, Emulated)]);
+emulated_options([{packet_size, Value} = Opt | Opts], Inet, Emulated) ->
+ validate_inet_option(packet_size, Value),
+ emulated_options(Opts, Inet, [Opt | proplists:delete(packet_size, Emulated)]);
emulated_options([Opt|Opts], Inet, Emulated) ->
emulated_options(Opts, [Opt|Inet], Emulated);
emulated_options([], Inet,Emulated) ->
@@ -953,7 +933,7 @@ handle_cipher_option(Value, Version) when is_list(Value) ->
error:_->
throw({error, {options, {ciphers, Value}}})
end.
-binary_cipher_suites(Version, []) -> %% Defaults to all supported suits
+binary_cipher_suites(Version, []) -> % Defaults to all supported suites
ssl_cipher:suites(Version);
binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility
Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0],
@@ -1076,3 +1056,17 @@ assert_proplist([inet6 | Rest]) ->
assert_proplist(Rest);
assert_proplist([Value | _]) ->
throw({option_not_a_key_value_tuple, Value}).
+
+emulated_socket_options(InetValues, #socket_options{
+ mode = Mode,
+ header = Header,
+ active = Active,
+ packet = Packet,
+ packet_size = Size}) ->
+ #socket_options{
+ mode = proplists:get_value(mode, InetValues, Mode),
+ header = proplists:get_value(header, InetValues, Header),
+ active = proplists:get_value(active, InetValues, Active),
+ packet = proplists:get_value(packet, InetValues, Packet),
+ packet_size = proplists:get_value(packet_size, InetValues, Size)
+ }.
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index db1535b5ec..78dc98bc25 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -31,7 +31,7 @@
-include("ssl_record.hrl").
-include("ssl_internal.hrl").
--export([encode/3, alert_txt/1, reason_code/2]).
+-export([encode/3, decode/1, alert_txt/1, reason_code/2]).
%%====================================================================
%% Internal application API
@@ -41,12 +41,21 @@
-spec encode(#alert{}, ssl_record:ssl_version(), #connection_states{}) ->
{iolist(), #connection_states{}}.
%%
-%% Description:
+%% Description: Encodes an alert
%%--------------------------------------------------------------------
encode(#alert{} = Alert, Version, ConnectionStates) ->
ssl_record:encode_alert_record(Alert, Version, ConnectionStates).
%%--------------------------------------------------------------------
+-spec decode(binary()) -> [#alert{}] | #alert{}.
+%%
+%% Description: Decode alert(s), will return a singel own alert if peer
+%% sends garbage or too many warning alerts.
+%%--------------------------------------------------------------------
+decode(Bin) ->
+ decode(Bin, [], 0).
+
+%%--------------------------------------------------------------------
-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}.
%%
%% Description: Returns the error reason that will be returned to the
@@ -71,6 +80,22 @@ alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}})
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
+
+%% It is very unlikely that an correct implementation will send more than one alert at the time
+%% So it there is more than 10 warning alerts we consider it an error
+decode(<<?BYTE(Level), ?BYTE(_), _/binary>>, _, N) when Level == ?WARNING, N > ?MAX_ALERTS ->
+ ?ALERT_REC(?FATAL, ?DECODE_ERROR);
+decode(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc, N) when Level == ?WARNING ->
+ Alert = ?ALERT_REC(Level, Description),
+ decode(Rest, [Alert | Acc], N + 1);
+decode(<<?BYTE(Level), ?BYTE(Description), _Rest/binary>>, Acc, _) when Level == ?FATAL->
+ Alert = ?ALERT_REC(Level, Description),
+ lists:reverse([Alert | Acc]); %% No need to decode rest fatal alert will end the connection
+decode(<<?BYTE(_Level), _/binary>>, _, _) ->
+ ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER);
+decode(<<>>, Acc, _) ->
+ lists:reverse(Acc, []).
+
level_txt(?WARNING) ->
"Warning:";
level_txt(?FATAL) ->
diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl
index 2d1f323085..f4f1d74264 100644
--- a/lib/ssl/src/ssl_alert.hrl
+++ b/lib/ssl/src/ssl_alert.hrl
@@ -104,6 +104,8 @@
-define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}).
+-define(MAX_ALERTS, 10).
+
%% Alert
-record(alert, {
level,
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 78a328ace8..a3ec419c2a 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -34,7 +34,8 @@
-export([security_parameters/2, security_parameters/3, suite_definition/1,
decipher/5, cipher/5,
- suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0,
+ suite/1, suites/1, all_suites/1,
+ ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0,
openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]).
@@ -224,6 +225,11 @@ suites({3, 0}) ->
suites({3, N}) ->
tls_v1:suites(N).
+all_suites(Version) ->
+ suites(Version)
+ ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:psk_suites(Version)
+ ++ ssl_cipher:srp_suites().
%%--------------------------------------------------------------------
-spec anonymous_suites() -> [cipher_suite()].
%%
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index c2810a199f..1eda926bcb 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -290,12 +290,11 @@ hello(#hello_request{}, #state{role = client} = State0, Connection) ->
{Record, State} = Connection:next_record(State0),
Connection:next_state(hello, hello, Record, State);
-hello({common_client_hello, Type, ServerHelloExt, HashSign},
- #state{session = #session{cipher_suite = CipherSuite},
- negotiated_version = Version} = State, Connection) ->
- {KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite),
- NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version),
+hello({common_client_hello, Type, ServerHelloExt, NegotiatedHashSign},
+ State, Connection) ->
do_server_hello(Type, ServerHelloExt,
+ %% Note NegotiatedHashSign is only negotiated for real if
+ %% if TLS version is at least TLS-1.2
State#state{hashsign_algorithm = NegotiatedHashSign}, Connection);
hello(timeout, State, _) ->
@@ -432,7 +431,8 @@ certify(#server_key_exchange{exchange_keys = Keys},
calculate_secret(Params#server_key_params.params,
State#state{hashsign_algorithm = HashSign}, Connection);
false ->
- ?ALERT_REC(?FATAL, ?DECRYPT_ERROR)
+ Connection:handle_own_alert(?ALERT_REC(?FATAL, ?DECRYPT_ERROR),
+ Version, certify, State)
end
end;
@@ -441,8 +441,9 @@ certify(#server_key_exchange{} = Msg,
Connection:handle_unexpected_message(Msg, certify_server_keyexchange, State);
certify(#certificate_request{hashsign_algorithms = HashSigns},
- #state{session = #session{own_certificate = Cert}} = State0, Connection) ->
- HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
+ #state{session = #session{own_certificate = Cert},
+ negotiated_version = Version} = State0, Connection) ->
+ HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version),
{Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}),
Connection:next_state(certify, certify, Record,
State#state{cert_hashsign_algorithm = HashSign});
@@ -559,7 +560,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS
tls_handshake_history = Handshake
} = State0, Connection) ->
- HashSign = ssl_handshake:select_cert_hashsign(CertHashSign, Algo, Version),
+ HashSign = ssl_handshake:select_hashsign_algs(CertHashSign, Algo, Version),
case ssl_handshake:certificate_verify(Signature, PublicKeyInfo,
Version, HashSign, MasterSecret, Handshake) of
valid ->
@@ -696,7 +697,11 @@ handle_sync_event({shutdown, How0}, _, StateName,
Error ->
{stop, normal, Error, State}
end;
-
+
+handle_sync_event({recv, _N, _Timeout}, _RecvFrom, StateName,
+ #state{socket_options = #socket_options{active = Active}} = State) when Active =/= false ->
+ {reply, {error, einval}, StateName, State, get_timeout(State)};
+
handle_sync_event({recv, N, Timeout}, RecvFrom, connection = StateName,
#state{protocol_cb = Connection} = State0) ->
Timer = start_or_recv_cancel_timer(Timeout, RecvFrom),
@@ -1559,60 +1564,6 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0
session = Session}, cipher, Connection),
Connection:next_state_connection(cipher, ack_connection(State#state{session = Session})).
-negotiated_hashsign(undefined, Algo, Version) ->
- default_hashsign(Version, Algo);
-negotiated_hashsign(HashSign = {_, _}, _, _) ->
- HashSign.
-
-%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
-%% If the client does not send the signature_algorithms extension, the
-%% server MUST do the following:
-%%
-%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA,
-%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had
-%% sent the value {sha1,rsa}.
-%%
-%% - If the negotiated key exchange algorithm is one of (DHE_DSS,
-%% DH_DSS), behave as if the client had sent the value {sha1,dsa}.
-%%
-%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
-%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
-
-default_hashsign(_Version = {Major, Minor}, KeyExchange)
- when Major >= 3 andalso Minor >= 3 andalso
- (KeyExchange == rsa orelse
- KeyExchange == dhe_rsa orelse
- KeyExchange == dh_rsa orelse
- KeyExchange == ecdhe_rsa orelse
- KeyExchange == ecdh_rsa orelse
- KeyExchange == srp_rsa) ->
- {sha, rsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == rsa;
- KeyExchange == dhe_rsa;
- KeyExchange == dh_rsa;
- KeyExchange == ecdhe_rsa;
- KeyExchange == ecdh_rsa;
- KeyExchange == srp_rsa ->
- {md5sha, rsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == ecdhe_ecdsa;
- KeyExchange == ecdh_ecdsa ->
- {sha, ecdsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == dhe_dss;
- KeyExchange == dh_dss;
- KeyExchange == srp_dss ->
- {sha, dsa};
-default_hashsign(_Version, KeyExchange)
- when KeyExchange == dh_anon;
- KeyExchange == ecdh_anon;
- KeyExchange == psk;
- KeyExchange == dhe_psk;
- KeyExchange == rsa_psk;
- KeyExchange == srp_anon ->
- {null, anon}.
-
select_curve(#state{client_ecc = {[Curve|_], _}}) ->
{namedCurve, Curve};
select_curve(_) ->
@@ -1884,3 +1835,15 @@ new_ssl_options([undefined | Rest0], [Head1| Rest1], Acc) ->
new_ssl_options(Rest0, Rest1, [Head1 | Acc]);
new_ssl_options([Head0 | Rest0], [_| Rest1], Acc) ->
new_ssl_options(Rest0, Rest1, [Head0 | Acc]).
+
+negotiated_hashsign(undefined, Alg, Version) ->
+ %% Not negotiated choose default
+ case is_anonymous(Alg) of
+ true ->
+ {null, anon};
+ false ->
+ ssl_handshake:select_hashsign_algs(Alg, Version)
+ end;
+negotiated_hashsign(HashSign = {_, _}, _, _) ->
+ HashSign.
+
diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl
index 22614a2d34..58efeaf892 100644
--- a/lib/ssl/src/ssl_dist_sup.erl
+++ b/lib/ssl/src/ssl_dist_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2014. 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
@@ -45,9 +45,11 @@ start_link() ->
init([]) ->
SessionCertManager = session_and_cert_manager_child_spec(),
ConnetionManager = connection_manager_child_spec(),
+ ListenOptionsTracker = listen_options_tracker_child_spec(),
ProxyServer = proxy_server_child_spec(),
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
+ {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager,
+ ListenOptionsTracker,
ProxyServer]}}.
%%--------------------------------------------------------------------
@@ -68,7 +70,7 @@ connection_manager_child_spec() ->
StartFunc = {tls_connection_sup, start_link_dist, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [ssl_connection],
+ Modules = [tls_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
@@ -81,3 +83,11 @@ proxy_server_child_spec() ->
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
+listen_options_tracker_child_spec() ->
+ Name = ssl_socket_dist,
+ StartFunc = {ssl_listen_tracker_sup, start_link_dist, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 1108edcf48..fc67d2c28d 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -73,7 +73,8 @@
]).
%% MISC
--export([select_version/3, prf/5, select_hashsign/2, select_cert_hashsign/3,
+-export([select_version/3, prf/5, select_hashsign/3,
+ select_hashsign_algs/2, select_hashsign_algs/3,
premaster_secret/2, premaster_secret/3, premaster_secret/4]).
%%====================================================================
@@ -590,23 +591,25 @@ prf({3,1}, Secret, Label, Seed, WantedLength) ->
{ok, tls_v1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)};
prf({3,_N}, Secret, Label, Seed, WantedLength) ->
{ok, tls_v1:prf(?SHA256, Secret, Label, Seed, WantedLength)}.
+
+
%%--------------------------------------------------------------------
--spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary()) ->
- [{atom(), atom()}] | undefined.
+-spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary(), ssl_record:ssl_version()) ->
+ {atom(), atom()} | undefined.
%%
%% Description:
%%--------------------------------------------------------------------
-select_hashsign(_, undefined) ->
+select_hashsign(_, undefined, _Version) ->
{null, anon};
-select_hashsign(undefined, Cert) ->
+select_hashsign(undefined, Cert, Version) ->
#'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
#'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
- select_cert_hashsign(undefined, Algo, {undefined, undefined});
-select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) ->
+ select_hashsign_algs(undefined, Algo, Version);
+select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, Version) ->
#'OTPCertificate'{tbsCertificate = TBSCert} =public_key:pkix_decode_cert(Cert, otp),
#'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
- DefaultHashSign = {_, Sign} = select_cert_hashsign(undefined, Algo, {undefined, undefined}),
+ DefaultHashSign = {_, Sign} = select_hashsign_algs(undefined, Algo, Version),
case lists:filter(fun({sha, dsa}) ->
true;
({_, dsa}) ->
@@ -622,26 +625,59 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) ->
[HashSign| _] ->
HashSign
end.
+
%%--------------------------------------------------------------------
--spec select_cert_hashsign(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version() | {undefined, undefined}) ->
+-spec select_hashsign_algs(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version()) ->
{atom(), atom()}.
+%% Description: For TLS 1.2 hash function and signature algorithm pairs can be
+%% negotiated with the signature_algorithms extension,
+%% for previous versions always use appropriate defaults.
+%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
+%% If the client does not send the signature_algorithms extension, the
+%% server MUST do the following: (e.i defaults for TLS 1.2)
+%%
+%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA,
+%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had
+%% sent the value {sha1,rsa}.
+%%
+%% - If the negotiated key exchange algorithm is one of (DHE_DSS,
+%% DH_DSS), behave as if the client had sent the value {sha1,dsa}.
%%
-%% Description: For TLS 1.2 selected cert_hash_sign will be recived
-%% in the handshake message, for previous versions use appropriate defaults.
-%% This function is also used by select_hashsign to extract
-%% the alogrithm of the server cert key.
+%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
+%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
+
%%--------------------------------------------------------------------
-select_cert_hashsign(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso
+select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso
Major >= 3 andalso Minor >= 3 ->
HashSign;
-select_cert_hashsign(undefined,?'id-ecPublicKey', _) ->
+select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
+ {sha, rsa};
+select_hashsign_algs(undefined,?'id-ecPublicKey', _) ->
{sha, ecdsa};
-select_cert_hashsign(undefined, ?rsaEncryption, _) ->
+select_hashsign_algs(undefined, ?rsaEncryption, _) ->
{md5sha, rsa};
-select_cert_hashsign(undefined, ?'id-dsa', _) ->
+select_hashsign_algs(undefined, ?'id-dsa', _) ->
{sha, dsa}.
+-spec select_hashsign_algs(atom(), ssl_record:ssl_version()) -> {atom(), atom()}.
+%% Wrap function to keep the knowledge of the default values in
+%% one place only
+select_hashsign_algs(Alg, Version) when (Alg == rsa orelse
+ Alg == dhe_rsa orelse
+ Alg == dh_rsa orelse
+ Alg == ecdhe_rsa orelse
+ Alg == ecdh_rsa orelse
+ Alg == srp_rsa) ->
+ select_hashsign_algs(undefined, ?rsaEncryption, Version);
+select_hashsign_algs(Alg, Version) when (Alg == dhe_dss orelse
+ Alg == dh_dss orelse
+ Alg == srp_dss) ->
+ select_hashsign_algs(undefined, ?'id-dsa', Version);
+select_hashsign_algs(Alg, Version) when (Alg == ecdhe_ecdsa orelse
+ Alg == ecdh_ecdsa) ->
+ select_hashsign_algs(undefined, ?'id-ecPublicKey', Version).
+
%%--------------------------------------------------------------------
-spec master_secret(atom(), ssl_record:ssl_version(), #session{} | binary(), #connection_states{},
client | server) -> {binary(), #connection_states{}} | #alert{}.
@@ -1017,12 +1053,9 @@ decode_suites('3_bytes', Dec) ->
%%-------------Cipeher suite handling --------------------------------
available_suites(UserSuites, Version) ->
- case UserSuites of
- [] ->
- ssl_cipher:suites(Version);
- _ ->
- UserSuites
- end.
+ lists:filtermap(fun(Suite) ->
+ lists:member(Suite, ssl_cipher:all_suites(Version))
+ end, UserSuites).
available_suites(ServerCert, UserSuites, Version, Curve) ->
ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version))
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 8bf5b30a83..fd0d87bd5f 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -116,14 +116,6 @@
honor_cipher_order = false
}).
--record(config, {ssl, %% SSL parameters
- inet_user, %% User set inet options
- emulated, %% #socket_option{} emulated
- inet_ssl, %% inet options for internal ssl socket
- transport_info, %% Callback info
- connection_cb
- }).
-
-record(socket_options,
{
mode = list,
@@ -133,6 +125,15 @@
active = true
}).
+-record(config, {ssl, %% SSL parameters
+ inet_user, %% User set inet options
+ emulated, %% Emulated option list or "inherit_tracker" pid
+ inet_ssl, %% inet options for internal ssl socket
+ transport_info, %% Callback info
+ connection_cb
+ }).
+
+
-type state_name() :: hello | abbreviated | certify | cipher | connection.
-type gen_fsm_state_return() :: {next_state, state_name(), term()} |
{next_state, state_name(), term(), timeout()} |
diff --git a/lib/ssl/src/ssl_listen_tracker_sup.erl b/lib/ssl/src/ssl_listen_tracker_sup.erl
new file mode 100644
index 0000000000..29f40e846d
--- /dev/null
+++ b/lib/ssl/src/ssl_listen_tracker_sup.erl
@@ -0,0 +1,71 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2014. 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 a listen options tracker
+%%----------------------------------------------------------------------
+-module(ssl_listen_tracker_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0, start_link_dist/0]).
+-export([start_child/1, start_child_dist/1]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+start_link() ->
+ supervisor:start_link({local, tracker_name(normal)}, ?MODULE, []).
+
+start_link_dist() ->
+ supervisor:start_link({local, tracker_name(dist)}, ?MODULE, []).
+
+start_child(Args) ->
+ supervisor:start_child(tracker_name(normal), Args).
+
+start_child_dist(Args) ->
+ supervisor:start_child(tracker_name(dist), Args).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init(_O) ->
+ RestartStrategy = simple_one_for_one,
+ MaxR = 0,
+ MaxT = 3600,
+
+ Name = undefined, % As simple_one_for_one is used.
+ StartFunc = {ssl_socket, start_link, []},
+ Restart = temporary, % E.g. should not be restarted
+ Shutdown = 4000,
+ Modules = [ssl_socket],
+ Type = worker,
+
+ ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules},
+ {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}.
+
+tracker_name(normal) ->
+ ?MODULE;
+tracker_name(dist) ->
+ list_to_atom(atom_to_list(?MODULE) ++ "dist").
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index b0e9943e6d..7337225bc4 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -377,7 +377,7 @@ cipher(Version, Fragment,
ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version),
{CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}.
%%--------------------------------------------------------------------
--spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}}.
+-spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}.
%%
%% Description: Payload decryption
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl
index 1b6e637cd3..e42d637301 100644
--- a/lib/ssl/src/ssl_socket.erl
+++ b/lib/ssl/src/ssl_socket.erl
@@ -1,20 +1,72 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2014. 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_socket).
+-behaviour(gen_server).
+
-include("ssl_internal.hrl").
-include("ssl_api.hrl").
-export([socket/4, setopts/3, getopts/3, peername/2, sockname/2, port/2]).
+-export([emulated_options/0, internal_inet_values/0, default_inet_values/0,
+ init/1, start_link/2, terminate/2, inherit_tracker/3, get_emulated_opts/1,
+ set_emulated_opts/2, handle_call/3, handle_cast/2,
+ handle_info/2, code_change/3]).
+
+-record(state, {
+ emulated_opts,
+ port
+ }).
+%%--------------------------------------------------------------------
+%%% Internal API
+%%--------------------------------------------------------------------
socket(Pid, Transport, Socket, ConnectionCb) ->
#sslsocket{pid = Pid,
%% "The name "fd" is keept for backwards compatibility
fd = {Transport, Socket, ConnectionCb}}.
-
+setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+ {SockOpts, EmulatedOpts} = split_options(Options),
+ ok = set_emulated_opts(Tracker, EmulatedOpts),
+ inet:setopts(ListenSocket, SockOpts);
+setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_},
+ emulated = Tracker}}}, Options) ->
+ {SockOpts, EmulatedOpts} = split_options(Options),
+ ok = set_emulated_opts(Tracker, EmulatedOpts),
+ Transport:setopts(ListenSocket, SockOpts);
+%%% Following clauses will not be called for emulated options, they are handled in the connection process
setopts(gen_tcp, Socket, Options) ->
inet:setopts(Socket, Options);
setopts(Transport, Socket, Options) ->
Transport:setopts(Socket, Options).
+getopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+ {SockOptNames, EmulatedOptNames} = split_options(Options),
+ EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames),
+ SocketOpts = get_socket_opts(ListenSocket, SockOptNames, inet),
+ {ok, EmulatedOpts ++ SocketOpts};
+getopts(Transport, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+ {SockOptNames, EmulatedOptNames} = split_options(Options),
+ EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames),
+ SocketOpts = get_socket_opts(ListenSocket, SockOptNames, Transport),
+ {ok, EmulatedOpts ++ SocketOpts};
+%%% Following clauses will not be called for emulated options, they are handled in the connection process
getopts(gen_tcp, Socket, Options) ->
inet:getopts(Socket, Options);
getopts(Transport, Socket, Options) ->
@@ -34,3 +86,144 @@ port(gen_tcp, Socket) ->
inet:port(Socket);
port(Transport, Socket) ->
Transport:port(Socket).
+
+emulated_options() ->
+ [mode, packet, active, header, packet_size].
+
+internal_inet_values() ->
+ [{packet_size,0}, {packet, 0}, {header, 0}, {active, false}, {mode,binary}].
+
+default_inet_values() ->
+ [{packet_size, 0}, {packet,0}, {header, 0}, {active, true}, {mode, list}].
+
+inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = false}) ->
+ ssl_listen_tracker_sup:start_child([ListenSocket, EmOpts]);
+inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = true}) ->
+ ssl_listen_tracker_sup:start_child_dist([ListenSocket, EmOpts]).
+
+get_emulated_opts(TrackerPid, EmOptNames) ->
+ {ok, EmOpts} = get_emulated_opts(TrackerPid),
+ lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts),
+ Value end,
+ EmOptNames).
+
+get_emulated_opts(TrackerPid) ->
+ call(TrackerPid, get_emulated_opts).
+set_emulated_opts(TrackerPid, InetValues) ->
+ call(TrackerPid, {set_emulated_opts, InetValues}).
+
+%%====================================================================
+%% ssl_listen_tracker_sup API
+%%====================================================================
+
+start_link(Port, SockOpts) ->
+ gen_server:start_link(?MODULE, [Port, SockOpts], []).
+
+%%--------------------------------------------------------------------
+-spec init(list()) -> {ok, #state{}}.
+%% Possible return values not used now.
+%% | {ok, #state{}, timeout()} | ignore | {stop, term()}.
+%%
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([Port, Opts]) ->
+ process_flag(trap_exit, true),
+ true = link(Port),
+ {ok, #state{emulated_opts = Opts, port = Port}}.
+
+%%--------------------------------------------------------------------
+-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}.
+%% Possible return values not used now.
+%% {reply, reply(), #state{}, timeout()} |
+%% {noreply, #state{}} |
+%% {noreply, #state{}, timeout()} |
+%% {stop, reason(), reply(), #state{}} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call({set_emulated_opts, Opts0}, _From,
+ #state{emulated_opts = Opts1} = State) ->
+ Opts = do_set_emulated_opts(Opts0, Opts1),
+ {reply, ok, State#state{emulated_opts = Opts}};
+handle_call(get_emulated_opts, _From,
+ #state{emulated_opts = Opts} = State) ->
+ {reply, {ok, Opts}, State}.
+
+%%--------------------------------------------------------------------
+-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}.
+%% Possible return values not used now.
+%% | {noreply, #state{}, timeout()} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(_, State)->
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+-spec handle_info(msg(), #state{}) -> {noreply, #state{}}.
+%% Possible return values not used now.
+%% |{noreply, #state{}, timeout()} |
+%% {stop, reason(), #state{}}.
+%%
+%% Description: Handling all non call/cast messages
+%%-------------------------------------------------------------------
+handle_info({'EXIT', Port, _}, #state{port = Port} = State) ->
+ {stop, normal, State}.
+
+
+%%--------------------------------------------------------------------
+-spec terminate(reason(), #state{}) -> ok.
+%%
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%--------------------------------------------------------------------
+-spec code_change(term(), #state{}, list()) -> {ok, #state{}}.
+%%
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+call(Pid, Msg) ->
+ gen_server:call(Pid, Msg, infinity).
+
+split_options(Opts) ->
+ split_options(Opts, emulated_options(), [], []).
+split_options([], _, SocketOpts, EmuOpts) ->
+ {SocketOpts, EmuOpts};
+split_options([{Name, _} = Opt | Opts], Emu, SocketOpts, EmuOpts) ->
+ case lists:member(Name, Emu) of
+ true ->
+ split_options(Opts, Emu, SocketOpts, [Opt | EmuOpts]);
+ false ->
+ split_options(Opts, Emu, [Opt | SocketOpts], EmuOpts)
+ end;
+split_options([Name | Opts], Emu, SocketOptNames, EmuOptNames) ->
+ case lists:member(Name, Emu) of
+ true ->
+ split_options(Opts, Emu, SocketOptNames, [Name | EmuOptNames]);
+ false ->
+ split_options(Opts, Emu, [Name | SocketOptNames], EmuOptNames)
+ end.
+
+do_set_emulated_opts([], Opts) ->
+ Opts;
+do_set_emulated_opts([{Name,_} = Opt | Rest], Opts) ->
+ do_set_emulated_opts(Rest, [Opt | proplists:delete(Name, Opts)]).
+
+get_socket_opts(_, [], _) ->
+ [];
+get_socket_opts(ListenSocket, SockOptNames, Cb) ->
+ {ok, Opts} = Cb:getopts(ListenSocket, SockOptNames),
+ Opts.
diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl
index e1aeb11ca4..7cccf8d5a5 100644
--- a/lib/ssl/src/ssl_sup.erl
+++ b/lib/ssl/src/ssl_sup.erl
@@ -47,8 +47,10 @@ init([]) ->
TLSConnetionManager = tls_connection_manager_child_spec(),
%% Not supported yet
%%DTLSConnetionManager = tls_connection_manager_child_spec(),
-
- {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager]}}.
+ %% Handles emulated options so that they inherited by the accept socket, even when setopts is performed on
+ %% the listen socket
+ ListenOptionsTracker = listen_options_tracker_child_spec(),
+ {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, ListenOptionsTracker]}}.
manager_opts() ->
@@ -85,7 +87,7 @@ tls_connection_manager_child_spec() ->
StartFunc = {tls_connection_sup, start_link, []},
Restart = permanent,
Shutdown = 4000,
- Modules = [tls_connection, ssl_connection],
+ Modules = [tls_connection_sup],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
@@ -98,6 +100,17 @@ tls_connection_manager_child_spec() ->
%% Type = supervisor,
%% {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+listen_options_tracker_child_spec() ->
+ Name = ssl_socket,
+ StartFunc = {ssl_listen_tracker_sup, start_link, []},
+ Restart = permanent,
+ Shutdown = 4000,
+ Modules = [ssl_socket],
+ Type = supervisor,
+ {Name, StartFunc, Restart, Shutdown, Type, Modules}.
+
+
session_cb_init_args() ->
case application:get_env(ssl, session_cb_init_args) of
{ok, Args} when is_list(Args) ->
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index ffa04ee8ba..32086ff6ce 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. 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
@@ -208,11 +208,11 @@ hello(Hello = #client_hello{client_version = ClientVersion,
session_cache = Cache,
session_cache_cb = CacheCb,
ssl_options = SslOpts}) ->
- HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, Session},
ConnectionStates, ServerHelloExt} ->
+ HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version),
ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign},
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
@@ -362,20 +362,11 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0) ->
ssl_record:encode_handshake(Frag, Version, ConnectionStates0),
{Encoded, ConnectionStates, Hist}.
-
encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
ssl_record:encode_change_cipher_spec(Version, ConnectionStates).
-
-
decode_alerts(Bin) ->
- decode_alerts(Bin, []).
-
-decode_alerts(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc) ->
- A = ?ALERT_REC(Level, Description),
- decode_alerts(Rest, [A | Acc]);
-decode_alerts(<<>>, Acc) ->
- lists:reverse(Acc, []).
+ ssl_alert:decode(Bin).
initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
{CbModule, DataTag, CloseTag, ErrorTag}) ->
@@ -420,10 +411,13 @@ next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = S
next_state(_,Next, no_record, State) ->
{next_state, Next, State, get_timeout(State)};
-next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) ->
- Alerts = decode_alerts(EncAlerts),
- handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)});
-
+next_state(Current, Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, #state{negotiated_version = Version} = State) ->
+ case decode_alerts(EncAlerts) of
+ Alerts = [_|_] ->
+ handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)});
+ #alert{} = Alert ->
+ handle_own_alert(Alert, Version, Current, State)
+ end;
next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
State0 = #state{protocol_buffers =
#protocol_buffers{tls_handshake_buffer = Buf0} = Buffers,
@@ -751,7 +745,11 @@ handle_tls_handshake(Handle, StateName,
handle_tls_handshake(Handle, NextStateName, State);
{stop, _,_} = Stop ->
Stop
- end.
+ end;
+
+handle_tls_handshake(_Handle, _StateName, #state{}) ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)).
+
write_application_data(Data0, From,
#state{socket = Socket,
negotiated_version = Version,
@@ -859,7 +857,8 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert,
{Record, State} = next_record(State0),
next_state(StateName, connection, Record, State);
-handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName,
+%% Gracefully log and ignore all other warning alerts
+handle_alert(#alert{level = ?WARNING} = Alert, StateName,
#state{ssl_options = SslOpts} = State0) ->
log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
{Record, State} = next_record(State0),
diff --git a/lib/ssl/src/tls_connection_sup.erl b/lib/ssl/src/tls_connection_sup.erl
index 6f0d8a7262..7a637c212a 100644
--- a/lib/ssl/src/tls_connection_sup.erl
+++ b/lib/ssl/src/tls_connection_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. 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
@@ -59,7 +59,7 @@ init(_O) ->
StartFunc = {tls_connection, start_link, []},
Restart = temporary, % E.g. should not be restarted
Shutdown = 4000,
- Modules = [tls_connection],
+ Modules = [tls_connection, ssl_connection],
Type = worker,
ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules},
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index 4da08e9c51..f50ea22f39 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -154,21 +154,24 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version,
sequence_number = Seq,
security_parameters = SecParams} = ReadState0,
CompressAlg = SecParams#security_parameters.compression_algorithm,
- {PlainFragment, Mac, ReadState1} = ssl_record:decipher(Version, CipherFragment, ReadState0),
- MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1),
- case ssl_record:is_correct_mac(Mac, MacHash) of
- true ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg,
- PlainFragment, CompressionS0),
- ConnnectionStates = ConnnectionStates0#connection_states{
- current_read = ReadState1#connection_state{
- sequence_number = Seq + 1,
- compression_state = CompressionS1}},
- {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
- false ->
- ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
- end.
-
+ case ssl_record:decipher(Version, CipherFragment, ReadState0) of
+ {PlainFragment, Mac, ReadState1} ->
+ MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1),
+ case ssl_record:is_correct_mac(Mac, MacHash) of
+ true ->
+ {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg,
+ PlainFragment, CompressionS0),
+ ConnnectionStates = ConnnectionStates0#connection_states{
+ current_read = ReadState1#connection_state{
+ sequence_number = Seq + 1,
+ compression_state = CompressionS1}},
+ {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ false ->
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end;
+ #alert{} = Alert ->
+ Alert
+ end.
%%--------------------------------------------------------------------
-spec protocol_version(tls_atom_version() | tls_version()) ->
tls_version() | tls_atom_version().
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index 0947657ca7..15a7e118ff 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -32,6 +32,7 @@
v2_crls = true,
ecc_certs = false,
issuing_distribution_point = false,
+ crl_port = 8000,
openssl_cmd = "openssl"}).
@@ -57,6 +58,8 @@ make_config([{default_bits, Bits}|T], C) when is_integer(Bits) ->
make_config(T, C#config{default_bits = Bits});
make_config([{v2_crls, Bool}|T], C) when is_boolean(Bool) ->
make_config(T, C#config{v2_crls = Bool});
+make_config([{crl_port, Port}|T], C) when is_integer(Port) ->
+ make_config(T, C#config{crl_port = Port});
make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) ->
make_config(T, C#config{ecc_certs = Bool});
make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) ->
@@ -423,7 +426,7 @@ ca_cnf(C) ->
"[crl_section]\n"
%% intentionally invalid
"URI.1=http://localhost/",C#config.commonName,"/crl.pem\n"
- "URI.2=http://localhost:8000/",C#config.commonName,"/crl.pem\n"
+ "URI.2=http://localhost:",integer_to_list(C#config.crl_port),"/",C#config.commonName,"/crl.pem\n"
"\n"
"[user_cert_digital_signature_only]\n"
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 8e3d2e4b80..a1b766e05f 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -115,7 +115,10 @@ options_tests() ->
reuseaddr,
tcp_reuseaddr,
honor_server_cipher_order,
- honor_client_cipher_order
+ honor_client_cipher_order,
+ ciphersuite_vs_version,
+ unordered_protocol_versions_server,
+ unordered_protocol_versions_client
].
api_tests() ->
@@ -138,7 +141,8 @@ api_tests() ->
ssl_accept_timeout,
ssl_recv_timeout,
versions_option,
- server_name_indication_option
+ server_name_indication_option,
+ accept_pool
].
session_tests() ->
@@ -187,7 +191,10 @@ error_handling_tests()->
tcp_error_propagation_in_active_mode,
tcp_connect,
tcp_connect_big,
- close_transport_accept
+ close_transport_accept,
+ recv_active,
+ recv_active_once,
+ dont_crash_on_handshake_garbage
].
rizzo_tests() ->
@@ -240,6 +247,14 @@ end_per_group(_GroupName, Config) ->
Config.
%%--------------------------------------------------------------------
+init_per_testcase(Case, Config) when Case == unordered_protocol_versions_client;
+ Case == unordered_protocol_versions_server->
+ case proplists:get_value(supported, ssl:versions()) of
+ ['tlsv1.2' | _] ->
+ Config;
+ _ ->
+ {skip, "TLS 1.2 need but not supported on this platform"}
+ end;
init_per_testcase(no_authority_key_identifier, Config) ->
%% Clear cach so that root cert will not
%% be found.
@@ -396,6 +411,7 @@ protocol_versions() ->
protocol_versions(Config) when is_list(Config) ->
basic_test(Config).
+
%%--------------------------------------------------------------------
empty_protocol_versions() ->
[{doc,"Test to set an empty list of protocol versions in app environment."}].
@@ -1154,6 +1170,57 @@ close_transport_accept(Config) when is_list(Config) ->
Other ->
exit({?LINE, Other})
end.
+%%--------------------------------------------------------------------
+recv_active() ->
+ [{doc,"Test recv on active socket"}].
+
+recv_active(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, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active, []}},
+ {options, [{active, true} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client =
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active, []}},
+ {options, [{active, true} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+recv_active_once() ->
+ [{doc,"Test recv on active socket"}].
+
+recv_active_once(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, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active_once, []}},
+ {options, [{active, once} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client =
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active_once, []}},
+ {options, [{active, once} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
dh_params() ->
@@ -2559,6 +2626,81 @@ honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) ->
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
+ciphersuite_vs_version(Config) when is_list(Config) ->
+
+ {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]),
+ ok = gen_tcp:send(Socket,
+ <<22, 3,0, 49:16, % handshake, SSL 3.0, length
+ 1, 45:24, % client_hello, length
+ 3,0, % SSL 3.0
+ 16#deadbeef:256, % 32 'random' bytes = 256 bits
+ 0, % no session ID
+ %% three cipher suites -- null, one with sha256 hash and one with sha hash
+ 6:16, 0,255, 0,61, 0,57,
+ 1, 0 % no compression
+ >>),
+ {ok, <<22, RecMajor:8, RecMinor:8, _RecLen:16, 2, HelloLen:24>>} = gen_tcp:recv(Socket, 9, 10000),
+ {ok, <<HelloBin:HelloLen/binary>>} = gen_tcp:recv(Socket, HelloLen, 5000),
+ ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin),
+ case ServerHello of
+ #server_hello{server_version = {3,0}, cipher_suite = <<0,57>>} ->
+ ok;
+ _ ->
+ ct:fail({unexpected_server_hello, ServerHello})
+ end.
+
+%%--------------------------------------------------------------------
+
+dont_crash_on_handshake_garbage() ->
+ [{doc, "Ensure SSL server worker thows an alert on garbage during handshake "
+ "instead of crashing and exposing state to user code"}].
+
+dont_crash_on_handshake_garbage(Config) ->
+ ServerOpts = ?config(server_opts, Config),
+
+ {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ unlink(Server), monitor(process, Server),
+ Port = ssl_test_lib:inet_port(Server),
+
+ {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]),
+
+ % Send hello and garbage record
+ ok = gen_tcp:send(Socket,
+ [<<22, 3,3, 49:16, 1, 45:24, 3,3, % client_hello
+ 16#deadbeef:256, % 32 'random' bytes = 256 bits
+ 0, 6:16, 0,255, 0,61, 0,57, 1, 0 >>, % some hello values
+
+ <<22, 3,3, 5:16, 92,64,37,228,209>> % garbage
+ ]),
+ % Send unexpected change_cipher_spec
+ ok = gen_tcp:send(Socket, <<20, 0,0,12, 111,40,244,7,137,224,16,109,197,110,249,152>>),
+
+ % Ensure we receive an alert, not sudden disconnect
+ {ok, <<21, _/binary>>} = drop_handshakes(Socket, 1000).
+
+drop_handshakes(Socket, Timeout) ->
+ {ok, <<RecType:8, _RecMajor:8, _RecMinor:8, RecLen:16>> = Header} = gen_tcp:recv(Socket, 5, Timeout),
+ {ok, <<Frag:RecLen/binary>>} = gen_tcp:recv(Socket, RecLen, Timeout),
+ case RecType of
+ 22 -> drop_handshakes(Socket, Timeout);
+ _ -> {ok, <<Header/binary, Frag/binary>>}
+ end.
+
+
+%%--------------------------------------------------------------------
hibernate() ->
[{doc,"Check that an SSL connection that is started with option "
@@ -2957,6 +3099,57 @@ versions_option(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
+unordered_protocol_versions_server() ->
+ [{doc,"Test that the highest protocol is selected even"
+ " when it is not first in the versions list."}].
+
+unordered_protocol_versions_server(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, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, [{versions, ['tlsv1.1', 'tlsv1.2']} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, ClientOpts}]),
+ CipherSuite = first_rsa_suite(ssl:cipher_suites()),
+ ServerMsg = ClientMsg = {ok, {'tlsv1.2', CipherSuite}},
+ ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg).
+
+%%--------------------------------------------------------------------
+unordered_protocol_versions_client() ->
+ [{doc,"Test that the highest protocol is selected even"
+ " when it is not first in the versions list."}].
+
+unordered_protocol_versions_client(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, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, ServerOpts }]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, connection_info_result, []}},
+ {options, [{versions, ['tlsv1.1', 'tlsv1.2']} | ClientOpts]}]),
+
+ CipherSuite = first_rsa_suite(ssl:cipher_suites()),
+ ServerMsg = ClientMsg = {ok, {'tlsv1.2', CipherSuite}},
+ ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg).
+
+%%--------------------------------------------------------------------
server_name_indication_option() ->
[{doc,"Test API server_name_indication option to connect."}].
@@ -2994,6 +3187,53 @@ server_name_indication_option(Config) when is_list(Config) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client0),
ssl_test_lib:close(Client1).
+%%--------------------------------------------------------------------
+
+accept_pool() ->
+ [{doc,"Test having an accept pool."}].
+accept_pool(Config) when is_list(Config) ->
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server0 = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {accepters, 3},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server0),
+ [Server1, Server2] = ssl_test_lib:accepters(2),
+
+ Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ClientOpts}
+ ]),
+
+ Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ClientOpts}
+ ]),
+
+ Client2 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ClientOpts}
+ ]),
+
+ ssl_test_lib:check_ok([Server0, Server1, Server2, Client0, Client1, Client2]),
+
+ ssl_test_lib:close(Server0),
+ ssl_test_lib:close(Server1),
+ ssl_test_lib:close(Server2),
+ ssl_test_lib:close(Client0),
+ ssl_test_lib:close(Client1),
+ ssl_test_lib:close(Client2).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
@@ -3505,6 +3745,10 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
connection_info_result(Socket) ->
ssl:connection_info(Socket).
+version_info_result(Socket) ->
+ {ok, {Version, _}} = ssl:connection_info(Socket),
+ {ok, Version}.
+
connect_dist_s(S) ->
Msg = term_to_binary({erlang,term}),
ok = ssl:send(S, Msg).
@@ -3582,3 +3826,22 @@ version_option_test(Config, Version) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
+
+try_recv_active(Socket) ->
+ ssl:send(Socket, "Hello world"),
+ {error, einval} = ssl:recv(Socket, 11),
+ ok.
+try_recv_active_once(Socket) ->
+ {error, einval} = ssl:recv(Socket, 11),
+ ok.
+
+first_rsa_suite([{ecdhe_rsa, _, _} = Suite | _]) ->
+ Suite;
+first_rsa_suite([{dhe_rsa, _, _} = Suite| _]) ->
+ Suite;
+first_rsa_suite([{rsa, _, _} = Suite| _]) ->
+ Suite;
+first_rsa_suite([_ | Rest]) ->
+ first_rsa_suite(Rest).
+
+
diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl
index 4eacf3adfc..bad0949ec4 100644
--- a/lib/ssl/test/ssl_crl_SUITE.erl
+++ b/lib/ssl/test/ssl_crl_SUITE.erl
@@ -48,8 +48,8 @@ all() ->
].
groups() ->
- [{basic, [], basic_tests()},
- {v1_crl, [], v1_crl_tests()},
+ [{basic, [], basic_tests()},
+ {v1_crl, [], v1_crl_tests()},
{idp_crl, [], idp_crl_tests()}].
basic_tests() ->
@@ -72,8 +72,8 @@ init_per_suite(Config0) ->
_ ->
TLSVersion = ?config(tls_version, Config0),
OpenSSL_version = (catch os:cmd("openssl version")),
- ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssh:module_info(): ~p~n",
- [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssh:module_info()]),
+ ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssl:module_info(): ~p~n",
+ [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssl:module_info()]),
case ssl_test_lib:enough_openssl_crl_support(OpenSSL_version) of
false ->
{skip, io_lib:format("Bad openssl version: ~p",[OpenSSL_version])};
@@ -82,7 +82,13 @@ init_per_suite(Config0) ->
try crypto:start() of
ok ->
ssl:start(),
- [{watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0]
+ {ok, Hostname0} = inet:gethostname(),
+ IPfamily =
+ case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts,[])) of
+ true -> inet6;
+ false -> inet
+ end,
+ [{ipfamily,IPfamily}, {watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0]
catch _C:_E ->
ct:log("crypto:start() caught ~p:~p",[_C,_E]),
{skip, "Crypto did not start"}
@@ -98,21 +104,23 @@ end_per_suite(_Config) ->
%%% Group init/end
init_per_group(Group, Config) ->
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
ssl:start(),
inets:start(),
CertDir = filename:join(?config(priv_dir, Config), Group),
DataDir = ?config(data_dir, Config),
ServerRoot = make_dir_path([?config(priv_dir,Config), Group, tmp]),
- Result = make_certs:all(DataDir, CertDir, cert_opts(Group)),
- ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, cert_opts(Group), Result]),
%% start a HTTP server to serve the CRLs
- {ok, Httpd} = inets:start(httpd, [{server_name, "localhost"}, {port, 8000},
+ {ok, Httpd} = inets:start(httpd, [{ipfamily, ?config(ipfamily,Config)},
+ {server_name, "localhost"}, {port, 0},
{server_root, ServerRoot},
{document_root, CertDir},
{modules, [mod_get]}
]),
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
+ [{port,Port}] = httpd:info(Httpd, [port]),
+ ct:log("~p:~p~nHTTPD IP family=~p, port=~p~n", [?MODULE, ?LINE, ?config(ipfamily,Config), Port]),
+ CertOpts = [{crl_port,Port}|cert_opts(Group)],
+ Result = make_certs:all(DataDir, CertDir, CertOpts),
+ ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, CertOpts, Result]),
[{make_cert_result, Result}, {cert_dir, CertDir}, {httpd, Httpd} | Config].
cert_opts(v1_crl) -> [{v2_crls, false}];
@@ -134,7 +142,6 @@ end_per_group(_GroupName, Config) ->
,ct:log("Stopped",[])
end,
inets:stop(),
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
Config.
%%%================================================================
@@ -481,7 +488,6 @@ fetch([]) ->
not_available;
fetch([{uniformResourceIdentifier, "http"++_=URL}|Rest]) ->
ct:log("~p:~p~ngetting CRL from ~p~n", [?MODULE,?LINE, URL]),
- ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]),
case httpc:request(get, {URL, []}, [], [{body_format, binary}]) of
{ok, {_Status, _Headers, Body}} ->
case Body of
diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl
index 6d020c472b..5f36842f9e 100644
--- a/lib/ssl/test/ssl_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_handshake_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -26,6 +26,7 @@
-include_lib("common_test/include/ct.hrl").
-include("ssl_internal.hrl").
-include("tls_handshake.hrl").
+-include_lib("public_key/include/public_key.hrl").
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
@@ -36,7 +37,8 @@ all() -> [decode_hello_handshake,
decode_single_hello_extension_correctly,
decode_supported_elliptic_curves_hello_extension_correctly,
decode_unknown_hello_extension_correctly,
- encode_single_hello_sni_extension_correctly].
+ encode_single_hello_sni_extension_correctly,
+ select_proper_tls_1_2_rsa_default_hashsign].
%%--------------------------------------------------------------------
%% Test Cases --------------------------------------------------------
@@ -95,3 +97,11 @@ encode_single_hello_sni_extension_correctly(_Config) ->
HelloExt = <<ExtSize:16/unsigned-big-integer, SNI/binary>>,
Encoded = ssl_handshake:encode_hello_extensions(Exts),
HelloExt = Encoded.
+
+select_proper_tls_1_2_rsa_default_hashsign(_Config) ->
+ % RFC 5246 section 7.4.1.4.1 tells to use {sha1,rsa} as default signature_algorithm for RSA key exchanges
+ {sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,3}),
+ % Older versions use MD5/SHA1 combination
+ {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,2}),
+ {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,0}).
+
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 59f10d53a6..69b222fc43 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -67,7 +67,16 @@ run_server(Opts) ->
run_server(ListenSocket, Opts).
run_server(ListenSocket, Opts) ->
- do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts).
+ Accepters = proplists:get_value(accepters, Opts, 1),
+ run_server(ListenSocket, Opts, Accepters).
+
+run_server(ListenSocket, Opts, 1) ->
+ do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts);
+run_server(ListenSocket, Opts, N) ->
+ Pid = proplists:get_value(from, Opts),
+ Server = spawn(?MODULE, run_server, [ListenSocket, Opts, 1]),
+ Pid ! {accepter, N, Server},
+ run_server(ListenSocket, Opts, N-1).
do_run_server(_, {error, timeout} = Result, Opts) ->
Pid = proplists:get_value(from, Opts),
@@ -290,7 +299,16 @@ wait_for_result(Server, ServerMsg, Client, ClientMsg) ->
%% Unexpected
end.
-
+check_ok([]) ->
+ ok;
+check_ok(Pids) ->
+ receive
+ {Pid, ok} ->
+ check_ok(lists:delete(Pid, Pids));
+ Other ->
+ ct:fail({expected, {"pid()", ok}, got, Other})
+ end.
+
wait_for_result(Pid, Msg) ->
receive
{Pid, Msg} ->
@@ -679,6 +697,17 @@ run_client_error(Opts) ->
Error = rpc:call(Node, Transport, connect, [Host, Port, Options]),
Pid ! {self(), Error}.
+accepters(N) ->
+ accepters([], N).
+
+accepters(Acc, 0) ->
+ Acc;
+accepters(Acc, N) ->
+ receive
+ {accepter, _, Server} ->
+ accepters([Server| Acc], N-1)
+ end.
+
inet_port(Pid) when is_pid(Pid)->
receive
{Pid, {port, Port}} ->
diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml
index f81e36f810..7f25f5b7bc 100644
--- a/lib/stdlib/doc/src/erl_tar.xml
+++ b/lib/stdlib/doc/src/erl_tar.xml
@@ -35,10 +35,11 @@
<modulesummary>Unix 'tar' utility for reading and writing tar archives</modulesummary>
<description>
<p>The <c>erl_tar</c> module archives and extract files to and from
- a tar file. The tar file format is the POSIX extended tar file format
- specified in IEEE Std 1003.1 and ISO/IEC&nbsp;9945-1. That is the same
- format as used by <c>tar</c> program on Solaris, but is not the same
- as used by the GNU tar program.</p>
+ a tar file. <c>erl_tar</c> supports the <c>ustar</c> format
+ (IEEE Std 1003.1 and ISO/IEC&nbsp;9945-1). All modern <c>tar</c>
+ programs (including GNU tar) can read this format. To ensure that
+ that GNU tar produces a tar file that <c>erl_tar</c> can read,
+ give the <c>--format=ustar</c> option to GNU tar.</p>
<p>By convention, the name of a tar file should end in "<c>.tar</c>".
To abide to the convention, you'll need to add "<c>.tar</c>" yourself
to the name.</p>
@@ -65,6 +66,20 @@
</description>
<section>
+ <title>UNICODE SUPPORT</title>
+ <p>If <seealso
+ marker="kernel:file#native_name_encoding/0">file:native_name_encoding/0</seealso>
+ returns <c>utf8</c>, path names will be encoded in UTF-8 when
+ creating tar files and path names will be assumed to be encoded in
+ UTF-8 when extracting tar files.</p>
+
+ <p>If <seealso
+ marker="kernel:file#native_name_encoding/0">file:native_name_encoding/0</seealso>
+ returns <c>latin1</c>, no translation of path names will be
+ done.</p>
+ </section>
+
+ <section>
<title>LIMITATIONS</title>
<p>For maximum compatibility, it is safe to archive files with names
up to 100 characters in length. Such tar files can generally be
@@ -112,8 +127,8 @@
<fsummary>Add a file to an open tar file</fsummary>
<type>
<v>TarDescriptor = term()</v>
- <v>FilenameOrBin = Filename()|binary()</v>
- <v>Filename = filename()()</v>
+ <v>FilenameOrBin = filename()|binary()</v>
+ <v>Filename = filename()</v>
<v>NameInArchive = filename()</v>
<v>Options = [Option]</v>
<v>Option = dereference|verbose</v>
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index acde3ad5d6..3cfedfee97 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -244,17 +244,17 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
erlang:raise(error, {undef_record,Name}, stacktrace());
%% map
-expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) ->
- {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs),
+expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) ->
+ {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, none),
case Map0 of
#{} ->
- {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef),
+ {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef),
Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) ->
maps:put(K, V, Mi);
({map_exact,K,V}, Mi) ->
maps:update(K, V, Mi)
end, Map0, Vs),
- ret_expr(Map1, Bs, RBs);
+ ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs);
_ ->
erlang:raise(error, {badarg,Map0}, stacktrace())
end;
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 7c064ce902..39cc03cf7a 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -1046,9 +1046,10 @@ check_undefined_types(#lint{usage=Usage,types=Def}=St0) ->
Used = Usage#usage.used_types,
UTAs = dict:fetch_keys(Used),
Undef = [{TA,dict:fetch(TA, Used)} ||
- TA <- UTAs,
+ {T,_}=TA <- UTAs,
not dict:is_key(TA, Def),
- not is_default_type(TA)],
+ not is_default_type(TA),
+ not is_newly_introduced_var_arity_type(T)],
foldl(fun ({TA,L}, St) ->
add_error(L, {undefined_type,TA}, St)
end, St0, Undef).
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 1dc5fc52a7..e1ae3b7aea 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -848,10 +848,12 @@ build_fun(Line, Cs) ->
end.
check_clauses(Cs, Name, Arity) ->
- mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity ->
- {clause,L,As,G,B};
- ({clause,L,_N,_As,_G,_B}) ->
- ret_err(L, "head mismatch") end, Cs).
+ [case C of
+ {clause,L,N,As,G,B} when N =:= Name, length(As) =:= Arity ->
+ {clause,L,As,G,B};
+ {clause,L,_N,_As,_G,_B} ->
+ ret_err(L, "head mismatch")
+ end || C <- Cs].
build_try(L,Es,Scs,{Ccs,As}) ->
{'try',L,Es,Scs,Ccs,As}.
@@ -861,17 +863,6 @@ ret_err(L, S) ->
{location,Location} = get_attribute(L, location),
return_error(Location, S).
-%% mapl(F,List)
-%% an alternative map which always maps from left to right
-%% and makes it possible to interrupt the mapping with throw on
-%% the first occurence from left as expected.
-%% can be removed when the jam machine (and all other machines)
-%% uses the standardized (Erlang 5.0) evaluation order (from left to right)
-mapl(F, [H|T]) ->
- V = F(H),
- [V | mapl(F,T)];
-mapl(_, []) ->
- [].
%% Convert between the abstract form of a term and a term.
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index 40b48d7999..acf7a5cd40 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -381,7 +381,12 @@ to_octal(Int, Count, Result) ->
to_octal(Int div 8, Count-1, [Int rem 8 + $0|Result]).
to_string(Str0, Count) ->
- Str = list_to_binary(Str0),
+ Str = case file:native_name_encoding() of
+ utf8 ->
+ unicode:characters_to_binary(Str0);
+ latin1 ->
+ list_to_binary(Str0)
+ end,
case byte_size(Str) of
Size when Size < Count ->
[Str|zeroes(Count-Size)];
@@ -392,9 +397,17 @@ to_string(Str0, Count) ->
pad_file(File) ->
{ok,Position} = file:position(File, {cur,0}),
- %% There must be at least one empty record at the end of the file.
- Zeros = zeroes(?block_size - (Position rem ?block_size)),
- file:write(File, Zeros).
+ %% There must be at least two zero records at the end.
+ Fill = case ?block_size - (Position rem ?block_size) of
+ Fill0 when Fill0 < 2*?record_size ->
+ %% We need to another block here to ensure that there
+ %% are at least two zero records at the end.
+ Fill0 + ?block_size;
+ Fill0 ->
+ %% Large enough.
+ Fill0
+ end,
+ file:write(File, zeroes(Fill)).
split_filename(Name) when length(Name) =< ?th_name_len ->
{"", Name};
@@ -608,7 +621,22 @@ typeflag(Bin) ->
%% Get the name of the file from the prefix and name fields of the
%% tar header.
-get_name(Bin) ->
+get_name(Bin0) ->
+ List0 = get_name_raw(Bin0),
+ case file:native_name_encoding() of
+ utf8 ->
+ Bin = list_to_binary(List0),
+ case unicode:characters_to_list(Bin) of
+ {error,_,_} ->
+ List0;
+ List when is_list(List) ->
+ List
+ end;
+ latin1 ->
+ List0
+ end.
+
+get_name_raw(Bin) ->
Name = from_string(Bin, ?th_name, ?th_name_len),
case binary_to_list(Bin, ?th_prefix+1, ?th_prefix+1) of
[0] ->
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index a266daa084..c0921e4cf1 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -488,7 +488,7 @@ badpattern(Reason) ->
error({badpattern,Reason}).
eval_read_file_info(File, file) ->
- file:read_file_info(File);
+ file:read_link_info(File);
eval_read_file_info(File, erl_prim_loader) ->
case erl_prim_loader:read_file_info(File) of
error -> {error, erl_prim_loader};
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index b91d14b5b8..b55324161b 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -1451,6 +1451,13 @@ eep43(Config) when is_list(Config) ->
" {Map#{a := B},Map#{a => c},Map#{d => e}} "
"end.",
{#{a => b},#{a => c},#{a => b,d => e}}),
+ check(fun () ->
+ lists:map(fun (X) -> X#{price := 0} end,
+ [#{hello => 0, price => nil}])
+ end,
+ "lists:map(fun (X) -> X#{price := 0} end,
+ [#{hello => 0, price => nil}]).",
+ [#{hello => 0, price => 0}]),
error_check("[camembert]#{}.", {badarg,[camembert]}),
error_check("#{} = 1.", {badmatch,1}),
ok.
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index d9512c0ef4..ea61b2082b 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -52,7 +52,7 @@
guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1,
otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1,
otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1,
- otp_11772/1, otp_11771/1,
+ otp_11772/1, otp_11771/1, otp_11872/1,
export_all/1,
bif_clash/1,
behaviour_basic/1, behaviour_multiple/1,
@@ -88,7 +88,7 @@ all() ->
otp_4886, otp_4988, otp_5091, otp_5276, otp_5338,
otp_5362, otp_5371, otp_7227, otp_5494, otp_5644,
otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254,
- otp_11772, otp_11771, export_all,
+ otp_11772, otp_11771, otp_11872, export_all,
bif_clash, behaviour_basic, behaviour_multiple,
otp_7550, otp_8051, format_warn, {group, on_load},
too_many_arguments, basic_errors, bin_syntax_errors, predef,
@@ -2630,6 +2630,29 @@ otp_11771(Config) when is_list(Config) ->
[]} = run_test2(Config, Ts, []),
ok.
+otp_11872(doc) ->
+ "OTP-11872. The type map() undefined when exported.";
+otp_11872(suite) -> [];
+otp_11872(Config) when is_list(Config) ->
+ Ts = <<"
+ -module(map).
+
+ -compile(export_all).
+
+ -export_type([map/0, product/0]).
+
+ -opaque map() :: dict().
+
+ -spec t() -> map().
+
+ t() ->
+ 1.
+ ">>,
+ {error,[{6,erl_lint,{undefined_type,{product,0}}}],
+ [{8,erl_lint,{new_var_arity_type,map}}]} =
+ run_test2(Config, Ts, []),
+ ok.
+
export_all(doc) ->
"OTP-7392. Warning for export_all.";
export_all(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index 4a67d68428..8203a03a7a 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -23,7 +23,7 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
wildcard_one/1,wildcard_two/1,wildcard_errors/1,
- fold_files/1,otp_5960/1,ensure_dir_eexist/1]).
+ fold_files/1,otp_5960/1,ensure_dir_eexist/1,symlinks/1]).
-import(lists, [foreach/2]).
@@ -43,7 +43,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[wildcard_one, wildcard_two, wildcard_errors,
- fold_files, otp_5960, ensure_dir_eexist].
+ fold_files, otp_5960, ensure_dir_eexist, symlinks].
groups() ->
[].
@@ -366,3 +366,39 @@ ensure_dir_eexist(Config) when is_list(Config) ->
?line {error, eexist} = filelib:ensure_dir(NeedFile),
?line {error, eexist} = filelib:ensure_dir(NeedFileB),
ok.
+
+symlinks(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Dir = filename:join(PrivDir, ?MODULE_STRING++"_symlinks"),
+ SubDir = filename:join(Dir, "sub"),
+ AFile = filename:join(SubDir, "a_file"),
+ Alias = filename:join(Dir, "symlink"),
+ ok = file:make_dir(Dir),
+ ok = file:make_dir(SubDir),
+ ok = file:write_file(AFile, "not that big\n"),
+ case file:make_symlink(AFile, Alias) of
+ {error, enotsup} ->
+ {skip, "Links not supported on this platform"};
+ {error, eperm} ->
+ {win32,_} = os:type(),
+ {skip, "Windows user not privileged to create symlinks"};
+ ok ->
+ ["sub","symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))),
+ ["symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))),
+ ok = file:delete(AFile),
+ %% The symlink should still be visible even when its target
+ %% has been deleted.
+ ["sub","symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))),
+ ["symlink"] =
+ basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))),
+ ok
+ end.
+
+basenames(Dir, Files) ->
+ [begin
+ Dir = filename:dirname(F),
+ filename:basename(F)
+ end || F <- Files].
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index 53a34511d9..59821220b4 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -94,10 +94,10 @@ appup_tests(App,{OkVsns,NokVsns}) ->
ok.
create_test_vsns(App) ->
- This = erlang:system_info(otp_release),
- FirstMajor = previous_major(This),
+ ThisMajor = erlang:system_info(otp_release),
+ FirstMajor = previous_major(ThisMajor),
SecondMajor = previous_major(FirstMajor),
- Ok = app_vsn(App,[FirstMajor]),
+ Ok = app_vsn(App,[ThisMajor,FirstMajor]),
Nok0 = app_vsn(App,[SecondMajor]),
Nok = case Ok of
[Ok1|_] ->
@@ -108,9 +108,9 @@ create_test_vsns(App) ->
{Ok,Nok}.
previous_major("17") ->
- "r16";
-previous_major("r"++Rel) ->
- "r"++previous_major(Rel);
+ "r16b";
+previous_major("r16b") ->
+ "r15b";
previous_major(Rel) ->
integer_to_list(list_to_integer(Rel)-1).
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 5bc34e35af..6349139925 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -23,7 +23,7 @@
create_long_names/1, bad_tar/1, errors/1, extract_from_binary/1,
extract_from_binary_compressed/1,
extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
- memory/1]).
+ memory/1,unicode/1]).
-include_lib("test_server/include/test_server.hrl").
-include_lib("kernel/include/file.hrl").
@@ -34,7 +34,7 @@ all() ->
[borderline, atomic, long_names, create_long_names,
bad_tar, errors, extract_from_binary,
extract_from_binary_compressed, extract_from_open_file,
- symlinks, open_add_close, cooked_compressed, memory].
+ symlinks, open_add_close, cooked_compressed, memory, unicode].
groups() ->
[].
@@ -73,6 +73,7 @@ borderline(Config) when is_list(Config) ->
?line lists:foreach(fun(Size) -> borderline_test(Size, TempDir) end,
[0, 1, 10, 13, 127, 333, Record-1, Record, Record+1,
+ Block-2*Record-1, Block-2*Record, Block-2*Record+1,
Block-Record-1, Block-Record, Block-Record+1,
Block-1, Block, Block+1,
Block+Record-1, Block+Record, Block+Record+1]),
@@ -726,6 +727,56 @@ memory(Config) when is_list(Config) ->
?line ok = delete_files([Name1,Name2]),
ok.
+%% Test filenames with characters outside the US ASCII range.
+unicode(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ do_unicode(PrivDir),
+ case has_transparent_naming() of
+ true ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Node = start_node(unicode, "+fnl -pa "++Pa),
+ ok = rpc:call(Node, erlang, apply,
+ [fun() -> do_unicode(PrivDir) end,[]]),
+ true = test_server:stop_node(Node),
+ ok;
+ false ->
+ ok
+ end.
+
+has_transparent_naming() ->
+ case os:type() of
+ {unix,darwin} -> false;
+ {unix,_} -> true;
+ _ -> false
+ end.
+
+do_unicode(PrivDir) ->
+ ok = file:set_cwd(PrivDir),
+ ok = file:make_dir("unicöde"),
+
+ Names = unicode_create_files(),
+ Tar = "unicöde.tar",
+ ok = erl_tar:create(Tar, ["unicöde"], []),
+ {ok,Names} = erl_tar:table(Tar, []),
+ _ = [ok = file:delete(Name) || Name <- Names],
+ ok = erl_tar:extract(Tar),
+ _ = [{ok,_} = file:read_file(Name) || Name <- Names],
+ _ = [ok = file:delete(Name) || Name <- Names],
+ ok = file:del_dir("unicöde"),
+ ok.
+
+unicode_create_files() ->
+ FileA = "unicöde/smörgåsbord",
+ ok = file:write_file(FileA, "yum!\n"),
+ [FileA|case file:native_name_encoding() of
+ utf8 ->
+ FileB = "unicöde/Хороший файл!",
+ ok = file:write_file(FileB, "But almost empty.\n"),
+ [FileB];
+ latin1 ->
+ []
+ end].
+
%% Delete the given list of files.
delete_files([]) -> ok;
delete_files([Item|Rest]) ->
@@ -791,3 +842,14 @@ make_temp_dir(Base, I) ->
ok -> Name;
{error,eexist} -> make_temp_dir(Base, I+1)
end.
+
+start_node(Name, Args) ->
+ [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ ct:log("Trying to start ~w@~s~n", [Name,Host]),
+ case test_server:start_node(Name, peer, [{args,Args}]) of
+ {error,Reason} ->
+ test_server:fail(Reason);
+ {ok,Node} ->
+ ct:log("Node ~p started~n", [Node]),
+ Node
+ end.
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 9b05bddf63..70dc7a1441 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -444,7 +444,7 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) ->
%% If this process (group leader of the test case) terminates before
%% all messages have been replied back to the io server, the io server
%% hangs. Fixed by the 20 milli timeout check here, and by using monitor in
-%% io.erl (livrem OCH hangslen mao :)
+%% io.erl.
%%
%% A test case is known to have failed if it returns {'EXIT', _} tuple,
%% or sends a message {failed, File, Line} to it's group_leader
@@ -673,7 +673,7 @@ handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) ->
spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()),
St;
handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc},
- config=Config,pid=Pid}=St) ->
+ config=Config,pid=Pid}=St) ->
R = case Reason of
{timetrap_timeout,TVal,_} ->
{timetrap,TVal};
diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl
index 582abb2153..acd47788db 100644
--- a/lib/test_server/src/test_server_node.erl
+++ b/lib/test_server/src/test_server_node.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. 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
@@ -653,7 +653,7 @@ find_rel_linux(Rel) ->
end.
find_rel_suse(Rel, SuseRel) ->
- Root = "/usr/local/otp/releases/otp_beam_linux_sles",
+ Root = "/usr/local/otp/releases/sles",
case SuseRel of
"11" ->
%% Try both SuSE 11, SuSE 10 and SuSe 9 in that order.
@@ -673,10 +673,10 @@ find_rel_suse(Rel, SuseRel) ->
find_rel_suse_1(Rel, RootWc) ->
case erlang:system_info(wordsize) of
4 ->
- find_rel_suse_2(Rel, RootWc++"_i386");
+ find_rel_suse_2(Rel, RootWc++"_32");
8 ->
- find_rel_suse_2(Rel, RootWc++"_x64") ++
- find_rel_suse_2(Rel, RootWc++"_i386")
+ find_rel_suse_2(Rel, RootWc++"_64") ++
+ find_rel_suse_2(Rel, RootWc++"_32")
end.
find_rel_suse_2(Rel, RootWc) ->
diff --git a/lib/typer/Makefile b/lib/typer/Makefile
index 40a82e9bba..d4396abc9d 100644
--- a/lib/typer/Makefile
+++ b/lib/typer/Makefile
@@ -29,7 +29,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# Macros
#
-SUB_DIRECTORIES = src
+SUB_DIRECTORIES = src doc/src
include vsn.mk
VSN = $(TYPER_VSN)
diff --git a/lib/typer/doc/Makefile b/lib/typer/doc/Makefile
new file mode 100644
index 0000000000..4ea0137202
--- /dev/null
+++ b/lib/typer/doc/Makefile
@@ -0,0 +1,39 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2006-2012. 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%
+#
+SHELL=/bin/sh
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+clean:
+ -rm -f *.html edoc-info stylesheet.css erlang.png
+
+distclean: clean
+realclean: clean
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
diff --git a/lib/typer/doc/html/.gitignore b/lib/typer/doc/html/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/typer/doc/html/.gitignore
diff --git a/lib/typer/doc/pdf/.gitignore b/lib/typer/doc/pdf/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/typer/doc/pdf/.gitignore
diff --git a/lib/typer/doc/src/Makefile b/lib/typer/doc/src/Makefile
new file mode 100644
index 0000000000..2683c08679
--- /dev/null
+++ b/lib/typer/doc/src/Makefile
@@ -0,0 +1,117 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2006-2012. 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%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../../vsn.mk
+VSN=$(TYPER_VSN)
+APPLICATION=typer
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+XML_APPLICATION_FILES = ref_man.xml
+XML_REF3_FILES =
+
+XML_PART_FILES = part_notes.xml
+XML_CHAPTER_FILES = notes.xml
+
+BOOK_FILES = book.xml
+
+XML_FILES = \
+ $(BOOK_FILES) $(XML_CHAPTER_FILES) \
+ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES)
+
+GIF_FILES =
+
+# ----------------------------------------------------
+
+HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
+
+INFO_FILE = ../../info
+EXTRA_FILES = \
+ $(DEFAULT_GIF_FILES) \
+ $(DEFAULT_HTML_FILES) \
+ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
+
+MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
+
+HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
+
+TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+XML_FLAGS +=
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+$(HTMLDIR)/%.gif: %.gif
+ $(INSTALL_DATA) $< $@
+
+docs: pdf html man
+
+$(TOP_PDF_FILE): $(XML_FILES)
+
+pdf: $(TOP_PDF_FILE)
+
+html: gifs $(HTML_REF_MAN_FILE)
+
+man: $(MAN3_FILES)
+
+gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
+
+debug opt:
+
+clean clean_docs:
+ rm -rf $(HTMLDIR)/*
+ rm -f $(MAN3DIR)/*
+ rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f errs core *~
+
+distclean: clean
+realclean: clean
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_docs_spec: docs
+ $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
+ $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
+ $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
+ $(INSTALL_DATA) $(HTMLDIR)/* \
+ "$(RELSYSDIR)/doc/html"
+ $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
+
+
+release_spec:
diff --git a/lib/typer/doc/src/book.xml b/lib/typer/doc/src/book.xml
new file mode 100644
index 0000000000..5cc85a3022
--- /dev/null
+++ b/lib/typer/doc/src/book.xml
@@ -0,0 +1,41 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE book SYSTEM "book.dtd">
+
+<book xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header titlestyle="normal">
+ <copyright>
+ <year>2006</year><year>2013</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>TypEr</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <pagetext></pagetext>
+ <preamble>
+ </preamble>
+ <pagetext>TypEr</pagetext>
+ <applications>
+ <xi:include href="ref_man.xml"/>
+ </applications>
+ <releasenotes>
+ <xi:include href="notes.xml"/>
+ </releasenotes>
+</book>
+
diff --git a/lib/typer/doc/src/fascicules.xml b/lib/typer/doc/src/fascicules.xml
new file mode 100644
index 0000000000..b15610fa8b
--- /dev/null
+++ b/lib/typer/doc/src/fascicules.xml
@@ -0,0 +1,12 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
+
+<fascicules>
+ <fascicule file="part_notes" href="part_notes_frame.html" entry="yes">
+ Release Notes
+ </fascicule>
+ <fascicule file="" href="../../../../doc/print.html" entry="no">
+ Off-Print
+ </fascicule>
+</fascicules>
+
diff --git a/lib/typer/doc/src/notes.xml b/lib/typer/doc/src/notes.xml
new file mode 100644
index 0000000000..53d554820d
--- /dev/null
+++ b/lib/typer/doc/src/notes.xml
@@ -0,0 +1,51 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2014</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>TypEr Release Notes</title>
+ <prepared>otp_appnotes</prepared>
+ <docno>nil</docno>
+ <date>nil</date>
+ <rev>nil</rev>
+ <file>notes.xml</file>
+ </header>
+ <p>This document describes the changes made to TypEr.</p>
+
+<section><title>TypEr 0.9.7</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Added initial documentation framework for TypEr.</p>
+ <p>
+ Own Id: OTP-11860</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+
+
+</chapter>
+
diff --git a/lib/typer/doc/src/part_notes.xml b/lib/typer/doc/src/part_notes.xml
new file mode 100644
index 0000000000..b4ccd3ed77
--- /dev/null
+++ b/lib/typer/doc/src/part_notes.xml
@@ -0,0 +1,35 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE part SYSTEM "part.dtd">
+
+<part xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>2006</year><year>2013</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>TypEr Release Notes</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <description>
+ <p><em>TypEr</em></p>
+ </description>
+ <xi:include href="notes.xml"/>
+</part>
+
diff --git a/lib/typer/doc/src/ref_man.xml b/lib/typer/doc/src/ref_man.xml
new file mode 100644
index 0000000000..b54a5f5947
--- /dev/null
+++ b/lib/typer/doc/src/ref_man.xml
@@ -0,0 +1,35 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE application SYSTEM "application.dtd">
+
+<application xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>2014</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>TypEr</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>ref_man.xml</file>
+ </header>
+ <description>
+ </description>
+ <xi:include href="typer_app.xml"/>
+</application>
+
diff --git a/lib/typer/doc/src/typer_app.xml b/lib/typer/doc/src/typer_app.xml
new file mode 100644
index 0000000000..469a9be108
--- /dev/null
+++ b/lib/typer/doc/src/typer_app.xml
@@ -0,0 +1,43 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE appref SYSTEM "appref.dtd">
+
+<appref>
+ <header>
+ <copyright>
+ <year>2014</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>TypEr</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev></rev>
+ <file>typer.xml</file>
+ </header>
+ <app>TypEr</app>
+ <appsummary>The TypEr Application</appsummary>
+ <description>
+ <p>An Erlang/OTP application that shows type information
+ for Erlang modules to the user. Additionally, it can
+ annotate the code of files with such type information.</p>
+ </description>
+
+</appref>
+
diff --git a/lib/typer/info b/lib/typer/info
new file mode 100644
index 0000000000..5145fbcfff
--- /dev/null
+++ b/lib/typer/info
@@ -0,0 +1,2 @@
+group: tools
+short: TypEr
diff --git a/lib/typer/src/Makefile b/lib/typer/src/Makefile
index 13af466755..a7059de971 100644
--- a/lib/typer/src/Makefile
+++ b/lib/typer/src/Makefile
@@ -63,7 +63,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += +warn_exported_vars +warn_untyped_record +warn_missing_spec
+ERL_COMPILE_FLAGS += +warn_export_vars +warn_untyped_record +warn_missing_spec
# ----------------------------------------------------
# Targets
diff --git a/lib/typer/vsn.mk b/lib/typer/vsn.mk
index 49fdda756e..9cc044c621 100644
--- a/lib/typer/vsn.mk
+++ b/lib/typer/vsn.mk
@@ -1 +1 @@
-TYPER_VSN = 0.9.6
+TYPER_VSN = 0.9.7
diff --git a/lib/wx/aclocal.m4 b/lib/wx/aclocal.m4
index 2b47f7c4bc..ed492d55ff 100644
--- a/lib/wx/aclocal.m4
+++ b/lib/wx/aclocal.m4
@@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in
[Define if you have the "ose_spi/ose_spi.h" header file.]))
;;
esac
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" == "xpthread"; then
+ if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \