diff options
141 files changed, 4614 insertions, 2160 deletions
diff --git a/erts/doc/src/atomics.xml b/erts/doc/src/atomics.xml index f552c11e18..455973f011 100644 --- a/erts/doc/src/atomics.xml +++ b/erts/doc/src/atomics.xml @@ -85,6 +85,8 @@ bsl 64)-1</c>.</p> </item> </taglist> + <p>Atomics are not tied to the current process and are automatically + garbage collected when they are no longer referenced.</p> </desc> </func> diff --git a/erts/doc/src/counters.xml b/erts/doc/src/counters.xml index 3d26093a59..36816bd68d 100644 --- a/erts/doc/src/counters.xml +++ b/erts/doc/src/counters.xml @@ -103,6 +103,8 @@ acceptable.</p> </item> </taglist> + <p>Counters are not tied to the current process and are automatically + garbage collected when they are no longer referenced.</p> </desc> </func> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 3fe6e00d57..34042cb4de 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -3063,6 +3063,11 @@ enif_map_iterator_destroy(env, &iter);</code> <code type="none">{select, Obj, Ref, ready_input | ready_output}</code> <p><c>ready_input</c> or <c>ready_output</c> indicates if the event object is ready for reading or writing.</p> + <note><p>For complete control over the message format use the newer functions + <seealso marker="#enif_select_read"><c>enif_select_read</c></seealso> or + <seealso marker="#enif_select_write"><c>enif_select_write</c></seealso> + introduced in erts-11.0 (OTP-22.0).</p> + </note> <p>Argument <c>pid</c> may be <c>NULL</c> to indicate the calling process.</p> <p>Argument <c>obj</c> is a resource object obtained from <seealso marker="#enif_alloc_resource"><c>enif_alloc_resource</c></seealso>. @@ -3157,6 +3162,34 @@ if (retval & ERL_NIF_SELECT_STOP_CALLED) { </func> <func> + <name since="OTP 22.0"><ret>int</ret> + <nametext>enif_select_read(ErlNifEnv* env, ErlNifEvent event, void* obj, + const ErlNifPid* pid, ERL_NIF_TERM msg, ErlNifEnv* msg_env)</nametext> + </name> + <name since="OTP 22.0"><ret>int</ret> + <nametext>enif_select_write(ErlNifEnv* env, ErlNifEvent event, void* obj, + const ErlNifPid* pid, ERL_NIF_TERM msg, ErlNifEnv* msg_env)</nametext> + </name> + <fsummary>Manage subscription on IO event.</fsummary> + <desc> + <p>These are variants of <seealso marker="#enif_select">enif_select</seealso> + where you can supply your own message term <c>msg</c> that will be sent to + the process instead of the predefined tuple <c>{select,_,_,_}.</c></p> + <p>Argument <c>msg_env</c> must either be <c>NULL</c> or the environment of + <c>msg</c> allocated with <seealso marker="#enif_alloc_env"> + <c>enif_alloc_env</c></seealso>. If argument <c>msg_env</c> is + <c>NULL</c> the term <c>msg</c> will be copied, otherwise both + <c>msg</c> and <c>msg_env</c> will be invalidated by a successful call + to <c>enif_select_read</c> or <c>enif_select_write</c>.</p> + <p>Apart from the message format <c>enif_select_read</c> and + <c>enif_select_write</c> behaves exactly the same as <seealso + marker="#enif_select">enif_select</seealso> with argument <c>mode</c> as + either <c>ERL_NIF_SELECT_READ</c> or <c>ERL_NIF_SELECT_WRITE</c>. To + cancel or close events use <seealso marker="#enif_select">enif_select</seealso>.</p> + </desc> + </func> + + <func> <name since="OTP R14B"><ret>ErlNifPid *</ret> <nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext> </name> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 6f27c0d58d..d30583be4b 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -7543,7 +7543,39 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="14" since=""/> + <name name="system_flag" arity="2" clause_i="14" since="OTP 21.3"/> + <fsummary>Set system logger process.</fsummary> + <desc> + <p>Sets the process that will receive the logging + messages generated by ERTS. If set to <c>undefined</c>, + all logging messages generated by ERTS will be dropped. + The messages will be in the format:</p> + <code> +{log,Level,Format,ArgList,Metadata} where + +Level = atom(), +Format = string(), +ArgList = list(term()), +Metadata = #{ pid => pid(), + group_leader => pid(), + time := logger:timestamp(), + error_logger := #{ emulator := true, tag := atom() } + </code> + <p>If the <c>system_logger</c> process dies, + this flag will be reset to <c>logger</c>.</p> + <p>The default is the process named <c>logger</c>.</p> + <p>Returns the old value of the flag.</p> + <note><p>This function is designed to be used by the + KERNEL <seealso marker="kernel:logger"><c>logger</c></seealso>. + Be careful if you change it to something else as + log messages may be lost. If you want to intercept + emulator log messages, do it by adding a specialized handler + to the KERNEL logger.</p></note> + </desc> + </func> + + <func> + <name name="system_flag" arity="2" clause_i="15" since=""/> <fsummary>Set system flag trace_control_word.</fsummary> <desc> <p>Sets the value of the node trace control word to @@ -7557,7 +7589,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="15" + <name name="system_flag" arity="2" clause_i="16" anchor="system_flag_time_offset" since="?"/> <fsummary>Finalize the time offset.</fsummary> <desc> @@ -7707,8 +7739,9 @@ ok <seealso marker="#system_info_nif_version"><c>nif_version</c></seealso>, <seealso marker="#system_info_otp_release"><c>otp_release</c></seealso>, <seealso marker="#system_info_port_parallelism"><c>port_parallelism</c></seealso>, - <seealso marker="#system_info_system_version"><c>system_version</c></seealso>, <seealso marker="#system_info_system_architecture"><c>system_architecture</c></seealso>, + <seealso marker="#system_info_system_logger"><c>system_logger</c></seealso>, + <seealso marker="#system_info_system_version"><c>system_version</c></seealso>, <seealso marker="#system_info_trace_control_word"><c>trace_control_word</c></seealso>, <seealso marker="#system_info_version"><c>version</c></seealso>, <seealso marker="#system_info_wordsize"><c>wordsize</c></seealso> @@ -7880,7 +7913,7 @@ ok anchor="system_info_cpu_topology" since=""/> <!-- cpu_topology --> <name name="system_info" arity="1" clause_i="13" since=""/> <!-- {cpu_topology, _} --> <name name="system_info" arity="1" clause_i="38" since=""/> <!-- logical_processors --> - <name name="system_info" arity="1" clause_i="73" since="?"/> <!-- update_cpu_info --> + <name name="system_info" arity="1" clause_i="74" since="?"/> <!-- update_cpu_info --> <fsummary>Information about the CPU topology of the system.</fsummary> <type name="cpu_topology"/> <type name="level_entry"/> @@ -8235,10 +8268,10 @@ ok <name name="system_info" arity="1" clause_i="50" since="OTP 18.0"/> <!-- os_monotonic_time_source --> <name name="system_info" arity="1" clause_i="51" since="OTP 18.0"/> <!-- os_system_time_source --> <name name="system_info" arity="1" clause_i="63" since="OTP 18.0"/> <!-- start_time --> - <name name="system_info" arity="1" clause_i="68" since="OTP 18.0"/> <!-- time_correction --> - <name name="system_info" arity="1" clause_i="69" since="OTP 18.0"/> <!-- time_offset --> - <name name="system_info" arity="1" clause_i="70" since="OTP 18.0"/> <!-- time_warp_mode --> - <name name="system_info" arity="1" clause_i="71" since="?"/> <!-- tolerant_timeofday --> + <name name="system_info" arity="1" clause_i="69" since="OTP 18.0"/> <!-- time_correction --> + <name name="system_info" arity="1" clause_i="70" since="OTP 18.0"/> <!-- time_offset --> + <name name="system_info" arity="1" clause_i="71" since="OTP 18.0"/> <!-- time_warp_mode --> + <name name="system_info" arity="1" clause_i="72" since="?"/> <!-- tolerant_timeofday --> <fsummary>Information about system time.</fsummary> <desc> <marker id="system_info_time_tags"/> @@ -8470,8 +8503,8 @@ ok <name name="system_info" arity="1" clause_i="60" since=""/> <!-- scheduler_id --> <name name="system_info" arity="1" clause_i="61" since=""/> <!-- schedulers --> <name name="system_info" arity="1" clause_i="62" since=""/> <!-- smp_support --> - <name name="system_info" arity="1" clause_i="66" since=""/> <!-- threads --> - <name name="system_info" arity="1" clause_i="67" since=""/> <!-- thread_pool_size --> + <name name="system_info" arity="1" clause_i="67" since=""/> <!-- threads --> + <name name="system_info" arity="1" clause_i="68" since=""/> <!-- thread_pool_size --> <fsummary>Information about system schedulers.</fsummary> <desc> <marker id="system_info_scheduler_tags"/> @@ -8893,19 +8926,20 @@ ok <!-- <name name="system_info" arity="1" clause_i="61"/> schedulers --> <!-- <name name="system_info" arity="1" clause_i="62"/> smp_support --> <!-- <name name="system_info" arity="1" clause_i="63"/> start_time --> - <name name="system_info" arity="1" clause_i="64" since=""/> <!-- system_version --> - <name name="system_info" arity="1" clause_i="65" since=""/> <!-- system_architecture --> - <!-- <name name="system_info" arity="1" clause_i="66"/> threads --> - <!-- <name name="system_info" arity="1" clause_i="67"/> thread_pool_size --> - <!-- <name name="system_info" arity="1" clause_i="68"/> time_correction --> - <!-- <name name="system_info" arity="1" clause_i="69"/> time_offset --> - <!-- <name name="system_info" arity="1" clause_i="70"/> time_warp_mode --> - <!-- <name name="system_info" arity="1" clause_i="71"/> tolerant_timeofday --> - <name name="system_info" arity="1" clause_i="72" since=""/> <!-- trace_control_word --> - <!-- <name name="system_info" arity="1" clause_i="73"/> update_cpu_info --> - <name name="system_info" arity="1" clause_i="74" since=""/> <!-- version --> - <name name="system_info" arity="1" clause_i="75" since=""/> <!-- wordsize --> - <!-- <name name="system_info" arity="1" clause_i="76"/> overview --> + <name name="system_info" arity="1" clause_i="64" since=""/> <!-- system_architecture --> + <name name="system_info" arity="1" clause_i="65" since="OTP 21.3"/> <!-- system_logger --> + <name name="system_info" arity="1" clause_i="66" since=""/> <!-- system_version --> + <!-- <name name="system_info" arity="1" clause_i="67"/> threads --> + <!-- <name name="system_info" arity="1" clause_i="68"/> thread_pool_size --> + <!-- <name name="system_info" arity="1" clause_i="69"/> time_correction --> + <!-- <name name="system_info" arity="1" clause_i="70"/> time_offset --> + <!-- <name name="system_info" arity="1" clause_i="71"/> time_warp_mode --> + <!-- <name name="system_info" arity="1" clause_i="72"/> tolerant_timeofday --> + <name name="system_info" arity="1" clause_i="73" since=""/> <!-- trace_control_word --> + <!-- <name name="system_info" arity="1" clause_i="74"/> update_cpu_info --> + <name name="system_info" arity="1" clause_i="75" since=""/> <!-- version --> + <name name="system_info" arity="1" clause_i="76" since=""/> <!-- wordsize --> + <!-- <name name="system_info" arity="1" clause_i="77"/> overview --> <fsummary>Information about the system.</fsummary> <desc> <marker id="system_info_misc_tags"/> @@ -9061,18 +9095,24 @@ ok <seealso marker="erl#+spp"><c>+spp</c></seealso> in <c>erl(1)</c>.</p> </item> - <tag><marker id="system_info_system_version"/> - <c>system_version</c></tag> - <item> - <p>Returns a string containing version number and - some important properties, such as the number of schedulers.</p> - </item> <tag><marker id="system_info_system_architecture"/> <c>system_architecture</c></tag> <item> <p>Returns a string containing the processor and OS architecture the emulator is built for.</p> </item> + <tag><marker id="system_info_system_logger"/> + <c>system_logger</c></tag> + <item> + <p>Returns the current <c>system_logger</c> as set by + <seealso marker="#system_flag/2"><c>erlang:system_flag(system_logger, _)</c></seealso>.</p> + </item> + <tag><marker id="system_info_system_version"/> + <c>system_version</c></tag> + <item> + <p>Returns a string containing version number and + some important properties, such as the number of schedulers.</p> + </item> <tag><marker id="system_info_trace_control_word"/> <c>trace_control_word</c></tag> <item> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index f3569f8925..8324871626 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,28 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 10.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a crash when dangling files were closed after + <c>init:restart/0</c>.</p> + <p> + Own Id: OTP-15495 Aux Id: ERL-821 </p> + </item> + <item> + <p> + A bug that could cause dirty schedulers to become + unresponsive has been fixed.</p> + <p> + Own Id: OTP-15509 Aux Id: PR-2027, PR-2093 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 10.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1625,6 +1647,22 @@ </section> +<section><title>Erts 9.3.3.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug that could cause dirty schedulers to become + unresponsive has been fixed.</p> + <p> + Own Id: OTP-15509 Aux Id: PR-2027, PR-2093 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.3.3.7</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -3220,6 +3258,43 @@ </section> +<section><title>Erts 8.3.5.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed bug in operator <c>band</c> of two negative + operands causing erroneous result if the absolute value + of one of the operands have the lowest <c>N*W</c> bits as + zero and the other absolute value is not larger than + <c>N*W</c> bits. <c>N</c> is an integer of 1 or larger + and <c>W</c> is 32 or 64 depending on word size.</p> + <p> + Own Id: OTP-15487 Aux Id: ERL-804 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Added an optional <c>./configure</c> flag to compile + the emulator with spectre mitigation: + <c>--with-spectre-mitigation</c></p> + <p>Note that this requires a recent version of GCC with + support for spectre mitigation and the + <c>--mindirect-branch=thunk</c> flag, such as + <c>8.1</c>.</p> + <p> + Own Id: OTP-15430 Aux Id: ERIERL-237 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.3.5.6</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/doc/src/ref_man.xml b/erts/doc/src/ref_man.xml index a78aaa449e..811d299f06 100644 --- a/erts/doc/src/ref_man.xml +++ b/erts/doc/src/ref_man.xml @@ -31,26 +31,26 @@ </header> <description> </description> - <xi:include href="erl_prim_loader.xml"/> - <xi:include href="erlang.xml"/> - <xi:include href="init.xml"/> - <xi:include href="persistent_term.xml"/> - <xi:include href="zlib.xml"/> + <xi:include href="atomics.xml"/> + <xi:include href="counters.xml"/> + <xi:include href="driver_entry.xml"/> <xi:include href="epmd.xml"/> <xi:include href="erl.xml"/> + <xi:include href="erlang.xml"/> <xi:include href="erlc.xml"/> - <xi:include href="werl.xml"/> - <xi:include href="escript.xml"/> - <xi:include href="erlsrv.xml"/> - <xi:include href="start_erl.xml"/> - <xi:include href="run_erl.xml"/> - <xi:include href="start.xml"/> <xi:include href="erl_driver.xml"/> - <xi:include href="driver_entry.xml"/> - <xi:include href="erts_alloc.xml"/> <xi:include href="erl_nif.xml"/> + <xi:include href="erl_prim_loader.xml"/> + <xi:include href="erlsrv.xml"/> <xi:include href="erl_tracer.xml"/> - <xi:include href="atomics.xml"/> - <xi:include href="counters.xml"/> + <xi:include href="erts_alloc.xml"/> + <xi:include href="escript.xml"/> + <xi:include href="init.xml"/> + <xi:include href="persistent_term.xml"/> + <xi:include href="run_erl.xml"/> + <xi:include href="start.xml"/> + <xi:include href="start_erl.xml"/> + <xi:include href="werl.xml"/> + <xi:include href="zlib.xml"/> </application> diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 764298bac8..ff7db0e742 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2812,38 +2812,110 @@ BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) /* convert an integer to a list of ascii integers */ -BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) +static Eterm integer_to_list(Process *c_p, Eterm num, int base) { - Eterm* hp; + Eterm *hp; + Eterm res; Uint need; + if (is_small(num)) { + char s[128]; + char *c = s; + Uint digits; + + digits = Sint_to_buf(signed_val(num), base, &c, sizeof(s)); + need = 2 * digits; + + hp = HAlloc(c_p, need); + res = buf_to_intlist(&hp, c, digits, NIL); + } else { + const int DIGITS_PER_RED = 16; + Eterm *hp_end; + Uint digits; + + digits = big_integer_estimate(num, base); + + if ((digits / DIGITS_PER_RED) > ERTS_BIF_REDS_LEFT(c_p)) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + + /* This could take a very long time, tell the caller to reschedule + * us to a dirty CPU scheduler if we aren't already on one. */ + if (esdp->type == ERTS_SCHED_NORMAL) { + return THE_NON_VALUE; + } + } else { + BUMP_REDS(c_p, digits / DIGITS_PER_RED); + } + + need = 2 * digits; + + hp = HAlloc(c_p, need); + hp_end = hp + need; + + res = erts_big_to_list(num, base, &hp); + HRelease(c_p, hp_end, hp); + } + + return res; +} + +BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) +{ + Eterm res; + if (is_not_integer(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(BIF_P, BADARG); } - if (is_small(BIF_ARG_1)) { - char *c; - int n; - struct Sint_buf ibuf; + res = integer_to_list(BIF_P, BIF_ARG_1, 10); - c = Sint_to_buf(signed_val(BIF_ARG_1), &ibuf); - n = sys_strlen(c); - need = 2*n; - hp = HAlloc(BIF_P, need); - BIF_RET(buf_to_intlist(&hp, c, n, NIL)); + if (is_non_value(res)) { + Eterm args[1]; + args[0] = BIF_ARG_1; + return erts_schedule_bif(BIF_P, + args, + BIF_I, + integer_to_list_1, + ERTS_SCHED_DIRTY_CPU, + am_erlang, + am_integer_to_list, + 1); } - else { - int n = big_decimal_estimate(BIF_ARG_1); - Eterm res; - Eterm* hp_end; - need = 2*n; - hp = HAlloc(BIF_P, need); - hp_end = hp + need; - res = erts_big_to_list(BIF_ARG_1, &hp); - HRelease(BIF_P,hp_end,hp); - BIF_RET(res); + return res; +} + +BIF_RETTYPE integer_to_list_2(BIF_ALIST_2) +{ + Eterm res; + SWord base; + + if (is_not_integer(BIF_ARG_1) || is_not_small(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + base = signed_val(BIF_ARG_2); + if (base < 2 || base > 36) { + BIF_ERROR(BIF_P, BADARG); + } + + res = integer_to_list(BIF_P, BIF_ARG_1, base); + + if (is_non_value(res)) { + Eterm args[2]; + args[0] = BIF_ARG_1; + args[1] = BIF_ARG_2; + return erts_schedule_bif(BIF_P, + args, + BIF_I, + integer_to_list_2, + ERTS_SCHED_DIRTY_CPU, + am_erlang, + am_integer_to_list, + 2); } + + return res; } /**********************************************************************/ @@ -4624,6 +4696,9 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) return erts_bind_schedulers(BIF_P, BIF_ARG_2); } else if (ERTS_IS_ATOM_STR("erts_alloc", BIF_ARG_1)) { return erts_alloc_set_dyn_param(BIF_P, BIF_ARG_2); + } else if (ERTS_IS_ATOM_STR("system_logger", BIF_ARG_1)) { + Eterm res = erts_set_system_logger(BIF_ARG_2); + if (is_value(res)) BIF_RET(res); } error: BIF_ERROR(BIF_P, BADARG); @@ -5126,55 +5201,6 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm * return exiting; } - - -#ifdef HARDDEBUG -/* -You'll need this line in bif.tab to be able to use this debug bif - -bif erlang:send_to_logger/2 - -*/ -BIF_RETTYPE send_to_logger_2(BIF_ALIST_2) -{ - byte *buf; - ErlDrvSizeT len; - if (!is_atom(BIF_ARG_1) || !(is_list(BIF_ARG_2) || - is_nil(BIF_ARG_1))) { - BIF_ERROR(BIF_P,BADARG); - } - if (erts_iolist_size(BIF_ARG_2, &len) != 0) - BIF_ERROR(BIF_P,BADARG); - else if (len == 0) - buf = ""; - else { - ErlDrvSizeT len2; - buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, len+1); - len2 = - erts_iolist_to_buf(BIF_ARG_2, buf, len); - ASSERT(len2 == len); (void)len2; - buf[len] = '\0'; - switch (BIF_ARG_1) { - case am_info: - erts_send_info_to_logger(BIF_P->group_leader, buf, len); - break; - case am_warning: - erts_send_warning_to_logger(BIF_P->group_leader, buf, len); - break; - case am_error: - erts_send_error_to_logger(BIF_P->group_leader, buf, len); - break; - default: - { - BIF_ERROR(BIF_P,BADARG); - } - } - erts_free(ERTS_ALC_T_TMP, (void *) buf); - } - BIF_RET(am_true); -} -#endif /* HARDDEBUG */ - BIF_RETTYPE get_module_info_1(BIF_ALIST_1) { Eterm ret = erts_module_info_0(BIF_P, BIF_ARG_1); diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index f141407c0e..18586b5ede 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -724,3 +724,16 @@ bif erts_internal:counters_get/2 bif erts_internal:counters_add/3 bif erts_internal:counters_put/3 bif erts_internal:counters_info/1 + +# +# New in 21.2.3 +# + +bif erts_internal:spawn_system_process/3 + +# +# New in 21.3 +# + +bif erlang:integer_to_list/2 +bif erlang:integer_to_binary/2 diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab index ce9e61a838..418bbe2b23 100644 --- a/erts/emulator/beam/bif_instrs.tab +++ b/erts/emulator/beam/bif_instrs.tab @@ -58,103 +58,70 @@ CALL_GUARD_BIF(BF, TmpReg, Dst) { } } -// Guard BIF in head. On failure, ignore the error and jump -// to the code for the next clause. We don't support tracing +// Guard BIF in head. On failure, ignore the error and jump +// to the code for the next clause. We don't support tracing // of guard BIFs. -i_bif1(Fail, Bif, Src, Dst) { +i_bif1 := i_bif.fetch0.call; +i_bif2 := i_bif.fetch1.fetch0.call; +i_bif3 := i_bif.fetch2.fetch1.fetch0.call; + +i_bif.head() { ErtsBifFunc bf; - Eterm tmp_reg[1]; + Eterm tmp_reg[3]; +} +i_bif.fetch0(Src) { tmp_reg[0] = $Src; - bf = (BifFunction) $Bif; - $CALL_GUARD_BIF(bf, tmp_reg, $Dst); - - $FAIL($Fail); } -// -// Guard BIF in body. It can fail like any BIF. No trace support. -// +i_bif.fetch1(Src) { + tmp_reg[1] = $Src; +} -i_bif1_body(Bif, Src, Dst) { - ErtsBifFunc bf; - Eterm tmp_reg[1]; +i_bif.fetch2(Src) { + tmp_reg[2] = $Src; +} - tmp_reg[0] = $Src; +i_bif.call(Fail, Bif, Dst) { bf = (BifFunction) $Bif; $CALL_GUARD_BIF(bf, tmp_reg, $Dst); - reg[0] = tmp_reg[0]; - SWAPOUT; - I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); - goto post_error_handling; -} - -// -// Guard bif in guard with two arguments ('and'/2, 'or'/2, 'xor'/2). -// - -i_bif2(Fail, Bif, Src1, Src2, Dst) { - Eterm tmp_reg[2]; - ErtsBifFunc bf; - - tmp_reg[0] = $Src1; - tmp_reg[1] = $Src2; - bf = (ErtsBifFunc) $Bif; - $CALL_GUARD_BIF(bf, tmp_reg, $Dst); $FAIL($Fail); } // -// Guard bif in body with two arguments ('and'/2, 'or'/2, 'xor'/2). +// Guard BIF in body. It can fail like any BIF. No trace support. // -i_bif2_body(Bif, Src1, Src2, Dst) { - Eterm tmp_reg[2]; - ErtsBifFunc bf; - - tmp_reg[0] = $Src1; - tmp_reg[1] = $Src2; - bf = (ErtsBifFunc) $Bif; - $CALL_GUARD_BIF(bf, tmp_reg, $Dst); - reg[0] = tmp_reg[0]; - reg[1] = tmp_reg[1]; - SWAPOUT; - I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); - goto post_error_handling; -} - -// Guard BIF in head (binary_part/3). On failure, ignore the error -// and jump to the code for the next clause. We don't support tracing -// of guard BIFs. +i_bif1_body := i_bif_body.fetch0.call; +i_bif2_body := i_bif_body.fetch1.fetch0.call; +i_bif3_body := i_bif_body.fetch2.fetch1.fetch0.call; -i_bif3(Fail, Bif, Src1, Src2, Src3, Dst) { +i_bif_body.head() { ErtsBifFunc bf; Eterm tmp_reg[3]; +} - tmp_reg[0] = $Src1; - tmp_reg[1] = $Src2; - tmp_reg[2] = $Src3; - bf = (BifFunction) $Bif; - $CALL_GUARD_BIF(bf, tmp_reg, $Dst); - - $FAIL($Fail); +i_bif_body.fetch0(Src) { + tmp_reg[0] = $Src; } -// Guard BIF in body with three arguments (binary_part/3). +i_bif_body.fetch1(Src) { + tmp_reg[1] = $Src; +} -i_bif3_body(Bif, Src1, Src2, Src3, Dst) { - ErtsBifFunc bf; - Eterm tmp_reg[3]; +i_bif_body.fetch2(Src) { + tmp_reg[2] = $Src; +} - tmp_reg[0] = $Src1; - tmp_reg[1] = $Src2; - tmp_reg[2] = $Src3; +i_bif_body.call(Bif, Dst) { bf = (BifFunction) $Bif; $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + reg[0] = tmp_reg[0]; reg[1] = tmp_reg[1]; + reg[2] = tmp_reg[2]; SWAPOUT; I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); goto post_error_handling; diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 7e0be2a2a7..522f50287a 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -429,6 +429,7 @@ static const byte digits_per_sint_lookup[36-1]; static const byte digits_per_small_lookup[36-1]; static const Sint largest_power_of_base_lookup[36-1]; +static const double lg2_lookup[36-1]; static ERTS_INLINE byte get_digits_per_signed_int(Uint base) { return digits_per_sint_lookup[base-2]; @@ -442,6 +443,10 @@ static ERTS_INLINE Sint get_largest_power_of_base(Uint base) { return largest_power_of_base_lookup[base-2]; } +static ERTS_INLINE double lookup_log2(Uint base) { + return lg2_lookup[base - 2]; +} + /* ** compare two number vectors */ @@ -1720,23 +1725,23 @@ double_to_big(double x, Eterm *heap, Uint hsz) /* - ** Estimate the number of decimal digits (include sign) + ** Estimate the number of digits in given base (include sign) */ -int big_decimal_estimate(Wterm x) +int big_integer_estimate(Wterm x, Uint base) { Eterm* xp = big_val(x); int lg = I_lg(BIG_V(xp), BIG_SIZE(xp)); - int lg10 = ((lg+1)*28/93)+1; + int lgBase = ((lg + 1) / lookup_log2(base)) + 1; - if (BIG_SIGN(xp)) lg10++; /* add sign */ - return lg10+1; /* add null */ + if (BIG_SIGN(xp)) lgBase++; /* add sign */ + return lgBase + 1; /* add null */ } /* -** Convert a bignum into a string of decimal numbers +** Convert a bignum into a string of numbers in given base */ - -static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) +static Uint write_big(Wterm x, int base, void (*write_func)(void *, char), + void *arg) { Eterm* xp = big_val(x); ErtsDigit* dx = BIG_V(xp); @@ -1744,48 +1749,72 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) short sign = BIG_SIGN(xp); ErtsDigit rem; Uint n = 0; - const Uint digits_per_Sint = get_digits_per_signed_int(10); - const Sint largest_pow_of_base = get_largest_power_of_base(10); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + const Sint largest_pow_of_base = get_largest_power_of_base(base); if (xl == 1 && *dx < largest_pow_of_base) { - rem = *dx; - if (rem == 0) { - (*write_func)(arg, '0'); n++; - } else { - while(rem) { - (*write_func)(arg, (rem % 10) + '0'); n++; - rem /= 10; - } - } + rem = *dx; + if (rem == 0) { + (*write_func)(arg, '0'); n++; + } else { + while(rem) { + int digit = rem % base; + + if (digit < 10) { + (*write_func)(arg, digit + '0'); n++; + } else { + (*write_func)(arg, 'A' + (digit - 10)); n++; + } + + rem /= base; + } + } } else { - ErtsDigit* tmp = (ErtsDigit*) erts_alloc(ERTS_ALC_T_TMP, - sizeof(ErtsDigit)*xl); - dsize_t tmpl = xl; + ErtsDigit* tmp = (ErtsDigit*) erts_alloc(ERTS_ALC_T_TMP, + sizeof(ErtsDigit) * xl); + dsize_t tmpl = xl; - MOVE_DIGITS(tmp, dx, xl); + MOVE_DIGITS(tmp, dx, xl); - while(1) { + while(1) { tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem); - if (tmpl == 1 && *tmp == 0) { - while(rem) { - (*write_func)(arg, (rem % 10)+'0'); n++; - rem /= 10; - } - break; - } else { + + if (tmpl == 1 && *tmp == 0) { + while(rem) { + int digit = rem % base; + + if (digit < 10) { + (*write_func)(arg, digit + '0'); n++; + } else { + (*write_func)(arg, 'A' + (digit - 10)); n++; + } + + rem /= base; + } + break; + } else { Uint i = digits_per_Sint; - while(i--) { - (*write_func)(arg, (rem % 10)+'0'); n++; - rem /= 10; - } - } - } - erts_free(ERTS_ALC_T_TMP, (void *) tmp); + + while(i--) { + int digit = rem % base; + + if (digit < 10) { + (*write_func)(arg, digit + '0'); n++; + } else { + (*write_func)(arg, 'A' + (digit - 10)); n++; + } + + rem /= base; + } + } + } + erts_free(ERTS_ALC_T_TMP, (void *) tmp); } if (sign) { - (*write_func)(arg, '-'); n++; + (*write_func)(arg, '-'); n++; } + return n; } @@ -1802,12 +1831,12 @@ write_list(void *arg, char c) blp->hp += 2; } -Eterm erts_big_to_list(Eterm x, Eterm **hpp) +Eterm erts_big_to_list(Eterm x, int base, Eterm **hpp) { struct big_list__ bl; bl.hp = *hpp; bl.res = NIL; - write_big(x, write_list, (void *) &bl); + write_big(x, base, write_list, (void *) &bl); *hpp = bl.hp; return bl.res; } @@ -1818,11 +1847,11 @@ write_string(void *arg, char c) *(--(*((char **) arg))) = c; } -char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz) +char *erts_big_to_string(Wterm x, int base, char *buf, Uint buf_sz) { char *big_str = buf + buf_sz - 1; *big_str = '\0'; - write_big(x, write_string, (void *) &big_str); + write_big(x, base, write_string, (void*)&big_str); ASSERT(buf <= big_str && big_str <= buf + buf_sz - 1); return big_str; } @@ -1831,11 +1860,11 @@ char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz) * e.g. 1 bsl 64 -> "18446744073709551616" */ -Uint erts_big_to_binary_bytes(Eterm x, char *buf, Uint buf_sz) +Uint erts_big_to_binary_bytes(Eterm x, int base, char *buf, Uint buf_sz) { char *big_str = buf + buf_sz; Uint n; - n = write_big(x, write_string, (void *) &big_str); + n = write_big(x, base, write_string, (void *) &big_str); ASSERT(buf <= big_str && big_str <= buf + buf_sz); return n; } @@ -2578,9 +2607,6 @@ static const double lg2_lookup[36-1] = { 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, 5.04439, 5.08746, 5.12928, 5.16993 }; -static ERTS_INLINE double lookup_log2(Uint base) { - return lg2_lookup[base - 2]; -} /* * How many digits can fit into a signed int (Sint) for given base, we take diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index a1ad75708c..da4dc84d10 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -119,10 +119,10 @@ typedef Uint dsize_t; /* Vector size type */ #endif -int big_decimal_estimate(Wterm); -Eterm erts_big_to_list(Eterm, Eterm**); -char *erts_big_to_string(Wterm x, char *buf, Uint buf_sz); -Uint erts_big_to_binary_bytes(Eterm x, char *buf, Uint buf_sz); +int big_integer_estimate(Wterm, Uint base); +Eterm erts_big_to_list(Eterm, int base, Eterm**); +char *erts_big_to_string(Wterm x, int base, char *buf, Uint buf_sz); +Uint erts_big_to_binary_bytes(Eterm x, int base, char *buf, Uint buf_sz); Eterm small_times(Sint, Sint, Eterm*); diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 6a349764b2..a18228b84a 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -322,40 +322,102 @@ BIF_RETTYPE binary_to_integer_2(BIF_ALIST_2) } +static Eterm integer_to_binary(Process *c_p, Eterm num, int base) +{ + Eterm res; + + if (is_small(num)) { + char s[128]; + char *c = s; + Uint digits; + + digits = Sint_to_buf(signed_val(num), base, &c, sizeof(s)); + res = new_binary(c_p, (byte*)c, digits); + } else { + const int DIGITS_PER_RED = 16; + Uint digits, n; + byte *bytes; + + digits = big_integer_estimate(num, base); + + if ((digits / DIGITS_PER_RED) > ERTS_BIF_REDS_LEFT(c_p)) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + + /* This could take a very long time, tell the caller to reschedule + * us to a dirty CPU scheduler if we aren't already on one. */ + if (esdp->type == ERTS_SCHED_NORMAL) { + return THE_NON_VALUE; + } + } else { + BUMP_REDS(c_p, digits / DIGITS_PER_RED); + } + + bytes = (byte*)erts_alloc(ERTS_ALC_T_TMP, sizeof(byte) * digits); + n = erts_big_to_binary_bytes(num, base, (char*)bytes, digits); + res = new_binary(c_p, bytes + digits - n, n); + erts_free(ERTS_ALC_T_TMP, (void*)bytes); + } + + return res; +} + BIF_RETTYPE integer_to_binary_1(BIF_ALIST_1) -{ - Uint size; +{ Eterm res; if (is_not_integer(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); + BIF_ERROR(BIF_P, BADARG); } - if (is_small(BIF_ARG_1)) { - char *c; - struct Sint_buf ibuf; + res = integer_to_binary(BIF_P, BIF_ARG_1, 10); + + if (is_non_value(res)) { + Eterm args[1]; + args[0] = BIF_ARG_1; + return erts_schedule_bif(BIF_P, + args, + BIF_I, + integer_to_binary_1, + ERTS_SCHED_DIRTY_CPU, + am_erlang, + am_integer_to_binary, + 1); + } - /* Enhancement: If we can calculate the buffer size exactly - * we could avoid an unnecessary copy of buffers. - * Useful if size determination is faster than a copy. - */ - c = Sint_to_buf(signed_val(BIF_ARG_1), &ibuf); - size = sys_strlen(c); - res = new_binary(BIF_P, (byte *)c, size); - } else { - byte* bytes; - Uint n = 0; + return res; +} - /* Here we also have multiple copies of buffers - * due to new_binary interface - */ - size = big_decimal_estimate(BIF_ARG_1) - 1; /* remove null */ - bytes = (byte*) erts_alloc(ERTS_ALC_T_TMP, sizeof(byte)*size); - n = erts_big_to_binary_bytes(BIF_ARG_1, (char *)bytes, size); - res = new_binary(BIF_P, bytes + size - n, n); - erts_free(ERTS_ALC_T_TMP, (void *) bytes); +BIF_RETTYPE integer_to_binary_2(BIF_ALIST_2) +{ + Eterm res; + SWord base; + + if (is_not_integer(BIF_ARG_1) || is_not_small(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + base = signed_val(BIF_ARG_2); + if (base < 2 || base > 36) { + BIF_ERROR(BIF_P, BADARG); } - BIF_RET(res); + + res = integer_to_binary(BIF_P, BIF_ARG_1, base); + + if (is_non_value(res)) { + Eterm args[2]; + args[0] = BIF_ARG_1; + args[1] = BIF_ARG_2; + return erts_schedule_bif(BIF_P, + args, + BIF_I, + integer_to_binary_2, + ERTS_SCHED_DIRTY_CPU, + am_erlang, + am_integer_to_binary, + 2); + } + + return res; } #define ERTS_B2L_BYTES_PER_REDUCTION 256 diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 81531f6cc8..273b598562 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -82,7 +82,7 @@ process_info(fmtfn_t to, void *to_arg) * they are most likely just created and has invalid data */ if (!ERTS_PROC_IS_EXITING(p) && p->heap != NULL) - print_process_info(to, to_arg, p); + print_process_info(to, to_arg, p, 0); } } @@ -101,7 +101,7 @@ process_killer(void) rp = erts_pix2proc(i); if (rp && rp->i != ENULL) { int br; - print_process_info(ERTS_PRINT_STDOUT, NULL, rp); + print_process_info(ERTS_PRINT_STDOUT, NULL, rp, 0); erts_printf("(k)ill (n)ext (r)eturn:\n"); while(1) { if ((j = sys_get_key(0)) <= 0) @@ -200,13 +200,14 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext) /* Display info about an individual Erlang process */ void -print_process_info(fmtfn_t to, void *to_arg, Process *p) +print_process_info(fmtfn_t to, void *to_arg, Process *p, ErtsProcLocks orig_locks) { int garbing = 0; int running = 0; Sint len; struct saved_calls *scb; erts_aint32_t state; + ErtsProcLocks locks = orig_locks; /* display the PID */ erts_print(to, to_arg, "=proc:%T\n", p->common.id); @@ -223,6 +224,22 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p) | ERTS_PSFLG_DIRTY_RUNNING)) running = 1; + if (!(locks & ERTS_PROC_LOCK_MAIN)) { + locks |= ERTS_PROC_LOCK_MAIN; + if (ERTS_IS_CRASH_DUMPING && running) { + if (erts_proc_trylock(p, locks)) { + /* crash dumping and main lock taken, this probably means that + the process is doing a GC on a dirty-scheduler... so we cannot + do erts_proc_sig_fetch as that would potentially cause a segfault */ + locks = 0; + } + } else { + erts_proc_lock(p, locks); + } + } else { + ERTS_ASSERT(locks == ERTS_PROC_LOCK_MAIN && "Only main lock should be held"); + } + /* * If the process is registered as a global process, display the * registered name @@ -252,13 +269,19 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p) erts_print(to, to_arg, "Spawned by: %T\n", p->parent); - erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ); - len = erts_proc_sig_fetch(p); - erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); + if (locks & ERTS_PROC_LOCK_MAIN) { + erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ); + len = erts_proc_sig_fetch(p); + erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); + } else { + len = p->sig_qs.len; + } erts_print(to, to_arg, "Message queue length: %d\n", len); - /* display the message queue only if there is anything in it */ - if (!ERTS_IS_CRASH_DUMPING && p->sig_qs.first != NULL && !garbing) { + /* display the message queue only if there is anything in it + and we can do it safely */ + if (!ERTS_IS_CRASH_DUMPING && p->sig_qs.first != NULL && !garbing + && (locks & ERTS_PROC_LOCK_MAIN)) { erts_print(to, to_arg, "Message queue: ["); ERTS_FOREACH_SIG_PRIVQS( p, mp, @@ -358,6 +381,8 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p) /* Display all states */ erts_print(to, to_arg, "Internal State: "); erts_dump_extended_process_state(to, to_arg, state); + + erts_proc_unlock(p, locks & ~orig_locks); } static void diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 3b0f0d33fa..8fb8bd2831 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3137,6 +3137,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) DECL_AM(tag); BIF_RET(AM_tag); #endif + } else if (ERTS_IS_ATOM_STR("system_logger", BIF_ARG_1)) { + BIF_RET(erts_get_system_logger()); } BIF_ERROR(BIF_P, BADARG); @@ -4606,6 +4608,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } } else if (ERTS_IS_ATOM_STR("broken_halt", BIF_ARG_1)) { + erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); broken_halt_test(BIF_ARG_2); } else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) { diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 7fe4e02782..ed825d3dda 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -891,10 +891,6 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) driver = &spawn_driver; } else if (*tp == am_fd) { /* An fd port */ - int n; - struct Sint_buf sbuf; - char* p; - if (arity != make_arityval(3)) { goto badarg; } @@ -904,15 +900,9 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) opts.ifd = unsigned_val(tp[1]); opts.ofd = unsigned_val(tp[2]); - /* Syntesize name from input and output descriptor. */ - name_buf = erts_alloc(ERTS_ALC_T_TMP, - 2*sizeof(struct Sint_buf) + 2); - p = Sint_to_buf(opts.ifd, &sbuf); - n = sys_strlen(p); - sys_strncpy(name_buf, p, n); - name_buf[n] = '/'; - p = Sint_to_buf(opts.ofd, &sbuf); - sys_strcpy(name_buf+n+1, p); + /* Syntesize name from input and output descriptor. */ + name_buf = erts_alloc(ERTS_ALC_T_TMP, 256); + erts_snprintf(name_buf, 256, "%i/%i", opts.ifd, opts.ofd); driver = &fd_driver; } else { diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 957762d4b0..ec7442aeeb 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2491,7 +2491,7 @@ restart: case matchProcessDump: { erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); ASSERT(c_p == self); - print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p); + print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p, ERTS_PROC_LOCK_MAIN); *esp++ = new_binary(build_proc, (byte *)dsbufp->str, dsbufp->str_len); erts_destroy_tmp_dsbuf(dsbufp); diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index 9ef7c39d41..a5ecbfff06 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -54,7 +54,8 @@ enum ErlNifSelectFlags { ERL_NIF_SELECT_READ = (1 << 0), ERL_NIF_SELECT_WRITE = (1 << 1), ERL_NIF_SELECT_STOP = (1 << 2), - ERL_NIF_SELECT_CANCEL = (1 << 3) + ERL_NIF_SELECT_CANCEL = (1 << 3), + ERL_NIF_SELECT_CUSTOM_MSG= (1 << 4) }; /* diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 2b19d2cfd3..c0a86ea738 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -376,6 +376,28 @@ erl_init(int ncpu, } static Eterm + +erl_spawn_system_process(Process* parent, Eterm mod, Eterm func, Eterm args, + ErlSpawnOpts *so) +{ + Eterm res; + int arity; + + ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(parent)); + arity = erts_list_length(args); + + if (erts_find_function(mod, func, arity, erts_active_code_ix()) == NULL) { + erts_exit(ERTS_ERROR_EXIT, "No function %T:%T/%i\n", mod, func, arity); + } + + so->flags |= SPO_SYSTEM_PROC; + + res = erl_create_process(parent, mod, func, args, so); + + return res; +} + +static Eterm erl_first_process_otp(char* mod_name, int argc, char** argv) { int i; @@ -386,17 +408,13 @@ erl_first_process_otp(char* mod_name, int argc, char** argv) ErlSpawnOpts so; Eterm boot_mod; - if (erts_find_function(am_erl_init, am_start, 2, - erts_active_code_ix()) == NULL) { - erts_exit(ERTS_ERROR_EXIT, "No function erl_init:start/2\n"); - } - /* * We need a dummy parent process to be able to call erl_create_process(). */ erts_init_empty_process(&parent); erts_proc_lock(&parent, ERTS_PROC_LOCK_MAIN); + hp = HAlloc(&parent, argc*2 + 4); args = NIL; for (i = argc-1; i >= 0; i--) { @@ -404,49 +422,76 @@ erl_first_process_otp(char* mod_name, int argc, char** argv) args = CONS(hp, new_binary(&parent, (byte*)argv[i], len), args); hp += 2; } - boot_mod = erts_atom_put((byte *) mod_name, sys_strlen(mod_name), ERTS_ATOM_ENC_LATIN1, 1); + boot_mod = erts_atom_put((byte *) mod_name, sys_strlen(mod_name), + ERTS_ATOM_ENC_LATIN1, 1); args = CONS(hp, args, NIL); hp += 2; args = CONS(hp, boot_mod, args); - so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC; - res = erl_create_process(&parent, am_erl_init, am_start, args, &so); + so.flags = erts_default_spo_flags; + res = erl_spawn_system_process(&parent, am_erl_init, am_start, args, &so); + ASSERT(is_internal_pid(res)); + erts_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN); erts_cleanup_empty_process(&parent); + return res; } static Eterm erl_system_process_otp(Eterm parent_pid, char* modname, int off_heap_msgq, int prio) -{ - Eterm start_mod; - Process* parent; +{ + Process *parent; ErlSpawnOpts so; - Eterm res; - - start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1); - if (erts_find_function(start_mod, am_start, 0, - erts_active_code_ix()) == NULL) { - erts_exit(ERTS_ERROR_EXIT, "No function %s:start/0\n", modname); - } + Eterm mod, res; parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN); + mod = erts_atom_put((byte *) modname, sys_strlen(modname), + ERTS_ATOM_ENC_LATIN1, 1); + + so.flags = erts_default_spo_flags|SPO_USE_ARGS; - so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC|SPO_USE_ARGS; - if (off_heap_msgq) + if (off_heap_msgq) { so.flags |= SPO_OFF_HEAP_MSGQ; - so.min_heap_size = H_MIN_SIZE; - so.min_vheap_size = BIN_VH_MIN_SIZE; - so.max_heap_size = H_MAX_SIZE; - so.max_heap_flags = H_MAX_FLAGS; - so.priority = prio; - so.max_gen_gcs = (Uint16) erts_atomic32_read_nob(&erts_max_gen_gcs); - so.scheduler = 0; - res = erl_create_process(parent, start_mod, am_start, NIL, &so); + } + + so.min_heap_size = H_MIN_SIZE; + so.min_vheap_size = BIN_VH_MIN_SIZE; + so.max_heap_size = H_MAX_SIZE; + so.max_heap_flags = H_MAX_FLAGS; + so.priority = prio; + so.max_gen_gcs = (Uint16) erts_atomic32_read_nob(&erts_max_gen_gcs); + so.scheduler = 0; + + res = erl_spawn_system_process(parent, mod, am_start, NIL, &so); + ASSERT(is_internal_pid(res)); + erts_proc_unlock(parent, ERTS_PROC_LOCK_MAIN); + return res; } +Eterm erts_internal_spawn_system_process_3(BIF_ALIST_3) { + Eterm mod, func, args, res; + ErlSpawnOpts so; + + mod = BIF_ARG_1; + func = BIF_ARG_2; + args = BIF_ARG_3; + + ASSERT(is_atom(mod)); + ASSERT(is_atom(func)); + ASSERT(erts_list_length(args) >= 0); + + so.flags = erts_default_spo_flags; + res = erl_spawn_system_process(BIF_P, mod, func, args, &so); + + if (is_non_value(res)) { + BIF_ERROR(BIF_P, so.error_code); + } + + BIF_RET(res); +} Eterm erts_preloaded(Process* p) diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index a3274d7443..942bec84cf 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -532,9 +532,7 @@ erts_try_alloc_message_on_heap(Process *pp, if ((*psp) & ERTS_PSFLGS_VOLATILE_HEAP) goto in_message_fragment; - else if ( - *plp & ERTS_PROC_LOCK_MAIN - ) { + else if (*plp & ERTS_PROC_LOCK_MAIN) { try_on_heap: if (((*psp) & ERTS_PSFLGS_VOLATILE_HEAP) || (pp->flags & F_DISABLE_GC) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 7339aa8874..a48d0391f6 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -707,6 +707,29 @@ error: return reds; } +/** @brief Create a message with the content of process independent \c msg_env. + * Invalidates \c msg_env. + */ +ErtsMessage* erts_create_message_from_nif_env(ErlNifEnv* msg_env) +{ + struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)msg_env; + ErtsMessage* mp; + + flush_env(msg_env); + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = menv->env.heap_frag; + ASSERT(mp->data.heap_frag == MBUF(&menv->phony_proc)); + if (mp->data.heap_frag != NULL) { + /* Move all offheap's from phony proc to the first fragment. + Quick and dirty... */ + ASSERT(!is_offheap(&mp->data.heap_frag->off_heap)); + mp->data.heap_frag->off_heap = MSO(&menv->phony_proc); + clear_offheap(&MSO(&menv->phony_proc)); + menv->env.heap_frag = NULL; + MBUF(&menv->phony_proc) = NULL; + } + return mp; +} int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg) @@ -803,20 +826,8 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, } #endif } - flush_env(msg_env); - mp = erts_alloc_message(0, NULL); + mp = erts_create_message_from_nif_env(msg_env); ERL_MESSAGE_TOKEN(mp) = token; - mp->data.heap_frag = menv->env.heap_frag; - ASSERT(mp->data.heap_frag == MBUF(&menv->phony_proc)); - if (mp->data.heap_frag != NULL) { - /* Move all offheap's from phony proc to the first fragment. - Quick and dirty... */ - ASSERT(!is_offheap(&mp->data.heap_frag->off_heap)); - mp->data.heap_frag->off_heap = MSO(&menv->phony_proc); - clear_offheap(&MSO(&menv->phony_proc)); - menv->env.heap_frag = NULL; - MBUF(&menv->phony_proc) = NULL; - } } else { erts_literal_area_t litarea; ErlOffHeap *ohp; diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 58a217c20b..3fd1a8fd4c 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -54,7 +54,7 @@ ** 2.13: 20.1 add enif_ioq ** 2.14: 21.0 add enif_ioq_peek_head, enif_(mutex|cond|rwlock|thread)_name ** enif_vfprintf, enif_vsnprintf, enif_make_map_from_arrays -** 2.15: 22.0 ERL_NIF_SELECT_CANCEL +** 2.15: 22.0 ERL_NIF_SELECT_CANCEL, enif_select_(read|write) */ #define ERL_NIF_MAJOR_VERSION 2 #define ERL_NIF_MINOR_VERSION 15 diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 81f64f2390..129166562d 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -210,6 +210,9 @@ ERL_NIF_API_FUNC_DECL(int,enif_vsnprintf,(char*, size_t, const char *fmt, va_lis ERL_NIF_API_FUNC_DECL(int,enif_make_map_from_arrays,(ErlNifEnv *env, ERL_NIF_TERM keys[], ERL_NIF_TERM values[], size_t cnt, ERL_NIF_TERM *map_out)); +ERL_NIF_API_FUNC_DECL(int,enif_select_x,(ErlNifEnv* env, ErlNifEvent e, enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, ERL_NIF_TERM msg, ErlNifEnv* msg_env)); + + /* ** ADD NEW ENTRIES HERE (before this comment) !!! */ @@ -392,6 +395,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_make_map_from_arrays,(ErlNifEnv *env, ERL_NIF_TER # define enif_vfprintf ERL_NIF_API_FUNC_MACRO(enif_vfprintf) # define enif_vsnprintf ERL_NIF_API_FUNC_MACRO(enif_vsnprintf) # define enif_make_map_from_arrays ERL_NIF_API_FUNC_MACRO(enif_make_map_from_arrays) +# define enif_select_x ERL_NIF_API_FUNC_MACRO(enif_select_x) /* ** ADD NEW ENTRIES HERE (before this comment) @@ -623,6 +627,12 @@ static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, #ifndef enif_make_pid # define enif_make_pid(ENV, PID) ((void)(ENV),(const ERL_NIF_TERM)((PID)->pid)) +# define enif_select_read(ENV, E, OBJ, PID, MSG, MSG_ENV) \ + enif_select_x(ENV, E, ERL_NIF_SELECT_READ | ERL_NIF_SELECT_CUSTOM_MSG, \ + OBJ, PID, MSG, MSG_ENV) +# define enif_select_write(ENV, E, OBJ, PID, MSG, MSG_ENV) \ + enif_select_x(ENV, E, ERL_NIF_SELECT_WRITE | ERL_NIF_SELECT_CUSTOM_MSG, \ + OBJ, PID, MSG, MSG_ENV) #if SIZEOF_LONG == 8 # define enif_get_int64 enif_get_long diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 990a01b96f..9cfb7fc681 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -364,13 +364,13 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { int print_res; char def_buf[64]; char *buf, *big_str; - Uint sz = (Uint) big_decimal_estimate(wobj); + Uint sz = (Uint) big_integer_estimate(wobj, 10); sz++; if (sz <= 64) buf = &def_buf[0]; else buf = erts_alloc(ERTS_ALC_T_TMP, sz); - big_str = erts_big_to_string(wobj, buf, sz); + big_str = erts_big_to_string(wobj, 10, buf, sz); print_res = erts_printf_string(fn, arg, big_str); if (buf != &def_buf[0]) erts_free(ERTS_ALC_T_TMP, (void *) buf); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index a24f4bc193..68d99e8e78 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -92,10 +92,6 @@ #undef HARDDEBUG #endif -#ifdef HARDDEBUG -#define HARDDEBUG_RUNQS -#endif - #ifdef HIPE #include "hipe_mode_switch.h" /* for hipe_init_process() */ #include "hipe_signal.h" /* for hipe_thread_signal_init() */ @@ -3300,6 +3296,46 @@ check_io_timer(void *null) #define prepare_for_sys_schedule() 0 #endif +#ifdef HARDDEBUG +#define ERTS_HDBG_CHK_SLEEP_LIST(SL, L, F, FN) \ + check_sleepers_list((SL), (L), (F), (FN)) +static void check_sleepers_list(ErtsSchedulerSleepList *sl, + int lock, + ErtsSchedulerSleepInfo *find, + ErtsSchedulerSleepInfo *find_not) +{ + ErtsSchedulerSleepInfo *last_out; + int found = 0; + + if (lock) + erts_spin_lock(&sl->lock); + + ERTS_ASSERT(!find_not || (!find_not->next && !find_not->prev)); + + last_out = sl->list; + if (last_out) { + ErtsSchedulerSleepInfo *tmp = last_out; + do { + ERTS_ASSERT(tmp->next); + ERTS_ASSERT(tmp->prev); + ERTS_ASSERT(tmp->next->prev == tmp); + ERTS_ASSERT(tmp->prev->next == tmp); + ERTS_ASSERT(tmp != find_not); + if (tmp == find) + found = !0; + tmp = tmp->next; + + } while (tmp != last_out); + } + ERTS_ASSERT(!find || found); + + if (lock) + erts_spin_unlock(&sl->lock); +} +#else +#define ERTS_HDBG_CHK_SLEEP_LIST(SL, L, F, FN) ((void) 0) +#endif + static void scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) { @@ -3313,23 +3349,29 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq)); - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - erts_spin_lock(&rq->sleepers.lock); flgs = sched_prep_spin_wait(ssi); if (flgs & ERTS_SSI_FLG_SUSPENDED) { /* Go suspend instead... */ - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - erts_spin_unlock(&rq->sleepers.lock); return; } if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { - ssi->prev = NULL; - ssi->next = rq->sleepers.list; - if (rq->sleepers.list) - rq->sleepers.list->prev = ssi; - rq->sleepers.list = ssi; - erts_spin_unlock(&rq->sleepers.lock); + erts_spin_lock(&rq->sleepers.lock); + ERTS_HDBG_CHK_SLEEP_LIST(&rq->sleepers, 0, NULL, ssi); + ASSERT(!ssi->next); /* Not in sleepers list */ + ASSERT(!ssi->prev); + if (!rq->sleepers.list) { + ssi->next = ssi->prev = ssi; + rq->sleepers.list = ssi; + } + else { + ssi->prev = rq->sleepers.list; + ssi->next = rq->sleepers.list->next; + ssi->prev->next = ssi; + ssi->next->prev = ssi; + } + ERTS_HDBG_CHK_SLEEP_LIST(&rq->sleepers, 0, ssi, NULL); + erts_spin_unlock(&rq->sleepers.lock); dirty_active(esdp, -1); } @@ -3473,8 +3515,28 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) (ERTS_SSI_FLG_SUSPENDED | ERTS_SSI_FLG_MSB_EXEC)); - if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { dirty_sched_wall_time_change(esdp, working = 1); + erts_spin_lock(&rq->sleepers.lock); + ERTS_HDBG_CHK_SLEEP_LIST(&rq->sleepers, 0, ssi->next ? ssi : NULL, NULL); + if (ssi->next) { /* Still in list... */ + if (ssi->next == ssi) { + ASSERT(rq->sleepers.list == ssi); + ASSERT(ssi->prev == ssi); + rq->sleepers.list = NULL; + } + else { + ASSERT(ssi->prev != ssi); + if (rq->sleepers.list == ssi) + rq->sleepers.list = ssi->next; + ssi->prev->next = ssi->next; + ssi->next->prev = ssi->prev; + } + ssi->next = ssi->prev = NULL; + } + ERTS_HDBG_CHK_SLEEP_LIST(&rq->sleepers, 0, NULL, ssi); + erts_spin_unlock(&rq->sleepers.lock); + } else if (!thr_prgr_active) { erts_thr_progress_active(erts_thr_prgr_data(esdp), thr_prgr_active = 1); sched_wall_time_change(esdp, 1); @@ -3562,56 +3624,44 @@ wake_scheduler(ErtsRunQueue *rq) } static void -wake_dirty_schedulers(ErtsRunQueue *rq, int one) +wake_dirty_scheduler(ErtsRunQueue *rq) { - ErtsSchedulerSleepInfo *ssi; + ErtsSchedulerSleepInfo *lo_ssi, *fo_ssi; ErtsSchedulerSleepList *sl; ASSERT(ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); sl = &rq->sleepers; erts_spin_lock(&sl->lock); - ssi = sl->list; - if (!ssi) { + ERTS_HDBG_CHK_SLEEP_LIST(&rq->sleepers, 0, NULL, NULL); + lo_ssi = sl->list; + if (!lo_ssi) { erts_spin_unlock(&sl->lock); - if (one) - wake_scheduler(rq); - } else if (one) { + wake_scheduler(rq); + } + else { erts_aint32_t flgs; - if (ssi->prev) - ssi->prev->next = ssi->next; - else { - ASSERT(sl->list == ssi); - sl->list = ssi->next; + fo_ssi = lo_ssi->next; + ASSERT(fo_ssi->prev == lo_ssi); + if (fo_ssi == lo_ssi) { + ASSERT(lo_ssi->prev == lo_ssi); + sl->list = NULL; + } + else { + ASSERT(lo_ssi->prev != lo_ssi); + lo_ssi->next = fo_ssi->next; + fo_ssi->next->prev = fo_ssi->prev; } - if (ssi->next) - ssi->next->prev = ssi->prev; - - erts_spin_unlock(&sl->lock); - - ERTS_THR_MEMORY_BARRIER; - flgs = ssi_flags_set_wake(ssi); - erts_sched_finish_poke(ssi, flgs); - } else { - sl->list = NULL; + fo_ssi->next = fo_ssi->prev = NULL; + ERTS_HDBG_CHK_SLEEP_LIST(&rq->sleepers, 0, NULL, fo_ssi); erts_spin_unlock(&sl->lock); ERTS_THR_MEMORY_BARRIER; - do { - ErtsSchedulerSleepInfo *wake_ssi = ssi; - ssi = ssi->next; - erts_sched_finish_poke(wake_ssi, ssi_flags_set_wake(wake_ssi)); - } while (ssi); + flgs = ssi_flags_set_wake(fo_ssi); + erts_sched_finish_poke(fo_ssi, flgs); } } -static void -wake_dirty_scheduler(ErtsRunQueue *rq) -{ - wake_dirty_schedulers(rq, 1); -} - - #define ERTS_NO_USED_RUNQS_SHIFT 16 #define ERTS_NO_RUNQS_MASK 0xffffU @@ -5984,6 +6034,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online, int no_poll_th for (ix = 0; ix < no_dirty_cpu_schedulers; ix++) { ErtsSchedulerSleepInfo *ssi = &aligned_dirty_cpu_sched_sleep_info[ix].ssi; erts_atomic32_init_nob(&ssi->flags, 0); + ssi->next = NULL; + ssi->prev = NULL; ssi->event = NULL; /* initialized in sched_dirty_cpu_thread_func */ erts_atomic32_init_nob(&ssi->aux_work, 0); } @@ -5994,6 +6046,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online, int no_poll_th for (ix = 0; ix < no_dirty_io_schedulers; ix++) { ErtsSchedulerSleepInfo *ssi = &aligned_dirty_io_sched_sleep_info[ix].ssi; erts_atomic32_init_nob(&ssi->flags, 0); + ssi->next = NULL; + ssi->prev = NULL; ssi->event = NULL; /* initialized in sched_dirty_io_thread_func */ erts_atomic32_init_nob(&ssi->aux_work, 0); } @@ -7503,7 +7557,13 @@ suspend_scheduler(ErtsSchedulerData *esdp) return; } +#ifdef HARDDEBUG + if (sched_type != ERTS_SCHED_NORMAL) + ERTS_HDBG_CHK_SLEEP_LIST(&esdp->run_queue->sleepers, !0, NULL, ssi); +#endif + if (erts_atomic32_read_nob(&ssi->flags) & ERTS_SSI_FLG_MSB_EXEC) { + ASSERT(no == 1); if (!msb_scheduler_type_switch(sched_type, esdp, no)) return; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index a1b029adbe..0aa19e7bde 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -359,7 +359,7 @@ typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo; typedef struct { erts_spinlock_t lock; - ErtsSchedulerSleepInfo *list; + ErtsSchedulerSleepInfo *list; /* circular lifo list; points to last out */ } ErtsSchedulerSleepList; struct ErtsSchedulerSleepInfo_ { diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 2350d4c02f..701fb38147 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -72,6 +72,7 @@ static ErtsTracer default_port_tracer; static Eterm system_monitor; static Eterm system_profile; +static erts_aint_t system_logger; #ifdef HAVE_ERTS_NOW_CPU int erts_cpu_timestamp; @@ -340,6 +341,7 @@ void erts_init_trace(void) { default_port_trace_flags = F_INITIAL_TRACE_FLAGS; default_port_tracer = erts_tracer_nil; system_seq_tracer = erts_tracer_nil; + erts_atomic_init_nob(&system_logger, am_logger); init_sys_msg_dispatcher(); init_tracer_nif(); } @@ -2027,10 +2029,24 @@ enqueue_sys_msg(enum ErtsSysMsgType type, erts_mtx_unlock(&smq_mtx); } +Eterm +erts_get_system_logger(void) +{ + return (Eterm)erts_atomic_read_nob(&system_logger); +} + +Eterm +erts_set_system_logger(Eterm logger) +{ + if (logger != am_logger && logger != am_undefined && !is_internal_pid(logger)) + return THE_NON_VALUE; + return (Eterm)erts_atomic_xchg_nob(&system_logger, logger); +} + void erts_queue_error_logger_message(Eterm from, Eterm msg, ErlHeapFragment *bp) { - enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, am_logger, msg, bp); + enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, erts_get_system_logger(), msg, bp); } void @@ -2271,7 +2287,7 @@ sys_msg_dispatcher_func(void *unused) } break; case SYS_MSG_TYPE_ERRLGR: - receiver = am_logger; + receiver = smqp->to; break; default: receiver = NIL; @@ -2285,8 +2301,15 @@ sys_msg_dispatcher_func(void *unused) if (is_internal_pid(receiver)) { proc = erts_pid2proc(NULL, 0, receiver, proc_locks); if (!proc) { - /* Bad tracer */ - goto failure; + if (smqp->type == SYS_MSG_TYPE_ERRLGR) { + /* Bad logger process, send to kernel 'logger' process */ + erts_set_system_logger(am_logger); + receiver = erts_get_system_logger(); + goto logger; + } else { + /* Bad tracer */ + goto failure; + } } else { ErtsMessage *mp; @@ -2299,9 +2322,9 @@ sys_msg_dispatcher_func(void *unused) #endif erts_proc_unlock(proc, proc_locks); } - } - else if (receiver == am_logger) { - proc = erts_whereis_process(NULL,0,receiver,proc_locks,0); + } else if (receiver == am_logger) { + logger: + proc = erts_whereis_process(NULL,0,am_logger,proc_locks,0); if (!proc) goto failure; else if (smqp->from == proc->common.id) @@ -2309,7 +2332,10 @@ sys_msg_dispatcher_func(void *unused) else goto queue_proc_msg; } - else if (is_internal_port(receiver)) { + else if (receiver == am_undefined) { + goto drop_sys_msg; + } + else if (is_internal_port(receiver)) { port = erts_thr_id2port_sflgs(receiver, ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); if (!port) @@ -2366,7 +2392,7 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm, to = erts_get_system_profile(); break; case SYS_MSG_TYPE_ERRLGR: - to = am_logger; + to = erts_get_system_logger(); break; default: to = NIL; diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index bccf31606e..b7844d1cb0 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -94,6 +94,8 @@ void erts_foreach_sys_msg_in_q(void (*func)(Eterm, Eterm, Eterm, ErlHeapFragment *)); +Eterm erts_set_system_logger(Eterm); +Eterm erts_get_system_logger(void); void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *); void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 77b5a3ca05..29de162b42 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -131,6 +131,7 @@ extern Eterm erts_nif_call_function(Process *p, Process *tracee, int erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg); +ErtsMessage* erts_create_message_from_nif_env(ErlNifEnv* msg_env); /* Driver handle (wrapper for old plain handle) */ @@ -966,7 +967,7 @@ void init_break_handler(void); void erts_set_ignore_break(void); void erts_replace_intr(void); void process_info(fmtfn_t, void *); -void print_process_info(fmtfn_t, void *, Process*); +void print_process_info(fmtfn_t, void *, Process*, ErtsProcLocks); void info(fmtfn_t, void *); void loaded(fmtfn_t, void *); void erts_print_base64(fmtfn_t to, void *to_arg, byte* src, Uint size); @@ -1307,14 +1308,7 @@ Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */ int erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written); Sint erts_unicode_list_to_buf_len(Eterm list); -struct Sint_buf { -#if defined(ARCH_64) - char s[22]; -#else - char s[12]; -#endif -}; -char* Sint_to_buf(Sint, struct Sint_buf*); +int Sint_to_buf(Sint num, int base, char **buf_p, size_t buf_size); #define ERTS_IOLIST_STATE_INITER(C_P, OBJ) \ {(C_P), 0, 0, (OBJ), {NULL, NULL, NULL, ERTS_ALC_T_INVALID}, 0, 0} diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index cb414143fc..ee99c9e563 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1002,11 +1002,11 @@ bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst) bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst) -bif1 p Bif S1 Dst => i_bif1_body Bif S1 Dst -bif1 Fail=f Bif S1 Dst => i_bif1 Fail Bif S1 Dst +bif1 p Bif S1 Dst => i_bif1_body S1 Bif Dst +bif1 Fail=f Bif S1 Dst => i_bif1 S1 Fail Bif Dst -bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst -bif2 Fail=f Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst +bif2 p Bif S1 S2 Dst => i_bif2_body S2 S1 Bif Dst +bif2 Fail=f Bif S1 S2 Dst => i_bif2 S2 S1 Fail Bif Dst i_get_hash c I d i_get s d @@ -1024,12 +1024,12 @@ i_fast_element xy j? I d i_element xy j? s d -i_bif1 f? b s d -i_bif1_body b s d -i_bif2 f? b s s d -i_bif2_body b s s d -i_bif3 f? b s s s d -i_bif3_body b s s s d +i_bif1 s f? b d +i_bif1_body s b d +i_bif2 s s f? b d +i_bif2_body s s b d +i_bif3 s s s f? b d +i_bif3_body s s s b d # # Internal calls. @@ -1601,14 +1601,14 @@ i_length j? t d # # Guard BIFs. # -gc_bif1 p Live Bif Src Dst => i_bif1_body Bif Src Dst -gc_bif1 Fail=f Live Bif Src Dst => i_bif1 Fail Bif Src Dst +gc_bif1 p Live Bif Src Dst => i_bif1_body Src Bif Dst +gc_bif1 Fail=f Live Bif Src Dst => i_bif1 Src Fail Bif Dst -gc_bif2 p Live Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst -gc_bif2 Fail=f Live Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst +gc_bif2 p Live Bif S1 S2 Dst => i_bif2_body S2 S1 Bif Dst +gc_bif2 Fail=f Live Bif S1 S2 Dst => i_bif2 S2 S1 Fail Bif Dst -gc_bif3 p Live Bif S1 S2 S3 Dst => i_bif3_body Bif S1 S2 S3 Dst -gc_bif3 Fail=f Live Bif S1 S2 S3 Dst => i_bif3 Fail Bif S1 S2 S3 Dst +gc_bif3 p Live Bif S1 S2 S3 Dst => i_bif3_body S3 S2 S1 Bif Dst +gc_bif3 Fail=f Live Bif S1 S2 S3 Dst => i_bif3 S3 S2 S1 Fail Bif Dst # # The following instruction is specially handled in beam_load.c diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index f70f5e73d4..1e7b494a91 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -3681,30 +3681,47 @@ erts_unicode_list_to_buf_len(Eterm list) } } -/* -** Convert an integer to a byte list -** return pointer to converted stuff (need not to be at start of buf!) -*/ -char* Sint_to_buf(Sint n, struct Sint_buf *buf) +/* Prints an integer in the given base, returning the number of digits printed. + * + * (*buf) is a pointer to the buffer, and is set to the start of the string + * when returning. */ +int Sint_to_buf(Sint n, int base, char **buf, size_t buf_size) { - char* p = &buf->s[sizeof(buf->s)-1]; - int sign = 0; - - *p-- = '\0'; /* null terminate */ - if (n == 0) - *p-- = '0'; - else if (n < 0) { - sign = 1; - n = -n; + char *p = &(*buf)[buf_size - 1]; + int sign = 0, size = 0; + + ASSERT(base >= 2 && base <= 36); + + if (n == 0) { + *p-- = '0'; + size++; + } else if (n < 0) { + sign = 1; + n = -n; } while (n != 0) { - *p-- = (n % 10) + '0'; - n /= 10; + int digit = n % base; + + if (digit < 10) { + *p-- = '0' + digit; + } else { + *p-- = 'A' + (digit - 10); + } + + size++; + + n /= base; } - if (sign) - *p-- = '-'; - return p+1; + + if (sign) { + *p-- = '-'; + size++; + } + + *buf = p + 1; + + return size; } /* Build a list of integers in some safe memory area @@ -4771,58 +4788,3 @@ erts_ptr_id(void *ptr) return ptr; } -#ifdef DEBUG -/* - * Handy functions when using a debugger - don't use in the code! - */ - -void upp(byte *buf, size_t sz) -{ - bin_write(ERTS_PRINT_STDERR, NULL, buf, sz); -} - -void pat(Eterm atom) -{ - upp(atom_tab(atom_val(atom))->name, - atom_tab(atom_val(atom))->len); -} - - -void pinfo() -{ - process_info(ERTS_PRINT_STDOUT, NULL); -} - - -void pp(p) -Process *p; -{ - if(p) - print_process_info(ERTS_PRINT_STDERR, NULL, p); -} - -void ppi(Eterm pid) -{ - pp(erts_proc_lookup(pid)); -} - -void td(Eterm x) -{ - erts_fprintf(stderr, "%T\n", x); -} - -void -ps(Process* p, Eterm* stop) -{ - Eterm* sp = STACK_START(p) - 1; - - if (stop <= STACK_END(p)) { - stop = STACK_END(p) + 1; - } - - while(sp >= stop) { - erts_printf("%p: %.75T\n", sp, *sp); - sp--; - } -} -#endif diff --git a/erts/emulator/nifs/common/prim_file_nif.c b/erts/emulator/nifs/common/prim_file_nif.c index eed2ff8e1b..3df04e42e2 100644 --- a/erts/emulator/nifs/common/prim_file_nif.c +++ b/erts/emulator/nifs/common/prim_file_nif.c @@ -38,7 +38,6 @@ static void unload(ErlNifEnv *env, void* priv_data); static ErlNifResourceType *efile_resource_type; -static ERL_NIF_TERM am_erts_prim_file; static ERL_NIF_TERM am_close; static ERL_NIF_TERM am_ok; @@ -220,7 +219,6 @@ static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM prim_file_pid) ASSERT(!"bad pid passed to prim_file_nif"); } - am_erts_prim_file = enif_make_atom(env, "erts_prim_file"); am_close = enif_make_atom(env, "close"); am_ok = enif_make_atom(env, "ok"); diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index b4609007c9..304e0a5d0c 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -591,6 +591,96 @@ abort_tasks(ErtsDrvEventState *state, int mode) } } +static void prepare_select_msg(struct erts_nif_select_event* e, + enum ErlNifSelectFlags mode, + Eterm recipient, + ErtsResource* resource, + Eterm msg, + ErlNifEnv* msg_env, + Eterm event_atom) +{ + ErtsMessage* mp; + Eterm* hp; + Uint hsz; + + if (is_not_nil(e->pid)) { + ASSERT(e->mp); + erts_cleanup_messages(e->mp); + } + + if (mode & ERL_NIF_SELECT_CUSTOM_MSG) { + if (msg_env) { + mp = erts_create_message_from_nif_env(msg_env); + ERL_MESSAGE_TERM(mp) = msg; + } + else { + hsz = size_object(msg); + mp = erts_alloc_message(hsz, &hp); + ERL_MESSAGE_TERM(mp) = copy_struct(msg, hsz, &hp, &mp->hfrag.off_heap); + } + } + else { + ErtsBinary* bin; + Eterm resource_term, ref_term, tuple; + Eterm* hp_start; + + /* {select, Resource, Ref, EventAtom} */ + hsz = 5 + ERTS_MAGIC_REF_THING_SIZE; + if (is_internal_ref(msg)) + hsz += ERTS_REF_THING_SIZE; + else + ASSERT(is_immed(msg)); + + mp = erts_alloc_message(hsz, &hp); + hp_start = hp; + + bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource); + resource_term = erts_mk_magic_ref(&hp, &mp->hfrag.off_heap, &bin->binary); + if (is_internal_ref(msg)) { + Uint32* refn = internal_ref_numbers(msg); + write_ref_thing(hp, refn[0], refn[1], refn[2]); + ref_term = make_internal_ref(hp); + hp += ERTS_REF_THING_SIZE; + } + else { + ASSERT(is_immed(msg)); + ref_term = msg; + } + tuple = TUPLE4(hp, am_select, resource_term, ref_term, event_atom); + hp += 5; + ERL_MESSAGE_TERM(mp) = tuple; + ASSERT(hp == hp_start + hsz); (void)hp_start; + } + + ASSERT(is_not_nil(recipient)); + e->pid = recipient; + e->mp = mp; +} + +static ERTS_INLINE void send_select_msg(struct erts_nif_select_event* e) +{ + Process* rp = erts_proc_lookup(e->pid); + + ASSERT(is_internal_pid(e->pid)); + if (!rp) { + erts_cleanup_messages(e->mp); + return; + } + + erts_queue_message(rp, 0, e->mp, ERL_MESSAGE_TERM(e->mp), am_system); +} + +static void clear_select_event(struct erts_nif_select_event* e) +{ + if (is_not_nil(e->pid)) { + /* Discard unsent message */ + ASSERT(e->mp); + erts_cleanup_messages(e->mp); + e->mp = NULL; + e->pid = NIL; + } +} + static void deselect(ErtsDrvEventState *state, int mode) { @@ -621,8 +711,8 @@ deselect(ErtsDrvEventState *state, int mode) erts_io_control(state, ERTS_POLL_OP_DEL, 0); switch (state->type) { case ERTS_EV_TYPE_NIF: - state->driver.nif->in.pid = NIL; - state->driver.nif->out.pid = NIL; + clear_select_event(&state->driver.nif->in); + clear_select_event(&state->driver.nif->out); enif_release_resource(state->driver.stop.resource->data); state->driver.stop.resource = NULL; break; @@ -943,12 +1033,21 @@ done_unknown: } int -enif_select(ErlNifEnv* env, - ErlNifEvent e, - enum ErlNifSelectFlags mode, - void* obj, - const ErlNifPid* pid, - Eterm ref) +enif_select(ErlNifEnv* env, ErlNifEvent e, enum ErlNifSelectFlags mode, + void* obj, const ErlNifPid* pid, Eterm msg) +{ + return enif_select_x(env, e, mode, obj, pid, msg, NULL); +} + + +int +enif_select_x(ErlNifEnv* env, + ErlNifEvent e, + enum ErlNifSelectFlags mode, + void* obj, + const ErlNifPid* pid, + Eterm msg, + ErlNifEnv* msg_env) { int on; ErtsResource* resource = DATA_TO_RESOURCE(obj); @@ -966,7 +1065,7 @@ enif_select(ErlNifEnv* env, #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if (!grow_drv_ev_state(fd)) { - if (fd > 0) nif_select_large_fd_error(fd, mode, resource, ref); + if (fd > 0) nif_select_large_fd_error(fd, mode, resource, msg); return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT; } #endif @@ -1012,21 +1111,21 @@ enif_select(ErlNifEnv* env, * Changing process and/or ref is ok (I think?). */ if (state->driver.stop.resource != resource) - nif_select_steal(state, ERL_DRV_READ | ERL_DRV_WRITE, resource, ref); + nif_select_steal(state, ERL_DRV_READ | ERL_DRV_WRITE, resource, msg); break; case ERTS_EV_TYPE_DRV_SEL: - nif_select_steal(state, mode, resource, ref); + nif_select_steal(state, mode, resource, msg); break; case ERTS_EV_TYPE_STOP_USE: { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - print_nif_select_op(dsbufp, fd, mode, resource, ref); + print_nif_select_op(dsbufp, fd, mode, resource, msg); steal_pending_stop_use(dsbufp, ERTS_INVALID_ERL_DRV_PORT, state, mode, on); ASSERT(state->type == ERTS_EV_TYPE_NONE); break; } case ERTS_EV_TYPE_STOP_NIF: { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - print_nif_select_op(dsbufp, fd, mode, resource, ref); + print_nif_select_op(dsbufp, fd, mode, resource, msg); steal_pending_stop_nif(dsbufp, resource, state, mode, on); if (state->type == ERTS_EV_TYPE_STOP_NIF) { ret = ERL_NIF_SELECT_STOP_SCHEDULED; /* ?? */ @@ -1082,7 +1181,6 @@ enif_select(ErlNifEnv* env, if (on) { const Eterm recipient = pid ? pid->pid : env->proc->common.id; - Uint32* refn; if (!state->driver.nif) state->driver.nif = alloc_nif_select_data(); if (state->type == ERTS_EV_TYPE_NONE) { @@ -1093,28 +1191,13 @@ enif_select(ErlNifEnv* env, ASSERT(state->type == ERTS_EV_TYPE_NIF); ASSERT(state->driver.stop.resource == resource); if (mode & ERL_DRV_READ) { - state->driver.nif->in.pid = recipient; - if (is_immed(ref)) { - state->driver.nif->in.immed = ref; - } else { - ASSERT(is_internal_ref(ref)); - refn = internal_ref_numbers(ref); - state->driver.nif->in.immed = THE_NON_VALUE; - sys_memcpy(state->driver.nif->in.refn, refn, - sizeof(state->driver.nif->in.refn)); - } + prepare_select_msg(&state->driver.nif->in, mode, recipient, + resource, msg, msg_env, am_ready_input); + msg_env = NULL; } if (mode & ERL_DRV_WRITE) { - state->driver.nif->out.pid = recipient; - if (is_immed(ref)) { - state->driver.nif->out.immed = ref; - } else { - ASSERT(is_internal_ref(ref)); - refn = internal_ref_numbers(ref); - state->driver.nif->out.immed = THE_NON_VALUE; - sys_memcpy(state->driver.nif->out.refn, refn, - sizeof(state->driver.nif->out.refn)); - } + prepare_select_msg(&state->driver.nif->out, mode, recipient, + resource, msg, msg_env, am_ready_output); } ret = 0; } @@ -1123,12 +1206,12 @@ enif_select(ErlNifEnv* env, if (state->type == ERTS_EV_TYPE_NIF) { if (mode & ERL_NIF_SELECT_READ && is_not_nil(state->driver.nif->in.pid)) { - state->driver.nif->in.pid = NIL; + clear_select_event(&state->driver.nif->in); ret |= ERL_NIF_SELECT_READ_CANCELLED; } if (mode & ERL_NIF_SELECT_WRITE && is_not_nil(state->driver.nif->out.pid)) { - state->driver.nif->out.pid = NIL; + clear_select_event(&state->driver.nif->out); ret |= ERL_NIF_SELECT_WRITE_CANCELLED; } } @@ -1545,53 +1628,6 @@ oready(Eterm id, ErtsDrvEventState *state) } } -static ERTS_INLINE void -send_event_tuple(struct erts_nif_select_event* e, ErtsResource* resource, - Eterm event_atom) -{ - Process* rp = erts_proc_lookup(e->pid); - ErtsProcLocks rp_locks = 0; - ErtsMessage* mp; - ErlOffHeap* ohp; - ErtsBinary* bin; - Eterm* hp; - Uint hsz; - Eterm resource_term, ref_term, tuple; - - if (!rp) { - return; - } - - bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource); - - /* {select, Resource, Ref, EventAtom} */ - if (is_value(e->immed)) { - hsz = 5 + ERTS_MAGIC_REF_THING_SIZE; - } - else { - hsz = 5 + ERTS_MAGIC_REF_THING_SIZE + ERTS_REF_THING_SIZE; - } - - mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp); - - resource_term = erts_mk_magic_ref(&hp, ohp, &bin->binary); - if (is_value(e->immed)) { - ASSERT(is_immed(e->immed)); - ref_term = e->immed; - } - else { - write_ref_thing(hp, e->refn[0], e->refn[1], e->refn[2]); - ref_term = make_internal_ref(hp); - hp += ERTS_REF_THING_SIZE; - } - tuple = TUPLE4(hp, am_select, resource_term, ref_term, event_atom); - - erts_queue_message(rp, rp_locks, mp, tuple, am_system); - - if (rp_locks) - erts_proc_unlock(rp, rp_locks); -} - static void bad_fd_in_pollset(ErtsDrvEventState *, Eterm inport, Eterm outport); void @@ -1765,7 +1801,6 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) case ERTS_EV_TYPE_NIF: { /* Requested via enif_select()... */ struct erts_nif_select_event in = {NIL}; struct erts_nif_select_event out = {NIL}; - ErtsResource* resource = NULL; if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) { if (revents & ERTS_POLL_EV_OUT) { @@ -1773,6 +1808,7 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) out = state->driver.nif->out; resource = state->driver.stop.resource; state->driver.nif->out.pid = NIL; + state->driver.nif->out.mp = NULL; } } if (revents & ERTS_POLL_EV_IN) { @@ -1780,6 +1816,7 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) in = state->driver.nif->in; resource = state->driver.stop.resource; state->driver.nif->in.pid = NIL; + state->driver.nif->in.mp = NULL; } } state->events &= ~revents; @@ -1792,10 +1829,10 @@ erts_check_io(ErtsPollThread *psi, ErtsMonotonicTime timeout_time) erts_mtx_unlock(fd_mtx(fd)); if (is_not_nil(in.pid)) { - send_event_tuple(&in, resource, am_ready_input); + send_select_msg(&in); } if (is_not_nil(out.pid)) { - send_event_tuple(&out, resource, am_ready_output); + send_select_msg(&out); } continue; } diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index 31182be5ec..0f3fc4f7a2 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -138,8 +138,7 @@ typedef struct { struct erts_nif_select_event { Eterm pid; - Eterm immed; - Uint32 refn[ERTS_REF_NUMBERS]; + ErtsMessage *mp; }; typedef struct { diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index edad62a9fb..0d0930e124 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -486,6 +486,7 @@ t_on_load(Config) when is_list(Config) -> -define(ERL_NIF_SELECT_WRITE, (1 bsl 1)). -define(ERL_NIF_SELECT_STOP, (1 bsl 2)). -define(ERL_NIF_SELECT_CANCEL, (1 bsl 3)). +-define(ERL_NIF_SELECT_CUSTOM_MSG, (1 bsl 4)). -define(ERL_NIF_SELECT_STOP_CALLED, (1 bsl 0)). -define(ERL_NIF_SELECT_STOP_SCHEDULED, (1 bsl 1)). @@ -496,100 +497,106 @@ t_on_load(Config) when is_list(Config) -> select(Config) when is_list(Config) -> ensure_lib_loaded(Config), + select_do(0, make_ref(), make_ref(), null), + + RefBin = list_to_binary(lists:duplicate(100, $x)), + [select_do(?ERL_NIF_SELECT_CUSTOM_MSG, + small, {a, tuple, with, "some", RefBin}, MSG_ENV) + || MSG_ENV <- [null, alloc_env]], + ok. + +select_do(Flag, Ref, Ref2, MSG_ENV) -> + io:format("select_do(~p, ~p, ~p)\n", [Ref, Ref2, MSG_ENV]), - Ref = make_ref(), - Ref2 = make_ref(), {{R, R_ptr}, {W, W_ptr}} = pipe_nif(), ok = write_nif(W, <<"hej">>), <<"hej">> = read_nif(R, 3), %% Wait for read eagain = read_nif(R, 3), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref), + 0 = select_nif(R,?ERL_NIF_SELECT_READ bor Flag, R,null,Ref,MSG_ENV), [] = flush(0), ok = write_nif(W, <<"hej">>), - [{select, R, Ref, ready_input}] = flush(), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2), - [{select, R, Ref2, ready_input}] = flush(), + receive_ready(R, Ref, ready_input), + 0 = select_nif(R,?ERL_NIF_SELECT_READ bor Flag,R,self(),Ref2,MSG_ENV), + receive_ready(R, Ref2, ready_input), Papa = self(), Pid = spawn_link(fun() -> - [{select, R, Ref, ready_input}] = flush(), + receive_ready(R, Ref, ready_input), Papa ! {self(), done} end), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,Pid,Ref), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, Pid, Ref,MSG_ENV), {Pid, done} = receive_any(1000), %% Cancel read - 0 = select_nif(R,?ERL_NIF_SELECT_READ bor ?ERL_NIF_SELECT_CANCEL,R,null,Ref), + 0 = select_nif(R,?ERL_NIF_SELECT_READ bor ?ERL_NIF_SELECT_CANCEL,R,null,Ref,null), <<"hej">> = read_nif(R, 3), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, null, Ref, MSG_ENV), ?ERL_NIF_SELECT_READ_CANCELLED = - select_nif(R,?ERL_NIF_SELECT_READ bor ?ERL_NIF_SELECT_CANCEL,R,null,Ref), + select_nif(R,?ERL_NIF_SELECT_READ bor ?ERL_NIF_SELECT_CANCEL,R,null,Ref,null), ok = write_nif(W, <<"hej again">>), [] = flush(0), <<"hej again">> = read_nif(R, 9), %% Wait for write Written = write_full(W, $a), - 0 = select_nif(W,?ERL_NIF_SELECT_WRITE,W,self(),Ref), + 0 = select_nif(W, ?ERL_NIF_SELECT_WRITE bor Flag, W, self(), Ref, MSG_ENV), [] = flush(0), Written = read_nif(R,byte_size(Written)), - [{select, W, Ref, ready_output}] = flush(), + receive_ready(W, Ref, ready_output), %% Cancel write - 0 = select_nif(W,?ERL_NIF_SELECT_WRITE bor ?ERL_NIF_SELECT_CANCEL,W,null,Ref), + 0 = select_nif(W, ?ERL_NIF_SELECT_WRITE bor ?ERL_NIF_SELECT_CANCEL, W, null, Ref, null), Written2 = write_full(W, $b), - 0 = select_nif(W,?ERL_NIF_SELECT_WRITE,W,null,Ref), + 0 = select_nif(W, ?ERL_NIF_SELECT_WRITE bor Flag, W, null, Ref, MSG_ENV), ?ERL_NIF_SELECT_WRITE_CANCELLED = - select_nif(W,?ERL_NIF_SELECT_WRITE bor ?ERL_NIF_SELECT_CANCEL,W,null,Ref), + select_nif(W, ?ERL_NIF_SELECT_WRITE bor ?ERL_NIF_SELECT_CANCEL, W, null, Ref, null), Written2 = read_nif(R,byte_size(Written2)), [] = flush(0), %% Close write and wait for EOF eagain = read_nif(R, 1), - check_stop_ret(select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref)), + check_stop_ret(select_nif(W, ?ERL_NIF_SELECT_STOP, W, null, Ref, null)), [{fd_resource_stop, W_ptr, _}] = flush(), {1, {W_ptr,_}} = last_fd_stop_call(), true = is_closed_nif(W), [] = flush(0), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref), - [{select, R, Ref, ready_input}] = flush(), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, self(), Ref, MSG_ENV), + receive_ready(R, Ref, ready_input), eof = read_nif(R,1), - check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref)), + check_stop_ret(select_nif(R, ?ERL_NIF_SELECT_STOP, R, null, Ref, null)), [{fd_resource_stop, R_ptr, _}] = flush(), {1, {R_ptr,_}} = last_fd_stop_call(), true = is_closed_nif(R), - select_2(Config). + select_2(Flag, Ref, Ref2, MSG_ENV). -select_2(Config) -> +select_2(Flag, Ref1, Ref2, MSG_ENV) -> erlang:garbage_collect(), {_,_,2} = last_resource_dtor_call(), - Ref1 = make_ref(), - Ref2 = make_ref(), {{R, R_ptr}, {W, W_ptr}} = pipe_nif(), %% Change ref eagain = read_nif(R, 1), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, null, Ref1, MSG_ENV), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, self(), Ref2, MSG_ENV), [] = flush(0), ok = write_nif(W, <<"hej">>), - [{select, R, Ref2, ready_input}] = flush(), + receive_ready(R, Ref2, ready_input), <<"hej">> = read_nif(R, 3), %% Change pid eagain = read_nif(R, 1), - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, null, Ref1, MSG_ENV), Papa = self(), spawn_link(fun() -> - 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1), + 0 = select_nif(R, ?ERL_NIF_SELECT_READ bor Flag, R, null, Ref1, MSG_ENV), [] = flush(0), Papa ! sync, - [{select, R, Ref1, ready_input}] = flush(), + receive_ready(R, Ref1, ready_input), <<"hej">> = read_nif(R, 3), Papa ! done end), @@ -598,24 +605,30 @@ select_2(Config) -> done = receive_any(), [] = flush(0), - check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref1)), + check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref1, null)), [{fd_resource_stop, R_ptr, _}] = flush(), {1, {R_ptr,_}} = last_fd_stop_call(), true = is_closed_nif(R), %% Stop without previous read/write select - ?ERL_NIF_SELECT_STOP_CALLED = select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref1), + ?ERL_NIF_SELECT_STOP_CALLED = select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref1,null), [{fd_resource_stop, W_ptr, 1}] = flush(), {1, {W_ptr,1}} = last_fd_stop_call(), true = is_closed_nif(W), - select_3(Config). + select_3(). -select_3(_Config) -> +select_3() -> erlang:garbage_collect(), {_,_,2} = last_resource_dtor_call(), ok. +receive_ready(R, Ref, IOatom) when is_reference(Ref) -> + [{select, R, Ref, IOatom}] = flush(); +receive_ready(_, Msg, _) -> + [Got] = flush(), + {true,_,_} = {Got=:=Msg, Got, Msg}. + %% @doc The stealing child process for the select_steal test. Duplicates given %% W/RFds and runs select on them to steal select_steal_child_process(Parent, RFd) -> @@ -624,7 +637,7 @@ select_steal_child_process(Parent, RFd) -> Ref2 = make_ref(), %% Try to select from the child pid (steal from parent) - ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2)), + ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2, null)), ?assertEqual([], flush(0)), ?assertEqual(eagain, read_nif(R2Fd, 1)), @@ -632,7 +645,7 @@ select_steal_child_process(Parent, RFd) -> Parent ! {self(), stage1}, % signal parent to send the <<"stolen1">> %% Receive <<"stolen1">> via enif_select - ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2)), + ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2, null)), ?assertMatch([{select, R2Fd, Ref2, ready_input}], flush()), ?assertEqual(<<"stolen1">>, read_nif(R2Fd, 7)), @@ -650,7 +663,7 @@ select_steal(Config) when is_list(Config) -> {{RFd, RPtr}, {WFd, WPtr}} = pipe_nif(), %% Bind the socket to current pid in enif_select - ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, null, Ref)), + ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, null, Ref, null)), ?assertEqual([], flush(0)), %% Spawn a process and do some stealing @@ -664,15 +677,15 @@ select_steal(Config) when is_list(Config) -> ?assertMatch([{Pid, done}], flush(1)), % synchronize with the child %% Try to select from the parent pid (steal back) - ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, Pid, Ref)), + ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, Pid, Ref, null)), %% Ensure that no data is hanging and close. %% Rfd is stolen at this point. - check_stop_ret(select_nif(WFd, ?ERL_NIF_SELECT_STOP, WFd, null, Ref)), + check_stop_ret(select_nif(WFd, ?ERL_NIF_SELECT_STOP, WFd, null, Ref, null)), ?assertMatch([{fd_resource_stop, WPtr, _}], flush()), {1, {WPtr, 1}} = last_fd_stop_call(), - check_stop_ret(select_nif(RFd, ?ERL_NIF_SELECT_STOP, RFd, null, Ref)), + check_stop_ret(select_nif(RFd, ?ERL_NIF_SELECT_STOP, RFd, null, Ref, null)), ?assertMatch([{fd_resource_stop, RPtr, _}], flush()), {1, {RPtr, _DirectCall}} = last_fd_stop_call(), @@ -3396,7 +3409,7 @@ term_to_binary_nif(_, _) -> ?nif_stub. binary_to_term_nif(_, _, _) -> ?nif_stub. port_command_nif(_, _) -> ?nif_stub. format_term_nif(_,_) -> ?nif_stub. -select_nif(_,_,_,_,_) -> ?nif_stub. +select_nif(_,_,_,_,_,_) -> ?nif_stub. dupe_resource_nif(_) -> ?nif_stub. pipe_nif() -> ?nif_stub. write_nif(_,_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index f2ce6dbe67..21af4b05b3 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -2486,7 +2486,8 @@ static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv enum ErlNifSelectFlags mode; void* obj; ErlNifPid nifpid, *pid = NULL; - ERL_NIF_TERM ref; + ERL_NIF_TERM ref_or_msg; + ErlNifEnv* msg_env = NULL; int retval; if (!get_fd(env, argv[0], &fdr) @@ -2501,11 +2502,27 @@ static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv return enif_make_badarg(env); pid = &nifpid; } - ref = argv[4]; + ref_or_msg = argv[4]; + if (argv[5] != atom_null) { + msg_env = enif_alloc_env(); + ref_or_msg = enif_make_copy(msg_env, ref_or_msg); + } fdr->was_selected = 1; enif_self(env, &fdr->pid); - retval = enif_select(env, fdr->fd, mode, obj, pid, ref); + switch (mode) { + case ERL_NIF_SELECT_CUSTOM_MSG | ERL_NIF_SELECT_READ: + retval = enif_select_read(env, fdr->fd, obj, pid, ref_or_msg, msg_env); + break; + case ERL_NIF_SELECT_CUSTOM_MSG | ERL_NIF_SELECT_WRITE: + retval = enif_select_write(env, fdr->fd, obj, pid, ref_or_msg, msg_env); + break; + default: + retval = enif_select(env, fdr->fd, mode, obj, pid, ref_or_msg); + } + + if (msg_env) + enif_free_env(msg_env); return enif_make_int(env, retval); } @@ -3565,7 +3582,7 @@ static ErlNifFunc nif_funcs[] = {"binary_to_term_nif", 3, binary_to_term}, {"port_command_nif", 2, port_command}, {"format_term_nif", 2, format_term}, - {"select_nif", 5, select_nif}, + {"select_nif", 6, select_nif}, #ifndef __WIN32__ {"pipe_nif", 0, pipe_nif}, {"write_nif", 2, write_nif}, diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index f15217814a..6b834705cf 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -504,6 +504,10 @@ t_integer_to_string(Config) when is_list(Config) -> test_its("A", 10, 16), test_its("D4BE", 54462, 16), test_its("-D4BE", -54462, 16), + test_its("FFFFFFFFFF", 1099511627775, 16), + test_its("123456789ABCDEF123456789ABCDEF123456789ABCDEF", + 108977460683796539709587792812439445667270661579197935, + 16), lists:foreach(fun(Value) -> {'EXIT', {badarg, _}} = @@ -515,12 +519,14 @@ t_integer_to_string(Config) when is_list(Config) -> ok. test_its(List,Int) -> - Int = list_to_integer(List), - Int = binary_to_integer(list_to_binary(List)). + List = integer_to_list(Int), + Binary = list_to_binary(List), + Binary = integer_to_binary(Int). test_its(List,Int,Base) -> - Int = list_to_integer(List, Base), - Int = binary_to_integer(list_to_binary(List), Base). + List = integer_to_list(Int, Base), + Binary = list_to_binary(List), + Binary = integer_to_binary(Int, Base). %% Tests binary_to_integer/1. diff --git a/erts/emulator/test/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl index 58cd3276b0..58038e24b7 100644 --- a/erts/emulator/test/persistent_term_SUITE.erl +++ b/erts/emulator/test/persistent_term_SUITE.erl @@ -21,7 +21,7 @@ -module(persistent_term_SUITE). -include_lib("common_test/include/ct.hrl"). --export([all/0,suite/0, +-export([all/0,suite/0,init_per_suite/1,end_per_suite/1, basic/1,purging/1,sharing/1,get_trapping/1, info/1,info_trapping/1,killed_while_trapping/1, off_heap_values/1,keys/1,collisions/1, @@ -39,39 +39,49 @@ all() -> killed_while_trapping,off_heap_values,keys,collisions, init_restart]. +init_per_suite(Config) -> + %% Put a term in the dict so that we know that the testcases handle + %% stray terms left by stdlib or other test suites. + persistent_term:put(init_per_suite, {?MODULE}), + Config. + +end_per_suite(Config) -> + persistent_term:erase(init_per_suite), + Config. + basic(_Config) -> Chk = chk(), N = 777, Seq = lists:seq(1, N), - par(2, N, Seq), - seq(3, Seq), - seq(3, Seq), %Same values. + par(2, N, Seq, Chk), + seq(3, Seq, Chk), + seq(3, Seq, Chk), %Same values. _ = [begin Key = {?MODULE,{key,I}}, true = persistent_term:erase(Key), false = persistent_term:erase(Key), {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)) end || I <- Seq], - [] = [P || {{?MODULE,_},_}=P <- persistent_term:get()], + [] = [P || {{?MODULE,_},_}=P <- pget(Chk)], chk(Chk). -par(C, N, Seq) -> +par(C, N, Seq, Chk) -> _ = [spawn_link(fun() -> ok = persistent_term:put({?MODULE,{key,I}}, {value,C*I}) end) || I <- Seq], - Result = wait(N), + Result = wait(N, Chk), _ = [begin Double = C*I, {{?MODULE,{key,I}},{value,Double}} = Res end || {I,Res} <- lists:zip(Seq, Result)], ok. -seq(C, Seq) -> +seq(C, Seq, Chk) -> _ = [ok = persistent_term:put({?MODULE,{key,I}}, {value,C*I}) || I <- Seq], - All = persistent_term:get(), - All = [P || {{?MODULE,_},_}=P <- persistent_term:get()], + All = pget(Chk), + All = [P || {{?MODULE,_},_}=P <- All], All = [{Key,persistent_term:get(Key)} || {Key,_} <- All], Result = lists:sort(All), _ = [begin @@ -80,15 +90,15 @@ seq(C, Seq) -> end || {I,Res} <- lists:zip(Seq, Result)], ok. -wait(N) -> - All = [P || {{?MODULE,_},_}=P <- persistent_term:get()], +wait(N, Chk) -> + All = [P || {{?MODULE,_},_}=P <- pget(Chk)], case length(All) of N -> All = [{Key,persistent_term:get(Key)} || {Key,_} <- All], lists:sort(All); _ -> receive after 10 -> ok end, - wait(N) + wait(N, Chk) end. %% Make sure that terms that have been erased are copied into all @@ -200,23 +210,23 @@ get_trapping(_Config) -> _ -> 1000 end, spawn_link(fun() -> get_trapping_create(N) end), - All = do_get_trapping(N, []), + All = do_get_trapping(N, [], Chk), N = get_trapping_check_result(lists:sort(All), 1), erlang:garbage_collect(), get_trapping_erase(N), chk(Chk). -do_get_trapping(N, Prev) -> - case persistent_term:get() of +do_get_trapping(N, Prev, Chk) -> + case pget(Chk) of Prev when length(Prev) >= N -> All = [P || {{?MODULE,{get_trapping,_}},_}=P <- Prev], case length(All) of N -> All; - _ -> do_get_trapping(N, Prev) + _ -> do_get_trapping(N, Prev, Chk) end; New -> receive after 1 -> ok end, - do_get_trapping(N, New) + do_get_trapping(N, New, Chk) end. get_trapping_create(0) -> @@ -331,25 +341,25 @@ info_trapping(_Config) -> _ -> 1000 end, spawn_link(fun() -> info_trapping_create(N) end), - All = do_info_trapping(N, 0), + All = do_info_trapping(N, 0, Chk), N = info_trapping_check_result(lists:sort(All), 1), erlang:garbage_collect(), info_trapping_erase(N), chk(Chk). -do_info_trapping(N, PrevMem) -> +do_info_trapping(N, PrevMem, Chk) -> case info_info() of - {N,Mem} -> + {M,Mem} when M >= N -> true = Mem >= PrevMem, - All = [P || {{?MODULE,{info_trapping,_}},_}=P <- persistent_term:get()], + All = [P || {{?MODULE,{info_trapping,_}},_}=P <- pget(Chk)], case length(All) of N -> All; - _ -> do_info_trapping(N, PrevMem) + _ -> do_info_trapping(N, PrevMem, Chk) end; {_,Mem} -> true = Mem >= PrevMem, receive after 1 -> ok end, - do_info_trapping(N, Mem) + do_info_trapping(N, Mem, Chk) end. info_trapping_create(0) -> @@ -462,17 +472,17 @@ collisions(_Config) -> _ = [V = persistent_term:get(K) || {K,V} <- Kvs], %% Now delete the persistent terms in random order. - collisions_delete(lists:keysort(2, Kvs)), + collisions_delete(lists:keysort(2, Kvs), Chk), chk(Chk). -collisions_delete([{Key,Val}|Kvs]) -> +collisions_delete([{Key,Val}|Kvs], Chk) -> Val = persistent_term:get(Key), true = persistent_term:erase(Key), - true = lists:sort(persistent_term:get()) =:= lists:sort(Kvs), + true = lists:sort(pget(Chk)) =:= lists:sort(Kvs), _ = [V = persistent_term:get(K) || {K,V} <- Kvs], - collisions_delete(Kvs); -collisions_delete([]) -> + collisions_delete(Kvs, Chk); +collisions_delete([], _) -> ok. colliding_keys() -> @@ -589,15 +599,16 @@ do_test_init_restart_cmd(File) -> %% and after each test case. chk() -> - persistent_term:info(). + {persistent_term:info(), persistent_term:get()}. -chk(Chk) -> - Chk = persistent_term:info(), +chk({Info, _Initial} = Chk) -> + Info = persistent_term:info(), Key = {?MODULE,?FUNCTION_NAME}, - ok = persistent_term:put(Key, {term,Chk}), + ok = persistent_term:put(Key, {term,Info}), Term = persistent_term:get(Key), true = persistent_term:erase(Key), chk_not_stuck(Term), + [persistent_term:erase(K) || {K, _} <- pget(Chk)], ok. chk_not_stuck(Term) -> @@ -612,3 +623,6 @@ chk_not_stuck(Term) -> _ -> ok end. + +pget({_, Initial}) -> + persistent_term:get() -- Initial. diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index f4b1d885fe..edf08ce0bd 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -2104,6 +2104,13 @@ spawn_opt_max_heap_size(_Config) -> error_logger:add_report_handler(?MODULE, self()), + %% flush any prior messages in error_logger + Pid = spawn(fun() -> ok = nok end), + receive + {error, _, {emulator, _, [Pid|_]}} -> + flush() + end, + %% Test that numerical limit works max_heap_size_test(1024, 1024, true, true), @@ -2208,6 +2215,13 @@ receive_unexpected() -> ok end. +flush() -> + receive + _M -> flush() + after 0 -> + ok + end. + %% error_logger report handler proxy init(Pid) -> {ok, Pid}. diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index 8ea2d88ec4..55b1162cfb 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -37,8 +37,9 @@ -export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1, ets_limit/1, atom_limit/1, - ets_count/1, - atom_count/1]). + ets_count/1, atom_count/1, system_logger/1]). + +-export([init/1, handle_event/2, handle_call/2]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -46,8 +47,8 @@ suite() -> all() -> [process_count, system_version, misc_smoke_tests, - ets_count, - heap_size, wordsize, memory, ets_limit, atom_limit, atom_count]. + ets_count, heap_size, wordsize, memory, ets_limit, atom_limit, atom_count, + system_logger]. %%% %%% The test cases ------------------------------------------------------------- @@ -578,3 +579,78 @@ atom_count(Config) when is_list(Config) -> true = Limit >= Count2, true = Count2 > Count1, ok. + + +system_logger(Config) when is_list(Config) -> + + TC = self(), + + ok = error_logger:add_report_handler(?MODULE, [TC]), + + generate_log_event(), + + flush(1, report_handler), + + Initial = erlang:system_info(system_logger), + + {Logger,_} = spawn_monitor(fun F() -> receive M -> TC ! {system_logger,M}, F() end end), + + Initial = erlang:system_flag(system_logger, Logger), + Logger = erlang:system_info(system_logger), + + generate_log_event(), + flush(1, system_logger), + + Logger = erlang:system_flag(system_logger, Logger), + + generate_log_event(), + flush(1, system_logger), + + exit(Logger, die), + receive {'DOWN',_,_,_,_} -> ok end, + + generate_log_event(), + flush(1, report_handler), + + logger = erlang:system_info(system_logger), + + logger = erlang:system_flag(system_logger, undefined), + generate_log_event(), + flush(), + + undefined = erlang:system_flag(system_logger, Initial), + + ok. + +flush() -> + receive + M -> + ct:fail({unexpected_message, M}) + after 0 -> + ok + end. + +flush(0, _Pat) -> + flush(); +flush(Cnt, Pat) -> + receive + M when element(1,M) =:= Pat -> + ct:log("~p",[M]), + flush(Cnt-1, Pat) + after 500 -> + ct:fail({missing, Cnt, Pat}) + end. + +generate_log_event() -> + {_Pid, Ref} = spawn_monitor(fun() -> ok = nok end), + receive {'DOWN', Ref, _, _, _} -> ok end. + +init([To]) -> + {ok, To}. + +handle_call(Msg, State) -> + {ok, Msg, State}. + +handle_event(Event, State) -> + State ! {report_handler, Event}, + {ok, State}. diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 70cc606a22..1b0cb5b50c 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 7ce8ed18f9..b3af713809 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex abd18c044b..b9f4791ba9 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index ed69245d01..65716def11 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2526,6 +2526,9 @@ subtract(_,_) -> OldSchedulersOnline when SchedulersOnline :: pos_integer(), OldSchedulersOnline :: pos_integer(); + (system_logger, Logger) -> PrevLogger when + Logger :: logger | undefined | pid(), + PrevLogger :: logger | undefined | pid(); (trace_control_word, TCW) -> OldTCW when TCW :: non_neg_integer(), OldTCW :: non_neg_integer(); @@ -2731,8 +2734,9 @@ tuple_to_list(_Tuple) -> (schedulers | schedulers_online) -> pos_integer(); (smp_support) -> boolean(); (start_time) -> integer(); - (system_version) -> string(); (system_architecture) -> string(); + (system_logger) -> logger | undefined | pid(); + (system_version) -> string(); (threads) -> boolean(); (thread_pool_size) -> non_neg_integer(); (time_correction) -> true | false; @@ -3395,60 +3399,15 @@ get_cookie() -> -spec integer_to_list(Integer, Base) -> string() when Integer :: integer(), Base :: 2..36. -integer_to_list(I, 10) -> - erlang:integer_to_list(I); -integer_to_list(I, Base) - when erlang:is_integer(I), erlang:is_integer(Base), - Base >= 2, Base =< 1+$Z-$A+10 -> - if I < 0 -> - [$-|integer_to_list(-I, Base, [])]; - true -> - integer_to_list(I, Base, []) - end; -integer_to_list(I, Base) -> - erlang:error(badarg, [I, Base]). - -integer_to_list(I0, Base, R0) -> - D = I0 rem Base, - I1 = I0 div Base, - R1 = if D >= 10 -> - [D-10+$A|R0]; - true -> - [D+$0|R0] - end, - if I1 =:= 0 -> - R1; - true -> - integer_to_list(I1, Base, R1) - end. +integer_to_list(_I, _Base) -> + erlang:nif_error(undefined). -spec integer_to_binary(Integer, Base) -> binary() when Integer :: integer(), Base :: 2..36. -integer_to_binary(I, 10) -> - erlang:integer_to_binary(I); -integer_to_binary(I, Base) - when erlang:is_integer(I), erlang:is_integer(Base), - Base >= 2, Base =< 1+$Z-$A+10 -> - if I < 0 -> - <<$-,(integer_to_binary(-I, Base, <<>>))/binary>>; - true -> - integer_to_binary(I, Base, <<>>) - end; -integer_to_binary(I, Base) -> - erlang:error(badarg, [I, Base]). - -integer_to_binary(I0, Base, R0) -> - D = I0 rem Base, - I1 = I0 div Base, - R1 = if - D >= 10 -> <<(D-10+$A),R0/binary>>; - true -> <<(D+$0),R0/binary>> - end, - if - I1 =:= 0 -> R1; - true -> integer_to_binary(I1, Base, R1) - end. +integer_to_binary(_I, _Base) -> + erlang:nif_error(undefined). + -record(cpu, {node = -1, processor = -1, diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 8f29a569f2..305b524438 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -97,6 +97,8 @@ -export([counters_new/1, counters_get/2, counters_add/3, counters_put/3, counters_info/1]). +-export([spawn_system_process/3]). + %% %% Await result of send to port %% @@ -726,3 +728,10 @@ counters_put(_Ref, _Ix, _Value) -> -spec counters_info(reference()) -> #{}. counters_info(_Ref) -> erlang:nif_error(undef). + +-spec spawn_system_process(Mod, Func, Args) -> pid() when + Mod :: atom(), + Func :: atom(), + Args :: list(). +spawn_system_process(_Mod, _Func, _Args) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 5fc22bc582..0994e2a9f4 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -46,7 +46,7 @@ -define(MIN_READLINE_SIZE, 256). -define(LARGEFILESIZE, (1 bsl 63)). --export([copy/3]). +-export([copy/3, start/0]). -include("file_int.hrl"). @@ -85,14 +85,21 @@ is_translatable(_) -> %% This is a janitor process used to close files whose controlling process has %% died. The emulator will be torn down if this is killed. -delayed_close_loop() -> +start() -> + helper_loop(). + +helper_loop() -> receive {close, FRef} when is_reference(FRef) -> delayed_close_nif(FRef); _ -> ok end, - delayed_close_loop(). + helper_loop(). -%% +on_load() -> + %% This is spawned as a system process to prevent init:restart/0 from + %% killing it. + Pid = erts_internal:spawn_system_process(?MODULE, start, []), + ok = erlang:load_nif(atom_to_list(?MODULE), Pid). %% Returns {error, Reason} | {ok, BytesCopied} copy(#file_descriptor{module = ?MODULE} = Source, @@ -103,14 +110,6 @@ copy(#file_descriptor{module = ?MODULE} = Source, %% XXX Should be moved down to the driver for optimization. file:copy_opened(Source, Dest, Length). -on_load() -> - Pid = spawn(fun() -> - process_flag(trap_exit, true), - delayed_close_loop() - end), - true = register(erts_prim_file, Pid), - ok = erlang:load_nif(atom_to_list(?MODULE), Pid). - open(Name, Modes) -> %% The try/catch pattern seen here is used throughout the file to adhere to %% the public file interface, which has leaked through for ages because of diff --git a/erts/vsn.mk b/erts/vsn.mk index 73199cc721..c579b6364a 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 10.2.1 +VSN = 10.2.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 78128980f0..5219ba0f5d 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -695,12 +695,13 @@ module.beam: module.erl \ </note> <note> - <p>The options <c>{nowarn_unused_function, FAs}</c>, - <c>{nowarn_bif_clash, FAs}</c>, and - <c>{nowarn_deprecated_function, MFAs}</c> are only - recognized when given in files. They are not affected by - options <c>warn_unused_function</c>, <c>warn_bif_clash</c>, or - <c>warn_deprecated_function</c>.</p> + <p>Before OTP 22, the option <c>{nowarn_deprecated_function, + MFAs}</c> was only recognized when given in the file with + attribute <c>-compile()</c>. (The option + <c>{nowarn_unused_function,FAs}</c> was incorrectly documented + to only work in a file, but it also worked when given in the + option list.) Starting from OTP 22, all options that can be + given in the file can also be given in the option list.</p> </note> <p>For debugging of the compiler, or for pure curiosity, diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 7addadf82c..02e6203137 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,26 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>An optimization that avoided allocation of a stack + frame for some <c>case</c> expressions was introduced in + OTP 21. (ERL-504/OTP-14808) It turns out that in rare + circumstances, this optimization is not safe. Therefore, + this optimization has been disabled.</p> + <p>A similar optimization will be included in OTP 22 in a + safe way.</p> + <p> + Own Id: OTP-15501 Aux Id: ERL-807, ERL-514, OTP-14808 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 961dacc6c9..074d9b881b 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,7 +49,6 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ - beam_bs \ beam_clean \ beam_dict \ beam_disasm \ diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index dd2537a699..1ac892a8f1 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -100,8 +100,12 @@ rename_instr({bs_put_utf16=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; rename_instr({bs_put_utf32=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; -rename_instr({bs_put_string,_,_}=I) -> - {bs_put,{f,0},I,[]}; +rename_instr({bs_put_string,_,{string,String}}) -> + %% Only happens when compiling from .S files. In old + %% .S files, String is a list. In .S in OTP 22 and later, + %% String is a binary. + {bs_put,{f,0},{bs_put_binary,8,{field_flags,[unsigned,big]}}, + [{atom,all},{literal,iolist_to_binary([String])}]}; rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) -> {bif,I,F,[Src1,Src2,{integer,U}],Dst}; rename_instr({bs_utf8_size=I,F,Src,Dst}) -> @@ -118,8 +122,8 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; -rename_instr({test,Op,F,[Ctx,Bits,{string,Str}]}) -> - %% When compiling from a .S file. +rename_instr({test,bs_match_string=Op,F,[Ctx,Bits,{string,Str}]}) when is_list(Str) -> + %% When compiling from an old .S file. Starting from OTP 22, Str is a binary. <<Bs:Bits/bits,_/bits>> = list_to_binary(Str), {test,Op,F,[Ctx,Bs]}; rename_instr({put_map_assoc,Fail,S,D,R,L}) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index df0321e85a..bc1290f6fd 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -424,8 +424,8 @@ encode_arg({f, W}, Dict) -> {encode(?tag_f, W), Dict}; %% encode_arg({'char', C}, Dict) -> %% {encode(?tag_h, C), Dict}; -encode_arg({string, String}, Dict0) -> - {Offset, Dict} = beam_dict:string(String, Dict0), +encode_arg({string, BinString}, Dict0) when is_binary(BinString) -> + {Offset, Dict} = beam_dict:string(BinString, Dict0), {encode(?tag_u, Offset), Dict}; encode_arg({extfunc, M, F, A}, Dict0) -> {Index, Dict} = beam_dict:import(M, F, A, Dict0), diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl deleted file mode 100644 index 15d8d687fc..0000000000 --- a/lib/compiler/src/beam_bs.erl +++ /dev/null @@ -1,183 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% Purpose: Peephole optimization of binary syntax instructions. - --module(beam_bs). - --export([module/2]). --import(lists, [reverse/1]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = bs_opt(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%%% -%%% Evaluate construction of constant bit fields. -%%% Combine bs_skip_bits2 and bs_test_tail2 instructions. -%%% - -bs_opt([{bs_put,_,_,_}=I|Is0]) -> - {BsPuts0,Is} = collect_bs_puts(Is0, [I]), - BsPuts = opt_bs_puts(BsPuts0), - BsPuts ++ bs_opt(Is); -bs_opt([{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}, - {test,bs_test_tail2,F,[Ctx,Bits]}|Is]) -> - [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|bs_opt(Is)]; -bs_opt([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,Flags]}, - {test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,_]}|Is]) -> - I = {test,bs_skip_bits2,F, - [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}, - bs_opt([I|Is]); -bs_opt([I|Is]) -> - [I|bs_opt(Is)]; -bs_opt([]) -> []. - -collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) -> - collect_bs_puts(Is, [I|Acc]); -collect_bs_puts([_|_]=Is, Acc) -> - {reverse(Acc),Is}. - -opt_bs_puts(Is) -> - opt_bs_1(Is, []). - -opt_bs_1([{bs_put,Fail, - {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> - try eval_put_float(Src, Sz, Flags0) of - <<Int:Sz>> -> - Flags = force_big(Flags0), - I = {bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}, - opt_bs_1([I|Is], Acc) - catch - error:_ -> - opt_bs_1(Is, [I0|Acc]) - end; -opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, - Acc0) -> - {Is,Acc} = bs_collect_string(IsAll, Acc0), - opt_bs_1(Is, Acc); -opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], - Acc) when Sz > 8 -> - case field_endian(F) of - big -> - %% We can do this optimization for any field size without - %% risk for code explosion. - case bs_split_int(N, Sz, Fail, Is0) of - no_split -> opt_bs_1(Is0, [I|Acc]); - Is -> opt_bs_1(Is, Acc) - end; - little when Sz < 128 -> - %% We only try to optimize relatively small fields, to - %% avoid an explosion in code size. - <<Int:Sz>> = <<N:Sz/little>>, - Flags = force_big(F), - Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}|Is0], - opt_bs_1(Is, Acc); - _ -> %native or too wide little field - opt_bs_1(Is0, [I|Acc]) - end; -opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> - opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); -opt_bs_1([I|Is], Acc) -> - opt_bs_1(Is, [I|Acc]); -opt_bs_1([], Acc) -> reverse(Acc). - -eval_put_float(Src, Sz, Flags) when Sz =< 256 -> - %%Only evaluate if Sz is reasonable. - Val = value(Src), - case field_endian(Flags) of - little -> <<Val:Sz/little-float-unit:1>>; - big -> <<Val:Sz/big-float-unit:1>> - %% native intentionally not handled here - we can't optimize - %% it. - end. - -value({integer,I}) -> I; -value({float,F}) -> F. - -bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> - bs_coll_str_1(Is, Len, reverse(Str), Acc); -bs_collect_string(Is, Acc) -> - bs_coll_str_1(Is, 0, [], Acc). - -bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], - Len, StrAcc, IsAcc) when U*Sz =:= 8 -> - Byte = V band 16#FF, - bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); -bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. - -field_endian({field_flags,F}) -> field_endian_1(F). - -field_endian_1([big=E|_]) -> E; -field_endian_1([little=E|_]) -> E; -field_endian_1([native=E|_]) -> E; -field_endian_1([_|Fs]) -> field_endian_1(Fs). - -force_big({field_flags,F}) -> - {field_flags,force_big_1(F)}. - -force_big_1([big|_]=Fs) -> Fs; -force_big_1([little|Fs]) -> [big|Fs]; -force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. - -bs_split_int(0, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only zeroes. - no_split; -bs_split_int(-1, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only 255 bytes. - no_split; -bs_split_int(N, Sz, Fail, Acc) -> - FirstByteSz = case Sz rem 8 of - 0 -> 8; - Rem -> Rem - end, - bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). - -bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,-1}]}, - [I|Acc]; -bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,0}]}, - [I|Acc]; -bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> - Mask = (1 bsl ByteSz) - 1, - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,ByteSz},{integer,N band Mask}]}, - bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); -bs_split_int_1(_, _, _, _, Acc) -> Acc. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 990e86062a..b2056332e6 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -126,18 +126,17 @@ import(Mod0, Name0, Arity, #asm{imports=Imp0,next_import=NextIndex}=D0) {NextIndex,D2#asm{imports=Imp,next_import=NextIndex+1}} end. -%% Returns the index for a string in the string table (adding the string to the -%% table if necessary). +%% Returns the index for a binary string in the string table (adding +%% the string to the table if necessary). %% string(String, Dict) -> {Offset, Dict'} --spec string(string(), bdict()) -> {non_neg_integer(), bdict()}. +-spec string(binary(), bdict()) -> {non_neg_integer(), bdict()}. -string(Str, Dict) when is_list(Str) -> +string(BinString, Dict) when is_binary(BinString) -> #asm{strings=Strings,string_offset=NextOffset} = Dict, - StrBin = list_to_binary(Str), - case old_string(StrBin, Strings) of + case old_string(BinString, Strings) of none -> - NewDict = Dict#asm{strings = <<Strings/binary,StrBin/binary>>, - string_offset=NextOffset+byte_size(StrBin)}, + NewDict = Dict#asm{strings = <<Strings/binary,BinString/binary>>, + string_offset=NextOffset+byte_size(BinString)}, {NextOffset,NewDict}; Offset when is_integer(Offset) -> {NextOffset-Offset,Dict} diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl index d3facc5911..fa5b19228b 100644 --- a/lib/compiler/src/beam_ssa_codegen.erl +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -1071,8 +1071,8 @@ cg_block([#cg_set{op={bif,Name},dst=Dst0,args=Args0}]=Is0, {Dst0,Fail}, St0) -> {z,_} -> %% The result of the BIF call will only be used once. Convert to %% a test instruction. - Test = bif_to_test(Name, Args, ensure_label(Fail, St0)), - {Test,St0}; + {Test,St1} = bif_to_test(Name, Args, ensure_label(Fail, St0), St0), + {Test,St1}; _ -> %% Must explicitly call the BIF since the result will be used %% more than once. @@ -1269,6 +1269,14 @@ cg_copy_1([], _St) -> []. element(1, Val) =:= atom orelse element(1, Val) =:= literal)). +bif_to_test('or', [V1,V2], {f,Lbl}=Fail, St0) when Lbl =/= 0 -> + {SuccLabel,St} = new_label(St0), + {[{test,is_eq_exact,{f,SuccLabel},[V1,{atom,false}]}, + {test,is_eq_exact,Fail,[V2,{atom,true}]}, + {label,SuccLabel}],St}; +bif_to_test(Op, Args, Fail, St) -> + {bif_to_test(Op, Args, Fail),St}. + bif_to_test('and', [V1,V2], Fail) -> [{test,is_eq_exact,Fail,[V1,{atom,true}]}, {test,is_eq_exact,Fail,[V2,{atom,true}]}]; @@ -2017,9 +2025,7 @@ is_gc_bif(Bif, Args) -> %% new_label(St) -> {L,St}. new_label(#cg{lcount=Next}=St) -> - %% Advance the label counter by 2 to allow us to create - %% a label for 'or' by incrementing an existing label. - {Next,St#cg{lcount=Next+2}}. + {Next,St#cg{lcount=Next+1}}. %% call_line(tail|body, Func, Anno) -> [] | [{line,...}]. %% Produce a line instruction if it will be needed by the diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index 2dda67eac6..6bba47b4ac 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -61,6 +61,7 @@ passes(Opts0) -> ?PASS(ssa_opt_cse), ?PASS(ssa_opt_type), ?PASS(ssa_opt_live), + ?PASS(ssa_opt_bs_puts), ?PASS(ssa_opt_dead), ?PASS(ssa_opt_cse), %Second time. ?PASS(ssa_opt_float), @@ -902,7 +903,13 @@ live_opt_unused(#b_set{op=get_map_element}=Set) -> live_opt_unused(_) -> keep. %%% -%%% Optimize binary matching instructions. +%%% Optimize binary matching. +%%% +%%% * If the value of segment is never extracted, rewrite +%%% to a bs_skip instruction. +%%% +%%% * Coalesce adjacent bs_skip instructions and skip instructions +%%% with bs_test_tail. %%% ssa_opt_bsm(#st{ssa=Linear}=St) -> @@ -910,9 +917,10 @@ ssa_opt_bsm(#st{ssa=Linear}=St) -> Extracted = cerl_sets:from_list(Extracted0), St#st{ssa=bsm_skip(Linear, Extracted)}. -bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs], Extracted) -> +bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs0], Extracted) -> + Bs = bsm_skip(Bs0, Extracted), Is = bsm_skip_is(Is0, Extracted), - [{L,Blk#b_blk{is=Is}}|bsm_skip(Bs, Extracted)]; + coalesce_skips({L,Blk#b_blk{is=Is}}, Bs); bsm_skip([], _) -> []. bsm_skip_is([I0|Is], Extracted) -> @@ -943,6 +951,63 @@ bsm_extracted([{_,#b_blk{is=Is}}|Bs]) -> end; bsm_extracted([]) -> []. +coalesce_skips({L,#b_blk{is=[#b_set{op=bs_extract}=Extract|Is0], + last=Last0}=Blk0}, Bs0) -> + case coalesce_skips_is(Is0, Last0, Bs0) of + not_possible -> + [{L,Blk0}|Bs0]; + {Is,Last,Bs} -> + Blk = Blk0#b_blk{is=[Extract|Is],last=Last}, + [{L,Blk}|Bs] + end; +coalesce_skips({L,#b_blk{is=Is0,last=Last0}=Blk0}, Bs0) -> + case coalesce_skips_is(Is0, Last0, Bs0) of + not_possible -> + [{L,Blk0}|Bs0]; + {Is,Last,Bs} -> + Blk = Blk0#b_blk{is=Is,last=Last}, + [{L,Blk}|Bs] + end. + +coalesce_skips_is([#b_set{op=bs_match, + args=[#b_literal{val=skip}, + Ctx0,Type,Flags, + #b_literal{val=Size0}, + #b_literal{val=Unit0}]}=Skip0, + #b_set{op=succeeded}], + #b_br{succ=L2,fail=Fail}=Br0, + Bs0) when is_integer(Size0) -> + case Bs0 of + [{L2,#b_blk{is=[#b_set{op=bs_match, + dst=SkipDst, + args=[#b_literal{val=skip},_,_,_, + #b_literal{val=Size1}, + #b_literal{val=Unit1}]}, + #b_set{op=succeeded}=Succeeded], + last=#b_br{fail=Fail}=Br}}|Bs] when is_integer(Size1) -> + SkipBits = Size0 * Unit0 + Size1 * Unit1, + Skip = Skip0#b_set{dst=SkipDst, + args=[#b_literal{val=skip},Ctx0, + Type,Flags, + #b_literal{val=SkipBits}, + #b_literal{val=1}]}, + Is = [Skip,Succeeded], + {Is,Br,Bs}; + [{L2,#b_blk{is=[#b_set{op=bs_test_tail, + args=[_Ctx,#b_literal{val=TailSkip}]}], + last=#b_br{succ=NextSucc,fail=Fail}}}|Bs] -> + SkipBits = Size0 * Unit0, + TestTail = Skip0#b_set{op=bs_test_tail, + args=[Ctx0,#b_literal{val=SkipBits+TailSkip}]}, + Br = Br0#b_br{bool=TestTail#b_set.dst,succ=NextSucc}, + Is = [TestTail], + {Is,Br,Bs}; + _ -> + not_possible + end; +coalesce_skips_is(_, _, _) -> + not_possible. + %%% %%% Short-cutting binary matching instructions. %%% @@ -1117,6 +1182,175 @@ bsm_units_join_1([], _MapA, Right) -> Right. %%% +%%% Optimize binary construction. +%%% +%%% If an integer segment or a float segment has a literal size and +%%% a literal value, convert to a binary segment. Coalesce adjacent +%%% literal binary segments. Literal binary segments will be converted +%%% to bs_put_string instructions in later pass. +%%% + +ssa_opt_bs_puts(#st{ssa=Linear0,cnt=Count0}=St) -> + {Linear,Count} = opt_bs_puts(Linear0, Count0, []), + St#st{ssa=Linear,cnt=Count}. + +opt_bs_puts([{L,#b_blk{is=Is}=Blk0}|Bs], Count0, Acc0) -> + case Is of + [#b_set{op=bs_put}=I0] -> + case opt_bs_put(L, I0, Blk0, Count0, Acc0) of + not_possible -> + opt_bs_puts(Bs, Count0, [{L,Blk0}|Acc0]); + {Count,Acc1} -> + Acc = opt_bs_puts_merge(Acc1), + opt_bs_puts(Bs, Count, Acc) + end; + _ -> + opt_bs_puts(Bs, Count0, [{L,Blk0}|Acc0]) + end; +opt_bs_puts([], Count, Acc) -> + {reverse(Acc),Count}. + +opt_bs_puts_merge([{L1,#b_blk{is=Is}=Blk0},{L2,#b_blk{is=AccIs}}=BAcc|Acc]) -> + case {AccIs,Is} of + {[#b_set{op=bs_put, + args=[#b_literal{val=binary}, + #b_literal{}, + #b_literal{val=Bin0}, + #b_literal{val=all}, + #b_literal{val=1}]}], + [#b_set{op=bs_put, + args=[#b_literal{val=binary}, + #b_literal{}, + #b_literal{val=Bin1}, + #b_literal{val=all}, + #b_literal{val=1}]}=I0]} -> + %% Coalesce the two segments to one. + Bin = <<Bin0/bitstring,Bin1/bitstring>>, + I = I0#b_set{args=bs_put_args(binary, Bin, all)}, + Blk = Blk0#b_blk{is=[I]}, + [{L2,Blk}|Acc]; + {_,_} -> + [{L1,Blk0},BAcc|Acc] + end. + +opt_bs_put(L, I0, #b_blk{last=Br0}=Blk0, Count0, Acc) -> + case opt_bs_put(I0) of + [Bin] when is_bitstring(Bin) -> + Args = bs_put_args(binary, Bin, all), + I = I0#b_set{args=Args}, + Blk = Blk0#b_blk{is=[I]}, + {Count0,[{L,Blk}|Acc]}; + [{int,Int,Size},Bin] when is_bitstring(Bin) -> + %% Construct a bs_put_integer instruction following + %% by a bs_put_binary instruction. + IntArgs = bs_put_args(integer, Int, Size), + BinArgs = bs_put_args(binary, Bin, all), + {BinL,BinVarNum} = {Count0,Count0+1}, + Count = Count0 + 2, + BinVar = #b_var{name={'@ssa_bool',BinVarNum}}, + BinI = I0#b_set{dst=BinVar,args=BinArgs}, + BinBlk = Blk0#b_blk{is=[BinI],last=Br0#b_br{bool=BinVar}}, + IntI = I0#b_set{args=IntArgs}, + IntBlk = Blk0#b_blk{is=[IntI],last=Br0#b_br{succ=BinL}}, + {Count,[{BinL,BinBlk},{L,IntBlk}|Acc]}; + not_possible -> + not_possible + end. + +opt_bs_put(#b_set{args=[#b_literal{val=binary},_,#b_literal{val=Val}, + #b_literal{val=all},#b_literal{val=Unit}]}) + when is_bitstring(Val) -> + if + bit_size(Val) rem Unit =:= 0 -> + [Val]; + true -> + not_possible + end; +opt_bs_put(#b_set{args=[#b_literal{val=Type},#b_literal{val=Flags}, + #b_literal{val=Val},#b_literal{val=Size}, + #b_literal{val=Unit}]}=I0) when is_integer(Size) -> + EffectiveSize = Size * Unit, + if + EffectiveSize > 0 -> + case {Type,opt_bs_put_endian(Flags)} of + {integer,big} when is_integer(Val) -> + if + EffectiveSize < 64 -> + [<<Val:EffectiveSize>>]; + true -> + opt_bs_put_split_int(Val, EffectiveSize) + end; + {integer,little} when is_integer(Val), EffectiveSize < 128 -> + %% To avoid an explosion in code size, we only try + %% to optimize relatively small fields. + <<Int:EffectiveSize>> = <<Val:EffectiveSize/little>>, + Args = bs_put_args(Type, Int, EffectiveSize), + I = I0#b_set{args=Args}, + opt_bs_put(I); + {binary,_} when is_bitstring(Val) -> + <<Bitstring:EffectiveSize/bits,_/bits>> = Val, + [Bitstring]; + {float,Endian} -> + try + [opt_bs_put_float(Val, EffectiveSize, Endian)] + catch error:_ -> + not_possible + end; + {_,_} -> + not_possible + end; + true -> + not_possible + end; +opt_bs_put(#b_set{}) -> not_possible. + +opt_bs_put_float(N, Sz, Endian) -> + case Endian of + big -> <<N:Sz/big-float-unit:1>>; + little -> <<N:Sz/little-float-unit:1>> + end. + +bs_put_args(Type, Val, Size) -> + [#b_literal{val=Type}, + #b_literal{val=[unsigned,big]}, + #b_literal{val=Val}, + #b_literal{val=Size}, + #b_literal{val=1}]. + +opt_bs_put_endian([big=E|_]) -> E; +opt_bs_put_endian([little=E|_]) -> E; +opt_bs_put_endian([native=E|_]) -> E; +opt_bs_put_endian([_|Fs]) -> opt_bs_put_endian(Fs). + +opt_bs_put_split_int(Int, Size) -> + Pos = opt_bs_put_split_int_1(Int, 0, Size - 1), + UpperSize = Size - Pos, + if + Pos =:= 0 -> + %% Value is 0 or -1 -- keep the original instruction. + not_possible; + UpperSize < 64 -> + %% No or few leading zeroes or ones. + [<<Int:Size>>]; + true -> + %% There are 64 or more leading ones or zeroes in + %% the resulting binary. Split into two separate + %% segments to avoid an explosion in code size. + [{int,Int bsr Pos,UpperSize},<<Int:Pos>>] + end. + +opt_bs_put_split_int_1(_Int, L, R) when L > R -> + 8 * ((L + 7) div 8); +opt_bs_put_split_int_1(Int, L, R) -> + Mid = (L + R) div 2, + case Int bsr Mid of + Upper when Upper =:= 0; Upper =:= -1 -> + opt_bs_put_split_int_1(Int, L, Mid - 1); + _ -> + opt_bs_put_split_int_1(Int, Mid + 1, R) + end. + +%%% %%% Miscellanous optimizations in execution order. %%% diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 56fe9b4793..fa1b7bb71e 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -1996,18 +1996,26 @@ reserve_zregs(Blocks, Intervals, Res) -> reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> case {Val,Last} of - {#b_literal{val=Arity},#b_br{}} when Arity bsr 32 =:= 0 -> + {#b_literal{val=Arity},#b_br{bool=#b_var{}}} when Arity bsr 32 =:= 0 -> %% These two instructions can be combined to a test_arity %% instruction provided that the arity variable is short-lived. reserve_zreg_1(Dst, ShortLived, A0); {_,_} -> - %% Either the arity is too big, or the boolean value from - %% '=:=' will be returned. + %% Either the arity is too big, or the boolean value is not + %% used in a conditional branch. A0 end; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}], #b_switch{}, ShortLived, A) -> reserve_zreg_1(Dst, ShortLived, A); +reserve_zreg([#b_set{op={bif,'xor'}}], _Last, _ShortLived, A) -> + %% There is no short, easy way to rewrite 'xor' to a series of + %% test instructions. + A; +reserve_zreg([#b_set{op={bif,is_record}}], _Last, _ShortLived, A) -> + %% There is no short, easy way to rewrite is_record/2 to a series of + %% test instructions. + A; reserve_zreg([#b_set{op=Op,dst=Dst}|Is], Last, ShortLived, A0) -> IsZReg = case Op of bs_match_string -> true; diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 95fc3bb0e9..ab5ea4b1a4 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -23,7 +23,7 @@ -include("beam_ssa.hrl"). -import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - reverse/1,sort/1]). + partition/2,reverse/1,sort/1]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). @@ -153,8 +153,15 @@ opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], Sub = Sub0#{Dst=>Lit}, opt_is(Is, Ts0, Ds0, Ls, Sub, Acc); #b_var{}=Var -> - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts0, Ds0, Ls, Sub, Acc) + case Is of + [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> + %% We must remove this 'succeeded' instruction. + Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, + opt_is([], Ts0, Ds0, Ls, Sub, Acc); + _ -> + Sub = Sub0#{Dst=>Var}, + opt_is(Is, Ts0, Ds0, Ls, Sub, Acc) + end end; opt_is([], Ts, Ds, _Ls, Sub, Acc) -> {reverse(Acc),Ts,Ds,Sub}. @@ -436,12 +443,12 @@ update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> %% no need to include the type database passed on to the %% successors of this block. Ts = maps:remove(Bool, Ts0), - D = update_successor(Fail, Ts, D0), - SuccTs = infer_types(Bool, Ts, D0), + {SuccTs,FailTs} = infer_types(Bool, Ts, D0), + D = update_successor(Fail, FailTs, D0), update_successor(Succ, SuccTs, D); false -> - D = update_successor_bool(Bool, false, Fail, Ts0, D0), - SuccTs = infer_types(Bool, Ts0, D0), + {SuccTs,FailTs} = infer_types(Bool, Ts0, D0), + D = update_successor_bool(Bool, false, Fail, FailTs, D0), update_successor_bool(Bool, true, Succ, SuccTs, D) end; update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> @@ -458,7 +465,8 @@ update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> end, foldl(F, D, List); false -> - D = update_successor(Fail, Ts0, D0), + FailTs = subtract_types([{V,join_sw_list(List, Ts0, none)}], Ts0), + D = update_successor(Fail, FailTs, D0), F = fun({Val,S}, A) -> T = get_type(Val, Ts0), update_successor(S, Ts0#{V=>T}, A) @@ -467,6 +475,10 @@ update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> end; update_successors(#b_ret{}, _Ts, D) -> D. +join_sw_list([{Val,_}|T], Ts, Type) -> + join_sw_list(T, Ts, join(Type, get_type(Val, Ts))); +join_sw_list([], _, Type) -> Type. + update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> case t_is_boolean(get_type(Var, Ts)) of true -> @@ -542,6 +554,14 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, {_,_} -> #t_tuple{} end; + {erlang,'++',[List1,List2]} -> + case get_type(List1, Ts) =:= cons orelse + get_type(List2, Ts) =:= cons of + true -> cons; + false -> list + end; + {erlang,'--',[_,_]} -> + list; {math,_,_} -> case is_math_bif(Name, length(Args)) of false -> any; @@ -873,10 +893,84 @@ get_type(#b_literal{val=Val}, _Ts) -> any end. -infer_types(#b_var{}=V, Ts, #d{ds=Ds}) -> +%% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} +%% Looking at the expression that defines the variable Var, infer +%% the types for the variables in the arguments. Return the updated +%% type database for the case that the expression evaluates to +%% true, and and for the case that it evaluates to false. +%% +%% Here is an example. The variable being asked about is +%% the variable Bool, which is defined like this: +%% +%% Bool = is_nonempty_list L +%% +%% If 'is_nonempty_list L' evaluates to 'true', L must +%% must be cons. The meet of the previously known type of L and 'cons' +%% will be added to SuccTypes. +%% +%% On the other hand, if 'is_nonempty_list L' evaluates to false, L +%% is not cons and cons can be subtracted from the previously known +%% type for L. For example, if L was known to be 'list', subtracting +%% 'cons' would give 'nil' as the only possible type. The result of the +%% subtraction for L will be added to FailTypes. +%% +%% Here is another example, asking about the variable Bool: +%% +%% Head = bif:hd L +%% Bool = succeeded Head +%% +%% 'succeeded Head' will evaluate to 'true' if the instrution that +%% defined Head succeeded. In this case, it is the 'bif:hd L' +%% instruction, which will succeed if L is 'cons'. Thus, the meet of +%% the previous type for L and 'cons' will be added to SuccTypes. +%% +%% If 'succeeded Head' evaluates to 'false', it means that 'bif:hd L' +%% failed and that L is not 'cons'. 'cons' can be subtracted from the +%% previously known type for L and the result put in FailTypes. + +infer_types(#b_var{}=V, Ts, #d{ds=Ds,once=Once}) -> #{V:=#b_set{op=Op,args=Args}} = Ds, - Types = infer_type(Op, Args, Ds), - meet_types(Types, Ts). + Types0 = infer_type(Op, Args, Ds), + + %% We must be careful with types inferred from '=:='. + %% + %% If we have seen L =:= [a], we know that L is 'cons' if the + %% comparison succeeds. However, if the comparison fails, L could + %% still be 'cons'. Therefore, we must not subtract 'cons' from the + %% previous type of L. + %% + %% However, it is safe to subtract a type inferred from '=:=' if + %% it is single-valued, e.g. if it is [] or the atom 'true'. + EqTypes0 = infer_eq_type(Op, Args, Ts, Ds), + {Types1,EqTypes} = partition(fun({_,T}) -> + is_singleton_type(T) + end, EqTypes0), + + %% Don't bother updating the types for variables that + %% are never used again. + Types2 = Types1 ++ Types0, + Types = [P || {InfV,_}=P <- Types2, not cerl_sets:is_element(InfV, Once)], + + {meet_types(EqTypes++Types, Ts),subtract_types(Types, Ts)}. + +infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> + Def = maps:get(Src, Ds), + Type = get_type(Lit, Ts), + [{Src,Type}|infer_tuple_size(Def, Lit) ++ + infer_first_element(Def, Lit)]; +infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> + %% As an example, assume that L1 is known to be 'list', and L2 is + %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can + %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). + Type0 = get_type(Arg0, Ts), + Type1 = get_type(Arg1, Ts), + Type = meet(Type0, Type1), + [{V,MeetType} || + {V,OrigType,MeetType} <- + [{Arg0,Type0,Type},{Arg1,Type1,Type}], + OrigType =/= MeetType]; +infer_eq_type(_Op, _Args, _Ts, _Ds) -> + []. infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> if @@ -885,20 +979,27 @@ infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> true -> [] end; -infer_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ds) -> - Def = maps:get(Src, Ds), - Type = get_type(Lit, #{}), - [{Src,Type}|infer_tuple_size(Def, Lit) ++ - infer_first_element(Def, Lit)]; +infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) -> + [{Position,t_integer()},{Tuple,#t_tuple{}}]; infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) -> case inferred_bif_type(Bif, Args) of any -> []; T -> [{Src,T}] end; +infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) -> + [{Src,{binary,8}}]; infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) -> [{Src,map}]; infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) -> [{Src,map}]; +infer_type({bif,Bif}, [_,_]=Args, _Ds) -> + case inferred_bif_type(Bif, Args) of + any -> []; + T -> [{A,T} || #b_var{}=A <- Args] + end; +infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) -> + [{Src,{binary,8}}| + [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]]; infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> [{Bin,{binary,1}}]; infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> @@ -969,6 +1070,7 @@ inferred_bif_type(is_number, [_]) -> number; inferred_bif_type(is_tuple, [_]) -> #t_tuple{}; inferred_bif_type(abs, [_]) -> number; inferred_bif_type(bit_size, [_]) -> {binary,1}; +inferred_bif_type('bnot', [_]) -> t_integer(); inferred_bif_type(byte_size, [_]) -> {binary,1}; inferred_bif_type(ceil, [_]) -> number; inferred_bif_type(float, [_]) -> number; @@ -976,10 +1078,25 @@ inferred_bif_type(floor, [_]) -> number; inferred_bif_type(hd, [_]) -> cons; inferred_bif_type(length, [_]) -> list; inferred_bif_type(map_size, [_]) -> map; +inferred_bif_type('not', [_]) -> t_boolean(); inferred_bif_type(round, [_]) -> number; inferred_bif_type(trunc, [_]) -> number; inferred_bif_type(tl, [_]) -> cons; inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; +inferred_bif_type('and', [_,_]) -> t_boolean(); +inferred_bif_type('or', [_,_]) -> t_boolean(); +inferred_bif_type('xor', [_,_]) -> t_boolean(); +inferred_bif_type('band', [_,_]) -> t_integer(); +inferred_bif_type('bor', [_,_]) -> t_integer(); +inferred_bif_type('bsl', [_,_]) -> t_integer(); +inferred_bif_type('bsr', [_,_]) -> t_integer(); +inferred_bif_type('bxor', [_,_]) -> t_integer(); +inferred_bif_type('div', [_,_]) -> t_integer(); +inferred_bif_type('rem', [_,_]) -> t_integer(); +inferred_bif_type('+', [_,_]) -> number; +inferred_bif_type('-', [_,_]) -> number; +inferred_bif_type('*', [_,_]) -> number; +inferred_bif_type('/', [_,_]) -> number; inferred_bif_type(_, _) -> any. infer_tuple_size(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, @@ -1088,6 +1205,11 @@ t_tuple_size(#t_tuple{size=Size,exact=true}) -> t_tuple_size(_) -> none. +is_singleton_type(#t_atom{elements=[_]}) -> true; +is_singleton_type(#t_integer{elements={V,V}}) -> true; +is_singleton_type(nil) -> true; +is_singleton_type(_) -> false. + %% join(Type1, Type2) -> Type %% Return the "join" of Type1 and Type2. The join is a more general %% type than Type1 and Type2. For example: @@ -1152,14 +1274,40 @@ gcd(A, B) -> meet_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - T = meet(T0, T1), - meet_types(Vs, Ts#{V:=T}); + case meet(T0, T1) of + T1 -> meet_types(Vs, Ts); + T -> meet_types(Vs, Ts#{V:=T}) + end; meet_types([], Ts) -> Ts. meet([T1,T2|Ts]) -> meet([meet(T1, T2)|Ts]); meet([T]) -> T. +subtract_types([{V,T0}|Vs], Ts) -> + #{V:=T1} = Ts, + case subtract(T1, T0) of + T1 -> subtract_types(Vs, Ts); + T -> subtract_types(Vs, Ts#{V:=T}) + end; +subtract_types([], Ts) -> Ts. + +%% subtract(Type1, Type2) -> Type. +%% Subtract Type2 from Type1. Example: +%% +%% subtract(list, cons) -> nil + +subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> + case ordsets:subtract(Set0, Set1) of + [] -> none; + [_|_]=Set -> #t_atom{elements=Set} + end; +subtract(number, float) -> #t_integer{}; +subtract(number, #t_integer{elements=any}) -> float; +subtract(list, cons) -> nil; +subtract(list, nil) -> cons; +subtract(T, _) -> T. + %% meet(Type1, Type2) -> Type %% Return the "meet" of Type1 and Type2. The meet is a narrower %% type than Type1 and Type2. For example: diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 1945faba7f..46c689e034 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -809,6 +809,14 @@ valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), branch_state(Lbl, Vst); +valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> + validate_src([Src], Vst), + Type = case get_term_type(Src, Vst) of + cons -> cons; + nil -> nil; + _ -> list + end, + set_aliased_type(Type, Src, branch_state(Lbl, Vst)); valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> Vst = branch_state(Lbl, Vst0), case Src of @@ -820,20 +828,27 @@ valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> _ -> kill_state(Vst0) end; +valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> + case get_term_type(Src, Vst) of + list -> + branch_state(Lbl, set_type_reg(cons, Src, Vst)); + _ -> + branch_state(Lbl, Vst) + end; valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> validate_src(Ss, Vst0), Infer = infer_types(Src, Vst0), Vst1 = Infer(Val, Vst0), - Vst = branch_state(Lbl, Vst1), - case Val of - {literal,Tuple} when is_tuple(Tuple) -> - Type0 = get_term_type(Val, Vst), - Type = upgrade_tuple_type({tuple,tuple_size(Tuple)}, - Type0), - set_aliased_type(Type, Src, Vst); - _ -> - Vst - end; + Vst2 = upgrade_ne_types(Src, Val, Vst1), + Vst3 = branch_state(Lbl, Vst2), + Vst = Vst3#vst{current=Vst1#vst.current}, + upgrade_eq_types(Src, Val, Vst); +valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> + validate_src(Ss, Vst0), + Vst1 = upgrade_eq_types(Src, Val, Vst0), + Vst2 = branch_state(Lbl, Vst1), + Vst = Vst2#vst{current=Vst0#vst.current}, + upgrade_ne_types(Src, Val, Vst); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); @@ -920,6 +935,25 @@ valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> valfun_4(_, _) -> error(unknown_instruction). +upgrade_ne_types(Src1, Src2, Vst0) -> + T1 = get_durable_term_type(Src1, Vst0), + T2 = get_durable_term_type(Src2, Vst0), + Type = subtract(T1, T2), + set_aliased_type(Type, Src1, Vst0). + +upgrade_eq_types(Src1, Src2, Vst0) -> + T1 = get_durable_term_type(Src1, Vst0), + T2 = get_durable_term_type(Src2, Vst0), + Meet = meet(T1, T2), + Vst = case T1 =/= Meet of + true -> set_aliased_type(Meet, Src1, Vst0); + false -> Vst0 + end, + case T2 =/= Meet of + true -> set_aliased_type(Meet, Src2, Vst); + false -> Vst + end. + verify_get_map(Fail, Src, List, Vst0) -> assert_not_literal(Src), %OTP 22. assert_type(map, Src, Vst0), @@ -1509,12 +1543,16 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% term Any valid Erlang (but not of the special types above). %% +%% binary Binary or bitstring. +%% %% bool The atom 'true' or the atom 'false'. %% %% cons Cons cell: [_|_] %% %% nil Empty list: [] %% +%% list List: [] or [_|_] +%% %% {tuple,[Sz]} Tuple. An element has been accessed using %% element/2 or setelement/3 so that it is known that %% the type is a tuple of size at least Sz. @@ -1535,7 +1573,7 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% map Map. %% -%% +%% none A conflict in types. There will be an exception at runtime. %% %% FRAGILITY %% --------- @@ -1548,6 +1586,47 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% Such terms are wrapped in a {fragile,Type} tuple, where Type is one %% of the types described above. +%% meet(Type1, Type2) -> Type +%% Return the meet of two types. The meet is a more specific type. +%% It will be 'none' if the types are in conflict. + +meet(Same, Same) -> + Same; +meet(term, Other) -> + Other; +meet(Other, term) -> + Other; +meet(T1, T2) -> + case {erlang:min(T1, T2),erlang:max(T1, T2)} of + {{atom,_}=A,{atom,[]}} -> A; + {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; + {bool,{atom,[]}} -> bool; + {cons,list} -> cons; + {{float,_}=T,{float,[]}} -> T; + {{integer,_}=T,{integer,[]}} -> T; + {list,nil} -> nil; + {number,{integer,_}=T} -> T; + {number,{float,_}=T} -> T; + {{tuple,Size1},{tuple,Size2}} -> + case {Size1,Size2} of + {[Sz1],[Sz2]} -> + {tuple,[erlang:max(Sz1, Sz2)]}; + {Sz1,[Sz2]} when Sz2 =< Sz1 -> + {tuple,Sz1}; + {_,_} -> + none + end; + {_,_} -> none + end. + +%% subtract(Type1, Type2) -> Type +%% Subtract Type2 from Type2. Example: +%% subtract(list, nil) -> cons + +subtract(list, nil) -> cons; +subtract(list, cons) -> nil; +subtract(Type, _) -> Type. + assert_type(WantedType, Term, Vst) -> case get_term_type(Term, Vst) of {fragile,Type} -> @@ -1581,25 +1660,27 @@ assert_type(Needed, Actual) -> %% be executed at run-time. upgrade_tuple_type(NewType, {fragile,OldType}) -> - make_fragile(upgrade_tuple_type_1(NewType, OldType)); + Type = upgrade_tuple_type_1(NewType, OldType), + make_fragile(Type); upgrade_tuple_type(NewType, OldType) -> upgrade_tuple_type_1(NewType, OldType). -upgrade_tuple_type_1({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz -> - %% The old type has a higher value for the least tuple size. - T; -upgrade_tuple_type_1({tuple,[Sz]}, {tuple,OldSz}=T) - when is_integer(Sz), is_integer(OldSz), Sz =< OldSz -> - %% The old size is exact, and the new size is smaller than the old size. - T; -upgrade_tuple_type_1({tuple,_}=T, _) -> - %% The new type information is exact or has a higher value for - %% the least tuple size. - %% Note that inconsistencies are also handled in this - %% clause, e.g. if the old type was an integer or a tuple accessed - %% outside its size; inconsistences will generally cause an exception - %% at run-time but are safe from our point of view. - T. +upgrade_tuple_type_1(NewType, OldType) -> + case meet(NewType, OldType) of + none -> + %% Unoptimized code may look like this: + %% + %% {test,is_list,Fail,[Reg]}. + %% {test,is_tuple,Fail,[Reg]}. + %% {test,test_arity,Fail,[Reg,5]}. + %% + %% Note that the test_arity instruction can never be reached. + %% To make sure it's not rejected, set the type of Reg to + %% NewType instead of 'none'. + NewType; + Type -> + Type + end. get_tuple_size({integer,[]}) -> 0; get_tuple_size({integer,Sz}) -> Sz; @@ -1608,6 +1689,17 @@ get_tuple_size(_) -> 0. validate_src(Ss, Vst) when is_list(Ss) -> foreach(fun(S) -> get_term_type(S, Vst) end, Ss). +%% get_durable_term_type(Src, ValidatorState) -> Type +%% Get the type of the source Src. The returned type Type will be +%% a standard Erlang type (no catch/try tags or match contexts). +%% Fragility will be stripped. + +get_durable_term_type(Src, Vst) -> + case get_term_type(Src, Vst) of + {fragile,Type} -> Type; + Type -> Type + end. + %% get_move_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be %% a standard Erlang type (no catch/try tags). Match contexts are OK. @@ -1641,6 +1733,8 @@ get_term_type_1(nil=T, _) -> T; get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; get_term_type_1({float,F}=T, _) when is_float(F) -> T; get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; +get_term_type_1({literal,[_|_]}, _) -> cons; +get_term_type_1({literal,Bitstring}, _) when is_bitstring(Bitstring) -> binary; get_term_type_1({literal,Map}, _) when is_map(Map) -> map; get_term_type_1({literal,Tuple}, _) when is_tuple(Tuple) -> {tuple,tuple_size(Tuple)}; @@ -2041,6 +2135,14 @@ return_type_1(erlang, setelement, 3, Vst) -> {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType); _ -> TupleType end; +return_type_1(erlang, '++', 2, Vst) -> + case get_term_type({x,0}, Vst) =:= cons orelse + get_term_type({x,1}, Vst) =:= cons of + true -> cons; + false -> list + end; +return_type_1(erlang, '--', 2, _Vst) -> + list; return_type_1(erlang, F, A, _) -> return_type_erl(F, A); return_type_1(math, F, A, _) -> diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 677094b3cd..415b579240 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -71,6 +71,31 @@ undo_renames([{get_hd,Src,Dst1},{get_tl,Src,Dst2}|Is]) -> [{get_list,Src,Dst1,Dst2}|undo_renames(Is)]; undo_renames([{get_tl,Src,Dst2},{get_hd,Src,Dst1}|Is]) -> [{get_list,Src,Dst1,Dst2}|undo_renames(Is)]; +undo_renames([{bs_put,_,{bs_put_binary,1,_}, + [{atom,all},{literal,<<>>}]}|Is]) -> + undo_renames(Is); +undo_renames([{bs_put,Fail,{bs_put_binary,1,_Flags}, + [{atom,all},{literal,BinString}]}|Is0]) -> + Bits = bit_size(BinString), + Bytes = Bits div 8, + case Bits rem 8 of + 0 -> + I = {bs_put_string,byte_size(BinString), + {string,BinString}}, + [undo_rename(I)|undo_renames(Is0)]; + Rem -> + <<Binary:Bytes/bytes,Int:Rem>> = BinString, + PutInt = {bs_put_integer,Fail,{integer,Rem},1, + {field_flags,[unsigned,big]},{integer,Int}}, + Is = [PutInt|undo_renames(Is0)], + case Binary of + <<>> -> + Is; + _ -> + [{bs_put_string,byte_size(Binary), + {string,Binary}}|Is] + end + end; undo_renames([I|Is]) -> [undo_rename(I)|undo_renames(Is)]; undo_renames([]) -> []. @@ -79,8 +104,6 @@ undo_rename({bs_put,F,{I,U,Fl},[Sz,Src]}) -> {I,F,Sz,U,Fl,Src}; undo_rename({bs_put,F,{I,Fl},[Src]}) -> {I,F,Fl,Src}; -undo_rename({bs_put,{f,0},{bs_put_string,_,_}=I,[]}) -> - I; undo_rename({bif,bs_add=I,F,[Src1,Src2,{integer,U}],Dst}) -> {I,F,[Src1,Src2,U],Dst}; undo_rename({bif,bs_utf8_size=I,F,[Src],Dst}) -> @@ -101,7 +124,7 @@ undo_rename({test,bs_match_string=Op,F,[Ctx,Bin0]}) -> 0 -> Bin0; Rem -> <<Bin0/bitstring,0:(8-Rem)>> end, - {test,Op,F,[Ctx,Bits,{string,binary_to_list(Bin)}]}; + {test,Op,F,[Ctx,Bits,{string,Bin}]}; undo_rename({put_map,Fail,assoc,S,D,R,L}) -> {put_map_assoc,Fail,S,D,R,L}; undo_rename({put_map,Fail,exact,S,D,R,L}) -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 14c8c5b4ab..73c66e6efc 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -855,8 +855,6 @@ asm_passes() -> {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, - {unless,no_bs_opt,{pass,beam_bs}}, - {iff,dbs,{listing,"bs"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, {unless,no_peep_opt,{pass,beam_peep}}, @@ -2084,7 +2082,6 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, - beam_bs, beam_clean, beam_dict, beam_except, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 1472e3fde1..108a0ca100 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,7 +24,6 @@ beam_a, beam_asm, beam_block, - beam_bs, beam_clean, beam_dict, beam_disasm, diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index ce9762899e..d925decce6 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -195,6 +195,7 @@ is_safe(erlang, is_float, 1) -> true; is_safe(erlang, is_function, 1) -> true; is_safe(erlang, is_integer, 1) -> true; is_safe(erlang, is_list, 1) -> true; +is_safe(erlang, is_map, 1) -> true; is_safe(erlang, is_number, 1) -> true; is_safe(erlang, is_pid, 1) -> true; is_safe(erlang, is_port, 1) -> true; diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 918e45ff6f..6efa98de44 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -213,6 +213,10 @@ coverage(Config) -> [_|_] -> ok end, + + %% Cover beam_type:verified_type(none). + {'EXIT',{badarith,_}} = (catch (id(2) / id(1)) band 16#ff), + ok. booleans(_Config) -> diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index ccc49df005..69017d87e7 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -153,6 +153,8 @@ l(I_13, I_big1, I_16, Bin) -> [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 16#77,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF, 16#FF,16#FF,16#FF,16#FF,16#FF,16#FF]), + ?T(<< (<<"abc",7:3>>):3/binary >>, + [$a,$b,$c]), %% Mix different units. ?T(<<37558955:(I_16-12)/unit:8,1:1>>, @@ -311,6 +313,9 @@ fail(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>), {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>), + %% Unaligned sizes with literal binaries. + {'EXIT',{badarg,_}} = (catch <<0,(<<7777:17>>)/binary>>), + ok. float_bin(Config) when is_list(Config) -> diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 6eae7b1404..c17d63cd60 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -391,7 +391,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dcg, ".codegen"), do_listing(Simple, TargetDir, dblk, ".block"), do_listing(Simple, TargetDir, dexcept, ".except"), - do_listing(Simple, TargetDir, dbs, ".bs"), do_listing(Simple, TargetDir, djmp, ".jump"), do_listing(Simple, TargetDir, dclean, ".clean"), do_listing(Simple, TargetDir, dpeep, ".peep"), diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 8393dced06..60ab969929 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -25,7 +25,7 @@ match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1, - unary_op/1]). + unary_op/1,eq_types/1]). -include_lib("common_test/include/ct.hrl"). @@ -40,7 +40,7 @@ groups() -> match_in_call,untuplify, shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, - grab_bag,literal_binary,unary_op]}]. + grab_bag,literal_binary,unary_op,eq_types]}]. init_per_suite(Config) -> @@ -390,6 +390,13 @@ untuplify(Config) when is_list(Config) -> %% We do this to cover sys_core_fold:unalias_pat/1. {1,2,3,4,alias,{[1,2],{3,4},alias}} = untuplify_1([1,2], {3,4}, alias), error = untuplify_1([1,2], {3,4}, 42), + + %% Test that a previous bug in v3_codegen is gone. (The sinking of + %% stack frames into only the case arms that needed them was not always + %% safe.) + [33, -1, -33, 1] = untuplify_2(32, 65), + {33, 1, -33, -1} = untuplify_2(65, 32), + ok. untuplify_1(A, B, C) -> @@ -402,6 +409,21 @@ untuplify_1(A, B, C) -> error end. +untuplify_2(V1, V2) -> + {D1,D2,D3,D4} = + if V1 > V2 -> + %% The 1 value was overwritten by the value of V2-V1. + {V1-V2, 1, V2-V1, -1}; + true -> + {V2-V1, -1, V1-V2, 1} + end, + if + D2 > D4 -> + {D1, D2, D3, D4}; + true -> + [D1, D2, D3, D4] + end. + %% Coverage of beam_dead:shortcut_boolean_label/4. shortcut_boolean(Config) when is_list(Config) -> false = shortcut_boolean_1([0]), @@ -848,5 +870,25 @@ unary_op_1(Vop@1) -> end end. +eq_types(_Config) -> + Ref = make_ref(), + Ref = eq_types(Ref, any), + ok. + +eq_types(A, B) -> + %% {put_tuple2,{y,0},{list,[{x,0},{x,1}]}}. + Term0 = {A, B}, + Term = id(Term0), + + %% {test,is_eq_exact,{f,3},[{y,0},{x,0}]}. + %% Here beam_validator must infer that {x,0} has the + %% same type as {y,0}. + Term = Term0, + + %% {get_tuple_element,{x,0},0,{x,0}}. + {Ref22,_} = Term, + + Ref22. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 2a6303ece8..e999c8ffae 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -223,10 +223,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_block:module(BlockInput, []) end), - %% beam_bs - BsInput = BlockInput, - expect_error(fun() -> beam_bs:module(BsInput, []) end), - %% beam_except ExceptInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 97179b7fc4..efedb414ad 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.3 +COMPILER_VSN = 7.3.1 diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index e046a25338..8b320e01a9 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -6,6 +6,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- MODULES = \ + crypto_bench_SUITE \ blowfish_SUITE \ crypto_SUITE \ engine_SUITE @@ -77,7 +78,7 @@ release_spec: release_tests_spec: $(TEST_TARGET) $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) crypto.spec crypto.cover $(RELTEST_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) crypto.spec crypto_bench.spec crypto.cover $(RELTEST_FILES) "$(RELSYSDIR)" @tar cfh - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) chmod -R u+w "$(RELSYSDIR)" diff --git a/lib/crypto/test/crypto.spec b/lib/crypto/test/crypto.spec index cc09970cb3..4a95275687 100644 --- a/lib/crypto/test/crypto.spec +++ b/lib/crypto/test/crypto.spec @@ -1 +1,6 @@ {suites,"../crypto_test",all}. + +{skip_suites, "../crypto_test", [crypto_bench_SUITE + ], + "Benchmarks run separately"}. + diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 82d098ebd1..003e0c58b1 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -156,7 +156,7 @@ groups() -> ]}, {dh, [], [generate_compute, compute_bug]}, - {ecdh, [], [generate_all_supported, compute, generate]}, + {ecdh, [], [use_all_elliptic_curves, compute, generate]}, {srp, [], [generate_compute]}, {des_cbc, [], [block]}, {des_cfb, [], [block]}, @@ -563,32 +563,43 @@ compute(Config) when is_list(Config) -> Gen = proplists:get_value(compute, Config), lists:foreach(fun do_compute/1, Gen). %%-------------------------------------------------------------------- -generate_all_supported() -> - [{doc, " Test that all curves from crypto:ec_curves/0 returns two binaries"}]. -generate_all_supported(_Config) -> +use_all_elliptic_curves() -> + [{doc, " Test that all curves from crypto:ec_curves/0"}]. +use_all_elliptic_curves(_Config) -> + Msg = <<"hello world!">>, + Sups = crypto:supports(), + Curves = proplists:get_value(curves, Sups), + Hashs = proplists:get_value(hashs, Sups), + ct:log("Lib: ~p~nFIPS: ~p~nCurves:~n~p~nHashs: ~p", [crypto:info_lib(), + crypto:info_fips(), + Curves, + Hashs]), Results = - [try - crypto:generate_key(ecdh, C) - of - {B1,B2} when is_binary(B1) and is_binary(B2) -> - %% That is, seems like it works as expected. - {ok,C}; - Err -> - ct:log("ERROR: Curve ~p generated ~p", [C,Err]), - {error,{C,Err}} - catch - Cls:Err:Stack -> - ct:log("ERROR: Curve ~p exception ~p:~p~n~p", [C,Cls,Err,Stack]), - {error,{C,{Cls,Err}}} - end - || C <- crypto:ec_curves(), - not lists:member(C, [ed25519, ed448]) + [{{Curve,Hash}, + try + {Pub,Priv} = crypto:generate_key(ecdh, Curve), + true = is_binary(Pub), + true = is_binary(Priv), + Sig = crypto:sign(ecdsa, Hash, Msg, [Priv, Curve]), + crypto:verify(ecdsa, Hash, Msg, Sig, [Pub, Curve]) + catch + C:E -> + {C,E} + end} + || Curve <- Curves -- [ed25519, ed448, x25519, x448, ipsec3, ipsec4], + Hash <- Hashs -- [md4, md5, ripemd160, sha3_224, sha3_256, sha3_384, sha3_512] ], - OK = [C || {ok,C} <- Results], - ct:log("Ok (len=~p): ~p", [length(OK), OK]), - false = lists:any(fun({error,_}) -> true; - (_) -> false - end, Results). + Fails = + lists:filter(fun({_,true}) -> false; + (_) -> true + end, Results), + case Fails of + [] -> + ok; + _ -> + ct:log("Fails:~n~p",[Fails]), + ct:fail("Bad curve(s)",[]) + end. %%-------------------------------------------------------------------- generate() -> diff --git a/lib/crypto/test/crypto_bench.spec b/lib/crypto/test/crypto_bench.spec new file mode 100644 index 0000000000..b9a26d94db --- /dev/null +++ b/lib/crypto/test/crypto_bench.spec @@ -0,0 +1,3 @@ +{suites, "../crypto_test", [ + crypto_bench_SUITE + ]}. diff --git a/lib/crypto/test/crypto_bench_SUITE.erl b/lib/crypto/test/crypto_bench_SUITE.erl new file mode 100644 index 0000000000..e1fd0a63e5 --- /dev/null +++ b/lib/crypto/test/crypto_bench_SUITE.erl @@ -0,0 +1,387 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(crypto_bench_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> [%%{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}, + {timetrap,{minutes,2}} + ]. + +all() -> + [ + {group, ciphers_128} + ]. + +groups() -> + [ + {ciphers_128, [{repeat, 3}], [{group,textblock_256} + ]}, + + {textblock_256, [{repeat,2}], [ + block, + stream + ]} + ]. + +%%%---------------------------------------------------------------- +%%% +init_per_suite(Config) -> + try crypto:start() of + _ -> + [{_,_,Info}] = crypto:info_lib(), + ct:comment("~s",[Info]), + ct:pal("Crypto version: ~p~n~n~p",[Info,crypto:supports()]), + [{sec_goal,5} | Config] + catch _:_ -> + {fail, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + application:stop(crypto). + +%%%---------------------------------------------------------------- +%%% +init_per_group(Group, Config0) -> + ct:pal("~p(~p,..)",[?FUNCTION_NAME,Group]), + + Config = calibrate(Config0), + case atom_to_list(Group) of + "ciphers_"++KeySizeStr -> + KeySize = list_to_integer(KeySizeStr), + [{key_size,KeySize} + | measure_openssl_aes_cbc(KeySize, Config)]; + + "textblock_"++BlockSizeStr -> + BlockSize = list_to_integer(BlockSizeStr), + [{block_size,BlockSize} | Config]; + + _ -> + Config + end. + +end_per_group(_Group, Config) -> + Config. + + +measure_openssl_aes_cbc(KeySize, Config) -> + BLno_acc = [baseline(aes_cbc, KeySize, false)], + ct:pal("Non-accelerated baseline encryption time [µs/block]:~n~p", [BLno_acc]), + BLacc = [baseline(aes_cbc, KeySize, true)], + ct:pal("Possibly accelerated baseline encryption time [µs/block]:~n~p", [BLacc]), + [{acc,BLacc}, + {no_acc,BLno_acc} | Config]. + +calibrate(Config) -> + Secs = proplists:get_value(sec_goal, Config, 5), + {_,Empty} = data(empty, 0, 0), + {Ne,Te} = run1(Secs*2000, Empty), + [{overhead,Te/Ne} | Config]. + +%%%================================================================ +%%% +%%% +block(Config) -> + run_cryptos([aes_cbc, aes_gcm, aes_ccm, chacha20_poly1305], + Config). + +stream(Config) -> + run_cryptos([aes_ctr, chacha20], + Config). + +%%%================================================================ +%%% +%%% + +run_cryptos(Cryptos, Config) -> + run_cryptos(Cryptos, 1, Config). + +run_cryptos(Cryptos, Factor, Config) -> + KeySize = proplists:get_value(key_size, Config), + BlockSize = proplists:get_value(block_size, Config), + MilliSecGoal = 1000*proplists:get_value(sec_goal,Config), + OverHead = proplists:get_value(overhead, Config, 0), + [try + Factor*run(Crypto,KeySize,BlockSize,MilliSecGoal) - OverHead + of + TimePerOp -> % µs + %% First, Report speed of encrypting blocks of 1000. [blocks/sec] + ReportUnit = 1000, + Label = [fmt(Crypto)," key:",KeySize," block:",BlockSize], + report(Label, + (BlockSize/ReportUnit)*1000000/TimePerOp + ), + + EffCrypto = case Crypto of + X -> X + end, + %% Percent of accelerated speed + case find_value([acc,{EffCrypto,KeySize},BlockSize], Config) of + undefined -> + ok; + TimePerOpBaseAcc -> + report(["Percent of acc OpenSSL "|Label], + 100*TimePerOpBaseAcc/TimePerOp % Percent of base *speed* + ) + end, + + %% Percent of non-accelerated speed + case find_value([no_acc,{EffCrypto,KeySize},BlockSize], Config) of + undefined -> + ok; + TimePerOpBaseNoAcc -> + report(["Percent of noacc OpenSSL "|Label], + 100*TimePerOpBaseNoAcc/TimePerOp % Percent of base *speed* + ) + end + catch + _:_ -> + ct:pal("~p unsupported",[{Crypto,KeySize,BlockSize}]) + end + || Crypto <- Cryptos, + supported(Crypto) + ]. + + +run(Crypto, KeySize, BlockSize, MilliSecGoal) -> + {_Type, Funs} = data(Crypto, KeySize, BlockSize), + {Nc,Tc} = run1(MilliSecGoal, Funs), + Tc/Nc. + +fmt(X) -> X. + + +find_value(KeyPath, PropList, Default) -> + try find_value(KeyPath, PropList) + of + undefined -> Default + catch + error:function_clause -> Default + end. + +find_value(KeyPath, PropList) -> + lists:foldl(fun(K, L) when is_list(L) -> proplists:get_value(K,L); + (_, _) -> undefined + end, PropList, KeyPath). + +%%%================================================================ +%%% +%%% +funs({block, {Type, Key, IV, Block}}) -> + {fun() -> ok end, + fun(_) -> crypto:block_encrypt(Type, Key, IV, Block) end, + fun(_) -> ok end}; + +funs({stream, {Type, Key, IV, Block}}) -> + {fun() -> {crypto:stream_init(Type, Key, IV),ok} end, + fun({Ctx,_}) -> crypto:stream_encrypt(Ctx, Block) end, + fun(_) -> ok end}. + + +data(aes_cbc, KeySize, BlockSize) -> + Type = case KeySize of + 128 -> aes_cbc128; + 256 -> aes_cbc256 + end, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + Block = mk_bin(BlockSize), + {Type, funs({block, {Type, Key, IV, Block}})}; + +data(aes_gcm, KeySize, BlockSize) -> + Type = aes_gcm, + Key = mk_bin(KeySize div 8), + IV = mk_bin(12), + Block = mk_bin(BlockSize), + AAD = <<01,02,03,04>>, + {Type, funs({block, {Type, Key, IV, {AAD,Block,16}}})}; + +data(aes_ccm, KeySize, BlockSize) -> + Type = aes_ccm, + Key = mk_bin(KeySize div 8), + IV = mk_bin(12), + Block = mk_bin(BlockSize), + AAD = <<01,02,03,04>>, + {Type, funs({block, {Type, Key, IV, {AAD,Block,12}}})}; + +data(aes_ctr, KeySize, BlockSize) -> + Type = aes_ctr, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + Block = mk_bin(BlockSize), + {Type, funs({stream, {Type, Key, IV, Block}})}; + +data(chacha20_poly1305, 256=KeySize, BlockSize) -> + Type = chacha20_poly1305, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + AAD = <<01,02,03,04>>, + Block = mk_bin(BlockSize), + {Type, funs({block, {Type, Key, IV, {AAD,Block}}})}; + +data(chacha20, 256=KeySize, BlockSize) -> + Type = chacha20, + Key = mk_bin(KeySize div 8), + IV = mk_bin(16), + Block = mk_bin(BlockSize), + {Type, funs({stream, {Type, Key, IV, Block}})}; + +data(empty, 0, 0) -> + {undefined, + {fun() -> ok end, + fun(X) -> X end, + fun(_) -> ok end}}. + +%%%================================================================ +%%% +%%% +run1(MilliSecGoal, Funs) -> + Parent = self(), + Pid = spawn(fun() -> + {Fi,Fu,Ff} = Funs, + Ctx0 = Fi(), + T0 = start_time(), + {N,Ctx} = loop(Fu, Ctx0, 0), + T = elapsed_time(T0), + Ff(Ctx), + Parent ! {result,N,microseconds(T)} + end), + Pid ! go, + receive + after MilliSecGoal -> + Pid ! stop + end, + receive + {result,N,MicroSecs} -> + {N,MicroSecs} + end. + + +loop(F, Ctx, N) -> + receive + stop -> + {N, Ctx} + after 0 -> + loop(F, F(Ctx), N+1) + end. + +%%%---------------------------------------------------------------- +report(LabelList, Value) -> + Label = report_chars(lists:concat(LabelList)), + ct:pal("ct_event:notify ~p: ~p", [Label, Value]), + ct_event:notify( + #event{name = benchmark_data, + data = [{name, Label}, + {value,Value}]}). + +report_chars(Cs) -> + [case C of + $- -> $_; + _ -> C + end || C <- Cs]. + +%%%---------------------------------------------------------------- +supported(Algorithm) -> + lists:member(Algorithm, + [A || {_,As} <- crypto:supports(), A <- As] + ). + +%%%---------------------------------------------------------------- +start_time() -> + erlang:system_time(). + +elapsed_time(StartTime) -> + erlang:system_time() - StartTime. + +microseconds(Time) -> + erlang:convert_time_unit(Time, native, microsecond). + +%%%---------------------------------------------------------------- + +%% Example output: +%% +DT:aes-128-cbc:3:16 +%% +R:135704772:aes-128-cbc:2.980000 +%% +DT:aes-128-cbc:3:64 +%% +R:36835089:aes-128-cbc:3.000000 +%% +DT:aes-128-cbc:3:256 +%% +R:9398616:aes-128-cbc:3.000000 +%% +DT:aes-128-cbc:3:1024 +%% +R:2355683:aes-128-cbc:2.990000 +%% +DT:aes-128-cbc:3:8192 +%% +R:294508:aes-128-cbc:2.990000 +%% +H:16:64:256:1024:8192 +%% +F:22:aes-128-cbc:728616225.50:785815232.00:802015232.00:806762338.46:806892821.40 + +baseline(Crypto, KeySize, EVP) -> + Spec= + case {Crypto,KeySize} of + {aes_cbc, 128} -> "aes-128-cbc"; + {aes_cbc, 256} -> "aes-256-cbc" + end, + {{Crypto,KeySize}, baseline(Spec, EVP)}. + +baseline(Spec, EVP) -> + Cmd = + case EVP of + true -> "openssl speed -mr -evp " ++ Spec; + false-> "openssl speed -mr " ++ Spec + end, + get_base_values(string:tokens(os:cmd(Cmd),"\n"), Spec, []). + + +get_base_values(["+DT:"++Sdt, + "+R:"++Sr + |T], Crypto, Acc) -> + [Crypto0,_GoalSecs0,BlockSize0] = string:tokens(Sdt, ":"), + [Nblocks0,Crypto0,RealSecs0] = string:tokens(Sr, ":"), + Crypto = fix_possible_space_bug(Crypto0), + RealSecs = list_to_float(RealSecs0), + BlockSize = list_to_integer(BlockSize0), + Nblocks = list_to_integer(Nblocks0), + get_base_values(T, Crypto, [{BlockSize, 1000000*RealSecs/Nblocks} | Acc]); + +get_base_values([_|T], Crypto, Acc) -> + get_base_values(T, Crypto, Acc); + +get_base_values([], _, Acc) -> + lists:sort(Acc). + +fix_possible_space_bug(S) -> lists:concat(lists:join("-",string:tokens(S,"- "))). + +%%%---------------------------------------------------------------- +mk_bin(Size) when Size =< 256 -> + list_to_binary(lists:seq(0,Size-1)); + +mk_bin(Size) when 1024 =< Size -> + B = mk_bin(Size div 4), + Brest = mk_bin(Size rem 4), + <<B/binary, B/binary, B/binary, B/binary, Brest/binary>>; + +mk_bin(Size) when 256 < Size -> + B = mk_bin(Size div 2), + Brest = mk_bin(Size rem 2), + <<B/binary, B/binary, Brest/binary>>. + diff --git a/lib/inets/doc/src/httpd_util.xml b/lib/inets/doc/src/httpd_util.xml index 29971ba8ae..e0f947f860 100644 --- a/lib/inets/doc/src/httpd_util.xml +++ b/lib/inets/doc/src/httpd_util.xml @@ -45,8 +45,7 @@ <fsummary>Converts the date to the Erlang date format.</fsummary> <type> <v>DateString = string()</v> - <v>ErlDate = {{Year,Month,Date},{Hour,Min,Sec}}</v> - <v>Year = Month = Date = Hour = Min = Sec = integer()</v> + <v>ErlDate = calendar:datetime() </v> </type> <desc> <p><c>convert_request_date/1</c> converts <c>DateString</c> to @@ -281,10 +280,10 @@ <func> <name since="">rfc1123_date() -> RFC1123Date</name> - <name since="">rfc1123_date({{YYYY,MM,DD},{Hour,Min,Sec}}) -> RFC1123Date</name> + <name since="">rfc1123_date(Date) -> RFC1123Date</name> <fsummary>Returns the current date in RFC 1123 format.</fsummary> <type> - <v>YYYY = MM = DD = Hour = Min = Sec = integer()</v> + <v> Date = calendar:datetime()</v> <v>RFC1123Date = string()</v> </type> <desc> diff --git a/lib/inets/test/httpd_bench_SUITE.erl b/lib/inets/test/httpd_bench_SUITE.erl index 4b549dcb5b..087516f56c 100644 --- a/lib/inets/test/httpd_bench_SUITE.erl +++ b/lib/inets/test/httpd_bench_SUITE.erl @@ -37,7 +37,8 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- suite() -> - [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. + [{timetrap, {minutes, 1}}, + {ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. all() -> [ @@ -499,8 +500,8 @@ start_dummy("http"= Protocol, Config) -> Conf = [ %%{big, filename:join(DataDir, "1M_file")}, %%{small, filename:join(DataDir, "1k_file")}, - {big, {gen, crypto:rand_bytes(1000000)}}, - {small, {gen, crypto:rand_bytes(1000)}}, + {big, {gen, crypto:strong_rand_bytes(1000000)}}, + {small, {gen, crypto:strong_rand_bytes(1000)}}, {http_version, HTTPVersion}, {keep_alive, ?config(keep_alive, Config)} ], @@ -519,8 +520,8 @@ start_dummy("https" = Protocol, Config) -> Opts = [{active, true}, {nodelay, true}, {reuseaddr, true} | SSLOpts], Conf = [%%{big, filename:join(DataDir, "1M_file")}, %%{small, filename:join(DataDir, "1k_file")}, - {big, {gen, crypto:rand_bytes(1000000)}}, - {small, {gen, crypto:rand_bytes(1000)}}, + {big, {gen, crypto:strong_rand_bytes(1000000)}}, + {small, {gen, crypto:strong_rand_bytes(1000)}}, {http_version, HTTPVersion}, {keep_alive, ?config(keep_alive, Config)} ], diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 104c698591..709ba8e8fd 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -1007,13 +1007,34 @@ get_tcpi_sacked(Sock) -> <marker id="option-linger"></marker> </item> <tag><c>{linger, {true|false, Seconds}}</c></tag> - <item> + <item> <p>Determines the time-out, in seconds, for flushing unsent data - in the <c>close/1</c> socket call. If the first component of - the value tuple is <c>false</c>, the second is ignored. This - means that <c>close/1</c> returns immediately, not waiting - for data to be flushed. Otherwise, the second component is - the flushing time-out, in seconds.</p> + in the <c>close/1</c> socket call. </p> + <p>The first component is if linger is enabled, the second component + is the flushing time-out, in seconds. There are 3 alternatives:</p> + <taglist> + <tag><c>{false, _}</c></tag> + <item> + <p>close/1 or shutdown/2 returns immediately, + not waiting for data to be flushed, with closing + happening in the background.</p> + </item> + <tag><c>{true, 0}</c></tag> + <item> + <p>Aborts the connection when it is closed. + Discards any data still remaining in the send buffers + and sends RST to the peer.</p> + <p>This avoids TCP's TIME_WAIT state, but leaves open + the possibility that another "incarnation" of this connection + being created.</p> + </item> + <tag><c>{true, Time} when Time > 0</c></tag> + <item> + <p>close/1 or shutdown/2 will not return until + all queued messages for the socket have been successfully + sent or the linger timeout (Time) has been reached.</p> + </item> + </taglist> </item> <tag><c>{low_msgq_watermark, Size}</c></tag> <item> diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 7828cc4716..a0154b2694 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -295,7 +295,7 @@ is_real_system(KernelVsn, StdlibVsn) -> %% before restart. %% ------------------------------------------------ many_restarts() -> - [{timetrap,{minutes,8}}]. + [{timetrap,{minutes,16}}]. many_restarts(Config) when is_list(Config) -> {ok, Node} = loose_node:start(init_test, "", ?DEFAULT_TIMEOUT_SEC), @@ -315,7 +315,7 @@ loop_restart(N,Node,EHPid) -> loose_node:stop(Node), ct:fail(not_stopping) end, - ok = wait_for(30, Node, EHPid), + ok = wait_for(60, Node, EHPid), loop_restart(N-1,Node,rpc:call(Node,erlang,whereis,[logger])). wait_for(0,Node,_) -> @@ -367,7 +367,8 @@ restart(Config) when is_list(Config) -> SysProcs0 = rpc:call(Node, ?MODULE, find_system_processes, []), io:format("SysProcs0=~p~n", [SysProcs0]), [InitPid, PurgerPid, LitCollectorPid, - DirtySigNPid, DirtySigHPid, DirtySigMPid] = SysProcs0, + DirtySigNPid, DirtySigHPid, DirtySigMPid, + PrimFilePid] = SysProcs0, InitPid = rpc:call(Node, erlang, whereis, [init]), PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]), Procs = rpc:call(Node, erlang, processes, []), @@ -385,7 +386,8 @@ restart(Config) when is_list(Config) -> SysProcs1 = rpc:call(Node, ?MODULE, find_system_processes, []), io:format("SysProcs1=~p~n", [SysProcs1]), [InitPid1, PurgerPid1, LitCollectorPid1, - DirtySigNPid1, DirtySigHPid1, DirtySigMPid1] = SysProcs1, + DirtySigNPid1, DirtySigHPid1, DirtySigMPid1, + PrimFilePid1] = SysProcs1, %% Still the same init process! InitPid1 = rpc:call(Node, erlang, whereis, [init]), @@ -411,6 +413,10 @@ restart(Config) when is_list(Config) -> DirtySigMP = pid_to_list(DirtySigMPid), DirtySigMP = pid_to_list(DirtySigMPid1), + %% and same prim_file helper process! + PrimFileP = pid_to_list(PrimFilePid), + PrimFileP = pid_to_list(PrimFilePid1), + NewProcs0 = rpc:call(Node, erlang, processes, []), NewProcs = NewProcs0 -- SysProcs1, case check_processes(NewProcs, MaxPid) of @@ -437,7 +443,8 @@ restart(Config) when is_list(Config) -> literal_collector, dirty_sig_handler_normal, dirty_sig_handler_high, - dirty_sig_handler_max}). + dirty_sig_handler_max, + prim_file}). find_system_processes() -> find_system_procs(processes(), #sys_procs{}). @@ -448,7 +455,8 @@ find_system_procs([], SysProcs) -> SysProcs#sys_procs.literal_collector, SysProcs#sys_procs.dirty_sig_handler_normal, SysProcs#sys_procs.dirty_sig_handler_high, - SysProcs#sys_procs.dirty_sig_handler_max]; + SysProcs#sys_procs.dirty_sig_handler_max, + SysProcs#sys_procs.prim_file]; find_system_procs([P|Ps], SysProcs) -> case process_info(P, [initial_call, priority]) of [{initial_call,{erl_init,start,2}},_] -> @@ -472,6 +480,9 @@ find_system_procs([P|Ps], SysProcs) -> {priority,max}] -> undefined = SysProcs#sys_procs.dirty_sig_handler_max, find_system_procs(Ps, SysProcs#sys_procs{dirty_sig_handler_max = P}); + [{initial_call,{prim_file,start,0}},_] -> + undefined = SysProcs#sys_procs.prim_file, + find_system_procs(Ps, SysProcs#sys_procs{prim_file = P}); _ -> find_system_procs(Ps, SysProcs) end. diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index a71e8fc29c..d6b5eff9b5 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -204,4 +204,4 @@ dump_persistent_terms() -> create_persistent_terms() -> persistent_term:put({?MODULE,first}, {pid,42.0}), persistent_term:put({?MODULE,second}, [1,2,3]), - persistent_term:get(). + {persistent_term:get({?MODULE,first}),persistent_term:get({?MODULE,second})}. diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 8c5e618f4a..31cf7011d4 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -615,9 +615,8 @@ special(File,Procs) -> #proc{dict=Dict} = ProcDetails, %% io:format("~p\n", [Dict]), - Pts1 = crashdump_helper:create_persistent_terms(), - Pts2 = proplists:get_value(pts,Dict), - true = lists:sort(Pts1) =:= lists:sort(Pts2), + Pts = crashdump_helper:create_persistent_terms(), + Pts = proplists:get_value(pts,Dict), io:format(" persistent terms ok",[]), ok; _ -> diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index 8c799f6ff1..fb4f61417e 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -2749,6 +2749,11 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean ext errmsg_buffer_size = errmsg_buffer_size - errmsg_size; acc_errmsg_size = acc_errmsg_size + errmsg_size; current_errmsg_pos = current_errmsg_pos + errmsg_size; + } else if(result == SQL_SUCCESS_WITH_INFO && errmsg_size >= errmsg_buffer_size) { + memcpy(diagnos.sqlState, current_sql_state, SQL_STATE_SIZE); + diagnos.nativeError = nativeError; + acc_errmsg_size = errmsg_buffer_size; + break; } else { break; } diff --git a/lib/runtime_tools/examples/dist.systemtap b/lib/runtime_tools/examples/dist.systemtap index bb20d617e1..4102a5243c 100644 --- a/lib/runtime_tools/examples/dist.systemtap +++ b/lib/runtime_tools/examples/dist.systemtap @@ -19,18 +19,18 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("dist-monitor") +probe process("beam.smp").mark("dist-monitor") { printf("monitor: pid %d, who %s, what %s, node %s, type %s, reason %s\n", pid(), @@ -38,38 +38,38 @@ probe process("beam").mark("dist-monitor") user_string($arg5)); } -probe process("beam").mark("dist-port_busy") +probe process("beam.smp").mark("dist-port_busy") { printf("dist port_busy: node %s, port %s, remote_node %s, blocked pid %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); - blocked_procs[user_string($arg4)] = timestamp; + blocked_procs[user_string($arg4)] = local_clock_ns(); } -probe process("beam").mark("dist-port_busy") +probe process("beam.smp").mark("dist-port_busy") { printf("dist port_busy: node %s, port %s, remote_node %s, blocked pid %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); - blocked_procs[user_string($arg4)] = timestamp; + blocked_procs[user_string($arg4)] = local_clock_ns(); } -probe process("beam").mark("dist-output") +probe process("beam.smp").mark("dist-output") { printf("dist output: node %s, port %s, remote_node %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("dist-outputv") +probe process("beam.smp").mark("dist-outputv") { printf("port outputv: node %s, port %s, remote_node %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("process-scheduled") +probe process("beam.smp").mark("process-scheduled") { pidstr = user_string($arg1); if (pidstr in blocked_procs) { printf("blocked pid %s scheduled now, waited %d microseconds\n", - pidstr, (timestamp - blocked_procs[pidstr]) / 1000); + pidstr, (local_clock_ns() - blocked_procs[pidstr]) / 1000); delete blocked_procs[pidstr]; } } diff --git a/lib/runtime_tools/examples/driver1.systemtap b/lib/runtime_tools/examples/driver1.systemtap index e1ee8ecffc..f5bc28b42d 100644 --- a/lib/runtime_tools/examples/driver1.systemtap +++ b/lib/runtime_tools/examples/driver1.systemtap @@ -19,108 +19,102 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("driver-init") +probe process("beam.smp").mark("driver__init") { printf("driver init name %s major %d minor %d flags %d\n", user_string($arg1), $arg2, $arg3, $arg4); } -probe process("beam").mark("driver-start") +probe process("beam.smp").mark("driver__start") { printf("driver start pid %s driver name %s port %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-stop") +probe process("beam.smp").mark("driver__stop") { printf("driver stop pid %s driver name %s port %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-finish") +probe process("beam.smp").mark("driver__finish") { printf("driver finish driver name %s\n", user_string($arg1)); } -probe process("beam").mark("driver-flush") +probe process("beam.smp").mark("driver__flush") { printf("driver flush pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-output") +probe process("beam.smp").mark("driver__output") { printf("driver output pid %s port %s port name %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("driver-outputv") +probe process("beam.smp").mark("driver__outputv") { printf("driver outputv pid %s port %s port name %s bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4); } -probe process("beam").mark("driver-control") +probe process("beam.smp").mark("driver__control") { printf("driver control pid %s port %s port name %s command %d bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4, $arg5); } -probe process("beam").mark("driver-call") +probe process("beam.smp").mark("driver__call") { printf("driver call pid %s port %s port name %s command %d bytes %d\n", user_string($arg1), user_string($arg2), user_string($arg3), $arg4, $arg5); } -probe process("beam").mark("driver-event") -{ - printf("driver event pid %s port %s port name %s\n", - user_string($arg1), user_string($arg2), user_string($arg3)); -} - -probe process("beam").mark("driver-ready_input") +probe process("beam.smp").mark("driver__ready_input") { printf("driver ready_input pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-ready_output") +probe process("beam.smp").mark("driver__ready_output") { printf("driver ready_output pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-timeout") +probe process("beam.smp").mark("driver__timeout") { printf("driver timeout pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-ready_async") +probe process("beam.smp").mark("driver__ready_async") { printf("driver ready_async pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-process_exit") +probe process("beam.smp").mark("driver__process_exit") { printf("driver process_exit pid %s port %s port name %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("driver-stop_select") +probe process("beam.smp").mark("driver__stop_select") { printf("driver stop_select driver name %s\n", user_string($arg1)); } diff --git a/lib/runtime_tools/examples/function-calls.systemtap b/lib/runtime_tools/examples/function-calls.systemtap index 9c44b2d014..6bb173b3ec 100644 --- a/lib/runtime_tools/examples/function-calls.systemtap +++ b/lib/runtime_tools/examples/function-calls.systemtap @@ -18,51 +18,51 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("local-function-entry") +probe process("beam.smp").mark("local-function-entry") { printf("pid %s enter (local) %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } -probe process("beam").mark("global-function-entry") +probe process("beam.smp").mark("global-function-entry") { printf("pid %s enter (global) %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } -probe process("beam").mark("function-return") +probe process("beam.smp").mark("function-return") { printf("pid %s return %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } -probe process("beam").mark("bif-entry") +probe process("beam.smp").mark("bif-entry") { printf("pid %s BIF entry mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("bif-return") +probe process("beam.smp").mark("bif-return") { printf("pid %s BIF return mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("nif-entry") +probe process("beam.smp").mark("nif-entry") { printf("pid %s NIF entry mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("nif-return") +probe process("beam.smp").mark("nif-return") { printf("pid %s NIF return mfa %s\n", user_string($arg1), user_string($arg2)); } diff --git a/lib/runtime_tools/examples/garbage-collection.systemtap b/lib/runtime_tools/examples/garbage-collection.systemtap index e414eea821..14f0d6851c 100644 --- a/lib/runtime_tools/examples/garbage-collection.systemtap +++ b/lib/runtime_tools/examples/garbage-collection.systemtap @@ -18,33 +18,33 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("gc_major-start") +probe process("beam.smp").mark("gc_major-start") { printf("GC major start pid %s need %d words\n", user_string($arg1), $arg2); } -probe process("beam").mark("gc_minor-start") +probe process("beam.smp").mark("gc_minor-start") { printf("GC minor start pid %s need %d words\n", user_string($arg1), $arg2); } -probe process("beam").mark("gc_major-end") +probe process("beam.smp").mark("gc_major-end") { printf("GC major end pid %s reclaimed %d words\n", user_string($arg1), $arg2); } -probe process("beam").mark("gc_minor-start") +probe process("beam.smp").mark("gc_minor-start") { printf("GC minor end pid %s reclaimed %d words\n", user_string($arg1), $arg2); } diff --git a/lib/runtime_tools/examples/memory1.systemtap b/lib/runtime_tools/examples/memory1.systemtap index 04df4d64c4..2fdc5a796c 100644 --- a/lib/runtime_tools/examples/memory1.systemtap +++ b/lib/runtime_tools/examples/memory1.systemtap @@ -18,34 +18,34 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("copy-struct") +probe process("beam.smp").mark("copy-struct") { printf("copy_struct %d bytes\n", $arg1); } -probe process("beam").mark("copy-object") +probe process("beam.smp").mark("copy-object") { printf("copy_object pid %s %d bytes\n", user_string($arg1), $arg2); } -probe process("beam").mark("process-heap_grow") +probe process("beam.smp").mark("process-heap_grow") { printf("proc heap grow pid %s %d -> %d bytes\n", user_string($arg1), $arg2, $arg3); } -probe process("beam").mark("process-heap_shrink") +probe process("beam.smp").mark("process-heap_shrink") { printf("proc heap shrink pid %s %d -> %d bytes\n", user_string($arg1), $arg2, $arg3); diff --git a/lib/runtime_tools/examples/messages.systemtap b/lib/runtime_tools/examples/messages.systemtap index f2ef56a22b..49b7f46d69 100644 --- a/lib/runtime_tools/examples/messages.systemtap +++ b/lib/runtime_tools/examples/messages.systemtap @@ -18,15 +18,15 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ probe begin @@ -38,7 +38,7 @@ probe begin printf("\n"); } -probe process("beam").mark("message-send") +probe process("beam.smp").mark("message-send") { if ($arg4 == 0 && $arg5 == 0 && $arg6 == 0) { printf("send: %s -> %s: %d words\n", @@ -51,7 +51,7 @@ probe process("beam").mark("message-send") } } -probe process("beam").mark("message-send-remote") +probe process("beam.smp").mark("message-send-remote") { if ($arg5 == 0 && $arg6 == 0 && $arg7 == 0) { printf("send : %s -> %s %s: %d words\n", @@ -64,7 +64,7 @@ probe process("beam").mark("message-send-remote") } } -probe process("beam").mark("message-queued") +probe process("beam.smp").mark("message-queued") { if ($arg4 == 0 && $arg5 == 0 && $arg6 == 0) { printf("queued: %s: %d words, queue len %d\n", user_string($arg1), $arg2, $arg3); @@ -75,7 +75,7 @@ probe process("beam").mark("message-queued") } } -probe process("beam").mark("message-receive") +probe process("beam.smp").mark("message-receive") { if ($arg4 == 0 && $arg5 == 0 && $arg6 == 0) { printf("receive: %s: %d words, queue len %d\n", diff --git a/lib/runtime_tools/examples/port1.systemtap b/lib/runtime_tools/examples/port1.systemtap index f7ce03a65e..235581b0b1 100644 --- a/lib/runtime_tools/examples/port1.systemtap +++ b/lib/runtime_tools/examples/port1.systemtap @@ -18,15 +18,15 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ probe begin @@ -96,19 +96,19 @@ probe begin driver_map["udp_inet", 62] = "BINDX"; } -probe process("beam").mark("port-open") +probe process("beam.smp").mark("port-open") { printf("port open pid %s port name %s port %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("port-command") +probe process("beam.smp").mark("port-command") { printf("port command pid %s port %s port name %s command type %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); } -probe process("beam").mark("port-control") +probe process("beam.smp").mark("port-control") { cmd = driver_map[user_string($arg3), $arg4]; cmd_str = (cmd == "") ? "unknown" : cmd; @@ -118,36 +118,36 @@ probe process("beam").mark("port-control") /* port-exit is fired as a result of port_close() or exit signal */ -probe process("beam").mark("port-exit") +probe process("beam.smp").mark("port-exit") { printf("port exit pid %s port %s port name %s reason %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); } -probe process("beam").mark("port-connect") +probe process("beam.smp").mark("port-connect") { printf("port connect pid %s port %s port name %s new pid %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); } -probe process("beam").mark("port-busy") +probe process("beam.smp").mark("port-busy") { printf("port busy %s\n", user_string($arg1)); } -probe process("beam").mark("port-not_busy") +probe process("beam.smp").mark("port-not_busy") { printf("port not busy %s\n", user_string($arg1)); } -probe process("beam").mark("aio_pool-add") +probe process("beam.smp").mark("aio_pool-add") { printf("async I/O pool add thread %d queue len %d\n", $arg1, $arg2); } -probe process("beam").mark("aio_pool-get") +probe process("beam.smp").mark("aio_pool-get") { printf("async I/O pool get thread %d queue len %d\n", $arg1, $arg2); } -global driver_map;
\ No newline at end of file +global driver_map; diff --git a/lib/runtime_tools/examples/process-scheduling.systemtap b/lib/runtime_tools/examples/process-scheduling.systemtap index b0b74257b3..231c589f64 100644 --- a/lib/runtime_tools/examples/process-scheduling.systemtap +++ b/lib/runtime_tools/examples/process-scheduling.systemtap @@ -18,28 +18,28 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("process-scheduled") +probe process("beam.smp").mark("process-scheduled") { printf(" Schedule pid %s mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("process-unscheduled") +probe process("beam.smp").mark("process-unscheduled") { printf("Unschedule pid %s\n", user_string($arg1)); } -probe process("beam").mark("process-hibernate") +probe process("beam.smp").mark("process-hibernate") { printf(" Hibernate pid %s resume mfa %s\n", user_string($arg1), user_string($arg2)); diff --git a/lib/runtime_tools/examples/spawn-exit.systemtap b/lib/runtime_tools/examples/spawn-exit.systemtap index 89bca14496..a7b4a0a3ea 100644 --- a/lib/runtime_tools/examples/spawn-exit.systemtap +++ b/lib/runtime_tools/examples/spawn-exit.systemtap @@ -18,34 +18,34 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("process-spawn") +probe process("beam.smp").mark("process-spawn") { printf("pid %s mfa %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("process-exit") +probe process("beam.smp").mark("process-exit") { printf("pid %s reason %s\n", user_string($arg1), user_string($arg2)); } -probe process("beam").mark("process-exit_signal") +probe process("beam.smp").mark("process-exit_signal") { printf("sender %s -> pid %s reason %s\n", user_string($arg1), user_string($arg2), user_string($arg3)); } -probe process("beam").mark("process-exit_signal-remote") +probe process("beam.smp").mark("process-exit_signal-remote") { printf("sender %s -> node %s pid %s reason %s\n", user_string($arg1), user_string($arg2), user_string($arg3), user_string($arg4)); diff --git a/lib/runtime_tools/examples/user-probe-n.systemtap b/lib/runtime_tools/examples/user-probe-n.systemtap index 25f7503283..8a0a89c931 100644 --- a/lib/runtime_tools/examples/user-probe-n.systemtap +++ b/lib/runtime_tools/examples/user-probe-n.systemtap @@ -18,18 +18,19 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("user_trace-n0") + +probe process("beam.smp").mark("user_trace-n0") { printf("probe n0: %s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", user_string($arg1), @@ -41,7 +42,7 @@ probe process("beam").mark("user_trace-n0") $arg9 == NULL ? "" : user_string($arg9)); } -probe process("beam").mark("user_trace-n1") +probe process("beam.smp").mark("user_trace-n1") { printf("probe n1: %s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", user_string($arg1), diff --git a/lib/runtime_tools/examples/user-probe.systemtap b/lib/runtime_tools/examples/user-probe.systemtap index 1777476e54..ce9dde30f8 100644 --- a/lib/runtime_tools/examples/user-probe.systemtap +++ b/lib/runtime_tools/examples/user-probe.systemtap @@ -18,23 +18,23 @@ * %CopyrightEnd% */ /* - * Note: This file assumes that you're using the non-SMP-enabled Erlang - * virtual machine, "beam". The SMP-enabled VM is called "beam.smp". + * Note: This file assumes that you're using the SMP-enabled Erlang + * virtual machine, "beam.smp". * Note that other variations of the virtual machine also have * different names, e.g. the debug build of the SMP-enabled VM * is "beam.debug.smp". * * To use a different virtual machine, replace each instance of - * "beam" with "beam.smp" or the VM name appropriate to your - * environment. + * "beam.smp" with "beam.debug.smp" or the VM name appropriate + * to your environment. */ -probe process("beam").mark("user_trace-s1") +probe process("beam.smp").mark("user_trace-s1") { printf("%s\n", user_string($arg1)); } -probe process("beam").mark("user_trace-i4s4") +probe process("beam.smp").mark("user_trace-i4s4") { printf("%s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", user_string($arg1), diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 278f6a9780..aa9ba0f9bb 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -508,11 +508,8 @@ close_our_file({_,Fd}, FileMod, FS0) -> FS1. %%% stat: do the stat -stat(Vsn, ReqId, Data, State, F) when Vsn =< 3-> - <<?UINT32(BLen), BPath:BLen/binary>> = Data, - stat(ReqId, unicode:characters_to_list(BPath), State, F); -stat(Vsn, ReqId, Data, State, F) when Vsn >= 4-> - <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(_Flags)>> = Data, +stat(Vsn, ReqId, Data, State, F) -> + <<?UINT32(BLen), BPath:BLen/binary, _/binary>> = Data, stat(ReqId, unicode:characters_to_list(BPath), State, F). fstat(Vsn, ReqId, Data, State) when Vsn =< 3-> diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl index f4eef2dc77..8e82527c6e 100644 --- a/lib/ssh/test/ssh_compat_SUITE.erl +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -1126,7 +1126,24 @@ prepare_local_directory(ServerRootDir) -> "chmod 222 unreadable_file", "exit"]. + check_local_directory(ServerRootDir) -> + TimesToTry = 3, % sleep 0.5, 1, 2 and then 4 secs (7.5s in total) + check_local_directory(ServerRootDir, 500, TimesToTry-1). + +check_local_directory(ServerRootDir, SleepTime, N) -> + case do_check_local_directory(ServerRootDir) of + {error,Error} when N>0 -> + %% Could be that the erlang side is faster and the docker's operations + %% are not yet finalized. + %% Sleep for a while and retry a few times: + timer:sleep(SleepTime), + check_local_directory(ServerRootDir, 2*SleepTime, N-1); + Other -> + Other + end. + +do_check_local_directory(ServerRootDir) -> case lists:sort(ok(file:list_dir(ServerRootDir)) -- [".",".."]) of ["ex_tst1","mydir","tst2"] -> {ok,Expect} = file:read_file(filename:join(ServerRootDir,"ex_tst1")), @@ -1161,6 +1178,7 @@ check_local_directory(ServerRootDir) -> {error,{bad_dir_contents,"/"}} end. + call_sftp_in_docker(Config, ServerIP, ServerPort, Cmnds, UserDir) -> {DockerIP,DockerPort} = ip_port(Config), {ok,C} = ssh:connect(DockerIP, DockerPort, diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 6fcfe55285..82eb8ff700 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,37 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix encoding of the SRP extension length field in ssl. + The old encoding of the SRP extension length could cause + interoperability problems with third party SSL + implementations when SRP was used.</p> + <p> + Own Id: OTP-15477 Aux Id: ERL-790 </p> + </item> + <item> + <p> + Guarantee active once data delivery, handling TCP stream + properly.</p> + <p> + Own Id: OTP-15504 Aux Id: ERL-371 </p> + </item> + <item> + <p> + Correct gen_statem returns for some error cases</p> + <p> + Own Id: OTP-15505</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 2da70131e1..200fb89a4d 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -83,8 +83,9 @@ <p><c>| {ciphers, ciphers()}</c></p> <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}}</c></p> - <p><c>| {reuse_sessions, boolean()}</c></p> - <p><c>| {reuse_session, fun()} {next_protocols_advertised, [binary()]}</c></p> + <p><c>| {reuse_sessions, boolean() | save()}</c></p> + <p><c>| {reuse_session, fun() | binary()} </c></p> + <p><c>| {next_protocols_advertised, [binary()]}</c></p> <p><c>| {client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}}</c></p> <p><c>| {log_alert, boolean()}</c></p> @@ -593,11 +594,23 @@ fun(srp, Username :: string(), UserState :: term()) -> <item><p>In mode <c>verify_none</c> the default behavior is to allow all x509-path validation errors. See also option <c>verify_fun</c>.</p> </item> + + <tag><marker id="client_reuse_session"/><c>{reuse_session, binary()}</c></tag> + <item><p>Reuses a specific session earlier saved with the option + <c>{reuse_sessions, save} since ssl-9.2</c> + </p></item> - <tag><c>{reuse_sessions, boolean()}</c></tag> - <item><p>Specifies if the client is to try to reuse sessions - when possible.</p></item> - + <tag><c>{reuse_sessions, boolean() | save}</c></tag> + <item><p>When <c>save</c> is specified a new connection will be negotiated + and saved for later reuse. The session ID can be fetched with + <seealso marker="#connection_information">connection_information/2</seealso> + and used with the client option <seealso marker="#client_reuse_session">reuse_session</seealso> + The boolean value true specifies that if possible, automatized session reuse will + be performed. If a new session is created, and is unique in regard + to previous stored sessions, it will be saved for possible later reuse. + Value <c>save</c> since ssl-9.2 + </p></item> + <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag> <item><p>The DER-encoded trusted certificates. If this option is supplied it overrides option <c>cacertfile</c>.</p></item> @@ -796,11 +809,14 @@ fun(srp, Username :: string(), UserState :: term()) -> </item> <tag><c>{reuse_sessions, boolean()}</c></tag> - <item><p>Specifies if the server is to agree to reuse sessions - when requested by the clients. See also option <c>reuse_session</c>. + <item><p>The boolean value true specifies that the server will + agree to reuse sessions. Setting it to false will result in an empty + session table, that is no sessions will be reused. + See also option <seealso marker="#server_reuse_session">reuse_session</seealso> </p></item> - <tag><c>{reuse_session, fun(SuggestedSessionId, + <tag><marker id="server_reuse_session"/> + <c>{reuse_session, fun(SuggestedSessionId, PeerCert, Compression, CipherSuite) -> boolean()}</c></tag> <item><p>Enables the TLS/DTLS server to have a local policy for deciding if a session is to be reused or not. diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 3dbda2c91b..eb0f742e70 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -214,8 +214,6 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, dtls_v1:corresponding_tls_version(Version), SslOpts, Session0, ConnectionStates0, Renegotiation) of - #alert{} = Alert -> - Alert; {Session, ConnectionStates, Protocol, ServerHelloExt} -> {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign} catch throw:Alert -> @@ -224,17 +222,16 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> - case ssl_handshake:handle_server_hello_extensions(dtls_record, Random, CipherSuite, - Compression, HelloExt, - dtls_v1:corresponding_tls_version(Version), - SslOpt, ConnectionStates0, Renegotiation) of - #alert{} = Alert -> - Alert; + try ssl_handshake:handle_server_hello_extensions(dtls_record, Random, CipherSuite, + Compression, HelloExt, + dtls_v1:corresponding_tls_version(Version), + SslOpt, ConnectionStates0, Renegotiation) of {ConnectionStates, ProtoExt, Protocol} -> {Version, SessionId, ConnectionStates, ProtoExt, Protocol} + catch throw:Alert -> + Alert end. - %%-------------------------------------------------------------------- enc_handshake(#hello_verify_request{protocol_version = {Major, Minor}, @@ -343,8 +340,9 @@ decode_handshake(Version, ?CLIENT_HELLO, <<?UINT24(_), ?UINT16(_), ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> TLSVersion = dtls_v1:corresponding_tls_version(Version), + LegacyVersion = dtls_v1:corresponding_tls_version({Major, Minor}), Exts = ssl_handshake:decode_vector(Extensions), - DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, TLSVersion, client), + DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, TLSVersion, LegacyVersion, client), #client_hello{ client_version = {Major,Minor}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 2c3f8bc20f..616e9e26e7 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -942,8 +942,6 @@ handle_options(Opts0, Role, Host) -> {list, [{mode, list}]}], Opts0), assert_proplist(Opts), RecordCb = record_cb(Opts), - - ReuseSessionFun = fun(_, _, _, _) -> true end, CaCerts = handle_option(cacerts, Opts, undefined), {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder, VerifyClientOnce} = @@ -1014,9 +1012,8 @@ handle_options(Opts0, Role, Host) -> Opts, undefined), %% Do not send by default tls_version(HighestVersion)), - %% Server side option - reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), - reuse_sessions = handle_option(reuse_sessions, Opts, true), + reuse_sessions = handle_reuse_sessions_option(reuse_sessions, Opts, Role), + reuse_session = handle_reuse_session_option(reuse_session, Opts, Role), secure_renegotiate = handle_option(secure_renegotiate, Opts, true), client_renegotiation = handle_option(client_renegotiation, Opts, default_option_role(server, true, Role), @@ -1211,11 +1208,16 @@ validate_option(srp_identity, {Username, Password}) {unicode:characters_to_binary(Username), unicode:characters_to_binary(Password)}; +validate_option(reuse_session, undefined) -> + undefined; validate_option(reuse_session, Value) when is_function(Value) -> Value; +validate_option(reuse_session, Value) when is_binary(Value) -> + Value; validate_option(reuse_sessions, Value) when is_boolean(Value) -> Value; - +validate_option(reuse_sessions, save = Value) -> + Value; validate_option(secure_renegotiate, Value) when is_boolean(Value) -> Value; validate_option(client_renegotiation, Value) when is_boolean(Value) -> @@ -1374,6 +1376,26 @@ handle_signature_algorithms_option(Value, Version) when is_list(Value) handle_signature_algorithms_option(_, _Version) -> undefined. +handle_reuse_sessions_option(Key, Opts, client) -> + Value = proplists:get_value(Key, Opts, true), + validate_option(Key, Value), + Value; +handle_reuse_sessions_option(Key, Opts0, server) -> + Opts = proplists:delete({Key, save}, Opts0), + Value = proplists:get_value(Key, Opts, true), + validate_option(Key, Value), + Value. + +handle_reuse_session_option(Key, Opts, client) -> + Value = proplists:get_value(Key, Opts, undefined), + validate_option(Key, Value), + Value; +handle_reuse_session_option(Key, Opts, server) -> + ReuseSessionFun = fun(_, _, _, _) -> true end, + Value = proplists:get_value(Key, Opts, ReuseSessionFun), + validate_option(Key, Value), + Value. + validate_options([]) -> []; validate_options([{Opt, Value} | Tail]) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 1b6072dbcc..4b975d753b 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,7 +34,7 @@ -include("tls_handshake_1_3.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([security_parameters/2, security_parameters/3, security_parameters_1_3/3, +-export([security_parameters/2, security_parameters/3, security_parameters_1_3/2, cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/5, aead_decrypt/6, suites/1, all_suites/1, crypto_support_filters/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, @@ -44,10 +44,11 @@ hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1, signature_scheme/1, - scheme_to_components/1, hash_size/1]). + scheme_to_components/1, hash_size/1, effective_key_bits/1, + key_material/1]). %% RFC 8446 TLS 1.3 --export([generate_client_shares/1, generate_server_share/1]). +-export([generate_client_shares/1, generate_server_share/1, add_zero_padding/2]). -compile(inline). @@ -88,23 +89,14 @@ security_parameters(Version, CipherSuite, SecParams) -> prf_algorithm = prf_algorithm(PrfHashAlg, Version), hash_size = hash_size(Hash)}. -security_parameters_1_3(SecParams, ClientRandom, CipherSuite) -> - #{cipher := Cipher, - mac := Hash, - prf := PrfHashAlg} = ssl_cipher_format:suite_definition(CipherSuite), +security_parameters_1_3(SecParams, CipherSuite) -> + #{cipher := Cipher, prf := PrfHashAlg} = + ssl_cipher_format:suite_definition(CipherSuite), SecParams#security_parameters{ - client_random = ClientRandom, cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), - cipher_type = type(Cipher), - key_size = effective_key_bits(Cipher), - expanded_key_material_length = expanded_key_material(Cipher), - key_material_length = key_material(Cipher), - iv_size = iv_size(Cipher), - mac_algorithm = mac_algorithm(Hash), - prf_algorithm =prf_algorithm(PrfHashAlg, {3,4}), - hash_size = hash_size(Hash), - compression_algorithm = 0}. + prf_algorithm = PrfHashAlg, %% HKDF hash algorithm + cipher_type = ?AEAD}. %%-------------------------------------------------------------------- -spec cipher_init(cipher_enum(), binary(), binary()) -> #cipher_state{}. @@ -578,7 +570,8 @@ crypto_support_filters() -> end]}. is_acceptable_keyexchange(KeyExchange, _Algos) when KeyExchange == psk; - KeyExchange == null -> + KeyExchange == null; + KeyExchange == any -> true; is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == dh_anon; KeyExchange == dhe_psk -> @@ -690,10 +683,9 @@ hash_size(sha) -> hash_size(sha256) -> 32; hash_size(sha384) -> - 48. -%% Uncomment when adding cipher suite that needs it -%hash_size(sha512) -> -% 64. + 48; +hash_size(sha512) -> + 64. %%-------------------------------------------------------------------- %%% Internal functions @@ -897,8 +889,8 @@ scheme_to_components(ecdsa_secp521r1_sha512) -> {sha512, ecdsa, secp521r1}; scheme_to_components(rsa_pss_rsae_sha256) -> {sha256, rsa_pss_rsae, undefined}; scheme_to_components(rsa_pss_rsae_sha384) -> {sha384, rsa_pss_rsae, undefined}; scheme_to_components(rsa_pss_rsae_sha512) -> {sha512, rsa_pss_rsae, undefined}; -%% scheme_to_components(ed25519) -> {undefined, undefined, undefined}; -%% scheme_to_components(ed448) -> {undefined, undefined, undefined}; +scheme_to_components(ed25519) -> {undefined, undefined, undefined}; +scheme_to_components(ed448) -> {undefined, undefined, undefined}; scheme_to_components(rsa_pss_pss_sha256) -> {sha256, rsa_pss_pss, undefined}; scheme_to_components(rsa_pss_pss_sha384) -> {sha384, rsa_pss_pss, undefined}; scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined}; @@ -1240,5 +1232,24 @@ generate_key_exchange(secp384r1) -> public_key:generate_key({namedCurve, secp384r1}); generate_key_exchange(secp521r1) -> public_key:generate_key({namedCurve, secp521r1}); +generate_key_exchange(x25519) -> + crypto:generate_key(ecdh, x25519); +generate_key_exchange(x448) -> + crypto:generate_key(ecdh, x448); generate_key_exchange(FFDHE) -> public_key:generate_key(ssl_dh_groups:dh_params(FFDHE)). + + +%% TODO: Move this functionality to crypto! +%% 7.4.1. Finite Field Diffie-Hellman +%% +%% For finite field groups, a conventional Diffie-Hellman [DH76] +%% computation is performed. The negotiated key (Z) is converted to a +%% byte string by encoding in big-endian form and left-padded with zeros +%% up to the size of the prime. This byte string is used as the shared +%% secret in the key schedule as specified above. +add_zero_padding(Bin, PrimeSize) + when byte_size (Bin) =:= PrimeSize -> + Bin; +add_zero_padding(Bin, PrimeSize) -> + add_zero_padding(<<0, Bin/binary>>, PrimeSize). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 19186336cb..a95a96f644 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1050,7 +1050,7 @@ cipher(internal, #finished{verify_data = Data} = Finished, get_current_prf(ConnectionStates0, read), MasterSecret, Handshake0) of verified -> - Session = register_session(Role, host_id(Role, Host, SslOpts), Port, Session0), + Session = handle_session(Role, SslOpts, Host, Port, Session0), cipher_role(Role, Data, Session, State#state{expecting_finished = false}, Connection); #alert{} = Alert -> @@ -1199,7 +1199,7 @@ handle_call({shutdown, read_write = How}, From, StateName, ok -> {next_state, StateName, State#state{terminated = true}, [{reply, From, ok}]}; Error -> - {stop, StateName, State#state{terminated = true}, [{reply, From, Error}]} + {stop_and_reply, {shutdown, normal}, {reply, From, Error}, State#state{terminated = true}} end catch throw:Return -> @@ -1212,7 +1212,7 @@ handle_call({shutdown, How0}, From, StateName, ok -> {next_state, StateName, State, [{reply, From, ok}]}; Error -> - {stop, StateName, State, [{reply, From, Error}]} + {stop_and_reply, {shutdown, normal}, {reply, From, Error}, State} end; handle_call({recv, _N, _Timeout}, From, _, #state{socket_options = @@ -2455,15 +2455,35 @@ session_handle_params(#server_ecdh_params{curve = ECCurve}, Session) -> session_handle_params(_, Session) -> Session. -register_session(client, Host, Port, #session{is_resumable = new} = Session0) -> +handle_session(Role = server, #ssl_options{reuse_sessions = true} = SslOpts, + Host, Port, Session0) -> + register_session(Role, host_id(Role, Host, SslOpts), Port, Session0, true); +handle_session(Role = client, #ssl_options{verify = verify_peer, + reuse_sessions = Reuse} = SslOpts, + Host, Port, Session0) when Reuse =/= false -> + register_session(Role, host_id(Role, Host, SslOpts), Port, Session0, reg_type(Reuse)); +handle_session(server, _, Host, Port, Session) -> + %% Remove "session of type new" entry from session DB + ssl_manager:invalidate_session(Host, Port, Session), + Session; +handle_session(client, _,_,_, Session) -> + %% In client case there is no entry yet, so nothing to remove + Session. + +reg_type(save) -> + true; +reg_type(true) -> + unique. + +register_session(client, Host, Port, #session{is_resumable = new} = Session0, Save) -> Session = Session0#session{is_resumable = true}, - ssl_manager:register_session(Host, Port, Session), + ssl_manager:register_session(Host, Port, Session, Save), Session; -register_session(server, _, Port, #session{is_resumable = new} = Session0) -> +register_session(server, _, Port, #session{is_resumable = new} = Session0, _) -> Session = Session0#session{is_resumable = true}, ssl_manager:register_session(Port, Session), Session; -register_session(_, _, _, Session) -> +register_session(_, _, _, Session, _) -> Session. %% Already registered host_id(client, _Host, #ssl_options{server_name_indication = Hostname}) when is_list(Hostname) -> diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 6e08445798..ffd99a06ba 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -111,4 +111,61 @@ base = ?DEFAULT_DIFFIE_HELLMAN_GENERATOR}). -define(WAIT_TO_ALLOW_RENEGOTIATION, 12000). + +%%---------------------------------------------------------------------- +%% TLS 1.3 +%%---------------------------------------------------------------------- + +%% TLS 1.3 uses the same state record with the following differences: +%% +%% state :: record() +%% +%% session_cache - not implemented +%% session_cache_cb - not implemented +%% crl_db - not implemented +%% client_hello_version - Bleichenbacher mitigation in TLS 1.2 +%% client_certificate_requested - Built into TLS 1.3 state machine +%% key_algorithm - not used +%% diffie_hellman_params - used in TLS 1.2 ECDH key exchange +%% diffie_hellman_keys - used in TLS 1.2 ECDH key exchange +%% psk_identity - not used +%% srp_params - not used, no srp extension in TLS 1.3 +%% srp_keys - not used, no srp extension in TLS 1.3 +%% premaster_secret - not used +%% renegotiation - TLS 1.3 forbids renegotiation +%% hello - used in user_hello, handshake continue +%% allow_renegotiate - TLS 1.3 forbids renegotiation +%% expecting_next_protocol_negotiation - ALPN replaced NPN, depricated in TLS 1.3 +%% expecting_finished - not implemented, used by abbreviated +%% next_protocol - ALPN replaced NPN, depricated in TLS 1.3 +%% +%% connection_state :: map() +%% +%% compression_state - not used +%% mac_secret - not used +%% sequence_number - not used +%% secure_renegotiation - not used, no renegotiation_info in TLS 1.3 +%% client_verify_data - not used, no renegotiation_info in TLS 1.3 +%% server_verify_data - not used, no renegotiation_info in TLS 1.3 +%% beast_mitigation - not used +%% +%% security_parameters :: map() +%% +%% cipher_type - TLS 1.3 uses only AEAD ciphers +%% iv_size - not used +%% key_size - not used +%% key_material_length - not used +%% expanded_key_material_length - used in SSL 3.0 +%% mac_algorithm - not used +%% prf_algorithm - not used +%% hash_size - not used +%% compression_algorithm - not used +%% master_secret - used for multiple secret types in TLS 1.3 +%% client_random - not used +%% server_random - not used +%% exportable - not used +%% +%% cipher_state :: record() +%% nonce - used for sequence_number + -endif. % -ifdef(ssl_connection). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 417e5d9eb6..5e3c767c2c 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -61,7 +61,7 @@ -export([encode_handshake/2, encode_hello_extensions/1, encode_extensions/1, encode_extensions/2, encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1]). %% Decode --export([decode_handshake/3, decode_vector/1, decode_hello_extensions/3, decode_extensions/3, +-export([decode_handshake/3, decode_vector/1, decode_hello_extensions/4, decode_extensions/3, decode_server_key/3, decode_client_key/3, decode_suites/2 ]). @@ -639,7 +639,7 @@ encode_extensions([#ec_point_formats{ec_point_format_list = ECPointFormats} | Re ?UINT16(Len), ?BYTE(ListLen), ECPointFormatList/binary, Acc/binary>>); encode_extensions([#srp{username = UserName} | Rest], Acc) -> SRPLen = byte_size(UserName), - Len = SRPLen + 2, + Len = SRPLen + 1, encode_extensions(Rest, <<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), UserName/binary, Acc/binary>>); encode_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], Acc) -> @@ -680,9 +680,9 @@ encode_extensions([#sni{hostname = Hostname} | Rest], Acc) -> encode_extensions([#client_hello_versions{versions = Versions0} | Rest], Acc) -> Versions = encode_versions(Versions0), VerLen = byte_size(Versions), - Len = VerLen + 2, + Len = VerLen + 1, encode_extensions(Rest, <<?UINT16(?SUPPORTED_VERSIONS_EXT), - ?UINT16(Len), ?UINT16(VerLen), Versions/binary, Acc/binary>>); + ?UINT16(Len), ?BYTE(VerLen), Versions/binary, Acc/binary>>); encode_extensions([#server_hello_selected_version{selected_version = Version0} | Rest], Acc) -> Version = encode_versions([Version0]), Len = byte_size(Version), %% 2 @@ -745,8 +745,7 @@ decode_handshake(Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32 ?BYTE(SID_length), Session_ID:SID_length/binary, Cipher_suite:2/binary, ?BYTE(Comp_method), ?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> - - HelloExtensions = decode_hello_extensions(Extensions, Version, server_hello), + HelloExtensions = decode_hello_extensions(Extensions, Version, {Major, Minor}, server_hello), #server_hello{ server_version = {Major,Minor}, @@ -803,11 +802,12 @@ decode_vector(<<?UINT16(Len), Vector:Len/binary>>) -> Vector. %%-------------------------------------------------------------------- --spec decode_hello_extensions(binary(), ssl_record:ssl_version(), atom()) -> map(). +-spec decode_hello_extensions(binary(), ssl_record:ssl_version(), + ssl_record:ssl_version(), atom()) -> map(). %% %% Description: Decodes TLS hello extensions %%-------------------------------------------------------------------- -decode_hello_extensions(Extensions, Version, MessageType0) -> +decode_hello_extensions(Extensions, LocalVersion, LegacyVersion, MessageType0) -> %% Convert legacy atoms MessageType = case MessageType0 of @@ -815,6 +815,13 @@ decode_hello_extensions(Extensions, Version, MessageType0) -> server -> server_hello; T -> T end, + %% RFC 8446 - 4.2.1 + %% Servers MUST be prepared to receive ClientHellos that include this extension but + %% do not include 0x0304 in the list of versions. + %% Clients MUST check for this extension prior to processing the rest of the + %% ServerHello (although they will have to parse the ServerHello in order to read + %% the extension). + Version = process_supported_versions_extension(Extensions, LocalVersion, LegacyVersion), decode_extensions(Extensions, Version, MessageType, empty_extensions(Version, MessageType)). %%-------------------------------------------------------------------- @@ -1167,7 +1174,12 @@ kse_remove_private_key(#key_share_entry{ signature_algs_ext(undefined) -> undefined; -signature_algs_ext(SignatureSchemes) -> +signature_algs_ext(SignatureSchemes0) -> + %% The SSL option signature_algs contains both hash-sign algorithms (tuples) and + %% signature schemes (atoms) if TLS 1.3 is configured. + %% Filter out all hash-sign tuples when creating the signature_algs extension. + %% (TLS 1.3 specific record type) + SignatureSchemes = lists:filter(fun is_atom/1, SignatureSchemes0), #signature_algorithms{signature_scheme_list = SignatureSchemes}. signature_algs_cert(undefined) -> @@ -1191,7 +1203,8 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, Empty = empty_extensions(Version, server_hello), ServerHelloExtensions = Empty#{renegotiation_info => renegotiation_info(RecordCB, server, ConnectionStates, Renegotiation), - ec_point_formats => server_ecc_extension(Version, maps:get(ec_point_formats, Exts, undefined)) + ec_point_formats => server_ecc_extension(Version, + maps:get(ec_point_formats, Exts, undefined)) }, %% If we receive an ALPN extension and have ALPN configured for this connection, @@ -1199,13 +1212,9 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, ALPN = maps:get(alpn, Exts, undefined), if ALPN =/= undefined, ALPNPreferredProtocols =/= undefined -> - case handle_alpn_extension(ALPNPreferredProtocols, decode_alpn(ALPN)) of - #alert{} = Alert -> - Alert; - Protocol -> - {Session, ConnectionStates, Protocol, - ServerHelloExtensions#{alpn => encode_alpn([Protocol], Renegotiation)}} - end; + Protocol = handle_alpn_extension(ALPNPreferredProtocols, decode_alpn(ALPN)), + {Session, ConnectionStates, Protocol, + ServerHelloExtensions#{alpn => encode_alpn([Protocol], Renegotiation)}}; true -> NextProtocolNegotiation = maps:get(next_protocol_negotiation, Exts, undefined), ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), @@ -1219,7 +1228,8 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtoSelector}, ConnectionStates0, Renegotiation) -> - ConnectionStates = handle_renegotiation_extension(client, RecordCB, Version, maps:get(renegotiation_info, Exts, undefined), Random, + ConnectionStates = handle_renegotiation_extension(client, RecordCB, Version, + maps:get(renegotiation_info, Exts, undefined), Random, CipherSuite, undefined, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), @@ -1234,12 +1244,8 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, {ConnectionStates, alpn, Protocol}; undefined -> NextProtocolNegotiation = maps:get(next_protocol_negotiation, Exts, undefined), - case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of - #alert{} = Alert -> - Alert; - Protocol -> - {ConnectionStates, npn, Protocol} - end; + Protocol = handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation), + {ConnectionStates, npn, Protocol}; {error, Reason} -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason); [] -> @@ -2201,6 +2207,47 @@ dec_server_key_signature(Params, <<?UINT16(Len), Signature:Len/binary>>, _) -> dec_server_key_signature(_, _, _) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, failed_to_decrypt_server_key_sign)). +%% Processes a ClientHello/ServerHello message and returns the version to be used +%% in the decoding functions. The following rules apply: +%% - IF supported_versions extension is absent: +%% RETURN the lowest of (LocalVersion and LegacyVersion) +%% - IF supported_versions estension is present: +%% RETURN the lowest of (LocalVersion and first element of supported versions) +process_supported_versions_extension(<<>>, LocalVersion, LegacyVersion) + when LegacyVersion =< LocalVersion -> + LegacyVersion; +process_supported_versions_extension(<<>>, LocalVersion, _LegacyVersion) -> + LocalVersion; +process_supported_versions_extension(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), + ExtData:Len/binary, _Rest/binary>>, + LocalVersion, _LegacyVersion) when Len > 2 -> + <<?BYTE(_),Versions0/binary>> = ExtData, + [Highest|_] = decode_versions(Versions0), + if Highest =< LocalVersion -> + Highest; + true -> + LocalVersion + end; +process_supported_versions_extension(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), + ?BYTE(Major),?BYTE(Minor), _Rest/binary>>, + LocalVersion, _LegacyVersion) when Len =:= 2 -> + SelectedVersion = {Major, Minor}, + if SelectedVersion =< LocalVersion -> + SelectedVersion; + true -> + LocalVersion + end; +process_supported_versions_extension(<<?UINT16(_), ?UINT16(Len), + _ExtData:Len/binary, Rest/binary>>, + LocalVersion, LegacyVersion) -> + process_supported_versions_extension(Rest, LocalVersion, LegacyVersion); +%% Tolerate protocol encoding errors and skip parsing the rest of the extension. +process_supported_versions_extension(_, LocalVersion, LegacyVersion) + when LegacyVersion =< LocalVersion -> + LegacyVersion; +process_supported_versions_extension(_, LocalVersion, _) -> + LocalVersion. + decode_extensions(<<>>, _Version, _MessageType, Acc) -> Acc; decode_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), @@ -2229,7 +2276,7 @@ decode_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), decode_extensions(<<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), SRP:SRPLen/binary, Rest/binary>>, Version, MessageType, Acc) - when Len == SRPLen + 2 -> + when Len == SRPLen + 1 -> decode_extensions(Rest, Version, MessageType, Acc#{srp => #srp{username = SRP}}); decode_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), @@ -2327,7 +2374,7 @@ decode_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), decode_extensions(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) when Len > 2 -> - <<?UINT16(_),Versions/binary>> = ExtData, + <<?BYTE(_),Versions/binary>> = ExtData, decode_extensions(Rest, Version, MessageType, Acc#{client_hello_versions => #client_hello_versions{ @@ -2596,30 +2643,26 @@ filter_unavailable_ecc_suites(_, Suites) -> handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite, ClientCipherSuites, Compression, ConnectionStates0, Renegotiation, SecureRenegotation) -> - case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0, - Renegotiation, SecureRenegotation, - ClientCipherSuites) of - {ok, ConnectionStates} -> - hello_pending_connection_states(RecordCB, Role, - Version, - NegotiatedCipherSuite, - Random, - Compression, - ConnectionStates); - #alert{} = Alert -> - throw(Alert) - end. + {ok, ConnectionStates} = handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0, + Renegotiation, SecureRenegotation, + ClientCipherSuites), + hello_pending_connection_states(RecordCB, Role, + Version, + NegotiatedCipherSuite, + Random, + Compression, + ConnectionStates). %% Receive protocols, choose one from the list, return it. handle_alpn_extension(_, {error, Reason}) -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason); + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason)); handle_alpn_extension([], _) -> - ?ALERT_REC(?FATAL, ?NO_APPLICATION_PROTOCOL); + throw(?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. + case lists:member(ServerProtocol, ClientProtocols) of + true -> ServerProtocol; + false -> handle_alpn_extension(Tail, ClientProtocols) + end. handle_next_protocol(undefined, _NextProtocolSelector, _Renegotiating) -> @@ -2632,14 +2675,14 @@ handle_next_protocol(#next_protocol_negotiation{} = NextProtocols, true -> select_next_protocol(decode_next_protocols(NextProtocols), NextProtocolSelector); false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, unexpected_next_protocol_extension) + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, unexpected_next_protocol_extension)) end. handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, SslOpts)-> case handle_next_protocol_on_server(NextProtocolNegotiation, Renegotiation, SslOpts) of #alert{} = Alert -> - Alert; + throw(Alert); ProtocolsToAdvertise -> ProtocolsToAdvertise end. @@ -2894,14 +2937,14 @@ handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_co true -> {ok, ConnectionStates}; false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation) + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation)) end; handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify}, ConnectionStates, true, _, CipherSuites) -> case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv})); false -> ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), Data = maps:get(client_verify_data, ConnectionState), @@ -2909,7 +2952,7 @@ handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_co true -> {ok, ConnectionStates}; false -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation) + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation)) end end; @@ -2919,7 +2962,7 @@ handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, S handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of true -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv}); + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv})); false -> handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation) end. @@ -2928,9 +2971,9 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), case {SecureRenegotation, maps:get(secure_renegotiation, ConnectionState)} of {_, true} -> - ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure); + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure)); {true, false} -> - ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); + throw(?ALERT_REC(?FATAL, ?NO_RENEGOTIATION)); {false, false} -> {ok, ConnectionStates} end. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index a079c6a796..57b72366d3 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -137,10 +137,10 @@ %% Local policy for the server if it want's to reuse the session %% or not. Defaluts to allways returning true. %% fun(SessionId, PeerCert, Compression, CipherSuite) -> boolean() - reuse_session, + reuse_session :: fun() | binary() | undefined, %% Server side is a fun() %% If false sessions will never be reused, if true they %% will be reused if possible. - reuse_sessions :: boolean(), + reuse_sessions :: boolean() | save, %% Only client side can use value save renegotiate_at, secure_renegotiate, client_renegotiation, @@ -176,6 +176,8 @@ max_handshake_size :: integer(), handshake, customize_hostname_check + %% , + %% save_session :: boolean() }). -record(socket_options, diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index 35c8dcfd48..ce8225bf72 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -32,6 +32,7 @@ -define(rec_info(T,R),lists:zip(record_info(fields,T),tl(tuple_to_list(R)))). -include("tls_record.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("tls_handshake.hrl"). -include_lib("kernel/include/logger.hrl"). @@ -87,20 +88,32 @@ format_handshake(Direction, BinMsg) -> parse_handshake(Direction, #client_hello{ - client_version = Version + client_version = Version0, + cipher_suites = CipherSuites0, + extensions = Extensions } = ClientHello) -> + Version = get_client_version(Version0, Extensions), Header = io_lib:format("~s ~s Handshake, ClientHello", [header_prefix(Direction), version(Version)]), - Message = io_lib:format("~p", [?rec_info(client_hello, ClientHello)]), + CipherSuites = parse_cipher_suites(CipherSuites0), + Message = io_lib:format("~p", + [?rec_info(client_hello, + ClientHello#client_hello{cipher_suites = CipherSuites})]), {Header, Message}; parse_handshake(Direction, #server_hello{ - server_version = Version + server_version = Version0, + cipher_suite = CipherSuite0, + extensions = Extensions } = ServerHello) -> + Version = get_server_version(Version0, Extensions), Header = io_lib:format("~s ~s Handshake, ServerHello", [header_prefix(Direction), version(Version)]), - Message = io_lib:format("~p", [?rec_info(server_hello, ServerHello)]), + CipherSuite = format_cipher(CipherSuite0), + Message = io_lib:format("~p", + [?rec_info(server_hello, + ServerHello#server_hello{cipher_suite = CipherSuite})]), {Header, Message}; parse_handshake(Direction, #certificate{} = Certificate) -> Header = io_lib:format("~s Handshake, Certificate", @@ -148,7 +161,34 @@ parse_handshake(Direction, #hello_request{} = HelloRequest) -> Message = io_lib:format("~p", [?rec_info(hello_request, HelloRequest)]), {Header, Message}. +parse_cipher_suites([_|_] = Ciphers) -> + [format_cipher(C) || C <- Ciphers]. + +format_cipher(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> + 'TLS_EMPTY_RENEGOTIATION_INFO_SCSV'; +format_cipher(C0) -> + list_to_atom(ssl_cipher_format:openssl_suite_name(C0)). + +get_client_version(Version, Extensions) -> + CHVersions = maps:get(client_hello_versions, Extensions, undefined), + case CHVersions of + #client_hello_versions{versions = [Highest|_]} -> + Highest; + undefined -> + Version + end. + +get_server_version(Version, Extensions) -> + SHVersion = maps:get(server_hello_selected_version, Extensions, undefined), + case SHVersion of + #server_hello_selected_version{selected_version = SelectedVersion} -> + SelectedVersion; + undefined -> + Version + end. +version({3,4}) -> + "TLS 1.3"; version({3,3}) -> "TLS 1.2"; version({3,2}) -> diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index c938772bc1..b1f080b0fe 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -30,7 +30,7 @@ connection_init/3, cache_pem_file/2, lookup_trusted_cert/4, new_session_id/1, clean_cert_db/2, - register_session/2, register_session/3, invalidate_session/2, + register_session/2, register_session/4, invalidate_session/2, insert_crls/2, insert_crls/3, delete_crls/1, delete_crls/2, invalidate_session/3, name/1]). @@ -170,9 +170,11 @@ clean_cert_db(Ref, File) -> %% %% Description: Make the session available for reuse. %%-------------------------------------------------------------------- --spec register_session(host(), inet:port_number(), #session{}) -> ok. -register_session(Host, Port, Session) -> - cast({register_session, Host, Port, Session}). +-spec register_session(host(), inet:port_number(), #session{}, unique | true) -> ok. +register_session(Host, Port, Session, true) -> + call({register_session, Host, Port, Session}); +register_session(Host, Port, Session, unique = Save) -> + cast({register_session, Host, Port, Session, Save}). -spec register_session(inet:port_number(), #session{}) -> ok. register_session(Port, Session) -> @@ -301,7 +303,10 @@ handle_call({{new_session_id, Port}, _}, _, #state{session_cache_cb = CacheCb, session_cache_server = Cache} = State) -> Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb), - {reply, Id, State}. + {reply, Id, State}; +handle_call({{register_session, Host, Port, Session},_}, _, State0) -> + State = client_register_session(Host, Port, Session, State0), + {reply, ok, State}. %%-------------------------------------------------------------------- -spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. @@ -311,8 +316,12 @@ handle_call({{new_session_id, Port}, _}, %% %% Description: Handling cast messages %%-------------------------------------------------------------------- -handle_cast({register_session, Host, Port, Session}, State0) -> - State = ssl_client_register_session(Host, Port, Session, State0), +handle_cast({register_session, Host, Port, Session, unique}, State0) -> + State = client_register_unique_session(Host, Port, Session, State0), + {noreply, State}; + +handle_cast({register_session, Host, Port, Session, true}, State0) -> + State = client_register_session(Host, Port, Session, State0), {noreply, State}; handle_cast({register_session, Port, Session}, State0) -> @@ -540,10 +549,10 @@ clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) -> ok end. -ssl_client_register_session(Host, Port, Session, #state{session_cache_client = Cache, - session_cache_cb = CacheCb, - session_cache_client_max = Max, - session_client_invalidator = Pid0} = State) -> +client_register_unique_session(Host, Port, Session, #state{session_cache_client = Cache, + session_cache_cb = CacheCb, + session_cache_client_max = Max, + session_client_invalidator = Pid0} = State) -> TimeStamp = erlang:monotonic_time(), NewSession = Session#session{time_stamp = TimeStamp}, @@ -557,6 +566,17 @@ ssl_client_register_session(Host, Port, Session, #state{session_cache_client = C register_unique_session(Sessions, NewSession, {Host, Port}, State) end. +client_register_session(Host, Port, Session, #state{session_cache_client = Cache, + session_cache_cb = CacheCb, + session_cache_client_max = Max, + session_client_invalidator = Pid0} = State) -> + TimeStamp = erlang:monotonic_time(), + NewSession = Session#session{time_stamp = TimeStamp}, + Pid = do_register_session({{Host, Port}, + NewSession#session.session_id}, + NewSession, Max, Pid0, Cache, CacheCb), + State#state{session_client_invalidator = Pid}. + server_register_session(Port, Session, #state{session_cache_server_max = Max, session_cache_server = Cache, session_cache_cb = CacheCb, diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index ddc83821b4..499ba108f2 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -39,7 +39,8 @@ set_renegotiation_flag/2, set_client_verify_data/3, set_server_verify_data/3, - empty_connection_state/2, initial_connection_state/2, record_protocol_role/1]). + empty_connection_state/2, initial_connection_state/2, record_protocol_role/1, + step_encryption_state/1]). %% Compression -export([compress/3, uncompress/3, compressions/0]). @@ -118,6 +119,20 @@ activate_pending_connection_state(#{current_write := Current, }. %%-------------------------------------------------------------------- +-spec step_encryption_state(connection_states()) -> connection_states(). +%% +%% Description: Activates the next encyrption state (e.g. handshake +%% encryption). +%%-------------------------------------------------------------------- +step_encryption_state(#{pending_read := PendingRead, + pending_write := PendingWrite} = States) -> + NewRead = PendingRead#{sequence_number => 0}, + NewWrite = PendingWrite#{sequence_number => 0}, + States#{current_read => NewRead, + current_write => NewWrite}. + + +%%-------------------------------------------------------------------- -spec set_security_params(#security_parameters{}, #security_parameters{}, connection_states()) -> connection_states(). %% diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index c9607489e9..a9759c9b43 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -53,6 +53,13 @@ is_new(_ClientSuggestion, _ServerDecision) -> %% Description: Should be called by the client side to get an id %% for the client hello message. %%-------------------------------------------------------------------- +client_id({Host, Port, #ssl_options{reuse_session = SessionId}}, Cache, CacheCb, _) when is_binary(SessionId)-> + case CacheCb:lookup(Cache, {{Host, Port}, SessionId}) of + undefined -> + <<>>; + #session{} -> + SessionId + end; client_id(ClientInfo, Cache, CacheCb, OwnCert) -> case select_session(ClientInfo, Cache, CacheCb, OwnCert) of no_session -> @@ -91,7 +98,8 @@ server_id(Port, SuggestedId, Options, Cert, Cache, CacheCb) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -select_session({_, _, #ssl_options{reuse_sessions=false}}, _Cache, _CacheCb, _OwnCert) -> +select_session({_, _, #ssl_options{reuse_sessions = Reuse}}, _Cache, _CacheCb, _OwnCert) when Reuse =/= true -> + %% If reuse_sessions == true | save a new session should be created no_session; select_session({HostIP, Port, SslOpts}, Cache, CacheCb, OwnCert) -> Sessions = CacheCb:select_session(Cache, {HostIP, Port}), @@ -132,7 +140,7 @@ is_resumable(SuggestedSessionId, Port, #ssl_options{reuse_session = ReuseFun} = false -> {false, undefined} end; undefined -> - {false, undefined} + {false, undefined} end. resumable(new) -> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index b042baebcb..41542c65c1 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1073,6 +1073,12 @@ handle_alerts([], Result) -> Result; handle_alerts(_, {stop, _, _} = Stop) -> Stop; +handle_alerts([#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} | _Alerts], + {next_state, connection = StateName, #state{user_data_buffer = Buffer, + protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}} = + State}) when (Buffer =/= <<>>) orelse + (CTs =/= []) -> + {next_state, StateName, State#state{terminated = true}}; handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)); handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl index 9ff84c703b..f5f91cedd7 100644 --- a/lib/ssl/src/tls_connection_1_3.erl +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -134,67 +134,57 @@ start(internal, end. -%% TODO: move these functions + +negotiated(internal, + Map, + #state{connection_states = ConnectionStates0, + session = #session{session_id = SessionId, + own_certificate = OwnCert}, + ssl_options = #ssl_options{} = SslOpts, + key_share = KeyShare, + tls_handshake_history = HHistory0, + private_key = CertPrivateKey, + static_env = #static_env{ + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + socket = Socket, + transport_cb = Transport}} = State0, _Module) -> + Env = #{connection_states => ConnectionStates0, + session_id => SessionId, + own_certificate => OwnCert, + cert_db => CertDbHandle, + cert_db_ref => CertDbRef, + ssl_options => SslOpts, + key_share => KeyShare, + tls_handshake_history => HHistory0, + transport_cb => Transport, + socket => Socket, + private_key => CertPrivateKey}, + case tls_handshake_1_3:do_negotiated(Map, Env) of + #alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, {3,4}, negotiated, State0); + M -> + %% TODO: implement update_state + %% State = update_state(State0, M), + {next_state, wait_flight2, State0, [{next_event, internal, M}]} + + end. + + update_state(#state{connection_states = ConnectionStates0, session = Session} = State, - #{client_random := ClientRandom, - cipher := Cipher, + #{cipher := Cipher, key_share := KeyShare, session_id := SessionId}) -> #{security_parameters := SecParamsR0} = PendingRead = maps:get(pending_read, ConnectionStates0), #{security_parameters := SecParamsW0} = PendingWrite = maps:get(pending_write, ConnectionStates0), - SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, ClientRandom, Cipher), - SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, ClientRandom, Cipher), + SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, Cipher), + SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, Cipher), ConnectionStates = ConnectionStates0#{pending_read => PendingRead#{security_parameters => SecParamsR}, pending_write => PendingWrite#{security_parameters => SecParamsW}}, State#state{connection_states = ConnectionStates, key_share = KeyShare, session = Session#session{session_id = SessionId}}. - - -negotiated(internal, - Map, - #state{connection_states = ConnectionStates0, - session = #session{session_id = SessionId}, - ssl_options = #ssl_options{} = SslOpts, - key_share = KeyShare, - tls_handshake_history = HHistory0, - static_env = #static_env{socket = Socket, - transport_cb = Transport}}, _Module) -> - - %% Create server_hello - %% Extensions: supported_versions, key_share, (pre_shared_key) - ServerHello = tls_handshake_1_3:server_hello(SessionId, KeyShare, - ConnectionStates0, Map), - - %% Update handshake_history (done in encode!) - %% Encode handshake - {BinMsg, _ConnectionStates, _HHistory} = - tls_connection:encode_handshake(ServerHello, {3,4}, ConnectionStates0, HHistory0), - %% Send server_hello - tls_connection:send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - Msg = #{direction => outbound, - protocol => 'handshake', - message => ServerHello}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Msg, #{domain => [otp,ssl,handshake]}), - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), - ok. - - %% K_send = handshake ??? - %% (Send EncryptedExtensions) - %% ([Send CertificateRequest]) - %% [Send Certificate + CertificateVerify] - %% Send Finished - %% K_send = application ??? - - %% Will be called implicitly - %% {Record, State} = Connection:next_record(State2#state{session = Session}), - %% Connection:next_event(wait_flight2, Record, State, Actions), - %% OR - %% Connection:next_event(WAIT_EOED, Record, State, Actions) diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 5aca4bf8c8..f0bbd0f94f 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -232,7 +232,8 @@ hello(#client_hello{client_version = ClientVersion, %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec encode_handshake(tls_handshake(), tls_record:tls_version()) -> iolist(). +-spec encode_handshake(tls_handshake() | tls_handshake_1_3:tls_handshake_1_3(), + tls_record:tls_version()) -> iolist(). %% %% Description: Encode a handshake packet %%-------------------------------------------------------------------- @@ -318,8 +319,6 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, Version, SslOpts, Session0, ConnectionStates0, Renegotiation) of - #alert{} = Alert -> - Alert; {Session, ConnectionStates, Protocol, ServerHelloExt} -> {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign} @@ -330,14 +329,14 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> - case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, + try ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, Compression, HelloExt, Version, SslOpt, ConnectionStates0, - Renegotiation) of - #alert{} = Alert -> - Alert; + Renegotiation) of {ConnectionStates, ProtoExt, Protocol} -> {Version, SessionId, ConnectionStates, ProtoExt, Protocol} + catch throw:Alert -> + Alert end. @@ -403,14 +402,15 @@ get_tls_handshake_aux(_Version, Data, _, Acc) -> decode_handshake({3, N}, ?HELLO_REQUEST, <<>>) when N < 4 -> #hello_request{}; -decode_handshake(Version, ?CLIENT_HELLO, +decode_handshake(Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> Exts = ssl_handshake:decode_vector(Extensions), - DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, client_hello), + DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, {Major, Minor}, + client_hello), #client_hello{ client_version = {Major,Minor}, random = Random, diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index f381e038cf..670c4d424d 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -27,6 +27,7 @@ -include("tls_handshake_1_3.hrl"). -include("ssl_alert.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -38,7 +39,11 @@ -export([handle_client_hello/3]). %% Create handshake messages --export([server_hello/4]). +-export([certificate/5, + certificate_verify/5, + server_hello/4]). + +-export([do_negotiated/2]). %%==================================================================== %% Create handshake messages @@ -50,8 +55,7 @@ server_hello(SessionId, KeyShare, ConnectionStates, _Map) -> Extensions = server_hello_extensions(KeyShare), #server_hello{server_version = {3,3}, %% legacy_version cipher_suite = SecParams#security_parameters.cipher_suite, - compression_method = - SecParams#security_parameters.compression_algorithm, + compression_method = 0, %% legacy attribute random = SecParams#security_parameters.server_random, session_id = SessionId, extensions = Extensions @@ -63,6 +67,37 @@ server_hello_extensions(KeyShare) -> ssl_handshake:add_server_share(Extensions, KeyShare). +%% TODO: use maybe monad for error handling! +certificate(OwnCert, CertDbHandle, CertDbRef, _CRContext, server) -> + case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of + {ok, _, Chain} -> + CertList = chain_to_cert_list(Chain), + %% If this message is in response to a CertificateRequest, the value of + %% certificate_request_context in that message. Otherwise (in the case + %%of server authentication), this field SHALL be zero length. + #certificate_1_3{ + certificate_request_context = <<>>, + certificate_list = CertList}; + {error, Error} -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {server_has_no_suitable_certificates, Error}) + end. + +%% TODO: use maybe monad for error handling! +certificate_verify(OwnCert, PrivateKey, SignatureScheme, Messages, server) -> + {HashAlgo, _, _} = + ssl_cipher:scheme_to_components(SignatureScheme), + + %% Transcript-Hash(Handshake Context, Certificate) + Context = [Messages, OwnCert], + THash = tls_v1:transcript_hash(Context, HashAlgo), + + Signature = digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>, + HashAlgo, PrivateKey), + + #certificate_verify_1_3{ + algorithm = SignatureScheme, + signature = Signature + }. %%==================================================================== %% Encode handshake @@ -76,7 +111,7 @@ encode_handshake(#certificate_request_1_3{ {?CERTIFICATE_REQUEST, <<EncContext/binary, BinExts/binary>>}; encode_handshake(#certificate_1_3{ certificate_request_context = Context, - entries = Entries}) -> + certificate_list = Entries}) -> EncContext = encode_cert_req_context(Context), EncEntries = encode_cert_entries(Entries), {?CERTIFICATE, <<EncContext/binary, EncEntries/binary>>}; @@ -120,14 +155,14 @@ decode_handshake(?CERTIFICATE, <<?BYTE(0), ?UINT24(Size), Certs:Size/binary>>) - CertList = decode_cert_entries(Certs), #certificate_1_3{ certificate_request_context = <<>>, - entries = CertList + certificate_list = CertList }; decode_handshake(?CERTIFICATE, <<?BYTE(CSize), Context:CSize/binary, ?UINT24(Size), Certs:Size/binary>>) -> CertList = decode_cert_entries(Certs), #certificate_1_3{ certificate_request_context = Context, - entries = CertList + certificate_list = CertList }; decode_handshake(?ENCRYPTED_EXTENSIONS, <<?UINT16(Size), EncExts:Size/binary>>) -> #encrypted_extensions{ @@ -193,12 +228,60 @@ extensions_list(HelloExtensions) -> [Ext || {_, Ext} <- maps:to_list(HelloExtensions)]. +%% TODO: add extensions! +chain_to_cert_list(L) -> + chain_to_cert_list(L, []). +%% +chain_to_cert_list([], Acc) -> + lists:reverse(Acc); +chain_to_cert_list([H|T], Acc) -> + chain_to_cert_list(T, [certificate_entry(H)|Acc]). + + +certificate_entry(DER) -> + #certificate_entry{ + data = DER, + extensions = #{} %% Extensions not supported. + }. + +%% The digital signature is then computed over the concatenation of: +%% - A string that consists of octet 32 (0x20) repeated 64 times +%% - The context string +%% - A single 0 byte which serves as the separator +%% - The content to be signed +%% +%% For example, if the transcript hash was 32 bytes of 01 (this length +%% would make sense for SHA-256), the content covered by the digital +%% signature for a server CertificateVerify would be: +%% +%% 2020202020202020202020202020202020202020202020202020202020202020 +%% 2020202020202020202020202020202020202020202020202020202020202020 +%% 544c5320312e332c207365727665722043657274696669636174655665726966 +%% 79 +%% 00 +%% 0101010101010101010101010101010101010101010101010101010101010101 +digitally_sign(THash, Context, HashAlgo, PrivateKey = #'RSAPrivateKey'{}) -> + Content = build_content(Context, THash), + + %% The length of the Salt MUST be equal to the length of the output + %% of the digest algorithm. + PadLen = ssl_cipher:hash_size(HashAlgo), + + public_key:sign(Content, HashAlgo, PrivateKey, + [{rsa_padding, rsa_pkcs1_pss_padding}, + {rsa_pss_saltlen, PadLen}]). + + +build_content(Context, THash) -> + <<" ", + " ", + Context/binary,?BYTE(0),THash/binary>>. + %%==================================================================== %% Handle handshake messages %%==================================================================== handle_client_hello(#client_hello{cipher_suites = ClientCiphers, - random = Random, session_id = SessionId, extensions = Extensions} = _Hello, #ssl_options{ciphers = ServerCiphers, @@ -233,26 +316,24 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers, Cipher = Maybe(select_cipher_suite(ClientCiphers, ServerCiphers)), Group = Maybe(select_server_group(ServerGroups, ClientGroups)), Maybe(validate_key_share(ClientGroups, ClientShares)), - _ClientPubKey = Maybe(get_client_public_key(Group, ClientShares)), - %% Handle certificate - {PublicKeyAlgo, SignAlgo} = get_certificate_params(Cert), + ClientPubKey = Maybe(get_client_public_key(Group, ClientShares)), + + {PublicKeyAlgo, SignAlgo, SignHash} = get_certificate_params(Cert), %% Check if client supports signature algorithm of server certificate - Maybe(check_cert_sign_algo(SignAlgo, ClientSignAlgs, ClientSignAlgsCert)), + Maybe(check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgs, ClientSignAlgsCert)), - %% Check if server supports + %% Select signature algorithm (used in CertificateVerify message). SelectedSignAlg = Maybe(select_sign_algo(PublicKeyAlgo, ClientSignAlgs, ServerSignAlgs)), %% Generate server_share KeyShare = ssl_cipher:generate_server_share(Group), - _Ret = #{cipher => Cipher, group => Group, sign_alg => SelectedSignAlg, - %% client_share => ClientPubKey, + client_share => ClientPubKey, key_share => KeyShare, - client_random => Random, session_id => SessionId} %% TODO: @@ -265,9 +346,9 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers, ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_groups); {Ref, illegal_parameter} -> ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); - {Ref, {client_hello_retry_request, _Group0}} -> + {Ref, {hello_retry_request, _Group0}} -> %% TODO - exit({client_hello_retry_request, not_implemented}); + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, "hello_retry_request not implemented"); {Ref, no_suitable_cipher} -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_cipher); {Ref, {insufficient_security, no_suitable_signature_algorithm}} -> @@ -277,6 +358,197 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers, end. +do_negotiated(#{client_share := ClientKey, + group := SelectedGroup, + sign_alg := SignatureScheme + } = Map, + #{connection_states := ConnectionStates0, + session_id := SessionId, + own_certificate := OwnCert, + cert_db := CertDbHandle, + cert_db_ref := CertDbRef, + ssl_options := SslOpts, + key_share := KeyShare, + tls_handshake_history := HHistory0, + transport_cb := Transport, + socket := Socket, + private_key := CertPrivateKey}) -> + {Ref,Maybe} = maybe(), + + try + %% Create server_hello + %% Extensions: supported_versions, key_share, (pre_shared_key) + ServerHello = server_hello(SessionId, KeyShare, ConnectionStates0, Map), + + %% Update handshake_history (done in encode!) + %% Encode handshake + {BinMsg, ConnectionStates1, HHistory1} = + tls_connection:encode_handshake(ServerHello, {3,4}, ConnectionStates0, HHistory0), + %% Send server_hello + tls_connection:send(Transport, Socket, BinMsg), + log_handshake(SslOpts, ServerHello), + log_tls_record(SslOpts, BinMsg), + + %% ConnectionStates2 = calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, + %% HHistory1, ConnectionStates1), + {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV} = + calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, + HHistory1, ConnectionStates1), + ConnectionStates2 = + update_pending_connection_states(ConnectionStates1, HandshakeSecret, + ReadKey, ReadIV, WriteKey, WriteIV), + ConnectionStates3 = + ssl_record:step_encryption_state(ConnectionStates2), + + %% Create Certificate + Certificate = certificate(OwnCert, CertDbHandle, CertDbRef, <<>>, server), + + %% Encode Certificate + {_, _ConnectionStates4, HHistory2} = + tls_connection:encode_handshake(Certificate, {3,4}, ConnectionStates3, HHistory1), + %% log_handshake(SslOpts, Certificate), + + %% Create CertificateVerify + {Messages, _} = HHistory2, + + %% Use selected signature_alg from here, HKDF only used for key_schedule + CertificateVerify = + tls_handshake_1_3:certificate_verify(OwnCert, CertPrivateKey, SignatureScheme, + Messages, server), + io:format("### CertificateVerify: ~p~n", [CertificateVerify]), + + %% Encode CertificateVerify + + %% Send Certificate, CertifricateVerify + + %% Send finished + + %% Next record/Next event + + Maybe(not_implemented(negotiated)) + + + catch + {Ref, {state_not_implemented, State}} -> + %% TODO + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) + end. + + +%% TODO: Remove this function! +not_implemented(State) -> + {error, {state_not_implemented, State}}. + + +log_handshake(SslOpts, Message) -> + Msg = #{direction => outbound, + protocol => 'handshake', + message => Message}, + ssl_logger:debug(SslOpts#ssl_options.log_level, Msg, #{domain => [otp,ssl,handshake]}). + + +log_tls_record(SslOpts, BinMsg) -> + Report = #{direction => outbound, + protocol => 'tls_record', + message => BinMsg}, + ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}). + + +calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, HHistory, ConnectionStates) -> + #{security_parameters := SecParamsR} = + ssl_record:pending_connection_state(ConnectionStates, read), + #security_parameters{prf_algorithm = HKDFAlgo, + cipher_suite = CipherSuite} = SecParamsR, + + %% Calculate handshake_secret + EarlySecret = tls_v1:key_schedule(early_secret, HKDFAlgo , {psk, <<>>}), + PrivateKey = get_server_private_key(KeyShare), %% #'ECPrivateKey'{} + + IKM = calculate_shared_secret(ClientKey, PrivateKey, SelectedGroup), + HandshakeSecret = tls_v1:key_schedule(handshake_secret, HKDFAlgo, IKM, EarlySecret), + + %% Calculate [sender]_handshake_traffic_secret + {Messages, _} = HHistory, + ClientHSTrafficSecret = + tls_v1:client_handshake_traffic_secret(HKDFAlgo, HandshakeSecret, lists:reverse(Messages)), + ServerHSTrafficSecret = + tls_v1:server_handshake_traffic_secret(HKDFAlgo, HandshakeSecret, lists:reverse(Messages)), + + %% Calculate traffic keys + #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite), + {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientHSTrafficSecret), + {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerHSTrafficSecret), + + {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV}. + + %% %% Update pending connection state + %% PendingRead0 = ssl_record:pending_connection_state(ConnectionStates, read), + %% PendingWrite0 = ssl_record:pending_connection_state(ConnectionStates, write), + + %% PendingRead = update_conn_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV), + %% PendingWrite = update_conn_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV), + + %% %% Update pending and copy to current (activate) + %% %% All subsequent handshake messages are encrypted + %% %% ([sender]_handshake_traffic_secret) + %% #{current_read => PendingRead, + %% current_write => PendingWrite, + %% pending_read => PendingRead, + %% pending_write => PendingWrite}. + + +get_server_private_key(#key_share_server_hello{server_share = ServerShare}) -> + get_private_key(ServerShare). + +get_private_key(#key_share_entry{ + key_exchange = #'ECPrivateKey'{} = PrivateKey}) -> + PrivateKey; +get_private_key(#key_share_entry{ + key_exchange = + {_, PrivateKey}}) -> + PrivateKey. + +%% X25519, X448 +calculate_shared_secret(OthersKey, MyKey, Group) + when is_binary(OthersKey) andalso is_binary(MyKey) andalso + (Group =:= x25519 orelse Group =:= x448)-> + crypto:compute_key(ecdh, OthersKey, MyKey, Group); +%% FFDHE +calculate_shared_secret(OthersKey, MyKey, Group) + when is_binary(OthersKey) andalso is_binary(MyKey) -> + Params = #'DHParameter'{prime = P} = ssl_dh_groups:dh_params(Group), + S = public_key:compute_key(OthersKey, MyKey, Params), + Size = byte_size(binary:encode_unsigned(P)), + ssl_cipher:add_zero_padding(S, Size); +%% ECDHE +calculate_shared_secret(OthersKey, MyKey = #'ECPrivateKey'{}, _Group) + when is_binary(OthersKey) -> + Point = #'ECPoint'{point = OthersKey}, + public_key:compute_key(Point, MyKey). + + +update_pending_connection_states(CS = #{pending_read := PendingRead0, + pending_write := PendingWrite0}, + HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV) -> + PendingRead = update_connection_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV), + PendingWrite = update_connection_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV), + CS#{pending_read => PendingRead, + pending_write => PendingWrite}. + +update_connection_state(ConnectionState = #{security_parameters := SecurityParameters0}, + HandshakeSecret, Key, IV) -> + %% Store secret + SecurityParameters = SecurityParameters0#security_parameters{ + master_secret = HandshakeSecret}, + ConnectionState#{security_parameters => SecurityParameters, + cipher_state => cipher_init(Key, IV)}. + + + +cipher_init(Key, IV) -> + #cipher_state{key = Key, iv = IV, tag_len = 16}. + + %% If there is no overlap between the received %% "supported_groups" and the groups supported by the server, then the %% server MUST abort the handshake with a "handshake_failure" or an @@ -324,14 +596,20 @@ get_client_public_key(Group, ClientShares) -> {value, {_, _, ClientPublicKey}} -> {ok, ClientPublicKey}; false -> - %% ClientHelloRetryRequest - {error, {client_hello_retry_request, Group}} + %% 4.1.4. Hello Retry Request + %% + %% The server will send this message in response to a ClientHello + %% message if it is able to find an acceptable set of parameters but the + %% ClientHello does not contain sufficient information to proceed with + %% the handshake. + {error, {hello_retry_request, Group}} end. select_cipher_suite([], _) -> {error, no_suitable_cipher}; select_cipher_suite([Cipher|ClientCiphers], ServerCiphers) -> - case lists:member(Cipher, ServerCiphers) of + case lists:member(Cipher, tls_v1:suites('TLS_v1.3')) andalso + lists:member(Cipher, ServerCiphers) of true -> {ok, Cipher}; false -> @@ -349,22 +627,28 @@ select_cipher_suite([Cipher|ClientCiphers], ServerCiphers) -> %% If no "signature_algorithms_cert" extension is %% present, then the "signature_algorithms" extension also applies to %% signatures appearing in certificates. -check_cert_sign_algo(SignAlgo, ClientSignAlgs, undefined) -> - maybe_lists_member(SignAlgo, ClientSignAlgs, - {insufficient_security, no_suitable_signature_algorithm}); -check_cert_sign_algo(SignAlgo, _, ClientSignAlgsCert) -> - maybe_lists_member(SignAlgo, ClientSignAlgsCert, - {insufficient_security, no_suitable_signature_algorithm}). + +%% Check if the signature algorithm of the server certificate is supported +%% by the client. +check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgs, undefined) -> + do_check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgs); +check_cert_sign_algo(SignAlgo, SignHash, _, ClientSignAlgsCert) -> + do_check_cert_sign_algo(SignAlgo, SignHash, ClientSignAlgsCert). %% DSA keys are not supported by TLS 1.3 select_sign_algo(dsa, _ClientSignAlgs, _ServerSignAlgs) -> {error, {insufficient_security, no_suitable_public_key}}; -%% TODO: Implement check for ellipctic curves! +%% TODO: Implement support for ECDSA keys! +select_sign_algo(_, [], _) -> + {error, {insufficient_security, no_suitable_signature_algorithm}}; select_sign_algo(PublicKeyAlgo, [C|ClientSignAlgs], ServerSignAlgs) -> {_, S, _} = ssl_cipher:scheme_to_components(C), - case PublicKeyAlgo =:= rsa andalso - ((S =:= rsa_pkcs1) orelse (S =:= rsa_pss_rsae) orelse (S =:= rsa_pss_pss)) andalso + %% RSASSA-PKCS1-v1_5 and Legacy algorithms are not defined for use in signed + %% TLS handshake messages: filter sha-1 and rsa_pkcs1. + case ((PublicKeyAlgo =:= rsa andalso S =:= rsa_pss_rsae) + orelse (PublicKeyAlgo =:= rsa_pss andalso S =:= rsa_pss_rsae)) + andalso lists:member(C, ServerSignAlgs) of true -> {ok, C}; @@ -373,51 +657,51 @@ select_sign_algo(PublicKeyAlgo, [C|ClientSignAlgs], ServerSignAlgs) -> end. -maybe_lists_member(Elem, List, Error) -> - case lists:member(Elem, List) of +do_check_cert_sign_algo(_, _, []) -> + {error, {insufficient_security, no_suitable_signature_algorithm}}; +do_check_cert_sign_algo(SignAlgo, SignHash, [Scheme|T]) -> + {Hash, Sign, _Curve} = ssl_cipher:scheme_to_components(Scheme), + case compare_sign_algos(SignAlgo, SignHash, Sign, Hash) of true -> ok; - false -> - {error, Error} + _Else -> + do_check_cert_sign_algo(SignAlgo, SignHash, T) end. -%% TODO: test with ecdsa, rsa_pss_rsae, rsa_pss_pss + +%% id-RSASSA-PSS (rsa_pss) indicates that the key may only be used for PSS signatures. +%% TODO: Uncomment when rsa_pss signatures are supported in certificates +%% compare_sign_algos(rsa_pss, Hash, Algo, Hash) +%% when Algo =:= rsa_pss_pss -> +%% true; +%% rsaEncryption (rsa) allows the key to be used for any of the standard encryption or +%% signature schemes. +compare_sign_algos(rsa, Hash, Algo, Hash) + when Algo =:= rsa_pss_rsae orelse + Algo =:= rsa_pkcs1 -> + true; +compare_sign_algos(Algo, Hash, Algo, Hash) -> + true; +compare_sign_algos(_, _, _, _) -> + false. + + get_certificate_params(Cert) -> {SignAlgo0, _Param, PublicKeyAlgo0} = ssl_handshake:get_cert_params(Cert), - SignAlgo = public_key:pkix_sign_types(SignAlgo0), + {SignHash0, SignAlgo} = public_key:pkix_sign_types(SignAlgo0), + %% Convert hash to new format + SignHash = case SignHash0 of + sha -> + sha1; + H -> H + end, PublicKeyAlgo = public_key_algo(PublicKeyAlgo0), - Scheme = sign_algo_to_scheme(SignAlgo), - {PublicKeyAlgo, Scheme}. - -sign_algo_to_scheme({Hash0, Sign0}) -> - SupportedSchemes = tls_v1:default_signature_schemes({3,4}), - Hash = case Hash0 of - sha -> - sha1; - H -> - H - end, - Sign = case Sign0 of - rsa -> - rsa_pkcs1; - S -> - S - end, - sign_algo_to_scheme(Hash, Sign, SupportedSchemes). -%% -sign_algo_to_scheme(_, _, []) -> - not_found; -sign_algo_to_scheme(H, S, [Scheme|T]) -> - {Hash, Sign, _Curve} = ssl_cipher:scheme_to_components(Scheme), - case H =:= Hash andalso S =:= Sign of - true -> - Scheme; - false -> - sign_algo_to_scheme(H, S, T) - end. + {PublicKeyAlgo, SignAlgo, SignHash}. %% Note: copied from ssl_handshake +public_key_algo(?'id-RSASSA-PSS') -> + rsa_pss; public_key_algo(?rsaEncryption) -> rsa; public_key_algo(?'id-ecPublicKey') -> diff --git a/lib/ssl/src/tls_handshake_1_3.hrl b/lib/ssl/src/tls_handshake_1_3.hrl index 6ef5364399..7ae1b93e1c 100644 --- a/lib/ssl/src/tls_handshake_1_3.hrl +++ b/lib/ssl/src/tls_handshake_1_3.hrl @@ -191,7 +191,7 @@ %% case RawPublicKey: %% /* From RFC 7250 ASN.1_subjectPublicKeyInfo */ %% opaque ASN1_subjectPublicKeyInfo<1..2^24-1>; - + %% %% case X509: %% opaque cert_data<1..2^24-1>; %% }; @@ -200,9 +200,14 @@ -record(certificate_1_3, { certificate_request_context, % opaque certificate_request_context<0..2^8-1>; - entries % CertificateEntry certificate_list<0..2^24-1>; + certificate_list % CertificateEntry certificate_list<0..2^24-1>; }). +-record(certificate_verify_1_3, { + algorithm, % SignatureScheme + signature % signature<0..2^16-1> + }). + %% RFC 8446 B.3.4. Ticket Establishment -record(new_session_ticket, { ticket_lifetime, %unit32 @@ -223,4 +228,11 @@ request_update }). +-type tls_handshake_1_3() :: #encrypted_extensions{} | + #certificate_request_1_3{} | + #certificate_1_3{} | + #certificate_verify_1_3{}. + +-export_type([tls_handshake_1_3/0]). + -endif. % -ifdef(tls_handshake_1_3). diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl index d424336187..1681babed9 100644 --- a/lib/ssl/src/tls_record_1_3.erl +++ b/lib/ssl/src/tls_record_1_3.erl @@ -76,8 +76,8 @@ encode_data(Frag, ConnectionStates) -> encode_plain_text(Type, Data0, #{current_write := Write0} = ConnectionStates) -> PadLen = 0, %% TODO where to specify PadLen? Data = inner_plaintext(Type, Data0, PadLen), - {CipherFragment, Write1} = encode_plain_text(Data, Write0), - {CipherText, Write} = encode_tls_cipher_text(CipherFragment, Write1), + CipherFragment = encode_plain_text(Data, Write0), + {CipherText, Write} = encode_tls_cipher_text(CipherFragment, Write0), {CipherText, ConnectionStates#{current_write => Write}}. encode_iolist(Type, Data, ConnectionStates0) -> @@ -105,24 +105,23 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, fragment = CipherFragment}, #{current_read := #{sequence_number := Seq, - cipher_state := CipherS0, + cipher_state := #cipher_state{key = Key, + iv = IV, + tag_len = TagLen}, security_parameters := #security_parameters{ cipher_type = ?AEAD, bulk_cipher_algorithm = BulkCipherAlgo} } = ReadState0} = ConnectionStates0) -> - AAD = start_additional_data(), - CipherS1 = ssl_cipher:nonce_seed(<<?UINT64(Seq)>>, CipherS0), - case decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment) of - {PlainFragment, CipherS1} -> + case decipher_aead(CipherFragment, BulkCipherAlgo, Key, Seq, IV, TagLen) of + #alert{} = Alert -> + Alert; + PlainFragment -> ConnectionStates = ConnectionStates0#{current_read => - ReadState0#{cipher_state => CipherS1, - sequence_number => Seq + 1}}, - decode_inner_plaintext(PlainFragment, ConnectionStates); - #alert{} = Alert -> - Alert + ReadState0#{sequence_number => Seq + 1}}, + {decode_inner_plaintext(PlainFragment), ConnectionStates} end; decode_cipher_text(#ssl_tls{type = Type, version = ?LEGACY_VERSION, @@ -137,7 +136,7 @@ decode_cipher_text(#ssl_tls{type = Type, fragment = CipherFragment}, ConnnectionStates0}; decode_cipher_text(#ssl_tls{type = Type}, _) -> %% Version mismatch is already asserted - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {record_typ_mismatch, Type}). + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {record_type_mismatch, Type}). %%-------------------------------------------------------------------- %%% Internal functions @@ -170,62 +169,61 @@ encode_plain_text(#inner_plaintext{ content = Data, type = Type, zeros = Zeros - }, #{cipher_state := CipherS0, + }, #{cipher_state := #cipher_state{key= Key, + iv = IV, + tag_len = TagLen}, sequence_number := Seq, security_parameters := #security_parameters{ - cipher_type = ?AEAD} - } = WriteState0) -> - PlainText = <<Data/binary, ?BYTE(Type), Zeros/binary>>, - AAD = start_additional_data(), - CipherS1 = ssl_cipher:nonce_seed(<<?UINT64(Seq)>>, CipherS0), - {Encoded, WriteState} = cipher_aead(PlainText, WriteState0#{cipher_state => CipherS1}, AAD), - {#tls_cipher_text{opaque_type = Type, - legacy_version = {3,3}, - encoded_record = Encoded}, WriteState}; + cipher_type = ?AEAD, + bulk_cipher_algorithm = BulkCipherAlgo} + }) -> + PlainText = [Data, Type, Zeros], + Encoded = cipher_aead(PlainText, BulkCipherAlgo, Key, Seq, IV, TagLen), + #tls_cipher_text{opaque_type = 23, %% 23 (application_data) for outward compatibility + legacy_version = {3,3}, + encoded_record = Encoded}; encode_plain_text(#inner_plaintext{ content = Data, type = Type }, #{security_parameters := #security_parameters{ cipher_suite = ?TLS_NULL_WITH_NULL_NULL} - } = WriteState0) -> + }) -> %% RFC8446 - 5.1. Record Layer %% When record protection has not yet been engaged, TLSPlaintext %% structures are written directly onto the wire. - {#tls_cipher_text{opaque_type = Type, + #tls_cipher_text{opaque_type = Type, legacy_version = {3,3}, - encoded_record = Data}, WriteState0}; + encoded_record = Data}; encode_plain_text(_, CS) -> exit({cs, CS}). -start_additional_data() -> - {MajVer, MinVer} = ?LEGACY_VERSION, - <<?BYTE(?OPAQUE_TYPE), ?BYTE(MajVer), ?BYTE(MinVer)>>. - -end_additional_data(AAD, Len) -> - <<AAD/binary, ?UINT16(Len)>>. - -nonce(#cipher_state{nonce = Nonce, iv = IV}) -> - Len = size(IV), - crypto:exor(<<Nonce:Len/bytes>>, IV). +additional_data(Length) -> + <<?BYTE(?OPAQUE_TYPE), ?BYTE(3), ?BYTE(3),?UINT16(Length)>>. -cipher_aead(Fragment, - #{cipher_state := CipherS0, - security_parameters := - #security_parameters{bulk_cipher_algorithm = - BulkCipherAlgo} - } = WriteState0, AAD) -> - {CipherFragment, CipherS1} = - cipher_aead(BulkCipherAlgo, CipherS0, AAD, Fragment), - {CipherFragment, WriteState0#{cipher_state => CipherS1}}. +%% The per-record nonce for the AEAD construction is formed as +%% follows: +%% +%% 1. The 64-bit record sequence number is encoded in network byte +%% order and padded to the left with zeros to iv_length. +%% +%% 2. The padded sequence number is XORed with either the static +%% client_write_iv or server_write_iv (depending on the role). +%% +%% The resulting quantity (of length iv_length) is used as the +%% per-record nonce. +nonce(Seq, IV) -> + Padding = binary:copy(<<0>>, byte_size(IV) - 8), + crypto:exor(<<Padding/binary,?UINT64(Seq)>>, IV). -cipher_aead(Type, #cipher_state{key=Key} = CipherState, AAD0, Fragment) -> - AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)), - Nonce = nonce(CipherState), - {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), - {<<Content/binary, CipherTag/binary>>, CipherState}. +cipher_aead(Fragment, BulkCipherAlgo, Key, Seq, IV, TagLen) -> + AAD = additional_data(erlang:iolist_size(Fragment) + TagLen), + Nonce = nonce(Seq, IV), + {Content, CipherTag} = + ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD), + <<Content/binary, CipherTag/binary>>. encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type, legacy_version = {MajVer, MinVer}, @@ -234,13 +232,14 @@ encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type, {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Encoded], Write#{sequence_number => Seq +1}}. -decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment) -> +decipher_aead(CipherFragment, BulkCipherAlgo, Key, Seq, IV, TagLen) -> try - Nonce = nonce(CipherState), - {AAD, CipherText, CipherTag} = aead_ciphertext_split(CipherState, CipherFragment, AAD0), - case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of + AAD = additional_data(erlang:iolist_size(CipherFragment)), + Nonce = nonce(Seq, IV), + {CipherText, CipherTag} = aead_ciphertext_split(CipherFragment, TagLen), + case ssl_cipher:aead_decrypt(BulkCipherAlgo, Key, Nonce, CipherText, CipherTag, AAD) of Content when is_binary(Content) -> - {Content, CipherState}; + Content; _ -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end @@ -249,39 +248,34 @@ decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) end. -aead_ciphertext_split(#cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> - CipherLen = size(CipherTextFragment) - Len, - <<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, - {end_additional_data(AAD, CipherLen), CipherText, CipherTag}. -decode_inner_plaintext(PlainText, ConnnectionStates) -> - case remove_padding(PlainText) of - #alert{} = Alert -> - Alert; - {Data, Type} -> - {#ssl_tls{type = Type, - version = {3,4}, %% Internally use real version - fragment = Data}, ConnnectionStates} - end. +aead_ciphertext_split(CipherTextFragment, TagLen) + when is_binary(CipherTextFragment) -> + CipherLen = erlang:byte_size(CipherTextFragment) - TagLen, + <<CipherText:CipherLen/bytes, CipherTag:TagLen/bytes>> = CipherTextFragment, + {CipherText, CipherTag}; +aead_ciphertext_split(CipherTextFragment, TagLen) + when is_list(CipherTextFragment) -> + CipherLen = erlang:iolist_size(CipherTextFragment) - TagLen, + <<CipherText:CipherLen/bytes, CipherTag:TagLen/bytes>> = + erlang:iolist_to_binary(CipherTextFragment), + {CipherText, CipherTag}. -remove_padding(PlainText)-> - case binary:split(PlainText, <<0>>, [global, trim]) of - [] -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, padding_error); - [Content] -> - Type = binary:last(Content), - split_content(Type, Content, erlang:byte_size(Content) - 1) +decode_inner_plaintext(PlainText) -> + case binary:last(PlainText) of + 0 -> + decode_inner_plaintext(init_binary(PlainText)); + Type when Type =:= ?APPLICATION_DATA orelse + Type =:= ?HANDSHAKE orelse + Type =:= ?ALERT -> + #ssl_tls{type = Type, + version = {3,4}, %% Internally use real version + fragment = init_binary(PlainText)}; + _Else -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_alert) end. -split_content(?HANDSHAKE, _, 0) -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_handshake); -split_content(?ALERT, _, 0) -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_alert); -%% For special middlebox compatible case! -split_content(?CHANGE_CIPHER_SPEC, _, 0) -> - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_change_cipher_spec); -split_content(?APPLICATION_DATA = Type, _, 0) -> - {Type, <<>>}; -split_content(Type, Content, N) -> - <<Data:N/bytes, ?BYTE(Type)>> = Content, - {Type, Data}. +init_binary(B) -> + {Init, _} = + split_binary(B, byte_size(B) - 1), + Init. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 83dd7585dd..df2a421bce 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -36,7 +36,15 @@ default_signature_schemes/1, signature_schemes/2, groups/1, groups/2, group_to_enum/1, enum_to_group/1, default_groups/1]). --export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4]). +-export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4, + key_schedule/3, key_schedule/4, + external_binder_key/2, resumption_binder_key/2, + client_early_traffic_secret/3, early_exporter_master_secret/3, + client_handshake_traffic_secret/3, server_handshake_traffic_secret/3, + client_application_traffic_secret_0/3, server_application_traffic_secret_0/3, + exporter_master_secret/3, resumption_master_secret/3, + update_traffic_secret/2, calculate_traffic_keys/3, + transcript_hash/2]). -type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 | @@ -56,7 +64,7 @@ %% TLS 1.3 --------------------------------------------------- -spec derive_secret(Secret::binary(), Label::binary(), - Messages::binary(), Algo::ssl_cipher_format:hash()) -> Key::binary(). + Messages::iodata(), Algo::ssl_cipher_format:hash()) -> Key::binary(). derive_secret(Secret, Label, Messages, Algo) -> Hash = crypto:hash(mac_algo(Algo), Messages), hkdf_expand_label(Secret, Label, @@ -71,11 +79,14 @@ hkdf_expand_label(Secret, Label0, Context, Length, Algo) -> %% opaque label<7..255> = "tls13 " + Label; %% opaque context<0..255> = Context; %% } HkdfLabel; - Content = << <<"tls13">>/binary, Label0/binary, Context/binary>>, + Label1 = << <<"tls13 ">>/binary, Label0/binary>>, + LLen = size(Label1), + Label = <<?BYTE(LLen), Label1/binary>>, + Content = <<Label/binary, Context/binary>>, Len = size(Content), HkdfLabel = <<?UINT16(Len), Content/binary>>, hkdf_expand(Secret, HkdfLabel, Length, Algo). - + -spec hkdf_extract(MacAlg::ssl_cipher_format:hash(), Salt::binary(), KeyingMaterial::binary()) -> PseudoRandKey::binary(). @@ -89,6 +100,12 @@ hkdf_extract(MacAlg, Salt, KeyingMaterial) -> hkdf_expand(PseudoRandKey, ContextInfo, Length, Algo) -> Iterations = erlang:ceil(Length / ssl_cipher:hash_size(Algo)), hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, 1, Iterations, <<>>, <<>>). + + +-spec transcript_hash(Messages::iodata(), Algo::ssl_cipher_format:hash()) -> Hash::binary(). + +transcript_hash(Messages, Algo) -> + crypto:hash(mac_algo(Algo), Messages). %% TLS 1.3 --------------------------------------------------- %% TLS 1.0 -1.2 --------------------------------------------------- @@ -235,6 +252,153 @@ setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, ServerWriteKey, ClientIV, ServerIV}. %% TLS v1.2 --------------------------------------------------- +%% TLS v1.3 --------------------------------------------------- +%% RFC 8446 - 7.1. Key Schedule +%% +%% 0 +%% | +%% v +%% PSK -> HKDF-Extract = Early Secret +%% | +%% +-----> Derive-Secret(., "ext binder" | "res binder", "") +%% | = binder_key +%% | +%% +-----> Derive-Secret(., "c e traffic", ClientHello) +%% | = client_early_traffic_secret +%% | +%% +-----> Derive-Secret(., "e exp master", ClientHello) +%% | = early_exporter_master_secret +%% v +%% Derive-Secret(., "derived", "") +%% | +%% v +%% (EC)DHE -> HKDF-Extract = Handshake Secret +%% | +%% +-----> Derive-Secret(., "c hs traffic", +%% | ClientHello...ServerHello) +%% | = client_handshake_traffic_secret +%% | +%% +-----> Derive-Secret(., "s hs traffic", +%% | ClientHello...ServerHello) +%% | = server_handshake_traffic_secret +%% v +%% Derive-Secret(., "derived", "") +%% | +%% v +%% 0 -> HKDF-Extract = Master Secret +%% | +%% +-----> Derive-Secret(., "c ap traffic", +%% | ClientHello...server Finished) +%% | = client_application_traffic_secret_0 +%% | +%% +-----> Derive-Secret(., "s ap traffic", +%% | ClientHello...server Finished) +%% | = server_application_traffic_secret_0 +%% | +%% +-----> Derive-Secret(., "exp master", +%% | ClientHello...server Finished) +%% | = exporter_master_secret +%% | +%% +-----> Derive-Secret(., "res master", +%% ClientHello...client Finished) +%% = resumption_master_secret +-spec key_schedule(early_secret | handshake_secret | master_secret, + atom(), {psk | early_secret | handshake_secret, binary()}) -> + {early_secret | handshake_secret | master_secret, binary()}. + +key_schedule(early_secret, Algo, {psk, PSK}) -> + Len = ssl_cipher:hash_size(Algo), + Salt = binary:copy(<<?BYTE(0)>>, Len), + {early_secret, hkdf_extract(Algo, Salt, PSK)}; +key_schedule(master_secret, Algo, {handshake_secret, Secret}) -> + Len = ssl_cipher:hash_size(Algo), + IKM = binary:copy(<<?BYTE(0)>>, Len), + Salt = derive_secret(Secret, <<"derived">>, <<>>, Algo), + {master_secret, hkdf_extract(Algo, Salt, IKM)}. +%% +key_schedule(handshake_secret, Algo, IKM, {early_secret, Secret}) -> + Salt = derive_secret(Secret, <<"derived">>, <<>>, Algo), + {handshake_secret, hkdf_extract(Algo, Salt, IKM)}. + +-spec external_binder_key(atom(), {early_secret, binary()}) -> binary(). +external_binder_key(Algo, {early_secret, Secret}) -> + derive_secret(Secret, <<"ext binder">>, <<>>, Algo). + +-spec resumption_binder_key(atom(), {early_secret, binary()}) -> binary(). +resumption_binder_key(Algo, {early_secret, Secret}) -> + derive_secret(Secret, <<"res binder">>, <<>>, Algo). + +-spec client_early_traffic_secret(atom(), {early_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello +client_early_traffic_secret(Algo, {early_secret, Secret}, M) -> + derive_secret(Secret, <<"c e traffic">>, M, Algo). + +-spec early_exporter_master_secret(atom(), {early_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello +early_exporter_master_secret(Algo, {early_secret, Secret}, M) -> + derive_secret(Secret, <<"e exp master">>, M, Algo). + +-spec client_handshake_traffic_secret(atom(), {handshake_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...ServerHello +client_handshake_traffic_secret(Algo, {handshake_secret, Secret}, M) -> + derive_secret(Secret, <<"c hs traffic">>, M, Algo). + +-spec server_handshake_traffic_secret(atom(), {handshake_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...ServerHello +server_handshake_traffic_secret(Algo, {handshake_secret, Secret}, M) -> + derive_secret(Secret, <<"s hs traffic">>, M, Algo). + +-spec client_application_traffic_secret_0(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...server Finished +client_application_traffic_secret_0(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"c ap traffic">>, M, Algo). + +-spec server_application_traffic_secret_0(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...server Finished +server_application_traffic_secret_0(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"s ap traffic">>, M, Algo). + +-spec exporter_master_secret(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...server Finished +exporter_master_secret(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"exp master">>, M, Algo). + +-spec resumption_master_secret(atom(), {master_secret, binary()}, iodata()) -> binary(). +%% M = ClientHello...client Finished +resumption_master_secret(Algo, {master_secret, Secret}, M) -> + derive_secret(Secret, <<"res master">>, M, Algo). + +%% The next-generation application_traffic_secret is computed as: +%% +%% application_traffic_secret_N+1 = +%% HKDF-Expand-Label(application_traffic_secret_N, +%% "traffic upd", "", Hash.length) +-spec update_traffic_secret(atom(), binary()) -> binary(). +update_traffic_secret(Algo, Secret) -> + hkdf_expand_label(Secret, <<"traffic upd">>, <<>>, ssl_cipher:hash_size(Algo), Algo). + +%% The traffic keying material is generated from the following input +%% values: +%% +%% - A secret value +%% +%% - A purpose value indicating the specific value being generated +%% +%% - The length of the key being generated +%% +%% The traffic keying material is generated from an input traffic secret +%% value using: +%% +%% [sender]_write_key = HKDF-Expand-Label(Secret, "key", "", key_length) +%% [sender]_write_iv = HKDF-Expand-Label(Secret, "iv", "", iv_length) +-spec calculate_traffic_keys(atom(), atom(), binary()) -> {binary(), binary()}. +calculate_traffic_keys(HKDFAlgo, Cipher, Secret) -> + Key = hkdf_expand_label(Secret, <<"key">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo), + IV = hkdf_expand_label(Secret, <<"iv">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo), + {Key, IV}. + +%% TLS v1.3 --------------------------------------------------- + %% TLS 1.0 -1.2 --------------------------------------------------- -spec mac_hash(integer() | atom(), binary(), integer(), integer(), tls_record:tls_version(), integer(), binary()) -> binary(). @@ -254,7 +418,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, %% TODO 1.3 same as above? --spec suites(1|2|3|4) -> [ssl_cipher_format:cipher_suite()]. +-spec suites(1|2|3|4|'TLS_v1.3') -> [ssl_cipher_format:cipher_suite()]. suites(Minor) when Minor == 1; Minor == 2 -> [ @@ -315,7 +479,17 @@ suites(4) -> %% Not supported %% ?TLS_AES_128_CCM_SHA256, %% ?TLS_AES_128_CCM_8_SHA256 - ] ++ suites(3). + ] ++ suites(3); + +suites('TLS_v1.3') -> + [?TLS_AES_256_GCM_SHA384, + ?TLS_AES_128_GCM_SHA256, + ?TLS_CHACHA20_POLY1305_SHA256 + %% Not supported + %% ?TLS_AES_128_CCM_SHA256, + %% ?TLS_AES_128_CCM_8_SHA256 + ]. + signature_algs({3, 4}, HashSigns) -> signature_algs({3, 3}, HashSigns); @@ -347,7 +521,9 @@ signature_algs({3, 3}, HashSigns) -> lists:reverse(Supported). default_signature_algs({3, 4} = Version) -> - default_signature_schemes(Version); + %% TLS 1.3 servers shall be prepared to process TLS 1.2 ClientHellos + %% containing legacy hash-sign tuples. + default_signature_schemes(Version) ++ default_signature_algs({3,3}); default_signature_algs({3, 3} = Version) -> Default = [%% SHA2 {sha512, ecdsa}, @@ -373,15 +549,23 @@ signature_schemes(Version, SignatureSchemes) when is_tuple(Version) Hashes = proplists:get_value(hashs, CryptoSupports), PubKeys = proplists:get_value(public_keys, CryptoSupports), Curves = proplists:get_value(curves, CryptoSupports), - Fun = fun (Scheme, Acc) -> + RSAPSSSupported = lists:member(rsa_pkcs1_pss_padding, + proplists:get_value(rsa_opts, CryptoSupports)), + Fun = fun (Scheme, Acc) when is_atom(Scheme) -> {Hash0, Sign0, Curve} = ssl_cipher:scheme_to_components(Scheme), Sign = case Sign0 of - rsa_pkcs1 -> rsa; + rsa_pkcs1 -> + rsa; + rsa_pss_rsae when RSAPSSSupported -> + rsa; + rsa_pss_pss when RSAPSSSupported -> + rsa; S -> S end, Hash = case Hash0 of - sha1 -> sha; + sha1 -> + sha; H -> H end, case proplists:get_bool(Sign, PubKeys) @@ -394,7 +578,10 @@ signature_schemes(Version, SignatureSchemes) when is_tuple(Version) [Scheme | Acc]; false -> Acc - end + end; + %% Special clause for filtering out the legacy hash-sign tuples. + (_ , Acc) -> + Acc end, Supported = lists:foldl(Fun, [], SignatureSchemes), lists:reverse(Supported); @@ -403,22 +590,29 @@ signature_schemes(_, _) -> default_signature_schemes(Version) -> Default = [ - rsa_pkcs1_sha256, - rsa_pkcs1_sha384, - rsa_pkcs1_sha512, - ecdsa_secp256r1_sha256, - ecdsa_secp384r1_sha384, ecdsa_secp521r1_sha512, - rsa_pss_rsae_sha256, - rsa_pss_rsae_sha384, + ecdsa_secp384r1_sha384, + ecdsa_secp256r1_sha256, + rsa_pss_pss_sha512, + rsa_pss_pss_sha384, + rsa_pss_pss_sha256, rsa_pss_rsae_sha512, + rsa_pss_rsae_sha384, + rsa_pss_rsae_sha256, %% ed25519, %% ed448, - rsa_pss_pss_sha256, - rsa_pss_pss_sha384, - rsa_pss_pss_sha512, - rsa_pkcs1_sha1, - ecdsa_sha1 + + %% These values refer solely to signatures + %% which appear in certificates (see Section 4.4.2.2) and are not + %% defined for use in signed TLS handshake messages, although they + %% MAY appear in "signature_algorithms" and + %% "signature_algorithms_cert" for backward compatibility with + %% TLS 1.2. + rsa_pkcs1_sha512, + rsa_pkcs1_sha384, + rsa_pkcs1_sha256, + ecdsa_sha1, + rsa_pkcs1_sha1 ], signature_schemes(Version, Default). @@ -553,7 +747,9 @@ ecc_curves(_Minor, TLSCurves) -> -spec groups(4 | all | default) -> [group()]. groups(all) -> - [secp256r1, + [x25519, + x448, + secp256r1, secp384r1, secp521r1, ffdhe2048, @@ -562,27 +758,33 @@ groups(all) -> ffdhe6144, ffdhe8192]; groups(default) -> - [secp256r1, - secp384r1, - secp521r1, - ffdhe2048]; + [x25519, + x448, + secp256r1, + secp384r1]; groups(Minor) -> TLSGroups = groups(all), groups(Minor, TLSGroups). %% -spec groups(4, [group()]) -> [group()]. groups(_Minor, TLSGroups) -> - %% TODO: Adding FFDHE groups to crypto? - CryptoGroups = crypto:ec_curves() ++ [ffdhe2048,ffdhe3072,ffdhe4096,ffdhe6144,ffdhe8192], + CryptoGroups = supported_groups(), lists:filter(fun(Group) -> proplists:get_bool(Group, CryptoGroups) end, TLSGroups). default_groups(Minor) -> TLSGroups = groups(default), groups(Minor, TLSGroups). +supported_groups() -> + %% TODO: Add new function to crypto? + proplists:get_value(curves, crypto:supports()) ++ + [ffdhe2048,ffdhe3072,ffdhe4096,ffdhe6144,ffdhe8192]. + group_to_enum(secp256r1) -> 23; group_to_enum(secp384r1) -> 24; group_to_enum(secp521r1) -> 25; +group_to_enum(x25519) -> 29; +group_to_enum(x448) -> 30; group_to_enum(ffdhe2048) -> 256; group_to_enum(ffdhe3072) -> 257; group_to_enum(ffdhe4096) -> 258; @@ -592,6 +794,8 @@ group_to_enum(ffdhe8192) -> 260. enum_to_group(23) -> secp256r1; enum_to_group(24) -> secp384r1; enum_to_group(25) -> secp521r1; +enum_to_group(29) -> x25519; +enum_to_group(30) -> x448; enum_to_group(256) -> ffdhe2048; enum_to_group(257) -> ffdhe3072; enum_to_group(258) -> ffdhe4096; diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 578f6a731a..76bf0fa895 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -189,6 +189,18 @@ gencrl(Root, CA, C, CrlHours) -> Env = [{"ROOTDIR", filename:absname(Root)}], cmd(Cmd, Env). +%% This function sets the number of seconds until the next CRL is due. +gencrl_sec(Root, CA, C, CrlSecs) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + Cmd = [C#config.openssl_cmd, " ca" + " -gencrl ", + " -crlsec ", integer_to_list(CrlSecs), + " -out ", CACRLFile, + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + can_generate_expired_crls(C) -> %% OpenSSL can generate CRLs with an expiration date in the past, %% if we pass a negative number for -crlhours. However, LibreSSL diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl index 6ffb6d311f..e4c4c89021 100644 --- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -160,7 +160,7 @@ certificate_1_3() -> ?LET(Certs, certificate_chain(), #certificate_1_3{ certificate_request_context = certificate_request_context(), - entries = certificate_entries(Certs, []) + certificate_list = certificate_entries(Certs, []) }). finished() -> @@ -326,7 +326,7 @@ extensions(?'TLS_v1.3' = Version, client_hello) -> %% oneof([psk_key_exchange_modes(), undefined]), %% oneof([early_data(), undefined]), %% oneof([cookie(), undefined]), - oneof([client_hello_versions(Version), undefined]), + oneof([client_hello_versions(Version)]), %% oneof([cert_authorities(), undefined]), %% oneof([post_handshake_auth(), undefined]), oneof([signature_algs_cert(), undefined]) @@ -403,7 +403,7 @@ extensions(?'TLS_v1.3' = Version, server_hello) -> { oneof([key_share(server_hello), undefined]), %% oneof([pre_shared_keys(), undefined]), - oneof([server_hello_selected_version(), undefined]) + oneof([server_hello_selected_version()]) }, maps:filter(fun(_, undefined) -> false; @@ -514,7 +514,9 @@ sig_scheme_list() -> client_hello_versions(?'TLS_v1.3') -> ?LET(SupportedVersions, oneof([[{3,4}], - [{3,3},{3,4}], + %% This list breaks the property but can be used for negative tests + %% [{3,3},{3,4}], + [{3,4},{3,3}], [{3,4},{3,3},{3,2},{3,1},{3,0}] ]), #client_hello_versions{versions = SupportedVersions}); @@ -543,7 +545,10 @@ choose_certificate_chain(#{server_config := ServerConf, oneof([certificate_chain(ServerConf), certificate_chain(ClientConf)]). certificate_request_context() -> - <<>>. + oneof([<<>>, + <<1>>, + <<"foobar">> + ]). certificate_entries([], Acc) -> lists:reverse(Acc); certificate_entries([Cert | Rest], Acc) -> diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec index 5e65bfcfe6..24272327c3 100644 --- a/lib/ssl/test/ssl.spec +++ b/lib/ssl/test/ssl.spec @@ -3,6 +3,7 @@ {suites,dir,all}. {skip_groups,dir,ssl_bench_SUITE,setup,"Benchmarks run separately"}. +{skip_groups,dir,ssl_bench_SUITE,payload,"Benchmarks run separately"}. {skip_groups,dir,ssl_bench_SUITE,pem_cache,"Benchmarks run separately"}. {skip_groups,dir,ssl_dist_bench_SUITE,setup,"Benchmarks run separately"}. {skip_groups,dir,ssl_dist_bench_SUITE,throughput,"Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl index 04c4b257d9..7f7c3da5ab 100644 --- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -262,52 +262,12 @@ client_renegotiate(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- session_reused(Config) when is_list(Config)-> - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_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). - + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). %-------------------------------------------------------------------------------- alpn_not_supported_client(Config) when is_list(Config) -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8d2c0c7e87..b8a8ef1d73 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -53,7 +53,8 @@ all() -> {group, options_tls}, {group, session}, {group, 'dtlsv1.2'}, - {group, 'dtlsv1'}, + {group, 'dtlsv1'}, + {group, 'tlsv1.3'}, {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, @@ -67,6 +68,7 @@ groups() -> {options_tls, [], options_tests_tls()}, {'dtlsv1.2', [], all_versions_groups()}, {'dtlsv1', [], all_versions_groups()}, + {'tlsv1.3', [], tls13_test_group()}, {'tlsv1.2', [], all_versions_groups() ++ tls_versions_groups() ++ [conf_signature_algs, no_common_signature_algs]}, {'tlsv1.1', [], all_versions_groups() ++ tls_versions_groups()}, {'tlsv1', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests()}, @@ -266,6 +268,12 @@ rizzo_tests() -> rizzo_zero_n, rizzo_disabled]. +%% For testing TLS 1.3 features and possible regressions +tls13_test_group() -> + [tls13_enable_client_side, + tls13_enable_server_side, + tls_record_1_3_encode_decode]. + %%-------------------------------------------------------------------- init_per_suite(Config0) -> catch crypto:stop(), @@ -295,7 +303,8 @@ init_per_group(GroupName, Config) when GroupName == basic_tls; GroupName == options; GroupName == basic; GroupName == session; - GroupName == error_handling_tests_tls + GroupName == error_handling_tests_tls; + GroupName == tls13_test_group -> ssl_test_lib:clean_tls_version(Config); init_per_group(GroupName, Config) -> @@ -654,8 +663,8 @@ new_options_in_accept(Config) when is_list(Config) -> handshake_continue() -> [{doc, "Test API function ssl:handshake_continue/3"}]. handshake_continue(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -714,7 +723,7 @@ hello_client_cancel(Config) when is_list(Config) -> hello_server_cancel() -> [{doc, "Test API function ssl:handshake_cancel/1 on the server side"}]. hello_server_cancel(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -756,8 +765,8 @@ prf(Config) when is_list(Config) -> secret_connection_info() -> [{doc,"Test the API function ssl:connection_information/2"}]. secret_connection_info(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -1446,8 +1455,8 @@ cipher_suites_mix() -> cipher_suites_mix(Config) when is_list(Config) -> CipherSuites = [{dhe_rsa,aes_128_cbc,sha256,sha256}, {dhe_rsa,aes_128_cbc,sha}], - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -2358,8 +2367,8 @@ invalid_options() -> [{doc,"Test what happens when we give invalid options"}]. invalid_options(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Check = fun(Client, Server, {versions, [sslv2, sslv3]} = Option) -> @@ -2374,27 +2383,28 @@ invalid_options(Config) when is_list(Config) -> {error, {options, Option}}) end, - TestOpts = [{versions, [sslv2, sslv3]}, - {verify, 4}, - {verify_fun, function}, - {fail_if_no_peer_cert, 0}, - {verify_client_once, 1}, - {depth, four}, - {certfile, 'cert.pem'}, - {keyfile,'key.pem' }, - {password, foo}, - {cacertfile, ""}, - {dhfile,'dh.pem' }, - {ciphers, [{foo, bar, sha, ignore}]}, - {reuse_session, foo}, - {reuse_sessions, 0}, - {renegotiate_at, "10"}, - {mode, depech}, - {packet, 8.0}, - {packet_size, "2"}, - {header, a}, - {active, trice}, - {key, 'key.pem' }], + TestOpts = + [{versions, [sslv2, sslv3]}, + {verify, 4}, + {verify_fun, function}, + {fail_if_no_peer_cert, 0}, + {verify_client_once, 1}, + {depth, four}, + {certfile, 'cert.pem'}, + {keyfile,'key.pem' }, + {password, foo}, + {cacertfile, ""}, + {dhfile,'dh.pem' }, + {ciphers, [{foo, bar, sha, ignore}]}, + {reuse_session, foo}, + {reuse_sessions, 0}, + {renegotiate_at, "10"}, + {mode, depech}, + {packet, 8.0}, + {packet_size, "2"}, + {header, a}, + {active, trice}, + {key, 'key.pem' }], [begin Server = @@ -2687,175 +2697,69 @@ ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. reuse_session(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = - ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, ServerOpts}]), - Port = ssl_test_lib:inet_port(Server), - Client0 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, ClientOpts}]), - SessionInfo = - receive - {Server, Info} -> - Info - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - %% 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:log("Expected: ~p, Unexpected: ~p~n", - [SessionInfo, Other]), - ct:fail(session_not_reused) - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, - - Client2 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, [{reuse_sessions, false} - | ClientOpts]}]), - receive - {Client2, SessionInfo} -> - ct:fail( - session_reused_when_session_reuse_disabled_by_client); - {Client2, _} -> - ok - end, - - ssl_test_lib:close(Server), - - Server1 = - ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {options, [{reuse_sessions, false} | ServerOpts]}]), - - Port1 = ssl_test_lib:inet_port(Server1), - Client3 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port1}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, ClientOpts}]), - - SessionInfo1 = - receive - {Server1, Info1} -> - Info1 - end, - - Server1 ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, - - %% Make sure session is registered - ct:sleep(?SLEEP), - - Client4 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port1}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), - - receive - {Client4, SessionInfo1} -> - ct:fail( - session_reused_when_session_reuse_disabled_by_server); - {Client4, _Other} -> - ct:log("OTHER: ~p ~n", [_Other]), - ok - end, - - ssl_test_lib:close(Server1), - ssl_test_lib:close(Client0), - ssl_test_lib:close(Client1), - ssl_test_lib:close(Client2), - ssl_test_lib:close(Client3), - ssl_test_lib:close(Client4). - + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). %%-------------------------------------------------------------------- reuse_session_expired() -> [{doc,"Test sessions is not reused when it has expired"}]. reuse_session_expired(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = - ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + + Server0 = + 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), - Client0 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, ClientOpts}]), - SessionInfo = - receive - {Server, Info} -> - Info - end, - - Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, ServerOpts}]), + Port0 = ssl_test_lib:inet_port(Server0), - %% 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}]), + Client0 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + Server0 ! listen, + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + + SID = receive + {Client0, Id0} -> + Id0 + end, + receive - {Client1, SessionInfo} -> - ok; - {Client1, Other} -> - ct:log("Expected: ~p, Unexpected: ~p~n", - [SessionInfo, Other]), - ct:fail(session_not_reused) + {Client1, SID} -> + ok + after ?SLEEP -> + ct:fail(session_not_reused) end, - Server ! listen, - + Server0 ! listen, + %% Make sure session is unregistered due to expiration - ct:sleep((?EXPIRE+1)), - [{session_id, Id} |_] = SessionInfo, + ct:sleep((?EXPIRE*2)), - make_sure_expired(Hostname, Port, Id), + make_sure_expired(Hostname, Port0, SID), Client2 = ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, session_info_result, []}}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, {from, self()}, {options, ClientOpts}]), receive - {Client2, SessionInfo} -> + {Client2, SID} -> ct:fail(session_reused_when_session_expired); {Client2, _} -> ok end, process_flag(trap_exit, false), - ssl_test_lib:close(Server), + ssl_test_lib:close(Server0), ssl_test_lib:close(Client0), ssl_test_lib:close(Client1), ssl_test_lib:close(Client2). @@ -2864,16 +2768,16 @@ make_sure_expired(Host, Port, Id) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - Cache = element(2, State), + ClientCache = element(2, State), - case ssl_session_cache:lookup(Cache, {{Host, Port}, Id}) of + case ssl_session_cache:lookup(ClientCache, {{Host, Port}, Id}) of undefined -> - ok; + ok; #session{is_resumable = false} -> - ok; + ok; _ -> ct:sleep(?SLEEP), - make_sure_expired(Host, Port, Id) + make_sure_expired(Host, Port, Id) end. %%-------------------------------------------------------------------- @@ -4472,6 +4376,163 @@ accept_pool(Config) when is_list(Config) -> ssl_test_lib:close(Client1), ssl_test_lib:close(Client2). +%%-------------------------------------------------------------------- +%% TLS 1.3 +%%-------------------------------------------------------------------- + +tls13_enable_client_side() -> + [{doc,"Test that a TLS 1.3 client can connect to a TLS 1.2 server."}]. + +tls13_enable_client_side(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(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, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.1', 'tlsv1.2']} | ServerOpts] }]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.2', 'tlsv1.3']} | ClientOpts]}]), + + ServerMsg = ClientMsg = {ok, 'tlsv1.2'}, + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). + +tls13_enable_server_side() -> + [{doc,"Test that a TLS 1.2 client can connect to a TLS 1.3 server."}]. + +tls13_enable_server_side(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(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, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.2', 'tlsv1.3']} | ServerOpts] }]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, protocol_info_result, []}}, + {options, [{versions, + ['tlsv1.2', 'tlsv1.1']} | ClientOpts]}]), + + ServerMsg = ClientMsg = {ok, 'tlsv1.2'}, + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). + +tls_record_1_3_encode_decode() -> + [{doc,"Test TLS 1.3 record encode/decode functions"}]. + +tls_record_1_3_encode_decode(_Config) -> + ConnectionStates = + #{current_read => + #{beast_mitigation => one_n_minus_one, + cipher_state => + {cipher_state, + <<14,172,111,243,199,170,242,203,126,205,34,93,122,115,226,14, + 15,117,155,48,24,112,61,15,113,208,127,51,179,227,194,232>>, + <<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228, + 131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>, + undefined,undefined,16}, + client_verify_data => undefined,compression_state => undefined, + mac_secret => undefined,secure_renegotiation => undefined, + security_parameters => + {security_parameters, + <<19,2>>, + 0,8,2,undefined,undefined,undefined,undefined,undefined, + sha384,undefined,undefined, + {handshake_secret, + <<128,229,186,211,62,127,182,20,62,166,233,23,135,64,121, + 3,104,251,214,161,253,31,3,2,232,37,8,221,189,72,64,218, + 121,41,112,148,254,34,68,164,228,60,161,201,132,55,56, + 157>>}, + undefined, + <<92,24,205,75,244,60,136,212,250,32,214,20,37,3,213,87,61,207, + 147,61,168,145,177,118,160,153,33,53,48,108,191,174>>, + undefined}, + sequence_number => 0,server_verify_data => undefined}, + current_write => + #{beast_mitigation => one_n_minus_one, + cipher_state => + {cipher_state, + <<14,172,111,243,199,170,242,203,126,205,34,93,122,115,226,14, + 15,117,155,48,24,112,61,15,113,208,127,51,179,227,194,232>>, + <<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228, + 131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>, + undefined,undefined,16}, + client_verify_data => undefined,compression_state => undefined, + mac_secret => undefined,secure_renegotiation => undefined, + security_parameters => + {security_parameters, + <<19,2>>, + 0,8,2,undefined,undefined,undefined,undefined,undefined, + sha384,undefined,undefined, + {handshake_secret, + <<128,229,186,211,62,127,182,20,62,166,233,23,135,64,121, + 3,104,251,214,161,253,31,3,2,232,37,8,221,189,72,64,218, + 121,41,112,148,254,34,68,164,228,60,161,201,132,55,56, + 157>>}, + undefined, + <<92,24,205,75,244,60,136,212,250,32,214,20,37,3,213,87,61,207, + 147,61,168,145,177,118,160,153,33,53,48,108,191,174>>, + undefined}, + sequence_number => 0,server_verify_data => undefined}}, + + PlainText = [11, + <<0,2,175>>, + <<0,0,2,171,0,2,166,48,130,2,162,48,130,1,138,2,9,0,186,57,220,137,88,255, + 191,235,48,13,6,9,42,134,72,134,247,13,1,1,11,5,0,48,18,49,16,48,14,6,3,85, + 4,3,12,7,84,101,115,116,32,67,65,48,30,23,13,49,56,48,53,48,52,49,52,49,50, + 51,56,90,23,13,50,56,48,50,48,52,49,52,49,50,51,56,90,48,20,49,18,48,16,6, + 3,85,4,3,12,9,108,111,99,97,108,104,111,115,116,48,130,1,34,48,13,6,9,42, + 134,72,134,247,13,1,1,1,5,0,3,130,1,15,0,48,130,1,10,2,130,1,1,0,169,40, + 144,176,121,63,134,97,144,126,243,183,225,157,37,131,183,225,87,243,23,88, + 230,70,9,134,32,147,7,27,167,98,51,81,224,75,199,12,229,251,195,207,75,179, + 181,78,128,3,255,44,58,39,43,172,142,45,186,58,51,65,187,199,154,153,245, + 70,133,137,1,27,87,42,116,65,251,129,109,145,233,97,171,71,54,213,185,74, + 209,166,11,218,189,119,206,86,170,60,212,213,85,189,30,50,215,23,185,53, + 132,238,132,176,198,250,139,251,198,221,225,128,109,113,23,220,39,143,71, + 30,59,189,51,244,61,158,214,146,180,196,103,169,189,221,136,78,129,216,148, + 2,9,8,65,37,224,215,233,13,209,21,235,20,143,33,74,59,53,208,90,152,94,251, + 54,114,171,39,88,230,227,158,211,135,37,182,67,205,161,59,20,138,58,253,15, + 53,48,8,157,9,95,197,9,177,116,21,54,9,125,78,109,182,83,20,16,234,223,116, + 41,155,123,87,77,17,120,153,246,239,124,130,105,219,166,146,242,151,66,198, + 75,72,63,28,246,86,16,244,223,22,36,50,15,247,222,98,6,152,136,154,72,150, + 73,127,2,3,1,0,1,48,13,6,9,42,134,72,134,247,13,1,1,11,5,0,3,130,1,1,0,76, + 33,54,160,229,219,219,193,150,116,245,252,18,39,235,145,86,12,167,171,52, + 117,166,30,83,5,216,245,177,217,247,95,1,136,94,246,212,108,248,230,111, + 225,202,189,6,129,8,70,128,245,18,204,215,87,82,129,253,227,122,66,182,184, + 189,30,193,169,144,218,216,109,105,110,215,144,60,104,162,178,101,164,218, + 122,60,37,41,143,57,150,52,59,51,112,238,113,239,168,114,69,183,143,154,73, + 61,58,80,247,172,95,251,55,28,186,28,200,206,230,118,243,92,202,189,49,76, + 124,252,76,0,247,112,85,194,69,59,222,163,228,103,49,110,104,109,251,155, + 138,9,37,167,49,189,48,134,52,158,185,129,24,96,153,196,251,90,206,76,239, + 175,119,174,165,133,108,222,125,237,125,187,149,152,83,190,16,202,94,202, + 201,40,218,22,254,63,189,41,174,97,140,203,70,18,196,118,237,175,134,79,78, + 246,2,61,54,77,186,112,32,17,193,192,188,217,252,215,200,7,245,180,179,132, + 183,212,229,155,15,152,206,135,56,81,88,3,123,244,149,110,182,72,109,70,62, + 146,152,146,151,107,126,216,210,9,93,0,0>>], + + {[_Header|Encoded], _} = tls_record_1_3:encode_plain_text(22, PlainText, ConnectionStates), + CipherText = #ssl_tls{type = 23, version = {3,3}, fragment = Encoded}, + + {#ssl_tls{type = 22, version = {3,4}, fragment = DecodedText}, _} = + tls_record_1_3:decode_cipher_text(CipherText, ConnectionStates), + + DecodedText = iolist_to_binary(PlainText), + ct:log("Decoded: ~p ~n", [DecodedText]), + ok. + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ @@ -4486,8 +4547,8 @@ tcp_send_recv_result(Socket) -> ok. basic_verify_test_no_close(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -4962,16 +5023,16 @@ run_suites(Ciphers, Config, Type) -> {ClientOpts, ServerOpts} = case Type of rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_opts, Config)]}; dsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_dsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_dsa_opts, Config)]}; anonymous -> %% No certs in opts! - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options([], Config)]}; psk -> @@ -5001,38 +5062,38 @@ run_suites(Ciphers, Config, Type) -> {ssl_test_lib:ssl_options(client_srp_dsa, Config), ssl_test_lib:ssl_options(server_srp_dsa, Config)}; ecdsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdsa_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; ecdh_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}; rc4_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; rc4_ecdh_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]}; rc4_ecdsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; des_dhe_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_verification_opts, Config)]}; des_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; chacha_rsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; chacha_ecdsa -> - {ssl_test_lib:ssl_options(client_verification_opts, Config), + {ssl_test_lib:ssl_options(client_ecdsa_opts, Config), [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]} end, diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec index 8b746c5ca9..217cc6fc83 100644 --- a/lib/ssl/test/ssl_bench.spec +++ b/lib/ssl/test/ssl_bench.spec @@ -1 +1,2 @@ {suites,"../ssl_test",[ssl_bench_SUITE, ssl_dist_bench_SUITE]}. +{skip_groups,"../ssl_test",ssl_bench_SUITE,basic,"Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index 13097b08b6..0b2011a627 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -25,10 +25,11 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. -all() -> [{group, setup}, {group, payload}, {group, pem_cache}]. +all() -> [{group, basic}, {group, setup}, {group, payload}, {group, pem_cache}]. groups() -> - [{setup, [{repeat, 3}], [setup_sequential, setup_concurrent]}, + [{basic, [], [basic_pem_cache]}, + {setup, [{repeat, 3}], [setup_sequential, setup_concurrent]}, {payload, [{repeat, 3}], [payload_simple]}, {pem_cache, [{repeat, 3}], [use_pem_cache, bypass_pem_cache]} ]. @@ -51,29 +52,21 @@ init_per_suite(Config) -> end_per_suite(_Config) -> ok. -init_per_testcase(use_pem_cache, Conf) -> +init_per_testcase(TC, Conf) when TC =:= use_pem_cache; + TC =:= bypass_pem_cache; + TC =:= basic_pem_cache -> case bypass_pem_cache_supported() of false -> {skipped, "PEM cache bypass support required"}; true -> application:set_env(ssl, bypass_pem_cache, false), Conf end; -init_per_testcase(bypass_pem_cache, Conf) -> - case bypass_pem_cache_supported() of - false -> {skipped, "PEM cache bypass support required"}; - true -> - application:set_env(ssl, bypass_pem_cache, true), - Conf - end; init_per_testcase(_Func, Conf) -> Conf. -end_per_testcase(use_pem_cache, _Config) -> - case bypass_pem_cache_supported() of - false -> ok; - true -> application:set_env(ssl, bypass_pem_cache, false) - end; -end_per_testcase(bypass_pem_cache, _Config) -> +end_per_testcase(TC, _Config) when TC =:= use_pem_cache; + TC =:= bypass_pem_cache; + TC =:= basic_pem_cache -> case bypass_pem_cache_supported() of false -> ok; true -> application:set_env(ssl, bypass_pem_cache, false) @@ -119,6 +112,9 @@ payload_simple(Config) -> {suite, "ssl"}, {name, "Payload simple"}]}), ok. +basic_pem_cache(_Config) -> + do_test(ssl, pem_cache, 10, 5, node()). + use_pem_cache(_Config) -> {ok, Result} = do_test(ssl, pem_cache, 100, 500, node()), ct_event:notify(#event{name = benchmark_data, diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl index 23c5eaf84d..c61039b5da 100644 --- a/lib/ssl/test/ssl_crl_SUITE.erl +++ b/lib/ssl/test/ssl_crl_SUITE.erl @@ -383,8 +383,11 @@ crl_hash_dir_expired(Config) when is_list(Config) -> {verify, verify_peer}], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - %% First make a CRL that expired yesterday. - make_certs:gencrl(PrivDir, CA, CertsConfig, -24), + %% First make a CRL that will expire in one second. + make_certs:gencrl_sec(PrivDir, CA, CertsConfig, 1), + %% Sleep until the next CRL is due + ct:sleep({seconds, 1}), + CrlDir = filename:join(PrivDir, "crls"), populate_crl_hash_dir(PrivDir, CrlDir, [{CA, "1627b4b0"}], diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index e39313e5cd..1b432970b6 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -26,6 +26,7 @@ -include_lib("common_test/include/ct.hrl"). -include("ssl_alert.hrl"). +-include("ssl_handshake.hrl"). -include("ssl_internal.hrl"). -include("tls_handshake.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -42,7 +43,8 @@ all() -> [decode_hello_handshake, decode_empty_server_sni_correctly, select_proper_tls_1_2_rsa_default_hashsign, ignore_hassign_extension_pre_tls_1_2, - unorded_chain, signature_algorithms]. + unorded_chain, signature_algorithms, + encode_decode_srp]. %%-------------------------------------------------------------------- init_per_suite(Config) -> @@ -124,13 +126,13 @@ decode_supported_elliptic_curves_hello_extension_correctly(_Config) -> Len = ListLen + 2, Extension = <<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary>>, % after decoding we should see only valid curves - Extensions = ssl_handshake:decode_hello_extensions(Extension, {3,2}, client), + Extensions = ssl_handshake:decode_hello_extensions(Extension, {3,2}, {3,2}, client), #{elliptic_curves := #elliptic_curves{elliptic_curve_list = [?sect233k1, ?sect193r2]}} = Extensions. decode_unknown_hello_extension_correctly(_Config) -> FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>, Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = ssl_handshake:decode_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, {3,2}, client), + Extensions = ssl_handshake:decode_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, {3,2}, {3,2}, client), #{renegotiation_info := #renegotiation_info{renegotiated_connection = <<0>>}} = Extensions. @@ -145,12 +147,12 @@ encode_single_hello_sni_extension_correctly(_Config) -> decode_single_hello_sni_extension_correctly(_Config) -> SNI = <<16#00, 16#00, 16#00, 16#0d, 16#00, 16#0b, 16#00, 16#00, 16#08, $t, $e, $s, $t, $., $c, $o, $m>>, - Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, client), + Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, {3,3}, client), #{sni := #sni{hostname = "test.com"}} = Decoded. decode_empty_server_sni_correctly(_Config) -> SNI = <<?UINT16(?SNI_EXT),?UINT16(0)>>, - Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, server), + Decoded = ssl_handshake:decode_hello_extensions(SNI, {3,3}, {3,3}, server), #{sni := #sni{hostname = ""}} = Decoded. @@ -190,6 +192,30 @@ unorded_chain(Config) when is_list(Config) -> {ok, _, OrderedChain} = ssl_certificate:certificate_chain(PeerCert, ets:new(foo, []), ExtractedCerts, UnordedChain). +encode_decode_srp(_Config) -> + Exts = #{srp => #srp{username = <<"foo">>}, + sni => #sni{hostname = "bar"}, + renegotiation_info => undefined, + signature_algs => undefined, + alpn => undefined, + next_protocol_negotiation => undefined, + ec_point_formats => undefined, + elliptic_curves => undefined + }, + EncodedExts0 = <<0,20, % Length + 0,12, % SRP extension + 0,4, % Length + 3, % srp_I length + 102,111,111, % username = "foo" + 0,0, % SNI extension + 0,8, % Length + 0,6, % ServerNameLength + 0, % NameType (host_name) + 0,3, % HostNameLength + 98,97,114>>, % hostname = "bar" + EncodedExts0 = <<?UINT16(_),EncodedExts/binary>> = + ssl_handshake:encode_hello_extensions(Exts), + Exts = ssl_handshake:decode_hello_extensions(EncodedExts, {3,3}, {3,3}, client). signature_algorithms(Config) -> Opts = proplists:get_value(server_opts, Config), diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 1c7d6b5f9f..878e983bb9 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -64,13 +64,12 @@ next_protocol_not_supported() -> npn_not_supported_server ]. -init_per_suite(Config) -> +init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> ssl_test_lib:clean_start(), - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config), - proplists:get_value(priv_dir, Config)), + Config = ssl_test_lib:make_rsa_cert(Config0), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -196,10 +195,10 @@ client_negotiate_server_does_not_support(Config) when is_list(Config) -> renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> Data = "hello world", - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}] ++ ClientOpts0, - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, ExpectedProtocol = {ok, <<"http/1.0">>}, @@ -221,7 +220,7 @@ renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- npn_not_supported_client(Config) when is_list(Config) -> - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), PrefProtocols = {client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}, ClientOpts = [PrefProtocols] ++ ClientOpts0, @@ -236,7 +235,7 @@ npn_not_supported_client(Config) when is_list(Config) -> %-------------------------------------------------------------------------------- npn_not_supported_server(Config) when is_list(Config)-> - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, ServerOpts = [AdvProtocols] ++ ServerOpts0, @@ -244,63 +243,24 @@ npn_not_supported_server(Config) when is_list(Config)-> %-------------------------------------------------------------------------------- npn_handshake_session_reused(Config) when is_list(Config)-> - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"http/1.0">>], <<"http/1.1">>}}] ++ ClientOpts0, - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts =[{next_protocols_advertised, [<<"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:reuse_session(ClientOpts, ServerOpts, Config). - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ssl_test_lib:close(Client1). - %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> Data = "hello world", - ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = ClientExtraOpts ++ ClientOpts0, - ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), ServerOpts = ServerExtraOpts ++ ServerOpts0, {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl index 1f9b6a5772..27b9c258a0 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -64,7 +64,8 @@ payload_tests() -> server_echos_active_huge, client_echos_passive_huge, client_echos_active_once_huge, - client_echos_active_huge]. + client_echos_active_huge, + client_active_once_server_close]. init_per_suite(Config) -> catch crypto:stop(), @@ -397,6 +398,23 @@ client_echos_active_huge(Config) when is_list(Config) -> client_echos_active( Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + +%%-------------------------------------------------------------------- +client_active_once_server_close() -> + [{doc, "Server sends 500000 bytes and immediately after closes the connection" + "Make sure client recives all data if possible"}]. + +client_active_once_server_close(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + %% + Data = binary:copy(<<"1234567890">>, 50000), + client_active_once_server_close( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname). + + + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -541,42 +559,57 @@ client_echos_active( ssl_test_lib:close(Server), ssl_test_lib:close(Client). +client_active_once_server_close( + Data, ClientOpts, ServerOpts, ClientNode, ServerNode, Hostname) -> + Length = byte_size(Data), + Server = + ssl_test_lib:start_server( + [{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_close, [Data]}}, + {options, [{active, once}, {mode, binary} | 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, active_once_recv, [Length]}}, + {options,[{active, once}, {mode, binary} | ClientOpts]}]), + %% + ssl_test_lib:check_result(Server, ok, Client, ok). + +send(_Socket, _Data, 0, _) -> + ok; +send(Socket, Data, Count, RecvEcho) -> + ok = ssl:send(Socket, Data), + RecvEcho(), + send(Socket, Data, Count - 1, RecvEcho). -send(Socket, Data, Count, Verify) -> - send(Socket, Data, Count, <<>>, Verify). -%% -send(_Socket, _Data, 0, Acc, _Verify) -> - Acc; -send(Socket, Data, Count, Acc, Verify) -> +send_close(Socket, Data) -> ok = ssl:send(Socket, Data), - NewAcc = Verify(Acc), - send(Socket, Data, Count - 1, NewAcc, Verify). + ssl:close(Socket). - sender(Socket, Data) -> ct:log("Sender recv: ~p~n", [ssl:getopts(Socket, [active])]), - <<>> = - send( - Socket, Data, 100, - fun(Acc) -> verify_recv(Socket, Data, Acc) end), - ok. + send(Socket, Data, 100, + fun() -> + ssl_test_lib:recv_disregard(Socket, byte_size(Data)) + end). sender_active_once(Socket, Data) -> ct:log("Sender active once: ~p~n", [ssl:getopts(Socket, [active])]), - <<>> = - send( - Socket, Data, 100, - fun(Acc) -> verify_active_once(Socket, Data, Acc) end), - ok. + send(Socket, Data, 100, + fun() -> + ssl_test_lib:active_once_disregard(Socket, byte_size(Data)) + end). sender_active(Socket, Data) -> ct:log("Sender active: ~p~n", [ssl:getopts(Socket, [active])]), - <<>> = - send( - Socket, Data, 100, - fun(Acc) -> verify_active(Socket, Data, Acc) end), - ok. - + send(Socket, Data, 100, + fun() -> + ssl_test_lib:active_disregard(Socket, byte_size(Data)) + end). echoer(Socket, Size) -> ct:log("Echoer recv: ~p~n", [ssl:getopts(Socket, [active])]), @@ -592,99 +625,32 @@ echoer_active(Socket, Size) -> %% Receive Size bytes +echo_recv(_Socket, 0) -> + ok; echo_recv(Socket, Size) -> {ok, Data} = ssl:recv(Socket, 0), ok = ssl:send(Socket, Data), - NewSize = Size - byte_size(Data), - if - 0 < NewSize -> - echo_recv(Socket, NewSize); - 0 == NewSize -> - ok - end. - -%% Verify that received data is SentData, return any superflous data -verify_recv(Socket, SentData, Acc) -> - {ok, NewData} = ssl:recv(Socket, 0), - SentSize = byte_size(SentData), - NewAcc = <<Acc/binary, NewData/binary>>, - NewSize = byte_size(NewAcc), - if - SentSize < NewSize -> - {SentData,Rest} = split_binary(NewAcc, SentSize), - Rest; - NewSize < SentSize -> - verify_recv(Socket, SentData, NewAcc); - true -> - SentData = NewAcc, - <<>> - end. + echo_recv(Socket, Size - byte_size(Data)). %% Receive Size bytes +echo_active_once(_Socket, 0) -> + ok; echo_active_once(Socket, Size) -> receive {ssl, Socket, Data} -> ok = ssl:send(Socket, Data), NewSize = Size - byte_size(Data), ssl:setopts(Socket, [{active, once}]), - if - 0 < NewSize -> - echo_active_once(Socket, NewSize); - 0 == NewSize -> - ok - end + echo_active_once(Socket, NewSize) end. -%% Verify that received data is SentData, return any superflous data -verify_active_once(Socket, SentData, Acc) -> - receive - {ssl, Socket, Data} -> - SentSize = byte_size(SentData), - NewAcc = <<Acc/binary, Data/binary>>, - NewSize = byte_size(NewAcc), - ssl:setopts(Socket, [{active, once}]), - if - SentSize < NewSize -> - {SentData,Rest} = split_binary(NewAcc, SentSize), - Rest; - NewSize < SentSize -> - verify_active_once(Socket, SentData, NewAcc); - true -> - SentData = NewAcc, - <<>> - end - end. - - %% Receive Size bytes +echo_active(_Socket, 0) -> + ok; echo_active(Socket, Size) -> receive {ssl, Socket, Data} -> ok = ssl:send(Socket, Data), - NewSize = Size - byte_size(Data), - if - 0 < NewSize -> - echo_active(Socket, NewSize); - 0 == NewSize -> - ok - end - end. - -%% Verify that received data is SentData, return any superflous data -verify_active(Socket, SentData, Acc) -> - receive - {ssl, Socket, Data} -> - SentSize = byte_size(SentData), - NewAcc = <<Acc/binary, Data/binary>>, - NewSize = byte_size(NewAcc), - if - SentSize < NewSize -> - {SentData,Rest} = split_binary(NewAcc, SentSize), - Rest; - NewSize < SentSize -> - verify_active(Socket, SentData, NewAcc); - true -> - SentData = NewAcc, - <<>> - end - end. + echo_active(Socket, Size - byte_size(Data)) + end. + diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index 25d2cb300d..6f11e2bbe8 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -44,11 +44,8 @@ init_per_suite(Config0) -> try crypto:start() of ok -> ssl_test_lib:clean_start(), - %% make rsa certs using oppenssl - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), - proplists:get_value(priv_dir, Config0)), - Config1 = ssl_test_lib:make_dsa_cert(Config0), - ssl_test_lib:cert_options(Config1) + %% make rsa certs + ssl_test_lib:make_rsa_cert(Config0) catch _:_ -> {skip, "Crypto did not start"} end. @@ -86,8 +83,8 @@ pem_cleanup() -> [{doc, "Test pem cache invalidate mechanism"}]. pem_cleanup(Config)when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = @@ -118,8 +115,8 @@ invalid_insert() -> invalid_insert(Config)when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), BadClientOpts = [{cacertfile, "tmp/does_not_exist.pem"} | proplists:delete(cacertfile, ClientOpts)], Server = diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index a0fab58b9d..7f33fe3204 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -48,7 +48,8 @@ all() -> session_cache_process_list, session_cache_process_mnesia, client_unique_session, - max_table_size + max_table_size, + save_specific_session ]. groups() -> @@ -60,10 +61,7 @@ init_per_suite(Config0) -> ok -> ssl_test_lib:clean_start(), %% make rsa certs using - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0), - proplists:get_value(priv_dir, Config0)), - Config = ssl_test_lib:make_dsa_cert(Config0), - ssl_test_lib:cert_options(Config) + ssl_test_lib:make_rsa_cert(Config0) catch _:_ -> {skip, "Crypto did not start"} end. @@ -97,7 +95,10 @@ init_per_testcase(session_cleanup, Config) -> init_per_testcase(client_unique_session, Config) -> ct:timetrap({seconds, 40}), Config; - +init_per_testcase(save_specific_session, Config) -> + ssl_test_lib:clean_start(), + ct:timetrap({seconds, 5}), + Config; init_per_testcase(max_table_size, Config) -> ssl:stop(), application:load(ssl), @@ -141,7 +142,7 @@ end_per_testcase(max_table_size, Config) -> end_per_testcase(default_action, Config); end_per_testcase(Case, Config) when Case == session_cache_process_list; Case == session_cache_process_mnesia -> - ets:delete(ssl_test), + catch ets:delete(ssl_test), Config; end_per_testcase(_, Config) -> Config. @@ -154,8 +155,8 @@ client_unique_session() -> "sets up many connections"}]. client_unique_session(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_opts, Config), - ServerOpts = proplists:get_value(server_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -164,8 +165,7 @@ client_unique_session(Config) when is_list(Config) -> {tcp_options, [{active, false}]}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - LastClient = clients_start(Server, - ClientNode, Hostname, Port, ClientOpts, client_unique_session, 20), + LastClient = clients_start(Server, ClientNode, Hostname, Port, ClientOpts, 20), receive {LastClient, {ok, _}} -> ok @@ -185,8 +185,8 @@ session_cleanup() -> "does not grow and grow ..."}]. session_cleanup(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = @@ -254,13 +254,75 @@ session_cache_process_mnesia(Config) when is_list(Config) -> session_cache_process(mnesia,Config). %%-------------------------------------------------------------------- +save_specific_session() -> + [{doc, "Test that we can save a specific client session" + }]. +save_specific_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + Server ! listen, + + Client2 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + SessionID1 = + receive + {Client1, S1} -> + S1 + end, + + SessionID2 = + receive + {Client2, S2} -> + S2 + end, + + true = SessionID1 =/= SessionID2, + + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + ClientCache = element(2, State), + 2 = ssl_session_cache:size(ClientCache), + + Server ! listen, + + Client3 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_session, SessionID2} | ClientOpts]}]), + receive + {Client3, SessionID2} -> + ok; + {Client3, SessionID3}-> + ct:fail({got, SessionID3, expected, SessionID2}); + Other -> + ct:fail({got,Other}) + end. + +%%-------------------------------------------------------------------- max_table_size() -> [{doc,"Test max limit on session table"}]. max_table_size(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -270,7 +332,7 @@ max_table_size(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), LastClient = clients_start(Server, - ClientNode, Hostname, Port, ClientOpts, max_table_size, 20), + ClientNode, Hostname, Port, ClientOpts, 20), receive {LastClient, {ok, _}} -> ok @@ -426,25 +488,27 @@ session_loop(Sess) -> %%-------------------------------------------------------------------- session_cache_process(_Type,Config) when is_list(Config) -> - ssl_basic_SUITE:reuse_session(Config). + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). -clients_start(_Server, ClientNode, Hostname, Port, ClientOpts, Test, 0) -> +clients_start(_Server, ClientNode, Hostname, Port, ClientOpts, 0) -> %% Make sure session is registered ct:sleep(?SLEEP * 2), ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {mfa, {?MODULE, connection_info_result, []}}, - {from, self()}, {options, test_copts(Test, 0, ClientOpts)}]); -clients_start(Server, ClientNode, Hostname, Port, ClientOpts, Test, N) -> + {from, self()}, {options, ClientOpts}]); +clients_start(Server, ClientNode, Hostname, Port, ClientOpts, N) -> spawn_link(ssl_test_lib, start_client, [[{node, ClientNode}, {port, Port}, {host, Hostname}, {mfa, {ssl_test_lib, no_result, []}}, - {from, self()}, {options, test_copts(Test, N, ClientOpts)}]]), + {from, self()}, {options, ClientOpts}]]), Server ! listen, wait_for_server(), - clients_start(Server, ClientNode, Hostname, Port, ClientOpts, Test, N-1). + clients_start(Server, ClientNode, Hostname, Port, ClientOpts, N-1). connection_info_result(Socket) -> ssl:connection_information(Socket, [protocol, cipher_suite]). @@ -481,21 +545,3 @@ get_delay_timers() -> wait_for_server() -> ct:sleep(100). - - -test_copts(_, 0, ClientOpts) -> - ClientOpts; -test_copts(max_table_size, N, ClientOpts) -> - Version = tls_record:highest_protocol_version([]), - CipherSuites = %%lists:map(fun(X) -> ssl_cipher_format:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), -[ Y|| Y = {Alg,_, _, _} <- lists:map(fun(X) -> ssl_cipher_format:suite_definition(X) end, ssl_cipher:filter_suites(ssl_cipher:suites(Version))), Alg =/= ecdhe_ecdsa, Alg =/= ecdh_ecdsa, Alg =/= ecdh_rsa, Alg =/= ecdhe_rsa, Alg =/= dhe_dss, Alg =/= dss], - case length(CipherSuites) of - M when M >= N -> - Cipher = lists:nth(N, CipherSuites), - ct:pal("~p",[Cipher]), - [{ciphers, [Cipher]} | ClientOpts]; - _ -> - ClientOpts - end; -test_copts(_, _, ClientOpts) -> - ClientOpts. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 7767d76a0d..0173b98e1a 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -523,7 +523,7 @@ cert_options(Config) -> {client_verification_opts, [{cacertfile, ServerCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}, - {ssl_imp, new}]}, + {verify, verify_peer}]}, {client_verification_opts_digital_signature_only, [{cacertfile, ServerCaCertFile}, {certfile, ClientCertFileDigitalSignatureOnly}, {keyfile, ClientKeyFile}, @@ -1537,7 +1537,12 @@ init_tls_version(Version, Config) -> clean_tls_version(Config) -> proplists:delete(protocol_opts, proplists:delete(protocol, Config)). - + +sufficient_crypto_support(Version) + when Version == 'tlsv1.3' -> + CryptoSupport = crypto:supports(), + lists:member(rsa_pkcs1_pss_padding, proplists:get_value(rsa_opts, CryptoSupport)) andalso + lists:member(x448, proplists:get_value(curves, CryptoSupport)); sufficient_crypto_support(Version) when Version == 'tlsv1.2'; Version == 'dtlsv1.2' -> CryptoSupport = crypto:supports(), @@ -1583,35 +1588,22 @@ v_1_2_check(ecdh_rsa, ecdh_ecdsa) -> v_1_2_check(_, _) -> false. -send_recv_result_active(Socket) -> - ssl:send(Socket, "Hello world"), - receive - {ssl, Socket, "H"} -> - receive - {ssl, Socket, "ello world"} -> - ok - end; - {ssl, Socket, "Hello world"} -> - ok - end. - send_recv_result(Socket) -> - ssl:send(Socket, "Hello world"), - {ok,"Hello world"} = ssl:recv(Socket, 11), + Data = "Hello world", + ssl:send(Socket, Data), + {ok, Data} = ssl:recv(Socket, length(Data)), + ok. + +send_recv_result_active(Socket) -> + Data = "Hello world", + ssl:send(Socket, Data), + Data = active_recv(Socket, length(Data)), ok. send_recv_result_active_once(Socket) -> - ssl:send(Socket, "Hello world"), - receive - {ssl, Socket, "H"} -> - ssl:setopts(Socket, [{active, once}]), - receive - {ssl, Socket, "ello world"} -> - ok - end; - {ssl, Socket, "Hello world"} -> - ok - end. + Data = "Hello world", + ssl:send(Socket, Data), + active_once_recv_list(Socket, length(Data)). active_recv(Socket, N) -> active_recv(Socket, N, []). @@ -1624,6 +1616,44 @@ active_recv(Socket, N, Acc) -> active_recv(Socket, N-length(Bytes), Acc ++ Bytes) end. +active_once_recv(_Socket, 0) -> + ok; +active_once_recv(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + ssl:setopts(Socket, [{active, once}]), + active_once_recv(Socket, N-byte_size(Bytes)) + end. + +active_once_recv_list(_Socket, 0) -> + ok; +active_once_recv_list(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + ssl:setopts(Socket, [{active, once}]), + active_once_recv_list(Socket, N-length(Bytes)) + end. +recv_disregard(_Socket, 0) -> + ok; +recv_disregard(Socket, N) -> + {ok, Bytes} = ssl:recv(Socket, 0), + recv_disregard(Socket, N-byte_size(Bytes)). + +active_disregard(_Socket, 0) -> + ok; +active_disregard(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + active_disregard(Socket, N-byte_size(Bytes)) + end. +active_once_disregard(_Socket, 0) -> + ok; +active_once_disregard(Socket, N) -> + receive + {ssl, Socket, Bytes} -> + ssl:setopts(Socket, [{active, once}]), + active_once_disregard(Socket, N-byte_size(Bytes)) + end. is_sane_ecc(openssl) -> case os:cmd("openssl version") of "OpenSSL 1.0.0a" ++ _ -> % Known bug in openssl @@ -2161,3 +2191,98 @@ server_msg(Server, ServerMsg) -> Unexpected -> ct:fail(Unexpected) end. + +session_id(Socket) -> + {ok, [{session_id, ID}]} = ssl:connection_information(Socket, [session_id]), + ID. + +reuse_session(ClientOpts, ServerOpts, Config) -> + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server0 = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, ServerOpts}]), + Port0 = ssl_test_lib:inet_port(Server0), + + Client0 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + Server0 ! listen, + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + + SID = receive + {Client0, Id0} -> + Id0 + end, + + receive + {Client1, SID} -> + ok + after ?SLEEP -> + ct:fail(session_not_reused) + end, + + Server0 ! listen, + + Client2 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port0}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, false} + | ClientOpts]}]), + receive + {Client2, SID} -> + ct:fail(session_reused_when_session_reuse_disabled_by_client); + {Client2, _} -> + ok + end, + + ssl_test_lib:close(Server0), + ssl_test_lib:close(Client0), + ssl_test_lib:close(Client1), + ssl_test_lib:close(Client2), + + Server1 = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {tcp_options, [{active, false}]}, + {options, [{reuse_sessions, false} |ServerOpts]}]), + Port1 = ssl_test_lib:inet_port(Server1), + + Client3 = ssl_test_lib:start_client([{node, ClientNode}, + {port, Port1}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, [{reuse_sessions, save} | ClientOpts]}]), + SID1 = receive + {Client3, Id3} -> + Id3 + end, + + Server1 ! listen, + + Client4 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port1}, {host, Hostname}, + {mfa, {ssl_test_lib, session_id, []}}, + {from, self()}, {options, ClientOpts}]), + + receive + {Client4, SID1} -> + ct:fail(session_reused_when_session_reuse_disabled_by_server); + {Client4, _} -> + ok + end, + + ssl_test_lib:close(Server1), + ssl_test_lib:close(Client3), + ssl_test_lib:close(Client4). + diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 3c8b25b912..d180021439 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -260,8 +260,9 @@ special_init(TestCase, Config) when Config; special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_renegotiate; - TestCase == erlang_client_openssl_server_nowrap_seqnum; - TestCase == erlang_server_openssl_client_nowrap_seqnum + TestCase == erlang_client_openssl_server_nowrap_seqnum; + TestCase == erlang_server_openssl_client_nowrap_seqnum; + TestCase == erlang_client_openssl_server_renegotiate_after_client_data -> {ok, Version} = application:get_env(ssl, protocol_version), check_sane_openssl_renegotaite(Config, Version); @@ -761,8 +762,8 @@ erlang_client_openssl_server_renegotiate() -> [{doc,"Test erlang client when openssl server issuses a renegotiate"}]. erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -771,12 +772,14 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile, "-msg"], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -806,8 +809,8 @@ erlang_client_openssl_server_renegotiate_after_client_data() -> [{doc,"Test erlang client when openssl server issuses a renegotiate after reading client data"}]. erlang_client_openssl_server_renegotiate_after_client_data(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -815,6 +818,7 @@ erlang_client_openssl_server_renegotiate_after_client_data(Config) when is_list( OpenSslData = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), @@ -822,6 +826,7 @@ erlang_client_openssl_server_renegotiate_after_client_data(Config) when is_list( Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile, "-msg"], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -856,7 +861,7 @@ erlang_client_openssl_server_nowrap_seqnum() -> " to lower treashold substantially."}]. erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -865,12 +870,14 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> N = 10, Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), Exe = "openssl", Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile, "-msg"], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -899,7 +906,7 @@ erlang_server_openssl_client_nowrap_seqnum() -> " to lower treashold substantially."}]. erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1648,8 +1655,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = ErlangClientOpts ++ ClientOpts0, {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1657,6 +1664,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens Data = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), @@ -1666,10 +1674,12 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens [] -> ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile,"-key", KeyFile]; [Opt, Value] -> ["s_server", Opt, Value, "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile,"-key", KeyFile] end, @@ -1694,8 +1704,8 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = proplists:get_value(server_rsa_opts, Config), - ClientOpts0 = proplists:get_value(client_rsa_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), + ClientOpts0 = proplists:get_value(client_rsa_verify_opts, Config), ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0], {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1703,12 +1713,14 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba Data = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), Exe = "openssl", Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), @@ -1826,8 +1838,8 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0], {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), @@ -1835,6 +1847,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Data = "From openssl to erlang", Port = ssl_test_lib:inet_port(node()), + CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), Version = ssl_test_lib:protocol_version(Config), @@ -1842,6 +1855,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Exe = "openssl", Args = ["s_server", "-msg", "-nextprotoneg", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), + "-CAfile", CaCertFile, "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 3501622f5a..3527062a8a 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.1.1 +SSL_VSN = 9.1.2 diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 66146e9258..2755fb3dce 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2018</year> + <year>1996</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -689,6 +689,18 @@ c</pre> </func> <func> + <name name="search" arity="2" since="OTP 21.0"/> + <fsummary>Find the first element that satisfies a predicate.</fsummary> + <desc> + <p>If there is a <c><anno>Value</anno></c> in <c><anno>List</anno></c> + such that <c><anno>Pred</anno>(<anno>Value</anno>)</c> returns + <c>true</c>, returns <c>{value, <anno>Value</anno>}</c> + for the first such <c><anno>Value</anno></c>, + otherwise returns <c>false</c>.</p> + </desc> + </func> + + <func> <name name="seq" arity="2" since=""/> <name name="seq" arity="3" since=""/> <fsummary>Generate a sequence of integers.</fsummary> @@ -771,18 +783,6 @@ length(lists:seq(From, To, Incr)) =:= (To - From + Incr) div Incr</code> </func> <func> - <name name="search" arity="2" since="OTP 21.0"/> - <fsummary>Find the first element that satisfies a predicate.</fsummary> - <desc> - <p>If there is a <c><anno>Value</anno></c> in <c><anno>List</anno></c> - such that <c><anno>Pred</anno>(<anno>Value</anno>)</c> returns - <c>true</c>, returns <c>{value, <anno>Value</anno>}</c> - for the first such <c><anno>Value</anno></c>, - otherwise returns <c>false</c>.</p> - </desc> - </func> - - <func> <name name="splitwith" arity="2" since=""/> <fsummary>Split a list into two lists based on a predicate.</fsummary> <desc> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index e0cd68617b..3ec78a2667 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -831,13 +831,15 @@ bif_clashes(Forms, #lint{nowarn_bif_clash=Nowarn} = St) -> %% not_deprecated(Forms, State0) -> State -not_deprecated(Forms, St0) -> +not_deprecated(Forms, #lint{compile=Opts}=St0) -> %% There are no line numbers in St0#lint.compile. MFAsL = [{MFA,L} || {attribute, L, compile, Args} <- Forms, {nowarn_deprecated_function, MFAs0} <- lists:flatten([Args]), MFA <- lists:flatten([MFAs0])], - Nowarn = [MFA || {MFA,_L} <- MFAsL], + Nowarn = [MFA || + {nowarn_deprecated_function, MFAs0} <- Opts, + MFA <- lists:flatten([MFAs0])], ML = [{M,L} || {{M,_F,_A},L} <- MFAsL, is_atom(M)], St1 = foldl(fun ({M,L}, St2) -> check_module_name(M, L, St2) diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 9602f0bcd9..4ad94f2507 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -841,7 +841,7 @@ Erlang code. -type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}. -type af_map_pattern() :: - {'map', anno(), [af_assoc_exact(abstract_expr)]}. + {'map', anno(), [af_assoc_exact(abstract_expr())]}. -type abstract_type() :: af_annotated_type() | af_atom() @@ -872,7 +872,7 @@ Erlang code. -type af_fun_type() :: {'type', anno(), 'fun', []} | {'type', anno(), 'fun', [{'type', anno(), 'any'} | abstract_type()]} - | {'type', anno(), 'fun', af_function_type()}. + | af_function_type(). -type af_integer_range_type() :: {'type', anno(), 'range', [af_singleton_integer_type()]}. @@ -924,10 +924,11 @@ Erlang code. -type af_function_constraint() :: [af_constraint()]. -type af_constraint() :: {'type', anno(), 'constraint', - af_lit_atom('is_subtype'), - [af_type_variable() | abstract_type()]}. % [V, T] + [af_lit_atom('is_subtype') | + [af_type_variable() | abstract_type()]]}. % [IsSubtype, [V, T]] -type af_singleton_integer_type() :: af_integer() + | af_character() | af_unary_op(af_singleton_integer_type()) | af_binary_op(af_singleton_integer_type()). diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 6d243e1bec..97ec785c62 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -556,8 +556,8 @@ tg({call, Line, {remote,_,{atom,_,erlang},{atom, Line2, FunName}},ParaList}, FunName,length(ParaList)}}) end; tg({call, Line, {remote,_,{atom,_,ModuleName}, - {atom, _, FunName}},_ParaList},B) -> - throw({error,Line,{?ERR_GENREMOTECALL+B#tgd.eb,ModuleName,FunName}}); + {atom, _, FunName}},ParaList},B) -> + throw({error,Line,{?ERR_GENREMOTECALL+B#tgd.eb,ModuleName,FunName,length(ParaList)}}); tg({cons,Line, H, T},B) -> {cons, Line, tg(H,B), tg(T,B)}; tg({nil, Line},_B) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index e6ed55bf2d..e791da48cf 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -68,7 +68,7 @@ non_latin1_module/1, otp_14323/1, stacktrace_syntax/1, otp_14285/1, otp_14378/1, - external_funs/1]). + external_funs/1,otp_15456/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -89,7 +89,8 @@ all() -> maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, record_errors, otp_11879_cont, non_latin1_module, otp_14323, - stacktrace_syntax, otp_14285, otp_14378, external_funs]. + stacktrace_syntax, otp_14285, otp_14378, external_funs, + otp_15456]. groups() -> [{unused_vars_warn, [], @@ -2119,6 +2120,61 @@ otp_5362(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +%% OTP-15456. All compiler options can now be given in the option list +%% (as opposed to only in files). +otp_15456(Config) when is_list(Config) -> + Ts = [ + %% {nowarn_deprecated_function,[{M,F,A}]} can now be given + %% in the option list as well as in an attribute. + %% Wherever it occurs, it is not affected by + %% warn_deprecated_function. + {otp_15456_1, + <<"-compile({nowarn_deprecated_function,{erlang,now,0}}). + -export([foo/0]). + + foo() -> + {erlang:now(), random:seed0(), random:seed(1, 2, 3), + random:uniform(), random:uniform(42)}. + ">>, + {[{nowarn_deprecated_function,{random,seed0,0}}, + {nowarn_deprecated_function,[{random,uniform,0}, + {random,uniform,1}]}, + %% There should be no warnings when attempting to + %% turn of warnings for functions that are not + %% deprecated or not used in the module. + {nowarn_deprecated_function,{random,uniform_s,1}}, + {nowarn_deprecated_function,{erlang,abs,1}}, + warn_deprecated_function]}, + {warnings,[{5,erl_lint, + {deprecated,{random,seed,3}, + "the 'random' module is deprecated; " + "use the 'rand' module instead"}}]}}, + + %% {nowarn_unused_function,[{M,F,A}]} can be given + %% in the option list as well as in an attribute. + %% It was incorrectly documented to only work when + %% given in an attribute. + {otp_15456_2, + <<"-compile({nowarn_unused_function,foo/0}). + foo() -> ok. + bar() -> ok. + foobar() -> ok. + barf(_) -> ok. + other() -> ok. + ">>, + {[{nowarn_unused_function,[{bar,0},{foobar,0}]}, + {nowarn_unused_function,{barf,1}}, + %% There should be no warnings when attempting to + %% turn of warnings for unused functions that are not + %% defined in the module. + {nowarn_unused_function,{not_defined_in_module,1}}, + warn_unused_function]}, + {warnings,[{6,erl_lint,{unused_function,{other,0}}}]} + }], + + [] = run(Config, Ts), + ok. + %% OTP-5371. Aliases for bit syntax expressions are no longer allowed. otp_5371(Config) when is_list(Config) -> Ts = [{otp_5371_1, diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 6906ef1553..6ad9bec2e6 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -1101,8 +1101,9 @@ lay_2(Node, Ctxt) -> Ctxt1 = reset_prec(Ctxt), D1 = lay(erl_syntax:constrained_function_type_body(Node), Ctxt1), + Ctxt2 = Ctxt1#ctxt{clause = undefined}, D2 = lay(erl_syntax:constrained_function_type_argument(Node), - Ctxt1), + Ctxt2), beside(D1, beside(floating(text(" when ")), D2)); @@ -1113,7 +1114,7 @@ lay_2(Node, Ctxt) -> _ -> {"fun(", ")"} end, - Ctxt1 = reset_prec(Ctxt), + Ctxt1 = (reset_prec(Ctxt))#ctxt{clause = undefined}, D1 = case erl_syntax:function_type_arguments(Node) of any_arity -> text("(...)"); diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 9dbd0e302a..6b42f7a0a1 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -26,14 +26,14 @@ -export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1, revert_map_type/1, t_abstract_type/1,t_erl_parse_type/1,t_type/1, t_epp_dodger/1, - t_comment_scan/1,t_igor/1,t_erl_tidy/1]). + t_comment_scan/1,t_igor/1,t_erl_tidy/1,t_prettypr/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app_test,appup_test,smoke_test,revert,revert_map,revert_map_type, t_abstract_type,t_erl_parse_type,t_type,t_epp_dodger, - t_comment_scan,t_igor,t_erl_tidy]. + t_comment_scan,t_igor,t_erl_tidy,t_prettypr]. groups() -> []. @@ -300,6 +300,14 @@ t_comment_scan(Config) when is_list(Config) -> ok = test_comment_scan(Filenames,DataDir), ok. +t_prettypr(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Filenames = ["type_specs.erl", + "specs_and_funs.erl"], + ok = test_prettypr(Filenames,DataDir,PrivDir), + ok. + test_files(Config) -> DataDir = ?config(data_dir, Config), [ filename:join(DataDir,Filename) || Filename <- test_files() ]. @@ -307,7 +315,8 @@ test_files(Config) -> test_files() -> ["syntax_tools_SUITE_test_module.erl", "syntax_tools_test.erl", - "type_specs.erl"]. + "type_specs.erl", + "specs_and_funs.erl"]. t_igor(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), @@ -359,6 +368,27 @@ test_comment_scan([File|Files],DataDir) -> test_comment_scan(Files,DataDir). +test_prettypr([],_,_) -> ok; +test_prettypr([File|Files],DataDir,PrivDir) -> + Filename = filename:join(DataDir,File), + io:format("Parsing ~p~n", [Filename]), + {ok, Fs0} = epp:parse_file(Filename, [], []), + Fs = erl_syntax:form_list(Fs0), + PP = erl_prettypr:format(Fs, [{paper, 120}, {ribbon, 110}]), + io:put_chars(PP), + OutFile = filename:join(PrivDir, File), + ok = file:write_file(OutFile,iolist_to_binary(PP)), + io:format("Parsing OutFile: ~s~n", [OutFile]), + {ok, Fs2} = epp:parse_file(OutFile, [], []), + case [Error || {error, _} = Error <- Fs2] of + [] -> + ok; + Errors -> + ?t:fail(Errors) + end, + test_prettypr(Files,DataDir,PrivDir). + + test_epp_dodger([], _, _) -> ok; test_epp_dodger([Filename|Files],DataDir,PrivDir) -> io:format("Parsing ~p~n", [Filename]), diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/specs_and_funs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/specs_and_funs.erl new file mode 100644 index 0000000000..8dfeaf5a6b --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/specs_and_funs.erl @@ -0,0 +1,18 @@ +-module(specs_and_funs). + +-export([my_apply/3, two/1]). + +%% OTP-15519, ERL-815 + +-spec my_apply(Fun, Arg, fun((A) -> A)) -> Result when + Fun :: fun((Arg) -> Result), + Arg :: any(), + Result :: any(). + +my_apply(Fun, Arg, _) -> + Fun(Arg). + +-spec two(fun((A) -> A)) -> fun((B) -> B). + +two(F) -> + F(fun(X) -> X end). diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index a97036127e..7f6874e36b 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.19</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The charset detection parsing crash in some cases when + the XML directive is not syntactic correct.</p> + <p> + Own Id: OTP-15492 Aux Id: ERIERL-283 </p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.18</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -62,6 +77,21 @@ </section> +<section><title>Xmerl 1.3.16.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The charset detection parsing crash in some cases when + the XML directive is not syntactic correct.</p> + <p> + Own Id: OTP-15492 Aux Id: ERIERL-283 </p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.16</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1412,4 +1442,3 @@ </section> </section> </chapter> - diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl index e383c4c349..fe836fd8cd 100644 --- a/lib/xmerl/src/xmerl_sax_parser.erl +++ b/lib/xmerl/src/xmerl_sax_parser.erl @@ -1,8 +1,8 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2017. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2018. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,13 +14,13 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %%---------------------------------------------------------------------- %% File : xmerl_sax_parser.erl %% Description : XML SAX parse API module. %% -%% Created : 4 Jun 2008 +%% Created : 4 Jun 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser). @@ -72,9 +72,9 @@ file(Name,Options) -> CL = filename:absname(Dir), File = filename:basename(Name), ContinuationFun = fun default_continuation_cb/1, - Res = stream(<<>>, + Res = stream(<<>>, [{continuation_fun, ContinuationFun}, - {continuation_state, FD}, + {continuation_state, FD}, {current_location, CL}, {entity, File} |Options], @@ -101,39 +101,39 @@ stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) -> State = parse_options(Options, initial_state()), case State#xmerl_sax_parser_state.file_type of dtd -> - xmerl_sax_parser_list:parse_dtd(Xml, + xmerl_sax_parser_list:parse_dtd(Xml, State#xmerl_sax_parser_state{encoding = list, input_type = InputType}); normal -> - xmerl_sax_parser_list:parse(Xml, + xmerl_sax_parser_list:parse(Xml, State#xmerl_sax_parser_state{encoding = list, input_type = InputType}) end; stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) -> - case parse_options(Options, initial_state()) of + case parse_options(Options, initial_state()) of {error, Reason} -> {error, Reason}; State -> - ParseFunction = + ParseFunction = case State#xmerl_sax_parser_state.file_type of dtd -> parse_dtd; normal -> parse end, - try + try {Xml1, State1} = detect_charset(Xml, State), parse_binary(Xml1, State1#xmerl_sax_parser_state{input_type = InputType}, ParseFunction) catch throw:{fatal_error, {State2, Reason}} -> - {fatal_error, + {fatal_error, { State2#xmerl_sax_parser_state.current_location, - State2#xmerl_sax_parser_state.entity, + State2#xmerl_sax_parser_state.entity, 1 }, - Reason, [], + Reason, [], State2#xmerl_sax_parser_state.event_state} end end. @@ -157,7 +157,7 @@ parse_binary(Xml, #xmerl_sax_parser_state{encoding={utf16,big}}=State, F) -> xmerl_sax_parser_utf16be:F(Xml, State); parse_binary(Xml, #xmerl_sax_parser_state{encoding=latin1}=State, F) -> xmerl_sax_parser_latin1:F(Xml, State); -parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, State) -> +parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, State) -> ?fatal_error(State, lists:flatten(io_lib:format("Charcter set ~p not supported", [Enc]))). %%---------------------------------------------------------------------- @@ -177,9 +177,9 @@ initial_state() -> %%---------------------------------------------------------------------- %% Function: parse_options(Options, State) %% Input: Options = [Option] -%% Option = {event_state, term()} | {event_fun, fun()} | +%% Option = {event_state, term()} | {event_fun, fun()} | %% {continuation_state, term()} | {continuation_fun, fun()} | -%% {encoding, Encoding} | {file_type, FT} +%% {encoding, Encoding} | {file_type, FT} %% FT = normal | dtd %% Encoding = utf8 | utf16le | utf16be | list | iso8859 %% State = #xmerl_sax_parser_state{} @@ -200,7 +200,7 @@ parse_options([{file_type, FT} |Options], State) when FT==normal; FT==dtd -> parse_options(Options, State#xmerl_sax_parser_state{file_type = FT}); parse_options([{encoding, E} |Options], State) -> case check_encoding_option(E) of - {error, Reason} -> + {error, Reason} -> {error, Reason}; Enc -> parse_options(Options, State#xmerl_sax_parser_state{encoding = Enc}) @@ -231,7 +231,7 @@ check_encoding_option(E) -> %% Description: Detects which character set is used in a binary stream. %%---------------------------------------------------------------------- detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = State) -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); detect_charset(<<>>, State) -> cf(<<>>, State, fun detect_charset/2); detect_charset(Bytes, State) -> @@ -269,22 +269,14 @@ detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D>> = Xml, State) -> cf(Xml, State, fun detect_charset_1/2); detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml2/binary>>, State) -> {Xml3, State1} = read_until_end_of_xml_directive(Xml2, State), - case parse_xml_directive(Xml3) of - {error, Reason} -> - ?fatal_error(State, Reason); - AttrList -> - case lists:keysearch("encoding", 1, AttrList) of - {value, {_, E}} -> - case convert_encoding(E) of - {error, Reason} -> - ?fatal_error(State, Reason); - Enc -> - {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, - State1#xmerl_sax_parser_state{encoding=Enc}} - end; - _ -> - {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, State1} - end + AttrList = parse_xml_directive(Xml3, State), + case lists:keysearch("encoding", 1, AttrList) of + {value, {_, E}} -> + Enc = convert_encoding(E, State), + {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, + State1#xmerl_sax_parser_state{encoding=Enc}}; + _ -> + {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, State1} end; detect_charset_1(Xml, State) -> {Xml, State}. @@ -295,7 +287,7 @@ detect_charset_1(Xml, State) -> %% Output: utf8 | iso8859 %% Description: Converting 7,8 bit and utf8 encoding strings to internal format. %%---------------------------------------------------------------------- -convert_encoding(Enc) -> %% Just for 7,8 bit + utf8 +convert_encoding(Enc, State) -> %% Just for 7,8 bit + utf8 case string:to_lower(Enc) of "utf-8" -> utf8; "us-ascii" -> utf8; @@ -309,19 +301,19 @@ convert_encoding(Enc) -> %% Just for 7,8 bit + utf8 "iso-8859-7" -> latin1; "iso-8859-8" -> latin1; "iso-8859-9" -> latin1; - _ -> {error, "Unknown encoding: " ++ Enc} + _ -> ?fatal_error(State, "Unknown encoding: " ++ Enc) end. %%---------------------------------------------------------------------- %% Function: parse_xml_directive(Xml) %% Input: Xml = binary() %% Acc = list() -%% Output: +%% Output: %% Description: Parsing the xml declaration from the input stream. %%---------------------------------------------------------------------- -parse_xml_directive(<<C, Rest/binary>>) when ?is_whitespace(C) -> - parse_xml_directive_1(Rest, []). - +parse_xml_directive(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> + parse_xml_directive_1(Rest, [], State). + %%---------------------------------------------------------------------- %% Function: parse_xml_directive_1(Xml, Acc) -> [{Name, Value}] %% Input: Xml = binary() @@ -331,20 +323,20 @@ parse_xml_directive(<<C, Rest/binary>>) when ?is_whitespace(C) -> %% Output: see above %% Description: Parsing the xml declaration from the input stream. %%---------------------------------------------------------------------- -parse_xml_directive_1(<<C, Rest/binary>>, Acc) when ?is_whitespace(C) -> - parse_xml_directive_1(Rest, Acc); -parse_xml_directive_1(<<"?>", _/binary>>, Acc) -> +parse_xml_directive_1(<<C, Rest/binary>>, Acc, State) when ?is_whitespace(C) -> + parse_xml_directive_1(Rest, Acc, State); +parse_xml_directive_1(<<"?>", _/binary>>, Acc, _State) -> Acc; -parse_xml_directive_1(<<C, Rest/binary>>, Acc) when 97 =< C, C =< 122 -> +parse_xml_directive_1(<<C, Rest/binary>>, Acc, State) when 97 =< C, C =< 122 -> {Name, Rest1} = parse_name(Rest, [C]), - Rest2 = parse_eq(Rest1), - {Value, Rest3} = parse_value(Rest2), - parse_xml_directive_1(Rest3, [{Name, Value} |Acc]); -parse_xml_directive_1(_, _) -> - {error, "Unknown attribute in xml directive"}. + Rest2 = parse_eq(Rest1, State), + {Value, Rest3} = parse_value(Rest2, State), + parse_xml_directive_1(Rest3, [{Name, Value} |Acc], State); +parse_xml_directive_1(_, _, State) -> + ?fatal_error(State, "Unknown attribute in xml directive"). %%---------------------------------------------------------------------- -%% Function: parse_xml_directive_1(Xml, Acc) -> Name +%% Function: parse_name(Xml, Acc) -> Name %% Input: Xml = binary() %% Acc = string() %% Output: Name = string() @@ -361,10 +353,12 @@ parse_name(Rest, Acc) -> %% Output: Rest = binary() %% Description: Reads an '=' from the stream. %%---------------------------------------------------------------------- -parse_eq(<<C, Rest/binary>>) when ?is_whitespace(C) -> - parse_eq(Rest); -parse_eq(<<"=", Rest/binary>>) -> - Rest. +parse_eq(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> + parse_eq(Rest, State); +parse_eq(<<"=", Rest/binary>>, _State) -> + Rest; +parse_eq(_, State) -> + ?fatal_error(State, "expecting = or whitespace"). %%---------------------------------------------------------------------- %% Function: parse_value(Xml) -> {Value, Rest} @@ -373,10 +367,12 @@ parse_eq(<<"=", Rest/binary>>) -> %% Rest = binary() %% Description: Parsing an attribute value from the stream. %%---------------------------------------------------------------------- -parse_value(<<C, Rest/binary>>) when ?is_whitespace(C) -> - parse_value(Rest); -parse_value(<<C, Rest/binary>>) when C == $'; C == $" -> - parse_value_1(Rest, C, []). +parse_value(<<C, Rest/binary>>, State) when ?is_whitespace(C) -> + parse_value(Rest, State); +parse_value(<<C, Rest/binary>>, _State) when C == $'; C == $" -> + parse_value_1(Rest, C, []); +parse_value(_, State) -> + ?fatal_error(State, "\', \" or whitespace expected"). %%---------------------------------------------------------------------- %% Function: parse_value_1(Xml, Stop, Acc) -> {Value, Rest} @@ -431,7 +427,7 @@ read_until_end_of_xml_directive(Rest, State) -> nomatch -> case cf(Rest, State) of {<<>>, _} -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); {NewBytes, NewState} -> read_until_end_of_xml_directive(NewBytes, NewState) end; @@ -450,9 +446,9 @@ read_until_end_of_xml_directive(Rest, State) -> %% input stream and calls the fun in NextCall. %%---------------------------------------------------------------------- cf(_Rest, #xmerl_sax_parser_state{continuation_fun = undefined} = State) -> - ?fatal_error(State, "Continuation function undefined"); + ?fatal_error(State, "Continuation function undefined"); cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State) -> - Result = + Result = try CFun(CState) catch @@ -463,9 +459,9 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C end, case Result of {<<>>, _} -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); {NewBytes, NewContState} -> - {<<Rest/binary, NewBytes/binary>>, + {<<Rest/binary, NewBytes/binary>>, State#xmerl_sax_parser_state{continuation_state = NewContState}} end. @@ -479,10 +475,10 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C %% input stream and calls the fun in NextCall. %%---------------------------------------------------------------------- cf(_Rest, #xmerl_sax_parser_state{continuation_fun = undefined} = State, _) -> - ?fatal_error(State, "Continuation function undefined"); -cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State, + ?fatal_error(State, "Continuation function undefined"); +cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State, NextCall) -> - Result = + Result = try CFun(CState) catch @@ -493,8 +489,8 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C end, case Result of {<<>>, _} -> - ?fatal_error(State, "Can't detect character encoding due to lack of indata"); + ?fatal_error(State, "Can't detect character encoding due to lack of indata"); {NewBytes, NewContState} -> - NextCall(<<Rest/binary, NewBytes/binary>>, + NextCall(<<Rest/binary, NewBytes/binary>>, State#xmerl_sax_parser_state{continuation_state = NewContState}) end. diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 3a266a56bd..b6486681c2 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.18 +XMERL_VSN = 1.3.19 diff --git a/otp_versions.table b/otp_versions.table index fc1ff8bc62..669999dbfd 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-21.2.3 : compiler-7.3.1 erts-10.2.2 ssl-9.1.2 xmerl-1.3.19 # asn1-5.0.8 common_test-1.16.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 : OTP-21.2.2 : ssh-4.7.3 # asn1-5.0.8 common_test-1.16.1 compiler-7.3 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 erts-10.2.1 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssl-9.1.1 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.18 : OTP-21.2.1 : erts-10.2.1 ssl-9.1.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.2 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.18 : OTP-21.2 : asn1-5.0.8 compiler-7.3 crypto-4.4 erts-10.2 et-1.6.4 hipe-3.18.2 inets-7.0.3 kernel-6.2 observer-2.8.2 os_mon-2.4.7 public_key-1.6.4 reltool-0.7.8 sasl-3.3 ssh-4.7.2 ssl-9.1 stdlib-3.7 tools-3.0.2 wx-1.8.6 # common_test-1.16.1 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 eunit-2.3.7 ftp-1.0.1 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.5 odbc-2.12.2 otp_mibs-1.2.1 parsetools-2.1.8 runtime_tools-1.13.1 snmp-5.2.12 syntax_tools-2.1.6 tftp-1.0.1 xmerl-1.3.18 : @@ -16,6 +17,8 @@ OTP-21.0.3 : erts-10.0.3 # asn1-5.0.6 common_test-1.16 compiler-7.2.2 crypto-4.3 OTP-21.0.2 : compiler-7.2.2 erts-10.0.2 public_key-1.6.1 stdlib-3.5.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0.1 : compiler-7.2.1 erts-10.0.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0 : asn1-5.0.6 common_test-1.16 compiler-7.2 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 erts-10.0 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 mnesia-4.15.4 observer-2.8 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 # megaco-3.18.3 odbc-2.12.1 snmp-5.2.11 : +OTP-20.3.8.18 : erts-9.3.3.8 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 : +OTP-20.3.8.17 : xmerl-1.3.16.1 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.7 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 : OTP-20.3.8.16 : erts-9.3.3.7 ssh-4.6.9.3 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.8.15 : asn1-5.0.5.2 # common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.6 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.2 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.8.14 : ssh-4.6.9.2 # asn1-5.0.5.1 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.6 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : @@ -62,6 +65,7 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1 OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 : OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 : OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 : +OTP-19.3.6.13 : erts-8.3.5.7 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2.1 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.4 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.12 : eldap-1.2.2.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.6 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.4 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.11 : erts-8.3.5.6 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.4 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.10 : erts-8.3.5.5 syntax_tools-2.1.1.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.4 ssl-8.1.3.1.1 stdlib-3.3 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : |