diff options
Diffstat (limited to 'lib')
248 files changed, 4323 insertions, 1821 deletions
diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 02cbba0f10..1f8805ff5e 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -11,5 +11,5 @@ ]}, {env, []}, {applications, [kernel, stdlib]}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index d3c1f34821..0e41aa1a7a 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1233,15 +1233,23 @@ gen_record(TorPtype,Name,Type,Num) when is_record(Type,type) -> emit({"}).",nl,nl}), Tr ++ ExtensionList2; {Rootl1,Extl,Rootl2} -> + case Rootl1 =/= [] andalso Extl++Rootl2 =/= [] of + true -> emit([com]); + false -> ok + end, case Rootl1 of - [] -> true; - _ -> emit([",",nl]) + [_|_] -> emit([nl]); + [] -> ok end, emit(["%% with extensions",nl]), gen_record2(Name,'SEQUENCE',Extl,"",ext), + case Extl =/= [] andalso Rootl2 =/= [] of + true -> emit([com]); + false -> ok + end, case Extl of - [_H|_] when Rootl2 /= [] -> emit([",",nl]); - _ -> ok + [_|_] -> emit([nl]); + [] -> ok end, emit(["%% end of extensions",nl]), gen_record2(Name,'SEQUENCE',Rootl2,"",noext), diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 91820e08de..5bf69e9294 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1922,16 +1922,7 @@ enc_opt(nil, St) -> enc_opt({seq,H0,T0}, St0) -> {H,St1} = enc_opt(H0, St0), {T,St} = enc_opt(T0, St1), - case {H,T} of - {none,_} -> - {T,St}; - {{list,Imm,Data}, - {seq,{call,per,complete,[Data],_},_}} -> - %% Get rid of any explicit 'align' added by per_enc_open_type/2. - {{seq,{list,remove_trailing_align(Imm),Data},T},St}; - {_,_} -> - {{seq,H,T},St} - end; + {enc_opt_seq(H, T),St}; enc_opt({set,_,_}=Imm, St) -> {Imm,St#ost{t=undefined}}; enc_opt({sub,Src0,Int,Dst}, St0) -> @@ -1965,6 +1956,28 @@ remove_trailing_align({seq,H,T}) -> {seq,H,remove_trailing_align(T)}; remove_trailing_align(Imm) -> Imm. +enc_opt_seq(none, T) -> + T; +enc_opt_seq({list,Imm,Data}, {seq,{call,per,complete,[Data],_},_}=T) -> + %% Get rid of any explicit 'align' added by per_enc_open_type/2. + {seq,{list,remove_trailing_align(Imm),Data},T}; +enc_opt_seq({call,_,_,_,{var,_}=Dst}=H, T) -> + case is_var_unused(Dst, T) of + false -> {seq,H,T}; + true -> T + end; +enc_opt_seq(H, T) -> + {seq,H,T}. + +is_var_unused(_, align) -> + true; +is_var_unused(V, {call,_,_,Args}) -> + not lists:member(V, Args); +is_var_unused(V, {cons,H,T}) -> + is_var_unused(V, H) andalso is_var_unused(V, T); +is_var_unused(_, _) -> + false. + bit_size_propagate(Bin, Type, St) -> case t_range(Type) of any -> diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 221cd991a7..c5901d5489 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -352,8 +352,9 @@ random_unnamed_bit_string(M, C) -> %% end. random(Upper) -> - {A1,A2,A3} = erlang:now(), - _ = random:seed(A1, A2, A3), + _ = random:seed(erlang:phash2([erlang:node()]), + erlang:monotonic_time(), + erlang:unique_integer()), random:uniform(Upper). size_random(C) -> diff --git a/lib/asn1/test/asn1_SUITE_data/DoubleEllipses.asn b/lib/asn1/test/asn1_SUITE_data/DoubleEllipses.asn index a96425cbea..846c3e7569 100644 --- a/lib/asn1/test/asn1_SUITE_data/DoubleEllipses.asn +++ b/lib/asn1/test/asn1_SUITE_data/DoubleEllipses.asn @@ -59,6 +59,18 @@ SeqAltV2 ::= SEQUENCE g INTEGER } +SeqDoubleEmpty1 ::= SEQUENCE { + ..., + ... +} + +SeqDoubleEmpty2 ::= SEQUENCE { + a BOOLEAN, + b INTEGER OPTIONAL, + ..., + ... +} + Set ::= SET { a INTEGER, ..., diff --git a/lib/asn1/test/testDoubleEllipses.erl b/lib/asn1/test/testDoubleEllipses.erl index 3caa166ae0..bd6831bf1e 100644 --- a/lib/asn1/test/testDoubleEllipses.erl +++ b/lib/asn1/test/testDoubleEllipses.erl @@ -58,6 +58,14 @@ main(_Rules) -> #'SetAltV2'{a=10,d=12, b = <<2#1010:4>>, e=true,h="PS",i=13,c=false,f=14,g=16}), + + roundtrip('SeqDoubleEmpty1', + {'SeqDoubleEmpty1'}), + roundtrip('SeqDoubleEmpty2', + {'SeqDoubleEmpty2',true,42}), + roundtrip('SeqDoubleEmpty2', + {'SeqDoubleEmpty2',true,asn1_NOVALUE}), + ok. roundtrip(T, V) -> diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 155d6f6ff5..43835728e8 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -232,7 +232,8 @@ bit_string(Rules, Opts) -> end. random_bits(N) -> - Seed = integer_to_list(erlang:phash2(erlang:now())), + Seed0 = {erlang:monotonic_time(),erlang:unique_integer()}, + Seed = integer_to_list(erlang:phash2(Seed0)), random_bits(<<>>, N, Seed). random_bits(Bin, N, Seed) -> diff --git a/lib/common_test/doc/src/event_handler_chapter.xml b/lib/common_test/doc/src/event_handler_chapter.xml index 45f01c12ec..f39f391818 100644 --- a/lib/common_test/doc/src/event_handler_chapter.xml +++ b/lib/common_test/doc/src/event_handler_chapter.xml @@ -59,6 +59,15 @@ Event handlers plugged into this manager will receive the events from all the test nodes as well as information from the CT Master server itself.</p> + + <p>User specific event handlers may be plugged into a Common Test event + manager, either by telling Common Test to install them before the test + run (see below), or by adding the handlers dynamically during the test + run by means of + <c>gen_event:add_handler/3</c> or <c>gen_event:add_sup_handler/3</c>. + In the latter scenario, the reference of the Common Test event manager is + required. To get it, call <c>ct:get_event_mgr_ref/0</c> or (on the CT + Master node) <c>ct_master:get_event_mgr_ref/0</c>.</p> </section> <section> <marker id="usage"></marker> diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 85afdc7834..9d8fce2789 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -52,6 +52,7 @@ -module(ct). -include("ct.hrl"). +-include("ct_util.hrl"). %% Command line user interface for running tests -export([install/1, run/1, run/2, run/3, @@ -77,6 +78,7 @@ %% Other interface functions -export([get_status/0, abort_current_testcase/1, + get_event_mgr_ref/0, encrypt_config_file/2, encrypt_config_file/3, decrypt_config_file/2, decrypt_config_file/3]). @@ -1005,6 +1007,18 @@ abort_current_testcase(Reason) -> test_server_ctrl:abort_current_testcase(Reason). %%%----------------------------------------------------------------- +%%% @spec get_event_mgr_ref() -> EvMgrRef +%%% EvMgrRef = atom() +%%% +%%% @doc <p>Call this function in order to get a reference to the +%%% CT event manager. The reference can be used to e.g. add +%%% a user specific event handler while tests are running. +%%% Example: +%%% <c>gen_event:add_handler(ct:get_event_mgr_ref(), my_ev_h, [])</c></p> +get_event_mgr_ref() -> + ?CT_EVMGR_REF. + +%%%----------------------------------------------------------------- %%% @spec encrypt_config_file(SrcFileName, EncryptFileName) -> %%% ok | {error,Reason} %%% SrcFileName = string() diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 5c80a299f8..4b92ca6f8f 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -693,8 +693,7 @@ make_crypto_key(String) -> {[K1,K2,K3],IVec}. random_bytes(N) -> - {A,B,C} = now(), - random:seed(A, B, C), + random:seed(os:timestamp()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl index cff02a46d9..2d15035cd8 100644 --- a/lib/common_test/src/ct_conn_log_h.erl +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -34,6 +34,8 @@ -define(WIDTH,80). +-define(now, os:timestamp()). + %%%----------------------------------------------------------------- %%% Callbacks init({GL,ConnLogs}) -> @@ -72,14 +74,14 @@ handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> handle_event({_Type,GL,{Pid,{ct_connection,Mod,Action,ConnName},Report}}, State) -> Info = conn_info(Pid,#conn_log{name=ConnName,action=Action,module=Mod}), - write_report(now(),Info,Report,GL,State), + write_report(?now,Info,Report,GL,State), {ok, State}; handle_event({_Type,GL,{Pid,Info=#conn_log{},Report}}, State) -> - write_report(now(),conn_info(Pid,Info),Report,GL,State), + write_report(?now,conn_info(Pid,Info),Report,GL,State), {ok, State}; handle_event({error_report,GL,{Pid,_,[{ct_connection,ConnName}|R]}}, State) -> %% Error reports from connection - write_error(now(),conn_info(Pid,#conn_log{name=ConnName}),R,GL,State), + write_error(?now,conn_info(Pid,#conn_log{name=ConnName}),R,GL,State), {ok, State}; handle_event(_What, State) -> {ok, State}. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index ec525784ec..498950c9d1 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -686,18 +686,21 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> undefined -> %% send sync notification so that event handlers may print %% in the log file before it gets closed - ct_event:sync_notify(#event{name=tc_done, - node=node(), - data={Mod,FuncSpec, - tag_cth(FinalNotify)}}), + Event = #event{name=tc_done, + node=node(), + data={Mod,FuncSpec, + tag(FinalNotify)}}, + ct_event:sync_notify(Event), Result1; Fun -> %% send sync notification so that event handlers may print %% in the log file before it gets closed - ct_event:sync_notify(#event{name=tc_done, - node=node(), - data={Mod,FuncSpec, - tag(FinalNotify)}}), + Event = #event{name=tc_done, + node=node(), + data={Mod,FuncSpec, + tag({'$test_server_framework_test', + FinalNotify})}}, + ct_event:sync_notify(Event), Fun(end_tc, Return) end, @@ -770,44 +773,37 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> %% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | %% {testcase_aborted,Reason} | testcase_aborted_or_killed | -%% {'EXIT',Reason} | Other (ignored return value, e.g. 'ok') -tag({STag,Reason}) when STag == skip; STag == skipped -> - case Reason of - {failed,{_,init_per_testcase,_}} -> {auto_skipped,Reason}; - _ -> {skipped,Reason} - end; -tag({auto_skip,Reason}) -> - {auto_skipped,Reason}; -tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; - ETag == timetrap_timeout; - ETag == testcase_aborted -> - {failed,E}; -tag(E = testcase_aborted_or_killed) -> - {failed,E}; -tag(Other) -> - Other. - -tag_cth({skipped,Reason={failed,{_,init_per_testcase,_}}}) -> +%% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} | +%% {user_timetrap_error,Reason} | +%% Other (ignored return value, e.g. 'ok') +tag({'$test_server_framework_test',Result}) -> + case tag(Result) of + ok -> Result; + Failure -> Failure + end; +tag({skipped,Reason={failed,{_,init_per_testcase,_}}}) -> {auto_skipped,Reason}; -tag_cth({STag,Reason}) when STag == skip; STag == skipped -> +tag({STag,Reason}) when STag == skip; STag == skipped -> case Reason of {failed,{_,init_per_testcase,_}} -> {auto_skipped,Reason}; _ -> {skipped,Reason} end; -tag_cth({auto_skip,Reason}) -> +tag({auto_skip,Reason}) -> {auto_skipped,Reason}; -tag_cth({fail,Reason}) -> +tag({fail,Reason}) -> {failed,{error,Reason}}; -tag_cth(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; +tag(Failed = {failed,_Reason}) -> + Failed; +tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; ETag == timetrap_timeout; ETag == testcase_aborted -> {failed,E}; -tag_cth(E = testcase_aborted_or_killed) -> +tag(E = testcase_aborted_or_killed) -> {failed,E}; -tag_cth(List) when is_list(List) -> - ok; -tag_cth(Other) -> - Other. +tag(UserTimetrap = {user_timetrap_error,_Reason}) -> + UserTimetrap; +tag(_Other) -> + ok. %%%----------------------------------------------------------------- %%% @spec error_notification(Mod,Func,Args,Error) -> ok @@ -841,6 +837,8 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> io_lib:format("{test_case_failed,~p}", [Reason]); Result -> Result end; + {'EXIT',_Reason} = EXIT -> + io_lib:format("~P", [EXIT,5]); {Spec,_Reason} when is_atom(Spec) -> io_lib:format("~w", [Spec]); Other -> diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 23332ad268..12749a8cc4 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -73,6 +73,8 @@ -define(abs(Name), filename:absname(Name)). +-define(now, os:timestamp()). + -record(log_cache, {version, all_runs = [], tests = []}). @@ -311,7 +313,7 @@ unregister_groupleader(Pid) -> %%% data to log (as in <code>io:format(Format,Args)</code>).</p> log(Heading,Format,Args) -> cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, - [{int_header(),[log_timestamp(now()),Heading]}, + [{int_header(),[log_timestamp(?now),Heading]}, {Format,Args}, {int_footer(),[]}]}), ok. @@ -333,7 +335,7 @@ log(Heading,Format,Args) -> %%% @see end_log/0 start_log(Heading) -> cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, - [{int_header(),[log_timestamp(now()),Heading]}]}), + [{int_header(),[log_timestamp(?now),Heading]}]}), ok. %%%----------------------------------------------------------------- @@ -491,11 +493,11 @@ tc_print(Category,Importance,Format,Args) -> get_heading(default) -> io_lib:format("\n-----------------------------" "-----------------------\n~s\n", - [log_timestamp(now())]); + [log_timestamp(?now)]); get_heading(Category) -> io_lib:format("\n-----------------------------" "-----------------------\n~s ~w\n", - [log_timestamp(now()),Category]). + [log_timestamp(?now),Category]). %%%----------------------------------------------------------------- @@ -553,13 +555,13 @@ div_header(Class) -> div_header(Class,"User"). div_header(Class,Printer) -> "\n<div class=\"" ++ atom_to_list(Class) ++ "\"><b>*** " ++ Printer ++ - " " ++ log_timestamp(now()) ++ " ***</b>". + " " ++ log_timestamp(?now) ++ " ***</b>". div_footer() -> "</div>". maybe_log_timestamp() -> - {MS,S,US} = now(), + {MS,S,US} = ?now, case get(log_timestamp) of {MS,S,_} -> ok; @@ -686,7 +688,7 @@ logger(Parent, Mode, Verbosity) -> make_last_run_index(Time), CtLogFd = open_ctlog(?misc_io_log), io:format(CtLogFd,int_header()++int_footer(), - [log_timestamp(now()),"Common Test Logger started"]), + [log_timestamp(?now),"Common Test Logger started"]), Parent ! {started,self(),{Time,filename:absname("")}}, set_evmgr_gl(CtLogFd), @@ -835,7 +837,7 @@ logger_loop(State) -> stop -> io:format(State#logger_state.ct_log_fd, int_header()++int_footer(), - [log_timestamp(now()),"Common Test Logger finished"]), + [log_timestamp(?now),"Common Test Logger finished"]), close_ctlog(State#logger_state.ct_log_fd), ok end. @@ -1905,6 +1907,17 @@ sort_all_runs(Dirs) -> {Date1,HH1,MM1,SS1} > {Date2,HH2,MM2,SS2} end, Dirs). +sort_ct_runs(Dirs) -> + %% Directory naming: <Prefix>.NodeName.Date_Time[/...] + %% Sort on Date_Time string: "YYYY-MM-DD_HH.MM.SS" + lists:sort(fun(Dir1,Dir2) -> + [_Prefix,_Node1,DateHH1,MM1,SS1] = + string:tokens(filename:dirname(Dir1),[$.]), + [_Prefix,_Node2,DateHH2,MM2,SS2] = + string:tokens(filename:dirname(Dir2),[$.]), + {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2} + end, Dirs). + dir_diff_all_runs(Dirs, LogCache) -> case LogCache#log_cache.all_runs of [] -> @@ -2217,7 +2230,8 @@ make_all_suites_index(When) when is_atom(When) -> end end, - LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext), + Wildcard = logdir_prefix()++".*/*"++?logdir_ext, + LogDirs = sort_ct_runs(filelib:wildcard(Wildcard)), LogCacheInfo = get_cache_data(UseCache), diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index b42ff73846..2cdb259899 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -25,6 +25,7 @@ -export([run/1,run/3,run/4]). -export([run_on_node/2,run_on_node/3]). -export([run_test/1,run_test/2]). +-export([get_event_mgr_ref/0]). -export([basic_html/1]). -export([abort/0,abort/1,progress/0]). @@ -292,6 +293,18 @@ progress() -> call(progress). %%%----------------------------------------------------------------- +%%% @spec get_event_mgr_ref() -> MasterEvMgrRef +%%% MasterEvMgrRef = atom() +%%% +%%% @doc <p>Call this function in order to get a reference to the +%%% CT master event manager. The reference can be used to e.g. +%%% add a user specific event handler while tests are running. +%%% Example: +%%% <c>gen_event:add_handler(ct_master:get_event_mgr_ref(), my_ev_h, [])</c></p> +get_event_mgr_ref() -> + ?CT_MEVMGR_REF. + +%%%----------------------------------------------------------------- %%% @spec basic_html(Bool) -> ok %%% Bool = true | false %%% diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 5393097f57..384c1f6863 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -37,6 +37,8 @@ -define(details_file_name,"details.info"). -define(table_color,"lightblue"). +-define(now, os:timestamp()). + %%%-------------------------------------------------------------------- %%% API %%%-------------------------------------------------------------------- @@ -54,7 +56,7 @@ start(LogDir,Nodes) -> end. log(Heading,Format,Args) -> - cast({log,self(),[{int_header(),[log_timestamp(now()),Heading]}, + cast({log,self(),[{int_header(),[log_timestamp(?now),Heading]}, {Format,Args}, {int_footer(),[]}]}), ok. @@ -132,7 +134,7 @@ init(Parent,LogDir,Nodes) -> atom_to_list(N) ++ " " end,Nodes)), - io:format(CtLogFd,int_header(),[log_timestamp(now()),"Test Nodes\n"]), + io:format(CtLogFd,int_header(),[log_timestamp(?now),"Test Nodes\n"]), io:format(CtLogFd,"~ts\n",[NodeStr]), io:put_chars(CtLogFd,[int_footer(),"\n"]), @@ -189,7 +191,7 @@ loop(State) -> make_all_runs_index(State#state.logdir), io:format(State#state.log_fd, int_header()++int_footer(), - [log_timestamp(now()),"Finished!"]), + [log_timestamp(?now),"Finished!"]), close_ct_master_log(State#state.log_fd), close_nodedir_index(State#state.nodedir_ix_fd), ok diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 14ee55703f..af82f2dcbf 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -794,8 +794,9 @@ action(Client,Action) -> Client :: client(), Action :: simple_xml(), Timeout :: timeout(), - Result :: {ok,[simple_xml()]} | {error,error_reason()}. -%% @doc Execute an action. + Result :: ok | {ok,[simple_xml()]} | {error,error_reason()}. +%% @doc Execute an action. If the return type is void, <c>ok</c> will +%% be returned instead of <c>{ok,[simple_xml()]}</c>. %% %% @end %%---------------------------------------------------------------------- @@ -1606,6 +1607,9 @@ decode_ok(Other) -> decode_data([{Tag,Attrs,Content}]) -> case get_local_name_atom(Tag) of + ok -> + %% when action has return type void + ok; data -> %% Since content of data has nothing from the netconf %% namespace, we remove the parent's xmlns attribute here diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4e03bf8630..d906a267a1 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -29,7 +29,9 @@ %% Command timeout = 10 sec (time to wait for a command to return) %% Max no of reconnection attempts = 3 %% Reconnection interval = 5 sek (time to wait in between reconnection attempts) -%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle)</pre> +%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle) +%% Polling limit = 0 (max number of times to poll to get a remaining string terminated) +%% Polling interval = 1 sec (sleep time between polls)</pre> %% <p>These parameters can be altered by the user with the following %% configuration term:</p> %% <pre> @@ -37,7 +39,9 @@ %% {command_timeout,Millisec}, %% {reconnection_attempts,N}, %% {reconnection_interval,Millisec}, -%% {keep_alive,Bool}]}.</pre> +%% {keep_alive,Bool}, +%% {poll_limit,N}, +%% {poll_interval,Millisec}]}.</pre> %% <p><code>Millisec = integer(), N = integer()</code></p> %% <p>Enter the <code>telnet_settings</code> term in a configuration %% file included in the test and ct_telnet will retrieve the information @@ -156,6 +160,8 @@ -define(RECONN_TIMEOUT,5000). -define(DEFAULT_TIMEOUT,10000). -define(DEFAULT_PORT,23). +-define(POLL_LIMIT,0). +-define(POLL_INTERVAL,1000). -include("ct_util.hrl"). @@ -169,6 +175,8 @@ type, target_mod, keep_alive, + poll_limit=?POLL_LIMIT, + poll_interval=?POLL_INTERVAL, extra, conn_to=?DEFAULT_TIMEOUT, com_to=?DEFAULT_TIMEOUT, @@ -379,8 +387,15 @@ cmdf(Connection,CmdFormat,Args,Opts) when is_list(Args) -> %%% Connection = ct_telnet:connection() %%% Data = [string()] %%% Reason = term() -%%% @doc Get all data which has been received by the telnet client -%%% since last command was sent. +%%% @doc Get all data that has been received by the telnet client +%%% since the last command was sent. Note that only newline terminated +%%% strings are returned. If the last string received has not yet +%%% been terminated, the connection may be polled automatically until +%%% the string is complete. The polling feature is controlled +%%% by the `poll_limit' and `poll_interval' config values and is +%%% by default disabled (meaning the function will immediately +%%% return all complete strings received and save a remaining +%%% non-terminated string for a later `get_data' call). get_data(Connection) -> case get_handle(Connection) of {ok,Pid} -> @@ -596,9 +611,12 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> "Reconnection attempts: ~p\n" "Reconnection interval: ~p\n" "Connection timeout: ~p\n" - "Keep alive: ~w", + "Keep alive: ~w\n" + "Poll limit: ~w\n" + "Poll interval: ~w", [Ip,Port,S1#state.com_to,S1#state.reconns, - S1#state.reconn_int,S1#state.conn_to,KeepAlive]), + S1#state.reconn_int,S1#state.conn_to,KeepAlive, + S1#state.poll_limit,S1#state.poll_interval]), {ok,TelnPid,S1}; {'EXIT',Reason} -> {error,Reason}; @@ -619,6 +637,10 @@ set_telnet_defaults([{reconnection_interval,RInt}|Ss],S) -> set_telnet_defaults(Ss,S#state{reconn_int=RInt}); set_telnet_defaults([{keep_alive,_}|Ss],S) -> set_telnet_defaults(Ss,S); +set_telnet_defaults([{poll_limit,PL}|Ss],S) -> + set_telnet_defaults(Ss,S#state{poll_limit=PL}); +set_telnet_defaults([{poll_interval,PI}|Ss],S) -> + set_telnet_defaults(Ss,S#state{poll_interval=PI}); set_telnet_defaults([Unknown|Ss],S) -> force_log(S,error, "Bad element in telnet_settings: ~p",[Unknown]), @@ -706,10 +728,8 @@ handle_msg({send,Cmd,Opts},State) -> handle_msg(get_data,State) -> start_gen_log(heading(get_data,State#state.name)), log(State,cmd,"Reading data...",[]), - {ok,Data,Buffer} = teln_get_all_data(State#state.teln_pid, - State#state.prx, - State#state.buffer, - [],[]), + {ok,Data,Buffer} = teln_get_all_data(State,State#state.buffer,[],[], + State#state.poll_limit), log(State,recv,"Return: ~p",[{ok,Data}]), end_gen_log(), {{ok,Data},State#state{buffer=Buffer}}; @@ -944,16 +964,25 @@ teln_cmd(Pid,Cmd,Prx,Newline,Timeout) -> ct_telnet_client:send_data(Pid,Cmd,Newline), teln_receive_until_prompt(Pid,Prx,Timeout). -teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> +teln_get_all_data(State=#state{teln_pid=Pid,prx=Prx},Data,Acc,LastLine,Polls) -> case check_for_prompt(Prx,LastLine++Data) of {prompt,Lines,_PromptType,Rest} -> - teln_get_all_data(Pid,Prx,Rest,[Lines|Acc],[]); + teln_get_all_data(State,Rest,[Lines|Acc],[],State#state.poll_limit); {noprompt,Lines,LastLine1} -> case ct_telnet_client:get_data(Pid) of + {ok,[]} when LastLine1 /= [], Polls > 0 -> + %% No more data from server but the last string is not + %% a complete line (maybe because of a slow connection), + timer:sleep(State#state.poll_interval), + NewPolls = if Polls == infinity -> infinity; + true -> Polls-1 + end, + teln_get_all_data(State,[],[Lines|Acc],LastLine1,NewPolls); {ok,[]} -> {ok,lists:reverse(lists:append([Lines|Acc])),LastLine1}; {ok,Data1} -> - teln_get_all_data(Pid,Prx,Data1,[Lines|Acc],LastLine1) + teln_get_all_data(State,Data1,[Lines|Acc],LastLine1, + State#state.poll_limit) end end. @@ -1106,12 +1135,18 @@ repeat_expect(Name,Pid,Data,Pattern,Acc,EO) -> teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, total_timeout=TotalTO}) -> - ExpectFun = case EO#eo.seq of + %% TotalTO is a float value in this loop (unless it's 'infinity'), + %% but an integer value will be passed to the other functions + EOMod = if TotalTO /= infinity -> EO#eo{total_timeout=trunc(TotalTO)}; + true -> EO + end, + + ExpectFun = case EOMod#eo.seq of true -> fun() -> - seq_expect(Name,Pid,Data,Pattern,Acc,EO) + seq_expect(Name,Pid,Data,Pattern,Acc,EOMod) end; false -> fun() -> - one_expect(Name,Pid,Data,Pattern,EO) + one_expect(Name,Pid,Data,Pattern,EOMod) end end, case ExpectFun() of @@ -1121,9 +1156,14 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, {halt,Why,Rest}; NotFinished -> %% Get more data - Fun = fun() -> get_data1(EO#eo.teln_pid) end, - BreakAfter = if TotalTO < IdleTO -> TotalTO; true -> IdleTO end, - case timer:tc(ct_gen_conn, do_within_time, [Fun, BreakAfter]) of + Fun = fun() -> get_data1(EOMod#eo.teln_pid) end, + BreakAfter = if TotalTO < IdleTO -> + %% use the integer value + EOMod#eo.total_timeout; + true -> + IdleTO + end, + case timer:tc(ct_gen_conn, do_within_time, [Fun,BreakAfter]) of {_,{error,Reason}} -> %% A timeout will occur when the telnet connection %% is idle for EO#eo.idle_timeout milliseconds. @@ -1132,13 +1172,15 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, case NotFinished of {nomatch,Rest} -> %% One expect - teln_expect1(Name,Pid,Rest++Data1,Pattern,[],EO); + teln_expect1(Name,Pid,Rest++Data1, + Pattern,[],EOMod); {continue,Patterns1,Acc1,Rest} -> %% Sequence - teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO) + teln_expect1(Name,Pid,Rest++Data1, + Patterns1,Acc1,EOMod) end; {Elapsed,{ok,Data1}} -> - TVal = trunc(TotalTO - (Elapsed/1000)), + TVal = TotalTO - (Elapsed/1000), if TVal =< 0 -> {error,timeout}; true -> @@ -1146,10 +1188,12 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, case NotFinished of {nomatch,Rest} -> %% One expect - teln_expect1(Name,Pid,Rest++Data1,Pattern,[],EO1); + teln_expect1(Name,Pid,Rest++Data1, + Pattern,[],EO1); {continue,Patterns1,Acc1,Rest} -> %% Sequence - teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO1) + teln_expect1(Name,Pid,Rest++Data1, + Patterns1,Acc1,EO1) end end end @@ -1430,8 +1474,10 @@ check_for_prompt(Prx,Data) -> split_lines(String) -> split_lines(String,[],[]). -split_lines([$\n|Rest],Line,Lines) -> +split_lines([$\n|Rest],Line,Lines) when Line /= [] -> split_lines(Rest,[],[lists:reverse(Line)|Lines]); +split_lines([$\n|Rest],[],Lines) -> + split_lines(Rest,[],Lines); split_lines([$\r|Rest],Line,Lines) -> split_lines(Rest,Line,Lines); split_lines([0|Rest],Line,Lines) -> diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index 36d33522a3..b0734d8d65 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -32,7 +32,7 @@ -module(ct_telnet_client). -%% -define(debug, true). +%%-define(debug, true). -export([open/2, open/3, open/4, open/5, close/1]). -export([send_data/2, send_data/3, get_data/1]). @@ -111,7 +111,6 @@ get_data(Pid) -> {ok,Data} end. - %%%----------------------------------------------------------------- %%% Internal functions init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> @@ -146,7 +145,7 @@ loop(State, Sock, Acc) -> ok end; {tcp,_,Msg0} -> - dbg("tcp msg: ~tp~n",[Msg0]), + dbg("rcv tcp msg: ~tp~n",[Msg0]), Msg = check_msg(Sock,Msg0,[]), loop(State, Sock, [Msg | Acc]); {send_data,Data} -> @@ -180,6 +179,7 @@ loop(State, Sock, Acc) -> NewState = case State of #state{keep_alive = true, get_data = 0} -> + dbg("sending NOP\n",[]), if Acc == [] -> send([?IAC,?NOP], Sock, State#state.conn_name); true -> ok @@ -225,15 +225,17 @@ loop(State, Sock, Acc) -> gen_tcp:close(Sock), Pid ! closed after wait(State#state.keep_alive,?IDLE_TIMEOUT) -> + dbg("idle timeout\n",[]), Data = lists:reverse(lists:append(Acc)), case Data of [] -> + dbg("sending NOP\n",[]), send([?IAC,?NOP], Sock, State#state.conn_name), loop(State, Sock, Acc); _ when State#state.log_pos == length(Data)+1 -> loop(State, Sock, Acc); _ -> - dbg("Idle timeout, printing ~tp\n",[Data]), + dbg("idle timeout, printing ~tp\n",[Data]), Len = length(Data), ct_telnet:log(State#state.conn_name, general_io, "~ts", @@ -391,7 +393,7 @@ cmd_dbg(Prefix,Cmd) -> end. timestamp() -> - {MS,S,US} = now(), + {MS,S,US} = os:timestamp(), {{Year,Month,Day}, {Hour,Min,Sec}} = calendar:now_to_local_time({MS,S,US}), MilliSec = trunc(US/1000), diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index bb12171ea7..3deaefe0e9 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -59,6 +59,8 @@ -define(default_report,"junit_report.xml"). -define(suite_log,"suite.log.html"). +-define(now, os:timestamp()). + %% Number of dirs from log root to testcase log file. %% ct_run.<node>.<timestamp>/<test_name>/run.<timestamp>/<tc_log>.html -define(log_depth,3). @@ -77,11 +79,11 @@ init(Path, Opts) -> axis = proplists:get_value(axis,Opts,[]), properties = proplists:get_value(properties,Opts,[]), url_base = proplists:get_value(url_base,Opts), - timer = now() }. + timer = ?now }. pre_init_per_suite(Suite,SkipOrFail,State) when is_tuple(SkipOrFail) -> {SkipOrFail, init_tc(State#state{curr_suite = Suite, - curr_suite_ts = now()}, + curr_suite_ts = ?now}, SkipOrFail) }; pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> TcLog = proplists:get_value(tc_logfile,Config), @@ -96,7 +98,7 @@ pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> end, {Config, init_tc(State#state{ filepath = Path, curr_suite = Suite, - curr_suite_ts = now(), + curr_suite_ts = ?now, curr_log_dir = CurrLogDir}, Config) }; pre_init_per_suite(Suite,Config,State) -> @@ -169,9 +171,9 @@ do_tc_skip(Res, State) -> State#state{ test_cases = [NewTC | tl(TCs)]}. init_tc(State, Config) when is_list(Config) == false -> - State#state{ timer = now(), tc_log = "" }; + State#state{ timer = ?now, tc_log = "" }; init_tc(State, Config) -> - State#state{ timer = now(), + State#state{ timer = ?now, tc_log = proplists:get_value(tc_logfile, Config, [])}. end_tc(Func, Config, Res, State) when is_atom(Func) -> @@ -194,7 +196,7 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, ClassName = atom_to_list(Suite), PGroup = string:join([ atom_to_list(Group)|| Group <- lists:reverse(Groups)],"."), - TimeTakes = io_lib:format("~f",[timer:now_diff(now(),TS) / 1000000]), + TimeTakes = io_lib:format("~f",[timer:now_diff(?now,TS) / 1000000]), State#state{ test_cases = [#testcase{ log = Log, url = Url, timestamp = now_to_string(TS), @@ -209,7 +211,7 @@ close_suite(#state{ test_cases = [] } = State) -> State; close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> {Total,Fail,Skip} = count_tcs(TCs,0,0,0), - TimeTaken = timer:now_diff(now(),State#state.curr_suite_ts) / 1000000, + TimeTaken = timer:now_diff(?now,State#state.curr_suite_ts) / 1000000, SuiteLog = filename:join(State#state.curr_log_dir,?suite_log), SuiteUrl = make_url(UrlBase,SuiteLog), Suite = #testsuite{ name = atom_to_list(State#state.curr_suite), diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl index 8ee12a2e4d..ef1fd63905 100644 --- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl @@ -35,7 +35,7 @@ %% which will return the list with the following variables: %% localtime = the erlang:localtime() result in list [{date, Date}, {time, Time}] %% node = erlang:node() - can be compared in the testcase -%% now = erlang:now() - easier to compare than localtime() +%% now = os:timestamp() - easier to compare than localtime() %% config_server_pid - pid of the config server, should NOT change! %% config_server_vsn - .19 %% config_server_iteration - a number of iteration config_server's loop done @@ -73,7 +73,7 @@ test_get_known_variable(_)-> test_localtime_update(_)-> Seconds = 5, LT1 = ct:get_config(localtime), - timer:sleep(Seconds*1000), + ct:sleep(Seconds*1000), LT2 = ct:reload_config(localtime), case is_diff_ok(LT1, LT2, Seconds) of {false, Actual, Exp}-> diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl index 8463fea645..e65d6584b1 100644 --- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl +++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl @@ -73,7 +73,7 @@ loop(Iteration)-> [{localtime, [{date, D}, {time, T}]}, {node, erlang:node()}, {config_server_iteration, Iteration}, - {now, erlang:now()}, + {now, os:timestamp()}, {config_server_pid, self()}, {config_server_vsn, ?vsn}], Config2 = if Iteration rem 2 == 0-> diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index ecf231529a..8464225284 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -1466,7 +1466,8 @@ test_events(misc_errors) -> {failed,{error,{suite_failed,this_is_expected}}}}}, {?eh,test_stats,{0,5,{0,0}}}, {?eh,tc_start,{misc_error_1_SUITE,killed_by_signal_1}}, - {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_1,i_die_now}}, + {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_1, + {failed,{'EXIT',i_die_now}}}}, {?eh,test_stats,{0,6,{0,0}}}, {?eh,tc_start,{misc_error_1_SUITE,killed_by_signal_2}}, {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_2, diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl index 806d3caf72..0ff8659269 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl @@ -26,10 +26,10 @@ init_per_testcase(_, Config) -> Config. end_per_testcase(tc2, _Config) -> - timer:sleep(2000), + ct:sleep(2000), exit(this_should_not_be_printed); end_per_testcase(tc4, _Config) -> - timer:sleep(2000), + ct:sleep(2000), exit(this_should_not_be_printed); end_per_testcase(_, _) -> ok. @@ -42,7 +42,7 @@ tc1() -> put('$test_server_framework_test', fun(init_tc, _Default) -> ct:pal("init_tc(~p): Night time...",[self()]), - timer:sleep(2000), + ct:sleep(2000), ct:pal("init_tc(~p): Day time!",[self()]), exit(this_should_not_be_printed); (_, Default) -> Default @@ -67,7 +67,7 @@ tc3(_) -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), @@ -78,7 +78,7 @@ tc4() -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl index c8a3c1d15e..cfc0babb68 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl @@ -26,7 +26,7 @@ init_per_suite() -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl index 960d0f61b0..54b09e78c6 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl @@ -29,7 +29,7 @@ end_per_suite() -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl index 08c57887ef..0d93e46501 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl @@ -36,7 +36,7 @@ suite() -> %% Reason = term() %%-------------------------------------------------------------------- init_per_suite(Config) -> - timer:sleep(5000), + ct:sleep(5000), exit(shouldnt_happen). % Config. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl index 9cd5b6ad29..d95f3b235b 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl @@ -43,7 +43,7 @@ init_per_suite(Config) -> %% Config0 = Config1 = [tuple()] %%-------------------------------------------------------------------- end_per_suite(Config) -> - timer:sleep(5000), + ct:sleep(5000), ok. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl index 25993833d7..d8f0c48034 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl @@ -57,7 +57,7 @@ init_per_group(g1, Config) -> Config; init_per_group(g2, Config) -> ct:comment("init_per_group(g2) timeout"), - timer:sleep(5000), + ct:sleep(5000), Config; init_per_group(g3, _Config) -> badmatch = 42; @@ -80,7 +80,7 @@ end_per_group(g11, _Config) -> ok; end_per_group(g12, _Config) -> ct:comment("end_per_group(g6) timeout"), - timer:sleep(5000), + ct:sleep(5000), ok; end_per_group(_GroupName, _Config) -> ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl index a98382965f..1451a4119e 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl @@ -111,7 +111,7 @@ end_per_testcase1(tc2, Config) -> ct:pal("end_per_testcase(tc2): ~p", [Config]), tc2 = ?config(tc, Config), {failed,timetrap_timeout} = ?config(tc_status, Config), - timer:sleep(2000); + ct:sleep(2000); end_per_testcase1(tc3, Config) -> ct:pal("end_per_testcase(tc3): ~p", [Config]), @@ -123,7 +123,7 @@ end_per_testcase1(tc4, Config) -> ct:pal("end_per_testcase(tc4): ~p", [Config]), tc4 = ?config(tc, Config), {failed,{testcase_aborted,testing_end_conf}} = ?config(tc_status, Config), - timer:sleep(2000); + ct:sleep(2000); end_per_testcase1(tc5, Config) -> ct:pal("end_per_testcase(tc5): ~p", [Config]), @@ -182,29 +182,29 @@ all() -> [tc1, tc2, tc3, tc4, tc5, tc6, tc7, tc8, tc9]. tc1(_) -> - timer:sleep(2000), + ct:sleep(2000), ok. tc2(_) -> - timer:sleep(2000). + ct:sleep(2000). tc3(_) -> spawn(ct, abort_current_testcase, [testing_end_conf]), - timer:sleep(2000), + ct:sleep(2000), ok. tc4(_) -> spawn(ct, abort_current_testcase, [testing_end_conf]), - timer:sleep(2000), + ct:sleep(2000), ok. tc5(_) -> - timer:sleep(2000), + ct:sleep(2000), ok. tc6(_) -> spawn(ct, abort_current_testcase, [testing_end_conf]), - timer:sleep(2000). + ct:sleep(2000). tc7(_) -> sleep(2000), @@ -220,5 +220,5 @@ tc9(_) -> %%%----------------------------------------------------------------- sleep(T) -> - timer:sleep(T), + ct:sleep(T), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl index a77d06815e..d926fc55a4 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl @@ -141,12 +141,13 @@ tc3() -> [{timetrap,{seconds,2}}]. tc3(_) -> - T0 = now(), + T0 = erlang:monotonic_time(), ct:timetrap(infinity), N = list_to_integer(ct:get_config(multiply)), ct:comment(io_lib:format("Sleeping for ~w sec...", [4*N])), ct:sleep(4000), - Diff = timer:now_diff(now(), T0), + T1 = erlang:monotonic_time(), + Diff = erlang:convert_time_unit(T1-T0, native, micro_seconds), if ((Diff < (N*4000000)) or (Diff > (N*4500000))) -> exit(not_expected); true -> diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl index 1389acca11..a9ea0be847 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl @@ -3,5 +3,5 @@ -export([sleep/1]). sleep(T) -> - timer:sleep(T), + ct:sleep(T), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl index 446dd8bfdf..d5b3e0035a 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl @@ -81,7 +81,7 @@ init(Id, Opts) -> -spec id(Opts :: proplists:proplist()) -> Id :: term(). id(Opts) -> - now(). + os:timestamp(). %% @doc Called before init_per_suite is called. Note that this callback is %% only called if the CTH is added before init_per_suite is run (eg. in a test diff --git a/lib/common_test/test/ct_event_handler_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE.erl index 30a5e650fe..b759424e46 100644 --- a/lib/common_test/test/ct_event_handler_SUITE.erl +++ b/lib/common_test/test/ct_event_handler_SUITE.erl @@ -29,6 +29,7 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/src/ct_util.hrl"). %-include_lib("common_test/include/ct_event.hrl"). @@ -59,7 +60,7 @@ end_per_testcase(TestCase, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start_stop, results]. + [start_stop, results, event_mgrs]. groups() -> []. @@ -156,21 +157,28 @@ results(Config) when is_list(Config) -> TestEvents = [{eh_A,start_logging,{'DEF','RUNDIR'}}, {eh_A,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {eh_A,start_info,{1,1,4}}, + {eh_A,start_info,{1,1,5}}, {eh_A,tc_start,{eh_11_SUITE,init_per_suite}}, {eh_A,tc_done,{eh_11_SUITE,init_per_suite,ok}}, - {eh_A,tc_start,{eh_11_SUITE,tc1}}, - {eh_A,tc_done,{eh_11_SUITE,tc1,ok}}, - {eh_A,test_stats,{1,0,{0,0}}}, - {eh_A,tc_start,{eh_11_SUITE,tc2}}, - {eh_A,tc_done,{eh_11_SUITE,tc2,{skipped,"Skip"}}}, - {eh_A,test_stats,{1,0,{1,0}}}, - {eh_A,tc_start,{eh_11_SUITE,tc3}}, - {eh_A,tc_done,{eh_11_SUITE,tc3,{skipped,"Skipped"}}}, - {eh_A,test_stats,{1,0,{2,0}}}, - {eh_A,tc_start,{eh_11_SUITE,tc4}}, - {eh_A,tc_done,{eh_11_SUITE,tc4,{failed,{error,'Failing'}}}}, - {eh_A,test_stats,{1,1,{2,0}}}, + [{eh_A,tc_start,{eh_11_SUITE,{init_per_group,g1,[]}}}, + {eh_A,tc_done,{eh_11_SUITE,{init_per_group,g1,[]},ok}}, + {eh_A,tc_start,{eh_11_SUITE,tc1}}, + {eh_A,tc_done,{eh_11_SUITE,tc1,ok}}, + {eh_A,test_stats,{1,0,{0,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc2}}, + {eh_A,tc_done,{eh_11_SUITE,tc2,ok}}, + {eh_A,test_stats,{2,0,{0,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc3}}, + {eh_A,tc_done,{eh_11_SUITE,tc3,{skipped,"Skip"}}}, + {eh_A,test_stats,{2,0,{1,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc4}}, + {eh_A,tc_done,{eh_11_SUITE,tc4,{skipped,"Skipped"}}}, + {eh_A,test_stats,{2,0,{2,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc5}}, + {eh_A,tc_done,{eh_11_SUITE,tc5,{failed,{error,'Failing'}}}}, + {eh_A,test_stats,{2,1,{2,0}}}, + {eh_A,tc_start,{eh_11_SUITE,{end_per_group,g1,[]}}}, + {eh_A,tc_done,{eh_11_SUITE,{end_per_group,g1,[]},ok}}], {eh_A,tc_start,{eh_11_SUITE,end_per_suite}}, {eh_A,tc_done,{eh_11_SUITE,end_per_suite,ok}}, {eh_A,test_done,{'DEF','STOP_TIME'}}, @@ -179,5 +187,10 @@ results(Config) when is_list(Config) -> ok = ct_test_support:verify_events(TestEvents++TestEvents, Events, Config). +event_mgrs(_) -> + ?CT_EVMGR_REF = ct:get_event_mgr_ref(), + ?CT_MEVMGR_REF = ct_master:get_event_mgr_ref(). + + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS diff --git a/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl index a52fe96f30..14ea12d579 100644 --- a/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl +++ b/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl @@ -32,100 +32,36 @@ %% COMMON TEST CALLBACK FUNCTIONS %%-------------------------------------------------------------------- -%%-------------------------------------------------------------------- -%% Function: suite() -> Info -%% -%% Info = [tuple()] -%% List of key/value pairs. -%% -%% Description: Returns list of tuples to set default properties -%% for the suite. -%% -%% Note: The suite/0 function is only meant to be used to return -%% default data values, not perform any other operations. -%%-------------------------------------------------------------------- suite() -> [ {timetrap,{seconds,10}} ]. -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Reason = term() -%% The reason for skipping the suite. -%% -%% Description: Initialization before the suite. -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config0) -> void() | {save_config,Config1} -%% -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Cleanup after the suite. -%%-------------------------------------------------------------------- end_per_suite(_Config) -> - ok. + %% should report ok as result to event handler + done. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + %% should report ok as result to event handler + void. -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% -%% TestCase = atom() -%% Name of the test case that is about to run. -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Reason = term() -%% The reason for skipping the test case. -%% -%% Description: Initialization before each test case. -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_testcase(_TestCase, Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config0) -> -%% void() | {save_config,Config1} -%% -%% TestCase = atom() -%% Name of the test case that is finished. -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Cleanup after each test case. -%%-------------------------------------------------------------------- end_per_testcase(_TestCase, _Config) -> - ok. + true. -%%-------------------------------------------------------------------- -%% Function: all() -> TestCases | {skip,Reason} -%% -%% TestCases = [TestCase | {sequence,SeqName}] -%% TestCase = atom() -%% Name of a test case. -%% SeqName = atom() -%% Name of a test case sequence. -%% Reason = term() -%% The reason for skipping all test cases. -%% -%% Description: Returns the list of test cases that are to be executed. -%%-------------------------------------------------------------------- -all() -> - [tc1, tc2, tc3, tc4]. +groups() -> + [{g1, [], [tc1, tc2, tc3, tc4, tc5]}]. +all() -> + [{group,g1}]. %%-------------------------------------------------------------------- %% TEST CASES @@ -134,11 +70,15 @@ all() -> tc1(_Config) -> ok. -tc2(_Config) -> - {skip,"Skip"}. +tc2(_Config) -> + %% should report ok as result to event handler + 42. tc3(_Config) -> + {skip,"Skip"}. + +tc4(_Config) -> {skipped,"Skipped"}. -tc4(_Config) -> +tc5(_Config) -> exit('Failing'). diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl index 1344878675..96dd80e4e8 100644 --- a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl @@ -73,23 +73,23 @@ handles_to_multi_conn_pids(_Config) -> {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, ok = proto:close(Handle1), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, ConnPid2x = ct_gen_conn:get_conn_pid(Handle2), true = is_process_alive(ConnPid2x), ok = proto:close(Handle2), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, ok. @@ -116,23 +116,23 @@ handles_to_single_conn_pids(_Config) -> ct:pal("CONNS = ~n~p", [Conns]), ok = proto:close(Handle1), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), NewConnPid = ct_gen_conn:get_conn_pid(Handle2), NewConnPid = ct_gen_conn:get_conn_pid(Handle3), true = is_process_alive(Handle2), true = is_process_alive(Handle3), ok = proto:close(Handle2), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)}, ok. @@ -158,29 +158,29 @@ names_to_multi_conn_pids(_Config) -> Handle1 = proto:open(mconn1), ok = proto:close(mconn1), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), Handle2 = proto:open(mconn2), % should've been reconnected already {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, ConnPid2x = ct_gen_conn:get_conn_pid(Handle2), true = is_process_alive(ConnPid2x), ok = proto:close(mconn2), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)}, Handle2y = proto:open(mconn2), ConnPid2y = ct_gen_conn:get_conn_pid(Handle2y), {true,true} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)}, ok = proto:close(mconn2), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, ok. @@ -211,11 +211,11 @@ names_to_single_conn_pids(_Config) -> ct:pal("CONNS on ~p = ~n~p", [ConnPid,Conns]), ok = proto:close(sconn1), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid)}, Handle2 = proto:open(sconn2), % should've been reconnected already NewConnPid = ct_gen_conn:get_conn_pid(Handle2), @@ -227,12 +227,12 @@ names_to_single_conn_pids(_Config) -> ct:pal("CONNS on ~p = ~n~p", [NewConnPid,Conns1]), ok = proto:close(sconn2), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)}, ok. diff --git a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl index 804f722081..bfdc78639e 100644 --- a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl +++ b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl @@ -258,14 +258,14 @@ gen_io(Label, N, Acc) -> %% (via ct logging functions) from an external process which has a %% different group leader than the test cases. unexp1(Config) -> - timer:sleep(1000), + ct:sleep(1000), gen_unexp_io(), - timer:sleep(1000), + ct:sleep(1000), check_unexp_io(Config), ok. unexp2(_) -> - timer:sleep(2000), + ct:sleep(2000), ok. gen_unexp_io() -> diff --git a/lib/common_test/test/ct_groups_test_1_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE.erl index e520a72227..d5de949554 100644 --- a/lib/common_test/test/ct_groups_test_1_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_1_SUITE.erl @@ -302,7 +302,7 @@ test_events(groups_suite_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -410,7 +410,7 @@ test_events(groups_suite_2) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -505,7 +505,7 @@ test_events(groups_suites_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}}, @@ -596,7 +596,7 @@ test_events(groups_suites_1) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -691,7 +691,7 @@ test_events(groups_dir_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}}, @@ -782,7 +782,7 @@ test_events(groups_dir_1) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -878,7 +878,7 @@ test_events(groups_dirs_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}}, @@ -969,7 +969,7 @@ test_events(groups_dirs_1) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_21_SUITE,init_per_suite}}, {?eh,tc_done,{groups_21_SUITE,init_per_suite,ok}}, @@ -1089,7 +1089,7 @@ test_events(groups_dirs_1) -> {groups_21_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_21_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_21_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_21_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_22_SUITE,init_per_suite}}, {?eh,tc_done,{groups_22_SUITE,init_per_suite,ok}}, @@ -1223,6 +1223,6 @@ test_events(groups_dirs_1) -> {groups_22_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]. diff --git a/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl index ec90ef95d1..6f49f9a957 100644 --- a/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl @@ -278,7 +278,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/ct_groups_test_2_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE.erl index 8b0de98709..f41395e028 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE.erl @@ -302,7 +302,7 @@ test_events(empty_group) -> {?eh,tc_done, {groups_22_SUITE,{end_per_group,test_group_8,[]},ok}}], {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl index 154c676d7e..80bb5ba69b 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl @@ -293,7 +293,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl index 3c1f5669e8..f8c8725602 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl @@ -26,21 +26,23 @@ -include("ct.hrl").
+-define(now, os:timestamp()).
+
%% Test server callback functions
init_per_suite(Config) ->
- [{init_per_suite,now()}|Config].
+ [{init_per_suite,?now}|Config].
end_per_suite(_Config) ->
ok.
init_per_testcase(_TestCase, Config) ->
- [{init_per_testcase,now()}|Config].
+ [{init_per_testcase,?now}|Config].
end_per_testcase(_TestCase, _Config) ->
ok.
init_per_group(GroupName, Config) ->
- [{init_per_group,now()}|Config].
+ [{init_per_group,?now}|Config].
end_per_group(GroupName, Config) ->
ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl index 18dd07e87e..80ce248418 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl @@ -50,7 +50,7 @@ init_per_suite(Config) -> end_per_suite(Config) -> Gen = proplists:get_value(gen, Config), exit(Gen, kill), - timer:sleep(100), + ct:sleep(100), ok. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index 77783fccf5..5f8eae1f70 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -87,7 +87,7 @@ id(Opts) -> gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, id, [Opts]}}), ct:log("~w:id called", [?MODULE]), - now(). + os:timestamp(). %% @doc Called before init_per_suite is called. Note that this callback is %% only called if the CTH is added before init_per_suite is run (eg. in a test diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl index 2ee0d7da9c..55a1b9a130 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl @@ -24,6 +24,7 @@ -include_lib("common_test/src/ct_util.hrl").
-include_lib("common_test/include/ct_event.hrl").
+-define(now, os:timestamp()).
%% CT Hooks
-compile(export_all).
@@ -33,44 +34,44 @@ init(Id, Opts) -> pre_init_per_suite(Suite, Config, State) ->
empty_cth:pre_init_per_suite(Suite,Config,State),
- {[{pre_init_per_suite,now()}|Config],State}.
+ {[{pre_init_per_suite,?now}|Config],State}.
post_init_per_suite(Suite,Config,Return,State) ->
empty_cth:post_init_per_suite(Suite,Config,Return,State),
- {[{post_init_per_suite,now()}|Return],State}.
+ {[{post_init_per_suite,?now}|Return],State}.
pre_end_per_suite(Suite,Config,State) ->
empty_cth:pre_end_per_suite(Suite,Config,State),
- {[{pre_end_per_suite,now()}|Config],State}.
+ {[{pre_end_per_suite,?now}|Config],State}.
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State),
- NewConfig = [{post_end_per_suite,now()}|Config],
+ NewConfig = [{post_end_per_suite,?now}|Config],
{NewConfig,NewConfig}.
pre_init_per_group(Group,Config,State) ->
empty_cth:pre_init_per_group(Group,Config,State),
- {[{pre_init_per_group,now()}|Config],State}.
+ {[{pre_init_per_group,?now}|Config],State}.
post_init_per_group(Group,Config,Return,State) ->
empty_cth:post_init_per_group(Group,Config,Return,State),
- {[{post_init_per_group,now()}|Return],State}.
+ {[{post_init_per_group,?now}|Return],State}.
pre_end_per_group(Group,Config,State) ->
empty_cth:pre_end_per_group(Group,Config,State),
- {[{pre_end_per_group,now()}|Config],State}.
+ {[{pre_end_per_group,?now}|Config],State}.
post_end_per_group(Group,Config,Return,State) ->
empty_cth:post_end_per_group(Group,Config,Return,State),
- {[{post_end_per_group,now()}|Config],State}.
+ {[{post_end_per_group,?now}|Config],State}.
pre_init_per_testcase(TC,Config,State) ->
empty_cth:pre_init_per_testcase(TC,Config,State),
- {[{pre_init_per_testcase,now()}|Config],State}.
+ {[{pre_init_per_testcase,?now}|Config],State}.
post_end_per_testcase(TC,Config,Return,State) ->
empty_cth:post_end_per_testcase(TC,Config,Return,State),
- {[{post_end_per_testcase,now()}|Config],State}.
+ {[{post_end_per_testcase,?now}|Config],State}.
on_tc_fail(TC, Reason, State) ->
empty_cth:on_tc_fail(TC,Reason,State).
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index 332e54d1a7..e7bbdc28a5 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -204,7 +204,7 @@ hello_required_exists(Config) -> ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(my_named_connection), - timer:sleep(500), + ct:sleep(500), %% Then check that it can be used again after the first is closed {ok,_Client2} = open_configured_success(my_named_connection,DataDir), @@ -486,8 +486,15 @@ action(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), Data = [{myactionreturn,[{xmlns,"myns"}],["value"]}], - ?NS:expect_reply(action,{data,Data}), - {ok,Data} = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + %% test either to receive {data,Data} or {ok,Data}, + %% both need to be handled + {Reply,RetVal} = case element(3, now()) rem 2 of + 0 -> {{data,Data},{ok,Data}}; + 1 -> {{ok,Data},ok} + end, + ct:log("Client will receive {~w,Data}", [element(1,Reply)]), + ?NS:expect_reply(action,Reply), + RetVal = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. @@ -654,10 +661,10 @@ receive_chunked_data(Config) -> %% Spawn a process which will wait a bit for the client to send %% the request (below), then order the server to the chunks of the %% rpc-reply one by one. - spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1), - timer:sleep(100),?NS:hupp(send,Part2), - timer:sleep(100),?NS:hupp(send,Part3), - timer:sleep(100),?NS:hupp(send,Part4) + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2), + ct:sleep(100),?NS:hupp(send,Part3), + ct:sleep(100),?NS:hupp(send,Part4) end), %% Order server to expect a get - then the process above will make @@ -702,8 +709,8 @@ timeout_receive_chunked_data(Config) -> %% Spawn a process which will wait a bit for the client to send %% the request (below), then order the server to the chunks of the %% rpc-reply one by one. - spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1), - timer:sleep(100),?NS:hupp(send,Part2) + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2) end), %% Order server to expect a get - then the process above will make @@ -748,9 +755,9 @@ close_while_waiting_for_chunked_data(Config) -> %% Spawn a process which will wait a bit for the client to send %% the request (below), then order the server to the chunks of the %% rpc-reply one by one. - spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1), - timer:sleep(100),?NS:hupp(send,Part2), - timer:sleep(100),?NS:hupp(kill) + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2), + ct:sleep(100),?NS:hupp(kill) end), %% Order server to expect a get - then the process above will make @@ -766,7 +773,7 @@ connection_crash(Config) -> %% Test that if the test survives killing the connection %% process. Earlier this caused ct_util_server to terminate, and %% this aborting the complete test run. - spawn(fun() -> timer:sleep(500),exit(Client,kill) end), + spawn(fun() -> ct:sleep(500),exit(Client,kill) end), ?NS:expect(get), {error,{closed,killed}}=ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), ok. diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index f7c7b891bb..e4bc396536 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -351,7 +351,7 @@ check_expected(SessionId,ConnRef,Msg) -> do(ConnRef, Do), reply(ConnRef,Reply); error -> - timer:sleep(1000), + ct:sleep(1000), exit({error,{got_unexpected,SessionId,Msg,ets:tab2list(ns_tab)}}) end. @@ -548,8 +548,13 @@ make_msg({hello,SessionId,Stuff}) -> SessionIdXml/binary,"</hello>">>); make_msg(ok) -> xml(rpc_reply("<ok/>")); + +make_msg({ok,Data}) -> + xml(rpc_reply(from_simple({ok,Data}))); + make_msg({data,Data}) -> xml(rpc_reply(from_simple({data,Data}))); + make_msg(event) -> xml(<<"<notification xmlns=\"",?NETCONF_NOTIF_NAMESPACE,"\">" "<eventTime>2012-06-14T14:50:54+02:00</eventTime>" diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl index 5de1ecc2bd..1e6018f442 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -91,27 +91,27 @@ pre_post_io(Config) -> spawn(fun() -> ct:pal("CONTROLLER: Started!", []), %% --- test run 1 --- - timer:sleep(3000), + ct:sleep(3000), ct:pal("CONTROLLER: Handle remote events = true", []), ok = ct_test_support:ct_rpc({cth_log_redirect, handle_remote_events, [true]}, Config), - timer:sleep(2000), + ct:sleep(2000), ct:pal("CONTROLLER: Proceeding with test run #1!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - timer:sleep(6000), + ct:sleep(6000), ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), %% --- test run 2 --- - timer:sleep(3000), + ct:sleep(3000), ct:pal("CONTROLLER: Handle remote events = true", []), ok = ct_test_support:ct_rpc({cth_log_redirect, handle_remote_events, [true]}, Config), - timer:sleep(2000), + ct:sleep(2000), ct:pal("CONTROLLER: Proceeding with test run #2!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - timer:sleep(6000), + ct:sleep(6000), ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) end), diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index e37aeb196c..50e07608f6 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -220,8 +220,7 @@ test_events(repeat_cs_and_grs) -> {?eh,test_stats,{1,1,{0,0}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_result,[]},ok}}, {?eh,test_stats,{2,1,{0,0}}}, - {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},ok}}], {?eh,test_stats,{3,1,{0,0}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]}, {failed,{error,fails_on_purpose}}}}, @@ -242,8 +241,7 @@ test_events(repeat_cs_and_grs) -> {?eh,test_stats,{5,2,{0,1}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_result,[]},ok}}, {?eh,test_stats,{6,2,{0,1}}}, - {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},ok}}], {?eh,test_stats,{7,2,{0,1}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]}, {failed,{error,fails_on_purpose}}}}, @@ -289,8 +287,7 @@ test_events(repeat_seq) -> {init_per_group,gr_fail_result,[]},ok}}, {?eh,test_stats,{4,2,{0,2}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_2}, {group_result,gr_fail_result,failed}}}, {?eh,test_stats,{4,2,{0,3}}}, @@ -402,8 +399,7 @@ test_events(repeat_gr_until_any_ok) -> [{?eh,tc_done,{repeat_1_SUITE, {init_per_group,gr_fail_result,[]},ok}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_fail_1, {failed,{error,{{badmatch,2},'_'}}}}}, {?eh,test_stats,{1,1,{0,0}}}, @@ -418,8 +414,7 @@ test_events(repeat_gr_until_any_ok) -> [{?eh,tc_done,{repeat_1_SUITE, {init_per_group,gr_fail_result_then_ok,[]},ok}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result_then_ok,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result_then_ok,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_gr_until_any_ok_1, [{repeat_until_any_ok,3}]},ok}}], @@ -441,8 +436,7 @@ test_events(repeat_gr_until_any_ok) -> {init_per_group,repeat_gr_until_any_ok_2, [{repeat_until_any_ok,3}]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_fail_1, {failed,{error,{{badmatch,2},'_'}}}}}, {?eh,test_stats,{5,5,{0,2}}}, @@ -675,8 +669,7 @@ test_events(repeat_gr_until_any_fail) -> {repeat_1_SUITE,{end_per_group,gr_ok_then_fail_result,[]}}}, {?eh,tc_done, {repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_start,{repeat_1_SUITE,tc_ok_2}}, {?eh,tc_done,{repeat_1_SUITE,tc_ok_2,ok}}, {?eh,test_stats,{8,0,{0,0}}}, @@ -938,8 +931,7 @@ test_events(repeat_gr_until_all_ok) -> {?eh,tc_done,{repeat_1_SUITE,tc_ok_1,ok}}, {?eh,test_stats,{3,1,{0,0}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result_then_ok,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result_then_ok,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_gr_until_all_ok_1, [{repeat_until_all_ok,3}]},ok}}], @@ -1113,8 +1105,7 @@ test_events(repeat_gr_until_all_fail) -> gr_ok_then_fail_result,[]},ok}}, {?eh,test_stats,{3,3,{0,2}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_gr_until_all_fail_1, [{repeat_until_all_fail,2}]},ok}}], @@ -1148,8 +1139,7 @@ test_events(repeat_gr_until_all_fail) -> {init_per_group,repeat_gr_until_all_fail_3, [{repeat_until_all_fail,3}]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1,ok}}, {?eh,test_stats,{6,5,{0,3}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -1159,8 +1149,7 @@ test_events(repeat_gr_until_all_fail) -> {init_per_group,repeat_gr_until_all_fail_3, [{repeat_until_all_fail,2}]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1, {failed,{error,failing_this_time}}}}, {?eh,test_stats,{7,6,{0,3}}}, @@ -1263,8 +1252,7 @@ test_events(repeat_seq_until_any_fail) -> {init_per_group,repeat_seq_until_any_fail_4, [{repeat_until_any_fail,2},sequence]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_1}, {group_result,gr_ok_then_fail_result,failed}}}, {?eh,test_stats,{19,1,{0,3}}}, @@ -1473,8 +1461,7 @@ test_events(repeat_shuffled_seq_until_any_fail) -> [{?eh,tc_start,{repeat_1_SUITE, {end_per_group,gr_ok_then_fail_result,[]}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_start,{repeat_1_SUITE, {end_per_group,repeat_shuffled_seq_until_any_fail_4, [{shuffle,repeated},{repeat_until_any_fail,2},sequence]}}}, diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl index 3fd5943691..3d7049a9c4 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl @@ -68,7 +68,7 @@ end_per_testcase(_Case, Config) -> %%%----------------------------------------------------------------- %%% Test cases tc1(_Config) -> - timer:sleep(10000), + ct:sleep(10000), ok. tc2(_Config) -> diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl index dc9abc2863..e4f6e7dcc1 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl @@ -68,7 +68,7 @@ end_per_testcase(_Case, Config) -> %%%----------------------------------------------------------------- %%% Test cases tc1(_Config) -> - %% timer:sleep(3000), + %% ct:sleep(3000), ok. tc2(_Config) -> diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl index 5a775a1117..4055cd789e 100644 --- a/lib/common_test/test/ct_sequence_1_SUITE.erl +++ b/lib/common_test/test/ct_sequence_1_SUITE.erl @@ -182,8 +182,7 @@ test_events(subgroup_return_fail) -> {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start, {subgroups_1_SUITE,{end_per_group,return_fail,[]}}}, - {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},ok}}], {?eh,tc_auto_skip, {subgroups_1_SUITE,{ok_tc,ok_group}, {group_result,return_fail,failed}}}, @@ -191,8 +190,7 @@ test_events(subgroup_return_fail) -> {?eh,tc_start, {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]}}}, {?eh,tc_done, - {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]}, - {return_group_result,failed}}}], + {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -221,8 +219,7 @@ test_events(subgroup_init_fail) -> {?eh,test_stats,{0,0,{0,2}}}, {?eh,tc_start,{subgroups_1_SUITE,{end_per_group,subgroup_init_fail,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,subgroup_init_fail,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,subgroup_init_fail,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -245,8 +242,7 @@ test_events(subgroup_after_failed_case) -> {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,subgroup_after_failed_case,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,subgroup_after_failed_case,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,subgroup_after_failed_case,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -266,16 +262,14 @@ test_events(case_after_subgroup_return_fail) -> {?eh,tc_done,{subgroups_1_SUITE,failing_tc,{failed,{error,{{badmatch,3},'_'}}}}}, {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start,{subgroups_1_SUITE,{end_per_group,return_fail,[]}}}, - {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},ok}}], {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,case_after_subgroup_return_fail}, {group_result,return_fail,failed}}}, {?eh,test_stats,{0,1,{0,1}}}, {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,case_after_subgroup_return_fail,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,case_after_subgroup_return_fail,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,case_after_subgroup_return_fail,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -310,8 +304,7 @@ test_events(case_after_subgroup_fail_init) -> {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,case_after_subgroup_fail_init,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,case_after_subgroup_fail_init,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,case_after_subgroup_fail_init,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_shell_SUITE.erl b/lib/common_test/test/ct_shell_SUITE.erl index 4b8c43d800..70c0ab8127 100644 --- a/lib/common_test/test/ct_shell_SUITE.erl +++ b/lib/common_test/test/ct_shell_SUITE.erl @@ -93,7 +93,7 @@ start_interactive(Config) -> test_server:format(Level, "ct_util_server not stopped on ~p yet, waiting 5 s...~n", [CTNode]), - timer:sleep(5000), + ct:sleep(5000), undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server]) end, Events = ct_test_support:get_events(ERPid, Config), diff --git a/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl b/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl index 825846cd55..89e202a404 100644 --- a/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl @@ -72,7 +72,7 @@ end_per_group(_GroupName, _Config) -> %% Reason = term() %%-------------------------------------------------------------------- init_per_testcase(tc1, Config) -> - timer:sleep(5000), + ct:sleep(5000), Config; init_per_testcase(_TestCase, Config) -> Config. diff --git a/lib/common_test/test/ct_smoke_test_SUITE.erl b/lib/common_test/test/ct_smoke_test_SUITE.erl index 49b38361e2..6077946c33 100644 --- a/lib/common_test/test/ct_smoke_test_SUITE.erl +++ b/lib/common_test/test/ct_smoke_test_SUITE.erl @@ -480,7 +480,7 @@ events(Test) when Test == dir1 ; Test == dir2 ; {Suite,tc4,{skipped,"Skipping this one"}}}, {?eh,test_stats,{7,0,{1,0}}}, {?eh,tc_start,{Suite,end_per_suite}}, - {?eh,tc_done,{Suite,end_per_suite,ips_data}}, + {?eh,tc_done,{Suite,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -517,7 +517,7 @@ events(Test) when Test == dir1_2 ; Test == suite11_21 -> {happy_11_SUITE,tc4,{skipped,"Skipping this one"}}}, {?eh,test_stats,{7,0,{1,0}}}, {?eh,tc_start,{happy_11_SUITE,end_per_suite}}, - {?eh,tc_done,{happy_11_SUITE,end_per_suite,ips_data}}, + {?eh,tc_done,{happy_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{happy_21_SUITE,init_per_suite}}, {?eh,tc_done,{happy_21_SUITE,init_per_suite,ok}}, {?eh,tc_start,{happy_21_SUITE,tc1}}, @@ -546,7 +546,7 @@ events(Test) when Test == dir1_2 ; Test == suite11_21 -> {happy_21_SUITE,tc4,{skipped,"Skipping this one"}}}, {?eh,test_stats,{14,0,{2,0}}}, {?eh,tc_start,{happy_21_SUITE,end_per_suite}}, - {?eh,tc_done,{happy_21_SUITE,end_per_suite,ips_data}}, + {?eh,tc_done,{happy_21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -563,7 +563,7 @@ events(Test) when Test == tc111 ; Test == tc211 -> {?eh,tc_done,{Suite,tc1,ok}}, {?eh,test_stats,{1,0,{0,0}}}, {?eh,tc_start,{Suite,end_per_suite}}, - {?eh,tc_done,{Suite,end_per_suite,ips_data}}, + {?eh,tc_done,{Suite,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -582,7 +582,7 @@ events(tc111_112) -> {?eh,tc_done,{happy_11_SUITE,tc2,ok}}, {?eh,test_stats,{2,0,{0,0}}}, {?eh,tc_start,{happy_11_SUITE,end_per_suite}}, - {?eh,tc_done,{happy_11_SUITE,end_per_suite,ips_data}}, + {?eh,tc_done,{happy_11_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl index e20832e1e7..07f7bf02e4 100644 --- a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl @@ -117,12 +117,12 @@ break(_Config) -> start_stop(Config) -> ok = ct_snmp:start(Config,snmp1,snmp_app1), - timer:sleep(1000), + ct:sleep(1000), {snmp,_,_} = lists:keyfind(snmp,1,application:which_applications()), [_|_] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)), ok = ct_snmp:stop(Config), - timer:sleep(1000), + ct:sleep(1000), false = lists:keyfind(snmp,1,application:which_applications()), [] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)), ok. diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl index 84e69c2b54..62cb821ede 100644 --- a/lib/common_test/test/ct_telnet_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE.erl @@ -203,7 +203,9 @@ telnet_config(_, LogType) -> {command_timeout,10000}, {reconnection_attempts,0}, {reconnection_interval,0}, - {keep_alive,true}]} | + {keep_alive,true}, + {poll_limit,10}, + {poll_interval,1000}]} | if LogType == legacy -> [{ct_conn_log,[]}]; true -> 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 bd5d76266a..1d3f5918d2 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 @@ -283,14 +283,14 @@ large_string(_) -> %% yield the same result as the single request case. ok = ct_telnet:send(Handle, "echo_sep "++BigString), - timer:sleep(1000), + ct: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), + ct: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/=$>], @@ -316,7 +316,7 @@ server_speaks(_) -> "echo_no_prompt This is the second message"), %% Let ct_telnet_client get an idle timeout. This should print the %% two messages to the log. Note that the buffers are not flushed here! - timer:sleep(15000), + ct:sleep(15000), ok = ct_telnet_client:send_data(Backdoor, "echo_no_prompt This is the third message"), {ok,_} = ct_telnet:expect(Handle, ["first.*second.*third"], @@ -326,7 +326,7 @@ server_speaks(_) -> ok = ct_telnet_client:send_data(Backdoor, "echo_no_prompt This is the fourth message"), %% give the server time to respond - timer:sleep(2000), + ct:sleep(2000), %% closing the connection should print last message in log ok = ct_telnet:close(Handle), ok. @@ -338,11 +338,11 @@ server_disconnects(_) -> ok = ct_telnet:send(Handle, "disconnect_after 1500"), %% wait until the get_data operation (triggered by send/2) times out %% before sending the msg - timer:sleep(500), + ct:sleep(500), ok = ct_telnet:send(Handle, "echo_no_prompt This is the message"), %% when the server closes the connection, the last message should be %% printed in the log - timer:sleep(3000), + ct:sleep(3000), _ = ct_telnet:close(Handle), ok. diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl index 06fa6ac638..d30feb0bd2 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl @@ -76,7 +76,7 @@ end_per_group(_GroupName, _Config) -> %% Reason = term() %%-------------------------------------------------------------------- init_per_testcase(tc1, Config) -> - timer:sleep(5000), + ct:sleep(5000), Config; init_per_testcase(tc8, _Config) -> {skip,"tc8 skipped"}; @@ -92,7 +92,7 @@ init_per_testcase(_TestCase, Config) -> %% Config0 = Config1 = [tuple()] %%-------------------------------------------------------------------- end_per_testcase(tc2, Config) -> - timer:sleep(5000); + ct:sleep(5000); end_per_testcase(tc12, Config) -> ct:comment("end_per_testcase(tc12) called!"), ct:pal("end_per_testcase(tc12) called!", []), @@ -146,7 +146,7 @@ tc2(_) -> timeout_in_end_per_testcase. tc3(_) -> - timer:sleep(5000). + ct:sleep(5000). tc4(_) -> exit(failed_on_purpose). @@ -186,7 +186,7 @@ gtc2(_) -> tc12(_) -> F = fun() -> ct:abort_current_testcase('stopping tc12') end, spawn(F), - timer:sleep(1000), + ct:sleep(1000), exit(should_have_been_aborted). tc13(_) -> diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 2c1f98d63b..ffef8187f3 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -51,12 +51,12 @@ init_per_suite(Config) -> init_per_suite(Config, 50). init_per_suite(Config, Level) -> + ScaleFactor = test_server:timetrap_scale_factor(), case os:type() of {win32, _} -> %% Extend timeout to 1 hour for windows as starting node %% can take a long time there - test_server:timetrap( 60*60*1000 * - test_server:timetrap_scale_factor()); + test_server:timetrap( 60*60*1000 * ScaleFactor ); _ -> ok end, @@ -67,6 +67,16 @@ init_per_suite(Config, Level) -> _ -> ok end, + + {Mult,Scale} = test_server_ctrl:get_timetrap_parameters(), + test_server:format(Level, "Timetrap multiplier: ~w~n", [Mult]), + if Scale == true -> + test_server:format(Level, "Timetrap scale factor: ~w~n", + [ScaleFactor]); + true -> + ok + end, + start_slave(Config, Level). start_slave(Config, Level) -> @@ -277,10 +287,13 @@ run_ct_run_test(Opts,Config) -> Level = proplists:get_value(trace_level, Config), test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~p) on ~p~n", [Opts, CTNode]), - T0 = now(), + + T0 = erlang:monotonic_time(), CtRunTestResult = rpc:call(CTNode, ct, run_test, [Opts]), + T1 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), test_server:format(Level, "~n[RUN #1] Got return value ~p after ~p ms~n", - [CtRunTestResult,trunc(timer:now_diff(now(), T0)/1000)]), + [CtRunTestResult,Elapsed]), case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of undefined -> ok; @@ -303,10 +316,12 @@ run_ct_script_start(Opts, Config) -> [common_test, run_test_start_opts, Opts1]), test_server:format(Level, "[RUN #2] Calling ct_run:script_start() on ~p~n", [CTNode]), - T0 = now(), + T0 = erlang:monotonic_time(), ExitStatus = rpc:call(CTNode, ct_run, script_start, []), + T1 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), test_server:format(Level, "[RUN #2] Got exit status value ~p after ~p ms~n", - [ExitStatus,trunc(timer:now_diff(now(), T0)/1000)]), + [ExitStatus,Elapsed]), ExitStatus. check_result({_Ok,Failed,{_UserSkipped,_AutoSkipped}},1,_Opts) @@ -398,7 +413,7 @@ ct_rpc({M,F,A}, Config) -> %%%----------------------------------------------------------------- %%% random_error/1 random_error(Config) when is_list(Config) -> - random:seed(now()), + random:seed(os:timestamp()), Gen = fun(0,_) -> ok; (N,Fun) -> Fun(N-1, Fun) end, Gen(random:uniform(100), Gen), diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index c2670316b6..bc19283a47 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -795,7 +795,7 @@ test_events(skip_all_groups) -> {?eh,test_stats,{0,0,{12,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_4},"SKIPPED!"}}, {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; @@ -840,7 +840,7 @@ test_events(skip_group) -> {?eh,test_stats,{2,0,{6,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_2}, "SKIPPED!"}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; @@ -876,7 +876,7 @@ test_events(skip_group_all_testcases) -> {?eh,test_stats,{0,0,{4,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1b}, "SKIPPED!"}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; @@ -1065,7 +1065,7 @@ test_events(skip_subgroup) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; diff --git a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl index 69c06f9b83..e5de5df1a8 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl @@ -285,7 +285,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl index cd517876df..dcd361d658 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl @@ -278,7 +278,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index d25ee62d38..e073f0bfa4 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -59,7 +59,7 @@ init(Opts) -> accept(State), ok = gen_tcp:close(LSock), dbg("telnet_server closed the listen socket ~p\n", [LSock]), - timer:sleep(1000), + ct:sleep(1000), ok. listen(0, _Port, _Opts) -> @@ -68,7 +68,7 @@ listen(Retries, Port, Opts) -> case gen_tcp:listen(Port, Opts) of {error,eaddrinuse} -> dbg("Listen port not released, trying again..."), - timer:sleep(5000), + ct:sleep(5000), listen(Retries-1, Port, Opts); Ok = {ok,_LSock} -> Ok; @@ -220,7 +220,7 @@ do_handle_data("echo_sep " ++ Data,State) -> Msgs = string:tokens(Data," "), lists:foreach(fun(Msg) -> send(Msg,State), - timer:sleep(10) + ct:sleep(10) end, Msgs), send("\r\n> ",State), {ok,State}; @@ -284,15 +284,15 @@ send(Data,State) -> send_loop(T,Data,State) -> dbg("Server sending ~p in loop for ~w ms...~n",[Data,T]), - send_loop(now(),T,Data,State). + send_loop(os:timestamp(),T,Data,State). send_loop(T0,T,Data,State) -> - ElapsedMS = trunc(timer:now_diff(now(),T0)/1000), + ElapsedMS = trunc(timer:now_diff(os:timestamp(),T0)/1000), if ElapsedMS >= T -> ok; true -> send(Data,State), - timer:sleep(500), + ct:sleep(500), send_loop(T0,T,Data,State) end. @@ -314,7 +314,7 @@ dbg(_F,_A) -> io:format("[telnet_server, ~s]\n" ++ _F,[TS|_A]). timestamp() -> - {MS,S,US} = now(), + {MS,S,US} = os:timestamp(), {{Year,Month,Day}, {Hour,Min,Sec}} = calendar:now_to_local_time({MS,S,US}), MilliSec = trunc(US/1000), diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 2032392821..7c4cebdc28 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -159,6 +159,10 @@ $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $< +# Inlining core_parse is slow and has no benefit. +$(EBIN)/core_parse.beam: $(EGEN)/core_parse.erl + $(V_ERLC) $(subst +inline,,$(ERL_COMPILE_FLAGS)) -o$(EBIN) $< + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 92f09e400c..5216f39296 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -252,13 +252,6 @@ combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> %% opt([Instruction]) -> [Instruction] %% Optimize the instruction stream inside a basic block. -opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, - {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) -> - %% Get rid of the 'not' if the operation can be inverted. - case inverse_comp_op(Bif) of - none -> [I1,I2|opt(Is)]; - RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] - end; opt([{set,[X],[X],move}|Is]) -> opt(Is); opt([{set,_,_,{line,_}}=Line1, {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, @@ -428,18 +421,6 @@ x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. -%% inverse_comp_op(Op) -> none|RevOp - -inverse_comp_op('=:=') -> '=/='; -inverse_comp_op('=/=') -> '=:='; -inverse_comp_op('==') -> '/='; -inverse_comp_op('/=') -> '=='; -inverse_comp_op('>') -> '=<'; -inverse_comp_op('<') -> '>='; -inverse_comp_op('>=') -> '<'; -inverse_comp_op('=<') -> '>'; -inverse_comp_op(_) -> none. - %%% %%% Evaluation of constant bit fields. %%% diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index a452d30b61..5ed9c16d61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -787,6 +787,9 @@ is_not_used(R, Is, Label, #st{ll=Ll}) -> initialized_regs(Is) -> initialized_regs(Is, ordsets:new()). +initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) -> + Regs = add_init_regs(free_vars_regs(Live), Regs0), + add_init_regs(Dst, Regs); initialized_regs([{set,Dst,Src,_}|Is], Regs) -> initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); initialized_regs([{test,_,_,Src}|Is], Regs) -> diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 7cd07dc3be..f4515ba2a7 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -98,6 +98,12 @@ move_move_into_block([], Acc) -> reverse(Acc). forward(Is, Lc) -> forward(Is, gb_trees:empty(), Lc, []). +forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) -> + %% move/2 followed by jump/1 is optimized by backward/3. + forward([Move,{jump,{f,L}}|Is], D, Lc, Acc); +forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) -> + %% bif/4 followed by jump/1 is optimized by backward/3. + forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc); forward([{block,[]}|Is], D, Lc, Acc) -> %% Empty blocks can prevent optimizations. forward(Is, D, Lc, Acc); @@ -124,6 +130,8 @@ forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> _ -> Is0 %Keep move instruction. end, forward(Is, D, Lc, [LblI|Acc]); +forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> + forward(Is, D, Lc, Acc); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> forward([I,{block,Bl}|Is], D, Lc, Acc); @@ -234,10 +242,8 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> Fail = shortcut_bs_test(Fail1, Is, D), Sel = {select,select_val,Reg,{f,Fail},List}, backward(Is, D, [Sel|Acc]); -backward([{jump,{f,To0}},{move,Src0,Reg}|Is], D, Acc) -> - To1 = shortcut_select_label(To0, Reg, Src0, D), - {To,Src} = shortcut_boolean_label(To1, Reg, Src0, D), - Move = {move,Src,Reg}, +backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> + To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, case beam_utils:is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); @@ -330,16 +336,6 @@ shortcut_label(To0, D) -> shortcut_select_label(To, Reg, Lit, D) -> shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). -shortcut_boolean_label(To0, Reg, {atom,Bool0}=Lit, D) when is_boolean(Bool0) -> - case beam_utils:code_at(To0, D) of - [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> - Bool = {atom,not Bool0}, - {shortcut_select_label(To, Reg, Bool, D),Bool}; - _ -> - {To0,Lit} - end; -shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}. - %% Replace a comparison operator with a test instruction and a jump. %% For example, if we have this code: %% diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 97a8c7ba70..5abacc8d5d 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -108,14 +108,14 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> %% has succeeded. peep(Is, gb_sets:empty(), [I|Acc]); true -> - Test = {Op,Ops}, - case gb_sets:is_element(Test, SeenTests0) of + case is_test_redundant(Op, Ops, SeenTests0) of true -> - %% This test has already succeeded and + %% This test or a similar test has already succeeded and %% is therefore redundant. peep(Is, SeenTests0, Acc); false -> %% Remember that we have seen this test. + Test = {Op,Ops}, SeenTests = gb_sets:insert(Test, SeenTests0), peep(Is, SeenTests, [I|Acc]) end @@ -136,6 +136,15 @@ peep([I|Is], _, Acc) -> peep(Is, gb_sets:empty(), [I|Acc]); peep([], _, Acc) -> reverse(Acc). +is_test_redundant(Op, Ops, Seen) -> + gb_sets:is_element({Op,Ops}, Seen) orelse + is_test_redundant_1(Op, Ops, Seen). + +is_test_redundant_1(is_boolean, [R], Seen) -> + gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse + gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen); +is_test_redundant_1(_, _, _) -> false. + kill_seen(Dst, Seen0) -> gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)). diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 3d4b9ee0c6..ea960abc1a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -138,7 +138,8 @@ ]). -export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, - c_literal/0, c_map/0, c_map_pair/0, c_module/0, c_tuple/0, + c_let/0, c_literal/0, c_map/0, c_map_pair/0, + c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). -include("core_parse.hrl"). @@ -255,7 +256,7 @@ %% @see c_primop/2 %% @see c_receive/1 %% @see c_seq/2 -%% @see c_try/3 +%% @see c_try/5 %% @see c_tuple/1 %% @see c_values/1 %% @see c_var/1 @@ -1455,7 +1456,7 @@ is_proper_list(_) -> %% X4]</code>. %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_length/1 %% @see make_list/2 @@ -1486,7 +1487,7 @@ abstract_list([]) -> %% efficient.</p> %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_elements/1 @@ -1991,7 +1992,7 @@ update_c_fname(Node, Atom, Arity) -> %% %% @see c_fname/2 %% @see c_var/1 -%% @see c_var_name/1 +%% @see var_name/1 -spec is_c_fname(cerl()) -> boolean(). @@ -3669,7 +3670,7 @@ c_try(Expr, Vs, Body, Evs, Handler) -> %% @spec ann_c_try(As::[term()], Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec ann_c_try([term()], cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3682,7 +3683,7 @@ ann_c_try(As, Expr, Vs, Body, Evs, Handler) -> %% @spec update_c_try(Old::cerl(), Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec update_c_try(c_try(), cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3697,7 +3698,7 @@ update_c_try(Node, Expr, Vs, Body, Evs, Handler) -> %% @doc Returns <code>true</code> if <code>Node</code> is an abstract %% try-expression, otherwise <code>false</code>. %% -%% @see c_try/3 +%% @see c_try/5 -spec is_c_try(cerl()) -> boolean(). @@ -3711,7 +3712,7 @@ is_c_try(_) -> %% %% @doc Returns the expression subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_arg(c_try()) -> cerl(). @@ -3724,7 +3725,7 @@ try_arg(Node) -> %% @doc Returns the list of success variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_vars(c_try()) -> [cerl()]. @@ -3736,7 +3737,7 @@ try_vars(Node) -> %% %% @doc Returns the success body subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_body(c_try()) -> cerl(). @@ -3749,7 +3750,7 @@ try_body(Node) -> %% @doc Returns the list of exception variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_evars(c_try()) -> [cerl()]. @@ -3762,7 +3763,7 @@ try_evars(Node) -> %% @doc Returns the exception body subtree of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_handler(c_try()) -> cerl(). @@ -3784,7 +3785,7 @@ try_handler(Node) -> %% @see update_c_catch/2 %% @see is_c_catch/1 %% @see catch_body/1 -%% @see c_try/3 +%% @see c_try/5 -spec c_catch(cerl()) -> c_catch(). diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index b93da8e97f..f1bf0e02e7 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -19,7 +19,7 @@ %% @doc Basic functions on Core Erlang abstract syntax trees. %% %% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index f347438509..c45c9a1a29 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1295,8 +1295,9 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> list_to_binary([0,length(TypeString),TypeString,Bin]). random_bytes(N) -> - {A,B,C} = now(), - _ = random:seed(A, B, C), + _ = random:seed(erlang:time_offset(), + erlang:monotonic_time(), + erlang:unique_integer()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index fbaa7a96fe..2a40c1c379 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -69,5 +69,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-7.0", "crypto-3.3"]}]}. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ea1959d0f8..0d020578f5 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -96,7 +96,7 @@ t=[], %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool'. +-type type_info() :: cerl:cerl() | 'bool' | 'integer'. -type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. -type sub() :: #sub{}. @@ -297,7 +297,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> Seq0#c_seq{arg=Arg,body=B1} end end; -expr(#c_let{}=Let, Ctxt, Sub) -> +expr(#c_let{}=Let0, Ctxt, Sub) -> + Let = opt_case_in_let(Let0), case simplify_let(Let, Sub) of impossible -> %% The argument for the let is "simple", i.e. has no @@ -829,16 +830,16 @@ eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> maybe -> Call; no -> #c_literal{val=false} end; -eval_rel_op(Call, '==', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '==', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, Call#c_call{name=Name}; false -> Call end; -eval_rel_op(Call, '/=', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '/=', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, Call#c_call{name=Name}; @@ -847,11 +848,17 @@ eval_rel_op(Call, '/=', Ops, _Sub) -> end; eval_rel_op(Call, _, _, _) -> Call. -is_exact_eq_ok([#c_literal{val=Lit}|_]) -> +is_exact_eq_ok([A,B]=L, Sub) -> + case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of + true -> true; + false -> is_exact_eq_ok_1(L) + end. + +is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> is_non_numeric(Lit); -is_exact_eq_ok([_|T]) -> - is_exact_eq_ok(T); -is_exact_eq_ok([]) -> false. +is_exact_eq_ok_1([_|T]) -> + is_exact_eq_ok_1(T); +is_exact_eq_ok_1([]) -> false. is_non_numeric([H|T]) -> is_non_numeric(H) andalso is_non_numeric(T); @@ -963,7 +970,7 @@ eval_element(Call, #c_literal{val=Pos}, Tuple, Types) 1 =< Pos, Pos =< length(Es) -> El = lists:nth(Pos, Es), try - pat_to_expr(El) + cerl:set_ann(pat_to_expr(El), [compiler_generated]) catch throw:impossible -> Call @@ -1008,28 +1015,32 @@ eval_is_record(Call, _, _, _, _) -> Call. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. %% Evaluates setelement/3 if position Pos is an integer -%% the shape of the tuple Tuple is known. +%% and the shape of the tuple Tuple is known. %% -eval_setelement(Call, Pos, Tuple, NewVal) -> - try - eval_setelement_1(Pos, Tuple, NewVal) - catch - error:_ -> - Call - end. - -eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal) - when is_integer(Pos) -> - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)); -eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal) +eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) when is_integer(Pos) -> - Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)], - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)). + case cerl:is_data(Tuple) of + false -> + Call; + true -> + Es0 = case cerl:is_c_tuple(Tuple) of + false -> []; + true -> cerl:tuple_es(Tuple) + end, + if + 1 =< Pos, Pos =< length(Es0) -> + Es = eval_setelement_1(Pos, Es0, NewVal), + cerl:update_c_tuple(Tuple, Es); + true -> + eval_failure(Call, badarg) + end + end; +eval_setelement(Call, _, _, _) -> Call. -eval_setelement_2(1, [_|T], NewVal) -> +eval_setelement_1(1, [_|T], NewVal) -> [NewVal|T]; -eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_2(Pos-1, T, NewVal)]. +eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> + [H|eval_setelement_1(Pos-1, T, NewVal)]. %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with @@ -1955,46 +1966,125 @@ letify(Bs, Body) -> cerl:ann_c_let(Ann, [V], Val, B) end, Body, Bs). -%% opt_case_in_let(LetExpr) -> LetExpr' +%% opt_not_in_let(Let) -> Cerl +%% Try to optimize away a 'not' operator in a 'let'. -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> - opt_case_in_let_0(Vs, Arg, B, Let, Sub). +-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl(). -opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> - case opt_case_in_let_1(V, Arg, Cs) of - impossible -> - case is_simple_case_arg(Arg) andalso - not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of - true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); - false -> - Let +opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) -> + case opt_not_in_let(Vs0, Arg0, Body0) of + {[],#c_values{es=[]},Body} -> + Body; + {Vs,Arg,Body} -> + Let#c_let{vars=Vs,arg=Arg,body=Body} + end; +opt_not_in_let(Let) -> Let. + +%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'} +%% Try to optimize away a 'not' operator in a 'let'. + +-spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) -> + {[cerl:c_var()],cerl:cerl(),cerl:cerl()}. + +opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) -> + case cerl:type(Body0) of + call -> + %% let <V> = Expr in not V ==> + %% let <> = <> in notExpr + case opt_not_in_let_1(V, Body0, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Body} -> + {[],#c_values{es=[]},Body} end; - Expr -> Expr + 'let' -> + %% let <V> = Expr in let <Var> = not V in Body ==> + %% let <Var> = notExpr in Body + %% V must not be used in Body. + LetArg = cerl:let_arg(Body0), + case opt_not_in_let_1(V, LetArg, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Arg} -> + LetBody = cerl:let_body(Body0), + case core_lib:is_var_used(V, LetBody) of + true -> + {Vs0,Arg0,Body0}; + false -> + LetVars = cerl:let_vars(Body0), + {LetVars,Arg,LetBody} + end + end; + _ -> + {Vs0,Arg0,Body0} end; -opt_case_in_let_0(_, _, _, Let, _) -> Let. - -opt_case_in_let_1(V, Arg, Cs) -> - try - opt_case_in_let_2(V, Arg, Cs) - catch - _:_ -> impossible +opt_not_in_let(Vs, Arg, Body) -> + {Vs,Arg,Body}. + +opt_not_in_let_1(V, Call, Body) -> + case Call of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=[#c_var{name=V}]} -> + opt_not_in_let_2(Body); + _ -> + no end. -opt_case_in_let_2(V, Arg0, - [#c_clause{pats=[#c_tuple{es=Es}], - guard=#c_literal{val=true},body=B}|_]) -> +opt_not_in_let_2(#c_case{clauses=Cs0}=Case) -> + Vars = make_vars([], 1), + Body = #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=Vars}, + Cs = [begin + Let = #c_let{vars=Vars,arg=B,body=Body}, + C#c_clause{body=opt_not_in_let(Let)} + end || #c_clause{body=B}=C <- Cs0], + {yes,Case#c_case{clauses=Cs}}; +opt_not_in_let_2(#c_call{}=Call0) -> + invert_call(Call0); +opt_not_in_let_2(_) -> no. + +invert_call(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name0}, + args=[_,_]}=Call) -> + case inverse_rel_op(Name0) of + no -> no; + Name -> {yes,Call#c_call{name=#c_literal{val=Name}}} + end; +invert_call(#c_call{}) -> no. + +%% inverse_rel_op(Op) -> no | RevOp + +inverse_rel_op('=:=') -> '=/='; +inverse_rel_op('=/=') -> '=:='; +inverse_rel_op('==') -> '/='; +inverse_rel_op('/=') -> '=='; +inverse_rel_op('>') -> '=<'; +inverse_rel_op('<') -> '>='; +inverse_rel_op('>=') -> '<'; +inverse_rel_op('=<') -> '>'; +inverse_rel_op(_) -> no. - %% In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end. - %% avoid building tuples, by converting tuples to multiple values. - %% (The optimisation is not done if the built tuple is used or returned.) - true = all(fun (#c_var{}) -> true; - (_) -> false end, Es), %Only variables in tuple - false = core_lib:is_var_used(V, B), %Built tuple must not be used. - Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail. - #c_let{vars=Es,arg=Arg1,body=B}. +%% opt_bool_case_in_let(LetExpr, Sub) -> Core + +opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_1(Vs, Arg, B, Let, Sub). + +opt_case_in_let_1([#c_var{name=V}], Arg, + #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> + case is_simple_case_arg(Arg) of + true -> + Case = opt_bool_case(Case0#c_case{arg=Arg}), + case core_lib:is_var_used(V, Case) of + false -> expr(Case, sub_new(Sub)); + true -> Let + end; + false -> + Let + end; +opt_case_in_let_1(_, _, _, Let, _) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2036,7 +2126,7 @@ is_bool_expr(#c_clause{body=B}, Sub) -> is_bool_expr(B, Sub); is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [#c_literal{val=true}], Sub0); + true -> update_types(V, [bool], Sub0); false -> Sub0 end, is_bool_expr(B, Sub); @@ -2122,38 +2212,6 @@ is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> end; is_safe_bool_expr_list([], _, _) -> true. -%% tuple_to_values(Expr, TupleArity) -> Expr' -%% Convert tuples in return position of arity TupleArity to values. -%% Throws an exception for constructs that are not handled. - -tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity -> - core_lib:make_values(Es); -tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity -> - Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)], - core_lib:make_values(Es); -tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) -> - Cs1 = [tuple_to_values(E, Arity) || E <- Cs0], - Case#c_case{clauses=Cs1}; -tuple_to_values(#c_seq{body=B0}=Seq, Arity) -> - Seq#c_seq{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_let{body=B0}=Let, Arity) -> - Let#c_let{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) -> - Cs = [tuple_to_values(E, Arity) || E <- Cs0], - A = case Timeout of - #c_literal{val=infinity} -> A0; - _ -> tuple_to_values(A0, Arity) - end, - Rec#c_receive{clauses=Cs,action=A}; -tuple_to_values(#c_clause{body=B0}=Clause, Arity) -> - B = tuple_to_values(B0, Arity), - Clause#c_clause{body=B}; -tuple_to_values(Expr, _) -> - case will_fail(Expr) of - true -> Expr; - false -> erlang:error({not_handled,Expr}) - end. - %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such %% as a let or a sequence, move the original let body into the complex @@ -2180,7 +2238,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Arg = body(Arg0, Sub0), ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}), {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0), - + OuterBody = body(OuterBody0, ScopeSub), {InnerVs,Sub} = pattern_list(InnerVs0, Sub0), @@ -2258,50 +2316,179 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> will_fail(B). +%% opt_case_in_let(Let) -> Let' +%% Try to avoid building tuples that are immediately matched. +%% A common pattern is: +%% +%% {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end +%% +%% In Core Erlang the pattern would look like this: +%% +%% let <V> = case E of +%% ... -> ... {Val1,Val2} +%% ... +%% end, +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Rewrite this to: +%% +%% let <V1,V2> = case E of +%% ... -> ... <Val1,Val2> +%% ... +%% end, +%% in +%% let <V> = {V1,V2} +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Note that the second 'case' is unchanged. The other optimizations +%% in this module will eliminate the building of the tuple and +%% rewrite the second case to: +%% +%% case <V1,V2> of +%% <A,B> -> ... <use A and B> ... +%% end +%% + +opt_case_in_let(#c_let{vars=Vs,arg=Arg0,body=B}=Let0) -> + case matches_data(Vs, B) of + {yes,TypeSig} -> + case delay_build(Arg0, TypeSig) of + no -> + Let0; + {yes,Vars,Arg,Data} -> + InnerLet = Let0#c_let{arg=Data}, + Let0#c_let{vars=Vars,arg=Arg,body=InnerLet} + end; + no -> + Let0 + end. + +matches_data([#c_var{name=V}], #c_case{arg=#c_var{name=V}, + clauses=[#c_clause{pats=[P]}|_]}) -> + case cerl:is_data(P) of + false -> + no; + true -> + case cerl:data_type(P) of + {atomic,_} -> + no; + Type -> + {yes,{Type,cerl:data_arity(P)}} + end + end; +matches_data(_, _) -> no. + +delay_build(Core, TypeSig) -> + case cerl:is_data(Core) of + true -> no; + false -> delay_build_1(Core, TypeSig) + end. + +delay_build_1(Core0, TypeSig) -> + try delay_build_expr(Core0, TypeSig) of + Core -> + {Type,Arity} = TypeSig, + Vars = make_vars([], Arity), + Data = cerl:ann_make_data([compiler_generated], Type, Vars), + {yes,Vars,Core,Data} + catch + throw:impossible -> + no + end. + +delay_build_cs([#c_clause{body=B0}=C0|Cs], TypeSig) -> + B = delay_build_expr(B0, TypeSig), + C = C0#c_clause{body=B}, + [C|delay_build_cs(Cs, TypeSig)]; +delay_build_cs([], _) -> []. + +delay_build_expr(Core, {Type,Arity}=TypeSig) -> + case cerl:is_data(Core) of + false -> + delay_build_expr_1(Core, TypeSig); + true -> + case {cerl:data_type(Core),cerl:data_arity(Core)} of + {Type,Arity} -> + core_lib:make_values(cerl:data_es(Core)); + {_,_} -> + throw(impossible) + end + end. + +delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + Case#c_case{clauses=Cs}; +delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Let#c_let{body=B}; +delay_build_expr_1(#c_receive{clauses=Cs0, + timeout=Timeout, + action=A0}=Rec, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + A = case Timeout of + #c_literal{val=infinity} -> A0; + _ -> delay_build_expr(A0, TypeSig) + end, + Rec#c_receive{clauses=Cs,action=A}; +delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Seq#c_seq{body=B}; +delay_build_expr_1(Core, _TypeSig) -> + case will_fail(Core) of + true -> Core; + false -> throw(impossible) + end. + %% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm %% Optimize a let construct that does not contain any lets in %% in its argument. -opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) -> - Arg = body(Arg0, value, Sub0), %This is a body +opt_simple_let(Let0, Ctxt, Sub) -> + case opt_not_in_let(Let0) of + #c_let{}=Let -> + opt_simple_let_0(Let, Ctxt, Sub); + Expr -> + expr(Expr, Ctxt, Sub) + end. + +opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> + Arg = body(Arg0, value, Sub), %This is a body case will_fail(Arg) of true -> Arg; - false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0) + false -> opt_simple_let_1(Let, Arg, Ctxt, Sub) end. opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. - {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), - BodySub = case {Vs,Args} of - {[V],[A]} -> - case is_bool_expr(A, Sub0) of - true -> - update_types(V, [#c_literal{val=true}], Sub1); - false -> - Sub1 - end; - {_,_} -> Sub1 - end, - B = body(B0, Ctxt, BodySub), - Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1). - -opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> + {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), + BodySub = update_let_types(Vs1, Args, Sub1), + B1 = body(B0, Ctxt, BodySub), + Arg1 = core_lib:make_values(Args), + {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1), + opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg,#c_var{name=N2}} -> + {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> case N1 =:= N2 of true -> %% let <Var> = Arg in <Var> ==> Arg - Arg; + Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)) end; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {_,Arg,#c_literal{}} -> + {Vs,Arg1,#c_literal{}} -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), E = case Ctxt of effect -> %% Throw away the literal body. @@ -2313,22 +2500,50 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> #c_seq{arg=Arg,body=Body} end, expr(E, Ctxt, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> + {Vs,Arg1,Body} -> %% If none of the variables are used in the body, we can %% rewrite the let to a sequence: %% let <Var> = Arg in BodyWithoutVar ==> %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - Let2 = opt_case_in_let(Let1, Sub), + Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, + Let2 = opt_bool_case_in_let(Let1, Sub), opt_case_in_let_arg(Let2, Ctxt, Sub) end end. +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% Try to suppress false warnings when a variable is not used. +%% For instance, we don't expect a warning for useless building in: +%% +%% R = #r{}, %No warning expected. +%% R#r.f %Optimization would remove the reference to R. +%% +%% To avoid false warnings, we will check whether the variables were +%% referenced in the original unoptimized code. If they were, we will +%% consider the warning false and suppress it. + +maybe_suppress_warnings(Arg, _, _, effect) -> + %% Don't suppress any warnings in effect context. + Arg; +maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> + case suppress_warning(Arg) of + true -> + Arg; %Already suppressed. + false -> + case is_any_var_used(Vs, PrevBody) of + true -> + cerl:set_ann(Arg, [compiler_generated]); + false -> + Arg + end + end. + move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, body=InnerArg0}=Outer, clauses=InnerClauses}=Inner, Sub) -> @@ -2416,7 +2631,7 @@ move_case_into_arg(_, _) -> %% <> when 'true' -> %% let <Var> = Literal2 in LetBody %% end -%% +%% %% In the worst case, the size of the code could increase. %% In practice, though, substituting the literals into %% LetBody and doing constant folding will decrease the code @@ -2490,6 +2705,7 @@ is_boolean_type(Var, Sub) -> is_int_type(Var, Sub) -> case get_type(Var, Sub) of none -> maybe; + integer -> yes; C -> yes_no(cerl:is_c_int(C)) end. @@ -2504,8 +2720,58 @@ is_tuple_type(Var, Sub) -> yes_no(true) -> yes; yes_no(false) -> no. +%%% +%%% Update type information. +%%% + +update_let_types(Vs, Args, Sub) when is_list(Args) -> + update_let_types_1(Vs, Args, Sub); +update_let_types(_Vs, _Arg, Sub) -> + %% The argument is a complex expression (such as a 'case') + %% that returns multiple values. + Sub. + +update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> + Sub = update_types_from_expr(V, A, Sub0), + update_let_types_1(Vs, As, Sub); +update_let_types_1([], [], Sub) -> Sub. + +update_types_from_expr(V, Expr, Sub) -> + Type = extract_type(Expr, Sub), + update_types(V, [Type], Sub). + +extract_type(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name}, + args=Args}=Call, Sub) -> + case returns_integer(Name, Args) of + true -> integer; + false -> extract_type_1(Call, Sub) + end; +extract_type(Expr, Sub) -> + extract_type_1(Expr, Sub). + +extract_type_1(Expr, Sub) -> + case is_bool_expr(Expr, Sub) of + false -> Expr; + true -> bool + end. + +returns_integer(bit_size, [_]) -> true; +returns_integer('bsl', [_,_]) -> true; +returns_integer('bsr', [_,_]) -> true; +returns_integer(byte_size, [_]) -> true; +returns_integer(length, [_]) -> true; +returns_integer('rem', [_,_]) -> true; +returns_integer(size, [_]) -> true; +returns_integer(tuple_size, [_]) -> true; +returns_integer(trunc, [_]) -> true; +returns_integer(_, _) -> false. + %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. + +-spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). + update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> Tdb = update_types_1(Expr, Pat, Tdb0), Sub#sub{t=Tdb}. @@ -2525,6 +2791,8 @@ update_types_2(V, [#c_tuple{}=P], Types) -> orddict:store(V, P, Types); update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> orddict:store(V, bool, Types); +update_types_2(V, [Type], Types) when is_atom(Type) -> + orddict:store(V, Type, Types); update_types_2(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' @@ -2791,7 +3059,7 @@ bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) -> bsm_problem(P, bin_partition) end; bsm_ensure_no_partition_after([], _) -> ok. - + bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); bsm_could_match_binary(#c_cons{}) -> false; bsm_could_match_binary(#c_tuple{}) -> false; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index cbe50b93b0..7eec9dd62b 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -69,10 +69,8 @@ stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] -module({Mod,Exp,Attr,Forms}, Options) -> - put(?MODULE, Options), +module({Mod,Exp,Attr,Forms}, _Options) -> {Fs,St} = functions(Forms, {atom,Mod}), - erase(?MODULE), {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. functions(Forms, AtomMod) -> @@ -924,7 +922,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 3c19a209c0..c954d21e59 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -78,7 +78,7 @@ splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). --import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, +-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1, ann_c_map/3]). -include("core_parse.hrl"). @@ -1660,48 +1660,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> %% pat_alias(CorePat, CorePat) -> AliasPat. %% Normalise aliases. Trap bad aliases by throwing 'nomatch'. -pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; -pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; - -%% alias cons -pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> - pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T})); -pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> - pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T}), Cons); -pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> - ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); - -%% alias tuples -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> - Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> - Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); - -%% alias maps -%% There are no literals in maps patterns (patterns are always abstract) -pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> - M#c_map{es=pat_alias_map_pairs(Es1++Es2)}; - -pat_alias(#c_alias{var=V1,pat=P1}, - #c_alias{var=V2,pat=P2}) -> - if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; - true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}} +pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P; +pat_alias(#c_var{name=V1}=Var, + #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) -> + if + V1 =:= V2 -> + Alias; + true -> + Alias#c_alias{pat=pat_alias(Var, Pat)} + end; +pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2}; + +pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) -> + Alias; +pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1}, + #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) -> + Pat = pat_alias(P1, P2), + if + V1 =:= V2 -> + #c_alias{var=Var1,pat=Pat}; + true -> + pat_alias(Var1, pat_alias(Var2, Pat)) end; -pat_alias(#c_alias{var=V1,pat=P1}, P2) -> - #c_alias{var=V1,pat=pat_alias(P1, P2)}; -pat_alias(P1, #c_alias{var=V2,pat=P2}) -> - #c_alias{var=V2,pat=pat_alias(P1, P2)}; +pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) -> + #c_alias{var=Var,pat=pat_alias(P1, P2)}; + +pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)}; + +pat_alias(P1, #c_var{}=Var) -> + #c_alias{var=Var,pat=P1}; +pat_alias(P1, #c_alias{pat=P2}=Alias) -> + Alias#c_alias{pat=pat_alias(P1, P2)}; + pat_alias(P1, P2) -> - case {set_anno(P1, []),set_anno(P2, [])} of - {P,P} -> P; + %% Aliases between binaries are not allowed, so the only + %% legal patterns that remain are data patterns. + case cerl:is_data(P1) andalso cerl:is_data(P2) of + false -> throw(nomatch); + true -> ok + end, + Type = cerl:data_type(P1), + case cerl:data_type(P2) of + Type -> ok; _ -> throw(nomatch) - end. + end, + Es1 = cerl:data_es(P1), + Es2 = cerl:data_es(P2), + Es = pat_alias_list(Es1, Es2), + cerl:make_data(Type, Es). %% pat_alias_list([A1], [A2]) -> [A]. diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index cd4b5fd674..75bd188479 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -270,7 +270,7 @@ match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) -> end, Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts], - #l{ke={select,literal2(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; + #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs], @@ -297,7 +297,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> _ -> Ctxt0 end, B = match(Kb, Ls1, I+1, Ctxt, Vdb1), - #l{ke={val_clause,literal2(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. + #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), @@ -350,6 +350,7 @@ atomic_list(Ks) -> [atomic(K) || K <- Ks]. %% literal_list([Klit]) -> [Lit]. literal(#k_var{name=N}, _) -> {var,N}; +literal(#k_literal{val=I}, _) -> {literal,I}; literal(#k_int{val=I}, _) -> {integer,I}; literal(#k_float{val=F}, _) -> {float,F}; literal(#k_atom{val=N}, _) -> {atom,N}; @@ -358,58 +359,29 @@ literal(#k_nil{}, _) -> nil; literal(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; literal(#k_binary{segs=V}, Ctxt) -> - {binary,literal(V, Ctxt)}; + {binary,literal(V, Ctxt)}; +literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> + %% Only occurs in patterns. + {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]}; literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs, [literal(Seg, Ctxt),literal(N, Ctxt)]}; +literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> + %% Only occurs in patterns. + {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int, + [literal(N, Ctxt)]}; literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> - {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)}; literal(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal(K, Ctxt),literal(V, Ctxt)}; -literal(#k_literal{val=V}, _Ctxt) -> - {literal,V}. + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}. literal_list(Ks, Ctxt) -> [literal(K, Ctxt) || K <- Ks]. -literal2(#k_var{name=N}, _) -> {var,N}; -literal2(#k_literal{val=I}, _) -> {literal,I}; -literal2(#k_int{val=I}, _) -> {integer,I}; -literal2(#k_float{val=F}, _) -> {float,F}; -literal2(#k_atom{val=N}, _) -> {atom,N}; -%%literal2(#k_char{val=C}, _) -> {char,C}; -literal2(#k_nil{}, _) -> nil; -literal2(#k_cons{hd=H,tl=T}, Ctxt) -> - {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]}; -literal2(#k_binary{segs=V}, Ctxt) -> - {binary,literal2(V, Ctxt)}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,[literal2(Seg, Ctxt)]}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs, - [literal2(Seg, Ctxt),literal2(N, Ctxt)]}; -literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> - {bin_int,Ctxt,literal2(S, Ctxt),U,Fs,Int, - [literal2(N, Ctxt)]}; -literal2(#k_bin_end{}, Ctxt) -> - {bin_end,Ctxt}; -literal2(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list2(Es, Ctxt)}; -literal2(#k_map{op=Op,es=Es}, Ctxt) -> - {map,Op,literal_list2(Es, Ctxt)}; -literal2(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. - -literal_list2(Ks, Ctxt) -> - [literal2(K, Ctxt) || K <- Ks]. - -%% literal_bin(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) -> -%% {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]} - %% is_gc_bif(Name, Arity) -> true|false %% Determines whether the BIF Name/Arity might do a GC. diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 3199440d84..4d7f444c4f 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -370,6 +370,11 @@ combined(Config) when is_list(Config) -> ?line true = ?COMB(false, blurf, true), ?line true = ?COMB(true, true, blurf), + false = simple_comb(false, false), + false = simple_comb(false, true), + false = simple_comb(true, false), + true = simple_comb(true, true), + ok. -undef(COMB). @@ -396,6 +401,13 @@ comb(A, B, C) -> end, id(Res). +simple_comb(A, B) -> + %% Use Res twice, to ensure that a careless optimization of 'not' + %% doesn't leave Res as a free variable. + Res = A andalso B, + _ = id(not Res), + Res. + %% Test that a boolean expression in a case expression is properly %% optimized (in particular, that the error behaviour is correct). in_case(Config) when is_list(Config) -> diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 512aada203..bc82eaf5aa 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -88,6 +88,7 @@ t_element(Config) when is_list(Config) -> {_,_,_}=Tup -> ?line {'EXIT',{badarg,_}} = (catch element(4, Tup)) end, + {'EXIT',{badarg,_}} = (catch element(1, tuple_size(Tuple))), ok. @@ -106,6 +107,7 @@ setelement(Config) when is_list(Config) -> ?line error = setelement_crash_2({a,b,c,d,e,f}, <<42>>), {'EXIT',{badarg,_}} = (catch setelement(1, not_a_tuple, New)), + {'EXIT',{badarg,_}} = (catch setelement(3, {a,b}, New)), ok. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index cfa8262701..1c9574c2a2 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -543,7 +543,7 @@ t_map_sort_literals(Config) when is_list(Config) -> 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}), + true = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}), %% value order diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 7522ee985f..9aec0b3d4e 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -141,6 +141,13 @@ aliases(Config) when is_list(Config) -> ?line {a,b} = list_alias2([a,b]), ?line {a,b} = list_alias3([a,b]), + %% Non-matching aliases. + none = mixed_aliases(<<42>>), + none = mixed_aliases([b]), + none = mixed_aliases([d]), + none = mixed_aliases({a,42}), + none = mixed_aliases(42), + ok. str_alias(V) -> @@ -244,6 +251,12 @@ list_alias2([X,Y]=[a,b]) -> list_alias3([X,b]=[a,Y]) -> {X,Y}. +mixed_aliases(<<X:8>> = x) -> {a,X}; +mixed_aliases([b] = <<X:8>>) -> {b,X}; +mixed_aliases(<<X:8>> = {a,X}) -> {c,X}; +mixed_aliases([X] = <<X:8>>) -> {d,X}; +mixed_aliases(_) -> none. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index dcd3910926..d0b7c71be8 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -39,7 +39,7 @@ guard/1,bad_arith/1,bool_cases/1,bad_apply/1, files/1,effect/1,bin_opt_info/1,bin_construction/1, comprehensions/1,maps/1,redundant_boolean_clauses/1, - latin1_fallback/1,underscore/1]). + latin1_fallback/1,underscore/1,no_warnings/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(2)). @@ -65,7 +65,7 @@ groups() -> bad_arith,bool_cases,bad_apply,files,effect, bin_opt_info,bin_construction,comprehensions,maps, redundant_boolean_clauses,latin1_fallback, - underscore]}]. + underscore,no_warnings]}]. init_per_suite(Config) -> Config. @@ -281,7 +281,6 @@ bad_arith(Config) when is_list(Config) -> {3,sys_core_fold,{eval_failure,badarith}}, {9,sys_core_fold,nomatch_guard}, {9,sys_core_fold,{eval_failure,badarith}}, - {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, {10,sys_core_fold,nomatch_guard}, {10,sys_core_fold,{eval_failure,badarith}}, {15,sys_core_fold,{eval_failure,badarith}} @@ -719,6 +718,27 @@ underscore(Config) when is_list(Config) -> ok. +no_warnings(Config) when is_list(Config) -> + Ts = [{no_warnings, + <<"-record(r, {s=ordsets:new(),a,b}). + + a() -> + R = #r{}, %No warning expected. + {R#r.a,R#r.b}. + + b(X) -> + T = true, + Var = [X], %No warning expected. + case T of + false -> Var; + true -> [] + end. + ">>, + [], + []}], + run(Config, Ts), + ok. + %%% %%% End of test cases. %%% diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index e525484a8e..b114d29f44 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -494,7 +494,7 @@ t_map_sort_literals(Config) when is_list(Config) -> true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), - false = #{ 1 => 1 } < id(#{ 1.0 => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), false = #{ 1.0 => 1 } < id(#{ 1 => 1}), %% value order @@ -587,12 +587,11 @@ t_bif_map_is_key(Config) when is_list(Config) -> t_bif_map_keys(Config) when is_list(Config) -> [] = maps:keys(#{}), - [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), - % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, - [4,int,"hi",<<"key">>] = maps:keys(M1), + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), %% error case {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)), @@ -634,40 +633,39 @@ t_bif_map_merge(Config) when is_list(Config) -> ok. - t_bif_map_put(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number, 18446744073709551629 => wat}, M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), - ["hi"] = maps:keys(M1), - ["hello"] = maps:values(M1), + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), M2 = #{ int := 3 } = maps:put(int, 3, M1), - [int,"hi"] = maps:keys(M2), - [3,"hello"] = maps:values(M2), + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), - [int,"hi",<<"key">>] = maps:keys(M3), - [3,"hello",<<"value">>] = maps:values(M3), + true = is_members([int,"hi",<<"key">>],maps:keys(M3)), + true = is_members([3,"hello",<<"value">>],maps:values(M3)), M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), - [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4), - [wat,3,"hello",<<"value">>] = maps:values(M4), + true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)), + true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)), M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5), - [number,wat,3,"hello",<<"value">>] = maps:values(M5), + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)), + true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)), M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6), - [number,wat,3,"hello",<<"other value">>] = maps:values(M6), + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)), + true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)), %% error case {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)), @@ -675,46 +673,16 @@ t_bif_map_put(Config) when is_list(Config) -> {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)), {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])), {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)), - ok. - -t_bif_map_remove(Config) when is_list(Config) -> - 0 = erlang:map_size(maps:remove(some_key, #{})), - - M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, - 4 => number, 18446744073709551629 => wat}, - - M1 = maps:remove("hi", M0), - [4,18446744073709551629,int,<<"key">>] = maps:keys(M1), - [number,wat,3,<<"value">>] = maps:values(M1), - - M2 = maps:remove(int, M1), - [4,18446744073709551629,<<"key">>] = maps:keys(M2), - [number,wat,<<"value">>] = maps:values(M2), - - M3 = maps:remove(<<"key">>, M2), - [4,18446744073709551629] = maps:keys(M3), - [number,wat] = maps:values(M3), - - M4 = maps:remove(18446744073709551629, M3), - [4] = maps:keys(M4), - [number] = maps:values(M4), - - M5 = maps:remove(4, M4), - [] = maps:keys(M5), - [] = maps:values(M5), + ok. - M0 = maps:remove(5,M0), - M0 = maps:remove("hi there",M0), +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). - #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). - %% error case - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), - ok. t_bif_map_update(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, @@ -742,20 +710,57 @@ t_bif_map_update(Config) when is_list(Config) -> ok. +t_bif_map_remove(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:remove(some_key, #{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = maps:remove("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + + M2 = maps:remove(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + + M3 = maps:remove(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + M4 = maps:remove(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + + M5 = maps:remove(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + + M0 = maps:remove(5,M0), + M0 = maps:remove("hi there",M0), + + #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), + + %% error case + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), + {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), + ok. t_bif_map_values(Config) when is_list(Config) -> [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), - [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), - % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, - [number,3,"hello2",<<"value2">>] = maps:values(M2), - [number,3,"hello",<<"value">>] = maps:values(M1), + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), %% error case {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)), @@ -764,75 +769,74 @@ t_bif_map_values(Config) when is_list(Config) -> {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), ok. + + t_erlang_hash(Config) when is_list(Config) -> ok = t_bif_erlang_phash2(), ok = t_bif_erlang_phash(), ok = t_bif_erlang_hash(), - ok. t_bif_erlang_phash2() -> - 39679005 = erlang:phash2(#{}), - 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), - 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), - 14363616 = erlang:phash2(#{ 1 => a }), - 51612236 = erlang:phash2(#{ a => 1 }), + 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764 + 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230 + 108954384 = erlang:phash2(#{ 1 => a }), % 14363616 + 59617982 = erlang:phash2(#{ a => 1 }), % 51612236 - 37468437 = erlang:phash2(#{{} => <<>>}), - 44049159 = erlang:phash2(#{<<>> => {}}), + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 118679416 = erlang:phash2(M0), - 51612236 = erlang:phash2(M1), - 118679416 = erlang:phash2(M2), + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 ok. t_bif_erlang_phash() -> Sz = 1 bsl 32, - 268440612 = erlang:phash(#{},Sz), - 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 1394238263 = erlang:phash(#{ 1 => a },Sz), - 4066388227 = erlang:phash(#{ a => 1 },Sz), + 1113425985 = erlang:phash(#{},Sz), % 268440612 + 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908 + 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064 + 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263 + 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227 - 1578050717 = erlang:phash(#{{} => <<>>},Sz), - 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 3590546636 = erlang:phash(M0,Sz), - 4066388227 = erlang:phash(M1,Sz), - 3590546636 = erlang:phash(M2,Sz), + 2620391445 = erlang:phash(M0,Sz), % 3590546636 + 1670235874 = erlang:phash(M1,Sz), % 4066388227 + 2620391445 = erlang:phash(M2,Sz), % 3590546636 ok. t_bif_erlang_hash() -> Sz = 1 bsl 27 - 1, - 5158 = erlang:hash(#{},Sz), - 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 126071654 = erlang:hash(#{ 1 => a },Sz), - 126426236 = erlang:hash(#{ a => 1 },Sz), + 39684169 = erlang:hash(#{},Sz), % 5158 + 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 + 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 + 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 + 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 - 101655720 = erlang:hash(#{{} => <<>>},Sz), - 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken + 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 + 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 38260486 = erlang:hash(M0,Sz), - 126426236 = erlang:hash(M1,Sz), - 38260486 = erlang:hash(M2,Sz), + 70254632 = erlang:hash(M0,Sz), % 38260486 + 59623150 = erlang:hash(M1,Sz), % 126426236 + 70254632 = erlang:hash(M2,Sz), % 38260486 ok. - t_map_encode_decode(Config) when is_list(Config) -> <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), Pairs = [ @@ -895,39 +899,42 @@ t_map_encode_decode(Config) when is_list(Config) -> map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> M1 = maps:put(K,V,M0), B0 = erlang:term_to_binary(M1), - Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), - %% sort Ks and Vs according to term spec, then match it - KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls), - ok = match_encoded_map(B0, length(Ls), KVbins), + Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs], + ok = match_encoded_map(B0, length(Ls), Ls), %% decode and match it M1 = erlang:binary_to_term(B0), map_encode_decode_and_match(Pairs,Ls,M1); map_encode_decode_and_match([],_,_) -> ok. match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> - match_encoded_map(Encoded,Items); + match_encoded_map_stripped_size(Encoded,Items,Items); match_encoded_map(_,_,_) -> no_match_size. -match_encoded_map(<<>>,[]) -> ok; -match_encoded_map(Bin,[<<131,Item/binary>>|Items]) -> - Size = erlang:byte_size(Item), - <<EncodedTerm:Size/binary, Bin1/binary>> = Bin, - EncodedTerm = Item, %% Asssert - match_encoded_map(Bin1,Items). +match_encoded_map_stripped_size(<<>>,_,_) -> ok; +match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) -> + Ksz = byte_size(K), + Vsz = byte_size(V), + case B0 of + <<K:Ksz/binary,V:Vsz/binary,B1/binary>> -> + match_encoded_map_stripped_size(B1,Ls,Ls); + _ -> + match_encoded_map_stripped_size(B0,Items,Ls) + end; +match_encoded_map_stripped_size(_,[],_) -> fail. t_bif_map_to_list(Config) when is_list(Config) -> [] = maps:to_list(#{}), - [{a,1},{b,2}] = maps:to_list(#{a=>1,b=>2}), - [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}), - [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}), - - [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, - <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10}), + [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})), + [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})), + + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})), %% error cases {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))), diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 1756800c4f..7b2e1d4a9d 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -46,5 +46,5 @@ {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.0", - "kernel-3.0","hipe-3.10.3","erts-6.0", + "kernel-3.0","hipe-3.10.3","erts-7.0", "compiler-5.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 336b4641d4..48d1ab9ebc 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -3519,6 +3519,7 @@ find_terminals(Tree) -> 'let' -> find_terminals(cerl:let_body(Tree)); letrec -> find_terminals(cerl:letrec_body(Tree)); literal -> {false, true}; + map -> {false, true}; primop -> {false, false}; %% match_fail, etc. are not explicit exits. 'receive' -> Timeout = cerl:receive_timeout(Tree), diff --git a/lib/dialyzer/src/dialyzer_timing.erl b/lib/dialyzer/src/dialyzer_timing.erl index b1a4bdc07c..759d49abc8 100644 --- a/lib/dialyzer/src/dialyzer_timing.erl +++ b/lib/dialyzer/src/dialyzer_timing.erl @@ -38,7 +38,7 @@ init(Active) -> case Active of true -> io:format("\n"), - spawn_link(fun() -> loop(now(), 0, "") end); + spawn_link(fun() -> loop(erlang:monotonic_time(), 0, "") end); debug -> io:format("\n"), spawn_link(fun() -> debug_loop("") end); @@ -105,14 +105,14 @@ debug_loop(Phase) -> start_stamp(none, _) -> ok; start_stamp(Pid, Msg) -> - Pid ! {stamp, Msg, now()}, + Pid ! {stamp, Msg, erlang:monotonic_time()}, ok. -spec end_stamp(timing_server()) -> ok. end_stamp(none) -> ok; end_stamp(Pid) -> - Pid ! {stamp, now()}, + Pid ! {stamp, erlang:monotonic_time()}, ok. -spec send_size_info(timing_server(), integer(), string()) -> ok. @@ -126,8 +126,8 @@ send_size_info(Pid, Size, Unit) -> stop(none) -> ok; stop(Pid) -> - Pid ! {self(), stop, now()}, + Pid ! {self(), stop, erlang:monotonic_time()}, receive ok -> ok end. diff(T2, T1) -> - timer:now_diff(T2,T1) / 1000000. + (T2-T1) / erlang:convert_time_unit(1, seconds, native). diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 638c1c4c2b..37e67d8630 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -303,7 +303,7 @@ Defaults to <c>none</c>.</p> <tag><c>{timeout, &dict_Unsigned32;}</c></tag> <item> <p> -The number of milliseconds after which the request should +Number of milliseconds after which the request should timeout. Defaults to 5000.</p> </item> @@ -674,7 +674,7 @@ connection establishment.</p> <tag><c>{'CEA', Result, Caps, Pkt}</c></tag> <item> <pre> -Result = integer() | atom() | {capabilities_cb, CB, ResultCode|discard} +Result = ResultCode | atom() | {capabilities_cb, CB, ResultCode|discard} Caps = #diameter_caps{} Pkt = #diameter_packet{} ResultCode = integer() @@ -742,7 +742,7 @@ info fields of forms other than the above.</p> <tag><c>service_name() = term()</c></tag> <item> <p> -The name of a service as passed to &start_service; and with which the +Name of a service as passed to &start_service; and with which the service is identified. There can be at most one service with a given name on a given node. Note that &make_ref; @@ -754,7 +754,7 @@ can be used to generate a service name that is somewhat unique.</p> <tag><c>service_opt()</c></tag> <item> <p> -An option passed to &start_service;. +Option passed to &start_service;. Can be any <c>&capability;</c> as well as the following.</p> <taglist> @@ -762,7 +762,7 @@ Can be any <c>&capability;</c> as well as the following.</p> <tag><c>{application, [&application_opt;]}</c></tag> <item> <p> -Defines a Diameter application supported by the service.</p> +A Diameter application supported by the service.</p> <p> A service must configure one tuple for each Diameter @@ -790,7 +790,7 @@ be matched by corresponding &capability; configuration, of | evaluable()}</c></tag> <item> <p> -Specifies the degree to which the service allows multiple transport +The degree to which the service allows multiple transport connections to the same peer, as identified by its Origin-Host at capabilities exchange.</p> @@ -816,7 +816,7 @@ Defaults to <c>nodes</c>.</p> <tag><c>{sequence, {H,N} | &evaluable;}</c></tag> <item> <p> -Specifies a constant value <c>H</c> for the topmost <c>32-N</c> bits of +A constant value <c>H</c> for the topmost <c>32-N</c> bits of of 32-bit End-to-End and Hop-by-Hop Identifiers generated by the service, either explicitly or as a return value of a function to be evaluated at &start_service;. @@ -851,7 +851,7 @@ outgoing requests.</p> <tag><c>{share_peers, boolean() | [node()] | evaluable()}</c></tag> <item> <p> -Specifies nodes to which peer connections established on the local +Nodes to which peer connections established on the local Erlang node are communicated. Shared peers become available in the remote candidates list passed to &app_pick_peer; callbacks on remote nodes whose services are @@ -890,7 +890,7 @@ of a single Diameter node across multiple Erlang nodes.</p> <tag><c>{spawn_opt, [term()]}</c></tag> <item> <p> -An options list passed to &spawn_opt; when spawning a process for an +Options list passed to &spawn_opt; when spawning a process for an incoming Diameter request, unless the transport in question specifies another value. Options <c>monitor</c> and <c>link</c> are ignored.</p> @@ -899,10 +899,34 @@ Options <c>monitor</c> and <c>link</c> are ignored.</p> Defaults to the empty list.</p> </item> +<marker id="string_decode"/> +<tag><c>{string_decode, boolean()}</c></tag> +<item> +<p> +Whether or not to decode AVPs of type &dict_OctetString; and its +derived types &dict_DiameterIdentity;, &dict_DiameterURI;, +&dict_IPFilterRule;, &dict_QoSFilterRule;, and &dict_UTF8String;. +If <c>true</c> then AVPs of these types are decoded to string(). +If <c>false</c> then values are retained as binary().</p> + +<p> +Defaults to <c>true</c>.</p> + +<warning> +<p> +This option should be set to <c>false</c> +since a sufficiently malicious peer can otherwise cause large amounts +of memory to be consumed when decoded Diameter messages are passed +between processes. +The default value is for backwards compatibility.</p> +</warning> + +</item> + <tag><c>{use_shared_peers, boolean() | [node()] | evaluable()}</c></tag> <item> <p> -Specifies nodes from which communicated peers are made available in +Nodes from which communicated peers are made available in the remote candidates list of &app_pick_peer; callbacks.</p> <p> @@ -942,7 +966,7 @@ each node from which requests are sent.</p> <tag><c>transport_opt()</c></tag> <item> <p> -An option passed to &add_transport;. +Option passed to &add_transport;. Has one of the following types.</p> <taglist> @@ -950,8 +974,7 @@ Has one of the following types.</p> <tag><c>{applications, [&application_alias;]}</c></tag> <item> <p> -The list of Diameter applications to which the transport should be -restricted. +Diameter applications to which the transport should be restricted. Defaults to all applications configured on the service in question. Applications not configured on the service in question are ignored.</p> @@ -984,7 +1007,7 @@ TLS is desired over TCP as implemented by &man_tcp;.</p> <tag><c>{capabilities_cb, &evaluable;}</c></tag> <item> <p> -A callback invoked upon reception of CER/CEA during capabilities +Callback invoked upon reception of CER/CEA during capabilities exchange in order to ask whether or not the connection should be accepted. Applied to the <c>&transport_ref;</c> and @@ -1115,7 +1138,7 @@ Defaults to <c>rebooting</c> for <c>Reason=service|application</c> and <p> Number of milliseconds after which the transport process is terminated if DPA has not been received. -Defaults to 1000.</p> +Defaults to the value of &dpa_timeout;.</p> </item> </taglist> </item> @@ -1152,6 +1175,29 @@ configured them.</p> Defaults to a single callback returning <c>dpr</c>.</p> </item> +<marker id="dpa_timeout"/> +<tag><c>{dpa_timeout, &dict_Unsigned32;}</c></tag> +<item> +<p> +Number of milliseconds after which a transport connection is +terminated following an outgoing DPR if DPA is not received.</p> + +<p> +Defaults to 1000.</p> +</item> + +<marker id="dpr_timeout"/> +<tag><c>{dpr_timeout, &dict_Unsigned32;}</c></tag> +<item> +<p> +Number of milliseconds after which a transport connection is +terminated following an incoming DPR if the peer does not close the +connection.</p> + +<p> +Defaults to 5000.</p> +</item> + <marker id="length_errors"/> <tag><c>{length_errors, exit|handle|discard}</c></tag> <item> @@ -1207,7 +1253,7 @@ the same peer.</p> <tag><c>{spawn_opt, [term()]}</c></tag> <item> <p> -Options list passed to &spawn_opt; when spawning a process for an +Options passed to &spawn_opt; when spawning a process for an incoming Diameter request. Options <c>monitor</c> and <c>link</c> are ignored.</p> diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index 810a146b88..9db9bcffde 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -529,6 +529,11 @@ answer record and passed to a &app_handle_request; callback upon reception of an incoming request.</p> <p> +In cases in which there is a choice between list() and binary() types +for OctetString() and derived types, the representation is determined +by the value of &mod_string_decode;.</p> + +<p> <em>Basic AVP Data Formats</em></p> <marker id="OctetString"/> @@ -541,7 +546,7 @@ callback upon reception of an incoming request.</p> <marker id="Grouped"/> <pre> -OctetString() = [0..255] +OctetString() = string() | binary() Integer32() = -2147483647..2147483647 Integer64() = -9223372036854775807..9223372036854775807 Unsigned32() = 0..4294967295 @@ -603,7 +608,7 @@ and <c>{{2104,2,26},{9,42,23}}</c> (both inclusive) can be encoded.</p> <marker id="UTF8String"/> <pre> -UTF8String() = [integer()] +UTF8String() = [integer()] | binary() </pre> <p> diff --git a/lib/diameter/doc/src/seealso.ent b/lib/diameter/doc/src/seealso.ent index 44541afb9b..4e205ffad7 100644 --- a/lib/diameter/doc/src/seealso.ent +++ b/lib/diameter/doc/src/seealso.ent @@ -4,7 +4,7 @@ %CopyrightBegin% -Copyright Ericsson AB 2012-2014. All Rights Reserved. +Copyright Ericsson AB 2012-2015. 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 @@ -64,11 +64,14 @@ significant. <!ENTITY capabilities_cb '<seealso marker="#capabilities_cb">capabilities_cb</seealso>'> <!ENTITY capx_timeout '<seealso marker="#capx_timeout">capx_timeout</seealso>'> <!ENTITY disconnect_cb '<seealso marker="#disconnect_cb">disconnect_cb</seealso>'> +<!ENTITY dpa_timeout '<seealso marker="#dpa_timeout">dpa_timeout</seealso>'> <!ENTITY transport_config '<seealso marker="#transport_config">transport_config</seealso>'> <!ENTITY transport_module '<seealso marker="#transport_module">transport_module</seealso>'> <!ENTITY connect_timer '<seealso marker="#connect_timer">connect_timer</seealso>'> <!ENTITY watchdog_timer '<seealso marker="#watchdog_timer">watchdog_timer</seealso>'> +<!ENTITY mod_string_decode '<seealso marker="diameter#service_opt">diameter:service_opt()</seealso> <seealso marker="diameter#string_decode">string_decode</seealso>'> + <!-- diameter_app --> <!ENTITY app_handle_answer '<seealso marker="diameter_app#Mod:handle_answer-4">handle_answer/4</seealso>'> @@ -102,6 +105,9 @@ significant. <!ENTITY dict_Address '<seealso marker="diameter_dict#DATA_TYPES">Address()</seealso>'> <!ENTITY dict_DiameterIdentity '<seealso marker="diameter_dict#DATA_TYPES">DiameterIdentity()</seealso>'> +<!ENTITY dict_DiameterURI '<seealso marker="diameter_dict#DATA_TYPES">DiameterURI()</seealso>'> +<!ENTITY dict_IPFilterRule '<seealso marker="diameter_dict#DATA_TYPES">IPFilterRule()</seealso>'> +<!ENTITY dict_QoSFilterRule '<seealso marker="diameter_dict#DATA_TYPES">QoSFilterRule()</seealso>'> <!ENTITY dict_Grouped '<seealso marker="diameter_dict#DATA_TYPES">Grouped()</seealso>'> <!ENTITY dict_OctetString '<seealso marker="diameter_dict#DATA_TYPES">OctetString()</seealso>'> <!ENTITY dict_Time '<seealso marker="diameter_dict#DATA_TYPES">Time()</seealso>'> diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl index be5b4cbba5..844c9cdbdd 100644 --- a/lib/diameter/examples/code/client.erl +++ b/lib/diameter/examples/code/client.erl @@ -41,6 +41,7 @@ -include_lib("diameter/include/diameter_gen_base_rfc6733.hrl"). -export([start/1, %% start a service + start/2, %% connect/2, %% add a connecting transport call/1, %% send using the record encoding cast/1, %% send using the list encoding and detached @@ -68,6 +69,7 @@ {'Vendor-Id', 0}, {'Product-Name', "Client"}, {'Auth-Application-Id', [0]}, + {string_decode, false}, {application, [{alias, common}, {dictionary, diameter_gen_base_rfc6733}, {module, client_cb}]}]). @@ -76,11 +78,23 @@ start(Name) when is_atom(Name) -> - node:start(Name, ?SERVICE(Name)). + start(Name, []); + +start(Opts) + when is_list(Opts) -> + start(?DEF_SVC_NAME, Opts). + +%% start/0 start() -> start(?DEF_SVC_NAME). +%% start/2 + +start(Name, Opts) -> + node:start(Name, Opts ++ [T || {K,_} = T <- ?SERVICE(Name), + false == lists:keymember(K, 1, Opts)]). + %% connect/2 connect(Name, T) -> diff --git a/lib/diameter/examples/code/relay.erl b/lib/diameter/examples/code/relay.erl index 0aa3cd06d3..7bc46dc68d 100644 --- a/lib/diameter/examples/code/relay.erl +++ b/lib/diameter/examples/code/relay.erl @@ -32,6 +32,7 @@ -module(relay). -export([start/1, + start/2, listen/2, connect/2, stop/1]). @@ -49,6 +50,7 @@ {'Vendor-Id', 193}, {'Product-Name', "RelayAgent"}, {'Auth-Application-Id', [16#FFFFFFFF]}, + {string_decode, false}, {application, [{alias, relay}, {dictionary, diameter_relay}, {module, relay_cb}]}]). @@ -57,11 +59,19 @@ start(Name) when is_atom(Name) -> - node:start(Name, ?SERVICE(Name)). + start(Name, []). + +%% start/1 start() -> start(?DEF_SVC_NAME). +%% start/2 + +start(Name, Opts) -> + node:start(Name, Opts ++ [T || {K,_} = T <- ?SERVICE(Name), + false == lists:keymember(K, 1, Opts)]). + %% listen/2 listen(Name, T) -> diff --git a/lib/diameter/examples/code/server.erl b/lib/diameter/examples/code/server.erl index 8c91e68895..f32cec594c 100644 --- a/lib/diameter/examples/code/server.erl +++ b/lib/diameter/examples/code/server.erl @@ -35,6 +35,7 @@ -module(server). -export([start/1, %% start a service + start/2, %% listen/2, %% add a listening transport stop/1]). %% stop a service @@ -53,6 +54,8 @@ {'Vendor-Id', 193}, {'Product-Name', "Server"}, {'Auth-Application-Id', [0]}, + {restrict_connections, false}, + {string_decode, false}, {application, [{alias, common}, {dictionary, diameter_gen_base_rfc6733}, {module, server_cb}]}]). @@ -61,11 +64,23 @@ start(Name) when is_atom(Name) -> - node:start(Name, ?SERVICE(Name)). + start(Name, []); + +start(Opts) + when is_list(Opts) -> + start(?DEF_SVC_NAME, Opts). + +%% start/0 start() -> start(?DEF_SVC_NAME). +%% start/2 + +start(Name, Opts) -> + node:start(Name, Opts ++ [T || {K,_} = T <- ?SERVICE(Name), + false == lists:keymember(K, 1, Opts)]). + %% listen/2 listen(Name, T) -> diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index 1bbdf6e34d..67dfc7bdbf 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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 @@ -306,6 +306,7 @@ call(SvcName, App, Message) -> | {restrict_connections, restriction()} | {sequence, sequence() | evaluable()} | {share_peers, remotes()} + | {string_decode, boolean()} | {use_shared_peers, remotes()} | {spawn_opt, list()}. @@ -343,6 +344,8 @@ call(SvcName, App, Message) -> | {capabilities_cb, evaluable()} | {capx_timeout, 'Unsigned32'()} | {disconnect_cb, evaluable()} + | {dpr_timeout, 'Unsigned32'()} + | {dpa_timeout, 'Unsigned32'()} | {length_errors, exit | handle | discard} | {connect_timer, 'Unsigned32'()} | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 93548ecafd..7dc61f229f 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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 @@ -50,7 +50,8 @@ -export([build_CER/2, recv_CER/3, recv_CEA/3, - make_caps/2]). + make_caps/2, + binary_caps/1]). -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). @@ -115,7 +116,8 @@ mk_caps(Caps0, Opts) -> -define(SC(K,F), set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> - {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). + {Caps#diameter_caps{F = cap(K, copy(Val))}, + C#diameter_caps{F = true}}). ?SC('Origin-Host', origin_host); ?SC('Origin-Realm', origin_realm); @@ -375,10 +377,10 @@ capx_to_caps(CEX, Dict) -> 'Firmware-Revision', 'AVP'], CEX), - #diameter_caps{origin_host = OH, - origin_realm = OR, + #diameter_caps{origin_host = copy(OH), + origin_realm = copy(OR), vendor_id = VId, - product_name = PN, + product_name = copy(PN), origin_state_id = OSI, host_ip_address = IP, supported_vendor_id = SV, @@ -389,6 +391,32 @@ capx_to_caps(CEX, Dict) -> firmware_revision = FR, avp = X}. +%% Copy binaries to avoid retaining a reference to a large binary +%% containing AVPs we aren't interested in. +copy(B) + when is_binary(B) -> + binary:copy(B); + +copy(T) -> + T. + +%% binary_caps/1 +%% +%% Encode stringish capabilities with {string_decode, false}. + +binary_caps(Caps) -> + lists:foldl(fun bcaps/2, Caps, [#diameter_caps.origin_host, + #diameter_caps.origin_realm, + #diameter_caps.product_name]). + +bcaps(N, Caps) -> + case element(N, Caps) of + undefined -> + Caps; + V -> + setelement(N, Caps, iolist_to_binary(V)) + end. + %% --------------------------------------------------------------------------- %% --------------------------------------------------------------------------- diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index b4ecb63961..15a4c5e86f 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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 @@ -22,6 +22,8 @@ -export([encode/2, decode/2, decode/3, + setopts/1, + getopt/1, collect_avps/1, decode_header/1, sequence_numbers/1, @@ -59,6 +61,50 @@ %% +-+-+-+-+-+-+-+-+-+-+-+-+- %%% --------------------------------------------------------------------------- +%%% # setopts/1 +%%% # getopt/1 +%%% --------------------------------------------------------------------------- + +%% These functions are a compromise in the same vein as the use of the +%% process dictionary in diameter_gen.hrl in generated codec modules. +%% Instead of rewriting the entire dictionary generation to pass +%% encode/decode options around, the calling process sets them by +%% calling setopts/1. At current, the only option is whether or not to +%% decode binaries as strings, which is used by diameter_types. + +setopts(Opts) + when is_list(Opts) -> + lists:foreach(fun setopt/1, Opts). + +%% Decode stringish types to string()? The default true is for +%% backwards compatibility. +setopt({string_decode = K, false = B}) -> + setopt(K, B); + +%% Regard anything but the generated RFC 3588 dictionary as modern. +%% This affects the interpretation of defaults during the decode +%% of values of type DiameterURI, this having changed from RFC 3588. +%% (So much for backwards compatibility.) +setopt({common_dictionary, diameter_gen_base_rfc3588}) -> + setopt(rfc, 3588); + +setopt(_) -> + ok. + +setopt(Key, Value) -> + put({diameter, Key}, Value). + +getopt(Key) -> + case get({diameter, Key}) of + undefined when Key == string_decode -> + true; + undefined when Key == rfc -> + 6733; + V -> + V + end. + +%%% --------------------------------------------------------------------------- %%% # encode/2 %%% --------------------------------------------------------------------------- @@ -90,7 +136,7 @@ encode(Mod, Msg) -> msg = Msg}). e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - try encode_avps(As) of + try encode_avps(reorder(As)) of Avps -> Length = size(Avps) + 20, @@ -183,26 +229,50 @@ values(Avps) -> %% Message as a list of #diameter_avp{} ... encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> - encode_avps(reorder(Avps, [], Avps)); + encode_avps(reorder(Avps)); %% ... or as a tuple list or record. encode_avps(Mod, MsgName, Values) -> Mod:encode_avps(MsgName, Values). %% reorder/1 +%% +%% Reorder AVPs for the relay case using the index field of +%% diameter_avp records. Decode populates this field in collect_avps +%% and presents AVPs in reverse order. A relay then sends the reversed +%% list with a Route-Record AVP prepended. The goal here is just to do +%% lists:reverse/1 in Grouped AVPs and the outer list, but only in the +%% case there are indexed AVPs at all, so as not to reverse lists that +%% have been explicilty sent (unindexed, in the desired order) as a +%% diameter_avp list. The effect is the same as lists:keysort/2, but +%% only on the cases we expect, not a general sort. + +reorder(Avps) -> + case reorder(Avps, []) of + false -> + Avps; + Sorted -> + Sorted + end. -reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> +%% reorder/3 + +%% In case someone has reversed the list already. (Not likely.) +reorder([#diameter_avp{index = 0} | _] = Avps, Acc) -> Avps ++ Acc; -reorder([#diameter_avp{index = N} = A | Avps], Acc, _) +%% Assume indexed AVPs are in reverse order. +reorder([#diameter_avp{index = N} = A | Avps], Acc) when is_integer(N) -> lists:reverse(Avps, [A | Acc]); -reorder([H | T], Acc, Avps) -> - reorder(T, [H | Acc], Avps); +%% An unindexed AVP. +reorder([H | T], Acc) -> + reorder(T, [H | Acc]); -reorder([], Acc, _) -> - Acc. +%% No indexed members. +reorder([], _) -> + false. %% encode_avps/1 diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index c0a4f7df69..0d0304bf33 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -532,7 +532,10 @@ opt({applications, As}) -> opt({capabilities, Os}) -> is_list(Os) andalso ok == encode_CER(Os); -opt({capx_timeout, Tmo}) -> +opt({K, Tmo}) + when K == capx_timeout; + K == dpr_timeout; + K == dpa_timeout -> ?IS_UINT32(Tmo); opt({length_errors, T}) -> @@ -642,13 +645,23 @@ make_config(SvcName, Opts) -> {false, monitor}, {?NOMASK, sequence}, {nodes, restrict_connections}, + {true, string_decode}, {[], spawn_opt}]), + D = proplists:get_value(string_decode, SvcOpts, true), + #service{name = SvcName, rec = #diameter_service{applications = Apps, - capabilities = Caps}, + capabilities = binary_caps(Caps, D)}, options = SvcOpts}. +binary_caps(Caps, true) -> + Caps; +binary_caps(Caps, false) -> + diameter_capx:binary_caps(Caps). + +%% make_opts/2 + make_opts(Opts, Defs) -> Known = [{K, get_opt(K, Opts, D)} || {D,K} <- Defs], Unknown = Opts -- Known, @@ -667,7 +680,8 @@ opt(K, false = B) opt(K, true = B) when K == share_peers; - K == use_shared_peers -> + K == use_shared_peers; + K == string_decode -> B; opt(restrict_connections, T) diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl index d0d730f47c..51d203d722 100644 --- a/lib/diameter/src/base/diameter_lib.erl +++ b/lib/diameter/src/base/diameter_lib.erl @@ -19,6 +19,7 @@ -module(diameter_lib). -compile({no_auto_import, [now/0]}). +-compile({nowarn_deprecated_function, [{erlang, now, 0}]}). -export([info_report/2, error_report/2, @@ -129,12 +130,13 @@ timestamp({_,_,_} = T) -> %% erlang:now() T; timestamp(MonoT) -> %% monotonic time - MicroSecs = erlang:convert_time_resolution(MonoT + erlang:time_offset(), - erlang:time_resolution(), - 1000000), + MicroSecs = monotonic_to_microseconds(MonoT + erlang:time_offset()), Secs = MicroSecs div 1000000, {Secs div 1000000, Secs rem 1000000, MicroSecs rem 1000000}. +monotonic_to_microseconds(MonoT) -> + erlang:convert_time_unit(MonoT, native, micro_seconds). + %% --------------------------------------------------------------------------- %% # now_diff/1 %% --------------------------------------------------------------------------- @@ -164,9 +166,7 @@ micro_diff({_,_,_} = T0) -> timer:now_diff(erlang:now(), T0); micro_diff(T0) -> %% monotonic time - erlang:convert_time_resolution(erlang:monotonic_time() - T0, - erlang:time_resolution(), - 1000000). + monotonic_to_microseconds(erlang:monotonic_time() - T0). %% --------------------------------------------------------------------------- %% # micro_diff/2 @@ -178,9 +178,7 @@ micro_diff(T0) -> %% monotonic time micro_diff(T1, T0) when is_integer(T1), is_integer(T0) -> %% monotonic time - erlang:convert_time_resolution(T1 - T0, - erlang:time_resolution(), - 1000000); + monotonic_to_microseconds(T1 - T0); micro_diff(T1, T0) -> %% at least one erlang:now() timer:now_diff(timestamp(T1), timestamp(T0)). diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index ea326dd03e..89b63c8a92 100644 --- a/lib/diameter/src/base/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl @@ -232,12 +232,22 @@ recv(Pid, Pkt) -> %% # send/2 %% --------------------------------------------------------------------------- -send(Pid, #diameter_packet{transport_data = undefined, - bin = Bin}) -> - send(Pid, Bin); +send(Pid, Msg) -> + ifc_send(Pid, {send, strip(Msg)}). -send(Pid, Pkt) -> - ifc_send(Pid, {send, Pkt}). +%% Send only binary when possible. +strip(#diameter_packet{transport_data = undefined, + bin = Bin}) -> + Bin; + +%% Strip potentially large message terms. +strip(#diameter_packet{transport_data = T, + bin = Bin}) -> + #diameter_packet{transport_data = T, + bin = Bin}; + +strip(Msg) -> + Msg. %% --------------------------------------------------------------------------- %% # close/1 @@ -326,7 +336,6 @@ code_change(_OldVsn, State, _Extra) -> {ok, State}. %% --------------------------------------------------------- -%% INTERNAL FUNCTIONS %% --------------------------------------------------------- %% ifc_send/2 diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index ee6e7dd89e..aac2685514 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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 @@ -63,6 +63,8 @@ %% Keys in process dictionary. -define(CB_KEY, cb). %% capabilities callback -define(DPR_KEY, dpr). %% disconnect callback +-define(DPA_KEY, dpa). %% timeout for incoming DPA, or shutdown after + %% outgoing DPA -define(REF_KEY, ref). %% transport_ref() -define(Q_KEY, q). %% transport start queue -define(START_KEY, start). %% start of connected transport @@ -82,18 +84,26 @@ N == ?GOAWAY; N == goaway; N == ?BUSY; N == busy). -%% RFC 3588: +%% RFC 6733: %% %% Timeout An application-defined timer has expired while waiting %% for some event. %% --define(EVENT_TIMEOUT, 10000). + %% Default timeout for reception of CER/CEA. +-define(CAPX_TIMEOUT, 10000). -%% Default timeout for DPA in response to DPR. A bit short but the -%% timeout used to be hardcoded. (So it could be worse.) +%% Default timeout for DPA to be received in response to an outgoing +%% DPR. A bit short but the timeout used to be hardcoded. (So it could +%% be worse.) -define(DPA_TIMEOUT, 1000). +%% Default timeout for the connection to be closed by the peer +%% following an outgoing DPA in response to an incoming DPR. It's the +%% recipient of DPA that should close the connection according to the +%% RFC. +-define(DPR_TIMEOUT, 5000). + -type uint32() :: diameter:'Unsigned32'(). -record(state, @@ -107,8 +117,14 @@ transport :: pid(), %% transport process dictionary :: module(), %% common dictionary service :: #diameter_service{}, - dpr = false :: false | {uint32(), uint32()}, - %% | hop by hop and end to end identifiers + dpr = false :: false + | true %% DPR received, DPA sent + | {uint32(), uint32()} %% set in old code + | {boolean(), uint32(), uint32()}, + %% hop by hop and end to end identifiers in + %% outgoing DPR; boolean says whether or not + %% the request was sent explicitly with + %% diameter:call/4. length_errors :: exit | handle | discard}). %% There are non-3588 states possible as a consequence of 5.6.1 of the @@ -138,7 +154,8 @@ %% # start/3 %% --------------------------------------------------------------------------- --spec start(T, [Opt], {diameter:sequence(), +-spec start(T, [Opt], {[diameter:service_opt()] + | diameter:sequence(), %% from old code [node()], module(), #diameter_service{}}) @@ -177,18 +194,25 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({Ack, WPid, {M, Ref} = T, Opts, {Mask, Nodes, Dict0, Svc}}) -> +i({Ack, WPid, T, Opts, {{_,_} = Mask, Nodes, Dict0, Svc}}) -> %% from old code + i({Ack, WPid, T, Opts, {[{sequence, Mask}], Nodes, Dict0, Svc}}); + +i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) -> erlang:monitor(process, WPid), wait(Ack, WPid), diameter_stats:reg(Ref), + diameter_codec:setopts([{common_dictionary, Dict0} | SvcOpts]), + {_,_} = Mask = proplists:get_value(sequence, SvcOpts), {[Cs,Ds], Rest} = proplists:split(Opts, [capabilities_cb, disconnect_cb]), putr(?CB_KEY, {Ref, [F || {_,F} <- Cs]}), putr(?DPR_KEY, [F || {_, F} <- Ds]), putr(?REF_KEY, Ref), putr(?SEQUENCE_KEY, Mask), putr(?RESTRICT_KEY, Nodes), + putr(?DPA_KEY, {proplists:get_value(dpr_timeout, Opts, ?DPR_TIMEOUT), + proplists:get_value(dpa_timeout, Opts, ?DPA_TIMEOUT)}), - Tmo = proplists:get_value(capx_timeout, Opts, ?EVENT_TIMEOUT), + Tmo = proplists:get_value(capx_timeout, Opts, ?CAPX_TIMEOUT), OnLengthErr = proplists:get_value(length_errors, Opts, exit), {TPid, Addrs} = start_transport(T, Rest, Svc), @@ -212,9 +236,12 @@ wait(Ref, Pid) -> Ref -> ok; {'DOWN', _, process, Pid, _} = D -> - exit({shutdown, D}) + x(D) end. +x(T) -> + exit({shutdown, T}). + start_transport(T, Opts, #diameter_service{capabilities = LCaps} = Svc) -> Addrs0 = LCaps#diameter_caps.host_ip_address, start_transport(Addrs0, {T, Opts, Svc}). @@ -226,7 +253,7 @@ start_transport(Addrs0, T) -> q_next(TPid, Addrs0, Tmo, Data), {TPid, Addrs}; {error, No} -> - exit({shutdown, {no_connection, No}}) + x({no_connection, No}) end. svc(#diameter_service{capabilities = LCaps0} = Svc, Addrs) -> @@ -333,6 +360,9 @@ eraser(Key) -> %% transition/2 +transition(T, #state{dpr = {Hid, Eid}} = S) -> %% DPR sent from old code + transition(T, S#state{dpr = {false, Hid, Eid}}); + %% Connection to peer. transition({diameter, {TPid, connected, Remote}}, #state{transport = TPid, @@ -397,9 +427,8 @@ transition({timeout, _}, _) -> ok; %% Outgoing message. -transition({send, Msg}, #state{transport = TPid}) -> - send(TPid, Msg), - ok; +transition({send, Msg}, S) -> + outgoing(Msg, S); %% Request for graceful shutdown at remove_transport, stop_service of %% application shutdown. @@ -408,7 +437,8 @@ transition({shutdown, Pid, Reason}, #state{parent = Pid, dpr = false} = S) -> transition({shutdown, Pid, _}, #state{parent = Pid}) -> ok; -%% DPA reception has timed out. +%% DPA reception has timed out, or peer has not closed the connection +%% as a result of outgoing DPA. transition(dpa_timeout, _) -> stop; @@ -516,12 +546,9 @@ encode(Rec, Dict) -> recv(#diameter_packet{header = #diameter_header{} = Hdr} = Pkt, - #state{parent = Pid, - dictionary = Dict0} + #state{dictionary = Dict0} = S) -> - Name = diameter_codec:msg_name(Dict0, Hdr), - Pid ! {recv, self(), Name, Pkt}, - rcv(Name, Pkt, S); + recv1(diameter_codec:msg_name(Dict0, Hdr), Pkt, S); recv(#diameter_packet{header = undefined, bin = Bin} @@ -532,6 +559,41 @@ recv(#diameter_packet{header = undefined, recv(Bin, S) -> recv(#diameter_packet{bin = Bin}, S). +%% recv1/3 + +%% Incoming request after outgoing DPR: discard. Don't discard DPR, so +%% both ends don't do so when sending simultaneously. +recv1(Name, + #diameter_packet{header = #diameter_header{is_request = true} = H}, + #state{dpr = {_,_,_}}) + when Name /= 'DPR' -> + invalid(false, recv_after_outgoing_dpr, H); + +%% Incoming request after incoming DPR: discard. +recv1(_, + #diameter_packet{header = #diameter_header{is_request = true} = H}, + #state{dpr = true}) -> + invalid(false, recv_after_incoming_dpr, H); + +%% DPA with identifier mismatch, or in response to a DPR initiated by +%% the service. +recv1('DPA' = N, + #diameter_packet{header = #diameter_header{hop_by_hop_id = Hid, + end_to_end_id = Eid}} + = Pkt, + #state{dpr = {X,H,E}} + = S) + when H /= Hid; + E /= Eid; + not X -> + rcv(N, Pkt, S); + +%% Any other message with a header and no length errors: send to the +%% parent. +recv1(Name, Pkt, #state{parent = Pid} = S) -> + Pid ! {recv, self(), Name, Pkt}, + rcv(Name, Pkt, S). + %% recv/3 recv(#diameter_header{length = Len} @@ -588,7 +650,7 @@ rcv(Name, _, #state{state = PS}) rcv('DPR' = N, Pkt, S) -> handle_request(N, Pkt, S); -%% DPA in response to DPR and with the expected identifiers. +%% DPA in response to DPR, with the expected identifiers. rcv('DPA' = N, #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid} @@ -596,14 +658,21 @@ rcv('DPA' = N, = Pkt, #state{dictionary = Dict0, transport = TPid, - dpr = {Hid, Eid}}) -> + dpr = {X, Hid, Eid}}) -> ?LOG(recv, N), - incr(recv, H, Dict0), - incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0), + X orelse begin + %% Only count DPA in response to a DPR sent by the + %% service: explicit DPR is counted in the same way + %% as other explicitly sent requests. + incr(recv, H, Dict0), + incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0) + end, diameter_peer:close(TPid), {stop, N}; -%% Ignore anything else, an unsolicited DPA in particular. +%% Ignore anything else, an unsolicited DPA in particular. Note that +%% dpa_timeout deals with the case in which the peer sends the wrong +%% identifiers in DPA. rcv(N, #diameter_packet{header = H}, _) when N == 'CER'; N == 'CEA'; @@ -637,9 +706,61 @@ incr_error(Dir, Pkt, Dict0) -> %% Msg here could be a #diameter_packet or a binary depending on who's %% sending. In particular, the watchdog will send DWR as a binary %% while messages coming from clients will be in a #diameter_packet. + send(Pid, Msg) -> diameter_peer:send(Pid, Msg). +%% outgoing/2 + +%% Explicit DPR. +outgoing(#diameter_packet{header = #diameter_header{application_id = 0, + cmd_code = 282, + is_request = true} + = H} + = Pkt, + #state{dpr = T, + parent = Pid} + = S) -> + if T == false -> + inform_dpr(Pid), + send_dpr(true, Pkt, dpa_timeout(), S); + T == true -> + invalid(false, dpr_after_dpa, H); %% DPA sent: discard + true -> + invalid(false, dpr_after_dpr, H) %% DPR sent: discard + end; + +%% Explict CER or DWR: discard. These are sent by us. +outgoing(#diameter_packet{header = #diameter_header{application_id = 0, + cmd_code = C, + is_request = true} + = H}, + _) + when 257 == C; %% CER + 280 == C -> %% DWR + invalid(false, invalid_request, H); + +%% DPR not sent: send. +outgoing(Msg, #state{transport = TPid, dpr = false}) -> + send(TPid, Msg), + ok; + +%% Outgoing answer: send. +outgoing(#diameter_packet{header = #diameter_header{is_request = false}} + = Pkt, + #state{transport = TPid}) -> + send(TPid, Pkt), + ok; + +%% Outgoing request: discard. +outgoing(Msg, #state{dpr = {_,_,_}}) -> + invalid(false, send_after_dpr, header(Msg)). + +header(#diameter_packet{header = H}) -> + H; +header(Bin) -> %% DWR + diameter_codec:decode_header(Bin). + %% handle_request/3 %% %% Incoming CER or DPR. @@ -699,6 +820,8 @@ build_answer('CER', = Pkt, #state{dictionary = Dict0} = S) -> + diameter_codec:setopts([{string_decode, false}]), + {SupportedApps, RCaps, CEA} = recv_CER(CER, S), [RC, IS] = Dict0:'#get-'(['Result-Code', 'Inband-Security-Id'], CEA), @@ -731,7 +854,7 @@ build_answer(Type, errors = Es} = Pkt, S) -> - {RC, FailedAVP} = result_code(H, Es), + {RC, FailedAVP} = result_code(Type, H, Es), {answer(Type, RC, FailedAVP, S), post(Type, RC, Pkt, S)}. inband_security([]) -> @@ -748,8 +871,16 @@ cea(CEA, RC, Dict0) -> post('CER' = T, RC, Pkt, S) -> {T, caps(S), {RC, Pkt}}; -post('DPR' = T, _, _, #state{parent = Pid}) -> - [fun(S) -> Pid ! {T, self()}, S end]. +post('DPR', _, _, #state{parent = Pid}) -> + [fun(S) -> dpr_timer(), inform_dpr(Pid), dpr(S) end]. + +dpr(#state{dpr = false} = S) -> %% not awaiting DPA + S#state{dpr = true}; %% DPR received +dpr(S) -> %% DPR already sent or received + S. + +inform_dpr(Pid) -> + Pid ! {'DPR', self()}. %% tell watchdog to die with us rejected({capabilities_cb, _F, Reason}, T, S) -> rejected(Reason, T, S); @@ -798,6 +929,19 @@ set(['answer-message' | _] = Ans, FailedAvp) -> set([_|_] = Ans, FailedAvp) -> Ans ++ FailedAvp. +%% result_code/3 + +%% Be lenient with errors in DPR since there's no reason to be +%% otherwise. Rejecting may cause the peer to missinterpret the error +%% as meaning that the connection should not be closed, which may well +%% lead to more problems than any errors in the DPR. + +result_code('DPR', _, _) -> + {2001, []}; + +result_code('CER', H, Es) -> + result_code(H, Es). + %% result_code/2 result_code(#diameter_header{is_error = true}, _) -> @@ -886,6 +1030,8 @@ handle_CEA(#diameter_packet{header = H} = DPkt = diameter_codec:decode(Dict0, Pkt), + diameter_codec:setopts([{string_decode, false}]), + RC = result_code(incr_rc(recv, DPkt, Dict0)), {SApps, IS, RCaps} = recv_CEA(DPkt, S), @@ -1026,7 +1172,7 @@ close(Reason) -> %% dpr/2 %% -%% The RFC isn't clear on whether DPR should be send in a non-Open +%% The RFC isn't clear on whether DPR should be sent in a non-Open %% state. The Peer State Machine transitions it documents aren't %% exhaustive (no Stop in Wait-I-CEA for example) so assume it's up to %% the implementation and transition to Closed (ie. die) if we haven't @@ -1042,7 +1188,7 @@ dpr(Reason, #state{state = 'Open', Peer = {self(), Caps}, dpr(CBs, [Reason, Ref, Peer], S); -%% Connection is open, DPR already sent. +%% Connection is open, DPR already sent or received. dpr(_, #state{state = 'Open'}) -> ok; @@ -1073,10 +1219,9 @@ dpr([CB|Rest], [Reason | _] = Args, S) -> dpr([], [Reason | _], S) -> send_dpr(Reason, [], S). --record(opts, {cause, timeout = ?DPA_TIMEOUT}). +-record(opts, {cause, timeout}). -send_dpr(Reason, Opts, #state{transport = TPid, - dictionary = Dict, +send_dpr(Reason, Opts, #state{dictionary = Dict, service = #diameter_service{capabilities = Caps}} = S) -> #opts{cause = Cause, timeout = Tmo} @@ -1085,24 +1230,37 @@ send_dpr(Reason, Opts, #state{transport = TPid, transport -> ?GOAWAY; _ -> ?REBOOT end, - timeout = ?DPA_TIMEOUT}, + timeout = dpa_timeout()}, Opts), #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}} = Caps, - #diameter_packet{header = #diameter_header{end_to_end_id = Eid, - hop_by_hop_id = Hid}} - = Pkt - = encode(['DPR', {'Origin-Host', OH}, + Pkt = encode(['DPR', {'Origin-Host', OH}, {'Origin-Realm', OR}, {'Disconnect-Cause', Cause}], Dict), - incr(send, Pkt, Dict), + send_dpr(false, Pkt, Tmo, S). + +%% send_dpr/4 + +send_dpr(X, + #diameter_packet{header = #diameter_header{end_to_end_id = Eid, + hop_by_hop_id = Hid}} + = Pkt, + Tmo, + #state{transport = TPid, + dictionary = Dict} + = S) -> + %% Only count DPR sent by the service: explicit DPR is counted in + %% the same way as other explicitly sent requests. + X orelse incr(send, Pkt, Dict), send(TPid, Pkt), dpa_timer(Tmo), ?LOG(send, 'DPR'), - S#state{dpr = {Hid, Eid}}. + S#state{dpr = {X, Hid, Eid}}. + +%% opt/2 opt({timeout, Tmo}, Rec) when ?IS_TIMEOUT(Tmo) -> @@ -1125,6 +1283,27 @@ cause(N) -> dpa_timer(Tmo) -> erlang:send_after(Tmo, self(), dpa_timeout). +dpa_timeout() -> + dpa_timeout(getr(?DPA_KEY)). + +dpa_timeout({_, Tmo}) -> + Tmo; +dpa_timeout(undefined) -> %% set in old code + ?DPA_TIMEOUT; +dpa_timeout(Tmo) -> %% ditto + Tmo. + +dpr_timer() -> + dpa_timer(dpr_timeout()). + +dpr_timeout() -> + dpr_timeout(getr(?DPA_KEY)). + +dpr_timeout({Tmo, _}) -> + Tmo; +dpr_timeout(_) -> %% set in old code + ?DPR_TIMEOUT. + %% register_everywhere/1 %% %% Register a term and ensure it's not registered elsewhere. Note that diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 04401a3d87..a01bcdd4e7 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -130,7 +130,8 @@ :: [{sequence, diameter:sequence()} %% sequence mask | {share_peers, diameter:remotes()} %% broadcast to | {use_shared_peers, diameter:remotes()} %% use from - | {restrict_connections, diameter:restriction()}]}). + | {restrict_connections, diameter:restriction()} + | {string_decode, boolean()}]}). %% shared_peers reflects the peers broadcast from remote nodes. %% Record representing an RFC 3539 watchdog process implemented by @@ -261,16 +262,22 @@ whois(SvcName) -> %% --------------------------------------------------------------------------- -spec pick_peer(SvcName, AppOrAlias, Opts) - -> {{TPid, Caps, App}, Mask} - | false - | {error, term()} + -> {{TPid, Caps, App}, Mask, SvcOpts} + | false %% no selection + | {error, no_service} when SvcName :: diameter:service_name(), - AppOrAlias :: {alias, diameter:app_alias()} | #diameter_app{}, - Opts :: tuple(), + AppOrAlias :: #diameter_app{} + | {alias, diameter:app_alias()}, + Opts :: {fun((Dict :: module()) -> [term()]), + diameter:peer_filter(), + Xtra :: list()}, TPid :: pid(), Caps :: #diameter_caps{}, App :: #diameter_app{}, - Mask :: diameter:sequence(). + Mask :: diameter:sequence(), + SvcOpts :: [diameter:service_opt()]. +%% Extract Mask in the returned tuple so that diameter_traffic doesn't +%% need to know about the ordering of SvcOpts used here. pick_peer(SvcName, App, Opts) -> pick(lookup_state(SvcName), App, Opts). @@ -287,10 +294,10 @@ pick(#state{service = #diameter_service{applications = Apps}} Opts) -> %% initial call from diameter:call/4 pick(S, find_outgoing_app(Alias, Apps), Opts); -pick(_, false, _) -> - false; +pick(_, false = No, _) -> + No; -pick(#state{options = [{_, Mask} | _]} +pick(#state{options = [{_, Mask} | SvcOpts]} = S, #diameter_app{module = ModX, dictionary = Dict} = App0, @@ -299,7 +306,7 @@ pick(#state{options = [{_, Mask} | _]} [_,_] = RealmAndHost = diameter_lib:eval([DestF, Dict]), case pick_peer(App, RealmAndHost, Filter, S) of {TPid, Caps} -> - {{TPid, Caps, App}, Mask}; + {{TPid, Caps, App}, Mask, SvcOpts}; false = No -> No end. @@ -690,7 +697,8 @@ service_options(Opts) -> {restrict_connections, proplists:get_value(restrict_connections, Opts, ?RESTRICT)}, - {spawn_opt, proplists:get_value(spawn_opt, Opts, [])}]. + {spawn_opt, proplists:get_value(spawn_opt, Opts, [])}, + {string_decode, proplists:get_value(string_decode, Opts, true)}]. %% The order of options is significant since we match against the list. mref(false = No) -> @@ -802,10 +810,13 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, when Type == connect; Type == accept -> #diameter_service{applications = Apps} - = Svc + = Svc1 = merge_service(Opts, Svc0), - {_,_} = Mask = proplists:get_value(sequence, SvcOpts), - RecvData = diameter_traffic:make_recvdata([SvcName, PeerT, Apps, Mask]), + Svc = binary_caps(Svc1, proplists:get_value(string_decode, SvcOpts, true)), + RecvData = diameter_traffic:make_recvdata([SvcName, + PeerT, + Apps, + SvcOpts]), T = {{spawn_opts([Opts, SvcOpts]), RecvData}, Opts, SvcOpts, Svc}, Rec = #watchdog{type = Type, ref = Ref, @@ -816,8 +827,13 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, [], N). +binary_caps(Svc, true) -> + Svc; +binary_caps(#diameter_service{capabilities = Caps} = Svc, false) -> + Svc#diameter_service{capabilities = diameter_capx:binary_caps(Caps)}. + wd(Type, Ref, T, WatchdogT, Rec) -> - Pid = wd(Type, Ref, T), + Pid = start_watchdog(Type, Ref, T), insert(WatchdogT, Rec#watchdog{pid = Pid}), Pid. @@ -831,7 +847,7 @@ spawn_opts(Optss) -> T /= link, T /= monitor]. -wd(Type, Ref, T) -> +start_watchdog(Type, Ref, T) -> {_MRef, Pid} = diameter_watchdog:start({Type, Ref}, T), Pid. @@ -852,7 +868,7 @@ ms({applications, As}, #diameter_service{applications = Apps} = S) %% The fact that all capabilities can be configured on the transports %% means that the service doesn't necessarily represent a single -%% locally implemented Diameter peer as identified by Origin-Host: a +%% locally implemented Diameter node as identified by Origin-Host: a %% transport can configure its own Origin-Host. This means that the %% service little more than a placeholder for default capabilities %% plus a list of applications that individual transports can choose diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 0b503338a6..784f9ca08f 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. 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 @@ -77,7 +77,8 @@ {peerT :: ets:tid(), service_name :: diameter:service_name(), apps :: [#diameter_app{}], - sequence :: diameter:sequence()}). + sequence :: diameter:sequence(), + codec :: list()}). %% Record stored in diameter_request for each outgoing request. -record(request, @@ -92,11 +93,16 @@ %% # make_recvdata/1 %% --------------------------------------------------------------------------- -make_recvdata([SvcName, PeerT, Apps, Mask | _]) -> +make_recvdata([SvcName, PeerT, Apps, {_,_} = Mask | _]) -> %% from old code + make_recvdata([SvcName, PeerT, Apps, [{sequence, Mask}]]); + +make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) -> + {_,_} = Mask = proplists:get_value(sequence, SvcOpts), #recvdata{service_name = SvcName, peerT = PeerT, apps = Apps, - sequence = Mask}. + sequence = Mask, + codec = [T || {K,_} = T <- SvcOpts, K == string_decode]}. %% --------------------------------------------------------------------------- %% peer_up/1 @@ -270,8 +276,11 @@ recv_request(TPid, #diameter_packet{header = #diameter_header{application_id = Id}} = Pkt, Dict0, - #recvdata{peerT = PeerT, apps = Apps} + #recvdata{peerT = PeerT, + apps = Apps, + codec = Opts} = RecvData) -> + diameter_codec:setopts([{common_dictionary, Dict0} | Opts]), send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), TPid, Pkt, @@ -279,7 +288,13 @@ recv_request(TPid, RecvData), TPid, Dict0, - RecvData). + RecvData); + +recv_request(TPid, Pkt, Dict0, RecvData) -> %% from old code + recv_request(TPid, + Pkt, + Dict0, + #recvdata{} = erlang:append_element(RecvData, [])). %% recv_R/5 @@ -596,7 +611,7 @@ resend(false, Route = #diameter_avp{data = {Dict0, 'Route-Record', OH}}, Seq = diameter_session:sequence(Mask), Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], + Msg = [Hdr, Route | Avps], %% reordered at encode resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt). %% The incoming request is relayed with the addition of a %% Route-Record. Note the requirement on the return from call/4 below, @@ -1225,10 +1240,9 @@ answer_rc(_, _, Sent) -> send_R(SvcName, AppOrAlias, Msg, Opts, Caller) -> case pick_peer(SvcName, AppOrAlias, Msg, Opts) of - {{_,_,_} = Transport, Mask} -> + {Transport, Mask, SvcOpts} -> + diameter_codec:setopts(SvcOpts), send_request(Transport, Mask, Msg, Opts, Caller, SvcName); - false -> - {error, no_connection}; {error, _} = No -> No end. @@ -1290,6 +1304,8 @@ send_request({TPid, Caps, App} SvcName, []). +%% send_R/7 + send_R({send, Msg}, Pkt, Transport, Opts, Caller, SvcName, Fs) -> send_R(make_request_packet(Msg, Pkt), Transport, @@ -1550,7 +1566,9 @@ a(Hdr, SvcName, discard) -> %% timer value is ignored. This means that an answer could be accepted %% from a peer after timeout in the case of failover. -retransmit({{_,_,App} = Transport, _Mask}, Req, Opts, SvcName, Timeout) -> +%% retransmit/5 + +retransmit({{_,_,App} = Transport, _, _}, Req, Opts, SvcName, Timeout) -> try retransmit(Transport, Req, SvcName, Timeout) of T -> recv_A(Timeout, SvcName, App, Opts, T) catch @@ -1571,17 +1589,26 @@ pick_peer(SvcName, pick_peer(SvcName, App, Msg, Opts#options{extra = []}); pick_peer(_, _, undefined, _) -> - false; + {error, no_connection}; pick_peer(SvcName, AppOrAlias, Msg, #options{filter = Filter, extra = Xtra}) -> - diameter_service:pick_peer(SvcName, - AppOrAlias, - {fun(D) -> get_destination(D, Msg) end, - Filter, - Xtra}). + pick(diameter_service:pick_peer(SvcName, + AppOrAlias, + {fun(D) -> get_destination(D, Msg) end, + Filter, + Xtra})). + +pick({{_,_,_} = Transport, Mask}) -> %% from old code; dialyzer complains + {Transport, Mask, []}; %% about this + +pick(false) -> + {error, no_connection}; + +pick(T) -> + T. %% handle_error/4 @@ -1679,8 +1706,14 @@ recv(TPid, Pid, TRef, Ref) -> %% send/2 -send(Pid, Pkt) -> - Pid ! {send, Pkt}. +send(Pid, Pkt) -> %% Strip potentially large message terms. + #diameter_packet{header = H, + bin = Bin, + transport_data = T} + = Pkt, + Pid ! {send, #diameter_packet{header = H, + bin = Bin, + transport_data = T}}. %% retransmit/4 diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl index 442d90c98b..fe7613541c 100644 --- a/lib/diameter/src/base/diameter_types.erl +++ b/lib/diameter/src/base/diameter_types.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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 @@ -90,7 +90,12 @@ 'OctetString'(decode, Bin) when is_binary(Bin) -> - binary_to_list(Bin); + case diameter_codec:getopt(string_decode) of + true -> + binary_to_list(Bin); + _ -> + Bin + end; 'OctetString'(decode, B) -> ?INVALID_LENGTH(B); @@ -298,21 +303,29 @@ 'OctetString'(M, lists:duplicate(0,7)); 'DiameterURI'(encode, #diameter_uri{type = Type, - fqdn = D, - port = P, + fqdn = DN, + port = PN, transport = T, - protocol = Prot} - = U) -> - S = lists:append([atom_to_list(Type), "://", D, - ":", integer_to_list(P), + protocol = P}) + when (Type == 'aaa' orelse Type == 'aaas'), + is_integer(PN), + 0 =< PN, + (T == tcp orelse T == sctp orelse T == udp), + (P == diameter orelse P == radius orelse P == 'tacacs+'), + (P /= diameter orelse T /= udp) -> + iolist_to_binary([atom_to_list(Type), "://", DN, + ":", integer_to_list(PN), ";transport=", atom_to_list(T), - ";protocol=", atom_to_list(Prot)]), - U = scan_uri(S), %% assert - list_to_binary(S); + ";protocol=", atom_to_list(P)]); +%% Don't omit defaults since they're dependent on whether RFC 3588 or +%% 6733 is being followed. For one, we don't know this at encode; for +%% two (more importantly), we don't know how the peer will interpret +%% defaults, so it's best to be explicit. Interpret defaults on decode +%% since there's no choice. 'DiameterURI'(encode, Str) -> Bin = iolist_to_binary(Str), - #diameter_uri{} = scan_uri(Bin), %% type check + #diameter_uri{} = scan_uri(Bin), %% assert Bin. %% -------------------- @@ -321,7 +334,6 @@ 'IPFilterRule'(encode = M, zero) -> 'OctetString'(M, lists:duplicate(0,33)); -%% TODO: parse grammar. 'IPFilterRule'(M, X) -> 'OctetString'(M, X). @@ -331,7 +343,6 @@ 'QoSFilterRule'(encode = M, zero = X) -> 'IPFilterRule'(M, X); -%% TODO: parse grammar. 'QoSFilterRule'(M, X) -> 'OctetString'(M, X). @@ -339,7 +350,13 @@ 'UTF8String'(decode, Bin) when is_binary(Bin) -> - tl([0|_] = unicode:characters_to_list([0, Bin])); %% assert list return + case diameter_codec:getopt(string_decode) of + true -> + %% assert list return + tl([0|_] = unicode:characters_to_list([0, Bin])); + false -> + <<_/binary>> = unicode:characters_to_binary(Bin) + end; 'UTF8String'(decode, B) -> ?INVALID_LENGTH(B); @@ -507,55 +524,87 @@ msb(false) -> ?TIME_2036. %% %% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) -scan_uri(Bin) - when is_binary(Bin) -> - scan_uri(binary_to_list(Bin)); -scan_uri("aaa://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaa}); -scan_uri("aaas://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaas}). - -scan_fqdn(S, U) -> - {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), - scan_opt_port(Rest, U#diameter_uri{fqdn = F}). - -scan_opt_port(":" ++ S, U) -> - {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), - scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); -scan_opt_port(S, U) -> - scan_opt_transport(S, U). - -scan_opt_transport(";transport=" ++ S, U) -> - {P, Rest} = transport(S), - scan_opt_protocol(Rest, U#diameter_uri{transport = P}); -scan_opt_transport(S, U) -> - scan_opt_protocol(S, U). - -scan_opt_protocol(";protocol=" ++ S, U) -> - {P, ""} = protocol(S), - U#diameter_uri{protocol = P}; -scan_opt_protocol("", U) -> - U. - -transport("tcp" ++ S) -> - {tcp, S}; -transport("sctp" ++ S) -> - {sctp, S}; -transport("udp" ++ S) -> - {udp, S}. - -protocol("diameter" ++ S) -> - {diameter, S}; -protocol("radius" ++ S) -> - {radius, S}; -protocol("tacacs+" ++ S) -> - {'tacacs+', S}. - -is_fqdn(C) -> - is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. - -is_alpha(C) -> - ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). - -is_digit(C) -> - $0 =< C andalso C =< $9. +%% RFC 6733, 4.3.1, changes the defaults: +%% +%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; No transport security +%% +%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; Transport security used +%% +%% FQDN = < Fully Qualified Domain Name > +%% +%% port = ":" 1*DIGIT +%% +%% ; One of the ports used to listen for +%% ; incoming connections. +%% ; If absent, the default Diameter port +%% ; (3868) is assumed if no transport +%% ; security is used and port 5658 when +%% ; transport security (TLS/TCP and DTLS/SCTP) +%% ; is used. +%% +%% transport = ";transport=" transport-protocol +%% +%% ; One of the transports used to listen +%% ; for incoming connections. If absent, +%% ; the default protocol is assumed to be TCP. +%% ; UDP MUST NOT be used when the aaa-protocol +%% ; field is set to diameter. +%% +%% transport-protocol = ( "tcp" / "sctp" / "udp" ) +%% +%% protocol = ";protocol=" aaa-protocol +%% +%% ; If absent, the default AAA protocol +%% ; is Diameter. +%% +%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) + +scan_uri(Bin) -> + RE = "^(aaas?)://" + "([-a-zA-Z0-9.]+)" + "(:([0-9]+))?" + "(;transport=(tcp|sctp|udp))?" + "(;protocol=(diameter|radius|tacacs\\+))?$", + {match, [A, DN, PN, T, P]} = re:run(Bin, + RE, + [{capture, [1,2,4,6,8], binary}]), + Type = to_atom(A), + {PN0, T0} = defaults(diameter_codec:getopt(rfc), Type), + #diameter_uri{type = Type, + fqdn = from_bin(DN), + port = to_int(PN, PN0), + transport = to_atom(T, T0), + protocol = to_atom(P, diameter)}. + +%% Choose defaults based on the RFC, since 6733 has changed them. +defaults(3588, _) -> + {3868, sctp}; +defaults(6733, aaa) -> + {3868, tcp}; +defaults(6733, aaas) -> + {5658, tcp}. + +from_bin(B) -> + case diameter_codec:getopt(string_decode) of + true -> + binary_to_list(B); + false -> + B + end. + +to_int(<<>>, N) -> + N; +to_int(B, _) -> + binary_to_integer(B). + +to_atom(<<>>, A) -> + A; +to_atom(B, _) -> + to_atom(B). + +to_atom(B) -> + binary_to_atom(B, latin1). diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 67715906e8..de9c4bca33 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -124,14 +124,16 @@ i({Ack, T, Pid, {RecvData, wait(Ack, Pid), {_, Seed} = diameter_lib:seed(), random:seed(Seed), - putr(restart, {T, Opts, Svc}), %% save seeing it in trace - putr(dwr, dwr(Caps)), %% + putr(restart, {T, Opts, Svc, SvcOpts}), %% save seeing it in trace + putr(dwr, dwr(Caps)), %% {_,_} = Mask = proplists:get_value(sequence, SvcOpts), Restrict = proplists:get_value(restrict_connections, SvcOpts), Nodes = restrict_nodes(Restrict), Dict0 = common_dictionary(Apps), + diameter_codec:setopts([{common_dictionary, Dict0}, + {string_decode, false}]), #watchdog{parent = Pid, - transport = start(T, Opts, Mask, Nodes, Dict0, Svc), + transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc), tw = proplists:get_value(watchdog_timer, Opts, ?DEFAULT_TW_INIT), @@ -166,11 +168,11 @@ config({okay, N}, Rec) when ?IS_NATURAL(N) -> Rec#config{okay = N}. -%% start/5 +%% start/6 -start(T, Opts, Mask, Nodes, Dict0, Svc) -> +start(T, Opts, SvcOpts, Nodes, Dict0, Svc) -> {_MRef, Pid} - = diameter_peer_fsm:start(T, Opts, {Mask, Nodes, Dict0, Svc}), + = diameter_peer_fsm:start(T, Opts, {SvcOpts, Nodes, Dict0, Svc}), Pid. %% common_dictionary/1 @@ -320,7 +322,7 @@ code_change(_, State, _) -> %% expiry; or another watchdog is saying the same after reestablishing %% a connection previously had by this one. transition(close, #watchdog{}) -> - {{accept, _}, _, _} = getr(restart), %% assert + {accept, _} = role(), %% assert stop; %% Service is asking for the peer to be taken down gracefully. @@ -333,8 +335,9 @@ transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid, send(TPid, {T, self(), Reason}), S#watchdog{shutdown = true}; -%% Transport is telling us that DPA has been sent in response to DPR: -%% its death should lead to ours. +%% Transport is telling us that DPA has been sent in response to DPR, +%% or that DPR has been explicitly sent: transport death should lead +%% to ours. transition({'DPR', TPid}, #watchdog{transport = TPid} = S) -> S#watchdog{shutdown = true}; @@ -369,7 +372,7 @@ transition({open, TPid, Hosts, _} = Open, restrict = {_,R}, config = #config{suspect = OS}} = S) -> - case okay(getr(restart), Hosts, R) of + case okay(role(), Hosts, R) of okay -> set_watchdog(S#watchdog{status = okay, num_dwa = OS}); @@ -423,7 +426,7 @@ transition({'DOWN', _, process, TPid, _Reason} = D, = S0) -> S = S0#watchdog{pending = false, transport = undefined}, - {{M,_}, _, _} = getr(restart), + {M,_} = role(), %% Close an accepting watchdog immediately if there's no %% restriction on the number of connections to the same peer: the @@ -490,7 +493,7 @@ encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD} %% okay/3 -okay({{accept, Ref}, _, _}, Hosts, Restrict) -> +okay({accept, Ref}, Hosts, Restrict) -> T = {?MODULE, connection, Ref, Hosts}, diameter_reg:add(T), if Restrict -> @@ -501,7 +504,7 @@ okay({{accept, Ref}, _, _}, Hosts, Restrict) -> %% Register before matching so that at least one of two registering %% processes will match the other. -okay({{connect, _}, _, _}, _, _) -> +okay({connect, _}, _, _) -> okay. %% okay/2 @@ -516,6 +519,11 @@ okay(C) -> [_|_] = [send(P, close) || {_,P} <- C, self() /= P], reopen. +%% role/0 + +role() -> + element(1, getr(restart)). + %% set_watchdog/1 set_watchdog(#watchdog{tw = TwInit, @@ -550,7 +558,7 @@ send_watchdog(#watchdog{pending = false, ?LOG(send, 'DWR'), S#watchdog{pending = true}. -%% Dont' count encode errors since we don't expect any on DWR/DWA. +%% Don't count encode errors since we don't expect any on DWR/DWA. %% recv/3 @@ -572,11 +580,18 @@ rcv('DWR', Pkt, #watchdog{transport = TPid, DPkt = diameter_codec:decode(Dict0, Pkt), diameter_traffic:incr(recv, DPkt, TPid, Dict0), diameter_traffic:incr_error(recv, DPkt, TPid, Dict0), - EPkt = encode(dwa, Dict0, Pkt), + #diameter_packet{header = H, + transport_data = T, + bin = Bin} + = EPkt + = encode(dwa, Dict0, Pkt), diameter_traffic:incr(send, EPkt, TPid, Dict0), diameter_traffic:incr_rc(send, EPkt, TPid, Dict0), - send(TPid, {send, EPkt}), + %% Strip potentially large message terms. + send(TPid, {send, #diameter_packet{header = H, + transport_data = T, + bin = Bin}}), ?LOG(send, 'DWA'); rcv('DWA', Pkt, #watchdog{transport = TPid, @@ -591,9 +606,10 @@ rcv('DWA', Pkt, #watchdog{transport = TPid, rcv(N, _, _) when N == 'CER'; N == 'CEA'; - N == 'DPR'; - N == 'DPA' -> + N == 'DPR' -> false; +%% DPR can be sent explicitly with diameter:call/4. Only the +%% corresponding DPAs arrive here. rcv(_, Pkt, #watchdog{transport = TPid, dictionary = Dict0, @@ -794,26 +810,28 @@ restart(S) -> %% reconnect has won race with timeout %% state down rather then initial when receiving notification of an %% open connection. -restart({{connect, _} = T, Opts, Svc}, +restart({T, Opts, Svc}, S) -> %% put in old code + restart({T, Opts, Svc, []}, S); + +restart({{connect, _} = T, Opts, Svc, SvcOpts}, #watchdog{parent = Pid, - sequence = Mask, restrict = {R,_}, dictionary = Dict0} = S) -> send(Pid, {reconnect, self()}), Nodes = restrict_nodes(R), - S#watchdog{transport = start(T, Opts, Mask, Nodes, Dict0, Svc), + S#watchdog{transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc), restrict = {R, lists:member(node(), Nodes)}}; %% No restriction on the number of connections to the same peer: just %% die. Note that a state machine never enters state REOPEN in this %% case. -restart({{accept, _}, _, _}, #watchdog{restrict = {_, false}}) -> +restart({{accept, _}, _, _, _}, #watchdog{restrict = {_, false}}) -> stop; %% 'DOWN' was in old code: 'close' was not sent %% Otherwise hang around until told to die, either by the service or %% by another watchdog. -restart({{accept, _}, _, _}, S) -> +restart({{accept, _}, _, _, _}, S) -> S. %% Don't currently use Opts/Svc in the accept case. diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 881d25b5fb..a54eb24031 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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,32 @@ {"1.7.1", [{load_module, diameter_traffic}, %% 17.3 {load_module, diameter_watchdog}, {load_module, diameter_peer_fsm}, - {load_module, diameter_service}]} + {load_module, diameter_service}]}, + {"1.8", [{load_module, diameter_lib}, %% 17.4 + {load_module, diameter_peer}, + {load_module, diameter_reg}, + {load_module, diameter_session}, + {load_module, diameter_stats}, + {load_module, diameter_sync}, + {load_module, diameter_capx}, + {load_module, diameter_codec}, + {load_module, diameter_types}, + {load_module, diameter_traffic}, + {load_module, diameter_service}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_watchdog}, + {load_module, diameter_tcp}, + {load_module, diameter_sctp}, + {load_module, diameter_config}, + {load_module, diameter}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_relay}, + {update, diameter_transport_sup, supervisor}, + {update, diameter_service_sup, supervisor}, + {update, diameter_sup, supervisor}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -101,6 +126,31 @@ {"1.7.1", [{load_module, diameter_service}, {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, - {load_module, diameter_traffic}]} + {load_module, diameter_traffic}]}, + {"1.8", [{update, diameter_sup, supervisor}, + {update, diameter_service_sup, supervisor}, + {update, diameter_transport_sup, supervisor}, + {load_module, diameter_gen_relay}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter}, + {load_module, diameter_config}, + {load_module, diameter_sctp}, + {load_module, diameter_tcp}, + {load_module, diameter_watchdog}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_service}, + {load_module, diameter_traffic}, + {load_module, diameter_types}, + {load_module, diameter_codec}, + {load_module, diameter_capx}, + {load_module, diameter_sync}, + {load_module, diameter_stats}, + {load_module, diameter_session}, + {load_module, diameter_reg}, + {load_module, diameter_peer}, + {load_module, diameter_lib}]} ] }. diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index cf34c762e1..6975e83830 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -226,15 +226,18 @@ ignored({FromMod,_,_}, {ToMod,_,_} = To, Rel)-> %% New time api in OTP 18. time_api() -> - [{erlang, F, A} || {F,A} <- [{convert_time_resolution,3}, + [{erlang, F, A} || {F,A} <- [{convert_time_unit,3}, {monotonic_time,0}, {monotonic_time,1}, + {system_time,0}, + {system_time,1}, {time_offset,0}, {time_offset,1}, - {time_resolution,0}, {timestamp,0}, {unique_integer,0}, - {unique_integer,1}]]. + {unique_integer,1}]] + ++ [{os, system_time, 0}, + {os, system_time, 1}]. release() -> Rel = erlang:system_info(otp_release), diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index 472755c62a..854b71ba93 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -356,8 +356,15 @@ values('DiameterURI') -> Tr <- ["" | [";transport=" ++ X || X <- ["tcp", "sctp", "udp"]]], Pr <- ["" | [";protocol=" ++ X - || X <- ["diameter","radius","tacacs+"]]]], - []}; + || X <- ["diameter","radius","tacacs+"]]], + Tr /= ";transport=udp" + orelse (Pr /= ";protocol=diameter" andalso Pr /= "")], + ["aaa://diameter.se;transport=udp;protocol=diameter", + "aaa://diameter.se;transport=udp", + "aaa://:3868", + "aaax://diameter.se", + "aaa://diameter.se;transport=tcpx", + "aaa://diameter.se;transport=tcp;protocol=diameter "]}; values(T) when T == 'IPFilterRule'; diff --git a/lib/diameter/test/diameter_config_SUITE.erl b/lib/diameter/test/diameter_config_SUITE.erl index ad5b3f9420..77f7aace1b 100644 --- a/lib/diameter/test/diameter_config_SUITE.erl +++ b/lib/diameter/test/diameter_config_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. 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 @@ -82,6 +82,9 @@ [false], [[node(), node()]]], [[x]]}, + {string_decode, + [[true], [false]], + [[0], [x]]}, {invalid_option, %% invalid service options are rejected [], [[x], @@ -157,6 +160,12 @@ {length_errors, [[exit], [handle], [discard]], [[x]]}, + {dpr_timeout, + [[0], [3000], [16#FFFFFFFF]], + [[infinity], [-1], [1 bsl 32], [x]]}, + {dpa_timeout, + [[0], [3000], [16#FFFFFFFF]], + [[infinity], [-1], [1 bsl 32], [x]]}, {connect_timer, [[3000]], [[infinity]]}, @@ -171,6 +180,9 @@ [[{suspect, 2}]]], [[x], [[{open, 0}]]]}, + {pool_size, + [[1], [100]], + [[0], [infinity], [-1], [x]]}, {private, [[x]], []}, diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl index f3f16b06e0..81178e2bda 100644 --- a/lib/diameter/test/diameter_dpr_SUITE.erl +++ b/lib/diameter/test/diameter_dpr_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2014. All Rights Reserved. +%% Copyright Ericsson AB 2012-2015. 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 @@ -32,6 +32,7 @@ %% testcases -export([start/1, connect/1, + send_dpr/1, remove_transport/1, stop_service/1, check/1, @@ -41,6 +42,7 @@ -export([disconnect/5]). -include("diameter.hrl"). +-include("diameter_gen_base_rfc6733.hrl"). %% =========================================================================== @@ -51,9 +53,6 @@ -define(CLIENT, "CLIENT"). -define(SERVER, "SERVER"). --define(DICT_COMMON, ?DIAMETER_DICT_COMMON). --define(APP_ID, ?DICT_COMMON:id()). - %% Config for diameter:start_service/2. -define(SERVICE(Host), [{'Origin-Host', Host}, @@ -61,9 +60,10 @@ {'Host-IP-Address', [?ADDR]}, {'Vendor-Id', hd(Host)}, %% match this in disconnect/5 {'Product-Name', "OTP/diameter"}, - {'Acct-Application-Id', [?APP_ID]}, + {'Acct-Application-Id', [0]}, {restrict_connections, false}, - {application, [{dictionary, ?DICT_COMMON}, + {application, [{dictionary, diameter_gen_base_rfc6733}, + {alias, common}, {module, #diameter_callback{_ = false}}]}]). %% Disconnect reasons that diameter passes as the first argument of a @@ -74,10 +74,12 @@ -define(CAUSES, [0, rebooting, 1, busy, 2, goaway]). %% Establish one client connection for each element of this list, -%% configured with disconnect/5 as disconnect_cb and returning the -%% specified value. +%% configured with disconnect/5, disconnect_cb returning the specified +%% value. -define(RETURNS, - [[close, {dpr, [{cause, invalid}]}], [ignore, close], []] + [[close, {dpr, [{cause, invalid}]}], + [ignore, close], + []] ++ [[{dpr, [{timeout, 5000}, {cause, T}]}] || T <- ?CAUSES]). %% =========================================================================== @@ -86,7 +88,7 @@ suite() -> [{timetrap, {seconds, 60}}]. all() -> - [{group, R} || R <- ?REASONS]. + [start, send_dpr, stop | [{group, R} || R <- ?REASONS]]. %% The group determines how transports are terminated: by remove_transport, %% stop_service or application stop. @@ -111,6 +113,22 @@ start(_Config) -> ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). +send_dpr(_Config) -> + LRef = ?util:listen(?SERVER, tcp), + Ref = ?util:connect(?CLIENT, tcp, LRef, [{dpa_timeout, 10000}]), + #diameter_base_DPA{'Result-Code' = 2001} + = diameter:call(?CLIENT, + common, + ['DPR', {'Origin-Host', "CLIENT.erlang.org"}, + {'Origin-Realm', "erlang.org"}, + {'Disconnect-Cause', 0}]), + ok = receive %% endure the transport dies on DPA + #diameter_event{service = ?CLIENT, info = {down, Ref, _, _}} -> + ok + after 5000 -> + erlang:process_info(self(), messages) + end. + connect(Config) -> Pid = spawn(fun init/0), %% process for disconnect_cb to bang Grp = group(Config), diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 9822b95301..10c58ab6e7 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -122,8 +122,6 @@ -define(ADDR, {127,0,0,1}). --define(CLIENT, "CLIENT"). --define(SERVER, "SERVER"). -define(REALM, "erlang.org"). -define(HOST(Host, Realm), Host ++ [$.|Realm]). @@ -141,11 +139,19 @@ %% Which common dictionary to use in the clients. -define(RFCS, [rfc3588, rfc6733]). +%% Whether to decode stringish Diameter types to strings, or leave +%% them as binary. +-define(STRING_DECODES, [true, false]). + -record(group, - {client_encoding, + {client_service, + client_encoding, client_dict0, + client_strings, + server_service, server_encoding, - server_container}). + server_container, + server_strings}). %% Not really what we should be setting unless the message is sent in %% the common application but diameter doesn't care. @@ -166,7 +172,7 @@ ?answer_message(_, ResultCode)). %% Config for diameter:start_service/2. --define(SERVICE(Name), +-define(SERVICE(Name, Decode), [{'Origin-Host', Name ++ "." ++ ?REALM}, {'Origin-Realm', ?REALM}, {'Host-IP-Address', [?ADDR]}, @@ -175,6 +181,7 @@ {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]}, {restrict_connections, false}, + {string_decode, Decode}, {spawn_opt, [{min_heap_size, 5000}]} | [{application, [{dictionary, D}, {module, ?MODULE}, @@ -227,28 +234,53 @@ suite() -> [{timetrap, {seconds, 60}}]. all() -> - [start, start_services, add_transports, result_codes] - ++ [{group, ?util:name([R,D,A,C]), P} || R <- ?ENCODINGS, - D <- ?RFCS, - A <- ?ENCODINGS, - C <- ?CONTAINERS, - P <- [[], [parallel]]] - ++ [outstanding, remove_transports, empty, stop_services, stop]. + [start, result_codes, {group, traffic}, outstanding, empty, stop]. groups() -> Ts = tc(), - [{?util:name([R,D,A,C]), [], Ts} || R <- ?ENCODINGS, - D <- ?RFCS, - A <- ?ENCODINGS, - C <- ?CONTAINERS]. + [{?util:name([R,D,A,C]), [parallel], Ts} || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS] + ++ + [{?util:name([R,D,A,C,SD,CD]), + [], + [start_services, + add_transports, + result_codes, + {group, ?util:name([R,D,A,C])}, + remove_transports, + stop_services]} + || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS, + SD <- ?STRING_DECODES, + CD <- ?STRING_DECODES] + ++ + [{traffic, [parallel], [{group, ?util:name([R,D,A,C,SD,CD])} + || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS, + SD <- ?STRING_DECODES, + CD <- ?STRING_DECODES]}]. init_per_group(Name, Config) -> - [R,D,A,C] = ?util:name(Name), - G = #group{client_encoding = R, - client_dict0 = dict0(D), - server_encoding = A, - server_container = C}, - [{group, G} | Config]. + case ?util:name(Name) of + [R,D,A,C,SD,CD] -> + G = #group{client_service = [$C|?util:unique_string()], + client_encoding = R, + client_dict0 = dict0(D), + client_strings = CD, + server_service = [$S|?util:unique_string()], + server_encoding = A, + server_container = C, + server_strings = SD}, + [{group, G} | Config]; + _ -> + Config + end. end_per_group(_, _) -> ok. @@ -319,18 +351,26 @@ tc() -> start(_Config) -> ok = diameter:start(). -start_services(_Config) -> - ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), - ok = diameter:start_service(?CLIENT, [{sequence, ?CLIENT_MASK} - | ?SERVICE(?CLIENT)]). +start_services(Config) -> + #group{client_service = CN, + client_strings = CD, + server_service = SN, + server_strings = SD} + = group(Config), + ok = diameter:start_service(SN, ?SERVICE(SN, SD)), + ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK} + | ?SERVICE(CN, CD)]). add_transports(Config) -> - LRef = ?util:listen(?SERVER, + #group{client_service = CN, + server_service = SN} + = group(Config), + LRef = ?util:listen(SN, tcp, [{capabilities_cb, fun capx/2}, {spawn_opt, [{min_heap_size, 8096}]}, {applications, apps(rfc3588)}]), - Cs = [?util:connect(?CLIENT, + Cs = [?util:connect(CN, tcp, LRef, [{id, Id}, @@ -354,12 +394,18 @@ outstanding(_Config) -> is_atom(element(1,T))]. remove_transports(Config) -> + #group{client_service = CN, + server_service = SN} + = group(Config), [LRef | Cs] = ?util:read_priv(Config, "transport"), - [?util:disconnect(?CLIENT, C, ?SERVER, LRef) || C <- Cs]. + [?util:disconnect(CN, C, SN, LRef) || C <- Cs]. -stop_services(_Config) -> - ok = diameter:stop_service(?CLIENT), - ok = diameter:stop_service(?SERVER). +stop_services(Config) -> + #group{client_service = CN, + server_service = SN} + = group(Config), + ok = diameter:stop_service(CN), + ok = diameter:stop_service(SN). %% Ensure even transports have been removed from request table. empty(_Config) -> @@ -439,8 +485,9 @@ send_arbitrary(Config) -> ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), {'AVP', [#diameter_avp{name = 'Product-Name', - value = "XXX"}]} - = lists:last(Avps). + value = V}]} + = lists:last(Avps), + "XXX" = string(V, Config). %% Send an unknown AVP (to some client) and check that it comes back. send_unknown(Config) -> @@ -594,9 +641,11 @@ send_nopeer(Config) -> {error, no_connection} = call(Config, Req, [{extra, [?EXTRA]}]). %% Send something on an unconfigured application. -send_noapp(_Config) -> +send_noapp(Config) -> + #group{client_service = CN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}], - {error, no_connection} = diameter:call(?CLIENT, unknown_alias, Req). + {error, no_connection} = diameter:call(CN, unknown_alias, Req). %% Send something that's discarded by prepare_request. send_discard(Config) -> @@ -608,8 +657,10 @@ send_any_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], {error, no_connection} = call(Config, Req, [{filter, {any, []}}]). send_any_2(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req, [{filter, {any, [host, realm]}}]). @@ -621,8 +672,10 @@ send_all_1(Config) -> = call(Config, Req, [{filter, {all, [{host, any}, {realm, Realm}]}}]). send_all_2(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). @@ -655,8 +708,10 @@ send_encode_error(Config) -> %% Send with filtering and expect success. send_destination_1(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, ?REALM)]}], + {'Destination-Host', [?HOST(SN, ?REALM)]}], ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_2(Config) -> @@ -672,8 +727,10 @@ send_destination_3(Config) -> {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_4(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). @@ -685,8 +742,10 @@ send_destination_5(Config) -> ?answer_message(?REALM_NOT_SERVED) = call(Config, Req). send_destination_6(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req). @@ -748,16 +807,31 @@ send_anything(Config) -> %% =========================================================================== +group(Config) -> + #group{} = proplists:get_value(group, Config). + +string(V, Config) -> + #group{client_strings = B} = group(Config), + decode(V,B). + +decode(S, true) + when is_list(S) -> + S; +decode(B, false) + when is_binary(B) -> + binary_to_list(B). + call(Config, Req) -> call(Config, Req, []). call(Config, Req, Opts) -> Name = proplists:get_value(testcase, Config), - #group{client_encoding = ReqEncoding, + #group{client_service = CN, + client_encoding = ReqEncoding, client_dict0 = Dict0} = Group - = proplists:get_value(group, Config), - diameter:call(?CLIENT, + = group(Config), + diameter:call(CN, dict(Req, Dict0), msg(Req, ReqEncoding, Dict0), [{extra, [{Name, Group}, diameter_lib:now()]} | Opts]). @@ -844,35 +918,38 @@ peer_down(_SvcName, _Peer, State) -> %% pick_peer/6-7 -pick_peer(Peers, _, ?CLIENT, _State, {Name, Group}, _) +pick_peer(Peers, _, [$C|_], _State, {Name, Group}, _) when Name /= send_detach -> find(Group, Peers). -pick_peer(_Peers, _, ?CLIENT, _State, {send_nopeer, _}, _, ?EXTRA) -> +pick_peer(_Peers, _, [$C|_], _State, {send_nopeer, _}, _, ?EXTRA) -> false; -pick_peer(Peers, _, ?CLIENT, _State, {send_detach, Group}, _, {_,_}) -> +pick_peer(Peers, _, [$C|_], _State, {send_detach, Group}, _, {_,_}) -> find(Group, Peers). -find(#group{server_encoding = A, server_container = C}, Peers) -> +find(#group{client_service = CN, + server_encoding = A, + server_container = C}, + Peers) -> Id = {A,C}, - [P] = [P || P <- Peers, id(Id, P)], + [P] = [P || P <- Peers, id(Id, P, CN)], {ok, P}. -id(Id, {Pid, _Caps}) -> +id(Id, {Pid, _Caps}, SvcName) -> [{ref, _}, {type, _}, {options, Opts} | _] - = diameter:service_info(?CLIENT, Pid), + = diameter:service_info(SvcName, Pid), lists:member({id, Id}, Opts). %% prepare_request/5-6 -prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, {send_discard, _}, _) -> +prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, {send_discard, _}, _) -> {discard, unprepared}; -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {Name, Group}, _) -> +prepare_request(Pkt, [$C|_], {_Ref, Caps}, {Name, Group}, _) -> {send, prepare(Pkt, Caps, Name, Group)}. -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {send_detach, Group}, _, _) -> +prepare_request(Pkt, [$C|_], {_Ref, Caps}, {send_detach, Group}, _, _) -> {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. log(#diameter_packet{bin = Bin} = P, T) @@ -1043,10 +1120,10 @@ prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) -> %% handle_answer/6-7 -handle_answer(Pkt, Req, ?CLIENT, Peer, {Name, Group}, _) -> +handle_answer(Pkt, Req, [$C|_], Peer, {Name, Group}, _) -> answer(Pkt, Req, Peer, Name, Group). -handle_answer(Pkt, Req, ?CLIENT, Peer, {send_detach = Name, Group}, _, X) -> +handle_answer(Pkt, Req, [$C|_], Peer, {send_detach = Name, Group}, _, X) -> {Pid, Ref} = X, Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}. @@ -1075,13 +1152,13 @@ app(Req, _, Dict0) -> %% handle_error/6 -handle_error(timeout = Reason, _Req, ?CLIENT, _Peer, _, Time) -> +handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, Time) -> Now = diameter_lib:now(), {Reason, {diameter_lib:timestamp(Time), diameter_lib:timestamp(Now), diameter_lib:micro_diff(Now, Time)}}; -handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) -> +handle_error(Reason, _Req, [$C|_], _Peer, _, _Time) -> {error, Reason}. %% handle_request/3 @@ -1089,7 +1166,7 @@ handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) -> %% Note that diameter will set Result-Code and Failed-AVPs if %% #diameter_packet.errors is non-null. -handle_request(#diameter_packet{header = H, msg = M}, ?SERVER, {_Ref, Caps}) -> +handle_request(#diameter_packet{header = H, msg = M}, _, {_Ref, Caps}) -> #diameter_header{end_to_end_id = EI, hop_by_hop_id = HI} = H, diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 587ae08b3d..c00bac26bb 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -1,8 +1,6 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2014. All Rights Reserved. +# Copyright Ericsson AB 2010-2015. 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 @@ -18,5 +16,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.8 +DIAMETER_VSN = 1.9 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc index 0ced8cab32..3639bb43a5 100644 --- a/lib/edoc/doc/overview.edoc +++ b/lib/edoc/doc/overview.edoc @@ -78,7 +78,7 @@ The following are the main functions for running EDoc: typical Erlang application.</li> <li>{@link edoc:files/2}: Creates documentation for a specified set of source files.</li> - <li>{@link edoc:run/3}: General interface function; the common + <li>{@link edoc:run/2}: General interface function; the common back-end for the above functions. Options are documented here.</li> </ul> diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 78915e8943..88e7ab5346 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -313,7 +313,7 @@ opt_negations() -> %% INHERIT-OPTIONS: target_dir_info/5 %% INHERIT-OPTIONS: edoc_lib:find_sources/2 %% INHERIT-OPTIONS: edoc_lib:run_doclet/2 -%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4 +%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3 run(Files, Opts0) -> Opts = expand_opts(Opts0), @@ -421,7 +421,7 @@ toc(Dir, Opts) -> %% INHERIT-OPTIONS: init_context/1 %% INHERIT-OPTIONS: edoc_lib:run_doclet/2 -%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4 +%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3 toc(Dir, Paths, Opts0) -> Opts = expand_opts(Opts0 ++ [{dir, Dir}]), @@ -769,7 +769,7 @@ get_doc(File) -> %% </dl> %% %% See {@link read_source/2}, {@link read_comments/2} and {@link -%% edoc_lib:get_doc_env/4} for further options. +%% edoc_lib:get_doc_env/3} for further options. %% %% @see get_doc/3 %% @see run/2 @@ -778,7 +778,7 @@ get_doc(File) -> %% @see layout/2 %% INHERIT-OPTIONS: get_doc/3 -%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4 +%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3 get_doc(File, Opts) -> Env = edoc_lib:get_doc_env(Opts), @@ -790,7 +790,7 @@ get_doc(File, Opts) -> %% %% @doc Like {@link get_doc/2}, but for a given environment %% parameter. `Env' is an environment created by {@link -%% edoc_lib:get_doc_env/4}. +%% edoc_lib:get_doc_env/3}. %% INHERIT-OPTIONS: read_source/2, read_comments/2, edoc_extract:source/5 %% DEFER-OPTIONS: get_doc/2 diff --git a/lib/edoc/src/edoc_extract.erl b/lib/edoc/src/edoc_extract.erl index 6d34de3a85..758750083d 100644 --- a/lib/edoc/src/edoc_extract.erl +++ b/lib/edoc/src/edoc_extract.erl @@ -91,7 +91,7 @@ source(Forms, Comments, File, Env, Opts) -> %% type `form_list', or a list of syntax trees representing %% "program forms" (cf. {@link edoc:read_source/2}. %% `Env' is an environment created by {@link -%% edoc_lib:get_doc_env/4}. The `File' argument is used for +%% edoc_lib:get_doc_env/3}. The `File' argument is used for %% error reporting and output file name generation only. %% %% See {@link edoc:get_doc/2} for descriptions of the `def', @@ -222,7 +222,7 @@ add_macro_defs(Defs0, Opts, Env) -> %% %% @doc Reads a text file and returns the list of tags in the file. Any %% lines of text before the first tag are ignored. `Env' is an -%% environment created by {@link edoc_lib:get_doc_env/4}. Upon error, +%% environment created by {@link edoc_lib:get_doc_env/3}. Upon error, %% `Reason' is an atom returned from the call to {@link %% //kernel/file:read_file/1} or the atom 'invalid_unicode'. %% @@ -252,7 +252,7 @@ file(File, Context, Env, Opts) -> %% %% @doc Returns the list of tags in the text. Any lines of text before %% the first tag are ignored. `Env' is an environment created by {@link -%% edoc_lib:get_doc_env/4}. +%% edoc_lib:get_doc_env/3}. %% %% See {@link source/4} for a description of the `def' option. diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index 813fcf2476..c248964dc4 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -888,7 +888,7 @@ find_doc_dirs([]) -> %% implies that we use the default app-path. %% NEW-OPTIONS: doc_path -%% DEFER-OPTIONS: get_doc_env/4 +%% DEFER-OPTIONS: get_doc_env/3 get_doc_links(App, Modules, Opts) -> Path = proplists:append_values(doc_path, Opts) ++ find_doc_dirs(), @@ -924,7 +924,7 @@ add_new(K, V, D) -> end. %% @spec (Options::proplist()) -> edoc_env() -%% @equiv get_doc_env([], [], [], Opts) +%% @equiv get_doc_env([], [], Opts) %% @private get_doc_env(Opts) -> @@ -940,7 +940,7 @@ get_doc_env(Opts) -> %% generating references. The data representation is not documented. %% %% @doc Creates an environment data structure used by parts of EDoc for -%% generating references, etc. See {@link edoc:run/3} for a description +%% generating references, etc. See {@link edoc:run/2} for a description %% of the options `file_suffix', `app_default' and `doc_path'. %% %% @see edoc_extract:source/4 @@ -948,7 +948,7 @@ get_doc_env(Opts) -> %% NEW-OPTIONS: file_suffix, app_default %% INHERIT-OPTIONS: get_doc_links/4 -%% DEFER-OPTIONS: edoc:run/3 +%% DEFER-OPTIONS: edoc:run/2 get_doc_env(App, Modules, Opts) -> Suffix = proplists:get_value(file_suffix, Opts, @@ -967,10 +967,10 @@ get_doc_env(App, Modules, Opts) -> %% --------------------------------------------------------------------- %% Plug-in modules -%% @doc See {@link edoc:run/3} for a description of the `doclet' option. +%% @doc See {@link edoc:run/2} for a description of the `doclet' option. %% NEW-OPTIONS: doclet -%% DEFER-OPTIONS: edoc:run/3 +%% DEFER-OPTIONS: edoc:run/2 %% @private run_doclet(Fun, Opts) -> diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index b68115cd82..ed35ee3a9c 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -103,7 +103,7 @@ filter() See present/1, substrings/2, <type> <v>Handle = handle()</v> <v>Options = ssl:ssl_options()</v> - <v>Timeout = inifinity | positive_integer()</v> + <v>Timeout = infinity | positive_integer()</v> </type> <desc> <p>Upgrade the connection associated with <c>Handle</c> to a tls connection if possible.</p> diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 432ba2e742..adca41ed63 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.1 +ELDAP_VSN = 1.1.1 diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index c56de378f4..2aae87a759 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -66,7 +66,7 @@ a:visited { color: blue; text-decoration: none } span.bold_code { font-family: Courier, monospace; font-weight: bold } span.code { font-family: Courier, monospace; font-weight: normal } -.note, .warning { +.note, .warning, .do, .dont { border: solid black 1px; margin: 1em 3em; } @@ -96,6 +96,32 @@ span.code { font-family: Courier, monospace; font-weight: normal } font-size: 90%; padding: 5px 10px; } +.do .label { + background: #30d42a; + color: white; + font-weight: bold; + padding: 5px 10px; +} +.do .content { + background: #eafeea; + color: black; + line-height: 120%; + font-size: 90%; + padding: 5px 10px; +} +.dont .label { + background: #C00; + color: white; + font-weight: bold; + padding: 5px 10px; +} +.dont .content { + background: #FFF0F0; + color: black; + line-height: 120%; + font-size: 90%; + padding: 5px 10px; +} .example { background-color:#eeeeff; padding: 0px 10px; diff --git a/lib/erl_docgen/priv/dtd/application.dtd b/lib/erl_docgen/priv/dtd/application.dtd index 8a1e8832ec..fcadaced72 100644 --- a/lib/erl_docgen/priv/dtd/application.dtd +++ b/lib/erl_docgen/priv/dtd/application.dtd @@ -24,6 +24,6 @@ %common.header; <!ELEMENT application (header,description?,include+) > -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT include EMPTY > <!ATTLIST include file CDATA #REQUIRED> diff --git a/lib/erl_docgen/priv/dtd/book.dtd b/lib/erl_docgen/priv/dtd/book.dtd index bb89a6d255..ef723a9eed 100644 --- a/lib/erl_docgen/priv/dtd/book.dtd +++ b/lib/erl_docgen/priv/dtd/book.dtd @@ -38,7 +38,7 @@ <!ELEMENT pagetext (#PCDATA) > <!ELEMENT preamble (contents?,preface?) > -<!ELEMENT preface (title?,(%block;|quote|br|marker|warning|note|table)*) > +<!ELEMENT preface (title?,(%block;|quote|br|marker|warning|note|dont|do|table)*) > <!ELEMENT insidecover (#PCDATA|br|theheader|vfill|vspace|tt|bold| include)* > @@ -67,7 +67,7 @@ <!ELEMENT onepart (title?,description?,include+) > <!ATTLIST onepart lift (yes|no) "no" > -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT include EMPTY > <!ATTLIST include file CDATA #REQUIRED> diff --git a/lib/erl_docgen/priv/dtd/chapter.dtd b/lib/erl_docgen/priv/dtd/chapter.dtd index eb2c96b04f..4beff6cc54 100644 --- a/lib/erl_docgen/priv/dtd/chapter.dtd +++ b/lib/erl_docgen/priv/dtd/chapter.dtd @@ -29,8 +29,8 @@ <!-- Structure --> -<!ELEMENT chapter (header,(%block;|quote|warning|note|br| +<!ELEMENT chapter (header,(%block;|quote|warning|note|dont|do|br| image|marker|table)*,section+) > <!ELEMENT section (marker*,title, - (%block;|quote|warning|note|br|image|marker| + (%block;|quote|warning|note|dont|do|br|image|marker| table|section)*) > diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index f999ef8ea4..92d814e0f1 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -34,6 +34,8 @@ <!ELEMENT quote (p)* > <!ELEMENT warning (%block;|quote|br|marker)* > <!ELEMENT note (%block;|quote|br|marker)* > +<!ELEMENT dont (%block;|quote|br|marker)* > +<!ELEMENT do (%block;|quote|br|marker)* > <!ELEMENT c (#PCDATA) > <!ELEMENT em (#PCDATA|c)* > diff --git a/lib/erl_docgen/priv/dtd/common.refs.dtd b/lib/erl_docgen/priv/dtd/common.refs.dtd index 93592607df..a08b9e89d4 100644 --- a/lib/erl_docgen/priv/dtd/common.refs.dtd +++ b/lib/erl_docgen/priv/dtd/common.refs.dtd @@ -24,7 +24,7 @@ <!ENTITY % common.header SYSTEM "common.header.dtd" > %common.header; -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT funcs (func)+ > <!ELEMENT func (name+,type_desc*,fsummary,type?,desc?) > <!-- ELEMENT name is defined in each ref dtd --> @@ -34,12 +34,12 @@ name_i CDATA #IMPLIED> <!ELEMENT v (#PCDATA) > <!ELEMENT d (#PCDATA|c|em)* > -<!ELEMENT desc (%block;|quote|br|marker|warning|note|anno)* > +<!ELEMENT desc (%block;|quote|br|marker|warning|note|dont|do|anno)* > <!ELEMENT authors (aname,email)+ > <!ELEMENT aname (#PCDATA) > <!ELEMENT email (#PCDATA) > <!ELEMENT section (marker*,title,(%block;|quote|br|marker| - warning|note)*) > + warning|note|dont|do)*) > <!ELEMENT datatypes (datatype)+ > <!ELEMENT datatype (name+,desc?) > <!ELEMENT type_desc (#PCDATA) > diff --git a/lib/erl_docgen/priv/dtd/part.dtd b/lib/erl_docgen/priv/dtd/part.dtd index 3f97199042..79f68c415d 100644 --- a/lib/erl_docgen/priv/dtd/part.dtd +++ b/lib/erl_docgen/priv/dtd/part.dtd @@ -24,6 +24,6 @@ %common.header; <!ELEMENT part (header,description?,include+) > -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT include EMPTY > <!ATTLIST include file CDATA #REQUIRED> diff --git a/lib/erl_docgen/priv/dtd/report.dtd b/lib/erl_docgen/priv/dtd/report.dtd index 3d07e6e5a7..eb463f8867 100644 --- a/lib/erl_docgen/priv/dtd/report.dtd +++ b/lib/erl_docgen/priv/dtd/report.dtd @@ -48,7 +48,7 @@ <!ELEMENT file (#PCDATA) > <!ELEMENT section (marker*,title, - (%block;|quote|warning|note|br|image|marker| + (%block;|quote|warning|note|dont|do|br|image|marker| table|section)*) > <!ELEMENT p (%inline;|index)* > <!ELEMENT pre (#PCDATA|seealso|url|input)* > @@ -58,6 +58,8 @@ <!ELEMENT quote (p)* > <!ELEMENT warning (%block;|quote|br|image|marker|table)* > <!ELEMENT note (%block;|quote|br|image|marker|table)* > +<!ELEMENT dont (%block;|quote|br|image|marker|table)* > +<!ELEMENT do (%block;|quote|br|image|marker|table)* > <!ELEMENT i (#PCDATA|b|c|em)* > <!ELEMENT b (#PCDATA|i|c|em)* > <!ELEMENT c (#PCDATA) > diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index ab5f24c406..3b390f48fb 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -952,6 +952,36 @@ </div> </xsl:template> + <!-- Do --> + <xsl:template match="do"> + <xsl:param name="chapnum"/> + <div class="do"> + <div class="label">Do</div> + <div class="content"> + <p> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </p> + </div> + </div> + </xsl:template> + + <!-- Dont --> + <xsl:template match="dont"> + <xsl:param name="chapnum"/> + <div class="dont"> + <div class="label">Don't</div> + <div class="content"> + <p> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </p> + </div> + </div> + </xsl:template> + <!-- Paragraph --> <xsl:template match="p"> <p> diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index 3bcdd11c35..0caaba560f 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -543,7 +543,29 @@ <xsl:text> </xsl:text> </xsl:template> - <xsl:template match="warning/p | note/p"> + <!-- Do --> + <xsl:template match="do"> + <xsl:text> .LP </xsl:text> + <xsl:text> .RS -4</xsl:text> + <xsl:text> .B </xsl:text> + <xsl:text>Do:</xsl:text> + <xsl:text> .RE</xsl:text> + <xsl:apply-templates/> + <xsl:text> </xsl:text> + </xsl:template> + + <!-- Dont --> + <xsl:template match="dont"> + <xsl:text> .LP </xsl:text> + <xsl:text> .RS -4</xsl:text> + <xsl:text> .B </xsl:text> + <xsl:text>Dont:</xsl:text> + <xsl:text> .RE</xsl:text> + <xsl:apply-templates/> + <xsl:text> </xsl:text> + </xsl:template> + + <xsl:template match="warning/p | note/p | dont/p | do/p"> <xsl:variable name="content"> <xsl:text> </xsl:text> <xsl:apply-templates/> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index c15b16eb5b..8e7ffddefa 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -1138,6 +1138,31 @@ </fo:block> </xsl:template> + <!-- Do --> + <xsl:template match="do"> + <xsl:param name="partnum"/> + <fo:block xsl:use-attribute-sets="do"> + <fo:block xsl:use-attribute-sets="note-warning-title"> + <xsl:text>Do:</xsl:text> + </fo:block> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> + </xsl:template> + + <!-- Dont --> + <xsl:template match="dont"> + <xsl:param name="partnum"/> + <fo:block xsl:use-attribute-sets="dont"> + <fo:block xsl:use-attribute-sets="note-warning-title"> + <xsl:text>Don't:</xsl:text> + </fo:block> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> + </xsl:template> <!-- Paragraph --> <xsl:template match="p"> diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl index 2e3b22acf4..c2d9fb4320 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl @@ -289,6 +289,33 @@ <xsl:attribute name="keep-together.within-page">always</xsl:attribute> </xsl:attribute-set> +<xsl:attribute-set name="do"> + <xsl:attribute name="background-color">#d0fed0</xsl:attribute> + <xsl:attribute name="space-after">1em</xsl:attribute> + <xsl:attribute name="space-before">2em</xsl:attribute> + <xsl:attribute name="text-align">justify</xsl:attribute> + <xsl:attribute name="padding-before">1em</xsl:attribute> + <xsl:attribute name="padding-after">0.3em</xsl:attribute> + <xsl:attribute name="padding-left">0.5em</xsl:attribute> + <xsl:attribute name="padding-right">0.5em</xsl:attribute> + <xsl:attribute name="margin-left">0.5em</xsl:attribute> + <xsl:attribute name="margin-right">0.5em</xsl:attribute> + <xsl:attribute name="keep-together.within-page">always</xsl:attribute> + </xsl:attribute-set> + +<xsl:attribute-set name="dont"> + <xsl:attribute name="background-color">#ffd6d6</xsl:attribute> + <xsl:attribute name="space-after">1em</xsl:attribute> + <xsl:attribute name="space-before">2em</xsl:attribute> + <xsl:attribute name="text-align">justify</xsl:attribute> + <xsl:attribute name="padding-before">1em</xsl:attribute> + <xsl:attribute name="padding-after">0.3em</xsl:attribute> + <xsl:attribute name="padding-left">0.5em</xsl:attribute> + <xsl:attribute name="padding-right">0.5em</xsl:attribute> + <xsl:attribute name="margin-left">0.5em</xsl:attribute> + <xsl:attribute name="margin-right">0.5em</xsl:attribute> + <xsl:attribute name="keep-together.within-page">always</xsl:attribute> + </xsl:attribute-set> <xsl:attribute-set name="note-warning-title"> <xsl:attribute name="font-size">1.33em</xsl:attribute> diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index e81212d4dc..22ea71b4e6 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -224,4 +224,4 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.0","kernel-3.0", - "erts-6.0","compiler-5.0"]}]}. + "erts-7.0","compiler-5.0"]}]}. 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 index 31abf15d49..ccacbfe5c8 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl @@ -10,23 +10,25 @@ test() -> 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}), + true = #{ a => 1 } < id(#{ b => 1}), + false = #{ b => 1 } < id(#{ a => 1}), + true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}), + true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), + false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), + false = #{ 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 = #{ a => 1 } < id(#{ a => 2}), + false = #{ a => 2 } < id(#{ a => 1}), + false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), + true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + false = #{ a => 1 } < id(#{ a => 1.0}), + false = #{ a => 1.0 } < id(#{ a => 1}), - true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}), + true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), %% lists:sort @@ -34,7 +36,6 @@ test() -> [#{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. diff --git a/lib/hipe/tools/hipe_timer.erl b/lib/hipe/tools/hipe_timer.erl index 03cc358f17..5f44bc066d 100644 --- a/lib/hipe/tools/hipe_timer.erl +++ b/lib/hipe/tools/hipe_timer.erl @@ -46,27 +46,27 @@ tr(F) -> {R,{WT-EWT,(RT-ERT)/1000}}. empty_time() -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}. + {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}. time(F) -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), F(), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}. + {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}. timer(F) -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), R = F(), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {R,{(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}}. + {R,{(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}}. advanced(_Fun, I) when I < 2 -> false; advanced(Fun, Iterations) -> diff --git a/lib/inets/examples/httpd_load_test/hdlt_random_html.erl b/lib/inets/examples/httpd_load_test/hdlt_random_html.erl index e3a572c61f..59073a3d23 100644 --- a/lib/inets/examples/httpd_load_test/hdlt_random_html.erl +++ b/lib/inets/examples/httpd_load_test/hdlt_random_html.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. 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 @@ -48,7 +48,10 @@ stop() -> ". content(WorkSim, SzSim) -> - {A, B, C} = now(), + {A, B, C} = {erlang:phash2([node()]), + inets_time_compat:monotonic_time(), + inets_time_compat:unique_integer()}, + random:seed(A, B, C), lists:sort([random:uniform(X) || X <- lists:seq(1, WorkSim)]), lists:flatten(lists:duplicate(SzSim, "Dummy data ")). diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 8e51b1be5a..7eebe8d5bf 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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 @@ -2176,16 +2176,16 @@ handle_caller(#state{caller = {transfer_data, {Cmd, Bin, RemoteFile}}} = %% Connect to FTP server at Host (default is TCP port 21) %% in order to establish a control connection. setup_ctrl_connection(Host, Port, Timeout, State) -> - MsTime = millisec_time(), + MsTime = inets_time_compat:monotonic_time(), case connect(Host, Port, Timeout, State) of {ok, IpFam, CSock} -> NewState = State#state{csock = {tcp, CSock}, ipfamily = IpFam}, activate_ctrl_connection(NewState), - case Timeout - (millisec_time() - MsTime) of + case Timeout - inets_lib:millisec_passed(MsTime) of Timeout2 when (Timeout2 >= 0) -> {ok, NewState#state{caller = open}, Timeout2}; _ -> - %% Oups: Simulate timeout + %% Oups: Simulate timeout {ok, NewState#state{caller = open}, 0} end; Error -> @@ -2501,10 +2501,6 @@ progress_report(Report, #state{progress = ProgressPid}) -> ftp_progress:report(ProgressPid, Report). -millisec_time() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - peername({tcp, Socket}) -> inet:peername(Socket); peername({ssl, Socket}) -> ssl:peername(Socket). diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index ed306a84f5..35778d3ed5 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -115,8 +115,8 @@ maybe_dets_close(Db) -> %%-------------------------------------------------------------------- -%% Func: insert(CookieDb) -> ok -%% Purpose: Close the cookie db +%% Func: insert(CookieDb, Cookie) -> ok +%% Purpose: insert cookies into the cookie db %%-------------------------------------------------------------------- %% If no persistent cookie database is defined we diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 7f7328f1d9..8f2f11ce8e 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. 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 @@ -1122,7 +1122,7 @@ handle_http_body(Body, #state{headers = Headers, handle_response(State#state{headers = NewHeaders, body = NewBody}); _ -> - {NewBody2, NewRequest} = + {NewBody2, _NewRequest} = stream(NewBody, Request, Code), handle_response(State#state{headers = NewHeaders, body = NewBody2}) diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 22426eee79..926585f198 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2015. 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 @@ -47,7 +47,9 @@ MODULES = \ inets_app \ inets_sup \ inets_regexp \ - inets_trace + inets_trace \ + inets_lib \ + inets_time_compat INTERNAL_HRL_FILES = inets_internal.hrl EXTERNAL_HRL_FILES = ../../include/httpd.hrl \ diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 9eae962d03..7207672b7f 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -1,7 +1,7 @@ %% This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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,7 +26,9 @@ inets_app, inets_service, inets_regexp, - inets_trace, + inets_trace, + inets_lib, + inets_time_compat, %% FTP ftp, diff --git a/lib/inets/src/inets_app/inets_lib.erl b/lib/inets/src/inets_app/inets_lib.erl new file mode 100644 index 0000000000..e79959f678 --- /dev/null +++ b/lib/inets/src/inets_app/inets_lib.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. 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(inets_lib). + +-export([millisec_passed/1, formated_timestamp/0, format_timestamp/1]). + + + +%% Help function, elapsed milliseconds since T0 +millisec_passed({_,_,_} = T0 ) -> + %% OTP 17 and earlier + timer:now_diff(inets_time_compat:monotonic_time(), T0) div 1000; + +millisec_passed(T0) -> + %% OTP 18 + erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, + micro_seconds) div 1000. + +%% Return formated time stamp (e.g. 2015:03:16 10:05:23 1234) +formated_timestamp() -> + format_timestamp( os:timestamp() ). + +%% Return formated time stamp (e.g. 2015:03:16 10:05:23 1234) +format_timestamp({_N1, _N2, N3} = Tme) -> + {Date, Time} = calendar:now_to_datetime(Tme), + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", + [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), + lists:flatten(FormatDate). diff --git a/lib/inets/src/inets_app/inets_time_compat.erl b/lib/inets/src/inets_app/inets_time_compat.erl new file mode 100644 index 0000000000..d6297d9caf --- /dev/null +++ b/lib/inets/src/inets_app/inets_time_compat.erl @@ -0,0 +1,71 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. 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% +%% + +%% This module is created to be able to execute on ERTS versions both +%% earlier and later than 7.0. + +-module(inets_time_compat). + +%% We don't want warnings about the use of erlang:now/0 in +%% this module. +-compile(nowarn_deprecated_function). + +-export([monotonic_time/0, + timestamp/0, + unique_integer/0, + unique_integer/1]). + +monotonic_time() -> + try + erlang:monotonic_time() + catch + error:undef -> + %% Use Erlang system time as monotonic time + erlang_system_time_fallback() + end. + +timestamp() -> + try + erlang:timestamp() + catch + error:undef -> + erlang:now() + end. + +unique_integer() -> + try + erlang:unique_integer() + catch + error:undef -> + erlang_system_time_fallback() + end. + +unique_integer(Modifiers) -> + try + erlang:unique_integer(Modifiers) + catch + error:badarg -> + erlang:error(badarg, [Modifiers]); + error:undef -> + erlang_system_time_fallback() + end. + +erlang_system_time_fallback() -> + {MS, S, US} = erlang:now(), + (MS*1000000+S)*1000000+US. diff --git a/lib/inets/src/inets_app/inets_trace.erl b/lib/inets/src/inets_app/inets_trace.erl index 8911f65897..cb6d6d8bdb 100644 --- a/lib/inets/src/inets_app/inets_trace.erl +++ b/lib/inets/src/inets_app/inets_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2015. 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 @@ -228,21 +228,24 @@ handle_trace({trace_ts, _Who, call, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, {_, standard_io} = Fd) -> - (catch io:format(standard_io, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(standard_io, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), Fd; handle_trace({trace_ts, _Who, call, {?MODULE, report_event, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, standard_io = Fd) -> - (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(Fd, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), Fd; handle_trace({trace_ts, _Who, call, {?MODULE, report_event, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, {_Service, Fd}) -> - (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(Fd, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), (catch file:close(Fd)), closed_file; handle_trace({trace_ts, _Who, call, @@ -250,7 +253,8 @@ handle_trace({trace_ts, _Who, call, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, Fd) -> - (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(Fd, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), (catch file:close(Fd)), closed_file; handle_trace({trace_ts, Who, call, @@ -280,7 +284,7 @@ print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content) -> do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content). do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content) -> - Ts = format_timestamp(Timestamp), + Ts = inets_lib:format_timestamp(Timestamp), io:format(Fd, "[inets ~w trace ~w ~w ~s] ~s " "~n Content: ~p" "~n", @@ -307,7 +311,7 @@ do_print_trace(Fd, {trace, Who, What, Where, Extra}) -> "~n", [Who, What, Where, Extra]); do_print_trace(Fd, {trace_ts, Who, What, Where, When}) -> - Ts = format_timestamp(When), + Ts = inets_lib:format_timestamp(When), io:format(Fd, "[trace ~s]" "~n Who: ~p" "~n What: ~p" @@ -315,7 +319,7 @@ do_print_trace(Fd, {trace_ts, Who, What, Where, When}) -> "~n", [Ts, Who, What, Where]); do_print_trace(Fd, {trace_ts, Who, What, Where, Extra, When}) -> - Ts = format_timestamp(When), + Ts = inets_lib:format_timestamp(When), io:format(Fd, "[trace ~s]" "~n Who: ~p" "~n What: ~p" @@ -330,7 +334,7 @@ do_print_trace(Fd, {seq_trace, What, Where}) -> "~n", [What, Where]); do_print_trace(Fd, {seq_trace, What, Where, When}) -> - Ts = format_timestamp(When), + Ts = inets_lib:format_timestamp(When), io:format(Fd, "[seq trace ~s]" "~n What: ~p" "~n Where: ~p" @@ -345,13 +349,3 @@ do_print_trace(Fd, Trace) -> "~n", [Trace]). -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). - - diff --git a/lib/inets/src/tftp/tftp_logger.erl b/lib/inets/src/tftp/tftp_logger.erl index 0c3620e665..231a705371 100644 --- a/lib/inets/src/tftp/tftp_logger.erl +++ b/lib/inets/src/tftp/tftp_logger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. 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 @@ -84,8 +84,8 @@ info_msg(Format, Data) -> %%------------------------------------------------------------------- add_timestamp(Format, Data) -> - Now = {_MegaSecs, _Secs, _MicroSecs} = erlang:now(), - {{_Y, _Mo, _D}, {H, Mi, S}} = calendar:now_to_universal_time(Now), + Time = inets_time_compat:timestamp(), + {{_Y, _Mo, _D}, {H, Mi, S}} = calendar:now_to_universal_time(Time), %% {"~p-~s-~sT~s:~s:~sZ,~6.6.0w tftp: " ++ Format ++ "\n", %% [Y, t(Mo), t(D), t(H), t(Mi), t(S), MicroSecs | Data]}. {"~s:~s:~s tftp: " ++ Format, [t(H), t(Mi), t(S) | Data]}. diff --git a/lib/inets/src/tftp/tftp_sup.erl b/lib/inets/src/tftp/tftp_sup.erl index 1cafcc1069..7a0dcffc90 100644 --- a/lib/inets/src/tftp/tftp_sup.erl +++ b/lib/inets/src/tftp/tftp_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. 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 @@ -93,7 +93,7 @@ unique_name(Options) -> {value, {_, Port}} when is_integer(Port), Port > 0 -> {tftpd, Port}; _ -> - {tftpd, erlang:now()} + {tftpd, inets_time_compat:unique_integer([positive])} end. default_kill_after() -> diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index daee1bdcdc..b637832101 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. 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 @@ -1352,9 +1352,9 @@ do_delete(Pid, Config) -> ok. do_mkdir(Pid) -> - {A, B, C} = erlang:now(), - NewDir = "nisse_" ++ integer_to_list(A) ++ "_" ++ - integer_to_list(B) ++ "_" ++ integer_to_list(C), + NewDir = "earl_" ++ + integer_to_list(inets_time_compat:unique_integer([positive])), + ok = ftp:cd(Pid, "incoming"), {ok, CurrDir} = ftp:pwd(Pid), {error, efnamena} = ftp:mkdir(Pid, NewDir++"\r\nCWD ."), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0e89e831fb..0dfc65e8f7 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1933,12 +1933,13 @@ run_clients(NumClients, ServerPort, SeqNumServer) -> wait4clients([], _Timeout) -> ok; wait4clients(Clients, Timeout) when Timeout > 0 -> - Time = now_ms(), + Time = inets_time_compat:monotonic_time(), + receive {'DOWN', _MRef, process, Pid, normal} -> {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), NewClients = lists:keydelete(Id, 1, Clients), - wait4clients(NewClients, Timeout - (now_ms() - Time)); + wait4clients(NewClients, Timeout - inets_lib:millisec_passed(Time)); {'DOWN', _MRef, process, Pid, Reason} -> {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), ct:fail({bad_client_termination, Id, Reason}) @@ -2031,14 +2032,10 @@ parse_connection_type(Request) -> "keep-alive" -> keep_alive end. -%% Time in milli seconds -now_ms() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - set_random_seed() -> - {_, _, Micros} = now(), - A = erlang:phash2([make_ref(), self(), Micros]), + Unique = inets_time_compat:unique_integer(), + + A = erlang:phash2([make_ref(), self(), Unique]), random:seed(A, A, A). diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index 0bb457f9b9..7dd61a5517 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. 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 @@ -116,13 +116,14 @@ main(N, SocketType, Host, Port, Time) loop(Pollers, Timeout) -> d("loop -> entry when" "~n Timeout: ~p", [Timeout]), - Start = t(), + Start = inets_time_compat:monotonic_time(), + receive {'EXIT', Pid, {poller_stat_failure, SocketType, Host, Port, Time, Reason}} -> case is_poller(Pid, Pollers) of true -> error_msg("received unexpected exit from poller ~p~n" - "befor completion of test " + "before completion of test " "after ~p micro sec" "~n SocketType: ~p" "~n Host: ~p" @@ -133,7 +134,7 @@ loop(Pollers, Timeout) -> false -> error_msg("received unexpected ~p from ~p" "befor completion of test", [Reason, Pid]), - loop(Pollers, to(Timeout, Start)) + loop(Pollers, Timeout - inets_lib:millisec_passed(Start)) end; {poller_stat_failure, Pid, {SocketType, Host, Port, Time, Reason}} -> @@ -412,35 +413,6 @@ validate(ExpStatusCode, _SocketType, _Socket, Response) -> end. -trash_the_rest(Socket, N) -> - receive - {ssl, Socket, Trash} -> - trash_the_rest(Socket, add(N,sz(Trash))); - {ssl_closed, Socket} -> - N; - {ssl_error, Socket, Error} -> - exit({connection_error, Error}); - - {tcp, Socket, Trash} -> - trash_the_rest(Socket, add(N,sz(Trash))); - {tcp_closed, Socket} -> - N; - {tcp_error, Socket, Error} -> - exit({connection_error, Error}) - - after 10000 -> - exit({connection_timed_out, N}) - end. - - -add(N1,N2) when is_integer(N1) andalso is_integer(N2) -> - N1 + N2; -add(N1,_) when is_integer(N1) -> - N1; -add(_,N2) when is_integer(N2) -> - N2. - - sz(L) when is_list(L) -> length(lists:flatten(L)); sz(B) when is_binary(B) -> @@ -505,17 +477,6 @@ status_to_message(Code) -> io_lib:format("Unknown status code: ~p",[Code]). %% ---------------------------------------------------------------- -to(To, Start) -> - To - (t() - Start). - -%% Time in milli seconds -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - - -%% ---------------------------------------------------------------- - % close(Socket) -> diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl index 6510c70d08..a07dc79c02 100644 --- a/lib/inets/test/inets_SUITE.erl +++ b/lib/inets/test/inets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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 @@ -549,25 +549,12 @@ tsf(Reason) -> tsp(F) -> tsp(F, []). tsp(F, A) -> - Timestamp = formated_timestamp(), + Timestamp = inets_lib:formated_timestamp(), test_server:format("** ~s ** ~p ~p:" ++ F ++ "~n", [Timestamp, self(), ?MODULE | A]). i(F) -> i(F, []). i(F, A) -> - Timestamp = formated_timestamp(), + Timestamp = inets_lib:formated_timestamp(), io:format("*** ~s ~w:" ++ F ++ "~n", [Timestamp, ?MODULE | A]). - -formated_timestamp() -> - format_timestamp( os:timestamp() ). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). - diff --git a/lib/inets/test/inets_app_test.erl b/lib/inets/test/inets_app_test.erl index eabfa69f7c..22d6e25c87 100644 --- a/lib/inets/test/inets_app_test.erl +++ b/lib/inets/test/inets_app_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. 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 @@ -32,19 +32,6 @@ %% Test server callbacks -init_per_testcase(undef_funcs, Config) -> - NewConfig = lists:keydelete(watchdog, 1, Config), - Dog = test_server:timetrap(inets_test_lib:minutes(10)), - - %% We need to check if there is a point to run this test. - %% On some platforms, crypto will not build, which in turn - %% causes ssl to not build (at this time, this will - %% change in the future). - %% So, we first check if we can start crypto, and if not, - %% we skip this test case! - ?ENSURE_STARTED(crypto), - - [{watchdog, Dog}| NewConfig]; init_per_testcase(_, Config) -> Config. @@ -54,7 +41,7 @@ end_per_testcase(_Case, Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> - [fields, modules, exportall, app_depend, undef_funcs]. + [fields, modules, exportall, app_depend]. groups() -> []. @@ -244,56 +231,6 @@ check_apps([App|Apps]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; -undef_funcs(Config) when is_list(Config) -> - App = inets, - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - Root = code:root_dir(), - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - XRefTestName = undef_funcs_make_name(App, xref_test_name), - {ok, XRef} = xref:start(XRefTestName), - ok = xref:set_default(XRef, - [{verbose,false},{warnings,false}]), - XRefName = undef_funcs_make_name(App, xref_name), - {ok, XRefName} = xref:add_release(XRef, Root, {name, XRefName}), - {ok, App} = xref:replace_application(XRef, App, EbinDir), - {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), - xref:stop(XRef), - analyze_undefined_function_calls(Undefs, Mods, []). - -analyze_undefined_function_calls([], _, []) -> - ok; -analyze_undefined_function_calls([], _, AppUndefs) -> - exit({suite_failed, {undefined_function_calls, AppUndefs}}); -analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], - AppModules, AppUndefs) -> - %% Check that this module is our's - case lists:member(Mod,AppModules) of - true -> - {Calling,Called} = AppUndef, - {Mod1,Func1,Ar1} = Calling, - {Mod2,Func2,Ar2} = Called, - io:format("undefined function call: " - "~n ~w:~w/~w calls ~w:~w/~w~n", - [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), - analyze_undefined_function_calls(Undefs, AppModules, - [AppUndef|AppUndefs]); - false -> - io:format("dropping ~p~n", [Mod]), - analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) - end. - -%% This function is used simply to avoid cut-and-paste errors later... -undef_funcs_make_name(App, PostFix) -> - list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - fail(Reason) -> exit({suite_failed, Reason}). diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 4be9d9c8b3..7485971d3e 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. 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 @@ -498,13 +498,6 @@ close(essl,Socket) -> close(ip_comm,Socket) -> catch gen_tcp:close(Socket). -millis() -> - erlang:now(). - -millis_diff(A,B) -> - T1 = (element(1,A)*1000000) + element(2,A) + (element(3,A)/1000000), - T2 = (element(1,B)*1000000) + element(2,B) + (element(3,B)/1000000), - T1 - T2. hours(N) -> trunc(N * 1000 * 60 * 60). minutes(N) -> trunc(N * 1000 * 60). @@ -546,7 +539,7 @@ flush() -> tsp(F) -> tsp(F, []). tsp(F, A) -> - Timestamp = formated_timestamp(), + Timestamp = inets_lib:formated_timestamp(), ct:pal("*** ~s ~p ~p " ++ F ++ "~n", [Timestamp, node(), self() | A]). @@ -559,18 +552,6 @@ tss(Time) -> timestamp() -> http_util:timestamp(). -formated_timestamp() -> - format_timestamp( os:timestamp() ). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). - start_apps(Apps) -> lists:foreach(fun(App) -> application:stop(App), diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 8b85f24455..b9dbede0d3 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -142,14 +142,49 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> </desc> </func> <func> + <name name="system_time" arity="0"/> + <fsummary>Current OS system time</fsummary> + <desc> + <p>Returns current + <seealso marker="erts:time_correction#OS_System_Time">OS system time</seealso> + in <c>native</c> + <seealso marker="erts:erlang#type_time_unit">time unit</seealso>.</p> + + <note><p>This time is <em>not</em> a monotonically increasing time.</p></note> + </desc> + </func> + <func> + <name name="system_time" arity="1"/> + <fsummary>Current OS system time</fsummary> + <desc> + <p>Returns current + <seealso marker="erts:time_correction#OS_System_Time">OS system time</seealso> + converted into the <c><anno>Unit</anno></c> passed as argument.</p> + + <p>Calling <c>os:system_time(<anno>Unit</anno>)</c> is equivalent to: + <seealso marker="erts:erlang#convert_time_unit/3"><c>erlang:convert_time_unit</c></seealso><c>(</c><seealso marker="#system_time/0"><c>os:system_time()</c></seealso><c>, + native, <anno>Unit</anno>)</c>.</p> + + <note><p>This time is <em>not</em> a monotonically increasing time.</p></note> + </desc> + </func> + <func> <name name="timestamp" arity="0"/> <type_desc variable="Timestamp">Timestamp = {MegaSecs, Secs, MicroSecs}</type_desc> - <fsummary>Returna a timestamp from the OS in the erlang:now/0 format</fsummary> + <fsummary>Current OS system time on the erlang:timestamp/0 format</fsummary> <desc> - <p>Returns a tuple in the same format as <seealso marker="erts:erlang#now/0">erlang:now/0</seealso>. The difference is that this function returns what the operating system thinks (a.k.a. the wall clock time) without any attempts at time correction. The result of two different calls to this function is <em>not</em> guaranteed to be different.</p> - <p>The most obvious use for this function is logging. The tuple can be used together with the function <seealso marker="stdlib:calendar#now_to_universal_time/1">calendar:now_to_universal_time/1</seealso> -or <seealso marker="stdlib:calendar#now_to_local_time/1">calendar:now_to_local_time/1</seealso> to get calendar time. Using the calendar time together with the <c>MicroSecs</c> part of the return tuple from this function allows you to log timestamps in high resolution and consistent with the time in the rest of the operating system.</p> - <p>Example of code formatting a string in the format "DD Mon YYYY HH:MM:SS.mmmmmm", where DD is the day of month, Mon is the textual month name, YYYY is the year, HH:MM:SS is the time and mmmmmm is the microseconds in six positions:</p> + <p>Returns current + <seealso marker="erts:time_correction#OS_System_Time">OS system time</seealso> + in the same format as <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso>. + The tuple can be used together with the function + <seealso marker="stdlib:calendar#now_to_universal_time/1">calendar:now_to_universal_time/1</seealso> + or <seealso marker="stdlib:calendar#now_to_local_time/1">calendar:now_to_local_time/1</seealso> to + get calendar time. Using the calendar time together with the <c>MicroSecs</c> part of the return + tuple from this function allows you to log timestamps in high resolution and consistent with the + time in the rest of the operating system.</p> + <p>Example of code formatting a string in the format "DD Mon YYYY HH:MM:SS.mmmmmm", where + DD is the day of month, Mon is the textual month name, YYYY is the year, HH:MM:SS is the time and + mmmmmm is the microseconds in six positions:</p> <code> -module(print_time). -export([format_utc_timestamp/0]). @@ -168,6 +203,9 @@ format_utc_timestamp() -> 1> <input>io:format("~s~n",[print_time:format_utc_timestamp()]).</input> 29 Apr 2009 9:55:30.051711 </pre> + <p>OS system time can also be retreived by + <c><seealso marker="#system_time/0"><c>os:system_time/0</c></seealso></c>, + and <seealso marker="#system_time/1"><c>os:system_time/1</c></seealso>.</p> </desc> </func> <func> diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index eda35147d3..dbc486bee1 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -370,8 +370,8 @@ check_cookie1([], Result) -> %% Creates a new, random cookie. create_cookie(Name) -> - {_, S1, S2} = now(), - Seed = S2*10000+S1, + Seed = abs(erlang:monotonic_time() + bxor erlang:unique_integer()), Cookie = random_cookie(20, Seed, []), case file:open(Name, [write, raw]) of {ok, File} -> diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index b127fe2e33..6b510bd0c3 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -298,7 +298,7 @@ shutdown(_Module, _Line, _Data, Reason) -> exit(Reason). %% Use this line to debug connection. %% Set net_kernel verbose = 1 as well. -%% exit({Reason, ?MODULE, _Line, _Data, erlang:now()}). +%% exit({Reason, ?MODULE, _Line, _Data, erlang:timestamp()}). flush_down() -> @@ -373,7 +373,9 @@ gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> %% gen_challenge() returns a "random" number %% --------------------------------------------------------------- gen_challenge() -> - {A,B,C} = erlang:now(), + A = erlang:phash2([erlang:node()]), + B = erlang:monotonic_time(), + C = erlang:unique_integer(), {D,_} = erlang:statistics(reductions), {E,_} = erlang:statistics(runtime), {F,_} = erlang:statistics(wall_clock), diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl index 25ad34357a..3c4429129e 100644 --- a/lib/kernel/src/erl_distribution.erl +++ b/lib/kernel/src/erl_distribution.erl @@ -22,7 +22,6 @@ -export([start_link/0,start_link/1,init/1,start/1,stop/0]). -%-define(DBG,io:format("~p:~p~n",[?MODULE,?LINE])). -define(DBG,erlang:display([?MODULE,?LINE])). start_link() -> diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index ef605d0bfe..17bee06b5e 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -33,7 +33,7 @@ -export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, - same/2, set_internal_state/2]). + map_info/1, same/2, set_internal_state/2]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -164,8 +164,10 @@ set_internal_state(_, _) -> -spec size(term()) -> non_neg_integer(). +-record(s, {seen, maps}). + size(Term) -> - {Sum,_} = size(Term, gb_trees:empty(), 0), + {Sum,_} = size(Term, #s{seen=gb_trees:empty(),maps=[]}, 0), Sum. size([H|T]=Term, Seen0, Sum0) -> @@ -209,10 +211,24 @@ tuple_size(I, Sz, 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). + %% Danger: + %% The internal nodes from erts_internal:map_hashmap_children/1 + %% is not allowed to leak anywhere. They are only allowed in + %% containers (cons cells and tuples, not maps), in gc and + %% in erts_debug:same/2 + case erts_internal:map_type(Map) of + flatmap -> + 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); + hashmap -> + Cs = erts_internal:map_hashmap_children(Map), + fold_size(Cs,Seen0,Sum0+length(Cs)+2); + hashmap_node -> + Cs = erts_internal:map_hashmap_children(Map), + fold_size(Cs,Seen0,Sum0+length(Cs)+1) + end. fun_size(Fun, Seen, Sum) -> case erlang:fun_info(Fun, type) of @@ -229,13 +245,18 @@ fold_size([H|T], Seen0, Sum0) -> 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); +remember_term(Term, #s{maps=Ms}=S) when is_map(Term) -> + case is_term_seen(Term, Ms) of + false -> S#s{maps=[Term|Ms]}; + true -> seen + end; +remember_term(Term, #s{seen=T}=S) -> + case gb_trees:lookup(Term,T) of + none -> S#s{seen=gb_trees:insert(Term,[Term],T)}; {value,Terms} -> case is_term_seen(Term, Terms) of - false -> gb_trees:update(Term, [Term|Terms], Seen); - true -> seen + false -> S#s{seen=gb_trees:update(Term,[Term|Terms],T)}; + true -> seen end end. @@ -313,3 +334,9 @@ cont_dis(File, {Addr,Str,MFA}, MFA) -> io:put_chars(File, binary_to_list(Str)), cont_dis(File, erts_debug:disassemble(Addr), MFA); cont_dis(_, {_,_,_}, _) -> ok. + +-spec map_info(Map) -> list() when + Map :: map(). + +map_info(_) -> + erlang:nif_error(undef). diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 0a4edea452..6c36d417a2 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -881,11 +881,12 @@ handle_info({nodeup, Node}, S0) when S0#state.connect_all -> false -> resend_pre_connect(Node), - %% now() is used as a tag to separate different synch sessions + %% erlang:unique_integer([monotonic]) is used as a tag to + %% separate different synch sessions %% from each others. Global could be confused at bursty nodeups %% because it couldn't separate the messages between the different %% synch sessions started by a nodeup. - MyTag = now(), + MyTag = erlang:unique_integer([monotonic]), put({sync_tag_my, Node}, MyTag), ?trace({sending_nodeup_to_locker, {node,Node},{mytag,MyTag}}), S1#state.the_locker ! {nodeup, Node, MyTag}, @@ -1772,8 +1773,8 @@ update_locker_known(Upd, S) -> S#multi{known = Known, the_boss = TheBoss}. random_element(L) -> - {A,B,C} = now(), - E = (A+B+C) rem length(L), + E = abs(erlang:monotonic_time() + bxor erlang:unique_integer()) rem length(L), lists:nth(E+1, L). exclude_known(Others, Known) -> @@ -2072,9 +2073,10 @@ random_sleep(Times) -> end, case get(random_seed) of undefined -> - {A1, A2, A3} = now(), - _ = random:seed(A1, A2, A3 + erlang:phash(node(), 100000)), - ok; + _ = random:seed(erlang:phash2([erlang:node()]), + erlang:monotonic_time(), + erlang:unique_integer()), + ok; _ -> ok end, %% First time 1/4 seconds, then doubling each time up to 8 seconds max. @@ -2106,7 +2108,7 @@ trace_message(S, M, X) -> S#state{trace = [trace_message(M, X) | S#state.trace]}. trace_message(M, X) -> - {node(), now(), M, nodes(), X}. + {node(), erlang:timestamp(), M, nodes(), X}. %%----------------------------------------------------------------- %% Each sync process corresponds to one call to sync. Each such diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index 2ebdc0f554..abe207295f 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1372,8 +1372,7 @@ cache_rr(_Db, Cache, RR) -> ets:insert(Cache, RR). times() -> - {Mega,Secs,_} = erlang:now(), - Mega*1000000 + Secs. + erlang:monotonic_time(1). %% lookup and remove old entries diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 6037da1d22..410128a16a 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -715,10 +715,10 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer) udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode) when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout); + do_udp_recv(I, IP, Port, Timeout, Decode, time_now(), Timeout); udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode) when ?ip(A,B,C,D), ?port(Port) -> - do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout). + do_udp_recv(I, IP, Port, Timeout, Decode, time_now(), Timeout). do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) -> timeout; @@ -742,7 +742,7 @@ do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) -> NewTimeout = erlang:max(0, Timeout - 50), do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T); false -> - Now = erlang:now(), + Now = time_now(), NewT = erlang:max(0, Timeout - now_ms(Now, Start)), do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT); Result -> @@ -1057,5 +1057,9 @@ dns_msg(Msg) -> end. -compile({inline, [now_ms/2]}). -now_ms({Meg1,Sec1,Mic1}, {Meg0,Sec0,Mic0}) -> - ((Meg1-Meg0)*1000000 + (Sec1-Sec0))*1000 + ((Mic1-Mic0) div 1000). +now_ms(Int1, Int0) -> + Int1 - Int0. + +-compile({inline, [time_now/0]}). +time_now() -> + erlang:monotonic_time(1000). diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 9f6c0f4624..0cb10791d7 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -115,6 +115,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-6.1.2", "stdlib-2.0", "sasl-2.4"]} + {runtime_dependencies, ["erts-7.0", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 7468a06f3c..3647545777 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -26,7 +26,8 @@ %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, timestamp/0, unsetenv/1]). +-export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1, + timestamp/0, unsetenv/1]). -spec getenv() -> [string()]. @@ -65,6 +66,17 @@ getpid() -> putenv(_, _) -> erlang:nif_error(undef). +-spec system_time() -> integer(). + +system_time() -> + erlang:nif_error(undef). + +-spec system_time(Unit) -> integer() when + Unit :: erlang:time_unit(). + +system_time(_Unit) -> + erlang:nif_error(undef). + -spec timestamp() -> Timestamp when Timestamp :: erlang:timestamp(). diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index b562d4ffd2..70d7a75671 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -140,19 +140,22 @@ get_closest_pid(Name) -> [Pid] -> Pid; [] -> - {_,_,X} = erlang:now(), case get_members(Name) of [] -> {error, {no_process, Name}}; Members -> - lists:nth((X rem length(Members))+1, Members) + random_element(Members) end; Members when is_list(Members) -> - {_,_,X} = erlang:now(), - lists:nth((X rem length(Members))+1, Members); + random_element(Members); Else -> Else end. +random_element(List) -> + X = abs(erlang:monotonic_time() + bxor erlang:unique_integer()), + lists:nth((X rem length(List)) + 1, List). + %%% %%% Callback functions from gen_server %%% diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 849013ac79..44a32fc1ec 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -88,10 +88,30 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(lookup_bad_search_option, Config) -> + Db = inet_db, + Key = res_lookup, + %% The bad option can not enter through inet_db:set_lookup/1, + %% but through e.g .inetrc. + Prev = ets:lookup(Db, Key), + ets:delete(Db, Key), + ets:insert(Db, {Key,[lookup_bad_search_option]}), + ?t:format("Misconfigured resolver lookup order", []), + Dog = test_server:timetrap(test_server:seconds(60)), + [{Key,Prev},{watchdog,Dog}|Config]; init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), [{watchdog,Dog}|Config]. +end_per_testcase(lookup_bad_search_option, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + Db = inet_db, + Key = res_lookup, + Prev = ?config(Key, Config), + ets:delete(Db, Key), + ets:insert(Db, Prev), + ?t:format("Restored resolver lookup order", []); end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog). @@ -915,10 +935,8 @@ lookup_bad_search_option(suite) -> lookup_bad_search_option(doc) -> ["Test lookup with erroneously configured lookup option (OTP-12133)"]; lookup_bad_search_option(Config) when is_list(Config) -> - Db = inet_db, - %% The bad option can not enter through inet_db:set_lookup/1, - %% but through e.g .inetrc. - ets:insert(Db, {res_lookup,[lookup_bad_search_option]}), + %% Manipulation of resolver config is done in init_per_testcase + %% and end_per_testcase to ensure cleanup. {ok,Hostname} = inet:gethostname(), {ok,_Hent} = inet:gethostbyname(Hostname), % Will hang loop for this bug ok. diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index e99151284f..41c19fce51 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -146,8 +146,6 @@ api_deflateInit(Config) when is_list(Config) -> ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-20,8,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-7,8,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,7,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-8,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,8,8,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,0,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,10,default)), @@ -169,7 +167,7 @@ api_deflateInit(Config) when is_list(Config) -> ?m(ok, zlib:deflateInit(Z12,default,deflated,-Wbits,8,default)), ?m(ok,zlib:close(Z11)), ?m(ok,zlib:close(Z12)) - end, lists:seq(9, 15)), + end, lists:seq(8, 15)), lists:foreach(fun(MemLevel) -> ?line Z = zlib:open(), @@ -277,7 +275,7 @@ api_inflateInit(Config) when is_list(Config) -> ?m(ok, zlib:inflateInit(Z12,-Wbits)), ?m(ok,zlib:close(Z11)), ?m(ok,zlib:close(Z12)) - end, lists:seq(9,15)), + end, lists:seq(8,15)), ?m(?BARG, zlib:inflateInit(gurka, -15)), ?m(?BARG, zlib:inflateInit(Z1, 7)), ?m(?BARG, zlib:inflateInit(Z1, -7)), diff --git a/lib/mnesia/src/mnesia.app.src b/lib/mnesia/src/mnesia.app.src index e755864792..c78a7cba1e 100644 --- a/lib/mnesia/src/mnesia.app.src +++ b/lib/mnesia/src/mnesia.app.src @@ -48,6 +48,6 @@ ]}, {applications, [kernel, stdlib]}, {mod, {mnesia_sup, []}}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-7.0"]}]}. diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 8f14831ad3..792b6c4a73 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -2171,7 +2171,7 @@ system_info2(version) -> Version; false -> %% Ensure that it does not match - {mnesia_not_loaded, node(), now()} + {mnesia_not_loaded, node(), erlang:timestamp()} end; Version -> Version diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index c8010d5466..9a58ea581a 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -53,7 +53,9 @@ up_stores = [], %% list of upper layer stores for nested trans level = 1}). %% transaction level --define(unique_cookie, {erlang:now(), node()}). +-define(unique_cookie, {{erlang:monotonic_time() + erlang:time_offset(), + erlang:unique_integer(),1}, + node()}). -record(cstruct, {name, % Atom type = set, % set | bag diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 3b084e7371..71e610bd63 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -368,7 +368,7 @@ create_schema(_Ns, Reason) -> {error, Reason}. mk_str() -> - Now = [integer_to_list(I) || I <- tuple_to_list(now())], + Now = integer_to_list(erlang:unique_integer([positive])), lists:concat([node()] ++ Now ++ ".TMP"). make_initial_backup(Ns, Opaque, Mod) -> diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 173e3be2f5..442e68a13d 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -68,12 +68,12 @@ -import(mnesia_lib, [add/2, del/2, set/2, unset/1]). -import(mnesia_lib, [dbg_out/2]). --record(checkpoint_args, {name = {now(), node()}, +-record(checkpoint_args, {name = {erlang:unique_integer([positive]), node()}, allow_remote = true, ram_overrides_dump = false, nodes = [], node = node(), - now = now(), + now, %% unused cookie = ?unique_cookie, min = [], max = [], diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 67ec9d7399..8a4be88e9a 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -235,8 +235,7 @@ report_fatal(Format, Args, BinaryCore, CoreDumped) -> end. core_file(CoreDir,BinaryCore,Format,Args) -> - %% Integers = tuple_to_list(date()) ++ tuple_to_list(time()), - Integers = tuple_to_list(now()), + Integers = tuple_to_list(erlang:timestamp()), Fun = fun(I) when I < 10 -> ["_0",I]; (I) -> ["_",I] end, diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index a32c69c59e..fc41cbedcb 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -930,8 +930,9 @@ random_time(Retries, _Counter0) -> case get(random_seed) of undefined -> - {X, Y, Z} = erlang:now(), %% time() - _ = random:seed(X, Y, Z), + _ = random:seed(erlang:unique_integer(), + erlang:monotonic_time(), + erlang:unique_integer()), Time = Dup + random:uniform(MaxIntv), %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]), Time; diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index d2fd04a60b..6206a8bdb9 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -200,7 +200,7 @@ log_header(Kind, Version) -> log_kind=Kind, mnesia_version=mnesia:system_info(version), node=node(), - now=now()}. + now=erlang:timestamp()}. version() -> "4.3". diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 6e43052fb0..52180cfcf5 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -262,7 +262,7 @@ incr_version(Cs) -> [] -> {Major + 1, 0}; % All replicas are active _ -> {Major, Minor + 1} % Some replicas are inactive end, - Cs#cstruct{version = {V, {node(), now()}}}. + Cs#cstruct{version = {V, {node(), erlang:timestamp()}}}. %% Returns table name insert_cstruct(Tid, Cs, KeepWhereabouts) -> diff --git a/lib/mnesia/test/mnesia_trans_access_test.erl b/lib/mnesia/test/mnesia_trans_access_test.erl index 237984978e..f906670296 100644 --- a/lib/mnesia/test/mnesia_trans_access_test.erl +++ b/lib/mnesia/test/mnesia_trans_access_test.erl @@ -930,20 +930,20 @@ index_update_bag(Config)when is_list(Config) -> [IPos] = mnesia_lib:val({Tab,index}), ITab = mnesia_lib:val({index_test,{index, IPos}}), io:format("~n Index ~p @ ~p => ~p ~n~n",[IPos,ITab, ets:tab2list(ITab)]), - ?match([{2,1},{2,2},{12,1}], ets:tab2list(ITab)), + ?match([{2,1},{2,2},{12,1}], lists:keysort(1,ets:tab2list(ITab))), ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write(Rec5) end)), {atomic, R60} = mnesia:transaction(fun() -> mnesia:index_read(Tab, 2, ValPos) end), ?match([Rec1,Rec5,Rec2], lists:sort(R60)), - ?match([{2,1},{2,2},{12,1}], ets:tab2list(ITab)), + ?match([{2,1},{2,2},{12,1}], lists:keysort(1,ets:tab2list(ITab))), ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:delete_object(Rec3) end)), {atomic, R61} = mnesia:transaction(fun() -> mnesia:index_read(Tab, 2, ValPos) end), ?match([Rec1,Rec5,Rec2], lists:sort(R61)), {atomic, R62} = mnesia:transaction(fun() -> mnesia:index_read(Tab,12, ValPos) end), ?match([], lists:sort(R62)), - ?match([{2,1},{2,2}], ets:tab2list(ITab)), + ?match([{2,1},{2,2}], lists:keysort(1,ets:tab2list(ITab))), %% reset for rest of testcase ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write(Rec3) end)), diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index ea7950ae52..e293990d64 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -64,6 +64,6 @@ {env, []}, {runtime_dependencies, ["wx-1.2","stdlib-2.0","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","et-1.5", - "erts-6.0"]}]}. + "erts-7.0"]}]}. diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index 53197078cf..df0bc05312 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -155,7 +155,7 @@ all_or_expand(_Tab,Term,Str,false) href_proc_port(lists:flatten(Str)); all_or_expand(Tab,Term,Preview,true) when not is_binary(Term) -> - Key = {Key1,Key2,Key3} = now(), + Key = {Key1,Key2,Key3} = {erlang:unique_integer([positive]),1,2}, ets:insert(Tab,{Key,Term}), [href_proc_port(lists:flatten(Preview), false), $\n, href("TARGET=\"expanded\"", diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 61fd6d1787..a2db40aa2f 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -849,7 +849,7 @@ get_nodes() -> receive {?MODULE,Nodes} -> Nodes end. ts() -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()), + {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()), io_lib:format("-~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 1f088ecbde..66e7973e7e 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -221,7 +221,7 @@ get_uint32_measurement(Request, #internal{port = P, os_type = {unix, sunos}}) -> port_server_call(P, Request); get_uint32_measurement(Request, #internal{os_type = {unix, linux}}) -> {ok,F} = file:open("/proc/loadavg",[read,raw]), - {ok,D} = file:read(F,24), + {ok,D} = file:read_line(F), ok = file:close(F), {ok,[Load1,Load5,Load15,_PRun,PTotal],_} = io_lib:fread("~f ~f ~f ~d/~d", D), case Request of diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index a0a87e5351..e8ff965982 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -114,7 +114,7 @@ pem_encode(PemEntries) when is_list(PemEntries) -> iolist_to_binary(pubkey_pem:encode(PemEntries)). %%-------------------------------------------------------------------- --spec pem_entry_decode(pem_entry(), [string()]) -> term(). +-spec pem_entry_decode(pem_entry(), string()) -> term(). % %% Description: Decodes a pem entry. pem_decode/1 returns a list of %% pem entries. @@ -146,14 +146,16 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry, pem_entry_decode({Asn1Type, CryptDer, {Cipher, {#'PBEParameter'{},_}}} = PemEntry, Password) when is_atom(Asn1Type) andalso is_binary(CryptDer) andalso - is_list(Cipher) -> + is_list(Cipher) andalso + is_list(Password) -> do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, Password) when is_atom(Asn1Type) andalso is_binary(CryptDer) andalso is_list(Cipher) andalso is_binary(Salt) andalso - ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) -> + ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) andalso + is_list(Password) -> do_pem_entry_decode(PemEntry, Password). @@ -626,8 +628,12 @@ pkix_is_fixed_dh_cert(Cert) when is_binary(Cert) -> % %% Description: Returns the issuer id. %%-------------------------------------------------------------------- -pkix_issuer_id(Cert, Signed)-> - pkix_issuer_id(Cert, Signed, decode). +pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed) when (Signed == self) or + (Signed == other) -> + pubkey_cert:issuer_id(OtpCert, Signed); +pkix_issuer_id(Cert, Signed) when is_binary(Cert) -> + OtpCert = pkix_decode_cert(Cert, otp), + pkix_issuer_id(OtpCert, Signed). %%-------------------------------------------------------------------- -spec pkix_crl_issuer(CRL::binary()| #'CertificateList'{}) -> @@ -990,17 +996,3 @@ ec_key({PubKey, PrivateKey}, Params) -> parameters = Params, publicKey = {0, PubKey}}. -pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed, decode) when (Signed == self) or - (Signed == other) -> - pubkey_cert:issuer_id(OtpCert, Signed); -pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed, encode) when (Signed == self) or - (Signed == other) -> - case pubkey_cert:issuer_id(OtpCert, Signed) of - {ok, {Serial, Issuer}} -> - {ok, {Serial, pubkey_cert_records:transform(Issuer, encode)}}; - Error -> - Error - end; -pkix_issuer_id(Cert, Signed, Decode) when is_binary(Cert) -> - OtpCert = pkix_decode_cert(Cert, otp), - pkix_issuer_id(OtpCert, Signed, Decode). diff --git a/lib/reltool/src/reltool.app.src b/lib/reltool/src/reltool.app.src index 65fcf4aae5..579d2c0d1b 100644 --- a/lib/reltool/src/reltool.app.src +++ b/lib/reltool/src/reltool.app.src @@ -36,5 +36,5 @@ {applications, [stdlib, kernel]}, {env, []}, {runtime_dependencies, ["wx-1.2","tools-2.6.14","stdlib-2.0","sasl-2.4", - "kernel-3.0","erts-6.0"]} + "kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl index 66bc2b5ab3..d9e6f6d427 100644 --- a/lib/reltool/src/reltool_fgraph_win.erl +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -252,10 +252,10 @@ ticker_init(Pid) -> ticker_loop(Pid, Time) -> receive after Time -> Pid ! {self(), redraw}, - T0 = now(), + T0 = erlang:monotonic_time(), receive {Pid, ok} -> ok end, - T1 = now(), - D = timer:now_diff(T1, T0)/1000, + T1 = erlang:monotonic_time(), + D = erlang:convert_time_unit(T1-T0, native, milli_seconds), case round(40 - D) of Ms when Ms < 0 -> %io:format("ticker: wait is 0 ms [fg ~7s ms] [fps ~7s]~n", diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index fea0854042..fe814ceda4 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -248,7 +248,7 @@ etop_collect(Collector) -> SchedulerWallTime = erlang:statistics(scheduler_wall_time), ProcInfo = etop_collect(processes(), []), - Collector ! {self(),#etop_info{now = now(), + Collector ! {self(),#etop_info{now = erlang:timestamp(), n_procs = length(ProcInfo), run_queue = erlang:statistics(run_queue), runtime = SchedulerWallTime, diff --git a/lib/runtime_tools/src/percept_profile.erl b/lib/runtime_tools/src/percept_profile.erl index cdc7a0fca1..dfadb21aa8 100644 --- a/lib/runtime_tools/src/percept_profile.erl +++ b/lib/runtime_tools/src/percept_profile.erl @@ -119,7 +119,7 @@ stop() -> undefined -> {error, not_started}; Port -> - erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:now()})), + erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:timestamp()})), %% trace delivered? erlang:port_close(Port), ok @@ -139,7 +139,7 @@ profile_to_file(Filename, Opts) -> erlang:system_flag(multi_scheduling, block), Port = (dbg:trace_port(file, Filename))(), % Send start time - erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:now()})), + erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:timestamp()})), erlang:system_flag(multi_scheduling, unblock), %% Register Port diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index 0a70802c08..32ea9e564b 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -27,6 +27,6 @@ {env, []}, {mod, {runtime_tools, []}}, {runtime_dependencies, ["stdlib-2.0","mnesia-4.12","kernel-3.0", - "erts-6.0"]}]}. + "erts-7.0"]}]}. diff --git a/lib/ssh/examples/Makefile b/lib/ssh/examples/Makefile index de019f75b5..9280c42076 100644 --- a/lib/ssh/examples/Makefile +++ b/lib/ssh/examples/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2015. 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 @@ -38,7 +38,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN) MODULES = \ - ssh_sample_cli + ssh_sample_cli \ + ssh_device.erl ERL_FILES= $(MODULES:=.erl) diff --git a/lib/ssh/examples/ssh_device.erl b/lib/ssh/examples/ssh_device.erl new file mode 100644 index 0000000000..f6be812915 --- /dev/null +++ b/lib/ssh/examples/ssh_device.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2015. 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(ssh_device). + +%% api +-export([ssh_device/5]). + +%%% I wrote this because of i think a fully ssh client sample will be easy to start the ssh module better than +%%% go though each function file. +ssh_device(Host, Port, User, Pass, Cmd) -> + ssh:start(), + case ssh:connect(Host, Port, + [{user, User}, {password, Pass}, + {silently_accept_hosts, true}, {quiet_mode, true}]) + of + {ok, Conn} -> + {ok, ChannelId} = ssh_connection:session_channel(Conn, + infinity), + ssh_connection:exec(Conn, ChannelId, Cmd, infinity), + Init_rep = <<>>, + wait_for_response(Conn, Host, Init_rep), + ssh:close(Conn); + {error, nxdomain} -> + {error,nxdomain} + end. + +%%-------------------------------------------------------------------- +%%% Internal application API +%%-------------------------------------------------------------------- +wait_for_response(Conn, Host, Acc) -> + receive + {ssh_cm, Conn, Msg} -> + case Msg of + {closed, _ChannelId} -> + {ok,Acc}; + {data, _, _, A} -> + Acc2 = <<Acc/binary, A/binary>>, + wait_for_response(Conn, Host, Acc2); + _ -> + wait_for_response(Conn, Host, Acc) + end + after + 5000 -> + {error,timeout} + end. diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index e5a8666af0..eae9ded5c6 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -179,14 +179,7 @@ line(Len, Char) -> datetime() -> - %% Adapt to new OTP 18 erlang time API and be back-compatible - TimeStamp = try - erlang:timestamp() - catch - error:undef -> - erlang:now() - end, - {{YYYY,MM,DD}, {H,M,S}} = calendar:now_to_universal_time(TimeStamp), + {{YYYY,MM,DD}, {H,M,S}} = calendar:now_to_universal_time(erlang:timestamp()), lists:flatten(io_lib:format('~4w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w UTC',[YYYY,MM,DD, H,M,S])). diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index b449012ffc..4c5498dc0e 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -715,14 +715,7 @@ ssh_connect_arg4_timeout(_Config) -> %% try to connect with a timeout, but "supervise" it Client = spawn(fun() -> - %% Adapt to OTP 18 erlang time API and be back-compatible - T0 = try - erlang:monotonic_time() - catch - error:undef -> - %% Use Erlang system time as monotonic time - erlang:now() - end, + T0 = erlang:monotonic_time(), Rc = ssh:connect("localhost",Port,[],Timeout), ct:log("Client ssh:connect got ~p",[Rc]), Parent ! {done,self(),Rc,T0} @@ -731,7 +724,7 @@ ssh_connect_arg4_timeout(_Config) -> %% Wait for client reaction on the connection try: receive {done, Client, {error,timeout}, T0} -> - Msp = ms_passed(T0), + Msp = ms_passed(T0), exit(Server,hasta_la_vista___baby), Low = 0.9*Timeout, High = 1.1*Timeout, @@ -755,17 +748,12 @@ ssh_connect_arg4_timeout(_Config) -> {fail, "Didn't timeout"} end. - %% Help function, elapsed milliseconds since T0 -ms_passed({_,_,_} = T0 ) -> - %% OTP 17 and earlier - timer:now_diff(erlang:now(), T0)/1000; - ms_passed(T0) -> %% OTP 18 - erlang:convert_time_resolution(erlang:monotonic_time() - T0, - erlang:time_resolution(), - 1000000)/1000. + erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, + micro_seconds) / 1000. %%-------------------------------------------------------------------- ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true). diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index c8cac3e852..bfebe2c60b 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.1 +SSH_VSN = 3.1.1 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index c9b02d44ec..47b0dbc206 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -89,12 +89,14 @@ |{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} | {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} + {alpn_advertised_protocols, [binary()]} | + {alpn_preferred_protocols, [binary()]} | {next_protocols_advertised, [binary()]} | {client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}} | {log_alert, boolean()} | {server_name_indication, hostname() | disable} </c></p> - <p><c>transportoption() = {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag:atom()}} + <p><c>transportoption() = {cb_info, {CallbackModule :: atom(), DataTag :: atom(), ClosedTag :: atom(), ErrTag:atom()}} - defaults to {gen_tcp, tcp, tcp_closed, tcp_error}. Can be used to customize the transport layer. The callback module must implement a reliable transport protocol and behave as gen_tcp and in addition have functions corresponding to @@ -303,20 +305,20 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo </taglist> </item> - <tag>{crl_check, boolean() | peer | best_effort )</tag> + <tag>{crl_check, boolean() | peer | best_effort }</tag> <item> Perform CRL (Certificate Revocation List) verification <seealso marker="public_key:public_key#pkix_crl_validate-3"> - public_key:pkix_crls_validate/3</seealso>, during the + (public_key:pkix_crls_validate/3)</seealso> on all the certificates during the path validation <seealso - marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3 </seealso> - invokation on all the certificates in the peer certificate chain. Defaults to - false. - + marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3) + </seealso> + of the certificate chain. Defaults to false. + <p><c>peer</c> - check is only performed on the peer certificate.</p> - <p><c>best_effort</c> - if certificate revokation status can not be determined + <p><c>best_effort</c> - if certificate revocation status can not be determined it will be accepted as valid.</p> <p>The CA certificates specified for the connection will be used to @@ -326,7 +328,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo <seealso marker="ssl:ssl_crl_cache_api">ssl_crl_cache_api(3)</seealso>.</p> </item> - <tag>{crl_cache, {Module::atom, {DbHandle::internal | term(), Args::list()}}</tag> + <tag>{crl_cache, {Module :: atom(), {DbHandle :: internal | term(), Args :: list()}}}</tag> <item> <p>Module defaults to ssl_crl_cache with <c> DbHandle </c> internal and an empty argument list. The following arguments may be specified for the internal cache.</p> @@ -425,7 +427,20 @@ fun(srp, Username :: string(), UserState :: term()) -> certificates are used during server authentication and when building the client certificate chain. </item> - + + <tag>{alpn_advertised_protocols, [binary()]}</tag> + <item> + <p>The list of protocols supported by the client to be sent to the + server to be used for an Application-Layer Protocol Negotiation (ALPN). + If the server supports ALPN then it will choose a protocol from this + list; otherwise it will fail the connection with a "no_application_protocol" + alert. A server that does not support ALPN will ignore this value.</p> + + <p>The list of protocols must not contain an empty binary.</p> + + <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> + </item> + <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</tag> <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</tag> <item> @@ -545,12 +560,25 @@ fun(srp, Username :: string(), UserState :: term()) -> and CipherSuite is of type ciphersuite(). </item> + <tag>{alpn_preferred_protocols, [binary()]}</tag> + <item> + <p>Indicates the server will try to perform Application-Layer + Protocol Negotiation (ALPN).</p> + + <p>The list of protocols is in order of preference. The protocol + negotiated will be the first in the list that matches one of the + protocols advertised by the client. If no protocol matches, the + server will fail the connection with a "no_application_protocol" alert.</p> + + <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> + </item> + <tag>{next_protocols_advertised, Protocols :: [binary()]}</tag> <item>The list of protocols to send to the client if the client indicates it supports the Next Protocol extension. The client may select a protocol that is not on this list. The list of protocols must not contain an empty binary. If the server negotiates a Next Protocol it can be accessed - using <c>negotiated_next_protocol/1</c> method. + using <c>negotiated_protocol/1</c> function. </item> <tag>{psk_identity, string()}</tag> @@ -1018,15 +1046,15 @@ fun(srp, Username :: string(), UserState :: term()) -> </desc> </func> <func> - <name>negotiated_next_protocol(Socket) -> {ok, Protocol} | {error, next_protocol_not_negotiated}</name> - <fsummary>Returns the Next Protocol negotiated.</fsummary> + <name>negotiated_protocol(Socket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name> + <fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Protocol = binary()</v> </type> <desc> <p> - Returns the Next Protocol negotiated. + Returns the protocol negotiated through ALPN or NPN extensions. </p> </desc> </func> diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml index 1ed76d3e2a..b291c7b633 100644 --- a/lib/ssl/doc/src/ssl_crl_cache.xml +++ b/lib/ssl/doc/src/ssl_crl_cache.xml @@ -29,7 +29,7 @@ <p> Implements an internal CRL (Certificate Revocation List) cache. In addition to implementing the <seealso - marker="ssl_cache_crl_api"> ssl_cache_crl_api</seealso> + marker="ssl_cache_crl_api"> ssl_cache_crl_api</seealso> behaviour the following functions are available. </p> </description> diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml index 24365c9f59..3f518496be 100644 --- a/lib/ssl/doc/src/ssl_crl_cache_api.xml +++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml @@ -27,13 +27,15 @@ <modulesummary>API for a SSL/TLS CRL (Certificate Revocation List) cache.</modulesummary> <description> <p> - When SSL/TLS performs certificate path validation according to - <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> it should - also perform CRL validation checks. To enable the CRL checks the application - needs access to CRLs. A database of CRLs can be set up in many different ways. - This module provides an API to integrate an arbitrary CRL cache with the erlang - ssl application. It is also used by the application itself to provide a simple - default implementation of a CRL cache. + When SSL/TLS performs certificate path validation according to + <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> + it should also perform CRL validation checks. To enable the CRL + checks the application needs access to CRLs. A database of CRLs + can be set up in many different ways. This module provides the + behavior of the API needed to integrate an arbitrary CRL cache + with the erlang ssl application. It is also used by the + application itself to provide a simple default implementation of + a CRL cache. </p> </description> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 508983ddac..610e2c4e41 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. 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 @@ -146,7 +146,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> Handshake = ssl_handshake:init_handshake_history(), TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), try ssl_config:init(SSLOpts0, Role) of - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} -> Session = State0#state.session, State = State0#state{ tls_handshake_history = Handshake, @@ -155,6 +155,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> file_ref_db = FileRefHandle, cert_db_ref = Ref, cert_db = CertDbHandle, + crl_db = CRLDbInfo, session_cache = CacheHandle, private_key = Key, diffie_hellman_params = DHParams}, @@ -227,9 +228,9 @@ hello(Hello, case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> handle_own_alert(Alert, ReqVersion, hello, State); - {Version, NewId, ConnectionStates, NextProtocol} -> + {Version, NewId, ConnectionStates, ProtoExt, Protocol} -> ssl_connection:handle_session(Hello, - Version, NewId, ConnectionStates, NextProtocol, State) + Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; hello(Msg, State) -> diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 31d525b295..30381df050 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -181,8 +181,8 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, SslOpt, ConnectionStates0, Renegotiation) of #alert{} = Alert -> Alert; - {ConnectionStates, Protocol} -> - {Version, SessionId, ConnectionStates, Protocol} + {ConnectionStates, ProtoExt, Protocol} -> + {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. dtls_fragment(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 623fa92121..6461f64c1c 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -38,10 +38,12 @@ %% SSL/TLS protocol handling -export([cipher_suites/0, cipher_suites/1, suite_definition/1, connection_info/1, versions/0, session_info/1, format_error/1, - renegotiate/1, prf/5, negotiated_next_protocol/1]). + renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1]). %% Misc -export([random_bytes/1]). +-deprecated({negotiated_next_protocol, 1, next_major_release}). + -include("ssl_api.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). @@ -330,13 +332,27 @@ suite_definition(S) -> {KeyExchange, Cipher, Hash}. %%-------------------------------------------------------------------- +-spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. +%% +%% Description: Returns the protocol that has been negotiated. If no +%% protocol has been negotiated will return {error, protocol_not_negotiated} +%%-------------------------------------------------------------------- +negotiated_protocol(#sslsocket{pid = Pid}) -> + ssl_connection:negotiated_protocol(Pid). + +%%-------------------------------------------------------------------- -spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. %% %% Description: Returns the next protocol that has been negotiated. If no %% protocol has been negotiated will return {error, next_protocol_not_negotiated} %%-------------------------------------------------------------------- -negotiated_next_protocol(#sslsocket{pid = Pid}) -> - ssl_connection:negotiated_next_protocol(Pid). +negotiated_next_protocol(Socket) -> + case negotiated_protocol(Socket) of + {error, protocol_not_negotiated} -> + {error, next_protocol_not_negotiated}; + Res -> + Res + end. %%-------------------------------------------------------------------- -spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] | @@ -644,6 +660,10 @@ handle_options(Opts0) -> renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), + alpn_advertised_protocols = + handle_option(alpn_advertised_protocols, Opts, undefined), + alpn_preferred_protocols = + handle_option(alpn_preferred_protocols, Opts, undefined), next_protocols_advertised = handle_option(next_protocols_advertised, Opts, undefined), next_protocol_selector = @@ -667,7 +687,8 @@ handle_options(Opts0) -> user_lookup_fun, psk_identity, srp_identity, ciphers, reuse_session, reuse_sessions, ssl_imp, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, - erl_dist, next_protocols_advertised, + erl_dist, alpn_advertised_protocols, + alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, fallback], @@ -803,6 +824,20 @@ validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; validate_option(erl_dist,Value) when is_boolean(Value) -> Value; +validate_option(Opt, Value) + when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, + is_list(Value) -> + case tls_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(Opt, Value), + Value + end; +validate_option(Opt, Value) + when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, + Value =:= undefined -> + undefined; validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value) when is_list(PreferredProtocols) -> case tls_record:highest_protocol_version([]) of @@ -1131,6 +1166,10 @@ new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, Rec new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); +new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{alpn_advertised_protocols = validate_option(alpn_advertised_protocols, Value)}, RecordCB); +new_ssl_options([{alpn_preferred_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{alpn_preferred_protocols = validate_option(alpn_preferred_protocols, Value)}, RecordCB); new_ssl_options([{next_protocols_advertised, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{next_protocols_advertised = validate_option(next_protocols_advertised, Value)}, RecordCB); new_ssl_options([{client_preferred_next_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 9e372f739a..c46facb75d 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -163,5 +163,7 @@ description_txt(?UNKNOWN_PSK_IDENTITY) -> "unknown psk identity"; description_txt(?INAPPROPRIATE_FALLBACK) -> "inappropriate fallback"; +description_txt(?NO_APPLICATION_PROTOCOL) -> + "no application protocol"; description_txt(Enum) -> lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])). diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index a3619e4a35..70b7523975 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -69,6 +69,8 @@ %% bad_certificate_hash_value(114), %% RFC 4366 %% unknown_psk_identity(115), +%% RFC 7301 +%% no_application_protocol(120), %% (255) %% } AlertDescription; @@ -103,6 +105,7 @@ -define(BAD_CERTIFICATE_STATUS_RESPONSE, 113). -define(BAD_CERTIFICATE_HASH_VALUE, 114). -define(UNKNOWN_PSK_IDENTITY, 115). +-define(NO_APPLICATION_PROTOCOL, 120). -define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}). diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl index 22185ff60a..78127eeafa 100644 --- a/lib/ssl/src/ssl_api.hrl +++ b/lib/ssl/src/ssl_api.hrl @@ -49,6 +49,8 @@ {srp_identity, {string(), string()}} | {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} | {hibernate_after, integer()|undefined} | + {alpn_advertised_protocols, [binary()]} | + {alpn_preferred_protocols, [binary()]} | {next_protocols_advertised, list(binary())} | {client_preferred_next_protocols, binary(), client | server, list(binary())}. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 764bd82de0..34e4a8b447 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -84,7 +84,7 @@ trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) - end. %%-------------------------------------------------------------------- --spec certificate_chain(undefined | binary(), db_handle(), certdb_ref()) -> +-spec certificate_chain(undefined | binary() | #'OTPCertificate'{} , db_handle(), certdb_ref()) -> {error, no_cert} | {ok, #'OTPCertificate'{} | undefined, [der_cert()]}. %% %% Description: Return the certificate chain to send to peer. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 08d0145aa7..4a839872a6 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -42,10 +42,10 @@ %% User Events -export([send/2, recv/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, - peer_certificate/1, renegotiation/1, negotiated_next_protocol/1, prf/5 + peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5 ]). --export([handle_session/6]). +-export([handle_session/7]). %% SSL FSM state functions -export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]). @@ -191,12 +191,12 @@ new_user(ConnectionPid, User) -> sync_send_all_state_event(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- --spec negotiated_next_protocol(pid()) -> {ok, binary()} | {error, reason()}. +-spec negotiated_protocol(pid()) -> {ok, binary()} | {error, reason()}. %% %% Description: Returns the negotiated protocol %%-------------------------------------------------------------------- -negotiated_next_protocol(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, negotiated_next_protocol). +negotiated_protocol(ConnectionPid) -> + sync_send_all_state_event(ConnectionPid, negotiated_protocol). %%-------------------------------------------------------------------- -spec get_opts(pid(), list()) -> {ok, list()} | {error, reason()}. @@ -258,27 +258,26 @@ prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> handle_session(#server_hello{cipher_suite = CipherSuite, compression_method = Compression}, - Version, NewId, ConnectionStates, NextProtocol, + Version, NewId, ConnectionStates, ProtoExt, Protocol0, #state{session = #session{session_id = OldId}, - negotiated_version = ReqVersion} = State0) -> + negotiated_version = ReqVersion, + negotiated_protocol = CurrentProtocol} = State0) -> {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), - - NewNextProtocol = case NextProtocol of - undefined -> - State0#state.next_protocol; - _ -> - NextProtocol - end, - + + {ExpectNPN, Protocol} = case Protocol0 of + undefined -> {false, CurrentProtocol}; + _ -> {ProtoExt =:= npn, Protocol0} + end, + State = State0#state{key_algorithm = KeyAlgorithm, negotiated_version = Version, connection_states = ConnectionStates, premaster_secret = PremasterSecret, - expecting_next_protocol_negotiation = NextProtocol =/= undefined, - next_protocol = NewNextProtocol}, + expecting_next_protocol_negotiation = ExpectNPN, + negotiated_protocol = Protocol}, case ssl_session:is_new(OldId, NewId) of true -> @@ -371,7 +370,7 @@ abbreviated(#finished{verify_data = Data} = Finished, abbreviated(#next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}), + {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), Connection:next_state(abbreviated, abbreviated, Record, State#state{expecting_next_protocol_negotiation = false}); abbreviated(timeout, State, _) -> @@ -593,7 +592,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS %% client must send a next protocol message if we are expecting it cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true, - next_protocol = undefined, negotiated_version = Version} = State0, + negotiated_protocol = undefined, negotiated_version = Version} = State0, Connection) -> Connection:handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0); @@ -623,7 +622,7 @@ cipher(#finished{verify_data = Data} = Finished, cipher(#next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true, expecting_finished = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}), + {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false}); cipher(timeout, State, _) -> @@ -759,10 +758,10 @@ handle_sync_event({get_opts, OptTags}, _From, StateName, socket_options = SockOpts} = State) -> OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> - {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) -> - {reply, {ok, NextProtocol}, StateName, State, get_timeout(State)}; +handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = undefined} = State) -> + {reply, {error, protocol_not_negotiated}, StateName, State, get_timeout(State)}; +handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = SelectedProtocol} = State) -> + {reply, {ok, SelectedProtocol}, StateName, State, get_timeout(State)}; handle_sync_event({set_opts, Opts0}, _From, StateName0, #state{socket_options = Opts1, protocol_cb = Connection, @@ -1484,11 +1483,11 @@ finalize_handshake(State0, StateName, Connection) -> next_protocol(#state{role = server} = State, _) -> State; -next_protocol(#state{next_protocol = undefined} = State, _) -> +next_protocol(#state{negotiated_protocol = undefined} = State, _) -> State; next_protocol(#state{expecting_next_protocol_negotiation = false} = State, _) -> State; -next_protocol(#state{next_protocol = NextProtocol} = State0, Connection) -> +next_protocol(#state{negotiated_protocol = NextProtocol} = State0, Connection) -> NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol), Connection:send_handshake(NextProtocolMessage, State0). diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index ac3b26e4bf..e569d706af 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -78,7 +78,7 @@ allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), expecting_finished = false ::boolean(), - next_protocol = undefined :: undefined | binary(), + negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} tracker :: pid() %% Tracker process for listen socket }). diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl index b8761f0601..1a08d3c80a 100644 --- a/lib/ssl/src/ssl_crl.erl +++ b/lib/ssl/src/ssl_crl.erl @@ -73,8 +73,6 @@ verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) -> true -> throw({ok, ErlCertCandidate}); false -> - NotIssuer; - _ -> NotIssuer end; _ -> diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl index b2bdb19979..b9d6a61c3b 100644 --- a/lib/ssl/src/ssl_crl_cache.erl +++ b/lib/ssl/src/ssl_crl_cache.erl @@ -34,7 +34,7 @@ %% Cache callback API %%==================================================================== -lookup(#'DistributionPoint'{distributionPoint={fullName, Names}}, +lookup(#'DistributionPoint'{distributionPoint = {fullName, Names}}, CRLDbInfo) -> get_crls(Names, CRLDbInfo); lookup(_,_) -> @@ -48,8 +48,8 @@ select(Issuer, {{_Cache, Mapping},_}) -> CRLs end. -fresh_crl(DistributionPoint, CRL) -> - case get_crls(DistributionPoint, undefined) of +fresh_crl(#'DistributionPoint'{distributionPoint = {fullName, Names}}, CRL) -> + case get_crls(Names, undefined) of not_available -> CRL; [NewCRL] -> diff --git a/lib/ssl/src/ssl_crl_cache_api.erl b/lib/ssl/src/ssl_crl_cache_api.erl index 0915ba12e5..79db65104b 100644 --- a/lib/ssl/src/ssl_crl_cache_api.erl +++ b/lib/ssl/src/ssl_crl_cache_api.erl @@ -25,6 +25,6 @@ -type db_handle() :: term(). --callback lookup(#'DistributionPoint'{}, db_handle()) -> not_available | [public_key:der_encode()]. --callback select(term(), db_handle()) -> [public_key:der_encode()]. --callback fresh_crl(#'DistributionPoint'{}, public_key:der_encode()) -> public_key:der_encode(). +-callback lookup(#'DistributionPoint'{}, db_handle()) -> not_available | [public_key:der_encoded()]. +-callback select(term(), db_handle()) -> [public_key:der_encoded()]. +-callback fresh_crl(#'DistributionPoint'{}, public_key:der_encoded()) -> public_key:der_encoded(). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 6cab8eb7a1..493e5a87d9 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -136,6 +136,7 @@ client_hello_extensions(Host, Version, CipherSuites, SslOpts, ConnectionStates, hash_signs = advertised_hash_signs(Version), ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, + alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), next_protocol_negotiation = encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, Renegotiation), @@ -764,6 +765,11 @@ encode_hello_extensions([], Acc) -> Size = byte_size(Acc), <<?UINT16(Size), Acc/binary>>; +encode_hello_extensions([#alpn{extension_data = ExtensionData} | Rest], Acc) -> + Len = byte_size(ExtensionData), + ExtLen = Len + 2, + encode_hello_extensions(Rest, <<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), + ExtensionData/binary, Acc/binary>>); encode_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) -> Len = byte_size(ExtensionData), encode_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), @@ -862,6 +868,25 @@ decode_client_key(ClientKey, Type, Version) -> decode_server_key(ServerKey, Type, Version) -> dec_server_key(ServerKey, key_exchange_alg(Type), Version). +%% +%% Description: Encode and decode functions for ALPN extension data. +%%-------------------------------------------------------------------- + +%% While the RFC opens the door to allow ALPN during renegotiation, in practice +%% this does not work and it is recommended to ignore any ALPN extension during +%% renegotiation, as done here. +encode_alpn(_, true) -> + undefined; +encode_alpn(undefined, _) -> + undefined; +encode_alpn(Protocols, _) -> + #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. + +decode_alpn(undefined) -> + undefined; +decode_alpn(#alpn{extension_data=Data}) -> + decode_protocols(Data, []). + encode_client_protocol_negotiation(undefined, _) -> undefined; encode_client_protocol_negotiation(_, false) -> @@ -1124,8 +1149,10 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, #hello_extensions{renegotiation_info = Info, srp = SRP, ec_point_formats = ECCFormat, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation}, Version, - #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, + #ssl_options{secure_renegotiate = SecureRenegotation, + alpn_preferred_protocols = ALPNPreferredProtocols} = Opts, #session{cipher_suite = NegotiatedCipherSuite, compression_method = Compression} = Session0, ConnectionStates0, Renegotiation) -> @@ -1134,19 +1161,34 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, Random, NegotiatedCipherSuite, ClientCipherSuites, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), - ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), - + ServerHelloExtensions = #hello_extensions{ renegotiation_info = renegotiation_info(RecordCB, server, ConnectionStates, Renegotiation), - ec_point_formats = server_ecc_extension(Version, ECCFormat), - next_protocol_negotiation = - encode_protocols_advertised_on_server(ProtocolsToAdvertise) + ec_point_formats = server_ecc_extension(Version, ECCFormat) }, - {Session, ConnectionStates, ServerHelloExtensions}. + + %% If we receive an ALPN extension and have ALPN configured for this connection, + %% we handle it. Otherwise we check for the NPN extension. + if + ALPN =/= undefined, ALPNPreferredProtocols =/= undefined -> + case handle_alpn_extension(ALPNPreferredProtocols, decode_alpn(ALPN)) of + #alert{} = Alert -> + Alert; + Protocol -> + {Session, ConnectionStates, Protocol, + ServerHelloExtensions#hello_extensions{alpn=encode_alpn([Protocol], Renegotiation)}} + end; + true -> + ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), + {Session, ConnectionStates, undefined, + ServerHelloExtensions#hello_extensions{next_protocol_negotiation= + encode_protocols_advertised_on_server(ProtocolsToAdvertise)}} + end. handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, #hello_extensions{renegotiation_info = Info, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation}, Version, #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtoSelector}, @@ -1155,11 +1197,23 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, CipherSuite, undefined, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), - case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of - #alert{} = Alert -> - Alert; - Protocol -> - {ConnectionStates, Protocol} + + %% If we receive an ALPN extension then this is the protocol selected, + %% otherwise handle the NPN extension. + case decode_alpn(ALPN) of + %% ServerHello contains exactly one protocol: the one selected. + %% We also ignore the ALPN extension during renegotiation (see encode_alpn/2). + [Protocol] when not Renegotiation -> + {ConnectionStates, alpn, Protocol}; + undefined -> + case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of + #alert{} = Alert -> + Alert; + Protocol -> + {ConnectionStates, npn, Protocol} + end; + _ -> %% {error, _Reason} or a list of 0/2+ protocols. + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end. select_version(RecordCB, ClientVersion, Versions) -> @@ -1267,10 +1321,11 @@ hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, hash_signs = HashSigns, ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation, sni = Sni}) -> [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, - EcPointFormats, EllipticCurves, NextProtocolNegotiation, Sni], Ext =/= undefined]. + EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined]. srp_user(#ssl_options{srp_identity = {UserName, _}}) -> #srp{username = UserName}; @@ -1708,6 +1763,10 @@ dec_server_key_signature(_, _, _) -> dec_hello_extensions(<<>>, Acc) -> Acc; +dec_hello_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) + when Len + 2 =:= ExtLen -> + ALPN = #alpn{extension_data = ExtensionData}, + dec_hello_extensions(Rest, Acc#hello_extensions{alpn = ALPN}); dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) -> NextP = #next_protocol_negotiation{extension_data = ExtensionData}, dec_hello_extensions(Rest, Acc#hello_extensions{next_protocol_negotiation = NextP}); @@ -1788,18 +1847,19 @@ dec_sni(<<?BYTE(_), ?UINT16(Len), _:Len, Rest/binary>>) -> dec_sni(Rest); dec_sni(_) -> undefined. decode_next_protocols({next_protocol_negotiation, Protocols}) -> - decode_next_protocols(Protocols, []). -decode_next_protocols(<<>>, Acc) -> + decode_protocols(Protocols, []). + +decode_protocols(<<>>, Acc) -> lists:reverse(Acc); -decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> +decode_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> case Len of 0 -> - {error, invalid_next_protocols}; + {error, invalid_protocols}; _ -> - decode_next_protocols(Rest, [Protocol|Acc]) + decode_protocols(Rest, [Protocol|Acc]) end; -decode_next_protocols(_Bytes, _Acc) -> - {error, invalid_next_protocols}. +decode_protocols(_Bytes, _Acc) -> + {error, invalid_protocols}. %% encode/decode stream of certificate data to/from list of certificate data certs_to_list(ASN1Certs) -> @@ -1853,6 +1913,17 @@ key_exchange_alg(_) -> %%-------------Extension handling -------------------------------- +%% Receive protocols, choose one from the list, return it. +handle_alpn_extension(_, {error, _Reason}) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); +handle_alpn_extension([], _) -> + ?ALERT_REC(?FATAL, ?NO_APPLICATION_PROTOCOL); +handle_alpn_extension([ServerProtocol|Tail], ClientProtocols) -> + case lists:member(ServerProtocol, ClientProtocols) of + true -> ServerProtocol; + false -> handle_alpn_extension(Tail, ClientProtocols) + end. + handle_next_protocol(undefined, _NextProtocolSelector, _Renegotiating) -> undefined; @@ -1998,12 +2069,12 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) - case dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) of [] -> valid; %% No relevant CRL existed - Dps -> - crl_check_same_issuer(OtpCert, Check, Dps, Options) + DpsAndCRls -> + crl_check_same_issuer(OtpCert, Check, DpsAndCRls, Options) end; - Dps -> %% This DP list may be empty if relevant CRLs existed + DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed %% but could not be retrived, will result in {bad_cert, revocation_status_undetermined} - case public_key:pkix_crls_validate(OtpCert, Dps, Options) of + case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of {bad_cert, revocation_status_undetermined} -> crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer), Options); diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 80284faef0..91f674a6fc 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -95,6 +95,7 @@ -record(hello_extensions, { renegotiation_info, hash_signs, % supported combinations of hashes/signature algos + alpn, next_protocol_negotiation = undefined, % [binary()] srp, ec_point_formats, @@ -301,6 +302,14 @@ }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Application-Layer Protocol Negotiation RFC 7301 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(ALPN_EXT, 16). + +-record(alpn, {extension_data}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Next Protocol Negotiation %% (http://tools.ietf.org/html/draft-agl-tls-nextprotoneg-02) %% (http://technotes.googlecode.com/git/nextprotoneg.html) diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8df79f9e8c..90f8b8a412 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -116,16 +116,18 @@ hibernate_after :: boolean(), %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), - next_protocols_advertised = undefined, %% [binary()], + alpn_advertised_protocols = undefined :: [binary()] | undefined , + alpn_preferred_protocols = undefined :: [binary()] | undefined, + next_protocols_advertised = undefined :: [binary()] | undefined, next_protocol_selector = undefined, %% fun([binary()]) -> binary()) log_alert :: boolean(), server_name_indication = undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? - honor_cipher_order = false, - padding_check = true, - fallback = false, - crl_check, + honor_cipher_order = false :: boolean(), + padding_check = true :: boolean(), + fallback = false :: boolean(), + crl_check :: boolean() | peer | best_effort, crl_cache }). diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 9c4b2a8bad..396013825e 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -101,8 +101,10 @@ start_link_dist(Opts) -> gen_server:start_link({local, DistMangerName}, ?MODULE, [DistMangerName, Opts], []). %%-------------------------------------------------------------------- --spec connection_init(binary()| {der, list()}, client | server, {Cb :: atom(), Handle:: term()}) -> - {ok, certdb_ref(), db_handle(), db_handle(), db_handle(), db_handle()}. +-spec connection_init(binary()| {der, list()}, client | server, + {Cb :: atom(), Handle:: term()}) -> + {ok, certdb_ref(), db_handle(), db_handle(), + db_handle(), db_handle(), CRLInfo::term()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 77d3aa7889..0577222980 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -188,19 +188,27 @@ hello(Hello = #client_hello{client_version = ClientVersion, renegotiation = {Renegotiation, _}, session_cache = Cache, session_cache_cb = CacheCb, + negotiated_protocol = CurrentProtocol, ssl_options = SslOpts}) -> case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of + #alert{} = Alert -> + handle_own_alert(Alert, ClientVersion, hello, State); {Version, {Type, Session}, - ConnectionStates, ServerHelloExt} -> + ConnectionStates, Protocol0, ServerHelloExt} -> + + Protocol = case Protocol0 of + undefined -> CurrentProtocol; + _ -> Protocol0 + end, + 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, session = Session, - client_ecc = {EllipticCurves, EcPointFormats}}, ?MODULE); - #alert{} = Alert -> - handle_own_alert(Alert, ClientVersion, hello, State) + client_ecc = {EllipticCurves, EcPointFormats}, + negotiated_protocol = Protocol}, ?MODULE) end; hello(Hello, #state{connection_states = ConnectionStates0, @@ -211,9 +219,9 @@ hello(Hello, case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> handle_own_alert(Alert, ReqVersion, hello, State); - {Version, NewId, ConnectionStates, NextProtocol} -> + {Version, NewId, ConnectionStates, ProtoExt, Protocol} -> ssl_connection:handle_session(Hello, - Version, NewId, ConnectionStates, NextProtocol, State) + Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; hello(Msg, State) -> diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index b0b6d5a8e3..d936310991 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -78,12 +78,14 @@ client_hello(Host, Port, ConnectionStates, %%-------------------------------------------------------------------- -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, #connection_states{} | {inet:port_number(), #session{}, db_handle(), - atom(), #connection_states{}, binary() | undefined}, + atom(), #connection_states{}, + binary() | undefined}, boolean()) -> - {tls_record:tls_version(), session_id(), #connection_states{}, binary() | undefined}| - {tls_record:tls_version(), {resumed | new, #session{}}, #connection_states{}, - [binary()] | undefined, - [ssl_handshake:oid()] | undefined, [ssl_handshake:oid()] | undefined} | + {tls_record:tls_version(), session_id(), + #connection_states{}, alpn | npn, binary() | undefined}| + {tls_record:tls_version(), {resumed | new, #session{}}, + #connection_states{}, binary() | undefined, + #hello_extensions{}} | #alert{}. %% %% Description: Handles a recieved hello message @@ -246,8 +248,10 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites, HelloExt, Version, SslOpts, Session0, ConnectionStates0, Renegotiation) of - {Session, ConnectionStates, ServerHelloExt} -> - {Version, {Type, Session}, ConnectionStates, ServerHelloExt} + #alert{} = Alert -> + Alert; + {Session, ConnectionStates, Protocol, ServerHelloExt} -> + {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt} catch throw:Alert -> Alert end. @@ -260,7 +264,7 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, SslOpt, ConnectionStates0, Renegotiation) of #alert{} = Alert -> Alert; - {ConnectionStates, Protocol} -> - {Version, SessionId, ConnectionStates, Protocol} + {ConnectionStates, ProtoExt, Protocol} -> + {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 09cc5981e7..8c45a788a4 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -36,6 +36,7 @@ VSN=$(GS_VSN) MODULES = \ ssl_test_lib \ + ssl_alpn_handshake_SUITE \ ssl_basic_SUITE \ ssl_bench_SUITE \ ssl_cipher_SUITE \ diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl new file mode 100644 index 0000000000..ccd70fa605 --- /dev/null +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -0,0 +1,414 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. 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_alpn_handshake_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). +-include_lib("common_test/include/ct.hrl"). + +-define(SLEEP, 500). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}]. + +groups() -> + [ + {'tlsv1.2', [], alpn_tests()}, + {'tlsv1.1', [], alpn_tests()}, + {'tlsv1', [], alpn_tests()}, + {'sslv3', [], alpn_not_supported()} + ]. + +alpn_tests() -> + [empty_protocols_are_not_allowed, + protocols_must_be_a_binary_list, + empty_client, + empty_server, + empty_client_empty_server, + no_matching_protocol, + client_alpn_and_server_alpn, + client_alpn_and_server_no_support, + client_no_support_and_server_alpn, + client_alpn_npn_and_server_alpn, + client_alpn_npn_and_server_alpn_npn, + client_alpn_and_server_alpn_npn, + client_renegotiate, + session_reused + ]. + +alpn_not_supported() -> + [alpn_not_supported_client, + alpn_not_supported_server + ]. + +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + Result = + (catch make_certs:all(?config(data_dir, Config), + ?config(priv_dir, Config))), + ct:log("Make certs ~p~n", [Result]), + ssl_test_lib:cert_options(Config) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:unload(ssl), + application:stop(crypto). + + +init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + case ssl_test_lib:sufficient_crypto_support(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName), + Config; + false -> + {skip, "Missing crypto support"} + end; + _ -> + ssl:start(), + Config + end. + +end_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +empty_protocols_are_not_allowed(Config) when is_list(Config) -> + {error, {options, {alpn_preferred_protocols, {invalid_protocol, <<>>}}}} + = (catch ssl:listen(9443, + [{alpn_preferred_protocols, [<<"foo/1">>, <<"">>]}])), + {error, {options, {alpn_advertised_protocols, {invalid_protocol, <<>>}}}} + = (catch ssl:connect({127,0,0,1}, 9443, + [{alpn_advertised_protocols, [<<"foo/1">>, <<"">>]}])). + +%-------------------------------------------------------------------------------- + +protocols_must_be_a_binary_list(Config) when is_list(Config) -> + Option1 = {alpn_preferred_protocols, hello}, + {error, {options, Option1}} = (catch ssl:listen(9443, [Option1])), + Option2 = {alpn_preferred_protocols, [<<"foo/1">>, hello]}, + {error, {options, {alpn_preferred_protocols, {invalid_protocol, hello}}}} + = (catch ssl:listen(9443, [Option2])), + Option3 = {alpn_advertised_protocols, hello}, + {error, {options, Option3}} = (catch ssl:connect({127,0,0,1}, 9443, [Option3])), + Option4 = {alpn_advertised_protocols, [<<"foo/1">>, hello]}, + {error, {options, {alpn_advertised_protocols, {invalid_protocol, hello}}}} + = (catch ssl:connect({127,0,0,1}, 9443, [Option4])). + +%-------------------------------------------------------------------------------- + +empty_client(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, []}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +empty_server(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, []}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +empty_client_empty_server(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, []}], + [{alpn_preferred_protocols, []}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +no_matching_protocol(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +client_alpn_and_server_alpn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_alpn_and_server_no_support(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [], + {error, protocol_not_negotiated}). + +%-------------------------------------------------------------------------------- + +client_no_support_and_server_alpn(Config) when is_list(Config) -> + run_handshake(Config, + [], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {error, protocol_not_negotiated}). + +%-------------------------------------------------------------------------------- + +client_alpn_npn_and_server_alpn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}, + {client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"spdy/3">>}}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_alpn_npn_and_server_alpn_npn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}, + {client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"spdy/3">>}}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_alpn_and_server_alpn_npn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_renegotiate(Config) when is_list(Config) -> + Data = "hello world", + + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, + ExpectedProtocol = {ok, <<"http/1.0">>}, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, ssl_receive_and_assert_alpn, [ExpectedProtocol, Data]}}, + {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, assert_alpn_and_renegotiate_and_send_data, [ExpectedProtocol, Data]}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%-------------------------------------------------------------------------------- + +session_reused(Config) when is_list(Config)-> + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, + + {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, session_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, {ssl_test_lib, no_result_msg, []}}, + {options, ClientOpts}]), + + SessionInfo = + receive + {Server, Info} -> + Info + end, + + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, + + %% Make sure session is registered + ct:sleep(?SLEEP), + + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_info_result, []}}, + {from, self()}, {options, ClientOpts}]), + + receive + {Client1, SessionInfo} -> + ok; + {Client1, Other} -> + ct:fail(Other) + end, + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + ssl_test_lib:close(Client1). + +%-------------------------------------------------------------------------------- + +alpn_not_supported_client(Config) when is_list(Config) -> + ClientOpts0 = ?config(client_opts, Config), + PrefProtocols = {client_preferred_next_protocols, + {client, [<<"http/1.0">>], <<"http/1.1">>}}, + ClientOpts = [PrefProtocols] ++ ClientOpts0, + {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, + {port, 8888}, {host, Hostname}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:check_result(Client, {error, + {options, + {not_supported_in_sslv3, PrefProtocols}}}). + +%-------------------------------------------------------------------------------- + +alpn_not_supported_server(Config) when is_list(Config)-> + ServerOpts0 = ?config(server_opts, Config), + AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + ServerOpts = [AdvProtocols] ++ ServerOpts0, + + {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- + +run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) -> + ClientOpts = ClientExtraOpts ++ ?config(client_opts, Config), + ServerOpts = ServerExtraOpts ++ ?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, placeholder, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + ExpectedResult + = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, placeholder, []}}, + {options, ClientOpts}]). + +run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> + Data = "hello world", + + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = ClientExtraOpts ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = ServerExtraOpts ++ ServerOpts0, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, ssl_receive_and_assert_alpn, [ExpectedProtocol, Data]}}, + {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, ssl_send_and_assert_alpn, [ExpectedProtocol, Data]}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +assert_alpn(Socket, Protocol) -> + ct:log("Negotiated Protocol ~p, Expecting: ~p ~n", + [ssl:negotiated_protocol(Socket), Protocol]), + Protocol = ssl:negotiated_protocol(Socket). + +assert_alpn_and_renegotiate_and_send_data(Socket, Protocol, Data) -> + assert_alpn(Socket, Protocol), + ct:log("Renegotiating ~n", []), + ok = ssl:renegotiate(Socket), + ssl:send(Socket, Data), + assert_alpn(Socket, Protocol), + ok. + +ssl_send_and_assert_alpn(Socket, Protocol, Data) -> + assert_alpn(Socket, Protocol), + ssl_send(Socket, Data). + +ssl_receive_and_assert_alpn(Socket, Protocol, Data) -> + assert_alpn(Socket, Protocol), + ssl_receive(Socket, Data). + +ssl_send(Socket, Data) -> + ct:log("Connection info: ~p~n", + [ssl:connection_info(Socket)]), + ssl:send(Socket, Data). + +ssl_receive(Socket, Data) -> + ssl_receive(Socket, Data, []). + +ssl_receive(Socket, Data, Buffer) -> + ct:log("Connection info: ~p~n", + [ssl:connection_info(Socket)]), + receive + {ssl, Socket, MoreData} -> + ct:log("Received ~p~n",[MoreData]), + NewBuffer = Buffer ++ MoreData, + case NewBuffer of + Data -> + ssl:send(Socket, "Got it"), + ok; + _ -> + ssl_receive(Socket, Data, NewBuffer) + end; + Other -> + ct:fail({unexpected_message, Other}) + after 4000 -> + ct:fail({did_not_get, Data}) + end. + +connection_info_result(Socket) -> + ssl:connection_info(Socket). diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 30c0a67a36..326f907e66 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -172,7 +172,7 @@ no_client_negotiate_but_server_supports_npn(Config) when is_list(Config) -> run_npn_handshake(Config, [], [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}], - {error, next_protocol_not_negotiated}). + {error, protocol_not_negotiated}). %-------------------------------------------------------------------------------- @@ -180,7 +180,7 @@ client_negotiate_server_does_not_support(Config) when is_list(Config) -> run_npn_handshake(Config, [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], [], - {error, next_protocol_not_negotiated}). + {error, protocol_not_negotiated}). %-------------------------------------------------------------------------------- renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> @@ -311,8 +311,8 @@ run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> assert_npn(Socket, Protocol) -> ct:log("Negotiated Protocol ~p, Expecting: ~p ~n", - [ssl:negotiated_next_protocol(Socket), Protocol]), - Protocol = ssl:negotiated_next_protocol(Socket). + [ssl:negotiated_protocol(Socket), Protocol]), + Protocol = ssl:negotiated_protocol(Socket). assert_npn_and_renegotiate_and_send_data(Socket, Protocol, Data) -> assert_npn(Socket, Protocol), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 7d0546210c..d19e3b7fdb 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1090,6 +1090,8 @@ cipher_restriction(Config0) -> check_sane_openssl_version(Version) -> case {Version, os:cmd("openssl version")} of + {_, "OpenSSL 1.0.2" ++ _} -> + true; {_, "OpenSSL 1.0.1" ++ _} -> true; {'tlsv1.2', "OpenSSL 1.0" ++ _} -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 942c446ec4..27ee07ffc6 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. 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 @@ -50,9 +50,9 @@ all() -> groups() -> [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests() ++ npn_tests()}, - {'tlsv1.1', [], all_versions_tests() ++ npn_tests()}, - {'tlsv1', [], all_versions_tests()++ npn_tests()}, + {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()}, + {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()}, + {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests()}, {'sslv3', [], all_versions_tests()}]. basic_tests() -> @@ -79,6 +79,18 @@ all_versions_tests() -> expired_session, ssl2_erlang_server_openssl_client]. +alpn_tests() -> + [erlang_client_alpn_openssl_server_alpn, + erlang_server_alpn_openssl_client_alpn, + erlang_client_alpn_openssl_server, + erlang_client_openssl_server_alpn, + erlang_server_alpn_openssl_client, + erlang_server_openssl_client_alpn, + erlang_client_alpn_openssl_server_alpn_renegotiate, + erlang_server_alpn_openssl_client_alpn_renegotiate, + erlang_client_alpn_npn_openssl_server_alpn_npn, + erlang_server_alpn_npn_openssl_client_alpn_npn]. + npn_tests() -> [erlang_client_openssl_server_npn, erlang_server_openssl_client_npn, @@ -161,6 +173,36 @@ special_init(ssl2_erlang_server_openssl_client, Config) -> check_sane_openssl_sslv2(Config); special_init(TestCase, Config) + when TestCase == erlang_client_alpn_openssl_server_alpn; + TestCase == erlang_server_alpn_openssl_client_alpn; + TestCase == erlang_client_alpn_openssl_server; + TestCase == erlang_client_openssl_server_alpn; + TestCase == erlang_server_alpn_openssl_client; + TestCase == erlang_server_openssl_client_alpn -> + check_openssl_alpn_support(Config); + +special_init(TestCase, Config) + when TestCase == erlang_client_alpn_openssl_server_alpn_renegotiate; + TestCase == erlang_server_alpn_openssl_client_alpn_renegotiate -> + {ok, Version} = application:get_env(ssl, protocol_version), + case check_sane_openssl_renegotaite(Config, Version) of + {skip, _} = Skip -> + Skip; + _ -> + check_openssl_alpn_support(Config) + end; + +special_init(TestCase, Config) + when TestCase == erlang_client_alpn_npn_openssl_server_alpn_npn; + TestCase == erlang_server_alpn_npn_openssl_client_alpn_npn -> + case check_openssl_alpn_support(Config) of + {skip, _} = Skip -> + Skip; + _ -> + check_openssl_npn_support(Config) + end; + +special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_npn; TestCase == erlang_server_openssl_client_npn; TestCase == erlang_server_openssl_client_npn_only_server; @@ -179,6 +221,7 @@ special_init(TestCase, Config) _ -> check_openssl_npn_support(Config) end; + special_init(_, Config) -> Config. @@ -248,7 +291,7 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ - " -host localhost" ++ workaround_openssl_s_clinent(), + " -host localhost" ++ workaround_openssl_s_client(), ct:log("openssl cmd: ~p~n", [Cmd]), @@ -924,6 +967,128 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> process_flag(trap_exit, false). %%-------------------------------------------------------------------- + +erlang_client_alpn_openssl_server_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_server_alpn_openssl_client_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_client_alpn_openssl_server(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_with_opts(Config, + [{alpn_advertised_protocols, [<<"spdy/2">>]}], + "", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_client_openssl_server_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_with_opts(Config, + [], + "-alpn spdy/2", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_server_alpn_openssl_client(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_with_opts(Config, + [{alpn_advertised_protocols, [<<"spdy/2">>]}], + "", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_server_openssl_client_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_with_opts(Config, + [], + "-alpn spdy/2", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_client_alpn_openssl_server_alpn_renegotiate(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + ct:sleep(?SLEEP), + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_server_alpn_openssl_client_alpn_renegotiate(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + ct:sleep(?SLEEP), + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_client_alpn_npn_openssl_server_alpn_npn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_server_alpn_npn_openssl_client_alpn_npn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- erlang_client_openssl_server_npn() -> [{doc,"Test erlang client with openssl server doing npn negotiation"}]. @@ -1139,6 +1304,142 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens ssl_test_lib:close(Client), process_flag(trap_exit, false). +start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0], + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + + Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile, + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + ssl_test_lib:wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ClientOpts}]), + + Callback(Client, OpensslPort), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close_port(OpensslPort), + + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]} | ServerOpts0], + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + Cmd = "openssl s_client -alpn http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -host localhost", + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Callback(Server, OpenSslPort), + + ssl_test_lib:close(Server), + + ssl_test_lib:close_port(OpenSslPort), + process_flag(trap_exit, false). + +start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]}, + {client_preferred_next_protocols, {client, [<<"spdy/3">>, <<"http/1.1">>]}} | ClientOpts0], + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + + Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile, + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + ssl_test_lib:wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ClientOpts}]), + + Callback(Client, OpensslPort), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close_port(OpensslPort), + + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]}, + {next_protocols_advertised, [<<"spdy/3">>, <<"http/1.1">>]} | ServerOpts0], + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + Cmd = "openssl s_client -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -host localhost", + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Callback(Server, OpenSslPort), + + ssl_test_lib:close(Server), + + ssl_test_lib:close_port(OpenSslPort), + process_flag(trap_exit, false). + start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), @@ -1167,7 +1468,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac {host, Hostname}, {from, self()}, {mfa, {?MODULE, - erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, + erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, {options, ClientOpts}]), Callback(Client, OpensslPort), @@ -1188,7 +1489,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), @@ -1236,10 +1537,10 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS process_flag(trap_exit, false). -erlang_ssl_receive_and_assert_npn(Socket, Protocol, Data) -> - {ok, Protocol} = ssl:negotiated_next_protocol(Socket), +erlang_ssl_receive_and_assert_negotiated_protocol(Socket, Protocol, Data) -> + {ok, Protocol} = ssl:negotiated_protocol(Socket), erlang_ssl_receive(Socket, Data), - {ok, Protocol} = ssl:negotiated_next_protocol(Socket), + {ok, Protocol} = ssl:negotiated_protocol(Socket), ok. erlang_ssl_receive(Socket, Data) -> @@ -1297,6 +1598,15 @@ check_openssl_npn_support(Config) -> Config end. +check_openssl_alpn_support(Config) -> + HelpText = os:cmd("openssl s_client --help"), + case string:str(HelpText, "alpn") of + 0 -> + {skip, "Openssl not compiled with alpn support"}; + _ -> + Config + end. + check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1'; Version == 'tlsv1.2' -> case os:cmd("openssl version") of @@ -1348,7 +1658,7 @@ supports_sslv2(Port) -> true end. -workaround_openssl_s_clinent() -> +workaround_openssl_s_client() -> %% http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=683159 %% https://bugs.archlinux.org/task/33919 %% Bug seems to manifests it self if TLS version is not @@ -1362,6 +1672,8 @@ workaround_openssl_s_clinent() -> " -no_tls1_2 "; "OpenSSL 1.0.1f" ++ _ -> " -no_tls1_2 "; - _ -> + "OpenSSL 1.0.1l" ++ _ -> + " -cipher AES256-SHA"; + _ -> "" end. diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml index e32a639b81..d8193a9ec2 100644 --- a/lib/stdlib/doc/src/calendar.xml +++ b/lib/stdlib/doc/src/calendar.xml @@ -270,7 +270,8 @@ <fsummary>Convert now to local date and time</fsummary> <desc> <p>This function returns local date and time converted from - the return value from <c>erlang:now()</c>.</p> + the return value from + <seealso marker="erts:erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>.</p> </desc> </func> <func> @@ -279,7 +280,8 @@ <fsummary>Convert now to date and time</fsummary> <desc> <p>This function returns Universal Coordinated Time (UTC) - converted from the return value from <c>erlang:now()</c>.</p> + converted from the return value from + <seealso marker="erts:erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 902a921fbf..6b9524ef63 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -1618,14 +1618,18 @@ true</pre> </func> <func> <name name="update_counter" arity="3" clause_i="1"/> + <name name="update_counter" arity="4" clause_i="1"/> <name name="update_counter" arity="3" clause_i="2"/> + <name name="update_counter" arity="4" clause_i="2"/> <name name="update_counter" arity="3" clause_i="3"/> + <name name="update_counter" arity="4" clause_i="3"/> <type variable="Tab"/> <type variable="Key"/> <type variable="UpdateOp" name_i="1"/> <type variable="Pos" name_i="1"/> <type variable="Threshold" name_i="1"/> <type variable="SetValue" name_i="1"/> + <type variable="Default"/> <fsummary>Update a counter object in an ETS table.</fsummary> <desc> <p>This function provides an efficient way to update one or more @@ -1667,12 +1671,22 @@ true</pre> <seealso marker="#lookup/2">lookup/2</seealso> and <seealso marker="#new/2">new/2</seealso> for details on the difference).</p> + <p>If a default object <c><anno>Default</anno></c> is given, it is used + as the object to be updated if the key is missing from the table. The + value in place of the key is ignored and replaced by the proper key + value. The return value is as if the default object had not been used, + that is a single updated element or a list of them.</p> <p>The function will fail with reason <c>badarg</c> if:</p> <list type="bulleted"> <item>the table is not of type <c>set</c> or <c>ordered_set</c>,</item> - <item>no object with the right key exists,</item> + <item>no object with the right key exists and no default object were + supplied,</item> <item>the object has the wrong arity,</item> + <item>the default object arity is smaller than + <c><![CDATA[<keypos>]]></c></item> + <item>any field from the default object being updated is not an + integer</item> <item>the element to update is not an integer,</item> <item>the element to update is also the key, or,</item> <item>any of <c><anno>Pos</anno></c>, <c><anno>Incr</anno></c>, <c><anno>Threshold</anno></c> or diff --git a/lib/stdlib/doc/src/file_sorter.xml b/lib/stdlib/doc/src/file_sorter.xml index 16572df3c5..c069333c29 100644 --- a/lib/stdlib/doc/src/file_sorter.xml +++ b/lib/stdlib/doc/src/file_sorter.xml @@ -105,9 +105,9 @@ <c>file:get_cwd()</c> is used instead. The names of temporary files are derived from the Erlang nodename (<c>node()</c>), the process identifier of the current Erlang - emulator (<c>os:getpid()</c>), and a timestamp - (<c>erlang:now()</c>); a typical name would be - <c>fs_mynode@myhost_1763_1043_337000_266005.17</c>, where + emulator (<c>os:getpid()</c>), and a unique integer + (<c>erlang:unique_integer([positive])</c>); a typical name would be + <c>fs_mynode@myhost_1763_4711.17</c>, where <c>17</c> is a sequence number. Existing files will be overwritten. Temporary files are deleted unless some uncaught EXIT signal occurs. diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index f27a974242..9a0ff85038 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -173,7 +173,7 @@ <name name="init_ack" arity="2"/> <fsummary>Used by a process when it has started.</fsummary> <desc> - <p>This function must used by a process that has been started by + <p>This function must be used by a process that has been started by a <seealso marker="#start/3">start[_link]/3,4,5</seealso> function. It tells <c><anno>Parent</anno></c> that the process has initialized itself, has started, or has failed to initialize diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml index e001058e19..2cc621ffc3 100644 --- a/lib/stdlib/doc/src/random.xml +++ b/lib/stdlib/doc/src/random.xml @@ -70,12 +70,11 @@ <desc> <p>Seeds random number generation with integer values in the process dictionary, and returns the old state.</p> - <p>One way of obtaining a seed is to use the BIF <c>now/0</c>:</p> + <p>One easy way of obtaining a unique value to seed with is to:</p> <code type="none"> - ... - {A1,A2,A3} = now(), - random:seed(A1, A2, A3), - ...</code> + random:seed(<seealso marker="erts:erlang#phash2/1">erlang:phash2</seealso>([<seealso marker="erts:erlang#node/0">node()</seealso>]), + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time()</seealso>, + <seealso marker="erts:erlang#unique_integer/0">erlang:unique_integer()</seealso>)</code> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/timer.xml b/lib/stdlib/doc/src/timer.xml index eca9a72d36..791a29689e 100644 --- a/lib/stdlib/doc/src/timer.xml +++ b/lib/stdlib/doc/src/timer.xml @@ -217,12 +217,14 @@ </func> <func> <name name="now_diff" arity="2"/> - <fsummary>Calculate time difference between <c>now/0</c>timestamps</fsummary> + <fsummary>Calculate time difference between timestamps</fsummary> <type_desc variable="Tdiff">In microseconds</type_desc> <desc> <p>Calculates the time difference <c><anno>Tdiff</anno> = <anno>T2</anno> - <anno>T1</anno></c> in - <em>microseconds</em>, where <c><anno>T1</anno></c> and <c><anno>T2</anno></c> probably - are timestamp tuples returned from <c>erlang:now/0</c>.</p> + <em>microseconds</em>, where <c><anno>T1</anno></c> and <c><anno>T2</anno></c> + are timestamp tuples on the same format as returned from + <seealso marker="erts:erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>, + or <seealso marker="kernel:os#timestamp/0"><c>os:timestamp/0</c></seealso>.</p> </desc> </func> <func> @@ -234,7 +236,7 @@ </func> <func> <name name="minutes" arity="1"/> - <fsummary>Converts <c>Minutes</c>to <c>Milliseconds</c>.</fsummary> + <fsummary>Converts <c>Minutes</c> to <c>Milliseconds</c>.</fsummary> <desc> <p>Return the number of milliseconds in <c><anno>Minutes</anno></c>.</p> </desc> diff --git a/lib/stdlib/doc/src/zip.xml b/lib/stdlib/doc/src/zip.xml index 48b376743d..d201e81a79 100644 --- a/lib/stdlib/doc/src/zip.xml +++ b/lib/stdlib/doc/src/zip.xml @@ -135,6 +135,12 @@ <p>These options are described in <seealso marker="#zip_options">create/3</seealso>.</p> </desc> </datatype> + <datatype> + <name name="handle"/> + <desc> + <p>As returned by <seealso marker="#zip_open/2">zip_open/2</seealso>.</p> + </desc> + </datatype> </datatypes> <funcs> <func> @@ -430,6 +436,8 @@ means that subsequently reading files from the archive will be faster than unzipping files one at a time with <c>unzip</c>.</p> <p>The archive must be closed with <c>zip_close/1</c>.</p> + <p>The <c><anno>ZipHandle</anno></c> will be closed if the + process which originally opened the archive dies.</p> </desc> </func> <func> diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index 0320e0cd0e..d08001c933 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -299,7 +299,7 @@ local_time_to_universal_time_dst(DateTime) -> %% now_to_universal_time(Now) %% now_to_datetime(Now) %% -%% Convert from now() to UTC. +%% Convert from erlang:timestamp() to UTC. %% %% Args: Now = now(); now() = {MegaSec, Sec, MilliSec}, MegaSec = Sec %% = MilliSec = integer() diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index a4bd45ea19..5d365ac962 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1963,7 +1963,7 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {erlang:now(), [{Pid, 1}]}, + Fixed = {utime_now(), [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -3088,14 +3088,14 @@ update_cache(Head, ToAdd) -> {Head1, Found, []}; Cache#cache.wrtime =:= undefined -> %% Empty cache. Schedule a delayed write. - Now = now(), Me = self(), + Now = time_now(), Me = self(), Call = ?DETS_CALL(Me, {delayed_write, Now}), erlang:send_after(Cache#cache.delay, Me, Call), {Head1#head{cache = NewCache#cache{wrtime = Now}}, Found, []}; Size0 =:= 0 -> %% Empty cache that has been written after the %% currently scheduled delayed write. - {Head1#head{cache = NewCache#cache{wrtime = now()}}, Found, []}; + {Head1#head{cache = NewCache#cache{wrtime = time_now()}}, Found, []}; true -> %% Cache is not empty, delayed write has been scheduled. {Head1, Found, []} @@ -3158,11 +3158,7 @@ delayed_write(Head, WrTime) -> Head#head{cache = NewCache}; true -> %% Yes, schedule a new delayed write. - {MS1,S1,M1} = WrTime, - {MS2,S2,M2} = LastWrTime, - WrT = M1+1000000*(S1+1000000*MS1), - LastWrT = M2+1000000*(S2+1000000*MS2), - When = round((LastWrT - WrT)/1000), Me = self(), + When = round((LastWrTime - WrTime)/1000), Me = self(), Call = ?DETS_CALL(Me, {delayed_write, LastWrTime}), erlang:send_after(When, Me, Call), Head @@ -3274,6 +3270,16 @@ err(Error) -> Error end. +-compile({inline, [time_now/0]}). +time_now() -> + erlang:monotonic_time(1000000). + +-compile({inline, [utime_now/0]}). +utime_now() -> + Time = time_now(), + UniqueCounter = erlang:unique_integer([monotonic]), + {Time, UniqueCounter}. + %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% file_info(FileName) -> diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 6c176ad513..26e22dbd5b 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -447,7 +447,7 @@ reset_cache(C) -> WrTime =:= undefined -> WrTime; true -> - now() + erlang:monotonic_time(1000000) end, PK = family(C#cache.cache), NewC = C#cache{cache = [], csize = 0, inserts = 0, wrtime = NewWrTime}, diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index caa3276d09..72bd54fa29 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -300,7 +300,7 @@ format_error(Term) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add1(TarFile, Bin, NameInArchive, Opts) when is_binary(Bin) -> - Now = calendar:now_to_local_time(now()), + Now = calendar:now_to_local_time(erlang:timestamp()), Info = #file_info{size = byte_size(Bin), type = regular, access = read_write, diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 6bd0eb8a22..90e1f3a8d6 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -663,7 +663,8 @@ check_source(S, CheckOnly) -> end. pre_def_macros(File) -> - {MegaSecs, Secs, MicroSecs} = erlang:now(), + {MegaSecs, Secs, MicroSecs} = erlang:timestamp(), + Unique = erlang:unique_integer([positive]), Replace = fun(Char) -> case Char of $\. -> $\_; @@ -675,8 +676,9 @@ pre_def_macros(File) -> CleanBase ++ "__" ++ "escript__" ++ integer_to_list(MegaSecs) ++ "__" ++ - integer_to_list(Secs) ++ "__" ++ - integer_to_list(MicroSecs), + integer_to_list(Secs) ++ "__" ++ + integer_to_list(MicroSecs) ++ "__" ++ + integer_to_list(Unique), Module = list_to_atom(ModuleStr), PreDefMacros = [{'MODULE', Module, redefine}, {'MODULE_STRING', ModuleStr, redefine}], diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 09c8924650..1df069755d 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -72,7 +72,7 @@ select_count/2, select_delete/2, select_reverse/1, select_reverse/2, select_reverse/3, setopts/2, slot/2, take/2, - update_counter/3, update_element/3]). + update_counter/3, update_counter/4, update_element/3]). -spec all() -> [Tab] when Tab :: tab(). @@ -439,6 +439,38 @@ take(_, _) -> update_counter(_, _, _) -> erlang:nif_error(undef). +-spec update_counter(Tab, Key, UpdateOp, Default) -> Result when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} + | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(), + Default :: tuple(); + (Tab, Key, [UpdateOp], Default) -> [Result] when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} + | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(), + Default :: tuple(); + (Tab, Key, Incr, Default) -> Result when + Tab :: tab(), + Key :: term(), + Incr :: integer(), + Result :: integer(), + Default :: tuple(). + +update_counter(_, _, _, _) -> + erlang:nif_error(undef). + -spec update_element(Tab, Key, ElementSpec :: {Pos, Value}) -> boolean() when Tab :: tab(), Key :: term(), diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 687d72b4bd..61b489513a 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1425,8 +1425,8 @@ tmp_prefix1(Dir, TmpDirOpt) -> U = "_", Node = node(), Pid = os:getpid(), - {MSecs,Secs,MySecs} = now(), - F = lists:concat(["fs_",Node,U,Pid,U,MSecs,U,Secs,U,MySecs,"."]), + Unique = erlang:unique_integer([positive]), + F = lists:concat(["fs_",Node,U,Pid,U,Unique,"."]), TmpDir = case TmpDirOpt of default -> Dir; diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index e90cda0533..3378d668a5 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -287,6 +287,8 @@ write([H|T], D) -> end; write(F, _D) when is_function(F) -> erlang:fun_to_list(F); +write(Term, D) when is_map(Term) -> + write_map(Term, D); write(T, D) when is_tuple(T) -> if D =:= 1 -> "{...}"; @@ -295,9 +297,7 @@ write(T, D) when is_tuple(T) -> [write(element(1, T), D-1)| write_tail(tl(tuple_to_list(T)), D-1, $,)], $}] - end; -%write(Term, D) when is_map(Term) -> write_map(Term, D); -write(Term, D) -> write_map(Term, D). + end. %% write_tail(List, Depth, CharacterBeforeDots) %% Test the terminating case first as this looks better with depth. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 4a338798d0..540c1cac9c 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -59,6 +59,11 @@ obsolete_1(erl_eval, arg_list, 3) -> obsolete_1(erlang, hash, 2) -> {deprecated, {erlang, phash2, 2}}; +obsolete_1(erlang, now, 0) -> + {deprecated, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}; + obsolete_1(calendar, local_time_to_universal_time, 1) -> {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; @@ -590,6 +595,8 @@ obsolete_1(core_lib, is_literal_list, 1) -> " instead"}; obsolete_1(core_lib, literal_value, 1) -> {deprecated,{core_lib,concrete,1}}; +obsolete_1(ssl, negotiated_next_protocol, 1) -> + {deprecated,{ssl,negotiated_protocol}}; obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 002032d48d..5b19ee6190 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -2764,8 +2764,8 @@ tmp_filename(TmpDirOpt) -> U = "_", Node = node(), Pid = os:getpid(), - {MSecs,Secs,MySecs} = erlang:now(), - F = lists:concat([?MODULE,U,Node,U,Pid,U,MSecs,U,Secs,U,MySecs]), + Unique = erlang:unique_integer(), + F = lists:concat([?MODULE,U,Node,U,Pid,U,Unique]), TmpDir = case TmpDirOpt of "" -> {ok, CurDir} = file:get_cwd(), diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index d7b51a151c..cf84f8cecf 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -57,11 +57,17 @@ seed() -> %% seed({A1, A2, A3}) %% Seed random number generation --spec seed({A1, A2, A3}) -> 'undefined' | ran() when +-spec seed(SValue) -> 'undefined' | ran() when + SValue :: {A1, A2, A3} | integer(), A1 :: integer(), A2 :: integer(), A3 :: integer(). +seed(Int) when is_integer(Int) -> + A1 = (Int bsr 16) band 16#fffffff, + A2 = Int band 16#ffffff, + A3 = (Int bsr 36) bor (A2 bsr 16), + seed(A1, A2, A3); seed({A1, A2, A3}) -> seed(A1, A2, A3). diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index f134c75869..a435d683a5 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -102,7 +102,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-7.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 658c00dc77..7c0cd8b26a 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1383,7 +1383,7 @@ add_restart(State) -> I = State#state.intensity, P = State#state.period, R = State#state.restarts, - Now = erlang:now(), + Now = erlang:monotonic_time(1), R1 = add_restart([Now|R], Now, P), State1 = State#state{restarts = R1}, case length(R1) of @@ -1404,26 +1404,13 @@ add_restart([], _, _) -> []. inPeriod(Time, Now, Period) -> - case difference(Time, Now) of + case Time - Now of T when T > Period -> false; _ -> true end. -%% -%% Time = {MegaSecs, Secs, MicroSecs} (NOTE: MicroSecs is ignored) -%% Calculate the time elapsed in seconds between two timestamps. -%% If MegaSecs is equal just subtract Secs. -%% Else calculate the Mega difference and add the Secs difference, -%% note that Secs difference can be negative, e.g. -%% {827, 999999, 676} diff {828, 1, 653753} == > 2 secs. -%% -difference({TimeM, TimeS, _}, {CurM, CurS, _}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000) + (CurS - TimeS); -difference({_, TimeS, _}, {_, CurS, _}) -> - CurS - TimeS. - %%% ------------------------------------------------------ %%% Error and progress reporting. %%% ------------------------------------------------------ diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index 72a2dd9616..19d803345e 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -437,10 +437,8 @@ positive(X) -> %% %% system_time() -> time in microseconds %% -system_time() -> - {M,S,U} = erlang:now(), - 1000000 * (M*1000000 + S) + U. - +system_time() -> + erlang:monotonic_time(1000000). send([Pid, Msg]) -> Pid ! Msg. diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index b768c6d0b9..44e75ff15b 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -214,7 +214,9 @@ -type zip_comment() :: #zip_comment{}. -type zip_file() :: #zip_file{}. --export_type([create_option/0, filename/0]). +-opaque handle() :: pid(). + +-export_type([create_option/0, filename/0, handle/0]). %% Open a zip archive with options %% @@ -500,7 +502,7 @@ do_list_dir(F, Options) -> -spec(t(Archive) -> ok when Archive :: file:name() | binary() | ZipHandle, - ZipHandle :: pid()). + ZipHandle :: handle()). t(F) when is_pid(F) -> zip_t(F); t(F) when is_record(F, openzip) -> openzip_t(F); @@ -524,7 +526,7 @@ do_t(F, RawPrint) -> -spec(tt(Archive) -> ok when Archive :: file:name() | binary() | ZipHandle, - ZipHandle :: pid()). + ZipHandle :: handle()). tt(F) when is_pid(F) -> zip_tt(F); tt(F) when is_record(F, openzip) -> openzip_tt(F); @@ -1114,15 +1116,19 @@ local_file_header_from_info_method_name(#file_info{mtime = MTime}, file_name_length = length(Name), extra_field_length = 0}. +server_init(Parent) -> + %% we want to know if our parent dies + process_flag(trap_exit, true), + server_loop(Parent, not_open). %% small, simple, stupid zip-archive server -server_loop(OpenZip) -> +server_loop(Parent, OpenZip) -> receive {From, {open, Archive, Options}} -> case openzip_open(Archive, Options) of {ok, NewOpenZip} -> From ! {self(), {ok, self()}}, - server_loop(NewOpenZip); + server_loop(Parent, NewOpenZip); Error -> From ! {self(), Error} end; @@ -1130,43 +1136,47 @@ server_loop(OpenZip) -> From ! {self(), openzip_close(OpenZip)}; {From, get} -> From ! {self(), openzip_get(OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, {get, FileName}} -> From ! {self(), openzip_get(FileName, OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, list_dir} -> From ! {self(), openzip_list_dir(OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, {list_dir, Opts}} -> From ! {self(), openzip_list_dir(OpenZip, Opts)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, get_state} -> From ! {self(), OpenZip}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); + {'EXIT', Parent, Reason} -> + openzip_close(OpenZip), + exit({parent_died, Reason}); _ -> {error, bad_msg} end. -spec(zip_open(Archive) -> {ok, ZipHandle} | {error, Reason} when Archive :: file:name() | binary(), - ZipHandle :: pid(), + ZipHandle :: handle(), Reason :: term()). zip_open(Archive) -> zip_open(Archive, []). -spec(zip_open(Archive, Options) -> {ok, ZipHandle} | {error, Reason} when Archive :: file:name() | binary(), - ZipHandle :: pid(), + ZipHandle :: handle(), Options :: [Option], Option :: cooked | memory | {cwd, CWD :: file:filename()}, Reason :: term()). zip_open(Archive, Options) -> - Pid = spawn(fun() -> server_loop(not_open) end), - request(self(), Pid, {open, Archive, Options}). + Self = self(), + Pid = spawn_link(fun() -> server_init(Self) end), + request(Self, Pid, {open, Archive, Options}). -spec(zip_get(ZipHandle) -> {ok, [Result]} | {error, Reason} when - ZipHandle :: pid(), + ZipHandle :: handle(), Result :: file:name() | {file:name(), binary()}, Reason :: term()). @@ -1174,14 +1184,14 @@ zip_get(Pid) when is_pid(Pid) -> request(self(), Pid, get). -spec(zip_close(ZipHandle) -> ok | {error, einval} when - ZipHandle :: pid()). + ZipHandle :: handle()). zip_close(Pid) when is_pid(Pid) -> request(self(), Pid, close). -spec(zip_get(FileName, ZipHandle) -> {ok, Result} | {error, Reason} when FileName :: file:name(), - ZipHandle :: pid(), + ZipHandle :: handle(), Result :: file:name() | {file:name(), binary()}, Reason :: term()). @@ -1190,7 +1200,7 @@ zip_get(FileName, Pid) when is_pid(Pid) -> -spec(zip_list_dir(ZipHandle) -> {ok, Result} | {error, Reason} when Result :: [zip_comment() | zip_file()], - ZipHandle :: pid(), + ZipHandle :: handle(), Reason :: term()). zip_list_dir(Pid) when is_pid(Pid) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 2674f6886f..9f552b5a6b 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -47,6 +47,7 @@ -export([ordered/1, ordered_match/1, interface_equality/1, fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, update_element/1, update_counter/1, evil_update_counter/1, partly_bound/1, match_heavy/1]). +-export([update_counter_with_default/1]). -export([member/1]). -export([memory/1]). -export([select_fail/1]). @@ -99,7 +100,7 @@ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, - types_do/1, sleeper/0, memory_do/1, + types_do/1, sleeper/0, memory_do/1, update_counter_with_default_do/1, ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4 ]). @@ -136,7 +137,8 @@ all() -> {group, heavy}, ordered, ordered_match, interface_equality, fixtable_next, fixtable_insert, rename, rename_unnamed, evil_rename, update_element, - update_counter, evil_update_counter, partly_bound, + update_counter, evil_update_counter, + update_counter_with_default, partly_bound, match_heavy, {group, fold}, member, t_delete_object, t_init_table, t_whitebox, t_delete_all_objects, t_insert_list, t_test_ms, t_select_delete, t_ets_dets, @@ -1761,6 +1763,14 @@ update_counter_do(Opts) -> OrdSet = ets_new(ordered_set,[ordered_set | Opts]), update_counter_for(Set), update_counter_for(OrdSet), + ets:delete_all_objects(Set), + ets:delete_all_objects(OrdSet), + ets:safe_fixtable(Set, true), + ets:safe_fixtable(OrdSet, true), + update_counter_for(Set), + update_counter_for(OrdSet), + ets:safe_fixtable(Set, false), + ets:safe_fixtable(OrdSet, false), ets:delete(Set), ets:delete(OrdSet), update_counter_neg(Opts). @@ -1780,10 +1790,14 @@ update_counter_for(T) -> ?line {NewObj, Ret} = uc_mimic(Obj,Arg3), ArgHash = erlang:phash2({T,a,Arg3}), %%io:format("update_counter(~p, ~p, ~p) expecting ~p\n",[T,a,Arg3,Ret]), + [DefaultObj] = ets:lookup(T, a), ?line Ret = ets:update_counter(T,a,Arg3), + Ret = ets:update_counter(T, b, Arg3, DefaultObj), % Use other key ?line ArgHash = erlang:phash2({T,a,Arg3}), %%io:format("NewObj=~p~n ",[NewObj]), ?line [NewObj] = ets:lookup(T,a), + true = ets:lookup(T, b) =:= [setelement(1, NewObj, b)], + ets:delete(T, b), Myself(NewObj,Times-1,Arg3,Myself) end, @@ -2008,6 +2022,44 @@ evil_counter_1(Iter, T) -> ets:update_counter(T, dracula, 1), evil_counter_1(Iter-1, T). +update_counter_with_default(Config) when is_list(Config) -> + repeat_for_opts(update_counter_with_default_do). + +update_counter_with_default_do(Opts) -> + T1 = ets_new(a, [set | Opts]), + %% Insert default object. + 3 = ets:update_counter(T1, foo, 2, {beaufort,1}), + %% Increment. + 5 = ets:update_counter(T1, foo, 2, {cabecou,1}), + %% Increment with list. + [9] = ets:update_counter(T1, foo, [{2,4}], {camembert,1}), + %% Same with non-immediate key. + 3 = ets:update_counter(T1, {foo,bar}, 2, {{chaource,chevrotin},1}), + 5 = ets:update_counter(T1, {foo,bar}, 2, {{cantal,comté},1}), + [9] = ets:update_counter(T1, {foo,bar}, [{2,4}], {{emmental,de,savoie},1}), + %% Same with ordered set. + T2 = ets_new(b, [ordered_set | Opts]), + 3 = ets:update_counter(T2, foo, 2, {maroilles,1}), + 5 = ets:update_counter(T2, foo, 2, {mimolette,1}), + [9] = ets:update_counter(T2, foo, [{2,4}], {morbier,1}), + 3 = ets:update_counter(T2, {foo,bar}, 2, {{laguiole},1}), + 5 = ets:update_counter(T2, {foo,bar}, 2, {{saint,nectaire},1}), + [9] = ets:update_counter(T2, {foo,bar}, [{2,4}], {{rocamadour},1}), + %% Arithmetically-equal keys. + 3 = ets:update_counter(T2, 1.0, 2, {1,1}), + 5 = ets:update_counter(T2, 1, 2, {1,1}), + 7 = ets:update_counter(T2, 1, 2, {1.0,1}), + %% Same with reversed type difference. + 3 = ets:update_counter(T2, 2, 2, {2.0,1}), + 5 = ets:update_counter(T2, 2.0, 2, {2.0,1}), + 7 = ets:update_counter(T2, 2.0, 2, {2,1}), + %% bar is not an integer. + {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, 3, {saint,félicien})), + %% No third element in default value. + {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, [{3,1}], {roquefort,1})), + + ok. + fixtable_next(doc) -> ["Check that a first-next sequence always works on a fixed table"]; fixtable_next(suite) -> @@ -3779,6 +3831,7 @@ match_object_do(Opts) -> ?line ets:insert(Tab,{{one,5},5}), ?line ets:insert(Tab,{{two,4},4}), ?line ets:insert(Tab,{{two,5},6}), + ?line ets:insert(Tab, {#{camembert=>cabécou},7}), ?line case ets:match_object(Tab, {{one, '_'}, '$0'}) of [{{one,5},5},{{one,4},4}] -> ok; [{{one,4},4},{{one,5},5}] -> ok; @@ -3799,6 +3852,10 @@ match_object_do(Opts) -> [{{two,4},4},{{two,5},6}] -> ok; _ -> ?t:fail("ets:match_object() returned something funny.") end, + % Check that maps are inspected for variables. + [{#{camembert:=cabécou},7}] = + ets:match_object(Tab, {#{camembert=>'_'},7}), + {'EXIT',{badarg,_}} = (catch ets:match_object(Tab, {#{'$1'=>'_'},7})), % Check that unsucessful match returns an empty list. ?line [] = ets:match_object(Tab, {{three,'$0'}, '$92'}), % Check that '$0' equals '_'. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 4173a40d14..0b7b96da8e 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -3418,7 +3418,8 @@ lookup2(Config) when is_list(Config) -> end, [{1},{2}])">> ], - ?line run(Config, Ts), + + ok = run(Config, Ts), TsR = [ %% is_record/2,3: @@ -3456,7 +3457,8 @@ lookup2(Config) when is_list(Config) -> end, [{keypos,1}], [#r{}])">> ], - ?line run(Config, <<"-record(r, {a}).\n">>, TsR), + + ok = run(Config, <<"-record(r, {a}).\n">>, TsR), Ts2 = [ <<"etsc(fun(E) -> @@ -3566,7 +3568,6 @@ lookup2(Config) when is_list(Config) -> [{1,2},{2,2}] = qlc:e(Q), [2] = lookup_keys(Q) end, [{keypos,1}], [{1},{2},{3}])">>, - <<"%% Matchspec only. No cache. etsc(fun(E) -> Q = qlc:q([{X,Y} || @@ -3578,7 +3579,7 @@ lookup2(Config) when is_list(Config) -> {generate,_, {table,{ets,_,[_,[{traverse,_}]]}}}],[]} = i(Q), - [{1,2},{1,3},{2,2},{2,3}] = qlc:e(Q), + [{1,2},{1,3},{2,2},{2,3}] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{keypos,1}], [{1},{2},{3}])">>, <<"%% Matchspec only. Cache @@ -3592,7 +3593,7 @@ lookup2(Config) when is_list(Config) -> {generate,_,{qlc,_, [{generate,_,{table,{ets,_,[_,[{traverse,_}]]}}}], [{cache,ets}]}}],[]} = i(Q), - [{1,2},{1,3},{2,2},{2,3}] = qlc:e(Q), + [{1,2},{1,3},{2,2},{2,3}] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{keypos,1}], [{1},{2},{3}])">>, <<"%% An empty list. Always unique and cached. @@ -3645,7 +3646,7 @@ lookup2(Config) when is_list(Config) -> ], - ?line run(Config, Ts2), + ok = run(Config, Ts2), LTs = [ <<"etsc(fun(E) -> @@ -3677,7 +3678,8 @@ lookup2(Config) when is_list(Config) -> end, [{1,a},{2,b}])">> ], - ?line run(Config, LTs), + + ok = run(Config, LTs), ok. diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index a57641ef62..d168a9d9bc 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -23,7 +23,7 @@ bad_zip/1, unzip_from_binary/1, unzip_to_binary/1, zip_to_binary/1, unzip_options/1, zip_options/1, list_dir_options/1, aliases/1, - openzip_api/1, zip_api/1, unzip_jar/1, + openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1, compress_control/1, foldl/1]). @@ -38,7 +38,7 @@ all() -> [borderline, atomic, bad_zip, unzip_from_binary, unzip_to_binary, zip_to_binary, unzip_options, zip_options, list_dir_options, aliases, openzip_api, - zip_api, unzip_jar, compress_control, foldl]. + zip_api, open_leak, unzip_jar, compress_control, foldl]. groups() -> []. @@ -318,8 +318,46 @@ zip_api(Config) when is_list(Config) -> %% Clean up. delete_files([Names]), + ok. + +open_leak(doc) -> + ["Test that zip doesn't leak processes and ports where the " + "controlling process dies without closing an zip opened with " + "zip:zip_open/1."]; +open_leak(suite) -> []; +open_leak(Config) when is_list(Config) -> + %% Create a zip archive + Zip = "zip.zip", + {ok, Zip} = zip:zip(Zip, [], []), + + %% Open archive in a another process that dies immediately. + ZipSrv = spawn_zip(Zip, [memory]), + + %% Expect the ZipSrv process to die soon after. + true = spawned_zip_dead(ZipSrv), + + %% Clean up. + delete_files([Zip]), + ok. +spawn_zip(Zip, Options) -> + Self = self(), + spawn(fun() -> Self ! zip:zip_open(Zip, Options) end), + receive + {ok, ZipSrv} -> + ZipSrv + end. + +spawned_zip_dead(ZipSrv) -> + Ref = monitor(process, ZipSrv), + receive + {'DOWN', Ref, _, ZipSrv, _} -> + true + after 1000 -> + false + end. + unzip_options(doc) -> ["Test options for unzip, only cwd and file_list currently"]; unzip_options(suite) -> diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index 173f7075db..5538e8b851 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -34,5 +34,5 @@ {env, []}, {runtime_dependencies, ["tools-2.6.14","stdlib-2.0","runtime_tools-1.8.14", "observer-2.0","kernel-3.0","inets-5.10", - "syntax_tools-1.6.16","erts-6.0"]}]}. + "syntax_tools-1.6.16","erts-7.0"]}]}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 0e685a2d8a..acd2e0bff2 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -404,15 +404,6 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name, }). run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> - {ok,Cwd} = file:get_cwd(), - Args2Print = case Args of - [Args1] when is_list(Args1) -> - lists:keydelete(tc_group_result, 1, Args1); - _ -> - Args - end, - print(minor, "Test case started with:\n~w:~w(~tp)\n", [Mod,Func,Args2Print]), - print(minor, "Current directory is ~tp\n", [Cwd]), print_timestamp(minor,"Started at "), print(minor, "", [], internal_raw), TCCallback = get(test_server_testcase_callback), @@ -687,7 +678,7 @@ handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) Msg = {E,AbortReason}, {Msg,Loc0,Msg}; Other -> - {Other,unknown,Other} + {{'EXIT',Other},unknown,Other} end, Timeout = end_conf_timeout(Reason, St), Config = [{tc_status,{failed,F}}|Config0], @@ -701,7 +692,7 @@ handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, {testcase_aborted=E,AbortReason,Loc0} -> {{E,AbortReason},Loc0}; Other -> - {Other,St#st.last_known_loc} + {{'EXIT',Other},St#st.last_known_loc} end, Func = case Status of init_per_testcase=F -> {F,Func0}; @@ -738,18 +729,16 @@ do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) -> EndConfApply = fun() -> timetrap(TVal), - case catch apply(Mod, - end_per_testcase, - [Func,Conf]) of - {'EXIT',Why} -> + try apply(Mod,end_per_testcase,[Func,Conf]) of + _ -> ok + catch + _:Why -> timer:sleep(1), group_leader() ! {printout,12, "WARNING! " "~w:end_per_testcase(~w, ~p)" " crashed!\n\tReason: ~p\n", - [Mod,Func,Conf,Why]}; - _ -> - ok + [Mod,Func,Conf,Why]} end, Supervisor ! {self(),end_conf} end, @@ -778,13 +767,11 @@ spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid, Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped - case catch do_end_tc_call(Mod,Func, - {Pid,Skip,[CurrConf]}, - Why) of - {'EXIT',FwEndTCErr} -> - exit({fw_notify_done,end_tc,FwEndTCErr}); - _ -> - ok + try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) end, %% finished, report back SendTo ! {self(),fw_notify_done, @@ -812,12 +799,12 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, " failed!\n\tReason: timetrap timeout" " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, FailLoc = proplists:get_value(tc_fail_loc, EndConf), - case catch do_end_tc_call(Mod,Func, + try do_end_tc_call(Mod,Func, {Pid,Report,[EndConf]}, Why) of - {'EXIT',FwEndTCErr} -> - exit({fw_notify_done,end_tc,FwEndTCErr}); - _ -> - ok + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) end, Warn = "<font color=\"red\">" "WARNING: end_per_testcase timed out!</font>", @@ -853,21 +840,21 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> end, FwCall = fun() -> - case catch fw_error_notify(Mod,Func1,[], - Error,Loc) of - {'EXIT',FwErrorNotifyErr} -> + try fw_error_notify(Mod,Func1,[], + Error,Loc) of + _ -> ok + catch + _:FwErrorNotifyErr -> exit({fw_notify_done,error_notification, - FwErrorNotifyErr}); - _ -> - ok + FwErrorNotifyErr}) end, Conf = [{tc_status,{failed,Error}}|CurrConf], - case catch do_end_tc_call(Mod,Func1, - {Pid,Error,[Conf]},Error) of - {'EXIT',FwEndTCErr} -> - exit({fw_notify_done,end_tc,FwEndTCErr}); - _ -> - ok + try do_end_tc_call(Mod,Func1, + {Pid,Error,[Conf]},Error) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) end, %% finished, report back SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}} @@ -1358,8 +1345,8 @@ fw_error_notify(Mod, Func, Args, Error, Loc) -> %% Just like io:format, except that depending on the Detail value, the output %% is directed to console, major and/or minor log files. -print(Detail,Format,Args) -> - test_server_ctrl:print(Detail, Format, Args). +%% print(Detail,Format,Args) -> +%% test_server_ctrl:print(Detail, Format, Args). print(Detail,Format,Args,Printer) -> test_server_ctrl:print(Detail, Format, Args, Printer). @@ -1395,7 +1382,7 @@ lookup_config(Key,Config) -> %% timer:tc/3 ts_tc(M, F, A) -> - Before = erlang:now(), + Before = erlang:monotonic_time(), Result = try apply(M, F, A) catch @@ -1415,12 +1402,8 @@ ts_tc(M, F, A) -> {'EXIT',Reason} end end, - After = erlang:now(), - Elapsed = - (element(1,After)*1000000000000 - +element(2,After)*1000000+element(3,After)) - - (element(1,Before)*1000000000000 - +element(2,Before)*1000000+element(3,Before)), + After = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(After-Before, native, micro_seconds), {Elapsed, Result}. set_loc(Stk) -> @@ -1839,7 +1822,7 @@ time_ms_check(Other) -> time_ms_apply(Func, TCPid, MultAndScale) -> {_,GL} = process_info(TCPid, group_leader), WhoAmI = self(), % either TC or IO server - T0 = now(), + T0 = os:timestamp(), UserTTSup = spawn(fun() -> user_timetrap_supervisor(Func, WhoAmI, TCPid, @@ -1872,7 +1855,7 @@ user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> receive {UserTT,Result} -> demonitor(MonRef, [flush]), - Elapsed = trunc(timer:now_diff(now(), T0) / 1000), + Elapsed = trunc(timer:now_diff(os:timestamp(), T0) / 1000), try time_ms_check(Result) of TimeVal -> %% this is the new timetrap value to set (return value @@ -2395,9 +2378,8 @@ is_release_available(Release) -> %% run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> - {A,B,C} = now(), - Name = "shielded_node-" ++ integer_to_list(A) ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C), + Nr = erlang:unique_integer([positive]), + Name = "shielded_node-" ++ integer_to_list(Nr), Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of {ok, N} -> N; Err -> fail({failed_to_start_shielded_node, Err}) @@ -2456,9 +2438,8 @@ is_cover(Name) -> %% A filename of the form <Stem><Number> is generated, and the %% function checks that that file doesn't already exist. temp_name(Stem) -> - {A,B,C} = erlang:now(), - RandomNum = A bxor B bxor C, - RandomName = Stem ++ integer_to_list(RandomNum), + Num = erlang:unique_integer([positive]), + RandomName = Stem ++ integer_to_list(Num), {ok,Files} = file:list_dir(filename:dirname(Stem)), case lists:member(RandomName,Files) of true -> diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 488f38d05d..349b033c89 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -99,7 +99,7 @@ -define(last_link, "last_link"). -define(last_test, "last_test"). -define(html_ext, ".html"). --define(now, erlang:now()). +-define(now, os:timestamp()). -define(void_fun, fun() -> ok end). -define(mod_result(X), if X == skip -> skipped; @@ -1204,19 +1204,14 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, report_severe_error(Reason) -> test_server_sup:framework_call(report, [severe_error,Reason]). -%% timer:tc/3 -ts_tc(M, F, A) -> - Before = ?now, - Val = (catch apply(M, F, A)), - After = ?now, - Elapsed = elapsed_time(Before, After), - {Elapsed,Val}. - -elapsed_time(Before, After) -> - (element(1,After)*1000000000000 + - element(2,After)*1000000 + element(3,After)) - - (element(1,Before)*1000000000000 + - element(2,Before)*1000000 + element(3,Before)). +ts_tc(M,F,A) -> + Before = erlang:monotonic_time(), + Result = (catch apply(M, F, A)), + After = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(After-Before, + native, + micro_seconds), + {Elapsed, Result}. start_extra_tools(ExtraTools) -> start_extra_tools(ExtraTools, []). @@ -1808,20 +1803,32 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) -> put(test_server_minor_footer, Footer), io:put_chars(Fd, Header), + io:put_chars(Fd, "<a name=\"top\"></a>"), + io:put_chars(Fd, "<pre>\n"), + SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext, + + {Info,Arity} = + if Func == init_per_suite; Func == end_per_suite -> + {"Config function: ", 1}; + Func == init_per_group; Func == end_per_group -> + {"Config function: ", 2}; + true -> + {"Test case: ", 1} + end, + case {filelib:is_file(filename:join(LogDir, SrcListing)), lists:member(no_src, get(test_server_logopts))} of {true,false} -> - print(Lev, "<a href=\"~ts#~ts\">source code for ~w:~w/1</a>\n", + print(Lev, Info ++ "<a href=\"~ts#~ts\">~w:~w/~w</a> " + "(click for source code)\n", [uri_encode(SrcListing), uri_encode(atom_to_list(Func)++"-1",utf8), - Mod,Func]); + Mod,Func,Arity]); _ -> - ok + print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity]) end, - io:put_chars(Fd, "<pre>\n"), - AbsName. stop_minor_log_file() -> @@ -2478,7 +2485,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, file:set_cwd(filename:dirname(get(test_server_dir))), After = ?now, Before = get(test_server_parallel_start_time), - Elapsed = elapsed_time(Before, After)/1000000, + Elapsed = timer:now_diff(After, Before)/1000000, put(test_server_total_time, Elapsed), {false,tl(Mode0),undefined,Elapsed, update_status(Ref, OkSkipFail, Status)}; @@ -2487,7 +2494,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, %% parallel group (io buffering is active) OkSkipFail = wait_for_cases(Ref), queue_test_case_io(Ref, self(), 0, Mod, Func), - Elapsed = elapsed_time(conf_start(Ref, Mode0),?now)/1000000, + Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, case CurrIOHandler of {Ref,_} -> %% current_io_handler was set by start conf of this @@ -2504,12 +2511,12 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, %% this is an end conf for a non-parallel group that's not %% nested under a parallel group, so no need to buffer io {false,tl(Mode0),undefined, - elapsed_time(conf_start(Ref, Mode0),?now)/1000000, Status}; + timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status}; {Ref,_} -> %% this is an end conf for a non-parallel group nested under %% a parallel group (io buffering is active) queue_test_case_io(Ref, self(), 0, Mod, Func), - Elapsed = elapsed_time(conf_start(Ref, Mode0),?now)/1000000, + Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, case CurrIOHandler of {Ref,_} -> %% current_io_handler was set by start conf of this @@ -2564,7 +2571,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, %% 1. check the TS_RANDOM_SEED env variable %% 2. check random_seed in process state %% 3. use value provided with shuffle option - %% 4. use now() values for seed + %% 4. use timestamp() values for seed case os:getenv("TS_RANDOM_SEED") of Undef when Undef == false ; Undef == "undefined" -> case get(test_server_random_seed) of @@ -3076,13 +3083,11 @@ print_conf_time(ConfTime) -> print(major, "=group_time ~.3fs", [ConfTime]), print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]). -print_props(_, []) -> +print_props([]) -> ok; -print_props(true, Props) -> +print_props(Props) -> print(major, "=group_props ~p", [Props]), - print(minor, "Group properties: ~p~n", [Props]); -print_props(_, _) -> - ok. + print(minor, "Group properties: ~p~n", [Props]). %% repeat N times: {repeat,N} %% repeat N times or until all successful: {repeat_until_all_ok,N} @@ -3687,7 +3692,6 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, print(major, "=case ~w:~w", [Mod, Func]), MinorName = start_minor_log_file(Mod, Func, self() /= Main), - print(minor, "<a name=\"top\"></a>", [], internal_raw), MinorBase = filename:basename(MinorName), print(major, "=logfile ~ts", [filename:basename(MinorName)]), @@ -3701,8 +3705,8 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, RunDir = filename:dirname(MinorName), Ext = if Num == 0 -> - {_,S,Us} = now(), - lists:flatten(io_lib:format(".~w.~w", [S,Us])); + Nr = erlang:unique_integer([positive]), + lists:flatten(io_lib:format(".~w", [Nr])); true -> lists:flatten(io_lib:format(".~w", [Num])) end, @@ -3720,7 +3724,20 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, [tc_start,{{Mod,{Func,GrName}}, MinorName}]), - print_props((RunInit==skip_init), get_props(Mode)), + {ok,Cwd} = file:get_cwd(), + Args2Print = if is_list(UpdatedArgs) -> + lists:keydelete(tc_group_result, 1, UpdatedArgs); + true -> + UpdatedArgs + end, + if RunInit == skip_init -> + print_props(get_props(Mode)); + true -> + ok + end, + print(minor, "Config value:\n\n ~tp\n", [Args2Print]), + print(minor, "Current directory is ~tp\n", [Cwd]), + GrNameStr = case GrName of undefined -> ""; Name -> cast_to_list(Name) diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index acd47788db..9d87eca07e 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -618,9 +618,8 @@ do_quote_progname([Prog,Arg|Args]) -> end. random_element(L) -> - {A,B,C} = now(), - E = lists:sum([A,B,C]) rem length(L), - lists:nth(E+1, L). + random:seed(os:timestamp()), + lists:nth(random:uniform(length(L)), L). find_release(latest) -> "/usr/local/otp/releases/latest/bin/erl"; diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 96e369a138..7a1f7803eb 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -121,14 +121,8 @@ messages_get(Msgs) -> end. timecall(M, F, A) -> - Befor = erlang:now(), - Val = apply(M, F, A), - After = erlang:now(), - Elapsed = - (element(1,After)*1000000+element(2,After)+element(3,After)/1000000)- - (element(1,Befor)*1000000+element(2,Befor)+element(3,Befor)/1000000), - {Elapsed, Val}. - + {Elapsed, Val} = timer:tc(M, F, A), + {Elapsed / 1000000, Val}. call_crash(Time,Crash,M,F,A) -> @@ -874,9 +868,8 @@ unique_name() -> util_loop(State) -> receive {From,unique_name} -> - {_,S,Us} = now(), - Ms = trunc(Us/1000), - Name = lists:flatten(io_lib:format("~w.~w", [S,Ms])), + Nr = erlang:unique_integer([positive]), + Name = integer_to_list(Nr), if Name == State#util_state.latest_name -> timer:sleep(1), self() ! {From,unique_name}, diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index a41409f2fd..594e619fbc 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -18,7 +18,6 @@ %% -module(ts_install). - -export([install/2, platform_id/1]). -include("ts.hrl"). @@ -112,6 +111,12 @@ get_vars([], name, [], Result) -> get_vars(_, _, _, _) -> {error, fatal_bad_conf_vars}. +config_flags() -> + case os:getenv("CONFIG_FLAGS") of + false -> []; + CF -> string:tokens(CF, " \t\n") + end. + unix_autoconf(XConf) -> Configure = filename:absname("configure"), Flags = proplists:get_value(crossflags,XConf,[]), @@ -122,22 +127,70 @@ unix_autoconf(XConf) -> erlang:system_info(threads) /= false], Debug = [" --enable-debug-mode" || string:str(erlang:system_info(system_version),"debug") > 0], - MXX_Build = [Y || Y <- string:tokens(os:getenv("CONFIG_FLAGS", ""), " \t\n"), + MXX_Build = [Y || Y <- config_flags(), Y == "--enable-m64-build" orelse Y == "--enable-m32-build"], Args = Host ++ Build ++ Threads ++ Debug ++ " " ++ MXX_Build, case filelib:is_file(Configure) of true -> OSXEnv = macosx_cflags(), + UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)), io:format("Running ~s~nEnv: ~p~n", - [lists:flatten(Configure ++ Args),Env++OSXEnv]), + [lists:flatten(Configure ++ Args),UnQuotedEnv]), Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])}, - [stream, eof, {env,Env++OSXEnv}]), + [stream, eof, {env,UnQuotedEnv}]), ts_lib:print_data(Port); false -> {error, no_configure_script} end. +unquote([{Var,Val}|T]) -> + [{Var,unquote(Val)}|unquote(T)]; +unquote([]) -> + []; +unquote("\""++Rest) -> + lists:reverse(tl(lists:reverse(Rest))); +unquote(String) -> + String. + +assign_vars([]) -> + []; +assign_vars([{VAR,FlagsStr} | VARs]) -> + [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)]; +assign_vars(FlagsStr) -> + Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])], + string:strip(lists:flatten(lists:map(fun(Flag) -> + Flag ++ " " + end, Flags)), right). + +assign_all_vars([$$ | Rest], FlagSoFar) -> + {VarName,Rest1} = get_var_name(Rest, []), + assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName)); +assign_all_vars([Char | Rest], FlagSoFar) -> + assign_all_vars(Rest, FlagSoFar ++ [Char]); +assign_all_vars([], Flag) -> + Flag. + +get_var_name([Ch | Rest] = Str, VarR) -> + case valid_char(Ch) of + true -> get_var_name(Rest, [Ch | VarR]); + false -> {lists:reverse(VarR),Str} + end; +get_var_name([], VarR) -> + {lists:reverse(VarR),[]}. + +assign_var(VarName) -> + case os:getenv(VarName) of + false -> ""; + Val -> Val + end. + +valid_char(Ch) when Ch >= $a, Ch =< $z -> true; +valid_char(Ch) when Ch >= $A, Ch =< $Z -> true; +valid_char(Ch) when Ch >= $0, Ch =< $9 -> true; +valid_char($_) -> true; +valid_char(_) -> false. + get_xcomp_flag(Flag, Flags) -> get_xcomp_flag(Flag, Flag, Flags). get_xcomp_flag(Flag, Tag, Flags) -> @@ -228,7 +281,7 @@ add_vars(Vars0, Opts0) -> {Opts, [{longnames, LongNames}, {platform_id, PlatformId}, {platform_filename, PlatformFilename}, - {rsh_name, os:getenv("ERL_RSH", "rsh")}, + {rsh_name, get_rsh_name()}, {platform_label, PlatformLabel}, {ts_net_dir, Mounted}, {erl_flags, []}, @@ -249,6 +302,12 @@ get_testcase_callback() -> end end. +get_rsh_name() -> + case os:getenv("ERL_RSH") of + false -> "rsh"; + Str -> Str + end. + platform_id(Vars) -> {Id,_,_,_} = platform(Vars), Id. diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index 7746bbed6f..3dfa6174fe 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -238,12 +238,9 @@ generate_nodenames2(0, _Hosts, Acc) -> Acc; generate_nodenames2(N, Hosts, Acc) -> Host=lists:nth((N rem (length(Hosts)))+1, Hosts), - Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host), + Name=list_to_atom(temp_nodename("nod") ++ "@" ++ Host), generate_nodenames2(N-1, Hosts, [Name|Acc]). -temp_nodename([], Acc) -> - lists:flatten(Acc); -temp_nodename([Chr|Base], Acc) -> - {A,B,C} = erlang:now(), - New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)], - temp_nodename(Base, [New|Acc]). +temp_nodename(Base) -> + Num = erlang:unique_integer([positive]), + Base ++ integer_to_list(Num). diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index c56759ebb9..0c003bab39 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4743,6 +4743,23 @@ for a tag on the form `module:tag'." ;;; `module:tag'. +(when (and (fboundp 'etags-tags-completion-table) + (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ + (if (fboundp 'advice-add) + ;; Emacs 24.4+ + (advice-add 'etags-tags-completion-table :around + (lambda (oldfun) + (if (eq find-tag-default-function 'erlang-find-tag-for-completion) + (erlang-etags-tags-completion-table) + (funcall oldfun))) + (list :name 'erlang-replace-tags-table)) + ;; Emacs 23.1-24.3 + (defadvice etags-tags-completion-table (around erlang-replace-tags-table activate) + (if (eq find-tag-default-function 'erlang-find-tag-for-completion) + (setq ad-return-value (erlang-etags-tags-completion-table)) + ad-do-it)))) + + (defun erlang-complete-tag () "Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. @@ -4754,7 +4771,17 @@ about Erlang modules." (require 'etags) (error nil)) (cond ((and erlang-tags-installed - (fboundp 'complete-tag)) ; Emacs 19 + (fboundp 'etags-tags-completion-table) + (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ + ;; This depends on the advice called erlang-replace-tags-table + ;; above. It is not enough to let-bind + ;; tags-completion-table-function since that will not override + ;; the buffer-local value in the TAGS buffer. + (let ((find-tag-default-function 'erlang-find-tag-for-completion)) + (complete-tag))) + ((and erlang-tags-installed + (fboundp 'complete-tag) + (fboundp 'tags-complete-tag)) ; Emacs 19 (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) (fset 'tags-complete-tag (symbol-function 'erlang-tags-complete-tag)) @@ -4769,6 +4796,15 @@ about Erlang modules." (error "This version of Emacs can't complete tags")))) +(defun erlang-find-tag-for-completion () + (let ((start (save-excursion + (skip-chars-backward "[:word:][:digit:]_:'") + (point)))) + (unless (eq start (point)) + (buffer-substring-no-properties start (point))))) + + + ;; Based on `tags-complete-tag', but this one uses ;; `erlang-tags-completion-table' instead of `tags-completion-table'. ;; @@ -4816,7 +4852,12 @@ about Erlang modules." ;; the only format supported by Emacs, so far.) (defun erlang-etags-tags-completion-table () (let ((table (make-vector 511 0)) - (file nil)) + (file nil) + (progress-reporter + (when (fboundp 'make-progress-reporter) + (make-progress-reporter + (format "Making erlang tags completion table for %s..." buffer-file-name) + (point-min) (point-max))))) (save-excursion (goto-char (point-min)) ;; This monster regexp matches an etags tag line. @@ -4828,31 +4869,33 @@ about Erlang modules." ;; \6 is the line to start searching at; ;; \7 is the char to start searching at. (while (progn - (while (and - (eq (following-char) ?\f) - (looking-at "\f\n\\([^,\n]*\\),.*\n")) - (setq file (buffer-substring - (match-beginning 1) (match-end 1))) - (goto-char (match-end 0))) - (re-search-forward - "\ + (while (and + (eq (following-char) ?\f) + (looking-at "\f\n\\([^,\n]*\\),.*\n")) + (setq file (buffer-substring + (match-beginning 1) (match-end 1))) + (goto-char (match-end 0))) + (re-search-forward + "\ ^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ \\([0-9]+\\)?,\\([0-9]+\\)?\n" - nil t)) - (let ((tag (if (match-beginning 5) - ;; There is an explicit tag name. - (buffer-substring (match-beginning 5) (match-end 5)) - ;; No explicit tag name. Best guess. - (buffer-substring (match-beginning 3) (match-end 3)))) - (module (and file - (erlang-get-module-from-file-name file)))) - (intern tag table) - (if (stringp module) - (progn - (intern (concat module ":" tag) table) - ;; Only the first one will be stored in the table. - (intern (concat module ":") table)))))) + nil t)) + (let ((tag (if (match-beginning 5) + ;; There is an explicit tag name. + (buffer-substring (match-beginning 5) (match-end 5)) + ;; No explicit tag name. Best guess. + (buffer-substring (match-beginning 3) (match-end 3)))) + (module (and file + (erlang-get-module-from-file-name file)))) + (intern tag table) + (when (stringp module) + (intern (concat module ":" tag) table) + ;; Only the first ones will be stored in the table. + (intern (concat module ":") table) + (intern (concat module ":module_info") table)) + (when progress-reporter + (progress-reporter-update progress-reporter (point)))))) table)) ;;; diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl index 69f2f3b1aa..75bb45c659 100644 --- a/lib/tools/src/cover_web.erl +++ b/lib/tools/src/cover_web.erl @@ -734,7 +734,7 @@ generate_filename(Prefix) -> filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata"). ts() -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()), + {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()), io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl index bfbbefb473..a3fef91e61 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -187,7 +187,7 @@ handle_call({profile_start, Rootset, Pattern, {M,F,A}, Opts}, From, #state{fd = case set_process_trace(true, [Pid|Rootset], Topts) of true -> ok = set_pattern_trace(true, Pattern), - T0 = now(), + T0 = erlang:timestamp(), ok = execute_profiling(Pid), {noreply, #state{ profiling = true, @@ -211,7 +211,7 @@ handle_call({profile_start, Rootset, Pattern, undefined, Opts}, From, #state{ fd case set_process_trace(true, Rootset, Topts) of true -> - T0 = now(), + T0 = erlang:timestamp(), ok = set_pattern_trace(true, Pattern), {reply, profiling, #state{ profiling = true, diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl index e3cc51cdb2..e25db2eb1b 100644 --- a/lib/tools/src/tags.erl +++ b/lib/tools/src/tags.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. 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 @@ -297,15 +297,16 @@ word_char(_) -> false. %% Check the options `outfile' and `outdir'. open_out(Options) -> + Opts = [write, {encoding, unicode}], case lists:keysearch(outfile, 1, Options) of {value, {outfile, File}} -> - file:open(File, [write]); + file:open(File, Opts); _ -> case lists:keysearch(outdir, 1, Options) of {value, {outdir, Dir}} -> - file:open(filename:join(Dir, "TAGS"), [write]); + file:open(filename:join(Dir, "TAGS"), Opts); _ -> - file:open("TAGS", [write]) + file:open("TAGS", Opts) end end. diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index ec5b6f3a82..a4e5d85f92 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -41,7 +41,7 @@ ] }, {runtime_dependencies, ["webtool-0.8.10","stdlib-2.0","runtime_tools-1.8.14", - "kernel-3.0","inets-5.10","erts-6.0", + "kernel-3.0","inets-5.10","erts-7.0", "compiler-5.0"]} ] }. |