diff options
169 files changed, 5076 insertions, 2885 deletions
diff --git a/.gitignore b/.gitignore index 9497169cde..4a6aaab6f3 100644 --- a/.gitignore +++ b/.gitignore @@ -323,6 +323,7 @@ JAVADOC-GENERATED # kernel /lib/kernel/src/inet_dns_record_adts.hrl +/lib/kernel/test/gen_tcp_dist.erl # kernel diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot Binary files differindex b48d22fe41..5428e202e7 100644 --- a/bootstrap/bin/no_dot_erlang.boot +++ b/bootstrap/bin/no_dot_erlang.boot diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex b48d22fe41..5428e202e7 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex b48d22fe41..5428e202e7 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 5c91f09b30..5dafb89f68 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam Binary files differindex 7b34cc5906..b1bd549a8a 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex a5db96bdaf..71186a12cd 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 5829ab4867..57cfc6b932 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 0a5e6de039..c0483e7801 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "7.3.1"}, + {vsn, "7.3.2"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 8370664167..3d4fe9c021 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"7.3.1", +{"7.3.2", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 9db02f55fd..84c5b7636e 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex 32612f1bf6..c33895a44e 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 6add687cf2..6cbda0c9bb 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex f57cf03afd..f4ca5b8620 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex fc80f2d1bd..9270358896 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex 76d7ac2adb..e53e183312 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index ab106113c2..c3f4e2b892 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "6.2"}, + {vsn, "6.3"}, {modules, [application, application_controller, application_master, @@ -147,6 +147,6 @@ {logger_sasl_compatible, false} ]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-10.1", "stdlib-3.5", "sasl-3.0"]} + {runtime_dependencies, ["erts-10.2.5", "stdlib-3.5", "sasl-3.0"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 59e716b2d0..e126f18b35 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -26,7 +26,7 @@ %% versions that have branched off from the above %% stated previous versions. %% -{"6.2", +{"6.3", [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -40,7 +40,10 @@ {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.1$">>,[restart_new_emulator]}, {<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.2$">>,[restart_new_emulator]}, + {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -54,4 +57,7 @@ {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.1$">>,[restart_new_emulator]}, {<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.2$">>,[restart_new_emulator]}, + {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 8f75029c0f..11be83a49e 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/logger.beam b/bootstrap/lib/kernel/ebin/logger.beam Binary files differindex bd17885e22..1dc1c4fef4 100644 --- a/bootstrap/lib/kernel/ebin/logger.beam +++ b/bootstrap/lib/kernel/ebin/logger.beam diff --git a/bootstrap/lib/kernel/ebin/logger_formatter.beam b/bootstrap/lib/kernel/ebin/logger_formatter.beam Binary files differindex 83df11e66f..e3e40460f0 100644 --- a/bootstrap/lib/kernel/ebin/logger_formatter.beam +++ b/bootstrap/lib/kernel/ebin/logger_formatter.beam diff --git a/bootstrap/lib/kernel/ebin/logger_h_common.beam b/bootstrap/lib/kernel/ebin/logger_h_common.beam Binary files differindex 5e14216b5d..9e8c25b6b9 100644 --- a/bootstrap/lib/kernel/ebin/logger_h_common.beam +++ b/bootstrap/lib/kernel/ebin/logger_h_common.beam diff --git a/bootstrap/lib/kernel/ebin/logger_simple_h.beam b/bootstrap/lib/kernel/ebin/logger_simple_h.beam Binary files differindex 954bbdc071..583c77b290 100644 --- a/bootstrap/lib/kernel/ebin/logger_simple_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_simple_h.beam diff --git a/bootstrap/lib/kernel/ebin/logger_std_h.beam b/bootstrap/lib/kernel/ebin/logger_std_h.beam Binary files differindex 3b5d3cd9f8..b0f56d9a62 100644 --- a/bootstrap/lib/kernel/ebin/logger_std_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_std_h.beam diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex ac3193515c..9e783452f5 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex c13a82a074..44d783a6d0 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/calendar.beam b/bootstrap/lib/stdlib/ebin/calendar.beam Binary files differindex d0abc17e48..89102adda8 100644 --- a/bootstrap/lib/stdlib/ebin/calendar.beam +++ b/bootstrap/lib/stdlib/ebin/calendar.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex 7ffe569c60..ba644430da 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 2bb0b06f12..9f6ff2942b 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "3.7.1"}, + {vsn, "3.8"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index d22e917574..76372566d5 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -26,7 +26,7 @@ %% versions that have branched off from the above %% stated previous versions. %% -{"3.7.1", +{"3.8", [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -40,7 +40,8 @@ {<<"^3\\.6$">>,[restart_new_emulator]}, {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], + {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -54,4 +55,5 @@ {<<"^3\\.6$">>,[restart_new_emulator]}, {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. + {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex da647da3ca..437f63357c 100644 --- a/bootstrap/lib/stdlib/ebin/string.beam +++ b/bootstrap/lib/stdlib/ebin/string.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode_util.beam b/bootstrap/lib/stdlib/ebin/unicode_util.beam Binary files differindex 8ddf73ca26..c9db0483ca 100644 --- a/bootstrap/lib/stdlib/ebin/unicode_util.beam +++ b/bootstrap/lib/stdlib/ebin/unicode_util.beam diff --git a/erts/configure.in b/erts/configure.in index b070ad0649..5f969a0a8b 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2783,6 +2783,32 @@ AC_SUBST(HIPE_ENABLED) NATIVE_LIBS_ENABLED= if test X${enable_native_libs} = Xyes -a X${HIPE_ENABLED} = Xyes; then NATIVE_LIBS_ENABLED=yes + cat >> $ERL_TOP/erts/CONF_INFO <<EOF + + WARNING: In OTP 22, HiPE (the native code compiler) is + not fully functional. The reasons for this are: + + 1. There are new BEAM instructions for binary + matching that the HiPE native code compiler does not + support. + + 2. The new optimizations in the Erlang compiler create + new combination of instructions that HiPE currently + does not handle correctly. + + If erlc is invoked like so: + + erlc +native some_file.erl + + or like so: + + erlc +native some_file.beam + + and if any of the new binary matching instructions + are used, the compiler will issue a warning and + produce a BEAM file without native code. + +EOF fi AC_SUBST(NATIVE_LIBS_ENABLED) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index e78ded4ae1..0d94f83493 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1269,6 +1269,42 @@ end</code> data is available by calling <seealso marker="erlang#dist_ctrl_get_data_notification/1"><c>erlang:dist_ctrl_get_data_notification(DHandle)</c></seealso>. </p> + <p>The returned value when there are data available depends + on the value of the <c>get_size</c> option configured on the + distribution channel identified by <c><anno>DHandle</anno></c>. + For more information see the documentation of the <c>get_size</c> + option for the + <seealso marker="#dist_ctrl_set_opt/3"><c>erlang:dist_ctrl_set_opt/3</c></seealso> + function.</p> + <note><p> + Only the process registered as distribution + controller for the distribution channel identified by + <c><anno>DHandle</anno></c> is allowed to call this + function. + </p></note> + <p> + This function is used when implementing an alternative + distribution carrier using processes as distribution + controllers. <c><anno>DHandle</anno></c> is retrived + via the callback + <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>. + More information can be found in the documentation of + <seealso marker="erts:alt_dist#distribution_module">ERTS + User's Guide ➜ How to implement an Alternative Carrier + for the Erlang Distribution ➜ Distribution Module</seealso>. + </p> + </desc> + </func> + + <func> + <name name="dist_ctrl_get_opt" arity="2" clause_i="1" since="OTP @OTP-15617@"/> + <fsummary>Get value of the get_size option on a distribution channel</fsummary> + <desc> + <p>Returns the value of the <c>get_size</c> option on the distribution channel + identified by <c><anno>DHandle</anno></c>. For more information see the + documentation of the <c>get_size</c> option for the + <seealso marker="#dist_ctrl_set_opt/3"><c>erlang:dist_ctrl_set_opt/3</c></seealso> + function.</p> <note><p> Only the process registered as distribution controller for the distribution channel identified by @@ -1392,6 +1428,55 @@ end</code> </func> <func> + <name name="dist_ctrl_set_opt" arity="3" clause_i="1" since="OTP @OTP-15617@"/> + <fsummary>Set value of the get_size option on a distribution channel</fsummary> + <desc> + <p>Sets the value of the <c>get_size</c> option on the distribution channel + identified by <c><anno>DHandle</anno></c>. This option controls the return + value of calls to + <seealso marker="#dist_ctrl_get_data/1">erlang:dist_ctrl_get_data(<anno>DHandle</anno>)</seealso> + where <c><anno>DHandle</anno></c> equals <c><anno>DHandle</anno></c> used + when setting this option. + When the <c>get_size</c> option is:</p> + <taglist> + <tag><c>false</c></tag> + <item> + and there are distribution data available, a call to + <c>erlang:dist_ctrl_get_data(<anno>DHandle</anno>)</c> + will just return <c>Data</c> to pass over the channel. + This is the default value of the <c>get_size</c> option. + </item> + <tag><c>true</c></tag> + <item> + and there are distribution data available, a call to + <c>erlang:dist_ctrl_get_data(<anno>DHandle</anno>)</c> + will return <c>Data</c> to pass over the channel as well as + the <c>Size</c> of <c>Data</c> in bytes. This is returned as + a tuple on the form <c>{Size, Data}</c>. + </item> + </taglist> + <p>All options are set to default when a channel is closed.</p> + <note><p> + Only the process registered as distribution + controller for the distribution channel identified by + <c><anno>DHandle</anno></c> is allowed to call this + function. + </p></note> + <p> + This function is used when implementing an alternative + distribution carrier using processes as distribution + controllers. <c><anno>DHandle</anno></c> is retrived + via the callback + <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>. + More information can be found in the documentation of + <seealso marker="erts:alt_dist#distribution_module">ERTS + User's Guide ➜ How to implement an Alternative Carrier + for the Erlang Distribution ➜ Distribution Module</seealso>. + </p> + </desc> + </func> + + <func> <name name="element" arity="2" since=""/> <fsummary>Return the Nth element of a tuple.</fsummary> <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index bdae994d06..248b871ca0 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,38 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 10.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>If a suspend/resume signal pair was sent to a process + while it was executing dirty, the receiving process could + later end up in a suspended state indefinitely. This bug + was introduced in ERTS version 10.0 (OTP 21.0).</p> + <p>Suspend/resume signals are sent from <seealso + marker="erts:erlang#suspend_process/1"><c>erlang:suspend_process()</c></seealso>/<seealso + marker="erts:erlang#resume_process/1"><c>erlang:resume_process()</c></seealso>. + The <seealso + marker="runtime_tools:dbg"><c>dbg</c></seealso> trace + tool utilize this functionality and could thus trigger + this bug.</p> + <p> + Own Id: OTP-15688</p> + </item> + <item> + <p> + Fix a possible deadlock when terminating the ERTS caused + by a dirty scheduler not releasing it's run-queue lock + when terminating.</p> + <p> + Own Id: OTP-15690 Aux Id: PR-2172 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 10.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index f81082a698..412d689246 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -290,6 +290,7 @@ atom Ge='>=' atom generational atom get_all_trap atom get_seq_token +atom get_size atom get_tcw atom gather_gc_info_result atom gather_io_bytes diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index f71efd708f..762c5da9be 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -332,6 +332,13 @@ erts_debug_disassemble_1(BIF_ALIST_1) "unknown " HEXF "\n", instr); code_ptr++; } + if (i == op_call_nif) { + /* + * The rest of the code will not be executed. Don't disassemble any + * more code in this function. + */ + code_ptr = 0; + } bin = new_binary(p, (byte *) dsbufp->str, dsbufp->str_len); erts_destroy_tmp_dsbuf(dsbufp); hsz = 4+4; @@ -569,6 +576,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } break; case op_i_bs_match_string_xfWW: + case op_i_bs_match_string_yfWW: if (ap - first_arg < 3) { erts_print(to, to_arg, "%d", *ap); } else { @@ -772,8 +780,11 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case op_put_tuple2_xI: case op_put_tuple2_yI: case op_new_map_dtI: - case op_update_map_assoc_sdtI: - case op_update_map_exact_jsdtI: + case op_update_map_assoc_xdtI: + case op_update_map_assoc_ydtI: + case op_update_map_assoc_cdtI: + case op_update_map_exact_xjdtI: + case op_update_map_exact_yjdtI: { int n = unpacked[-1]; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 0ad5329b2f..21740caa2c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -492,6 +492,11 @@ typedef struct LoaderState { (Genop)->arity * sizeof(GenOpArg)); \ } while (0) +#define GENOP_NAME_ARITY(Genop, Name, Arity) \ + do { \ + (Genop)->op = genop_##Name##_##Arity; \ + (Genop)->arity = Arity; \ + } while (0) static void free_loader_state(Binary* magic); static ErlHeapFragment* new_literal_fragment(Uint size); @@ -3141,6 +3146,35 @@ is_killed(LoaderState* stp, GenOpArg Reg, GenOpArg Live) } /* + * Test whether register Reg is killed by make_fun instruction that + * creates the fun given by index idx. + */ + +static int +is_killed_by_make_fun(LoaderState* stp, GenOpArg Reg, GenOpArg idx) +{ + Uint num_free; + + if (idx.val >= stp->num_lambdas) { + /* Invalid index. Ignore the error for now. */ + return 0; + } else { + num_free = stp->lambdas[idx.val].num_free; + return Reg.type == TAG_x && num_free <= Reg.val; + } +} + +/* + * Test whether register Reg is killed by the send instruction that follows. + */ + +static int +is_killed_by_send(LoaderState* stp, GenOpArg Reg) +{ + return Reg.type == TAG_x && 2 <= Reg.val; +} + +/* * Generate an instruction for element/2. */ @@ -3151,20 +3185,19 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, GenOp* op; NEW_GENOP(stp, op); - op->arity = 4; op->next = NULL; if (Index.type == TAG_i && Index.val > 0 && Index.val <= ERTS_MAX_TUPLE_SIZE && (Tuple.type == TAG_x || Tuple.type == TAG_y)) { - op->op = genop_i_fast_element_4; + GENOP_NAME_ARITY(op, i_fast_element, 4); op->a[0] = Tuple; op->a[1] = Fail; op->a[2].type = TAG_u; op->a[2].val = Index.val; op->a[3] = Dst; } else { - op->op = genop_i_element_4; + GENOP_NAME_ARITY(op, i_element, 4); op->a[0] = Tuple; op->a[1] = Fail; op->a[2] = Index; @@ -3180,8 +3213,7 @@ gen_bs_save(LoaderState* stp, GenOpArg Reg, GenOpArg Index) GenOp* op; NEW_GENOP(stp, op); - op->op = genop_i_bs_save2_2; - op->arity = 2; + GENOP_NAME_ARITY(op, i_bs_save2, 2); op->a[0] = Reg; op->a[1] = Index; if (Index.type == TAG_u) { @@ -3200,8 +3232,7 @@ gen_bs_restore(LoaderState* stp, GenOpArg Reg, GenOpArg Index) GenOp* op; NEW_GENOP(stp, op); - op->op = genop_i_bs_restore2_2; - op->arity = 2; + GENOP_NAME_ARITY(op, i_bs_restore2, 2); op->a[0] = Reg; op->a[1] = Index; if (Index.type == TAG_u) { @@ -3235,21 +3266,18 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, } else if ((Flags.val & BSF_SIGNED) != 0) { goto generic; } else if (bits == 8) { - op->op = genop_i_bs_get_integer_8_3; - op->arity = 3; - op->a[0] = Ms; + GENOP_NAME_ARITY(op, i_bs_get_integer_8, 3); + op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Dst; } else if (bits == 16 && (Flags.val & BSF_LITTLE) == 0) { - op->op = genop_i_bs_get_integer_16_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_bs_get_integer_16, 3); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Dst; #ifdef ARCH_64 } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { - op->op = genop_i_bs_get_integer_32_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_bs_get_integer_32, 3); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Dst; @@ -3257,8 +3285,7 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, } else { generic: if (bits < SMALL_BITS) { - op->op = genop_i_bs_get_integer_small_imm_5; - op->arity = 5; + GENOP_NAME_ARITY(op, i_bs_get_integer_small_imm, 5); op->a[0] = Ms; op->a[1].type = TAG_u; op->a[1].val = bits; @@ -3266,8 +3293,7 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, op->a[3] = Flags; op->a[4] = Dst; } else { - op->op = genop_i_bs_get_integer_imm_6; - op->arity = 6; + GENOP_NAME_ARITY(op, i_bs_get_integer_imm, 6); op->a[0] = Ms; op->a[1].type = TAG_u; op->a[1].val = bits; @@ -3283,8 +3309,7 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, if (!term_to_Uint(big, &bigval)) { error: - op->op = genop_jump_1; - op->arity = 1; + GENOP_NAME_ARITY(op, jump, 1); op->a[0] = Fail; } else { if (!safe_mul(bigval, Unit.val, &bits)) { @@ -3293,8 +3318,7 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, goto generic; } } else { - op->op = genop_i_bs_get_integer_6; - op->arity = 6; + GENOP_NAME_ARITY(op, i_bs_get_integer, 6); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Live; @@ -3324,23 +3348,20 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, NATIVE_ENDIAN(Flags); if (Size.type == TAG_a && Size.val == am_all) { if (Ms.type == Dst.type && Ms.val == Dst.val) { - op->op = genop_i_bs_get_binary_all_reuse_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_bs_get_binary_all_reuse, 3); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Unit; } else { - op->op = genop_i_bs_get_binary_all2_5; - op->arity = 5; + GENOP_NAME_ARITY(op, i_bs_get_binary_all2, 5); op->a[0] = Ms; op->a[1] = Fail; - op->a[2] = Live; + op->a[2] = Live; op->a[3] = Unit; op->a[4] = Dst; } } else if (Size.type == TAG_i) { - op->op = genop_i_bs_get_binary_imm2_6; - op->arity = 6; + GENOP_NAME_ARITY(op, i_bs_get_binary_imm2, 6); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Live; @@ -3356,12 +3377,10 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, if (!term_to_Uint(big, &bigval)) { error: - op->op = genop_jump_1; - op->arity = 1; + GENOP_NAME_ARITY(op, jump, 1); op->a[0] = Fail; } else { - op->op = genop_i_bs_get_binary_imm2_6; - op->arity = 6; + GENOP_NAME_ARITY(op, i_bs_get_binary_imm2, 6); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Live; @@ -3373,8 +3392,7 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, op->a[5] = Dst; } } else { - op->op = genop_i_bs_get_binary2_6; - op->arity = 6; + GENOP_NAME_ARITY(op, i_bs_get_binary2, 6); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Live; @@ -3407,22 +3425,19 @@ gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size, NATIVE_ENDIAN(Flags); if (Size.type == TAG_a && Size.val == am_all) { - op->op = genop_i_new_bs_put_binary_all_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_new_bs_put_binary_all, 3); op->a[0] = Src; op->a[1] = Fail; op->a[2] = Unit; } else if (Size.type == TAG_i) { - op->op = genop_i_new_bs_put_binary_imm_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_new_bs_put_binary_imm, 3); op->a[0] = Fail; op->a[1].type = TAG_u; if (safe_mul(Size.val, Unit.val, &op->a[1].val)) { op->a[2] = Src; } else { error: - op->op = genop_badarg_1; - op->arity = 1; + GENOP_NAME_ARITY(op, badarg, 1); op->a[0] = Fail; } } else if (Size.type == TAG_q) { @@ -3440,16 +3455,14 @@ gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size, !safe_mul(bigval, Unit.val, &size)) { goto error; } - op->op = genop_i_new_bs_put_binary_imm_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_new_bs_put_binary_imm, 3); op->a[0] = Fail; op->a[1].type = TAG_u; op->a[1].val = size; op->a[2] = Src; #endif } else { - op->op = genop_i_new_bs_put_binary_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_new_bs_put_binary, 4); op->a[0] = Fail; op->a[1] = Size; op->a[2].type = TAG_u; @@ -3474,14 +3487,12 @@ gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size, Uint size; if (!safe_mul(Size.val, Unit.val, &size)) { error: - op->op = genop_badarg_1; - op->arity = 1; + GENOP_NAME_ARITY(op, badarg, 1); op->a[0] = Fail; op->next = NULL; return op; } - op->op = genop_i_new_bs_put_integer_imm_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_new_bs_put_integer_imm, 4); op->a[0] = Src; op->a[1] = Fail; op->a[2].type = TAG_u; @@ -3497,8 +3508,7 @@ gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size, !safe_mul(bigval, Unit.val, &size)) { goto error; } - op->op = genop_i_new_bs_put_integer_imm_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_new_bs_put_integer_imm, 4); op->a[0] = Src; op->a[1] = Fail; op->a[2].type = TAG_u; @@ -3506,8 +3516,7 @@ gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size, op->a[3].type = Flags.type; op->a[3].val = (Flags.val & 7); } else { - op->op = genop_i_new_bs_put_integer_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_new_bs_put_integer, 4); op->a[0] = Fail; op->a[1] = Size; op->a[2].type = TAG_u; @@ -3527,21 +3536,18 @@ gen_put_float(LoaderState* stp, GenOpArg Fail, GenOpArg Size, NATIVE_ENDIAN(Flags); if (Size.type == TAG_i) { - op->op = genop_i_new_bs_put_float_imm_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_new_bs_put_float_imm, 4); op->a[0] = Fail; op->a[1].type = TAG_u; if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { - op->op = genop_badarg_1; - op->arity = 1; + GENOP_NAME_ARITY(op, badarg, 1); op->a[0] = Fail; } else { op->a[2] = Flags; op->a[3] = Src; } } else { - op->op = genop_i_new_bs_put_float_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_new_bs_put_float, 4); op->a[0] = Fail; op->a[1] = Size; op->a[2].type = TAG_u; @@ -3564,8 +3570,7 @@ gen_get_float2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, NEW_GENOP(stp, op); NATIVE_ENDIAN(Flags); - op->op = genop_i_bs_get_float2_6; - op->arity = 6; + GENOP_NAME_ARITY(op, i_bs_get_float2, 6); op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Live; @@ -3582,7 +3587,7 @@ gen_get_float2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, */ static GenOp* -gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, +gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Size, GenOpArg Unit, GenOpArg Flags) { GenOp* op; @@ -3602,16 +3607,14 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, * a bs_restore2 instruction which will overwrite the position * by one of the stored positions. */ - op->op = genop_bs_test_unit_3; - op->arity = 3; + GENOP_NAME_ARITY(op, bs_test_unit, 3); op->a[0] = Fail; op->a[1] = Ms; op->a[2] = Unit; } else if (Size.type == TAG_i) { - op->op = genop_i_bs_skip_bits_imm2_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_bs_skip_bits_imm2, 3); op->a[0] = Fail; - op->a[1] = Ms; + op->a[1] = Ms; op->a[2].type = TAG_u; if (!safe_mul(Size.val, Unit.val, &op->a[2].val)) { goto error; @@ -3622,22 +3625,19 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, if (!term_to_Uint(big, &bigval)) { error: - op->op = genop_jump_1; - op->arity = 1; + GENOP_NAME_ARITY(op, jump, 1); op->a[0] = Fail; } else { - op->op = genop_i_bs_skip_bits_imm2_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_bs_skip_bits_imm2, 3); op->a[0] = Fail; - op->a[1] = Ms; + op->a[1] = Ms; op->a[2].type = TAG_u; if (!safe_mul(bigval, Unit.val, &op->a[2].val)) { goto error; } } } else { - op->op = genop_i_bs_skip_bits2_4; - op->arity = 4; + GENOP_NAME_ARITY(op, i_bs_skip_bits2, 4); op->a[0] = Ms; op->a[1] = Size; op->a[2] = Fail; @@ -3654,8 +3654,7 @@ gen_increment(LoaderState* stp, GenOpArg Reg, GenOp* op; NEW_GENOP(stp, op); - op->op = genop_i_increment_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_increment, 3); op->next = NULL; op->a[0] = Reg; op->a[1].type = TAG_u; @@ -3671,8 +3670,7 @@ gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, GenOp* op; NEW_GENOP(stp, op); - op->op = genop_i_increment_3; - op->arity = 3; + GENOP_NAME_ARITY(op, i_increment, 3); op->next = NULL; op->a[0] = Reg; op->a[1].type = TAG_u; @@ -3681,6 +3679,24 @@ gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, return op; } +static GenOp* +gen_plus_from_minus(LoaderState* stp, GenOpArg Fail, GenOpArg Live, + GenOpArg Src, GenOpArg Integer, GenOpArg Dst) +{ + GenOp* op; + + NEW_GENOP(stp, op); + GENOP_NAME_ARITY(op, gen_plus, 5); + op->next = NULL; + op->a[0] = Fail; + op->a[1] = Live; + op->a[2] = Src; + op->a[3].type = TAG_i; + op->a[3].val = -Integer.val; + op->a[4] = Dst; + return op; +} + /* * Test whether the negation of the given number is small. */ @@ -3727,12 +3743,11 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) Sint timeout; NEW_GENOP(stp, op); - op->op = genop_wait_timeout_unlocked_int_2; + GENOP_NAME_ARITY(op, wait_timeout_unlocked_int, 2); op->next = NULL; - op->arity = 2; op->a[0].type = TAG_u; op->a[1] = Fail; - + if (Time.type == TAG_i && (timeout = Time.val) >= 0 && #if defined(ARCH_64) (timeout >> 32) == 0 @@ -3761,8 +3776,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) #if !defined(ARCH_64) error: #endif - op->op = genop_i_wait_error_0; - op->arity = 0; + GENOP_NAME_ARITY(op, i_wait_error, 0); } return op; } @@ -3774,9 +3788,8 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) Sint timeout; NEW_GENOP(stp, op); - op->op = genop_wait_timeout_locked_int_2; + GENOP_NAME_ARITY(op, wait_timeout_locked_int, 2); op->next = NULL; - op->arity = 2; op->a[0].type = TAG_u; op->a[1] = Fail; @@ -3808,8 +3821,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) #if !defined(ARCH_64) error: #endif - op->op = genop_i_wait_error_locked_0; - op->arity = 0; + GENOP_NAME_ARITY(op, i_wait_error_locked, 0); } return op; } @@ -3846,9 +3858,9 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, */ if (size == 2) { NEW_GENOP(stp, op); - op->next = NULL; - op->op = genop_i_select_tuple_arity2_4; + GENOP_NAME_ARITY(op, i_select_tuple_arity2, 4); GENOP_ARITY(op, arity - 1); + op->next = NULL; op->a[0] = S; op->a[1] = Fail; op->a[2].type = TAG_u; @@ -3874,9 +3886,9 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, size += align; NEW_GENOP(stp, op); - op->next = NULL; - op->op = genop_i_select_tuple_arity_3; + GENOP_NAME_ARITY(op, i_select_tuple_arity, 3); GENOP_ARITY(op, arity); + op->next = NULL; op->a[0] = S; op->a[1] = Fail; op->a[2].type = TAG_u; @@ -3932,21 +3944,18 @@ gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg TypeFail, ASSERT(Size.val >= 2 && Size.val % 2 == 0); NEW_GENOP(stp, is_integer); - is_integer->op = genop_is_integer_2; - is_integer->arity = 2; + GENOP_NAME_ARITY(is_integer, is_integer, 2); is_integer->a[0] = TypeFail; is_integer->a[1] = S; NEW_GENOP(stp, label); - label->op = genop_label_1; - label->arity = 1; + GENOP_NAME_ARITY(label, label, 1); label->a[0].type = TAG_u; label->a[0].val = new_label(stp); NEW_GENOP(stp, op1); - op1->op = genop_select_val_3; + GENOP_NAME_ARITY(op1, select_val, 3); GENOP_ARITY(op1, 3 + Size.val); - op1->arity = 3; op1->a[0] = S; op1->a[1].type = TAG_f; op1->a[1].val = label->a[0].val; @@ -3954,9 +3963,8 @@ gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg TypeFail, op1->a[2].val = 0; NEW_GENOP(stp, op2); - op2->op = genop_select_val_3; + GENOP_NAME_ARITY(op2, select_val, 3); GENOP_ARITY(op2, 3 + Size.val); - op2->arity = 3; op2->a[0] = S; op2->a[1] = Fail; op2->a[2].type = TAG_u; @@ -4034,19 +4042,17 @@ gen_jump_tab(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpAr GenOp* jump; NEW_GENOP(stp, op); - op->arity = 3; - op->op = genop_is_ne_exact_3; + GENOP_NAME_ARITY(op, is_ne_exact, 3); op->a[0] = Rest[1]; op->a[1] = S; op->a[2] = Rest[0]; NEW_GENOP(stp, jump); - jump->next = NULL; - jump->arity = 1; - jump->op = genop_jump_1; + GENOP_NAME_ARITY(jump, jump, 1); jump->a[0] = Fail; op->next = jump; + jump->next = NULL; return op; } @@ -4073,12 +4079,11 @@ gen_jump_tab(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpAr NEW_GENOP(stp, op); op->next = NULL; if (min == 0) { - op->op = genop_i_jump_on_val_zero_3; - fixed_args = 3; + GENOP_NAME_ARITY(op, i_jump_on_val_zero, 3); } else { - op->op = genop_i_jump_on_val_4; - fixed_args = 4; + GENOP_NAME_ARITY(op, i_jump_on_val, 4); } + fixed_args = op->arity; arity = fixed_args + size; GENOP_ARITY(op, arity); op->a[0] = S; @@ -4143,7 +4148,7 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, NEW_GENOP(stp, op); op->next = NULL; - op->op = genop_i_select_val2_4; + GENOP_NAME_ARITY(op, i_select_val2, 4); GENOP_ARITY(op, arity - 1); op->a[0] = S; op->a[1] = Fail; @@ -4165,7 +4170,11 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, NEW_GENOP(stp, op); op->next = NULL; - op->op = (align == 0) ? genop_i_select_val_bins_3 : genop_i_select_val_lins_3; + if (align == 0) { + GENOP_NAME_ARITY(op, i_select_val_bins, 3); + } else { + GENOP_NAME_ARITY(op, i_select_val_lins, 3); + } GENOP_ARITY(op, arity); op->a[0] = S; op->a[1] = Fail; @@ -4229,8 +4238,7 @@ gen_select_literals(LoaderState* stp, GenOpArg S, GenOpArg Fail, ASSERT(Rest[i].type == TAG_q); NEW_GENOP(stp, op); - op->op = genop_is_ne_exact_3; - op->arity = 3; + GENOP_NAME_ARITY(op, is_ne_exact, 3); op->a[0] = Rest[i+1]; op->a[1] = S; op->a[2] = Rest[i]; @@ -4239,9 +4247,8 @@ gen_select_literals(LoaderState* stp, GenOpArg S, GenOpArg Fail, } NEW_GENOP(stp, jump); + GENOP_NAME_ARITY(jump, jump, 1); jump->next = NULL; - jump->op = genop_jump_1; - jump->arity = 1; jump->a[0] = Fail; *prev_next = jump; return op; @@ -4263,9 +4270,8 @@ const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, ASSERT(Size.type == TAG_u); NEW_GENOP(stp, op); + GENOP_NAME_ARITY(op, jump, 1); op->next = NULL; - op->op = genop_jump_1; - op->arity = 1; /* * Search for a literal matching the controlling expression. @@ -4346,15 +4352,17 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) funp->creator = erts_init_process_id; funp->arity = arity; - op->op = genop_move_2; - op->arity = 2; + /* + * Use a move_fun/2 instruction to load the fun to enable + * further optimizations. + */ + GENOP_NAME_ARITY(op, move_fun, 2); op->a[0].type = TAG_q; op->a[0].val = lit; op->a[1].type = TAG_x; op->a[1].val = 0; } else { - op->op = genop_i_make_fun_2; - op->arity = 2; + GENOP_NAME_ARITY(op, i_make_fun, 2); op->a[0].type = TAG_u; op->a[0].val = (BeamInstr) fe; op->a[1].type = TAG_u; @@ -4382,13 +4390,11 @@ gen_is_function2(LoaderState* stp, GenOpArg Fail, GenOpArg Fun, GenOpArg Arity) */ if (Arity.val > MAX_ARG) { /* Arity is negative or too big. */ - op->op = genop_jump_1; - op->arity = 1; + GENOP_NAME_ARITY(op, jump, 1); op->a[0] = Fail; return op; } else { - op->op = genop_hot_is_function2_3; - op->arity = 3; + GENOP_NAME_ARITY(op, hot_is_function2, 3); op->a[0] = Fail; op->a[1] = Fun; op->a[2].type = TAG_u; @@ -4408,20 +4414,17 @@ gen_is_function2(LoaderState* stp, GenOpArg Fail, GenOpArg Fun, GenOpArg Arity) move_fun->next = move_arity; move_arity->next = op; - move_fun->arity = 2; - move_fun->op = genop_move_2; + GENOP_NAME_ARITY(move_fun, move, 2); move_fun->a[0] = Fun; move_fun->a[1].type = TAG_x; move_fun->a[1].val = 1022; - move_arity->arity = 2; - move_arity->op = genop_move_2; + GENOP_NAME_ARITY(move_arity, move, 2); move_arity->a[0] = Arity; move_arity->a[1].type = TAG_x; move_arity->a[1].val = 1023; - op->op = genop_cold_is_function2_3; - op->arity = 3; + GENOP_NAME_ARITY(op, cold_is_function2, 3); op->a[0] = Fail; op->a[1].type = TAG_x; op->a[1].val = 1022; @@ -4442,8 +4445,8 @@ tuple_append_put5(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, NEW_GENOP(stp, op); op->next = NULL; + GENOP_NAME_ARITY(op, i_put_tuple, 2); GENOP_ARITY(op, arity+2+5); - op->op = genop_i_put_tuple_2; op->a[0] = Dst; op->a[1].type = TAG_u; op->a[1].val = arity + 5; @@ -4468,8 +4471,8 @@ tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, NEW_GENOP(stp, op); op->next = NULL; + GENOP_NAME_ARITY(op, i_put_tuple, 2); GENOP_ARITY(op, arity+2+1); - op->op = genop_i_put_tuple_2; op->a[0] = Dst; op->a[1].type = TAG_u; op->a[1].val = arity + 1; @@ -4537,9 +4540,9 @@ gen_new_small_map_lit(LoaderState* stp, GenOpArg Dst, GenOpArg Live, Eterm keys; NEW_GENOP(stp, op); + GENOP_NAME_ARITY(op, i_new_small_map_lit, 3); GENOP_ARITY(op, 3 + size/2); op->next = NULL; - op->op = genop_i_new_small_map_lit_3; tmp = thp = erts_alloc(ERTS_ALC_T_LOADER_TMP, (1 + size/2) * sizeof(*tmp)); keys = make_tuple(thp); @@ -4720,14 +4723,12 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, Key = Rest[0]; if (hash_genop_arg(stp, Key, &hx)) { - op->arity = 5; - op->op = genop_i_get_map_element_hash_5; + GENOP_NAME_ARITY(op, i_get_map_element_hash, 5); op->a[3].type = TAG_u; op->a[3].val = (BeamInstr) hx; op->a[4] = Rest[1]; } else { - op->arity = 4; - op->op = genop_i_get_map_element_4; + GENOP_NAME_ARITY(op, i_get_map_element, 4); op->a[3] = Rest[1]; } return op; @@ -4767,15 +4768,13 @@ gen_get(LoaderState* stp, GenOpArg Src, GenOpArg Dst) NEW_GENOP(stp, op); op->next = NULL; if (hash_internal_genop_arg(stp, Src, &hx)) { - op->arity = 3; - op->op = genop_i_get_hash_3; + GENOP_NAME_ARITY(op, i_get_hash, 3); op->a[0] = Src; op->a[1].type = TAG_u; op->a[1].val = (BeamInstr) hx; op->a[2] = Dst; } else { - op->arity = 2; - op->op = genop_i_get_2; + GENOP_NAME_ARITY(op, i_get, 2); op->a[0] = Src; op->a[1] = Dst; } @@ -4799,7 +4798,7 @@ gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src, ASSERT(Size.type == TAG_u); NEW_GENOP(stp, op); - op->op = genop_i_get_map_elements_3; + GENOP_NAME_ARITY(op, i_get_map_elements, 3); GENOP_ARITY(op, 3 + 3*(Size.val/2)); op->next = NULL; op->a[0] = Fail; @@ -4837,9 +4836,9 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src, n = Size.val; NEW_GENOP(stp, op); + GENOP_NAME_ARITY(op, get_map_elements, 3); GENOP_ARITY(op, 3 + 2*n); op->next = NULL; - op->op = genop_get_map_elements_3; op->a[0] = Fail; op->a[1] = Src; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 11941db8cd..34a0be4f2d 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -160,6 +160,8 @@ bif erlang:dist_ctrl_input_handler/2 bif erlang:dist_ctrl_put_data/2 bif erlang:dist_ctrl_get_data/1 bif erlang:dist_ctrl_get_data_notification/1 +bif erlang:dist_ctrl_get_opt/2 +bif erlang:dist_ctrl_set_opt/3 # Static native functions in erts_internal bif erts_internal:port_info/1 diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index b50c8273b1..ff5f766de7 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -3253,6 +3253,86 @@ dist_ctrl_put_data_2(BIF_ALIST_2) } BIF_RETTYPE +dist_ctrl_set_opt_3(BIF_ALIST_3) +{ + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P); + Uint32 conn_id; + BIF_RETTYPE ret; + + if (!dep) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + if (erts_dhandle_to_dist_entry(BIF_ARG_1, &conn_id) != dep) + BIF_ERROR(BIF_P, BADARG); + + erts_de_rlock(dep); + + if (dep->connection_id != conn_id) + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + else { + + switch (BIF_ARG_2) { + case am_get_size: + ERTS_BIF_PREP_RET(ret, (dep->opts & ERTS_DIST_CTRL_OPT_GET_SIZE + ? am_true + : am_false)); + if (BIF_ARG_3 == am_true) + dep->opts |= ERTS_DIST_CTRL_OPT_GET_SIZE; + else if (BIF_ARG_3 == am_false) + dep->opts &= ~ERTS_DIST_CTRL_OPT_GET_SIZE; + else + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + break; + default: + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + break; + } + + } + + erts_de_runlock(dep); + + return ret; +} + +BIF_RETTYPE +dist_ctrl_get_opt_2(BIF_ALIST_2) +{ + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P); + Uint32 conn_id; + BIF_RETTYPE ret; + + if (!dep) + BIF_ERROR(BIF_P, EXC_NOTSUP); + + if (erts_dhandle_to_dist_entry(BIF_ARG_1, &conn_id) != dep) + BIF_ERROR(BIF_P, BADARG); + + erts_de_rlock(dep); + + if (dep->connection_id != conn_id) + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + else { + + switch (BIF_ARG_2) { + case am_get_size: + ERTS_BIF_PREP_RET(ret, (dep->opts & ERTS_DIST_CTRL_OPT_GET_SIZE + ? am_true + : am_false)); + break; + default: + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + break; + } + + } + + erts_de_runlock(dep); + + return ret; +} + +BIF_RETTYPE dist_get_stat_1(BIF_ALIST_1) { Sint64 read, write, pend; @@ -3332,7 +3412,9 @@ dist_ctrl_get_data_1(BIF_ALIST_1) Eterm *hp; ProcBin *pb; erts_aint_t qsize; - Uint32 conn_id; + Uint32 conn_id, get_size; + Eterm res; + Uint hsz, bin_sz; if (!dep) BIF_ERROR(BIF_P, EXC_NOTSUP); @@ -3400,15 +3482,26 @@ dist_ctrl_get_data_1(BIF_ALIST_1) erts_de_runlock(dep); - hp = HAlloc(BIF_P, PROC_BIN_SIZE); + bin_sz = obuf->ext_endp - obuf->extp; + hsz = PROC_BIN_SIZE; + + get_size = dep->opts & ERTS_DIST_CTRL_OPT_GET_SIZE; + if (get_size) { + hsz += 3; /* 2 tuple */ + if (!IS_USMALL(0, bin_sz)) + hsz += BIG_UINT_HEAP_SIZE; + } + + hp = HAlloc(BIF_P, hsz); pb = (ProcBin *) (char *) hp; pb->thing_word = HEADER_PROC_BIN; - pb->size = obuf->ext_endp - obuf->extp; + pb->size = bin_sz; pb->next = MSO(BIF_P).first; MSO(BIF_P).first = (struct erl_off_heap_header*) pb; pb->val = ErtsDistOutputBuf2Binary(obuf); pb->bytes = (byte*) obuf->extp; pb->flags = 0; + hp += PROC_BIN_SIZE; qsize = erts_atomic_add_read_nob(&dep->qsize, -size_obuf(obuf)); ASSERT(qsize >= 0); @@ -3425,7 +3518,20 @@ dist_ctrl_get_data_1(BIF_ALIST_1) } } - BIF_RET2(make_binary(pb), (initial_reds - reds)); + res = make_binary(pb); + + if (get_size) { + Eterm sz_term; + if (IS_USMALL(0, bin_sz)) + sz_term = make_small(bin_sz); + else { + sz_term = uint_to_big(bin_sz, hp); + hp += BIG_UINT_HEAP_SIZE; + } + res = TUPLE2(hp, sz_term, res); + } + + BIF_RET2(res, (initial_reds - reds)); } void diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index c4bb967592..5bd22cc31f 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -172,6 +172,9 @@ extern int erts_is_alive; /* Pending connection; signals can be enqueued */ #define ERTS_DSIG_PREP_PENDING 4 +/* dist_ctrl_{g,s}et_option/2 */ +#define ERTS_DIST_CTRL_OPT_GET_SIZE ((Uint32) (1 << 0)) + #ifdef DEBUG #define ERTS_DBG_CHK_NO_DIST_LNK(D, R, L) \ erts_dbg_chk_no_dist_proc_link((D), (R), (L)) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index afafaf48dc..1adb101e30 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -177,6 +177,7 @@ dist_table_alloc(void *dep_tmpl) dep->connection_id = 0; dep->state = ERTS_DE_STATE_IDLE; dep->flags = 0; + dep->opts = 0; dep->version = 0; dep->mld = NULL; @@ -659,6 +660,7 @@ erts_set_dist_entry_not_connected(DistEntry *dep) dep->state = ERTS_DE_STATE_IDLE; dep->flags = 0; + dep->opts = 0; dep->prev = NULL; dep->cid = NIL; diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index d5daf0c2df..8153699596 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -148,6 +148,7 @@ struct dist_entry_ { enum dist_entry_state state; Uint32 flags; /* Distribution flags, like hidden, atom cache etc. */ + Uint32 opts; unsigned long version; /* Protocol version */ ErtsMonLnkDist *mld; /* Monitors and links */ diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 9c74a2c355..bd59c4afa3 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -3429,9 +3429,15 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, erts_nif_demonitored((ErtsResource *) tmon->other.ptr); cnt++; break; - case ERTS_MON_TYPE_SUSPEND: - erts_resume(c_p, ERTS_PROC_LOCK_MAIN); + case ERTS_MON_TYPE_SUSPEND: { + ErtsMonitorSuspend *msp; + erts_aint_t mstate; + msp = (ErtsMonitorSuspend *) erts_monitor_to_data(tmon); + mstate = erts_atomic_read_acqb(&msp->state); + if (mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE) + erts_resume(c_p, ERTS_PROC_LOCK_MAIN); break; + } default: break; } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 77bb71e321..f34289339f 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -9472,6 +9472,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!is_normal_sched & !!(flags & ERTS_RUNQ_FLG_HALTING)) { /* Wait for emulator to terminate... */ + erts_runq_unlock(rq); while (1) erts_milli_sleep(1000*1000); } @@ -13415,10 +13416,10 @@ void erts_halt(int code) if (-1 == erts_atomic32_cmpxchg_acqb(&erts_halt_progress, erts_no_schedulers, -1)) { + notify_reap_ports_relb(); ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_CPU_RUNQ, ERTS_RUNQ_FLG_HALTING); ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_IO_RUNQ, ERTS_RUNQ_FLG_HALTING); erts_halt_code = code; - notify_reap_ports_relb(); } } diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 1eb83b61f2..692408e212 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -477,6 +477,13 @@ i_make_fun(FunP, NumFree) { HEAVY_SWAPIN; } +move_trim(Src, Dst, Words) { + Uint cp = E[0]; + $Dst = $Src; + E += $Words; + E[0] = cp; +} + i_trim(Words) { Uint cp = E[0]; E += $Words; @@ -493,10 +500,6 @@ move3(S1, D1, S2, D2, S3, D3) { $D3 = $S3; } -move_dup(Src, D1, D2) { - $D1 = $D2 = $Src; -} - move2_par(S1, D1, S2, D2) { Eterm V1, V2; V1 = $S1; @@ -512,6 +515,39 @@ move_shift(Src, SD, D) { $SD = V; } +move_src_window2(Src, D1, D2) { + Eterm* src = &$Src; + Eterm s1, s2; + s1 = src[0]; + s2 = src[1]; + $D1 = s1; + $D2 = s2; +} + +move_src_window3(Src, D1, D2, D3) { + Eterm* src = &$Src; + Eterm s1, s2, s3; + s1 = src[0]; + s2 = src[1]; + s3 = src[2]; + $D1 = s1; + $D2 = s2; + $D3 = s3; +} + +move_src_window4(Src, D1, D2, D3, D4) { + Eterm* src = &$Src; + Eterm s1, s2, s3, s4; + s1 = src[0]; + s2 = src[1]; + s3 = src[2]; + s4 = src[3]; + $D1 = s1; + $D2 = s2; + $D3 = s3; + $D4 = s4; +} + move_window2(S1, S2, D) { Eterm xt0, xt1; Eterm* y = &$D; @@ -703,9 +739,11 @@ jump(Fail) { $JUMP($Fail); } -move_jump(Fail, Src) { - x(0) = $Src; - $jump($Fail); +move_jump(Lbl, Src, Dst) { + Eterm lbl = $Lbl; + Eterm src = $Src; + $Dst = src; + $JUMP(lbl); } // @@ -817,6 +855,16 @@ is_tagged_tuple(Fail, Src, Arityval, Tag) { } } +is_tagged_tuple_ff(NotTupleFail, WrongRecordFail, Src, Arityval, Tag) { + Eterm term = $Src; + if (is_not_tuple(term)) { + $FAIL($NotTupleFail); + } else if (ERTS_UNLIKELY((tuple_val(term))[0] != $Arityval || + (tuple_val(term))[1] != $Tag)) { + $FAIL($WrongRecordFail); + } +} + is_tuple(Fail, Src) { if (is_not_tuple($Src)) { $FAIL($Fail); diff --git a/erts/emulator/beam/map_instrs.tab b/erts/emulator/beam/map_instrs.tab index c594a87298..5620d5a2d1 100644 --- a/erts/emulator/beam/map_instrs.tab +++ b/erts/emulator/beam/map_instrs.tab @@ -127,11 +127,21 @@ i_get_map_elements(Fail, Src, N) { } } -update_map_assoc(Src, Dst, Live, N) { +update_map_assoc := update_map_assoc.fetch.execute; + +update_map_assoc.head() { + Eterm map; +} + +update_map_assoc.fetch(Src) { + map = $Src; +} + +update_map_assoc.execute(Dst, Live, N) { Eterm res; Uint live = $Live; - reg[live] = $Src; + reg[live] = map; HEAVY_SWAPOUT; res = erts_gc_update_map_assoc(c_p, reg, live, $N, $NEXT_INSTRUCTION); HEAVY_SWAPIN; @@ -141,11 +151,21 @@ update_map_assoc(Src, Dst, Live, N) { $NEXT($NEXT_INSTRUCTION+$N); } -update_map_exact(Fail, Src, Dst, Live, N) { +update_map_exact := update_map_exact.fetch.execute; + +update_map_exact.head() { + Eterm map; +} + +update_map_exact.fetch(Src) { + map = $Src; +} + +update_map_exact.execute(Fail, Dst, Live, N) { Eterm res; Uint live = $Live; - reg[live] = $Src; + reg[live] = map; HEAVY_SWAPOUT; res = erts_gc_update_map_exact(c_p, reg, live, $N, $NEXT_INSTRUCTION); HEAVY_SWAPIN; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index da5364183c..6832e65b1b 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -106,7 +106,10 @@ init y allocate_zero t t? allocate_heap_zero t I t? +move Src=y Dst=x | trim N Remaining => move_trim Src Dst N trim N Remaining => i_trim N + +move_trim y x t i_trim t test_heap I t? @@ -261,12 +264,14 @@ system_limit j # Move instructions. # -move C=cxy x==0 | jump Lbl => move_jump Lbl C +move Src=cxy Dst=xy | jump Lbl => move_jump Lbl Src Dst + +move_jump f cxy xy +move_jump f c r -move_jump f ncxy -# Movement to and from the stack is common -# Try to pack as much as we can into one instruction +# Movement to and from the stack is common. +# Try to pack as much as we can into one instruction. # Window move move_window/5 @@ -294,11 +299,49 @@ move_window3 x x x y move_window4 x x x x y move_window5 x x x x x y +# y -> x + +move_src_window/4 +move_src_window/5 + +move Y1=y X1=x | move Y2=y X2=x | succ(Y1, Y2) => \ + move_src_window Y1 Y2 X1 X2 + +move_src_window Y1 Y2 X1 X2 | move Y3=y X3=x | succ(Y2, Y3) => \ + move_src_window Y1 Y3 X1 X2 X3 +move_src_window Y1 Y2 X1 X2 | move Y3=y X3=x | move Y4=y X4=x | succ(Y3, Y4) => \ + move_src_window2 Y1 X1 X2 | move_src_window Y3 Y4 X3 X4 +move_src_window Y1 Y2 X1 X2 | move Y3=y X3=x => \ + move3 Y1 X1 Y2 X2 Y3 X3 + +move_src_window Y1 Y3 X1 X2 X3 | move Y4=y X4=x | succ(Y3, Y4) => \ + move_src_window4 Y1 X1 X2 X3 X4 + +move_src_window Y1 y X1 X2 => move_src_window2 Y1 X1 X2 +move_src_window Y1 y X1 X2 X3 => move_src_window3 Y1 X1 X2 X3 + +move_src_window2 y x x +move_src_window3 y x x x +move_src_window4 y x x x x + # Swap registers. -move R1=x Tmp=x | move R2=x R1 | move Tmp R2 => swap_temp R1 R2 Tmp +move R1=xy Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp + +# The compiler uses x(1022) when swapping registers. It will definitely +# not be used again. +swap_temp R1 R2 Tmp=x==1022 => swap R1 R2 + +swap_temp R1 R2 Tmp | move Src Tmp => swap R1 R2 | move Src Tmp swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed_apply(Tmp, Live) => \ swap R1 R2 | line Loc | apply Live +swap_temp R1 R2 Tmp | line Loc | apply_last Live D | is_killed_apply(Tmp, Live) => \ + swap R1 R2 | line Loc | apply_last Live D + +swap_temp R1 R2 Tmp | line Loc | call_fun Live | is_killed(Tmp, Live) => \ + swap R1 R2 | line Loc | call_fun Live +swap_temp R1 R2 Tmp | make_fun2 OldIndex=u | is_killed_by_make_fun(Tmp, OldIndex) => \ + swap R1 R2 | make_fun2 OldIndex swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \ swap R1 R2 | line Loc | call Live Addr @@ -314,27 +357,55 @@ swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \ swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \ is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D -swap_temp x x x - -swap x x +swap_temp R1 R2 Tmp | call_ext Live Addr | is_killed(Tmp, Live) => \ + swap R1 R2 | call_ext Live Addr +swap_temp R1 R2 Tmp | call_ext_only Live Addr | is_killed(Tmp, Live) => \ + swap R1 R2 | call_ext_only Live Addr +swap_temp R1 R2 Tmp | call_ext_last Live Addr D | is_killed(Tmp, Live) => \ + swap R1 R2 | call_ext_last Live Addr D + +swap_temp R1 R2 Tmp | move Src Any | line Loc | call Live Addr | \ + is_killed(Tmp, Live) | distinct(Tmp, Src) => \ + swap R1 R2 | move Src Any | line Loc | call Live Addr +swap_temp R1 R2 Tmp | move Src Any | line Loc | call_ext Live Addr | \ + is_killed(Tmp, Live) | distinct(Tmp, Src) => \ + swap R1 R2 | move Src Any | line Loc | call_ext Live Addr +swap_temp R1 R2 Tmp | move Src Any | call_only Live Addr | \ + is_killed(Tmp, Live) | distinct(Tmp, Src) => \ + swap R1 R2 | move Src Any | call_only Live Addr +swap_temp R1 R2 Tmp | move Src Any | line Loc | call_ext_only Live Addr | \ + is_killed(Tmp, Live) | distinct(Tmp, Src) => \ + swap R1 R2 | move Src Any | line Loc | call_ext_only Live Addr +swap_temp R1 R2 Tmp | move Src Any | line Loc | call_fun Live | \ + is_killed(Tmp, Live) | distinct(Tmp, Src) => \ + swap R1 R2 | move Src Any | line Loc | call_fun Live + +swap_temp R1 R2 Tmp | line Loc | send | is_killed_by_send(Tmp) => \ + swap R1 R2 | line Loc | send + +# swap_temp/3 with Y register operands are rare. +swap_temp R1 R2=y Tmp => swap R1 R2 | move R2 Tmp +swap_temp R1=y R2 Tmp => swap R1 R2 | move R2 Tmp + +swap R1=x R2=y => swap R2 R1 -# move_dup - -move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2 -move Src=x SD=x | move SD=x D=x => move_dup Src SD D +swap_temp x x x -move_dup x x x +swap xy x +swap y y # move_shift -move SD=x D=x | move Src=xy SD=x | distinct(D, Src) => move_shift Src SD D -move SD=y D=x | move Src=x SD=y | distinct(D, Src) => move_shift Src SD D -move SD=x D=y | move Src=x SD=x | distinct(D, Src) => move_shift Src SD D +move SD=x D=x | move Src=cxy SD=x | distinct(D, Src) => move_shift Src SD D +move SD=y D=x | move Src=x SD=y | distinct(D, Src) => move_shift Src SD D +move SD=y D=x | init SD | => move_shift n SD D +move SD=x D=y | move Src=x SD=x | distinct(D, Src) => move_shift Src SD D +move SD=x==0 D=y | move Src=y SD=x==0 | distinct(D, Src) => move_shift Src SD D -move_shift x x x -move_shift y x x -move_shift x y x +move_shift cxy x x +move_shift nx y x move_shift x x y +move_shift y r y # move2_par x x x x @@ -530,32 +601,26 @@ put_list Src Dst=x Dst => update_list Src Dst update_list xyc x -put_list x n x -put_list y n x -put_list x x x -put_list y x x +# put_list SrcReg1 SrcReg2 => Dst -put_list y y x -put_list x y x +put_list xy xy x -# put_list SrcReg Constant Dst +# put_list SrcReg [] => Dst -put_list x c x -put_list x c y +put_list xy n xy -put_list y c x +# put_list SrcReg Constant => x -# put_list Constant SrcReg Dst +put_list xy c x -put_list c x x -put_list c y x +# put_list Constant SrcReg => Dst + +put_list c xy x # The following put_list instructions using x(0) are frequently used. -put_list r n r -put_list r n x -put_list r x x -put_list r x r +put_list r n rx +put_list r x rx put_list x x r %cold @@ -629,6 +694,11 @@ test_arity f? xy A test_arity_get_tuple_element f? x A P x +is_tuple NotTupleFail Tuple=x | is_tagged_tuple WrongRecordFail Tuple Arity Atom => \ + is_tagged_tuple_ff NotTupleFail WrongRecordFail Tuple Arity Atom + +is_tagged_tuple_ff f? f? rx A a + get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ get_tuple_element Reg=x P3 D3=x | \ succ(P1, P2) | succ(P2, P3) | \ @@ -1103,8 +1173,25 @@ call_fun Arity => i_call_fun Arity i_call_fun t i_call_fun_last t Q + +# +# A fun with an empty environment can be converted to a literal. +# As a further optimization, the we try to move the fun to its +# final destination directly. + make_fun2 OldIndex=u => gen_make_fun2(OldIndex) +move_fun/2 +move_fun Fun X0 | move X0 Dst | move Src X0 => move Fun Dst | move Src X0 +move_fun Fun X0 | move A B | move X0 Dst | move Src X0 | \ + independent_moves(Fun, X0, A, B) | distinct(Dst, A) => \ + move Fun Dst | move A B | move Src X0 +move_fun Fun X0 | move X0 Dst | make_fun2 OldIndex | \ + is_killed_by_make_fun(X0, OldIndex)=> \ + move Fun Dst | make_fun2 OldIndex + +move_fun Fun Dst => move Fun Dst + %cold i_make_fun W t %hot @@ -1484,23 +1571,22 @@ put_map_exact F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \ sorted_put_map_assoc Map Dst Live Size Rest=* | is_empty_map(Map) => \ new_map Dst Live Size Rest -sorted_put_map_assoc Src=s Dst Live Size Rest=* => \ - update_map_assoc Src Dst Live Size Rest -sorted_put_map_assoc Src Dst Live Size Rest=* => \ - move Src x | update_map_assoc x Dst Live Size Rest +sorted_put_map_assoc Src=xyc Dst Live Size Rest=* => \ + update_map_assoc Src Dst Live Size Rest -sorted_put_map_exact F Src=s Dst Live Size Rest=* => \ - update_map_exact F Src Dst Live Size Rest -sorted_put_map_exact F Src Dst Live Size Rest=* => \ - move Src x | update_map_exact F x Dst Live Size Rest +sorted_put_map_exact Fail Src=xy Dst Live Size Rest=* => \ + update_map_exact Src Fail Dst Live Size Rest +# Literal map arguments for an exact update operation are extremely rare. +sorted_put_map_exact Fail Src Dst Live Size Rest=* => \ + move Src x | update_map_exact x Fail Dst Live Size Rest new_map Dst Live Size Rest=* | is_small_map_literal_keys(Size, Rest) => \ gen_new_small_map_lit(Dst, Live, Size, Rest) new_map d t I i_new_small_map_lit d t q -update_map_assoc s d t I -update_map_exact j? s d t I +update_map_assoc xyc d t I +update_map_exact xy j? d t I is_map Fail Lit=q | literal_is_map(Lit) => is_map Fail cq => jump Fail @@ -1562,6 +1648,11 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # Arithmetic instructions. # +# It is OK to swap arguments for '+' in a guard. It is also +# OK to turn minus into plus in a guard. +gen_plus Fail=f Live S1=c S2 Dst => i_plus S2 S1 Fail Dst +gen_minus Fail=f Live S1 S2=i Dst => gen_plus_from_minus(Fail, Live, S1, S2, Dst) + gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Dst gen_minus Fail Live S1 S2 Dst => i_minus S1 S2 Fail Dst @@ -1595,10 +1686,13 @@ gc_bif1 Fail Live u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src Dst i_increment rxy W d -i_plus x xy j? d -i_plus s s j? d +# Handle unoptimized code. +i_plus S1=c S2=c Fail Dst => move S1 x | i_plus x S2 Fail Dst + +i_plus xy xyc j? d i_minus x x j? d +i_minus c x j? d i_minus s s j? d i_times j? s s d @@ -1639,8 +1733,9 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler gc_bif1 Fail=j Live u$bif:erlang:length/1 Src Dst => \ i_length_setup Live Src | i_length Fail Live Dst -i_length_setup t xyc +i_length_setup Live Src=c => move Src x | i_length_setup Live x +i_length_setup t xy i_length j? t d # diff --git a/erts/emulator/nifs/common/net_nif.c b/erts/emulator/nifs/common/net_nif.c index 6c91bd74bd..252aa3c835 100644 --- a/erts/emulator/nifs/common/net_nif.c +++ b/erts/emulator/nifs/common/net_nif.c @@ -1363,7 +1363,7 @@ ERL_NIF_TERM encode_address_infos(ErlNifEnv* env, NDBG( ("NET", "encode_address_infos -> len: %d\r\n", len) ); if (len > 0) { - ERL_NIF_TERM* array = MALLOC(len * sizeof(ERL_NIF_TERM)); // LEAK? + ERL_NIF_TERM* array = MALLOC(len * sizeof(ERL_NIF_TERM)); unsigned int i = 0; struct addrinfo* p = addrInfo; @@ -1374,6 +1374,7 @@ ERL_NIF_TERM encode_address_infos(ErlNifEnv* env, } result = MKLA(env, array, len); + FREE(array); } else { result = MKEL(env); } diff --git a/erts/emulator/nifs/common/socket_dbg.c b/erts/emulator/nifs/common/socket_dbg.c index fe9135e5a0..96f75a328f 100644 --- a/erts/emulator/nifs/common/socket_dbg.c +++ b/erts/emulator/nifs/common/socket_dbg.c @@ -38,8 +38,10 @@ static FILE* dbgout = NULL; +#if defined(CLOCK_REALTIME) static int realtime(struct timespec* tsP); static int timespec2str(char *buf, unsigned int len, struct timespec *ts); +#endif extern @@ -71,41 +73,48 @@ void esock_dbg_printf( const char* prefix, const char* format, ... ) { va_list args; char f[512 + sizeof(format)]; // This has to suffice... +#if defined(CLOCK_REALTIME) char stamp[30]; struct timespec ts; +#endif int res; /* - * We should really include self in the printout, so we can se which process - * are executing the code. But then I must change the API.... - * ....something for later. + * We should really include self in the printout, + * so we can se which process are executing the code. + * But then I must change the API....something for later. */ - if (!realtime(&ts)) { - if (timespec2str(stamp, sizeof(stamp), &ts) != 0) { - res = enif_snprintf(f, sizeof(f), "%s [%s] %s", prefix, TSNAME(), format); - // res = enif_snprintf(f, sizeof(f), "%s [%s]", prefix, format); - } else { - res = enif_snprintf(f, sizeof(f), "%s [%s] [%s] %s", prefix, stamp, TSNAME(), format); - // res = enif_snprintf(f, sizeof(f), "%s [%s] %s", prefix, stamp, format); - } - - if (res > 0) { +#if defined(CLOCK_REALTIME) + if (!realtime(&ts) && + (timespec2str(stamp, sizeof(stamp), &ts) == 0)) { + res = enif_snprintf(f, sizeof(f), "%s [%s] [%s] %s", + prefix, stamp, TSNAME(), format); + } else { + res = enif_snprintf(f, sizeof(f), "%s [%s] %s", + prefix, TSNAME(), format); + } +#else + res = enif_snprintf(f, sizeof(f), "%s [%s] %s", + prefix, TSNAME(), format); +#endif + + if (res > 0) { va_start (args, format); enif_vfprintf (dbgout, f, args); va_end (args); fflush(stdout); - } } return; } +#if defined(CLOCK_REALTIME) static int realtime(struct timespec* tsP) { - return clock_gettime(CLOCK_REALTIME, tsP); + return clock_gettime(CLOCK_REALTIME, tsP); } @@ -136,3 +145,4 @@ int timespec2str(char *buf, unsigned int len, struct timespec *ts) return 0; } +#endif diff --git a/erts/emulator/nifs/common/socket_nif.c b/erts/emulator/nifs/common/socket_nif.c index bb3df85ea4..870ab63bdf 100644 --- a/erts/emulator/nifs/common/socket_nif.c +++ b/erts/emulator/nifs/common/socket_nif.c @@ -2309,12 +2309,14 @@ static void dec_socket(int domain, int type, int protocol); ERL_NIF_TERM sockRef); ACTIVATE_NEXT_FUNCS_DEFS #undef ACTIVATE_NEXT_FUNC_DEF - + +/* static BOOLEAN_T activate_next(ErlNifEnv* env, SocketDescriptor* descP, SocketRequestor* reqP, SocketRequestQueue* q, ERL_NIF_TERM sockRef); +*/ /* *** acceptor_search4pid | writer_search4pid | reader_search4pid *** * *** acceptor_push | writer_push | reader_push *** @@ -2408,7 +2410,8 @@ static void socket_down_reader(ErlNifEnv* env, const ErlNifPid* pid); static char* esock_send_close_msg(ErlNifEnv* env, - SocketDescriptor* descP); + SocketDescriptor* descP, + ERL_NIF_TERM sockRef); static char* esock_send_abort_msg(ErlNifEnv* env, ERL_NIF_TERM sockRef, ERL_NIF_TERM recvRef, @@ -16894,15 +16897,18 @@ char* send_msg_error(ErlNifEnv* env, */ static char* esock_send_close_msg(ErlNifEnv* env, - SocketDescriptor* descP) -{ - ERL_NIF_TERM sockRef = enif_make_resource(descP->closeEnv, descP); - char* res = esock_send_socket_msg(env, - sockRef, - esock_atom_close, - descP->closeRef, - &descP->closerPid, - descP->closeEnv); + SocketDescriptor* descP, + ERL_NIF_TERM sockRef) +{ + ERL_NIF_TERM sr = ((descP->closeEnv != NULL) ? + enif_make_copy(descP->closeEnv, sockRef) : + sockRef); + char* res = esock_send_socket_msg(env, + sr, + esock_atom_close, + descP->closeRef, + &descP->closerPid, + descP->closeEnv); descP->closeEnv = NULL; @@ -17047,93 +17053,81 @@ int esock_select_cancel(ErlNifEnv* env, * *** activate_next_writer *** * *** activate_next_reader *** * - * This functions pops the writer queue and then selects until it - * manages to successfully activate a writer or the queue is empty. + * This functions pops the requestors queue and then selects until it + * manages to successfully activate a requestor or the queue is empty. + * Return value indicates if a new requestor was activated or not. */ -#define ACTIVATE_NEXT_FUNCS \ - ACTIVATE_NEXT_FUNC_DECL(acceptor, currentAcceptor, acceptorsQ) \ - ACTIVATE_NEXT_FUNC_DECL(writer, currentWriter, writersQ) \ - ACTIVATE_NEXT_FUNC_DECL(reader, currentReader, readersQ) +#define ACTIVATE_NEXT_FUNCS \ + ACTIVATE_NEXT_FUNC_DECL(acceptor, read, currentAcceptor, acceptorsQ) \ + ACTIVATE_NEXT_FUNC_DECL(writer, write, currentWriter, writersQ) \ + ACTIVATE_NEXT_FUNC_DECL(reader, read, currentReader, readersQ) -#define ACTIVATE_NEXT_FUNC_DECL(F, R, Q) \ +#define ACTIVATE_NEXT_FUNC_DECL(F, S, R, Q) \ static \ BOOLEAN_T activate_next_##F(ErlNifEnv* env, \ SocketDescriptor* descP, \ ERL_NIF_TERM sockRef) \ { \ - return activate_next(env, descP, \ - &descP->R, &descP->Q, \ - sockRef); \ + BOOLEAN_T popped, activated; \ + int sres; \ + SocketRequestor* reqP = &descP->R; \ + SocketRequestQueue* q = &descP->Q; \ + \ + popped = FALSE; \ + do { \ + \ + if (requestor_pop(q, reqP)) { \ + \ + /* There was another one */ \ + \ + SSDBG( descP, \ + ("SOCKET", \ + "activate_next_" #F " -> new (active) requestor: " \ + "\r\n pid: %T" \ + "\r\n ref: %T" \ + "\r\n", reqP->pid, reqP->ref) ); \ + \ + if ((sres = esock_select_##S(env, descP->sock, descP, \ + &reqP->pid, reqP->ref)) < 0) { \ + /* We need to inform this process, reqP->pid, */ \ + /* that we failed to select, so we don't leave */ \ + /* it hanging. */ \ + /* => send abort */ \ + \ + esock_send_abort_msg(env, sockRef, reqP->ref, \ + sres, &reqP->pid); \ + \ + } else { \ + \ + /* Success: New requestor selected */ \ + popped = TRUE; \ + activated = FALSE; \ + \ + } \ + \ + } else { \ + \ + SSDBG( descP, \ + ("SOCKET", \ + "activate_next_" #F " -> no more requestors\r\n") ); \ + \ + popped = TRUE; \ + activated = FALSE; \ + } \ + \ + } while (!popped); \ + \ + SSDBG( descP, \ + ("SOCKET", "activate_next_" #F " -> " \ + "done with %s\r\n", B2S(activated)) ); \ + \ + return activated; \ } ACTIVATE_NEXT_FUNCS #undef ACTIVATE_NEXT_FUNC_DECL -/* *** activate_next *** - * - * This functions pops the requestor queue and then selects until it - * manages to successfully activate a new requestor or the queue is empty. - * Return value indicates if a new requestor was activated or not. - */ - -static -BOOLEAN_T activate_next(ErlNifEnv* env, - SocketDescriptor* descP, - SocketRequestor* reqP, - SocketRequestQueue* q, - ERL_NIF_TERM sockRef) -{ - BOOLEAN_T popped, activated; - int sres; - - popped = FALSE; - do { - - if (requestor_pop(q, reqP)) { - - /* There was another one */ - - SSDBG( descP, - ("SOCKET", "activate_next -> new (active) requestor: " - "\r\n pid: %T" - "\r\n ref: %T" - "\r\n", reqP->pid, reqP->ref) ); - - if ((sres = esock_select_read(env, descP->sock, descP, - &reqP->pid, reqP->ref)) < 0) { - /* We need to inform this process, reqP->pid, that we - * failed to select, so we don't leave it hanging. - * => send abort - */ - - esock_send_abort_msg(env, sockRef, reqP->ref, sres, &reqP->pid); - - } else { - - /* Success: New requestor selected */ - popped = TRUE; - activated = FALSE; - - } - - } else { - - SSDBG( descP, - ("SOCKET", "send_activate_next -> no more requestors\r\n") ); - - popped = TRUE; - activated = FALSE; - } - - } while (!popped); - - SSDBG( descP, - ("SOCKET", "activate_next -> " - "done with %s\r\n", B2S(activated)) ); - - return activated; -} /* ---------------------------------------------------------------------- @@ -17730,7 +17724,7 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) if (COMPARE_PIDS(&descP->closerPid, &descP->currentAcceptor.pid) != 0) { SSDBG( descP, ("SOCKET", "socket_stop -> " "send abort message to current acceptor %T\r\n", - descP->currentWriter.pid) ); + descP->currentAcceptor.pid) ); if (esock_send_abort_msg(env, sockRef, descP->currentAcceptor.ref, @@ -17764,11 +17758,12 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) if (descP->sock != INVALID_SOCKET) { if (descP->closeLocal) { + if (!is_direct_call) { /* +++ send close message to the waiting process +++ */ - esock_send_close_msg(env, descP); + esock_send_close_msg(env, descP, sockRef); DEMONP("socket_stop -> closer", env, descP, &descP->closerMon); @@ -17778,7 +17773,11 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) * since the message send takes care of it if scheduled. */ - if (descP->closeEnv != NULL) enif_free_env(descP->closeEnv); + if (descP->closeEnv != NULL) { + enif_clear_env(descP->closeEnv); + enif_free_env(descP->closeEnv); + descP->closeEnv = NULL; + } } } diff --git a/erts/emulator/nifs/common/socket_util.c b/erts/emulator/nifs/common/socket_util.c index b817ae7636..5e18355308 100644 --- a/erts/emulator/nifs/common/socket_util.c +++ b/erts/emulator/nifs/common/socket_util.c @@ -51,8 +51,12 @@ extern char* erl_errno_id(int error); /* THIS IS JUST TEMPORARY??? */ +#if defined(CLOCK_REALTIME) static int realtime(struct timespec* tsP); -static int timespec2str(char *buf, unsigned int len, struct timespec *ts); +static int timespec2str(char *buf, + unsigned int len, + struct timespec *ts); +#endif static char* make_sockaddr_in4(ErlNifEnv* env, ERL_NIF_TERM port, @@ -1506,39 +1510,46 @@ void esock_warning_msg( const char* format, ... ) { va_list args; char f[512 + sizeof(format)]; // This has to suffice... +#if defined(CLOCK_REALTIME) char stamp[64]; // Just in case... struct timespec ts; +#endif int res; /* - * We should really include self in the printout, so we can se which process - * are executing the code. But then I must change the API.... - * ....something for later. + * We should really include self in the printout, + * so we can se which process are executing the code. + * But then I must change the API....something for later. */ // 2018-06-29 12:13:21.232089 // 29-Jun-2018::13:47:25.097097 - - if (!realtime(&ts)) { - if (timespec2str(stamp, sizeof(stamp), &ts) != 0) { - res = enif_snprintf(f, sizeof(f), "=WARNING MSG==== %s", format); - } else { - res = enif_snprintf(f, sizeof(f), - "=WARNING MSG==== %s ===\r\n%s" , stamp, format); - } - if (res > 0) { +#if defined(CLOCK_REALTIME) + if (!realtime(&ts) && + (timespec2str(stamp, sizeof(stamp), &ts) == 0)) { + res = enif_snprintf(f, sizeof(f), + "=WARNING MSG==== %s ===\r\n%s", + stamp, format); + } else { + res = enif_snprintf(f, sizeof(f), "=WARNING MSG==== %s", format); + } +#else + res = enif_snprintf(f, sizeof(f), "=WARNING MSG==== %s", format); +#endif + + if (res > 0) { va_start (args, format); enif_vfprintf (stdout, f, args); va_end (args); fflush(stdout); - } } return; } +#if defined(CLOCK_REALTIME) static int realtime(struct timespec* tsP) { @@ -1574,6 +1585,7 @@ int timespec2str(char *buf, unsigned int len, struct timespec *ts) return 0; } +#endif /* =================================================================== * diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl index 46eb0cba58..4f5ad0295a 100644 --- a/erts/emulator/test/dirty_bif_SUITE.erl +++ b/erts/emulator/test/dirty_bif_SUITE.erl @@ -38,7 +38,8 @@ dirty_process_info/1, dirty_process_register/1, dirty_process_trace/1, - code_purge/1]). + code_purge/1, + otp_15688/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -64,7 +65,8 @@ all() -> dirty_process_info, dirty_process_register, dirty_process_trace, - code_purge]. + code_purge, + otp_15688]. init_per_suite(Config) -> case erlang:system_info(dirty_cpu_schedulers) of @@ -498,10 +500,58 @@ code_purge(Config) when is_list(Config) -> true = Time =< 1000, ok. +otp_15688(Config) when is_list(Config) -> + ImBack = make_ref(), + {See, SeeMon} = spawn_monitor(fun () -> + erts_debug:dirty_io(wait, 2000), + exit(ImBack) + end), + wait_until(fun () -> + [{current_function, {erts_debug, dirty_io, 2}}, + {status, running}] + == process_info(See, + [current_function, status]) + end), + {Ser1, Ser1Mon} = spawn_monitor(fun () -> + erlang:suspend_process(See, + [asynchronous]) + end), + erlang:suspend_process(See, [asynchronous]), + receive {'DOWN', Ser1Mon, process, Ser1, normal} -> ok end, + + %% Verify that we sent the suspend request while it was executing dirty... + [{current_function, {erts_debug, dirty_io, 2}}, + {status, running}] = process_info(See, [current_function, status]), + + wait_until(fun () -> + {status, suspended} == process_info(See, status) + end), + erlang:resume_process(See), + + receive + {'DOWN', SeeMon, process, See, Reason} -> + ImBack = Reason + after 4000 -> + %% Resume bug seems to have hit us... + PI = process_info(See), + exit(See, kill), + ct:fail({suspendee_stuck, PI}) + end. + + %% %% Internal... %% +wait_until(Fun) -> + case Fun() of + true -> + ok; + _ -> + receive after 100 -> ok end, + wait_until(Fun) + end. + access_dirty_process(Config, Start, Test, Finish) -> {ok, Node} = start_node(Config, ""), [ok] = mcall(Node, diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 119ccc71dc..b824daea67 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1231,7 +1231,7 @@ maps(Config) when is_list(Config) -> repeat_while(fun({35,_}) -> false; ({K,Map}) -> Map = maps_from_list_nif(maps:to_list(Map)), - Map = maps:filter(fun(K,V) -> V =:= K*100 end, Map), + Map = maps:filter(fun(K2,V) -> V =:= K2*100 end, Map), {K+1, maps:put(K,K*100,Map)} end, {1,#{}}), @@ -1302,24 +1302,29 @@ resource_hugo_do(Type) -> release_resource(HugoPtr), erlang:garbage_collect(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), - Pid = spawn_link(fun() -> - receive {Pid, Type, Resource, Ptr, Bin} -> - Pid ! {self(), got_it}, - receive {Pid, check_it} -> - {Ptr,Bin} = get_resource(Type,Resource), - Pid ! {self(), ok} - end - end - end), + {Pid,_} = + spawn_monitor(fun() -> + receive {Pid, Type, Resource, Ptr, Bin} -> + Pid ! {self(), got_it}, + receive {Pid, check_it} -> + {Ptr,Bin} = get_resource(Type,Resource) + end + end, + gc_and_exit(ok) + end), Pid ! {self(), Type, Hugo, HugoPtr, HugoBin}, {Pid, got_it} = receive_any(), erlang:garbage_collect(), % just to make our ProcBin move in memory Pid ! {self(), check_it}, - {Pid, ok} = receive_any(), + {'DOWN', _, process, Pid, ok} = receive_any(), [] = last_resource_dtor_call(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), {HugoPtr, HugoBin, 1}. +gc_and_exit(Reason) -> + erlang:garbage_collect(), + exit(Reason). + resource_otto(Type) -> {OttoPtr, OttoBin} = resource_otto_do(Type), erlang:garbage_collect(), @@ -1396,14 +1401,14 @@ resource_binary_do() -> ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1), Papa = self(), - Forwarder = spawn_link(fun() -> forwarder(Papa) end), + {Forwarder,_} = spawn_monitor(fun() -> forwarder(Papa) end), io:format("sending to forwarder pid=~p\n",[Forwarder]), Forwarder ! ResBin1, ResBin2 = receive_any(), ResBin2 = ResBin1, ResInfo = get_resource(binary_resource_type,ResBin2), Forwarder ! terminate, - {Forwarder, 1} = receive_any(), + {'DOWN', _, process, Forwarder, 1} = receive_any(), erlang:garbage_collect(), ResInfo = get_resource(binary_resource_type,ResBin1), ResInfo = get_resource(binary_resource_type,ResBin2), @@ -1924,11 +1929,11 @@ send2_do1(SendBlobF) -> send2_do2(SendBlobF, self()), Papa = self(), - Forwarder = spawn_link(fun() -> forwarder(Papa) end), + {Forwarder,_} = spawn_monitor(fun() -> forwarder(Papa) end), io:format("sending to forwarder pid=~p\n",[Forwarder]), send2_do2(SendBlobF, Forwarder), Forwarder ! terminate, - {Forwarder, 4} = receive_any(), + {'DOWN', _, process, Forwarder, 4} = receive_any(), ok. send2_do2(SendBlobF, To) -> @@ -1984,7 +1989,7 @@ forwarder(To) -> forwarder(To, N) -> case receive_any() of terminate -> - To ! {self(), N}; + gc_and_exit(N); Msg -> To ! Msg, forwarder(To, N+1) diff --git a/erts/emulator/test/socket_SUITE.erl b/erts/emulator/test/socket_SUITE.erl index aec280485c..2e3f40a350 100644 --- a/erts/emulator/test/socket_SUITE.erl +++ b/erts/emulator/test/socket_SUITE.erl @@ -3404,7 +3404,9 @@ api_to_connect_tcp4(suite) -> api_to_connect_tcp4(doc) -> []; api_to_connect_tcp4(_Config) when is_list(_Config) -> + Cond = fun() -> api_to_connect_cond() end, tc_try(api_to_connect_tcp4, + Cond, fun() -> ?TT(?SECS(10)), InitState = #{domain => inet, @@ -3414,6 +3416,41 @@ api_to_connect_tcp4(_Config) when is_list(_Config) -> ok = api_to_connect_tcp(InitState) end). +api_to_connect_cond() -> + api_to_connect_cond(os:type(), os:version()). + +%% I don't know exactly at which version this starts to work. +%% I know it does not work for 4.4.*, but is does for 4.15. +%% So, just to simplify, we require atleast 4.15 +api_to_connect_cond({unix, linux}, {Maj, Min, _Rev}) -> + if + ((Maj >= 4) andalso (Min >= 15)) -> + ok; + true -> + skip("TC does not work") + end; +%% Only test on one machine, which has version 6.3, and there it does +%% not work, so disable for all. +api_to_connect_cond({unix, openbsd}, _) -> + skip("TC does not work"); +api_to_connect_cond({unix, freebsd}, {Maj, Min, _Rev}) -> + if + ((Maj >= 10) andalso (Min >= 4)) -> + ok; + true -> + skip("TC may not work") + end; +api_to_connect_cond({unix, sunos}, {Maj, Min, _Rev}) -> + if + ((Maj >= 5) andalso (Min >= 10)) -> + ok; + true -> + skip("TC may not work") + end; +api_to_connect_cond(_, _) -> + skip("TC may not work"). + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3425,8 +3462,8 @@ api_to_connect_tcp6(doc) -> []; api_to_connect_tcp6(_Config) when is_list(_Config) -> tc_try(api_to_connect_tcp6, + fun() -> has_support_ipv6(), api_to_connect_cond() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), InitState = #{domain => inet6, backlog => 1, @@ -3937,8 +3974,8 @@ api_to_accept_tcp6(doc) -> []; api_to_accept_tcp6(_Config) when is_list(_Config) -> tc_try(api_to_accept_tcp4, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), InitState = #{domain => inet6, timeout => 5000}, ok = api_to_accept_tcp(InitState) @@ -4053,8 +4090,8 @@ api_to_maccept_tcp6(doc) -> api_to_maccept_tcp6(_Config) when is_list(_Config) -> ?TT(?SECS(20)), tc_try(api_to_maccept_tcp4, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), InitState = #{domain => inet6, timeout => 5000}, ok = api_to_maccept_tcp(InitState) end). @@ -4541,7 +4578,7 @@ api_to_recv_tcp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recv(Sock, 0, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState) end). @@ -4556,8 +4593,8 @@ api_to_recv_tcp6(doc) -> []; api_to_recv_tcp6(_Config) when is_list(_Config) -> tc_try(api_to_recv_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), case socket:supports(ipv6) of true -> ?TT(?SECS(10)), @@ -4566,7 +4603,7 @@ api_to_recv_tcp6(_Config) when is_list(_Config) -> end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState); false -> skip("ipv6 not supported") @@ -4900,7 +4937,7 @@ api_to_recvfrom_udp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvfrom(Sock, 0, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -4915,13 +4952,13 @@ api_to_recvfrom_udp6(doc) -> []; api_to_recvfrom_udp6(_Config) when is_list(_Config) -> tc_try(api_to_recvfrom_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock, To) -> socket:recvfrom(Sock, 0, To) end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -4984,6 +5021,7 @@ api_to_receive_udp(InitState) -> %% *** Termination *** #{desc => "close socket", cmd => fun(#{sock := Sock} = _State) -> + socket:setopt(Sock, otp, debug, true), sock_close(Sock), ok end}, @@ -5015,7 +5053,7 @@ api_to_recvmsg_udp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -5030,13 +5068,13 @@ api_to_recvmsg_udp6(doc) -> []; api_to_recvmsg_udp6(_Config) when is_list(_Config) -> tc_try(api_to_recvmsg_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -5056,7 +5094,7 @@ api_to_recvmsg_tcp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState) end). @@ -5071,13 +5109,13 @@ api_to_recvmsg_tcp6(doc) -> []; api_to_recvmsg_tcp6(_Config) when is_list(_Config) -> tc_try(api_to_recvmsg_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState) end). @@ -5103,7 +5141,6 @@ sc_cpe_socket_cleanup_tcp4(doc) -> sc_cpe_socket_cleanup_tcp4(_Config) when is_list(_Config) -> tc_try(sc_cpe_socket_cleanup_tcp4, fun() -> - %% not_yet_implemented(), ?TT(?SECS(5)), InitState = #{domain => inet, type => stream, @@ -5123,8 +5160,8 @@ sc_cpe_socket_cleanup_tcp6(doc) -> []; sc_cpe_socket_cleanup_tcp6(_Config) when is_list(_Config) -> tc_try(sc_cpe_socket_cleanup_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(5)), InitState = #{domain => inet6, type => stream, @@ -5165,8 +5202,8 @@ sc_cpe_socket_cleanup_udp6(doc) -> []; sc_cpe_socket_cleanup_udp6(_Config) when is_list(_Config) -> tc_try(sc_cpe_socket_cleanup_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(5)), InitState = #{domain => inet6, type => dgram, @@ -5341,8 +5378,8 @@ sc_lc_recv_response_tcp6(doc) -> []; sc_lc_recv_response_tcp6(_Config) when is_list(_Config) -> tc_try(sc_lc_recv_response_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock) -> socket:recv(Sock) end, InitState = #{domain => inet6, @@ -5957,8 +5994,8 @@ sc_lc_recvfrom_response_udp6(doc) -> []; sc_lc_recvfrom_response_udp6(_Config) when is_list(_Config) -> tc_try(sc_lc_recvfrom_response_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(30)), Recv = fun(Sock, To) -> socket:recvfrom(Sock, [], To) end, InitState = #{domain => inet6, @@ -6377,8 +6414,8 @@ sc_lc_recvmsg_response_tcp6(doc) -> []; sc_lc_recvmsg_response_tcp6(_Config) when is_list(_Config) -> tc_try(sc_recvmsg_response_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock) -> socket:recvmsg(Sock) end, InitState = #{domain => inet6, @@ -6420,8 +6457,8 @@ sc_lc_recvmsg_response_udp6(doc) -> []; sc_lc_recvmsg_response_udp6(_Config) when is_list(_Config) -> tc_try(sc_recvmsg_response_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet6, @@ -6466,8 +6503,8 @@ sc_lc_acceptor_response_tcp6(doc) -> []; sc_lc_acceptor_response_tcp6(_Config) when is_list(_Config) -> tc_try(sc_lc_acceptor_response_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), InitState = #{domain => inet, type => stream, @@ -6901,8 +6938,8 @@ sc_rc_recv_response_tcp6(doc) -> []; sc_rc_recv_response_tcp6(_Config) when is_list(_Config) -> tc_try(sc_rc_recv_response_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock) -> socket:recv(Sock) end, InitState = #{domain => inet6, @@ -7782,8 +7819,8 @@ sc_rc_recvmsg_response_tcp6(doc) -> []; sc_rc_recvmsg_response_tcp6(_Config) when is_list(_Config) -> tc_try(sc_rc_recvmsg_response_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), Recv = fun(Sock) -> socket:recvmsg(Sock) end, InitState = #{domain => inet6, @@ -7842,8 +7879,8 @@ sc_rs_recv_send_shutdown_receive_tcp6(doc) -> []; sc_rs_recv_send_shutdown_receive_tcp6(_Config) when is_list(_Config) -> tc_try(sc_rs_recv_send_shutdown_receive_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), MsgData = ?DATA, Recv = fun(Sock) -> @@ -8666,8 +8703,8 @@ sc_rs_recvmsg_send_shutdown_receive_tcp6(doc) -> []; sc_rs_recvmsg_send_shutdown_receive_tcp6(_Config) when is_list(_Config) -> tc_try(sc_rs_recvmsg_send_shutdown_receive_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(10)), MsgData = ?DATA, Recv = fun(Sock) -> @@ -8727,8 +8764,8 @@ traffic_send_and_recv_chunks_tcp6(doc) -> []; traffic_send_and_recv_chunks_tcp6(_Config) when is_list(_Config) -> tc_try(traffic_send_and_recv_chunks_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(30)), InitState = #{domain => inet6}, ok = traffic_send_and_recv_chunks_tcp(InitState) @@ -9729,8 +9766,8 @@ traffic_ping_pong_small_send_and_recv_tcp6(_Config) when is_list(_Config) -> Msg = l2b(?TPP_SMALL), Num = ?TPP_SMALL_NUM, tc_try(traffic_ping_pong_small_send_and_recv_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(15)), InitState = #{domain => inet6, msg => Msg, @@ -9782,8 +9819,8 @@ traffic_ping_pong_medium_send_and_recv_tcp6(_Config) when is_list(_Config) -> Msg = l2b(?TPP_MEDIUM), Num = ?TPP_MEDIUM_NUM, tc_try(traffic_ping_pong_medium_send_and_recv_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(30)), InitState = #{domain => inet6, msg => Msg, @@ -9836,8 +9873,8 @@ traffic_ping_pong_large_send_and_recv_tcp6(_Config) when is_list(_Config) -> Msg = l2b(?TPP_LARGE), Num = ?TPP_LARGE_NUM, tc_try(traffic_ping_pong_large_send_and_recv_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(45)), InitState = #{domain => inet6, msg => Msg, @@ -9943,8 +9980,8 @@ traffic_ping_pong_medium_sendto_and_recvfrom_udp6(_Config) when is_list(_Config) Msg = l2b(?TPP_MEDIUM), Num = ?TPP_MEDIUM_NUM, tc_try(traffic_ping_pong_medium_sendto_and_recvfrom_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(45)), InitState = #{domain => inet6, msg => Msg, @@ -9997,8 +10034,8 @@ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6(_Config) when is_list(_Config) Msg = l2b(?TPP_SMALL), Num = ?TPP_SMALL_NUM, tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(20)), InitState = #{domain => inet6, msg => Msg, @@ -10050,8 +10087,8 @@ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6(_Config) when is_list(_Config) Msg = l2b(?TPP_MEDIUM), Num = ?TPP_MEDIUM_NUM, tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(20)), InitState = #{domain => ine6, msg => Msg, @@ -10103,8 +10140,8 @@ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6(_Config) when is_list(_Config) Msg = l2b(?TPP_LARGE), Num = ?TPP_LARGE_NUM, tc_try(traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(30)), InitState = #{domain => inet6, msg => Msg, @@ -10157,8 +10194,8 @@ traffic_ping_pong_small_sendmsg_and_recvmsg_udp6(_Config) when is_list(_Config) Msg = l2b(?TPP_SMALL), Num = ?TPP_SMALL_NUM, tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(20)), InitState = #{domain => inet, msg => Msg, @@ -10210,8 +10247,8 @@ traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6(_Config) when is_list(_Config) Msg = l2b(?TPP_MEDIUM), Num = ?TPP_MEDIUM_NUM, tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6, + fun() -> has_support_ipv6() end, fun() -> - not_yet_implemented(), ?TT(?SECS(20)), InitState = #{domain => ine6, msg => Msg, @@ -17171,17 +17208,17 @@ convert_time(TStrRev, Convert) -> ?TTEST_RUNTIME end. -ttest_tcp(TC, - Domain, - ServerMod, ServerActive, - ClientMod, ClientActive, - MsgID, MaxOutstanding) -> - ttest_tcp(TC, - ?TTEST_RUNTIME, - Domain, - ServerMod, ServerActive, - ClientMod, ClientActive, - MsgID, MaxOutstanding). +%% ttest_tcp(TC, +%% Domain, +%% ServerMod, ServerActive, +%% ClientMod, ClientActive, +%% MsgID, MaxOutstanding) -> +%% ttest_tcp(TC, +%% ?TTEST_RUNTIME, +%% Domain, +%% ServerMod, ServerActive, +%% ClientMod, ClientActive, +%% MsgID, MaxOutstanding). ttest_tcp(TC, Runtime, Domain, @@ -17190,7 +17227,12 @@ ttest_tcp(TC, MsgID, MaxOutstanding) -> tc_try(TC, fun() -> - if (Domain =/= inet) -> not_yet_implemented(); true -> ok end, + if + (Domain =/= inet) -> has_support_ipv6(); + true -> ok + end + end, + fun() -> %% This may be overkill, depending on the runtime, %% but better safe then sorry... ?TT(Runtime + ?SECS(60)), @@ -17832,6 +17874,18 @@ which_addr2(Domain, [_|IFO]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Here are all the *general* test vase condition functions. + +%% The idea is that this function shall test if the test host has +%% support for IPv6. If not there is no point in running IPv6 tests. +%% Currently we just skip. +has_support_ipv6() -> + not_yet_implemented(). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + not_yet_implemented() -> skip("not yet implemented"). @@ -17885,15 +17939,45 @@ tc_end(Result) when is_list(Result) -> "", "----------------------------------------------------~n~n"), ok. - -tc_try(Case, Fun) when is_atom(Case) andalso is_function(Fun, 0) -> +%% *** tc_try/2,3 *** +%% Case: Basically the test case name +%% TCCondFun: A fun that is evaluated before the actual test case +%% The point of this is that it can performs checks to +%% see if we shall run the test case at all. +%% For instance, the test case may only work in specific +%% conditions. +%% FCFun: The test case fun +tc_try(Case, TCFun) -> + TCCondFun = fun() -> ok end, + tc_try(Case, TCCondFun, TCFun). + +tc_try(Case, TCCondFun, TCFun) + when is_atom(Case) andalso + is_function(TCCondFun, 0) andalso + is_function(TCFun, 0) -> tc_begin(Case), - try - begin - Fun(), - ?SLEEP(?SECS(1)), - tc_end("ok") - end + try TCCondFun() of + ok -> + try + begin + TCFun(), + ?SLEEP(?SECS(1)), + tc_end("ok") + end + catch + throw:{skip, _} = SKIP -> + tc_end("skipping"), + SKIP; + Class:Error:Stack -> + tc_end("failed"), + erlang:raise(Class, Error, Stack) + end; + {skip, _} = SKIP -> + tc_end("skipping"), + SKIP; + {error, Reason} -> + tc_end("failed"), + exit({tc_cond_failed, Reason}) catch throw:{skip, _} = SKIP -> tc_end("skipping"), diff --git a/erts/emulator/test/socket_test_evaluator.erl b/erts/emulator/test/socket_test_evaluator.erl index bd86b3b92e..c5748ac21b 100644 --- a/erts/emulator/test/socket_test_evaluator.erl +++ b/erts/emulator/test/socket_test_evaluator.erl @@ -104,8 +104,9 @@ start(Name, Seq, InitState) erlang:error({already_used, parent}); error -> InitState2 = InitState#{parent => self()}, - {Pid, MRef} = erlang:spawn_monitor( - fun() -> init(Name, Seq, InitState2) end), + Pid = erlang:spawn_link( + fun() -> init(Name, Seq, InitState2) end), + MRef = erlang:monitor(process, Pid), #ev{name = Name, pid = Pid, mref = MRef} end. @@ -149,55 +150,93 @@ loop(ID, [#{desc := Desc, Evs :: [ev()]. await_finish(Evs) -> - await_finish(Evs, []). + await_finish(Evs, [], []). -await_finish([], []) -> +await_finish([], _, []) -> ok; -await_finish([], Fails) -> +await_finish([], _OK, Fails) -> ?SEV_EPRINT("Fails: " "~n ~p", [Fails]), Fails; -await_finish(Evs, Fails) -> +await_finish(Evs, OK, Fails) -> receive %% Successfull termination of evaluator {'DOWN', _MRef, process, Pid, normal} -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) success", [Name, Pid]), - NewEvs = lists:keydelete(Pid, #ev.pid, Evs), - await_finish(NewEvs, Fails); - false -> - iprint("unknown process ~p died (normal)", [Pid]), - await_finish(Evs, Fails) - end; + {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2); + {'EXIT', Pid, normal} -> + {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2); %% The evaluator can skip the teat case: {'DOWN', _MRef, process, Pid, {skip, Reason}} -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) issued SKIP: " - "~n ~p", [Name, Pid, Reason]); + await_finish_skip(Pid, Reason, Evs, OK); + {'EXIT', Pid, {skip, Reason}} -> + await_finish_skip(Pid, Reason, Evs, OK); + + %% Evaluator failed + {'DOWN', _MRef, process, Pid, Reason} -> + {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2); + {'EXIT', Pid, Reason} -> + {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2) + end. + + +await_finish_normal(Pid, Evs, OK, Fails) -> + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + iprint("evaluator '~s' (~p) success", [Name, Pid]), + NewEvs = lists:keydelete(Pid, #ev.pid, Evs), + {NewEvs, [Pid|OK], Fails}; + false -> + case lists:member(Pid, OK) of + true -> + ok; + false -> + iprint("unknown process ~p died (normal)", [Pid]), + ok + end, + {Evs, OK, Fails} + end. + +await_finish_skip(Pid, Reason, Evs, OK) -> + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + iprint("evaluator '~s' (~p) issued SKIP: " + "~n ~p", [Name, Pid, Reason]); + false -> + case lists:member(Pid, OK) of + true -> + ok; false -> iprint("unknown process ~p issued SKIP: " "~n ~p", [Pid, Reason]) - end, - ?LIB:skip(Reason); + end + end, + ?LIB:skip(Reason). - %% Evaluator failed - {'DOWN', _MRef, process, Pid, Reason} -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) failed", [Name, Pid]), - NewEvs = lists:keydelete(Pid, #ev.pid, Evs), - await_finish(NewEvs, [{Pid, Reason}|Fails]); + +await_finish_fail(Pid, Reason, Evs, OK, Fails) -> + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + iprint("evaluator '~s' (~p) failed", [Name, Pid]), + NewEvs = lists:keydelete(Pid, #ev.pid, Evs), + {NewEvs, OK, [{Pid, Reason}|Fails]}; + false -> + case lists:member(Pid, OK) of + true -> + ok; false -> iprint("unknown process ~p died: " - "~n ~p", [Pid, Reason]), - await_finish(Evs, Fails) - end + "~n ~p", [Pid, Reason]) + end, + {Evs, OK, Fails} end. + %% ============================================================================ -spec announce_start(To) -> ok when diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 1625b2cc65..605a402f2a 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -2737,7 +2737,7 @@ sub tr_maybe_keep { return; } } elsif ($op eq 'store_var_next_arg') { - return unless shift(@last_instr) eq $args[0]; + return unless @last_instr and shift(@last_instr) eq $args[0]; } elsif (defined $pos) { return; } diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 1b0cb5b50c..62dc8702e7 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index a5b60cc845..ac73946dc0 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -48,6 +48,8 @@ dist_ctrl_put_data/2, dist_ctrl_get_data/1, dist_ctrl_get_data_notification/1, + dist_ctrl_get_opt/2, + dist_ctrl_set_opt/3, dist_get_stat/1]). -deprecated([get_stacktrace/0,now/0]). @@ -3326,7 +3328,8 @@ dist_ctrl_input_handler(_DHandle, _InputHandler) -> dist_ctrl_put_data(_DHandle, _Data) -> erlang:nif_error(undefined). --spec erlang:dist_ctrl_get_data(DHandle) -> Data | 'none' when +-spec erlang:dist_ctrl_get_data(DHandle) -> {Size, Data} | Data | 'none' when + Size :: non_neg_integer(), DHandle :: dist_handle(), Data :: iodata(). @@ -3339,6 +3342,21 @@ dist_ctrl_get_data(_DHandle) -> dist_ctrl_get_data_notification(_DHandle) -> erlang:nif_error(undefined). +-spec erlang:dist_ctrl_set_opt(DHandle, 'get_size', Value) -> OldValue when + DHandle :: dist_handle(), + Value :: boolean(), + OldValue :: boolean(). + +dist_ctrl_set_opt(_DHandle, _Opt, _Val) -> + erlang:nif_error(undefined). + +-spec erlang:dist_ctrl_get_opt(DHandle, 'get_size') -> Value when + DHandle :: dist_handle(), + Value :: boolean(). + +dist_ctrl_get_opt(_DHandle, _Opt) -> + erlang:nif_error(undefined). + -spec erlang:dist_get_stat(DHandle) -> Res when DHandle :: dist_handle(), InputPackets :: non_neg_integer(), diff --git a/erts/vsn.mk b/erts/vsn.mk index fac608ed4e..3942af7f78 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 10.3 +VSN = 10.3.1 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/compiler/scripts/smoke b/lib/compiler/scripts/smoke index 2429f104c0..ae31c923b8 100755 --- a/lib/compiler/scripts/smoke +++ b/lib/compiler/scripts/smoke @@ -54,6 +54,7 @@ setup_mix() -> ElixirBin = filename:join([SmokeDir,"elixir","bin"]), PATH = ElixirBin ++ ":" ++ os:getenv("PATH"), os:putenv("PATH", PATH), + mix("local.hex --force"), mix("local.rebar --force"), ok. diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs index 82ae3370fe..ba0815e465 100644 --- a/lib/compiler/scripts/smoke-mix.exs +++ b/lib/compiler/scripts/smoke-mix.exs @@ -25,6 +25,14 @@ defmodule Smoke.MixProject do [ {:bear, "~> 0.8.7"}, {:cloudi_core, "~> 1.7"}, + {:cloudi_service_monitoring, "~> 1.7"}, + {:cloudi_service_tcp, "~> 1.7"}, + {:cloudi_service_queue, "~> 1.7"}, + {:cloudi_service_udp, "~> 1.7"}, + {:cloudi_service_map_reduce, "~> 1.7"}, + {:cloudi_service_api_requests, "~> 1.7"}, + {:cloudi_service_router, "~> 1.7"}, + {:cloudi_service_request_rate, "~> 1.7"}, {:concuerror, "~> 0.20.0"}, {:cowboy, "~> 2.6.1"}, {:ecto, "~> 3.0.6"}, diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index c971e8844d..9f8d63baa1 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -129,9 +129,10 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native +else +ERL_COMPILE_FLAGS += -Werror endif ERL_COMPILE_FLAGS += +inline +warn_unused_import \ - -Werror \ -I../../stdlib/include -I$(EGEN) -W +warn_missing_spec # ---------------------------------------------------- diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index ab8caa1a0d..4fba3fa1c6 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1595,8 +1595,11 @@ infer_types(_, #vst{}) -> infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> fun({atom,true}, S) -> - Infer = infer_types(RHS, S), - Infer(LHS, S); + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, S), + Infer_R = infer_types(LHS, S), + Infer_R(RHS, Infer_L(LHS, S)); (_, S) -> S end; infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> @@ -1772,8 +1775,11 @@ update_ne_types(LHS, RHS, Vst) -> end. update_eq_types(LHS, RHS, Vst0) -> - Infer = infer_types(LHS, Vst0), - Vst1 = Infer(RHS, Vst0), + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, Vst0), + Infer_R = infer_types(LHS, Vst0), + Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), T1 = get_term_type(LHS, Vst1), T2 = get_term_type(RHS, Vst1), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 11dea9524b..28db8986ff 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -290,6 +290,10 @@ format_error(bad_crypto_key) -> "invalid crypto key."; format_error(no_crypto_key) -> "no crypto key supplied."; +format_error({unimplemented_instruction,Instruction}) -> + io_lib:fwrite("native-code compilation failed because of an " + "unimplemented instruction (~s).", + [Instruction]); format_error({native, E}) -> io_lib:fwrite("native-code compilation failed with reason: ~tP.", [E, 25]); @@ -1651,18 +1655,22 @@ native_compile_1(Code, St) -> case IgnoreErrors of true -> Ws = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> Es = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end catch + exit:{unimplemented_instruction,_}=Unimplemented -> + Ws = [{St#compile.ifile, + [{none,?MODULE,Unimplemented}]}], + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; Class:R:Stack -> case IgnoreErrors of true -> Ws = [{St#compile.ifile, [{none,?MODULE,{native_crash,R,Stack}}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> erlang:raise(Class, R, Stack) end diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 8b39fce479..de5a3c2873 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -34,7 +34,8 @@ undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, - receive_stacked/1,aliased_types/1,type_conflict/1]). + receive_stacked/1,aliased_types/1,type_conflict/1, + infer_on_eq/1]). -include_lib("common_test/include/ct.hrl"). @@ -63,7 +64,8 @@ groups() -> undef_label,illegal_instruction,failing_gc_guard_bif, map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, - receive_stacked,aliased_types,type_conflict]}]. + receive_stacked,aliased_types,type_conflict, + infer_on_eq]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -651,6 +653,32 @@ type_conflict_1(C) -> end, {C#r.e1, TRes}. +%% ERL-886; validation failed to infer types on both sides of '=:=' + +infer_on_eq(Config) when is_list(Config) -> + {ok, gurka} = infer_on_eq_1(id({gurka})), + {ok, gaffel} = infer_on_eq_2(id({gaffel})), + {ok, elefant} = infer_on_eq_3(id({elefant})), + {ok, myra} = infer_on_eq_4(id({myra})), + ok. + +infer_on_eq_1(T) -> + 1 = erlang:tuple_size(T), + {ok, erlang:element(1, T)}. + +infer_on_eq_2(T) -> + Size = erlang:tuple_size(T), + Size = 1, + {ok, erlang:element(1, T)}. + +infer_on_eq_3(T) -> + true = 1 =:= erlang:tuple_size(T), + {ok, erlang:element(1, T)}. + +infer_on_eq_4(T) -> + true = erlang:tuple_size(T) =:= 1, + {ok, erlang:element(1, T)}. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index e1e7f71538..b6a65d7488 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -77,9 +77,7 @@ CRYPTO_OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o \ $(OBJDIR)/algorithms$(TYPEMARKER).o \ $(OBJDIR)/api_ng$(TYPEMARKER).o \ $(OBJDIR)/atoms$(TYPEMARKER).o \ - $(OBJDIR)/block$(TYPEMARKER).o \ $(OBJDIR)/bn$(TYPEMARKER).o \ - $(OBJDIR)/chacha20$(TYPEMARKER).o \ $(OBJDIR)/cipher$(TYPEMARKER).o \ $(OBJDIR)/cmac$(TYPEMARKER).o \ $(OBJDIR)/dh$(TYPEMARKER).o \ @@ -98,7 +96,6 @@ CRYPTO_OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o \ $(OBJDIR)/pkey$(TYPEMARKER).o \ $(OBJDIR)/poly1305$(TYPEMARKER).o \ $(OBJDIR)/rand$(TYPEMARKER).o \ - $(OBJDIR)/rc4$(TYPEMARKER).o \ $(OBJDIR)/rsa$(TYPEMARKER).o \ $(OBJDIR)/srp$(TYPEMARKER).o CALLBACK_OBJS = $(OBJDIR)/crypto_callback$(TYPEMARKER).o diff --git a/lib/crypto/c_src/aes.c b/lib/crypto/c_src/aes.c index ee2bb70fb7..4b01e629f9 100644 --- a/lib/crypto/c_src/aes.c +++ b/lib/crypto/c_src/aes.c @@ -166,156 +166,7 @@ ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv } -#ifdef HAVE_EVP_AES_CTR -ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec) */ - ErlNifBinary key_bin, ivec_bin; - struct evp_cipher_ctx *ctx = NULL; - const EVP_CIPHER *cipher; - ERL_NIF_TERM ret; - - ASSERT(argc == 2); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) - goto bad_arg; - if (!enif_inspect_binary(env, argv[1], &ivec_bin)) - goto bad_arg; - if (ivec_bin.size != 16) - goto bad_arg; - - switch (key_bin.size) - { - case 16: - cipher = EVP_aes_128_ctr(); - break; - case 24: - cipher = EVP_aes_192_ctr(); - break; - case 32: - cipher = EVP_aes_256_ctr(); - break; - default: - goto bad_arg; - } - - if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL, - key_bin.data, ivec_bin.data, 1) != 1) - goto err; - - if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1) - goto err; - - ret = enif_make_resource(env, ctx); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (ctx) - enif_release_resource(ctx); - return ret; -} - -ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL; - ErlNifBinary data_bin; - ERL_NIF_TERM ret, cipher_term; - unsigned char *out; - int outl = 0; - - ASSERT(argc == 2); - - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) - goto bad_arg; - if (data_bin.size > INT_MAX) - goto bad_arg; - - if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) - goto err; - - if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL) - goto err; - - if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1) - goto err; - ASSERT(outl >= 0 && (size_t)outl == data_bin.size); - - ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); - CONSUME_REDS(env,data_bin); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (new_ctx) - enif_release_resource(new_ctx); - return ret; -} - -#else /* if not HAVE_EVP_AES_CTR */ - -ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec) */ - ASSERT(argc == 2); - - return aes_ctr_stream_init_compat(env, argv[0], argv[1]); -} - - -ERL_NIF_TERM aes_ctr_stream_init_compat(ErlNifEnv* env, const ERL_NIF_TERM key_term, const ERL_NIF_TERM iv_term) -{ - ErlNifBinary key_bin, ivec_bin; - ERL_NIF_TERM ecount_bin; - unsigned char *outp; - - if (!enif_inspect_iolist_as_binary(env, key_term, &key_bin)) - goto bad_arg; - if (key_bin.size != 16 && key_bin.size != 24 && key_bin.size != 32) - goto bad_arg; - if (!enif_inspect_binary(env, iv_term, &ivec_bin)) - goto bad_arg; - if (ivec_bin.size != 16) - goto bad_arg; - if ((outp = enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin)) == NULL) - goto err; - memset(outp, 0, AES_BLOCK_SIZE); - - return enif_make_tuple4(env, key_term, iv_term, ecount_bin, enif_make_int(env, 0)); - - bad_arg: - err: - return enif_make_badarg(env); -} - -ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{ - ASSERT(argc == 2); - - return aes_ctr_stream_encrypt_compat(env, argv[0], argv[1]); -} - - +#if !defined(HAVE_EVP_AES_CTR) ERL_NIF_TERM aes_ctr_stream_encrypt_compat(ErlNifEnv* env, const ERL_NIF_TERM state_arg, const ERL_NIF_TERM data_arg) {/* ({Key, IVec, ECount, Num}, Data) */ ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin; diff --git a/lib/crypto/c_src/aes.h b/lib/crypto/c_src/aes.h index 527d041410..c0b2b91f8d 100644 --- a/lib/crypto/c_src/aes.h +++ b/lib/crypto/c_src/aes.h @@ -27,10 +27,7 @@ ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #if !defined(HAVE_EVP_AES_CTR) -ERL_NIF_TERM aes_ctr_stream_init_compat(ErlNifEnv* env, const ERL_NIF_TERM key_term, const ERL_NIF_TERM iv_term); ERL_NIF_TERM aes_ctr_stream_encrypt_compat(ErlNifEnv* env, const ERL_NIF_TERM state_arg, const ERL_NIF_TERM data_arg); #endif diff --git a/lib/crypto/c_src/algorithms.c b/lib/crypto/c_src/algorithms.c index 06cd109fc1..1d45ed9df2 100644 --- a/lib/crypto/c_src/algorithms.c +++ b/lib/crypto/c_src/algorithms.c @@ -68,9 +68,15 @@ void init_algorithms_types(ErlNifEnv* env) // Non-validated algorithms follow algo_hash_fips_cnt = algo_hash_cnt; +#ifdef HAVE_MD4 algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md4"); +#endif +#ifdef HAVE_MD5 algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md5"); +#endif +#ifdef HAVE_RIPEMD160 algo_hash[algo_hash_cnt++] = enif_make_atom(env, "ripemd160"); +#endif algo_pubkey_cnt = 0; algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "rsa"); diff --git a/lib/crypto/c_src/api_ng.c b/lib/crypto/c_src/api_ng.c index c4114d1626..f4312114ed 100644 --- a/lib/crypto/c_src/api_ng.c +++ b/lib/crypto/c_src/api_ng.c @@ -25,199 +25,533 @@ /* * A unified set of functions for encryption/decryption. * - * EXPERIMENTAL!! - * */ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -/* Try better error messages in new functions */ -#define ERROR_Term(Env, ReasonTerm) enif_make_tuple2((Env), atom_error, (ReasonTerm)) -#define ERROR_Str(Env, ReasonString) ERROR_Term((Env), enif_make_string((Env),(ReasonString),(ERL_NIF_LATIN1))) +/* All nif functions return a valid value or throws an exception */ +#define EXCP(Env, Class, Str) enif_raise_exception((Env), \ + enif_make_tuple2((Env), (Class), \ + enif_make_string((Env),(Str),(ERL_NIF_LATIN1)) )) -/* Initializes state for (de)encryption - */ -ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Cipher, Key, IVec, Encrypt) % if no IV for the Cipher, set IVec = <<>> - */ - ErlNifBinary key_bin, ivec_bin; - unsigned char *iv = NULL; - struct evp_cipher_ctx *ctx; - const struct cipher_type_t *cipherp; - const EVP_CIPHER *cipher; - ERL_NIF_TERM enc_flg_arg, ret; - int enc; - unsigned iv_len; - - enc_flg_arg = argv[argc-1]; - if (enc_flg_arg == atom_true) - enc = 1; - else if (enc_flg_arg == atom_false) - enc = 0; - else if (enc_flg_arg == atom_undefined) +#define EXCP_NOTSUP(Env, Str) EXCP((Env), atom_notsup, (Str)) +#define EXCP_BADARG(Env, Str) EXCP((Env), atom_badarg, (Str)) +#define EXCP_ERROR(Env, Str) EXCP((Env), atom_error, (Str)) + + +#ifdef HAVE_ECB_IVEC_BUG + /* <= 0.9.8l returns faulty ivec length */ +# define GET_IV_LEN(Ciph) ((Ciph)->flags & ECB_BUG_0_9_8L) ? 0 : EVP_CIPHER_iv_length((Ciph)->cipher.p) +#else +# define GET_IV_LEN(Ciph) EVP_CIPHER_iv_length((Ciph)->cipher.p) +#endif + +/*************************************************************************/ +/* Get the arguments for the initialization of the EVP_CIPHER_CTX. Check */ +/* them and initialize that context. */ +/*************************************************************************/ +static int get_init_args(ErlNifEnv* env, + struct evp_cipher_ctx *ctx_res, + const ERL_NIF_TERM cipher_arg, + const ERL_NIF_TERM key_arg, + const ERL_NIF_TERM ivec_arg, + const ERL_NIF_TERM encflg_arg, + const struct cipher_type_t **cipherp, + ERL_NIF_TERM *return_term) +{ + int ivec_len; + ErlNifBinary key_bin; + ErlNifBinary ivec_bin; + int encflg; + + ctx_res->ctx = NULL; /* For testing if *ctx should be freed after errors */ + + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ + if (encflg_arg == atom_true) + encflg = 1; + else if (encflg_arg == atom_false) + encflg = 0; + else if (encflg_arg == atom_undefined) /* For compat funcs in crypto.erl */ - enc = -1; + encflg = -1; else - return ERROR_Str(env, "Bad enc flag"); + { + *return_term = EXCP_BADARG(env, "Bad enc flag"); + goto err; + } - if (!enif_inspect_binary(env, argv[1], &key_bin)) - return ERROR_Str(env, "Bad key"); + /* Fetch the key */ + if (!enif_inspect_iolist_as_binary(env, key_arg, &key_bin)) + { + *return_term = EXCP_BADARG(env, "Bad key"); + goto err; + } - if (!(cipherp = get_cipher_type(argv[0], key_bin.size))) - return ERROR_Str(env, "Unknown cipher or bad key size"); + /* Fetch cipher type */ + if (!enif_is_atom(env, cipher_arg)) + { + *return_term = EXCP_BADARG(env, "Cipher id is not an atom"); + goto err; + } - if (FORBIDDEN_IN_FIPS(cipherp)) - return enif_raise_exception(env, atom_notsup); + if (!(*cipherp = get_cipher_type(cipher_arg, key_bin.size))) + { + if (!get_cipher_type_no_key(cipher_arg)) + *return_term = EXCP_BADARG(env, "Unknown cipher"); + else + *return_term = EXCP_BADARG(env, "Bad key size"); + goto err; + } - if (enc == -1) - return atom_undefined; + if (FORBIDDEN_IN_FIPS(*cipherp)) + { + *return_term = EXCP_NOTSUP(env, "Forbidden in FIPS"); + goto err; + } - if (!(cipher = cipherp->cipher.p)) { + /* Get ivec_len for this cipher (if we found one) */ #if !defined(HAVE_EVP_AES_CTR) - if (cipherp->flags & AES_CTR_COMPAT) - return aes_ctr_stream_init_compat(env, argv[1], argv[2]); - else + /* This code is for historic OpenSSL where EVP_aes_*_ctr is not defined.... */ + if ((*cipherp)->cipher.p) { + /* Not aes_ctr compatibility code since EVP_* + was defined and assigned to (*cipherp)->cipher.p */ + ivec_len = GET_IV_LEN(*cipherp); + } else { + /* No EVP_* was found */ + if ((*cipherp)->flags & AES_CTR_COMPAT) + /* Use aes_ctr compatibility code later */ + ivec_len = 16; + else { + /* Unsupported crypto */ + *return_term = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); + goto err; + } + } +#else + /* Normal code */ + if (!((*cipherp)->cipher.p)) { + *return_term = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); + goto err; + } + ivec_len = GET_IV_LEN(*cipherp); #endif - return enif_raise_exception(env, atom_notsup); + + /* (*cipherp)->cipher.p != NULL and ivec_len has a value */ + + /* Fetch IV */ + if (ivec_len && (ivec_arg != atom_undefined)) { + if (!enif_inspect_iolist_as_binary(env, ivec_arg, &ivec_bin)) + { + *return_term = EXCP_BADARG(env, "Bad iv type"); + goto err; + } + + if (ivec_len != ivec_bin.size) + { + *return_term = EXCP_BADARG(env, "Bad iv size"); + goto err; + } } -#ifdef HAVE_ECB_IVEC_BUG - if (cipherp->flags & ECB_BUG_0_9_8L) - iv_len = 0; /* <= 0.9.8l returns faulty ivec length */ - else + ctx_res->iv_len = ivec_len; + +#if !defined(HAVE_EVP_AES_CTR) + if (!((*cipherp)->cipher.p) + && ((*cipherp)->flags & AES_CTR_COMPAT) + ) { + /* Must use aes_ctr compatibility code */ + ERL_NIF_TERM ecount_bin; + unsigned char *outp; + if ((outp = enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin)) == NULL) { + *return_term = EXCP_ERROR(env, "Can't allocate ecount_bin"); + goto err; + } + memset(outp, 0, AES_BLOCK_SIZE); + + ctx_res->env = enif_alloc_env(); + if (!ctx_res->env) { + *return_term = EXCP_ERROR(env, "Can't allocate env"); + goto err; + } + ctx_res->state = + enif_make_copy(ctx_res->env, + enif_make_tuple4(env, key_arg, ivec_arg, ecount_bin, enif_make_int(env, 0))); + goto success; + } else { + /* Flag for subsequent calls that no aes_ctr compatibility code should be called */ + ctx_res->state = atom_undefined; + ctx_res->env = NULL; + } #endif - iv_len = EVP_CIPHER_iv_length(cipher); - if (iv_len) { - if (!enif_inspect_binary(env, argv[2], &ivec_bin)) - return ERROR_Str(env, "Bad iv type"); + /* Initialize the EVP_CIPHER_CTX */ + + ctx_res->ctx = EVP_CIPHER_CTX_new(); + if (! ctx_res->ctx) + { + *return_term = EXCP_ERROR(env, "Can't allocate context"); + goto err; + } - if (iv_len != ivec_bin.size) - return ERROR_Str(env, "Bad iv size"); + if (!EVP_CipherInit_ex(ctx_res->ctx, (*cipherp)->cipher.p, NULL, NULL, NULL, encflg)) + { + *return_term = EXCP_ERROR(env, "Can't initialize context, step 1"); + goto err; + } + + if (!EVP_CIPHER_CTX_set_key_length(ctx_res->ctx, (int)key_bin.size)) + { + *return_term = EXCP_ERROR(env, "Can't initialize context, key_length"); + goto err; + } - iv = ivec_bin.data; +#ifdef HAVE_RC2 + if (EVP_CIPHER_type((*cipherp)->cipher.p) == NID_rc2_cbc) { + if (key_bin.size > INT_MAX / 8) { + *return_term = EXCP_BADARG(env, "To large rc2_cbc key"); + goto err; + } + if (!EVP_CIPHER_CTX_ctrl(ctx_res->ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key_bin.size * 8, NULL)) { + *return_term = EXCP_ERROR(env, "ctrl rc2_cbc key"); + goto err; + } } +#endif + + if (ivec_arg == atom_undefined || ivec_len == 0) + { + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, key_bin.data, NULL, -1)) { + *return_term = EXCP_ERROR(env, "Can't initialize key"); + goto err; + } + } + else + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, key_bin.data, ivec_bin.data, -1)) + { + *return_term = EXCP_ERROR(env, "Can't initialize key or iv"); + goto err; + } - if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - return ERROR_Str(env, "Can't allocate resource"); + EVP_CIPHER_CTX_set_padding(ctx_res->ctx, 0); - ctx->ctx = EVP_CIPHER_CTX_new(); - if (! ctx->ctx) - return ERROR_Str(env, "Can't allocate context"); + *return_term = atom_ok; - if (!EVP_CipherInit_ex(ctx->ctx, cipher, NULL, NULL, NULL, enc)) { - enif_release_resource(ctx); - return ERROR_Str(env, "Can't initialize context, step 1"); - } +#if !defined(HAVE_EVP_AES_CTR) + success: +#endif + return 1; - if (!EVP_CIPHER_CTX_set_key_length(ctx->ctx, (int)key_bin.size)) { - enif_release_resource(ctx); - return ERROR_Str(env, "Can't initialize context, key_length"); - } + err: + if (ctx_res->ctx) EVP_CIPHER_CTX_free(ctx_res->ctx); + return 0; +} - if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) { - if (key_bin.size > INT_MAX / 8) { - enif_release_resource(ctx); - return ERROR_Str(env, "To large rc2_cbc key"); +/*************************************************************************/ +/* Get the arguments for the EVP_CipherUpdate function, and call it. */ +/*************************************************************************/ + +static int get_update_args(ErlNifEnv* env, + struct evp_cipher_ctx *ctx_res, + const ERL_NIF_TERM indata_arg, + ERL_NIF_TERM *return_term) +{ + ErlNifBinary in_data_bin, out_data_bin; + int out_len, block_size; + + if (!enif_inspect_binary(env, indata_arg, &in_data_bin) ) + { + *return_term = EXCP_BADARG(env, "Bad 2:nd arg"); + goto err; } - if (!EVP_CIPHER_CTX_ctrl(ctx->ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key_bin.size * 8, NULL)) { - enif_release_resource(ctx); - return ERROR_Str(env, "ctrl rc2_cbc key"); + + ASSERT(in_data_bin.size <= INT_MAX); + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res->state != atom_undefined) { + ERL_NIF_TERM state0, newstate_and_outdata; + const ERL_NIF_TERM *tuple_argv; + int tuple_argc; + + state0 = enif_make_copy(env, ctx_res->state); + + if (enif_get_tuple(env, state0, &tuple_argc, &tuple_argv) && (tuple_argc == 4)) { + /* A compatibility state term */ + /* encrypt and decrypt is performed by calling the same function */ + newstate_and_outdata = aes_ctr_stream_encrypt_compat(env, state0, indata_arg); + + if (enif_get_tuple(env, newstate_and_outdata, &tuple_argc, &tuple_argv) && (tuple_argc == 2)) { + /* newstate_and_outdata = {NewState, OutData} */ + ctx_res->state = enif_make_copy(ctx_res->env, tuple_argv[0]); + /* Return the OutData (from the newstate_and_outdata tuple) only: */ + *return_term = tuple_argv[1]; + } } + } else +#endif + { + block_size = EVP_CIPHER_CTX_block_size(ctx_res->ctx); + + if (!enif_alloc_binary((size_t)in_data_bin.size+block_size, &out_data_bin)) + { + *return_term = EXCP_ERROR(env, "Can't allocate outdata"); + goto err; + } + + if (!EVP_CipherUpdate(ctx_res->ctx, out_data_bin.data, &out_len, in_data_bin.data, in_data_bin.size)) + { + *return_term = EXCP_ERROR(env, "Can't update"); + goto err; + } + + if (!enif_realloc_binary(&out_data_bin, (size_t)out_len)) + { + *return_term = EXCP_ERROR(env, "Can't reallocate"); + goto err; + } + + CONSUME_REDS(env, in_data_bin); + /* return the result text as a binary: */ + *return_term = enif_make_binary(env, &out_data_bin); } - if (!EVP_CipherInit_ex(ctx->ctx, NULL, NULL, key_bin.data, iv, enc)) { - enif_release_resource(ctx); - return ERROR_Str(env, "Can't initialize key and/or iv"); - } + /* success: */ + return 1; - EVP_CIPHER_CTX_set_padding(ctx->ctx, 0); + err: + return 0; +} - ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); +/*************************************************************************/ +/* Initialize the state for (de/en)cryption */ +/*************************************************************************/ + +ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Cipher, Key, IVec, Encrypt) % if no IV for the Cipher, set IVec = <<>> + */ + struct evp_cipher_ctx *ctx_res = NULL; + const struct cipher_type_t *cipherp; + ERL_NIF_TERM ret; + int encflg; + + if (enif_is_atom(env, argv[0])) { + if ((ctx_res = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) + return EXCP_ERROR(env, "Can't allocate resource"); + + if (!get_init_args(env, ctx_res, argv[0], argv[1], argv[2], argv[argc-1], + &cipherp, &ret)) + /* Error msg in &ret */ + goto ret; + + ret = enif_make_resource(env, ctx_res); + if(ctx_res) enif_release_resource(ctx_res); + + } else if (enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) { + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ + if (argv[3] == atom_true) + encflg = 1; + else if (argv[3] == atom_false) + encflg = 0; + else { + ret = EXCP_BADARG(env, "Bad enc flag"); + goto ret; + } + if (ctx_res->ctx) { + /* It is *not* a ctx_res for the compatibility handling of non-EVP aes_ctr */ + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, NULL, NULL, encflg)) { + ret = EXCP_ERROR(env, "Can't initialize encflag"); + goto ret; + } + } + ret = argv[0]; + } else { + ret = EXCP_BADARG(env, "Bad 1:st arg"); + goto ret; + } + + ret: return ret; } -ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) - (Context, Data, IV) */ - struct evp_cipher_ctx *ctx; - ErlNifBinary in_data_bin, ivec_bin, out_data_bin; - int out_len, block_size; -#if !defined(HAVE_EVP_AES_CTR) - const ERL_NIF_TERM *state_term; - int state_arity; +/*************************************************************************/ +/* Encrypt/decrypt */ +/*************************************************************************/ - if (enif_get_tuple(env, argv[0], &state_arity, &state_term) && (state_arity == 4)) { - return aes_ctr_stream_encrypt_compat(env, argv[0], argv[1]); - } +#if !defined(HAVE_EVP_CIPHER_CTX_COPY) +/* + The EVP_CIPHER_CTX_copy is not available in older cryptolibs although + the function is needed. + Instead of implement it in-place, we have a copy here as a compatibility + function +*/ + +int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in); + +int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in) +{ + if ((in == NULL) || (in->cipher == NULL)) + { + return 0; + } +#ifdef HAS_ENGINE_SUPPORT + /* Make sure it's safe to copy a cipher context using an ENGINE */ + if (in->engine && !ENGINE_init(in->engine)) + return 0; #endif - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) - return ERROR_Str(env, "Bad 1:st arg"); - - if (!enif_inspect_binary(env, argv[1], &in_data_bin) ) - return ERROR_Str(env, "Bad 2:nd arg"); + EVP_CIPHER_CTX_cleanup(out); + memcpy(out,in,sizeof *out); - /* arg[1] was checked by the caller */ - ASSERT(in_data_bin.size =< INT_MAX); + if (in->cipher_data && in->cipher->ctx_size) + { + out->cipher_data=OPENSSL_malloc(in->cipher->ctx_size); + if (!out->cipher_data) + return 0; + memcpy(out->cipher_data,in->cipher_data,in->cipher->ctx_size); + } - block_size = EVP_CIPHER_CTX_block_size(ctx->ctx); - if (in_data_bin.size % (size_t)block_size != 0) - return ERROR_Str(env, "Data not a multiple of block size"); +#if defined(EVP_CIPH_CUSTOM_COPY) && defined(EVP_CTRL_COPY) + if (in->cipher->flags & EVP_CIPH_CUSTOM_COPY) + return in->cipher->ctrl((EVP_CIPHER_CTX *)in, EVP_CTRL_COPY, 0, out); +#endif + return 1; +} +/****** End of compatibility function ******/ +#endif - if (argc==3) { - if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec_bin)) - return ERROR_Str(env, "Not binary IV"); - - if (ivec_bin.size > INT_MAX) - return ERROR_Str(env, "Too big IV"); - - if (!EVP_CipherInit_ex(ctx->ctx, NULL, NULL, NULL, ivec_bin.data, -1)) - return ERROR_Str(env, "Can't set IV"); - } - if (!enif_alloc_binary((size_t)in_data_bin.size+block_size, &out_data_bin)) - return ERROR_Str(env, "Can't allocate outdata"); +ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data [, IV]) */ + struct evp_cipher_ctx *ctx_res; + ERL_NIF_TERM ret; + + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) + return EXCP_BADARG(env, "Bad 1:st arg"); + + if (argc == 3) { + struct evp_cipher_ctx ctx_res_copy; + ErlNifBinary ivec_bin; - if (!EVP_CipherUpdate(ctx->ctx, out_data_bin.data, &out_len, in_data_bin.data, in_data_bin.size)) - return ERROR_Str(env, "Can't update"); + memcpy(&ctx_res_copy, ctx_res, sizeof ctx_res_copy); +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res_copy.state == atom_undefined) + /* Not going to use aes_ctr compat functions */ +#endif + { + ctx_res_copy.ctx = EVP_CIPHER_CTX_new(); - if (!enif_realloc_binary(&out_data_bin, (size_t)out_len)) - return ERROR_Str(env, "Can't reallocate"); + if (!EVP_CIPHER_CTX_copy(ctx_res_copy.ctx, ctx_res->ctx)) { + ret = EXCP_ERROR(env, "Can't copy ctx_res"); + goto err; + } + } - CONSUME_REDS(env, in_data_bin); - return enif_make_binary(env, &out_data_bin); + ctx_res = &ctx_res_copy; + + if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec_bin)) + { + ret = EXCP_BADARG(env, "Bad iv type"); + goto err; + } + + if (ctx_res_copy.iv_len != ivec_bin.size) + { + ret = EXCP_BADARG(env, "Bad iv size"); + goto err; + } + +#if !defined(HAVE_EVP_AES_CTR) + if ((ctx_res_copy.state != atom_undefined) ) { + /* replace the iv in state with argv[2] */ + ERL_NIF_TERM state0; + const ERL_NIF_TERM *tuple_argv; + int tuple_argc; + state0 = enif_make_copy(env, ctx_res_copy.state); + if (enif_get_tuple(env, state0, &tuple_argc, &tuple_argv) && (tuple_argc == 4)) { + /* A compatibility state term */ + ctx_res_copy.state = enif_make_tuple4(env, tuple_argv[0], argv[2], tuple_argv[2], tuple_argv[3]); + } + } else +#endif + if (!EVP_CipherInit_ex(ctx_res_copy.ctx, NULL, NULL, NULL, ivec_bin.data, -1)) + { + ret = EXCP_ERROR(env, "Can't set iv"); + goto err; + } + + get_update_args(env, &ctx_res_copy, argv[1], &ret); + } else + get_update_args(env, ctx_res, argv[1], &ret); + + err: + return ret; /* Both success and error */ } ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) - (Context, Data, IV) */ - int i; +{/* (Context, Data [, IV]) */ ErlNifBinary data_bin; - ERL_NIF_TERM new_argv[3]; - ASSERT(argc =< 3); + ASSERT(argc <= 3); - if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) - return ERROR_Str(env, "iodata expected as data"); + if (!enif_inspect_binary(env, argv[1], &data_bin)) + return EXCP_BADARG(env, "expected binary as data"); if (data_bin.size > INT_MAX) - return ERROR_Str(env, "to long data"); - - for (i=0; i<argc; i++) new_argv[i] = argv[i]; - new_argv[1] = enif_make_binary(env, &data_bin); + return EXCP_BADARG(env, "to long data"); /* Run long jobs on a dirty scheduler to not block the current emulator thread */ if (data_bin.size > MAX_BYTES_TO_NIF) { return enif_schedule_nif(env, "ng_crypto_update", ERL_NIF_DIRTY_JOB_CPU_BOUND, - ng_crypto_update, argc, new_argv); + ng_crypto_update, argc, argv); } - return ng_crypto_update(env, argc, new_argv); + return ng_crypto_update(env, argc, argv); +} + +/*************************************************************************/ +/* One shot */ +/*************************************************************************/ + +ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Cipher, Key, IVec, Data, Encrypt) */ + struct evp_cipher_ctx ctx_res; + const struct cipher_type_t *cipherp; + ERL_NIF_TERM ret; + + if (!get_init_args(env, &ctx_res, argv[0], argv[1], argv[2], argv[4], &cipherp, &ret)) + goto ret; + + get_update_args(env, &ctx_res, argv[3], &ret); + + ret: + if (ctx_res.ctx) + EVP_CIPHER_CTX_free(ctx_res.ctx); + return ret; } +ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Cipher, Key, IVec, Data, Encrypt) % if no IV for the Cipher, set IVec = <<>> + */ + ErlNifBinary data_bin; + + ASSERT(argc == 5); + + if (!enif_inspect_binary(env, argv[3], &data_bin)) + return EXCP_BADARG(env, "expected binary as data"); + + if (data_bin.size > INT_MAX) + return EXCP_BADARG(env, "to long data"); + + /* Run long jobs on a dirty scheduler to not block the current emulator thread */ + if (data_bin.size > MAX_BYTES_TO_NIF) { + return enif_schedule_nif(env, "ng_crypto_one_shot", + ERL_NIF_DIRTY_JOB_CPU_BOUND, + ng_crypto_one_shot, argc, argv); + } + + return ng_crypto_one_shot(env, argc, argv); +} diff --git a/lib/crypto/c_src/api_ng.h b/lib/crypto/c_src/api_ng.h index a3b40fe7fc..5c7d9af3c5 100644 --- a/lib/crypto/c_src/api_ng.h +++ b/lib/crypto/c_src/api_ng.h @@ -25,5 +25,6 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AES_H__ */ diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c index 798c26c9bb..114e3c1985 100644 --- a/lib/crypto/c_src/atoms.c +++ b/lib/crypto/c_src/atoms.c @@ -33,6 +33,7 @@ ERL_NIF_TERM atom_undefined; ERL_NIF_TERM atom_ok; ERL_NIF_TERM atom_none; ERL_NIF_TERM atom_notsup; +ERL_NIF_TERM atom_badarg; ERL_NIF_TERM atom_digest; #ifdef FIPS_SUPPORT ERL_NIF_TERM atom_enabled; @@ -150,6 +151,7 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM atom_ok = enif_make_atom(env,"ok"); atom_none = enif_make_atom(env,"none"); atom_notsup = enif_make_atom(env,"notsup"); + atom_badarg = enif_make_atom(env,"badarg"); atom_digest = enif_make_atom(env,"digest"); atom_type = enif_make_atom(env,"type"); diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h index f8e9211459..fc46d838aa 100644 --- a/lib/crypto/c_src/atoms.h +++ b/lib/crypto/c_src/atoms.h @@ -37,6 +37,7 @@ extern ERL_NIF_TERM atom_undefined; extern ERL_NIF_TERM atom_ok; extern ERL_NIF_TERM atom_none; extern ERL_NIF_TERM atom_notsup; +extern ERL_NIF_TERM atom_badarg; extern ERL_NIF_TERM atom_digest; #ifdef FIPS_SUPPORT extern ERL_NIF_TERM atom_enabled; diff --git a/lib/crypto/c_src/block.c b/lib/crypto/c_src/block.c deleted file mode 100644 index 0a4fd72623..0000000000 --- a/lib/crypto/c_src/block.c +++ /dev/null @@ -1,149 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-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% - */ - -#include "block.h" -#include "aes.h" -#include "cipher.h" - -ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */ - const struct cipher_type_t *cipherp; - const EVP_CIPHER *cipher; - ErlNifBinary key, ivec, text; - EVP_CIPHER_CTX *ctx = NULL; - ERL_NIF_TERM ret; - unsigned char *out; - int ivec_size, out_size = 0; - int cipher_len; - - ASSERT(argc == 4 || argc == 5); - - if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) - goto bad_arg; - if (key.size > INT_MAX) - goto bad_arg; - if ((cipherp = get_cipher_type(argv[0], key.size)) == NULL) - goto bad_arg; - if (cipherp->flags & (NON_EVP_CIPHER | AEAD_CIPHER)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) - goto bad_arg; - if (text.size > INT_MAX) - goto bad_arg; - - if (FORBIDDEN_IN_FIPS(cipherp)) - return enif_raise_exception(env, atom_notsup); - if ((cipher = cipherp->cipher.p) == NULL) - return enif_raise_exception(env, atom_notsup); - - if (cipherp->flags & AES_CFBx) { - if (argv[0] == atom_aes_cfb8 - && (key.size == 24 || key.size == 32)) { - /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? - * Fall back on low level API - */ - return aes_cfb_8_crypt(env, argc-1, argv+1); - } - else if (argv[0] == atom_aes_cfb128 - && (key.size == 24 || key.size == 32)) { - /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? - * Fall back on low level API - */ - return aes_cfb_128_crypt_nif(env, argc-1, argv+1); - } - } - - ivec_size = EVP_CIPHER_iv_length(cipher); - -#ifdef HAVE_ECB_IVEC_BUG - if (cipherp->flags & ECB_BUG_0_9_8L) - ivec_size = 0; /* 0.9.8l returns faulty ivec_size */ -#endif - - if (ivec_size < 0) - goto bad_arg; - - if ((cipher_len = EVP_CIPHER_block_size(cipher)) < 0) - goto bad_arg; - if (text.size % (size_t)cipher_len != 0) - goto bad_arg; - - if (ivec_size == 0) { - if (argc != 4) - goto bad_arg; - } else { - if (argc != 5) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec)) - goto bad_arg; - if (ivec.size != (size_t)ivec_size) - goto bad_arg; - } - - if ((out = enif_make_new_binary(env, text.size, &ret)) == NULL) - goto err; - if ((ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (!EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL, - (argv[argc - 1] == atom_true))) - goto err; - if (!EVP_CIPHER_CTX_set_key_length(ctx, (int)key.size)) - goto err; - - if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) { - if (key.size > INT_MAX / 8) - goto err; - if (!EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key.size * 8, NULL)) - goto err; - } - - if (!EVP_CipherInit_ex(ctx, NULL, NULL, key.data, - ivec_size ? ivec.data : NULL, -1)) - goto err; - if (!EVP_CIPHER_CTX_set_padding(ctx, 0)) - goto err; - - /* OpenSSL 0.9.8h asserts text.size > 0 */ - if (text.size > 0) { - if (!EVP_CipherUpdate(ctx, out, &out_size, text.data, (int)text.size)) - goto err; - if (ASSERT(out_size == text.size), 0) - goto err; - if (!EVP_CipherFinal_ex(ctx, out + out_size, &out_size)) - goto err; - } - - ASSERT(out_size == 0); - CONSUME_REDS(env, text); - goto done; - - bad_arg: - ret = enif_make_badarg(env); - goto done; - - err: - ret = enif_raise_exception(env, atom_notsup); - - done: - if (ctx) - EVP_CIPHER_CTX_free(ctx); - return ret; -} diff --git a/lib/crypto/c_src/block.h b/lib/crypto/c_src/block.h deleted file mode 100644 index cc5e78ce12..0000000000 --- a/lib/crypto/c_src/block.h +++ /dev/null @@ -1,28 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-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% - */ - -#ifndef E_BLOCK_H__ -#define E_BLOCK_H__ 1 - -#include "common.h" - -ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); - -#endif /* E_BLOCK_H__ */ diff --git a/lib/crypto/c_src/chacha20.c b/lib/crypto/c_src/chacha20.c deleted file mode 100644 index cfcc395dca..0000000000 --- a/lib/crypto/c_src/chacha20.c +++ /dev/null @@ -1,124 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-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% - */ - -#include "chacha20.h" -#include "cipher.h" - -ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IV) */ -#if defined(HAVE_CHACHA20) - ErlNifBinary key_bin, ivec_bin; - struct evp_cipher_ctx *ctx = NULL; - const EVP_CIPHER *cipher; - ERL_NIF_TERM ret; - - ASSERT(argc == 2); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) - goto bad_arg; - if (key_bin.size != 32) - goto bad_arg; - if (!enif_inspect_binary(env, argv[1], &ivec_bin)) - goto bad_arg; - if (ivec_bin.size != 16) - goto bad_arg; - - cipher = EVP_chacha20(); - - if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL, - key_bin.data, ivec_bin.data, 1) != 1) - goto err; - if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1) - goto err; - - ret = enif_make_resource(env, ctx); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (ctx) - enif_release_resource(ctx); - return ret; - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - -ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (State, Data) */ -#if defined(HAVE_CHACHA20) - struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL; - ErlNifBinary data_bin; - ERL_NIF_TERM ret, cipher_term; - unsigned char *out; - int outl = 0; - - ASSERT(argc == 2); - - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) - goto bad_arg; - if (data_bin.size > INT_MAX) - goto bad_arg; - - if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) - goto err; - if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL) - goto err; - if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1) - goto err; - ASSERT(outl >= 0 && (size_t)outl == data_bin.size); - - ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); - CONSUME_REDS(env, data_bin); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (new_ctx) - enif_release_resource(new_ctx); - return ret; - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} diff --git a/lib/crypto/c_src/chacha20.h b/lib/crypto/c_src/chacha20.h deleted file mode 100644 index 7e2ccae2bb..0000000000 --- a/lib/crypto/c_src/chacha20.h +++ /dev/null @@ -1,29 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-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% - */ - -#ifndef E_CHACHA20_H__ -#define E_CHACHA20_H__ 1 - -#include "common.h" - -ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); - -#endif /* E_CHACHA20_H__ */ diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c index c055a62654..9d60254a3c 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -28,12 +28,12 @@ static struct cipher_type_t cipher_types[] = { -#ifndef OPENSSL_NO_RC2 +#ifdef HAVE_RC2 {{"rc2_cbc"}, {&EVP_rc2_cbc}, 0, NO_FIPS_CIPHER}, #else {{"rc2_cbc"}, {NULL}, 0, NO_FIPS_CIPHER}, #endif -#ifndef OPENSSL_NO_RC4 +#ifdef HAVE_RC4 {{"rc4"}, {&EVP_rc4}, 0, NO_FIPS_CIPHER}, #else {{"rc4"}, {NULL}, 0, NO_FIPS_CIPHER}, @@ -98,7 +98,9 @@ static struct cipher_type_t cipher_types[] = {{"aes_128_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, {{"aes_192_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, {{"aes_256_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 0, AES_CTR_COMPAT}, + {{"aes_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, + {{"aes_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, + {{"aes_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, #endif #if defined(HAVE_CHACHA20) @@ -162,6 +164,11 @@ static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) { if (ctx->ctx) EVP_CIPHER_CTX_free(ctx->ctx); + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx->env) + enif_free_env(ctx->env); +#endif } int init_cipher_ctx(ErlNifEnv *env) { diff --git a/lib/crypto/c_src/cipher.h b/lib/crypto/c_src/cipher.h index b0d9d324e1..b94873940f 100644 --- a/lib/crypto/c_src/cipher.h +++ b/lib/crypto/c_src/cipher.h @@ -59,6 +59,11 @@ struct cipher_type_t { extern ErlNifResourceType* evp_cipher_ctx_rtype; struct evp_cipher_ctx { EVP_CIPHER_CTX* ctx; + int iv_len; +#if !defined(HAVE_EVP_AES_CTR) + ErlNifEnv* env; + ERL_NIF_TERM state; +#endif }; ERL_NIF_TERM cipher_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 261590d9a5..4aed06a489 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -29,9 +29,7 @@ #include "aes.h" #include "algorithms.h" #include "api_ng.h" -#include "block.h" #include "bn.h" -#include "chacha20.h" #include "cipher.h" #include "cmac.h" #include "dh.h" @@ -50,7 +48,6 @@ #include "pkey.h" #include "poly1305.h" #include "rand.h" -#include "rc4.h" #include "rsa.h" #include "srp.h" @@ -80,22 +77,16 @@ static ErlNifFunc nif_funcs[] = { {"hmac_final_nif", 2, hmac_final_nif, 0}, {"cmac_nif", 3, cmac_nif, 0}, {"cipher_info_nif", 1, cipher_info_nif, 0}, - {"block_crypt_nif", 5, block_crypt_nif, 0}, - {"block_crypt_nif", 4, block_crypt_nif, 0}, {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif, 0}, - {"aes_ctr_stream_init", 2, aes_ctr_stream_init, 0}, - {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt, 0}, - {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt, 0}, {"ng_crypto_init_nif", 4, ng_crypto_init_nif, 0}, {"ng_crypto_update_nif", 2, ng_crypto_update_nif, 0}, {"ng_crypto_update_nif", 3, ng_crypto_update_nif, 0}, + {"ng_crypto_one_shot_nif", 5, ng_crypto_one_shot_nif, 0}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0}, {"strong_rand_range_nif", 1, strong_rand_range_nif, 0}, {"rand_uniform_nif", 2, rand_uniform_nif, 0}, {"mod_exp_nif", 4, mod_exp_nif, 0}, {"do_exor", 2, do_exor, 0}, - {"rc4_set_key", 1, rc4_set_key, 0}, - {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state, 0}, {"pkey_sign_nif", 5, pkey_sign_nif, 0}, {"pkey_verify_nif", 6, pkey_verify_nif, 0}, {"pkey_crypt_nif", 6, pkey_crypt_nif, 0}, @@ -117,10 +108,6 @@ static ErlNifFunc nif_funcs[] = { {"aead_encrypt", 6, aead_encrypt, 0}, {"aead_decrypt", 6, aead_decrypt, 0}, - {"chacha20_stream_init", 2, chacha20_stream_init, 0}, - {"chacha20_stream_encrypt", 2, chacha20_stream_crypt, 0}, - {"chacha20_stream_decrypt", 2, chacha20_stream_crypt, 0}, - {"poly1305_nif", 2, poly1305_nif, 0}, {"engine_by_id_nif", 1, engine_by_id_nif, 0}, diff --git a/lib/crypto/c_src/digest.c b/lib/crypto/c_src/digest.c index fec286c000..c987a664d5 100644 --- a/lib/crypto/c_src/digest.c +++ b/lib/crypto/c_src/digest.c @@ -22,10 +22,32 @@ static struct digest_type_t digest_types[] = { - {{"md4"}, {&EVP_md4}}, - {{"md5"}, {&EVP_md5}}, - {{"ripemd160"}, {&EVP_ripemd160}}, + {{"md4"}, +#ifdef HAVE_MD4 + {&EVP_md4} +#else + {NULL} +#endif + }, + + {{"md5"}, +#ifdef HAVE_MD5 + {&EVP_md5} +#else + {NULL} +#endif + }, + + {{"ripemd160"}, +#ifdef HAVE_RIPEMD160 + {&EVP_ripemd160} +#else + {NULL} +#endif + }, + {{"sha"}, {&EVP_sha1}}, + {{"sha224"}, #ifdef HAVE_SHA224 {&EVP_sha224} @@ -33,6 +55,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha256"}, #ifdef HAVE_SHA256 {&EVP_sha256} @@ -40,6 +63,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha384"}, #ifdef HAVE_SHA384 {&EVP_sha384} @@ -47,6 +71,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha512"}, #ifdef HAVE_SHA512 {&EVP_sha512} @@ -54,6 +79,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha3_224"}, #ifdef HAVE_SHA3_224 {&EVP_sha3_224} @@ -61,6 +87,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha3_256"}, #ifdef HAVE_SHA3_256 {&EVP_sha3_256} @@ -68,6 +95,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha3_384"}, #ifdef HAVE_SHA3_384 {&EVP_sha3_384} @@ -75,6 +103,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"sha3_512"}, #ifdef HAVE_SHA3_512 {&EVP_sha3_512} @@ -82,6 +111,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"blake2b"}, #ifdef HAVE_BLAKE2 {&EVP_blake2b512} @@ -89,6 +119,7 @@ static struct digest_type_t digest_types[] = {NULL} #endif }, + {{"blake2s"}, #ifdef HAVE_BLAKE2 {&EVP_blake2s256} diff --git a/lib/crypto/c_src/engine.c b/lib/crypto/c_src/engine.c index 7ffbb9e70d..ea5d9a588f 100644 --- a/lib/crypto/c_src/engine.c +++ b/lib/crypto/c_src/engine.c @@ -106,15 +106,13 @@ int init_engine_ctx(ErlNifEnv *env) { (ErlNifResourceDtor*) engine_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, NULL); - if (engine_ctx_rtype == NULL) - goto err; + if (engine_ctx_rtype == NULL) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'"); + return 0; + } #endif return 1; - - err: - PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'"); - return 0; } ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) diff --git a/lib/crypto/c_src/hash.c b/lib/crypto/c_src/hash.c index 0a9f64acef..9b79258585 100644 --- a/lib/crypto/c_src/hash.c +++ b/lib/crypto/c_src/hash.c @@ -21,9 +21,15 @@ #include "hash.h" #include "digest.h" -#define MD5_CTX_LEN (sizeof(MD5_CTX)) -#define MD4_CTX_LEN (sizeof(MD4_CTX)) -#define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX)) +#ifdef HAVE_MD5 +# define MD5_CTX_LEN (sizeof(MD5_CTX)) +#endif +#ifdef HAVE_MD4 +# define MD4_CTX_LEN (sizeof(MD4_CTX)) +#endif +#ifdef HAVE_RIPEMD160 +# define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX)) +#endif #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) struct evp_md_ctx { @@ -261,18 +267,24 @@ ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) switch (EVP_MD_type(digp->md.p)) { +#ifdef HAVE_MD4 case NID_md4: ctx_size = MD4_CTX_LEN; ctx_init = (init_fun)(&MD4_Init); break; +#endif +#ifdef HAVE_MD5 case NID_md5: ctx_size = MD5_CTX_LEN; ctx_init = (init_fun)(&MD5_Init); break; +#endif +#ifdef HAVE_RIPEMD160 case NID_ripemd160: ctx_size = RIPEMD160_CTX_LEN; ctx_init = (init_fun)(&RIPEMD160_Init); break; +#endif case NID_sha1: ctx_size = sizeof(SHA_CTX); ctx_init = (init_fun)(&SHA1_Init); @@ -352,18 +364,24 @@ ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] switch (EVP_MD_type(digp->md.p)) { +#ifdef HAVE_MD4 case NID_md4: ctx_size = MD4_CTX_LEN; ctx_update = (update_fun)(&MD4_Update); break; +#endif +#ifdef HAVE_MD5 case NID_md5: ctx_size = MD5_CTX_LEN; ctx_update = (update_fun)(&MD5_Update); break; +#endif +#ifdef HAVE_RIPEMD160 case NID_ripemd160: ctx_size = RIPEMD160_CTX_LEN; ctx_update = (update_fun)(&RIPEMD160_Update); break; +#endif case NID_sha1: ctx_size = sizeof(SHA_CTX); ctx_update = (update_fun)(&SHA1_Update); @@ -448,18 +466,24 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) switch (EVP_MD_type(md)) { +#ifdef HAVE_MD4 case NID_md4: ctx_size = MD4_CTX_LEN; ctx_final = (final_fun)(&MD4_Final); break; +#endif +#ifdef HAVE_MD5 case NID_md5: ctx_size = MD5_CTX_LEN; ctx_final = (final_fun)(&MD5_Final); break; - case NID_ripemd160: +#endif +#ifdef HAVE_RIPEMD160 + case NID_ripemd160: ctx_size = RIPEMD160_CTX_LEN; ctx_final = (final_fun)(&RIPEMD160_Final); break; +#endif case NID_sha1: ctx_size = sizeof(SHA_CTX); ctx_final = (final_fun)(&SHA1_Final); diff --git a/lib/crypto/c_src/hmac.c b/lib/crypto/c_src/hmac.c index c41e50eb35..ff7005d75e 100644 --- a/lib/crypto/c_src/hmac.c +++ b/lib/crypto/c_src/hmac.c @@ -181,7 +181,7 @@ ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ASSERT(argc == 2); - if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)) + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)hmac_context_rtype, (void**)&obj)) goto bad_arg; if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) goto bad_arg; @@ -224,7 +224,7 @@ ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(argc == 1 || argc == 2); - if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)) + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)hmac_context_rtype, (void**)&obj)) goto bad_arg; if (argc == 2) { if (!enif_get_uint(env, argv[1], &req_len)) diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h index 45144a0c25..f926f8af13 100644 --- a/lib/crypto/c_src/openssl_config.h +++ b/lib/crypto/c_src/openssl_config.h @@ -109,6 +109,7 @@ #ifndef HAS_LIBRESSL # if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) # define HAS_EVP_PKEY_CTX +# define HAVE_EVP_CIPHER_CTX_COPY # endif #endif @@ -165,6 +166,28 @@ # define HAVE_BLAKE2 #endif +#ifndef OPENSSL_NO_MD4 +# define HAVE_MD4 +#endif + +#ifndef OPENSSL_NO_MD5 +# define HAVE_MD5 +#endif + +#ifndef OPENSSL_NO_RC2 +# define HAVE_RC2 +#endif + +#ifndef OPENSSL_NO_RC4 +# define HAVE_RC4 +#endif + +#ifndef OPENSSL_NO_RMD160 +/* Note RMD160 vs RIPEMD160 */ +# define HAVE_RIPEMD160 +#endif + + #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'o') \ && !defined(OPENSSL_NO_EC) \ && !defined(OPENSSL_NO_ECDH) \ @@ -191,7 +214,9 @@ # define HAVE_AEAD # define HAVE_GCM # define HAVE_CCM -# define HAVE_CMAC +# ifndef OPENSSL_NO_CMAC +# define HAVE_CMAC +# endif # if defined(RSA_PKCS1_OAEP_PADDING) # define HAVE_RSA_OAEP_PADDING # endif @@ -203,16 +228,27 @@ #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) # ifndef HAS_LIBRESSL -# define HAVE_CHACHA20 -# define HAVE_CHACHA20_POLY1305 +# if !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) +# define HAVE_CHACHA20_POLY1305 +# endif # define HAVE_RSA_OAEP_MD # endif #endif +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(1,1,0,'d') +# ifndef HAS_LIBRESSL +# ifndef OPENSSL_NO_CHACHA +# define HAVE_CHACHA20 +# endif +# endif +#endif + // OPENSSL_VERSION_NUMBER >= 1.1.1-pre8 #if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1)-7) # ifndef HAS_LIBRESSL -# define HAVE_POLY1305 +# if !defined(OPENSSL_NO_POLY1305) +# define HAVE_POLY1305 +# endif # endif #endif diff --git a/lib/crypto/c_src/pkey.c b/lib/crypto/c_src/pkey.c index 393358d173..638bb588fa 100644 --- a/lib/crypto/c_src/pkey.c +++ b/lib/crypto/c_src/pkey.c @@ -719,6 +719,11 @@ enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf); if (pkey) EVP_PKEY_free(pkey); +#ifdef HAVE_EDDSA + if (mdctx) + EVP_MD_CTX_free(mdctx); +#endif + return ret; } diff --git a/lib/crypto/c_src/poly1305.c b/lib/crypto/c_src/poly1305.c index db3433dce3..76579c0a29 100644 --- a/lib/crypto/c_src/poly1305.c +++ b/lib/crypto/c_src/poly1305.c @@ -85,6 +85,6 @@ ERL_NIF_TERM poly1305_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return ret; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } diff --git a/lib/crypto/c_src/rc4.c b/lib/crypto/c_src/rc4.c deleted file mode 100644 index e423661097..0000000000 --- a/lib/crypto/c_src/rc4.c +++ /dev/null @@ -1,92 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-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% - */ - -#include "rc4.h" - -ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key) */ -#ifndef OPENSSL_NO_RC4 - ErlNifBinary key; - ERL_NIF_TERM ret; - RC4_KEY *rc4_key; - - CHECK_NO_FIPS_MODE(); - - ASSERT(argc == 1); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key)) - goto bad_arg; - if (key.size > INT_MAX) - goto bad_arg; - - if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret)) == NULL) - goto err; - - RC4_set_key(rc4_key, (int)key.size, key.data); - return ret; - - bad_arg: - err: - return enif_make_badarg(env); - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - -ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (State, Data) */ -#ifndef OPENSSL_NO_RC4 - ErlNifBinary state, data; - RC4_KEY* rc4_key; - ERL_NIF_TERM new_state, new_data; - unsigned char *outp; - - CHECK_NO_FIPS_MODE(); - - ASSERT(argc == 2); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &state)) - goto bad_arg; - if (state.size != sizeof(RC4_KEY)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) - goto bad_arg; - - if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state)) == NULL) - goto err; - if ((outp = enif_make_new_binary(env, data.size, &new_data)) == NULL) - goto err; - - memcpy(rc4_key, state.data, sizeof(RC4_KEY)); - RC4(rc4_key, data.size, data.data, outp); - - CONSUME_REDS(env, data); - return enif_make_tuple2(env, new_state, new_data); - - bad_arg: - err: - return enif_make_badarg(env); - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - diff --git a/lib/crypto/c_src/rc4.h b/lib/crypto/c_src/rc4.h deleted file mode 100644 index 28bf674253..0000000000 --- a/lib/crypto/c_src/rc4.h +++ /dev/null @@ -1,29 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-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% - */ - -#ifndef E_RC4_H__ -#define E_RC4_H__ 1 - -#include "common.h" - -ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); - -#endif /* E_RC4_H__ */ diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 97a4a7a3f0..5cf34f8069 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -40,24 +40,27 @@ -export([rand_plugin_uniform/2]). -export([rand_cache_plugin_next/1]). -export([rand_uniform/2]). --export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]). -export([next_iv/2, next_iv/3]). --export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2]). -export([public_encrypt/4, private_decrypt/4]). -export([private_encrypt/4, public_decrypt/4]). -export([privkey_to_pubkey/2]). -export([ec_curve/1, ec_curves/0]). -export([rand_seed/1]). -%% Experiment --export([crypto_init/4, - crypto_update/2, crypto_update/3, - %% Emulates old api: - crypto_stream_init/2, crypto_stream_init/3, - crypto_stream_encrypt/2, - crypto_stream_decrypt/2, - crypto_block_encrypt/3, crypto_block_encrypt/4, - crypto_block_decrypt/3, crypto_block_decrypt/4 +%% Old interface. Now implemented with the New interface +-export([stream_init/2, stream_init/3, + stream_encrypt/2, + stream_decrypt/2, + block_encrypt/3, block_encrypt/4, + block_decrypt/3, block_decrypt/4 + ]). + +%% New interface +-export([crypto_init/4, crypto_init/3, + crypto_update/2, + crypto_one_shot/5, + crypto_init_dyn_iv/3, + crypto_update_dyn_iv/3 ]). @@ -533,10 +536,17 @@ poly1305(Key, Data) -> %%%================================================================ %%% -%%% Encrypt/decrypt +%%% Encrypt/decrypt, The "Old API" %%% %%%================================================================ +-define(COMPAT(CALL), + try CALL + catch + error:{E,_Reason} when E==notsup ; E==badarg -> + error(E) + end). + -spec cipher_info(Type) -> map() when Type :: block_cipher_with_iv() | aead_cipher() | block_cipher_without_iv(). @@ -544,7 +554,6 @@ cipher_info(Type) -> cipher_info_nif(Type). %%%---- Block ciphers - %%%---------------------------------------------------------------- -spec block_encrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> binary(); (Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), PlainText::iodata()}) -> @@ -556,11 +565,6 @@ cipher_info(Type) -> block_encrypt(Type, Key, Ivec, Data) -> do_block_encrypt(alias(Type), Key, Ivec, Data). -do_block_encrypt(Type, Key0, Ivec, Data) when Type =:= des_ede3_cbc; - Type =:= des_ede3_cfb -> - Key = check_des3_key(Key0), - block_crypt_nif(Type, Key, Ivec, Data, true); - do_block_encrypt(Type, Key, Ivec, PlainText) when Type =:= aes_ige256 -> notsup_to_error(aes_ige_crypt_nif(Key, Ivec, PlainText, true)); @@ -577,14 +581,13 @@ do_block_encrypt(Type, Key, Ivec, Data) when Type =:= aes_gcm; end; do_block_encrypt(Type, Key, Ivec, PlainText) -> - block_crypt_nif(Type, Key, Ivec, PlainText, true). - + ?COMPAT(crypto_one_shot(Type, Key, Ivec, PlainText, true)). -spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> binary(). block_encrypt(Type, Key, PlainText) -> - block_crypt_nif(alias(Type), Key, PlainText, true). + ?COMPAT(crypto_one_shot(Type, Key, <<>>, PlainText, true)). %%%---------------------------------------------------------------- %%%---------------------------------------------------------------- @@ -595,11 +598,6 @@ block_encrypt(Type, Key, PlainText) -> block_decrypt(Type, Key, Ivec, Data) -> do_block_decrypt(alias(Type), Key, Ivec, Data). -do_block_decrypt(Type, Key0, Ivec, Data) when Type =:= des_ede3_cbc; - Type =:= des_ede3_cfb -> - Key = check_des3_key(Key0), - block_crypt_nif(Type, Key, Ivec, Data, false); - do_block_decrypt(aes_ige256, Key, Ivec, Data) -> notsup_to_error(aes_ige_crypt_nif(Key, Ivec, Data, false)); @@ -609,14 +607,80 @@ do_block_decrypt(Type, Key, Ivec, {AAD, Data, Tag}) when Type =:= aes_gcm; aead_decrypt(Type, Key, Ivec, AAD, Data, Tag); do_block_decrypt(Type, Key, Ivec, Data) -> - block_crypt_nif(Type, Key, Ivec, Data, false). - + ?COMPAT(crypto_one_shot(Type, Key, Ivec, Data, false)). -spec block_decrypt(Type::block_cipher_without_iv(), Key::key(), Data::iodata()) -> binary(). block_decrypt(Type, Key, Data) -> - block_crypt_nif(alias(Type), Key, Data, false). + ?COMPAT(crypto_one_shot(Type, Key, <<>>, Data, false)). + +%%%-------- Stream ciphers API + +-opaque stream_state() :: {stream_cipher(), + crypto_state() | {crypto_state(),flg_undefined} + }. + +-type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() . +-type stream_cipher_no_iv() :: rc4 . +-type stream_cipher_iv() :: aes_ctr + | aes_128_ctr + | aes_192_ctr + | aes_256_ctr + | chacha20 . + +%%%---- stream_init +-spec stream_init(Type, Key, IVec) -> State | no_return() + when Type :: stream_cipher_iv(), + Key :: iodata(), + IVec ::binary(), + State :: stream_state() . +stream_init(Type, Key, IVec) when is_binary(IVec) -> + Ref = ?COMPAT(ng_crypto_init_nif(alias(Type), + iolist_to_binary(Key), iolist_to_binary(IVec), + undefined) + ), + {Type, {Ref,flg_undefined}}. + + +-spec stream_init(Type, Key) -> State | no_return() + when Type :: stream_cipher_no_iv(), + Key :: iodata(), + State :: stream_state() . +stream_init(rc4 = Type, Key) -> + Ref = ?COMPAT(ng_crypto_init_nif(alias(Type), + iolist_to_binary(Key), <<>>, + undefined) + ), + {Type, {Ref,flg_undefined}}. + +%%%---- stream_encrypt +-spec stream_encrypt(State, PlainText) -> {NewState, CipherText} | no_return() + when State :: stream_state(), + PlainText :: iodata(), + NewState :: stream_state(), + CipherText :: iodata() . +stream_encrypt(State, Data) -> + crypto_stream_emulate(State, Data, true). + +%%%---- stream_decrypt +-spec stream_decrypt(State, CipherText) -> {NewState, PlainText} | no_return() + when State :: stream_state(), + CipherText :: iodata(), + NewState :: stream_state(), + PlainText :: iodata() . +stream_decrypt(State, Data) -> + crypto_stream_emulate(State, Data, false). + +%%%-------- helpers +crypto_stream_emulate({Cipher,{Ref0,flg_undefined}}, Data, EncryptFlag) when is_reference(Ref0) -> + ?COMPAT(begin + Ref = ng_crypto_init_nif(Ref0, <<>>, <<>>, EncryptFlag), + {{Cipher,Ref}, crypto_update(Ref, Data)} + end); + +crypto_stream_emulate({Cipher,Ref}, Data, _) when is_reference(Ref) -> + ?COMPAT({{Cipher,Ref}, crypto_update(Ref, Data)}). %%%---------------------------------------------------------------- -spec next_iv(Type:: cbc_cipher(), Data) -> NextIVec when % Type :: cbc_cipher(), %des_cbc | des3_cbc | aes_cbc | aes_ige, @@ -645,59 +709,155 @@ next_iv(des_cfb, Data, IVec) -> next_iv(Type, Data, _Ivec) -> next_iv(Type, Data). -%%%---- Stream ciphers +%%%================================================================ +%%% +%%% Encrypt/decrypt, The "New API" +%%% +%%%================================================================ --opaque stream_state() :: {stream_cipher(), reference()}. +-opaque crypto_state() :: reference() . --type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() . --type stream_cipher_no_iv() :: rc4 . --type stream_cipher_iv() :: aes_ctr - | aes_128_ctr - | aes_192_ctr - | aes_256_ctr - | chacha20 . --spec stream_init(Type, Key, IVec) -> State when Type :: stream_cipher_iv(), - Key :: iodata(), - IVec :: binary(), - State :: stream_state() . -stream_init(aes_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(aes_128_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(aes_192_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(aes_256_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(chacha20, Key, Ivec) -> - {chacha20, chacha20_stream_init(Key,Ivec)}. - --spec stream_init(Type, Key) -> State when Type :: stream_cipher_no_iv(), - Key :: iodata(), - State :: stream_state() . -stream_init(rc4, Key) -> - {rc4, notsup_to_error(rc4_set_key(Key))}. - --spec stream_encrypt(State, PlainText) -> {NewState, CipherText} - when State :: stream_state(), - PlainText :: iodata(), - NewState :: stream_state(), - CipherText :: iodata() . -stream_encrypt(State, Data0) -> - Data = iolist_to_binary(Data0), - MaxByts = max_bytes(), - stream_crypt(fun do_stream_encrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). +%%%---------------------------------------------------------------- +%%% +%%% Create and initialize a new state for encryption or decryption +%%% --spec stream_decrypt(State, CipherText) -> {NewState, PlainText} - when State :: stream_state(), - CipherText :: iodata(), - NewState :: stream_state(), - PlainText :: iodata() . -stream_decrypt(State, Data0) -> - Data = iolist_to_binary(Data0), - MaxByts = max_bytes(), - stream_crypt(fun do_stream_decrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). +-spec crypto_init(Cipher, Key, EncryptFlag) -> State | ng_crypto_error() + when Cipher :: block_cipher_without_iv() + | stream_cipher_no_iv(), + Key :: iodata(), + EncryptFlag :: boolean(), + State :: crypto_state() . +crypto_init(Cipher, Key, EncryptFlag) -> + %% The IV is supposed to be supplied by calling crypto_update/3 + ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), <<>>, EncryptFlag). + + +-spec crypto_init(Cipher, Key, IV, EncryptFlag) -> State | ng_crypto_error() + when Cipher :: stream_cipher_iv() + | block_cipher_with_iv(), + Key :: iodata(), + IV :: iodata(), + EncryptFlag :: boolean(), + State :: crypto_state() . +crypto_init(Cipher, Key, IV, EncryptFlag) -> + ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). + + + +%%%---------------------------------------------------------------- +-spec crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> State | ng_crypto_error() + when Cipher :: stream_cipher_iv() + | block_cipher_with_iv(), + Key :: iodata(), + EncryptFlag :: boolean(), + State :: crypto_state() . +crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> + %% The IV is supposed to be supplied by calling crypto_update/3 + ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), undefined, EncryptFlag). + +%%%---------------------------------------------------------------- +%%% +%%% Encrypt/decrypt a sequence of bytes. The sum of the sizes +%%% of all blocks must be an integer multiple of the crypto's +%%% blocksize. +%%% + +-spec crypto_update(State, Data) -> Result | ng_crypto_error() + when State :: crypto_state(), + Data :: iodata(), + Result :: binary() . +crypto_update(State, Data0) -> + case iolist_to_binary(Data0) of + <<>> -> + <<>>; % Known to fail on OpenSSL 0.9.8h + Data -> + ng_crypto_update_nif(State, Data) + end. + + +%%%---------------------------------------------------------------- +-spec crypto_update_dyn_iv(State, Data, IV) -> Result | ng_crypto_error() + when State :: crypto_state(), + Data :: iodata(), + IV :: iodata(), + Result :: binary() . +crypto_update_dyn_iv(State, Data0, IV) -> + %% When State is from State = crypto_init(Cipher, Key, undefined, EncryptFlag) + case iolist_to_binary(Data0) of + <<>> -> + <<>>; % Known to fail on OpenSSL 0.9.8h + Data -> + ng_crypto_update_nif(State, Data, iolist_to_binary(IV)) + end. + +%%%---------------------------------------------------------------- +%%% +%%% Encrypt/decrypt one set bytes. +%%% The size must be an integer multiple of the crypto's blocksize. +%%% + +-spec crypto_one_shot(Cipher, Key, IV, Data, EncryptFlag) -> Result | ng_crypto_error() + when Cipher :: stream_cipher() + | block_cipher_with_iv() + | block_cipher_without_iv(), + Key :: iodata(), + IV :: iodata() | undefined, + Data :: iodata(), + EncryptFlag :: boolean(), + Result :: binary() . +crypto_one_shot(Cipher, Key, undefined, Data, EncryptFlag) -> + crypto_one_shot(Cipher, Key, <<>>, Data, EncryptFlag); + +crypto_one_shot(Cipher, Key, IV, Data0, EncryptFlag) -> + case iolist_to_binary(Data0) of + <<>> -> + <<>>; % Known to fail on OpenSSL 0.9.8h + Data -> + ng_crypto_one_shot_nif(alias(Cipher), + iolist_to_binary(Key), iolist_to_binary(IV), Data, + EncryptFlag) + end. + +%%%---------------------------------------------------------------- +%%% NIFs + +-type ng_crypto_error() :: no_return() . + +-spec ng_crypto_init_nif(atom(), binary(), binary()|undefined, boolean()|undefined ) -> crypto_state() | ng_crypto_error() + ; (crypto_state(), <<>>, <<>>, boolean()) -> crypto_state() | ng_crypto_error(). +ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlg) -> ?nif_stub. + + +-spec ng_crypto_update_nif(crypto_state(), binary()) -> binary() | ng_crypto_error() . +ng_crypto_update_nif(_State, _Data) -> ?nif_stub. + +-spec ng_crypto_update_nif(crypto_state(), binary(), binary()) -> binary() | ng_crypto_error() . +ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. + + +-spec ng_crypto_one_shot_nif(atom(), binary(), binary(), binary(), boolean() ) -> binary() | ng_crypto_error(). +ng_crypto_one_shot_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. + +%%%---------------------------------------------------------------- +%%% Cipher aliases +%%% +prepend_cipher_aliases(L) -> + [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L]. + +%%%---- des_ede3_cbc +alias(des3_cbc) -> des_ede3_cbc; +alias(des_ede3) -> des_ede3_cbc; +%%%---- des_ede3_cfb +alias(des_ede3_cbf) -> des_ede3_cfb; +alias(des3_cbf) -> des_ede3_cfb; +alias(des3_cfb) -> des_ede3_cfb; +%%%---- aes_*_cbc +alias(aes_cbc128) -> aes_128_cbc; +alias(aes_cbc256) -> aes_256_cbc; +alias(Alg) -> Alg. %%%================================================================ %%% @@ -1785,19 +1945,6 @@ poly1305_nif(_Key, _Data) -> ?nif_stub. cipher_info_nif(_Type) -> ?nif_stub. -block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub. -block_crypt_nif(_Type, _Key, _Text, _IsEncrypt) -> ?nif_stub. - -check_des3_key(Key) -> - case lists:map(fun erlang:iolist_to_binary/1, Key) of - ValidKey = [B1, B2, B3] when byte_size(B1) =:= 8, - byte_size(B2) =:= 8, - byte_size(B3) =:= 8 -> - ValidKey; - _ -> - error(badarg) - end. - %% %% AES - in Galois/Counter Mode (GCM) %% @@ -1814,59 +1961,7 @@ aead_decrypt(_Type, _Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. aes_ige_crypt_nif(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -%% Stream ciphers -------------------------------------------------------------------- - -stream_crypt(Fun, State, Data, Size, MaxByts, []) when Size =< MaxByts -> - Fun(State, Data); -stream_crypt(Fun, State0, Data, Size, MaxByts, Acc) when Size =< MaxByts -> - {State, Cipher} = Fun(State0, Data), - {State, list_to_binary(lists:reverse([Cipher | Acc]))}; -stream_crypt(Fun, State0, Data, _, MaxByts, Acc) -> - <<Increment:MaxByts/binary, Rest/binary>> = Data, - {State, CipherText} = Fun(State0, Increment), - stream_crypt(Fun, State, Rest, erlang:byte_size(Rest), MaxByts, [CipherText | Acc]). - -do_stream_encrypt({aes_ctr, State0}, Data) -> - {State, Cipher} = aes_ctr_stream_encrypt(State0, Data), - {{aes_ctr, State}, Cipher}; -do_stream_encrypt({rc4, State0}, Data) -> - {State, Cipher} = rc4_encrypt_with_state(State0, Data), - {{rc4, State}, Cipher}; -do_stream_encrypt({chacha20, State0}, Data) -> - {State, Cipher} = chacha20_stream_encrypt(State0, Data), - {{chacha20, State}, Cipher}. - -do_stream_decrypt({aes_ctr, State0}, Data) -> - {State, Text} = aes_ctr_stream_decrypt(State0, Data), - {{aes_ctr, State}, Text}; -do_stream_decrypt({rc4, State0}, Data) -> - {State, Text} = rc4_encrypt_with_state(State0, Data), - {{rc4, State}, Text}; -do_stream_decrypt({chacha20, State0}, Data) -> - {State, Cipher} = chacha20_stream_decrypt(State0, Data), - {{chacha20, State}, Cipher}. - - -%% -%% AES - in counter mode (CTR) with state maintained for multi-call streaming -%% -aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub. -aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub. -aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. - -%% -%% RC4 - symmetric stream cipher -%% -rc4_set_key(_Key) -> ?nif_stub. -rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. - -%% -%% CHACHA20 - stream cipher -%% -chacha20_stream_init(_Key, _IVec) -> ?nif_stub. -chacha20_stream_encrypt(_State, _Data) -> ?nif_stub. -chacha20_stream_decrypt(_State, _Data) -> ?nif_stub. +%%%================================================================ %% Secure remote password ------------------------------------------------------------------- @@ -2232,176 +2327,3 @@ check_otp_test_engine(LibDir) -> end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% Experimental NG -%%% - -%%% -> {ok,State::ref()} | {error,Reason} - --opaque crypto_state() :: reference() | {any(),any(),any(),any()}. - - -%%%---------------------------------------------------------------- -%%% -%%% Create and initialize a new state for encryption or decryption -%%% - --spec crypto_init(Cipher, Key, IV, EncryptFlag) -> {ok,State} | {error,term()} | undefined - when Cipher :: stream_cipher() - | block_cipher_with_iv() - | block_cipher_without_iv() , - Key :: iodata(), - IV :: binary(), - EncryptFlag :: boolean() | undefined, - State :: crypto_state() . - -crypto_init(Cipher, Key, IV, EncryptFlag) when is_atom(Cipher), - is_binary(Key), - is_binary(IV), - is_atom(EncryptFlag) -> - case ng_crypto_init_nif(alias(Cipher), Key, IV, EncryptFlag) of - {error,Error} -> - {error,Error}; - undefined -> % For compatibility function crypto_stream_init/3 - undefined; - Ref when is_reference(Ref) -> - {ok,Ref}; - State when is_tuple(State), - size(State)==4 -> - {ok,State} % compatibility with old cryptolibs < 1.0.1 - end. - - -%%%---------------------------------------------------------------- -%%% -%%% Encrypt/decrypt a sequence of bytes. The sum of the sizes -%%% of all blocks must be an integer multiple of the crypto's -%%% blocksize. -%%% - --spec crypto_update(State, Data) -> {ok,Result} | {error,term()} - when State :: crypto_state(), - Data :: iodata(), - Result :: binary() | {crypto_state(),binary()}. -crypto_update(State, Data) -> - mk_ret(ng_crypto_update_nif(State, Data)). - -%%%---------------------------------------------------------------- -%%% -%%% Encrypt/decrypt a sequence of bytes but change the IV first. -%%% Not applicable for all modes. -%%% - --spec crypto_update(State, Data, IV) -> {ok,Result} | {error,term()} - when State :: crypto_state(), - Data :: iodata(), - IV :: binary(), - Result :: binary() | {crypto_state(),binary()}. -crypto_update(State, Data, IV) -> - mk_ret(ng_crypto_update_nif(State, Data, IV)). - -%%%---------------------------------------------------------------- -%%% Helpers -mk_ret(R) -> mk_ret(R, []). - -mk_ret({error,Error}, _) -> - {error,Error}; -mk_ret(Bin, Acc) when is_binary(Bin) -> - {ok, iolist_to_binary(lists:reverse([Bin|Acc]))}; -mk_ret({State1,Bin}, Acc) when is_tuple(State1), - size(State1) == 4, - is_binary(Bin) -> - %% compatibility with old cryptolibs < 1.0.1 - {ok, {State1, iolist_to_binary(lists:reverse([Bin|Acc]))}}. - -%%%---------------------------------------------------------------- -%%% NIFs -ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlg) -> ?nif_stub. -ng_crypto_update_nif(_State, _Data) -> ?nif_stub. -ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. - -%%%================================================================ -%%% Compatibility functions to be called by "old" api functions. - -%%%-------------------------------- -%%%---- block encrypt/decrypt -crypto_block_encrypt(Cipher, Key, Data) -> crypto_block_encrypt(Cipher, Key, <<>>, Data). -crypto_block_decrypt(Cipher, Key, Data) -> crypto_block_decrypt(Cipher, Key, <<>>, Data). - -crypto_block_encrypt(Cipher, Key, Ivec, Data) -> crypto_block(Cipher, Key, Ivec, Data, true). -crypto_block_decrypt(Cipher, Key, Ivec, Data) -> crypto_block(Cipher, Key, Ivec, Data, false). - -%% AEAD: use old funcs - -%%%---- helper -crypto_block(Cipher, Key, IV, Data, EncryptFlag) -> - case crypto_init(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag) of - {ok, Ref} -> - case crypto_update(Ref, Data) of - {ok, {_,Bin}} when is_binary(Bin) -> Bin; - {ok, Bin} when is_binary(Bin) -> Bin; - {error,_} -> error(badarg) - end; - - {error,_} -> error(badarg) - end. - -%%%-------------------------------- -%%%---- stream init, encrypt/decrypt - -crypto_stream_init(Cipher, Key) -> - crypto_stream_init(Cipher, Key, <<>>). - -crypto_stream_init(Cipher, Key0, IV0) -> - Key = iolist_to_binary(Key0), - IV = iolist_to_binary(IV0), - %% First check the argumensts: - case crypto_init(Cipher, Key, IV, undefined) of - undefined -> - {Cipher, {Key, IV}}; - {error,_} -> - {error,badarg} - end. - -crypto_stream_encrypt(State, PlainText) -> - crypto_stream_emulate(State, PlainText, true). - -crypto_stream_decrypt(State, CryptoText) -> - crypto_stream_emulate(State, CryptoText, false). - - -%%%---- helper -crypto_stream_emulate({Cipher,{Key,IV}}, Data, EncryptFlag) -> - case crypto_init(Cipher, Key, IV, EncryptFlag) of - {ok,State} -> - crypto_stream_emulate({Cipher,State}, Data, EncryptFlag); - {error,_} -> - error(badarg) - end; -crypto_stream_emulate({Cipher,State}, Data, _) -> - case crypto_update(State, Data) of - {ok, {State1,Bin}} when is_binary(Bin) -> {{Cipher,State1},Bin}; - {ok,Bin} when is_binary(Bin) -> {{Cipher,State},Bin}; - {error,_} -> error(badarg) - end. - - -%%%================================================================ - -prepend_cipher_aliases(L) -> - [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L]. - - -%%%---- des_ede3_cbc -alias(des3_cbc) -> des_ede3_cbc; -alias(des_ede3) -> des_ede3_cbc; -%%%---- des_ede3_cfb -alias(des_ede3_cbf) -> des_ede3_cfb; -alias(des3_cbf) -> des_ede3_cfb; -alias(des3_cfb) -> des_ede3_cfb; -%%%---- aes_*_cbc -alias(aes_cbc128) -> aes_128_cbc; -alias(aes_cbc256) -> aes_256_cbc; - -alias(Alg) -> Alg. diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 7257f4fb9f..5aa19a6ae0 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -9,7 +9,7 @@ %% %% 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 @@ -46,53 +46,67 @@ all() -> ]. groups() -> - [{non_fips, [], [{group, md4}, + [{non_fips, [], [ + {group, blake2b}, + {group, blake2s}, + {group, dss}, + {group, ecdsa}, + {group, ed25519}, + {group, ed448}, + {group, rsa}, + + {group, md4}, {group, md5}, {group, ripemd160}, - {group, sha}, {group, sha224}, {group, sha256}, {group, sha384}, - {group, sha512}, {group, sha3_224}, {group, sha3_256}, {group, sha3_384}, {group, sha3_512}, - {group, blake2b}, - {group, blake2s}, - {group, rsa}, - {group, dss}, - {group, ecdsa}, - {group, ed25519}, - {group, ed448}, + {group, sha512}, + {group, sha}, + {group, dh}, {group, ecdh}, {group, srp}, - {group, des_cbc}, - {group, des_cfb}, - {group, des3_cbc}, - {group, des3_cbf}, - {group, des3_cfb}, - {group, des_ede3}, - {group, blowfish_cbc}, - {group, blowfish_ecb}, - {group, blowfish_cfb64}, - {group, blowfish_ofb64}, - {group, aes_cbc128}, - {group, aes_cfb8}, - {group, aes_cfb128}, - {group, aes_cbc256}, - {group, aes_ige256}, - {group, rc2_cbc}, - {group, rc4}, - {group, aes_ctr}, + + {group, aes_cbc}, {group, aes_ccm}, {group, aes_gcm}, {group, chacha20_poly1305}, {group, chacha20}, + {group, des3_cfb}, + {group, aes_cbc128}, + {group, aes_cbc256}, + {group, aes_cfb128}, + {group, aes_cfb8}, + {group, aes_ctr}, + {group, aes_ige256}, + {group, blowfish_cbc}, + {group, blowfish_cfb64}, + {group, blowfish_ecb}, + {group, blowfish_ofb64}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, des_cbc}, + {group, des_cfb}, + {group, des_ede3}, {group, poly1305}, - {group, aes_cbc}]}, - {fips, [], [{group, no_md4}, + {group, rc2_cbc}, + {group, rc4} + ]}, + {fips, [], [ + {group, no_blake2b}, + {group, no_blake2s}, + {group, dss}, + {group, ecdsa}, + {group, no_ed25519}, + {group, no_ed448}, + {group, rsa}, + + {group, no_md4}, {group, no_md5}, {group, no_ripemd160}, {group, sha}, @@ -100,37 +114,36 @@ groups() -> {group, sha256}, {group, sha384}, {group, sha512}, - {group, rsa}, - {group, dss}, - {group, ecdsa}, - {group, no_ed25519}, - {group, no_ed448}, + {group, dh}, {group, ecdh}, {group, no_srp}, - {group, no_des_cbc}, - {group, no_des_cfb}, - {group, des3_cbc}, - {group, des3_cbf}, + + {group, aes_cbc}, + {group, aes_ccm}, + {group, aes_gcm}, + {group, no_chacha20_poly1305}, + {group, no_chacha20}, {group, des3_cfb}, - {group, des_ede3}, - {group, no_blowfish_cbc}, - {group, no_blowfish_ecb}, - {group, no_blowfish_cfb64}, - {group, no_blowfish_ofb64}, {group, aes_cbc128}, - {group, no_aes_cfb8}, - {group, no_aes_cfb128}, {group, aes_cbc256}, + {group, no_aes_cfb128}, + {group, no_aes_cfb8}, + {group, aes_ctr}, {group, no_aes_ige256}, + {group, no_blowfish_cbc}, + {group, no_blowfish_cfb64}, + {group, no_blowfish_ecb}, + {group, no_blowfish_ofb64}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, no_des_cbc}, + {group, no_des_cfb}, + {group, des_ede3}, + {group, no_poly1305}, {group, no_rc2_cbc}, - {group, no_rc4}, - {group, aes_ctr}, - {group, aes_ccm}, - {group, aes_gcm}, - {group, no_chacha20_poly1305}, - {group, no_chacha20}, - {group, aes_cbc}]}, + {group, no_rc4} + ]}, {md4, [], [hash]}, {md5, [], [hash, hmac]}, {ripemd160, [], [hash]}, @@ -145,6 +158,8 @@ groups() -> {sha3_512, [], [hash, hmac]}, {blake2b, [], [hash, hmac]}, {blake2s, [], [hash, hmac]}, + {no_blake2b, [], [no_hash, no_hmac]}, + {no_blake2s, [], [no_hash, no_hmac]}, {rsa, [], [sign_verify, public_encrypt, private_encrypt, @@ -166,31 +181,32 @@ groups() -> compute_bug]}, {ecdh, [], [use_all_elliptic_curves, compute, generate]}, {srp, [], [generate_compute]}, - {des_cbc, [], [block]}, - {des_cfb, [], [block]}, - {des3_cbc,[], [block]}, - {des_ede3,[], [block]}, - {des3_cbf,[], [block]}, - {des3_cfb,[], [block]}, - {rc2_cbc,[], [block]}, - {aes_cbc128,[], [block, cmac]}, - {aes_cfb8,[], [block]}, - {aes_cfb128,[], [block]}, - {aes_cbc256,[], [block, cmac]}, - {aes_ecb,[], [block]}, + {des_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des3_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_ede3,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des3_cbf,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des3_cfb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc2_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cbc128,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, + {aes_cfb8,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cfb128,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cbc256,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, + {aes_ecb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {aes_ige256,[], [block]}, - {blowfish_cbc, [], [block]}, - {blowfish_ecb, [], [block]}, - {blowfish_cfb64, [], [block]}, - {blowfish_ofb64,[], [block]}, - {rc4, [], [stream]}, - {aes_ctr, [], [stream]}, + {blowfish_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ecb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_cfb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ofb64,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc4, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_ctr, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, {aes_ccm, [], [aead]}, {aes_gcm, [], [aead]}, {chacha20_poly1305, [], [aead]}, - {chacha20, [], [stream]}, + {chacha20, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, {poly1305, [], [poly1305]}, - {aes_cbc, [], [block]}, + {no_poly1305, [], [no_poly1305]}, + {aes_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {no_aes_cfb8,[], [no_support, no_block]}, {no_aes_cfb128,[], [no_support, no_block]}, {no_md4, [], [no_support, no_hash]}, @@ -307,12 +323,11 @@ end_per_group(_GroupName, Config) -> init_per_testcase(info, Config) -> Config; init_per_testcase(cmac, Config) -> - case crypto:info_lib() of - [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer), LibVer > 16#10001000 -> + case is_supported(cmac) of + true -> Config; - _Else -> - % The CMAC functionality was introduced in OpenSSL 1.0.1 - {skip, "OpenSSL is too old"} + false -> + {skip, "CMAC is not supported"} end; init_per_testcase(generate, Config) -> case proplists:get_value(type, Config) of @@ -412,11 +427,19 @@ poly1305(Config) -> end, proplists:get_value(poly1305, Config)). %%-------------------------------------------------------------------- +no_poly1305() -> + [{doc, "Test disabled poly1305 function"}]. +no_poly1305(Config) -> + Type = ?config(type, Config), + Key = <<133,214,190,120,87,85,109,51,127,68,82,254,66,213,6,168,1, + 3,128,138,251,13,178,253,74,191,246,175,65,73,245,27>>, + Txt = <<"Cryptographic Forum Research Group">>, + notsup(fun crypto:poly1305/2, [Key,Txt]). + +%%-------------------------------------------------------------------- block() -> [{doc, "Test block ciphers"}]. block(Config) when is_list(Config) -> - Fips = proplists:get_bool(fips, Config), - Type = ?config(type, Config), Blocks = lazy_eval(proplists:get_value(block, Config)), lists:foreach(fun block_cipher/1, Blocks), lists:foreach(fun block_cipher/1, block_iolistify(Blocks)), @@ -439,6 +462,156 @@ no_block(Config) when is_list(Config) -> notsup(fun crypto:block_encrypt/N, Args), notsup(fun crypto:block_decrypt/N, Args). %%-------------------------------------------------------------------- +api_ng() -> + [{doc, "Test new api"}]. + +api_ng(Config) when is_list(Config) -> + Blocks = lazy_eval(proplists:get_value(block, Config, [])), + Streams = lazy_eval(proplists:get_value(stream, Config, [])), + lists:foreach(fun api_ng_cipher_increment/1, Blocks++Streams). + + +api_ng_cipher_increment({Type, Key, PlainTexts}=_X) -> + ct:log("~p",[_X]), + api_ng_cipher_increment({Type, Key, <<>>, PlainTexts}); + +api_ng_cipher_increment({Type, Key, IV, PlainTexts}=_X) -> + ct:log("~p",[_X]), + api_ng_cipher_increment({Type, Key, IV, PlainTexts, undefined}); + +api_ng_cipher_increment({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> + ct:log("~p",[_X]), + PlainTexts = iolistify(PlainText0), + RefEnc = crypto:crypto_init(Type, Key, IV, true), + RefDec = crypto:crypto_init(Type, Key, IV, false), + EncTexts = api_ng_cipher_increment_loop(RefEnc, PlainTexts), + Enc = iolist_to_binary(EncTexts), + case ExpectedEncText of + undefined -> + ok; + Enc -> + ok; + _ -> + ct:log("encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainTexts}, ExpectedEncText, Enc]), + ct:fail("api_ng_cipher_increment (encode)",[]) + end, + Plain = iolist_to_binary(PlainTexts), + case iolist_to_binary(api_ng_cipher_increment_loop(RefDec, EncTexts)) of + Plain -> + ok; + OtherPT -> + ct:log("decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTexts}, Plain, OtherPT]), + ct:fail("api_ng_cipher_increment (encode)",[]) + end. + + +api_ng_cipher_increment_loop(Ref, InTexts) -> + lists:map(fun(Txt) -> + try crypto:crypto_update(Ref, Txt) + of + Bin when is_binary(Bin) -> + Bin + catch + error:Error -> + ct:pal("Txt = ~p",[Txt]), + ct:fail("~p",[Error]) + end + end, InTexts). + +%%-------------------------------------------------------------------- +api_ng_one_shot() -> + [{doc, "Test new api"}]. + +api_ng_one_shot(Config) when is_list(Config) -> + Blocks = lazy_eval(proplists:get_value(block, Config, [])), + Streams = lazy_eval(proplists:get_value(stream, Config, [])), + lists:foreach(fun do_api_ng_one_shot/1, Blocks++Streams). + +do_api_ng_one_shot({Type, Key, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_one_shot({Type, Key, <<>>, PlainTexts}); + +do_api_ng_one_shot({Type, Key, IV, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_one_shot({Type, Key, IV, PlainTexts, undefined}); + +do_api_ng_one_shot({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> + ct:log("~p",[_X]), + PlainText = iolist_to_binary(PlainText0), + EncTxt = crypto:crypto_one_shot(Type, Key, IV, PlainText, true), + case ExpectedEncText of + undefined -> + ok; + EncTxt -> + ok; + _ -> + ct:log("encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, EncTxt]), + ct:fail("api_ng_one_shot (encode)",[]) + end, + case crypto:crypto_one_shot(Type, Key, IV, EncTxt, false) of + PlainText -> + ok; + OtherPT -> + ct:log("decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, OtherPT]), + ct:fail("api_ng_one_shot (decode)",[]) + end. + +%%-------------------------------------------------------------------- +api_ng_tls() -> + [{doc, "Test special tls api"}]. + +api_ng_tls(Config) when is_list(Config) -> + Blocks = lazy_eval(proplists:get_value(block, Config, [])), + Streams = lazy_eval(proplists:get_value(stream, Config, [])), + lists:foreach(fun do_api_ng_tls/1, Blocks++Streams). + + +do_api_ng_tls({Type, Key, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_tls({Type, Key, <<>>, PlainTexts}); + +do_api_ng_tls({Type, Key, IV, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_tls({Type, Key, IV, PlainTexts, undefined}); + +do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> + ct:log("~p",[_X]), + PlainText = iolist_to_binary(PlainText0), + Renc = crypto:crypto_init_dyn_iv(Type, Key, true), + Rdec = crypto:crypto_init_dyn_iv(Type, Key, false), + EncTxt = crypto:crypto_update_dyn_iv(Renc, PlainText, IV), + case ExpectedEncText of + undefined -> + ok; + EncTxt -> + %% Now check that the state is NOT updated: + case crypto:crypto_update_dyn_iv(Renc, PlainText, IV) of + EncTxt -> + ok; + EncTxt2 -> + ct:log("2nd encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, EncTxt, EncTxt2]), + ct:fail("api_ng_tls (second encode)",[]) + end; + OtherEnc -> + ct:log("1st encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, OtherEnc]), + ct:fail("api_ng_tls (encode)",[]) + end, + case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + PlainText -> + %% Now check that the state is NOT updated: + case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + PlainText -> + ok; + PlainText2 -> + ct:log("2nd decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, PlainText2]), + ct:fail("api_ng_tls (second decode)",[]) + end; + OtherPT -> + ct:log("1st decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, OtherPT]), + ct:fail("api_ng_tlst (decode)",[]) + end. + +%%-------------------------------------------------------------------- no_aead() -> [{doc, "Test disabled aead ciphers"}]. no_aead(Config) when is_list(Config) -> @@ -774,6 +947,7 @@ cmac_check({Type, Key, Text, Size, CMac}) -> ct:fail({{crypto, cmac, [Type, Key, Text, Size]}, {expected, ExpCMac}, {got, Other}}) end. + block_cipher({Type, Key, PlainText}) -> Plain = iolist_to_binary(PlainText), CipherText = crypto:block_encrypt(Type, Key, PlainText), @@ -851,46 +1025,51 @@ block_cipher_increment(Type, Key, IV0, IV, [PlainText | PlainTexts], Plain, Ciph stream_cipher({Type, Key, PlainText}) -> Plain = iolist_to_binary(PlainText), - State = crypto:stream_init(Type, Key), - {_, CipherText} = crypto:stream_encrypt(State, PlainText), - case crypto:stream_decrypt(State, CipherText) of + StateE = crypto:stream_init(Type, Key), + StateD = crypto:stream_init(Type, Key), + {_, CipherText} = crypto:stream_encrypt(StateE, PlainText), + case crypto:stream_decrypt(StateD, CipherText) of {_, Plain} -> ok; Other -> - ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; stream_cipher({Type, Key, IV, PlainText}) -> Plain = iolist_to_binary(PlainText), - State = crypto:stream_init(Type, Key, IV), - {_, CipherText} = crypto:stream_encrypt(State, PlainText), - case crypto:stream_decrypt(State, CipherText) of + StateE = crypto:stream_init(Type, Key, IV), + StateD = crypto:stream_init(Type, Key, IV), + {_, CipherText} = crypto:stream_encrypt(StateE, PlainText), + case crypto:stream_decrypt(StateD, CipherText) of {_, Plain} -> ok; Other -> - ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; stream_cipher({Type, Key, IV, PlainText, CipherText}) -> Plain = iolist_to_binary(PlainText), - State = crypto:stream_init(Type, Key, IV), - case crypto:stream_encrypt(State, PlainText) of + StateE = crypto:stream_init(Type, Key, IV), + StateD = crypto:stream_init(Type, Key, IV), + case crypto:stream_encrypt(StateE, PlainText) of {_, CipherText} -> ok; {_, Other0} -> - ct:fail({{crypto, stream_encrypt, [State, Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) + ct:fail({{crypto, stream_encrypt, [StateE, Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) end, - case crypto:stream_decrypt(State, CipherText) of + case crypto:stream_decrypt(StateD, CipherText) of {_, Plain} -> ok; Other1 -> - ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other1}}) + ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other1}}) end. stream_cipher_incment({Type, Key, PlainTexts}) -> - State = crypto:stream_init(Type, Key), - stream_cipher_incment_loop(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); + StateE = crypto:stream_init(Type, Key), + StateD = crypto:stream_init(Type, Key), + stream_cipher_incment_loop(StateE, StateD, PlainTexts, [], iolist_to_binary(PlainTexts)); stream_cipher_incment({Type, Key, IV, PlainTexts}) -> - State = crypto:stream_init(Type, Key, IV), - stream_cipher_incment_loop(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); + StateE = crypto:stream_init(Type, Key, IV), + StateD = crypto:stream_init(Type, Key, IV), + stream_cipher_incment_loop(StateE, StateD, PlainTexts, [], iolist_to_binary(PlainTexts)); stream_cipher_incment({Type, Key, IV, PlainTexts, _CipherText}) -> stream_cipher_incment({Type, Key, IV, PlainTexts}). diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index fc08e7ca2f..bddd761705 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -90,8 +90,10 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native +else +ERL_COMPILE_FLAGS += -Werror endif -ERL_COMPILE_FLAGS += +warn_export_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +warnings_as_errors +ERL_COMPILE_FLAGS += +warn_export_vars +warn_unused_import +warn_untyped_record +warn_missing_spec # ---------------------------------------------------- # Targets diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index b686cfbf33..32d28b853b 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.11.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed two bugs in the <c>erl_call</c> program. A missing + initialization (introduced in <c>erl_interface-3.11</c>) + which either caused a crash or failure to connect to or + start a node, and an incorrectly calculated timeout which + could cause failure to start an erlang node. These bugs + only caused failures on some platforms.</p> + <p> + Own Id: OTP-15676 Aux Id: OTP-15442, ERL-881 </p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.11</title> <section><title>Improvements and New Features</title> diff --git a/lib/erl_interface/src/prog/ei_fake_prog.c b/lib/erl_interface/src/prog/ei_fake_prog.c index c7a16dc7c4..158464b385 100644 --- a/lib/erl_interface/src/prog/ei_fake_prog.c +++ b/lib/erl_interface/src/prog/ei_fake_prog.c @@ -98,11 +98,18 @@ int main(void) EI_ULONGLONG ulonglongx = 0; #endif erlang_char_encoding enc; + ei_socket_callbacks cbs; intx = erl_errno; + ei_init(); + + ei_close_connection(intx); + ei_connect_init(&xec, charp, charp, creation); + ei_connect_init_ussi(&xec, charp, charp, creation, &cbs, sizeof(cbs), NULL); ei_connect_xinit (&xec, charp, charp, charp, thisipaddr, charp, creation); + ei_connect_xinit_ussi(&xec, charp, charp, charp, thisipaddr, charp, creation, &cbs, sizeof(cbs), NULL); ei_connect(&xec, charp); ei_xconnect (&xec, thisipaddr, charp); @@ -121,6 +128,8 @@ int main(void) ei_publish(&xec, intx); ei_accept(&xec, intx, &conp); ei_unpublish(&xec); + ei_listen(&xec, intp, intx); + ei_xlisten(&xec, thisipaddr, intp, intx); ei_thisnodename(&xec); ei_thishostname(&xec); @@ -187,7 +196,7 @@ int main(void) ei_decode_char(charp, intp, charp); ei_decode_string(charp, intp, charp); ei_decode_atom(charp, intp, charp); - ei_decode_atom_as(charp, intp, charp, MAXATOMLEN_UTF8, ERLANG_WHATEVER, &enc, &enc); + ei_decode_atom_as(charp, intp, charp, MAXATOMLEN_UTF8, ERLANG_UTF8, &enc, &enc); ei_decode_binary(charp, intp, (void *)0, longp); ei_decode_fun(charp, intp, &efun); free_fun(&efun); diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c index 52ad6885e8..ab91157035 100644 --- a/lib/erl_interface/src/prog/erl_call.c +++ b/lib/erl_interface/src/prog/erl_call.c @@ -88,10 +88,6 @@ #include "ei_resolve.h" #include "erl_start.h" /* FIXME remove dependency */ -#ifdef __WIN32__ -static void initWinSock(void); -#endif - /* * Some nice global variables * (I don't think "nice" is the right word actually... -gordon) @@ -157,6 +153,8 @@ int erl_call(int argc, char **argv) char* progname = argv[0]; ei_cnode ec; + ei_init(); + /* Get the command line options */ while (i < argc) { if (argv[i][0] != '-') { @@ -317,14 +315,6 @@ int erl_call(int argc, char **argv) struct in_addr h_ipadr; char* ct; -#ifdef __WIN32__ - /* - * FIXME Extremly ugly, but needed to get ei_gethostbyname() below - * to work. - */ - initWinSock(); -#endif - /* gethostname requires len to be max(hostname) + 1 */ if (gethostname(h_hostname, EI_MAXHOSTNAMELEN+1) < 0) { fprintf(stderr,"erl_call: failed to get host name: %d\n", errno); @@ -857,46 +847,6 @@ static void usage(const char *progname) { exit(0); } - -/*************************************************************************** - * - * OS specific functions - * - ***************************************************************************/ - -#ifdef __WIN32__ -/* - * FIXME This should not be here. This is a quick fix to make erl_call - * work at all on Windows NT. - */ -static void initWinSock(void) -{ - WORD wVersionRequested; - WSADATA wsaData; - int err; - static int initialized; - - wVersionRequested = MAKEWORD(1, 1); - if (!initialized) { - initialized = 1; - err = WSAStartup(wVersionRequested, &wsaData); - - if (err != 0) { - fprintf(stderr,"erl_call: " - "Can't initialize windows sockets: %d\n", err); - } - - if ( LOBYTE( wsaData.wVersion ) != 1 || - HIBYTE( wsaData.wVersion ) != 1 ) { - fprintf(stderr,"erl_call: This version of " - "windows sockets not supported\n"); - WSACleanup(); - } - } -} -#endif - - /*************************************************************************** * * Utility functions diff --git a/lib/erl_interface/src/prog/erl_start.c b/lib/erl_interface/src/prog/erl_start.c index ba495ac818..b7aa451946 100644 --- a/lib/erl_interface/src/prog/erl_start.c +++ b/lib/erl_interface/src/prog/erl_start.c @@ -657,7 +657,7 @@ static int wait_for_erlang(int sockd, int magic, struct timeval *timeout) gettimeofday(&now,NULL); to.tv_sec = stop_time.tv_sec - now.tv_sec; to.tv_usec = stop_time.tv_usec - now.tv_usec; - while ((to.tv_usec <= 0) && (to.tv_sec >= 0)) { + while ((to.tv_usec < 0) && (to.tv_sec > 0)) { to.tv_usec += 1000000; to.tv_sec--; } diff --git a/lib/erl_interface/test/Makefile b/lib/erl_interface/test/Makefile index 94f4b422d6..f8f2ef0156 100644 --- a/lib/erl_interface/test/Makefile +++ b/lib/erl_interface/test/Makefile @@ -33,6 +33,7 @@ MODULES= \ ei_format_SUITE \ ei_print_SUITE \ ei_tmo_SUITE \ + erl_call_SUITE \ erl_connect_SUITE \ erl_global_SUITE \ erl_eterm_SUITE \ diff --git a/lib/erl_interface/test/erl_call_SUITE.erl b/lib/erl_interface/test/erl_call_SUITE.erl new file mode 100644 index 0000000000..9e2b2e4251 --- /dev/null +++ b/lib/erl_interface/test/erl_call_SUITE.erl @@ -0,0 +1,96 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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(erl_call_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, smoke/1]). + +all() -> + [smoke]. + +smoke(Config) when is_list(Config) -> + ErlCall = find_erl_call(), + NameSwitch = case net_kernel:longnames() of + true -> + "-name"; + false -> + "-sname" + end, + Name = atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(erlang:system_time(microsecond)), + + ArgsList = ["-s", "-a", "erlang node", NameSwitch, Name], + io:format("erl_call: \"~ts\"\n~nargs list: ~p~n", [ErlCall, ArgsList]), + CmdRes = get_smoke_port_res(open_port({spawn_executable, ErlCall}, + [{args, ArgsList}, eof]), []), + io:format("CmdRes: ~p~n", [CmdRes]), + + [_, Hostname] = string:lexemes(atom_to_list(node()), "@"), + NodeName = list_to_atom(Name ++ "@" ++ Hostname), + io:format("NodeName: ~p~n~n", [NodeName]), + + pong = net_adm:ping(NodeName), + rpc:cast(NodeName, erlang, halt, []), + NodeName = list_to_atom(string:trim(CmdRes, both, "'")), + ok. + +% +% Utility functions... +% + +find_erl_call() -> + ErlCallName = case os:type() of + {win32, _} -> "erl_call.exe"; + _ -> "erl_call" + end, + LibDir = code:lib_dir(erl_interface), + InstalledErlCall = filename:join([LibDir, "bin", ErlCallName]), + TargetDir = erlang:system_info(system_architecture), + TargetErlCall = filename:join([LibDir, "bin", TargetDir, ErlCallName]), + + try + lists:foreach(fun (F) -> + io:format("Checking: \"~ts\"~n", [F]), + case file:read_file_info(F) of + {ok, _} -> + throw(F); + _ -> + ok + end + end, + [InstalledErlCall, TargetErlCall]), + exit({missing, erl_call}) + catch + throw:ErlCall -> + ErlCall + end. + +get_smoke_port_res(Port, Acc) when is_port(Port) -> + receive + {Port, {data, Data}} -> + get_smoke_port_res(Port, [Acc|Data]); + {Port, eof} -> + lists:flatten(Acc) + end. + diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 0ed5c07bca..dae6052d55 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.11 +EI_VSN = 3.11.1 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile index f653dce36f..5c367b5b77 100644 --- a/lib/hipe/cerl/Makefile +++ b/lib/hipe/cerl/Makefile @@ -66,7 +66,10 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +inline -Werror +warn_export_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record +ERL_COMPILE_FLAGS += +inline +warn_export_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record +ifneq ($(NATIVE_LIBS_ENABLED),yes) +ERL_COMPILE_FLAGS += -Werror +endif # ---------------------------------------------------- # Targets diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index ffe81ef9b8..8e7e56b6c4 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1189,6 +1189,21 @@ trans_fun([raw_raise|Instructions], Env) -> [hipe_icode:mk_primop(Dst,raw_raise,Vars) | trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- +%% New binary matching added in OTP 22. +%%-------------------------------------------------------------------- +%%--- bs_get_tail --- +trans_fun([{bs_get_tail=Name,_,_,_}|_Instructions], _Env) -> + nyi(Name); +%%--- bs_start_match3 --- +trans_fun([{bs_start_match3=Name,_,_,_,_}|_Instructions], _Env) -> + nyi(Name); +%%--- bs_get_position --- +trans_fun([{bs_get_position=Name,_,_,_}|_Instructions], _Env) -> + nyi(Name); +%%--- bs_set_position --- +trans_fun([{bs_set_position=Name,_,_}|_Instructions], _Env) -> + nyi(Name); +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1196,6 +1211,9 @@ trans_fun([X|_], _) -> trans_fun([], _) -> []. +nyi(Name) -> + throw({unimplemented_instruction,Name}). + %%-------------------------------------------------------------------- %% trans_call and trans_enter generate correct Icode calls/tail-calls, %% recognizing explicit fails. diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile index 817ff67dcd..9f7a2def6d 100644 --- a/lib/hipe/llvm/Makefile +++ b/lib/hipe/llvm/Makefile @@ -70,7 +70,10 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += -Werror +inline +warn_export_vars #+warn_missing_spec +ERL_COMPILE_FLAGS += +inline +warn_export_vars #+warn_missing_spec +ifneq ($(NATIVE_LIBS_ENABLED),yes) +ERL_COMPILE_FLAGS += -Werror +endif # if in 32 bit backend define BIT32 symbol ifneq ($(BITS64),yes) diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 2348e9b1f6..094b7bc508 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -583,9 +583,8 @@ fix_beam_exports([], Exports) -> Exports. get_beam_icode(Mod, {BeamCode, Exports}, File, Options) -> - {ok, Icode} = - ?option_time((catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), - "BEAM-to-Icode", Options), + Icode = ?option_time(hipe_beam_to_icode:module(BeamCode, Options), + "BEAM-to-Icode", Options), BeamBin = get_beam_code(File), {{Mod, Exports, Icode}, BeamBin}. @@ -662,9 +661,12 @@ run_compiler_1(Name, DisasmFun, IcodeFun, Options) -> {Icode, WholeModule} = IcodeFun(Code, Opts), CompRes = compile_finish(Icode, WholeModule, Opts), compiler_return(CompRes, Parent) - catch error:Error:StackTrace -> + catch + error:Error:StackTrace -> print_crash_message(Name, Error, StackTrace), - exit(Error) + exit(Error); + throw:{unimplemented_instruction,_Instruction}=Error -> + exit(Error) end end), Timeout = case proplists:get_value(timeout, Options) of diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index becdd0b7d8..0c0f6e24f5 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -75,7 +75,10 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += -Werror +inline +warn_unused_import +warn_export_vars +ERL_COMPILE_FLAGS += +inline +warn_unused_import +warn_export_vars +ifneq ($(NATIVE_LIBS_ENABLED),yes) +ERL_COMPILE_FLAGS += -Werror +endif # ---------------------------------------------------- # Targets diff --git a/lib/kernel/examples/gen_tcp_dist/Makefile b/lib/kernel/examples/gen_tcp_dist/Makefile index 65513a1729..0c916835ea 100644 --- a/lib/kernel/examples/gen_tcp_dist/Makefile +++ b/lib/kernel/examples/gen_tcp_dist/Makefile @@ -2,9 +2,7 @@ RM=rm -f CP=cp EBIN=ebin ERLC=erlc -# Works if building in open source source tree -KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include -ERLCFLAGS+= -W -I$(KERNEL_INCLUDE) +ERLCFLAGS+= -W MODULES=gen_tcp_dist diff --git a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl index 98554ed805..cda4c470f9 100644 --- a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl +++ b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl @@ -53,10 +53,10 @@ -import(error_logger,[error_msg/2]). --include("net_address.hrl"). +-include_lib("kernel/include/net_address.hrl"). --include("dist.hrl"). --include("dist_util.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). %% ------------------------------------------------------------ %% Select this protocol based on node name @@ -679,7 +679,14 @@ dist_cntrlr_setup_loop(Socket, TickHandler, Sup) -> %% From now on we execute on normal priority process_flag(priority, normal), erlang:dist_ctrl_get_data_notification(DHandle), - dist_cntrlr_output_loop(DHandle, Socket) + case init:get_argument(gen_tcp_dist_output_loop) of + error -> + dist_cntrlr_output_loop(DHandle, Socket); + {ok, [[ModStr, FuncStr]]} -> % For testing... + apply(list_to_atom(ModStr), + list_to_atom(FuncStr), + [DHandle, Socket]) + end end. %% We use active 10 for good throughput while still diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 43b776f37e..fcb599859b 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -175,8 +175,10 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native +else +ERL_COMPILE_FLAGS += -Werror endif -ERL_COMPILE_FLAGS += -I../include -Werror +ERL_COMPILE_FLAGS += -I../include # ---------------------------------------------------- # Targets diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 9a8091fb2e..7715dca7c6 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -537,14 +537,12 @@ check_conf_data(ConfData) when is_list(ConfData) -> {AppName, List} when is_atom(AppName), is_list(List) -> case lists:keymember(AppName, 1, ConfDataRem) of true -> - ?LOG_WARNING("duplicate application config: " ++ atom_to_list(AppName)); + {error, "duplicate application config: " ++ atom_to_list(AppName)}; false -> - ok - end, - - case check_para(List, AppName) of - ok -> check_conf_data(ConfDataRem); - Error -> Error + case check_para(List, AppName) of + ok -> check_conf_data(ConfDataRem); + Error -> Error + end end; {AppName, List} when is_list(List) -> ErrMsg = "application: " @@ -570,15 +568,14 @@ check_para([], _AppName) -> check_para([{Para, Val} | ParaList], AppName) when is_atom(Para) -> case lists:keymember(Para, 1, ParaList) of true -> - ?LOG_WARNING("application: " ++ atom_to_list(AppName) ++ - "; duplicate parameter: " ++ atom_to_list(Para)); + ErrMsg = "application: " ++ atom_to_list(AppName) + ++ "; duplicate parameter: " ++ atom_to_list(Para), + {error, ErrMsg}; false -> - ok - end, - - case check_para_value(Para, Val, AppName) of - ok -> check_para(ParaList, AppName); - {error, _} = Error -> Error + case check_para_value(Para, Val, AppName) of + ok -> check_para(ParaList, AppName); + {error, _} = Error -> Error + end end; check_para([{Para, _Val} | _ParaList], AppName) -> {error, "application: " ++ atom_to_list(AppName) ++ "; invalid parameter name: " ++ diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index a38522eb5c..3875074d74 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -50,10 +50,9 @@ %% This is for backward compatibility only; the functionality is broken. -define(WARN_DUPLICATED_NAME, global_multi_name_action). -%% Undocumented Kernel variable. Set this to 0 (zero) to get the old -%% behaviour. +%% Undocumented Kernel variable. -define(N_CONNECT_RETRIES, global_connect_retries). --define(DEFAULT_N_CONNECT_RETRIES, 5). +-define(DEFAULT_N_CONNECT_RETRIES, 0). %%% In certain places in the server, calling io:format hangs everything, %%% so we'd better use erlang:display/1. @@ -125,16 +124,12 @@ %%% There are also ETS tables used for bookkeeping of locks and names %%% (the first position is the key): %%% -%%% global_locks (set): {ResourceId, LockRequesterId, [{Pid,RPid,ref()]} +%%% global_locks (set): {ResourceId, LockRequesterId, [{Pid,ref()]} %%% Pid is locking ResourceId, ref() is the monitor ref. -%%% RPid =/= Pid if there is an extra process calling erlang:monitor(). -%%% global_names (set): {Name, Pid, Method, RPid, ref()} +%%% global_names (set): {Name, Pid, Method, ref()} %%% Registered names. ref() is the monitor ref. -%%% RPid =/= Pid if there is an extra process calling erlang:monitor(). %%% global_names_ext (set): {Name, Pid, RegNode} %%% External registered names (C-nodes). -%%% (The RPid:s can be removed when/if erlang:monitor() returns before -%%% trying to connect to the other node.) %%% %%% Helper tables: %%% global_pid_names (bag): {Pid, Name} | {ref(), Name} @@ -310,7 +305,7 @@ re_register_name(Name, Pid, Method0) when is_pid(Pid) -> -spec registered_names() -> [Name] when Name :: term(). registered_names() -> - MS = ets:fun2ms(fun({Name,_Pid,_M,_RP,_R}) -> Name end), + MS = ets:fun2ms(fun({Name,_Pid,_M,_R}) -> Name end), ets:select(global_names, MS). %%----------------------------------------------------------------- @@ -1235,7 +1230,7 @@ ins_name_ext(Name, Pid, Method, RegNode, FromPidOrNode, ExtraInfo, S0) -> where(Name) -> case ets:lookup(global_names, Name) of - [{_Name, Pid, _Method, _RPid, _Ref}] -> + [{_Name, Pid, _Method, _Ref}] -> if node(Pid) == node() -> case is_process_alive(Pid) of true -> Pid; @@ -1272,10 +1267,10 @@ can_set_lock({ResourceId, LockRequesterId}) -> end. insert_lock({ResourceId, LockRequesterId}=Id, Pid, PidRefs, S) -> - {RPid, Ref} = do_monitor(Pid), + Ref = erlang:monitor(process, Pid), true = ets:insert(global_pid_ids, {Pid, ResourceId}), true = ets:insert(global_pid_ids, {Ref, ResourceId}), - Lock = {ResourceId, LockRequesterId, [{Pid,RPid,Ref} | PidRefs]}, + Lock = {ResourceId, LockRequesterId, [{Pid,Ref} | PidRefs]}, true = ets:insert(global_locks, Lock), trace_message(S, {ins_lock, node(Pid)}, [Id, Pid]). @@ -1293,10 +1288,9 @@ handle_del_lock({ResourceId, LockReqId}, Pid, S0) -> _ -> S0 end. -remove_lock(ResourceId, LockRequesterId, Pid, [{Pid,RPid,Ref}], Down, S0) -> +remove_lock(ResourceId, LockRequesterId, Pid, [{Pid,Ref}], Down, S0) -> ?trace({remove_lock_1, {id,ResourceId},{pid,Pid}}), true = erlang:demonitor(Ref, [flush]), - kill_monitor_proc(RPid, Pid), true = ets:delete(global_locks, ResourceId), true = ets:delete_object(global_pid_ids, {Pid, ResourceId}), true = ets:delete_object(global_pid_ids, {Ref, ResourceId}), @@ -1309,9 +1303,8 @@ remove_lock(ResourceId, LockRequesterId, Pid, [{Pid,RPid,Ref}], Down, S0) -> remove_lock(ResourceId, LockRequesterId, Pid, PidRefs0, _Down, S) -> ?trace({remove_lock_2, {id,ResourceId},{pid,Pid}}), PidRefs = case lists:keyfind(Pid, 1, PidRefs0) of - {Pid, RPid, Ref} -> + {Pid, Ref} -> true = erlang:demonitor(Ref, [flush]), - kill_monitor_proc(RPid, Pid), true = ets:delete_object(global_pid_ids, {Ref, ResourceId}), lists:keydelete(Pid, 1, PidRefs0); @@ -1324,11 +1317,6 @@ remove_lock(ResourceId, LockRequesterId, Pid, PidRefs0, _Down, S) -> trace_message(S, {rem_lock, node(Pid)}, [{ResourceId, LockRequesterId}, Pid]). -kill_monitor_proc(Pid, Pid) -> - ok; -kill_monitor_proc(RPid, _Pid) -> - exit(RPid, kill). - do_ops(Ops, ConnNode, Names_ext, ExtraInfo, S0) -> ?trace({do_ops, {ops,Ops}}), @@ -1394,8 +1382,8 @@ sync_other(Node, N) -> % exit(normal). insert_global_name(Name, Pid, Method, FromPidOrNode, ExtraInfo, S) -> - {RPid, Ref} = do_monitor(Pid), - true = ets:insert(global_names, {Name, Pid, Method, RPid, Ref}), + Ref = erlang:monitor(process, Pid), + true = ets:insert(global_names, {Name, Pid, Method, Ref}), true = ets:insert(global_pid_names, {Pid, Name}), true = ets:insert(global_pid_names, {Ref, Name}), case lock_still_set(FromPidOrNode, ExtraInfo, S) of @@ -1437,7 +1425,7 @@ extra_info(Tag, ExtraInfo) -> del_name(Ref, S) -> NameL = [Name || {_, Name} <- ets:lookup(global_pid_names, Ref), - {_, _Pid, _Method, _RPid, Ref1} <- + {_, _Pid, _Method, Ref1} <- ets:lookup(global_names, Name), Ref1 =:= Ref], case NameL of @@ -1450,24 +1438,23 @@ del_name(Ref, S) -> %% Keeps the entry in global_names for whereis_name/1. delete_global_name_keep_pid(Name, S) -> case ets:lookup(global_names, Name) of - [{Name, Pid, _Method, RPid, Ref}] -> - delete_global_name2(Name, Pid, RPid, Ref, S); + [{Name, Pid, _Method, Ref}] -> + delete_global_name2(Name, Pid, Ref, S); [] -> S end. delete_global_name2(Name, S) -> case ets:lookup(global_names, Name) of - [{Name, Pid, _Method, RPid, Ref}] -> + [{Name, Pid, _Method, Ref}] -> true = ets:delete(global_names, Name), - delete_global_name2(Name, Pid, RPid, Ref, S); + delete_global_name2(Name, Pid, Ref, S); [] -> S end. -delete_global_name2(Name, Pid, RPid, Ref, S) -> +delete_global_name2(Name, Pid, Ref, S) -> true = erlang:demonitor(Ref, [flush]), - kill_monitor_proc(RPid, Pid), delete_global_name(Name, Pid), ?trace({delete_global_name,{item,Name},{pid,Pid}}), true = ets:delete_object(global_pid_names, {Pid, Name}), @@ -1929,9 +1916,9 @@ reset_node_state(Node) -> %% from the same partition. exchange_names([{Name, Pid, Method} | Tail], Node, Ops, Res) -> case ets:lookup(global_names, Name) of - [{Name, Pid, _Method, _RPid2, _Ref2}] -> + [{Name, Pid, _Method, _Ref2}] -> exchange_names(Tail, Node, Ops, Res); - [{Name, Pid2, Method2, _RPid2, _Ref2}] when node() < Node -> + [{Name, Pid2, Method2, _Ref2}] when node() < Node -> %% Name clash! Add the result of resolving to Res(olved). %% We know that node(Pid) =/= node(), so we don't %% need to link/unlink to Pid. @@ -1960,7 +1947,7 @@ exchange_names([{Name, Pid, Method} | Tail], Node, Ops, Res) -> Op = {delete, Name}, exchange_names(Tail, Node, [Op | Ops], [Op | Res]) end; - [{Name, _Pid2, _Method, _RPid, _Ref}] -> + [{Name, _Pid2, _Method, _Ref}] -> %% The other node will solve the conflict. exchange_names(Tail, Node, Ops, Res); _ -> @@ -2036,7 +2023,7 @@ pid_is_locking(Pid, PidRefs) -> delete_lock(Ref, S0) -> Locks = pid_locks(Ref), F = fun({ResourceId, LockRequesterId, PidRefs}, S) -> - {Pid, _RPid, Ref} = lists:keyfind(Ref, 3, PidRefs), + {Pid, Ref} = lists:keyfind(Ref, 2, PidRefs), remove_lock(ResourceId, LockRequesterId, Pid, PidRefs, true, S) end, lists:foldl(F, S0, Locks). @@ -2046,10 +2033,10 @@ pid_locks(Ref) -> ets:lookup(global_locks, ResourceId) end, ets:lookup(global_pid_ids, Ref)), [Lock || Lock = {_Id, _Req, PidRefs} <- L, - rpid_is_locking(Ref, PidRefs)]. + ref_is_locking(Ref, PidRefs)]. -rpid_is_locking(Ref, PidRefs) -> - lists:keyfind(Ref, 3, PidRefs) =/= false. +ref_is_locking(Ref, PidRefs) -> + lists:keyfind(Ref, 2, PidRefs) =/= false. handle_nodedown(Node, S) -> %% DOWN signals from monitors have removed locks and registered names. @@ -2062,7 +2049,7 @@ handle_nodedown(Node, S) -> get_names() -> ets:select(global_names, - ets:fun2ms(fun({Name, Pid, Method, _RPid, _Ref}) -> + ets:fun2ms(fun({Name, Pid, Method, _Ref}) -> {Name, Pid, Method} end)). @@ -2205,24 +2192,6 @@ unexpected_message(Message, What) -> %%% Utilities -%% When/if erlang:monitor() returns before trying to connect to the -%% other node this function can be removed. -do_monitor(Pid) -> - case (node(Pid) =:= node()) orelse lists:member(node(Pid), nodes()) of - true -> - %% Assume the node is still up - {Pid, erlang:monitor(process, Pid)}; - false -> - F = fun() -> - Ref = erlang:monitor(process, Pid), - receive - {'DOWN', Ref, process, Pid, _Info} -> - exit(normal) - end - end, - erlang:spawn_monitor(F) - end. - intersection(_, []) -> []; intersection(L1, L2) -> diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index d203597fc2..6763a04d9f 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -57,6 +57,7 @@ MODULES= \ prim_file_SUITE \ ram_file_SUITE \ gen_tcp_api_SUITE \ + gen_tcp_dist \ gen_tcp_echo_SUITE \ gen_tcp_misc_SUITE \ gen_udp_SUITE \ @@ -137,7 +138,10 @@ TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # Targets # ---------------------------------------------------- -make_emakefile: +gen_tcp_dist.erl: ../examples/gen_tcp_dist/src/gen_tcp_dist.erl + cp $< $@ + +make_emakefile: $(ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ > $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 94d7c17712..1ab554db7c 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -2020,18 +2020,11 @@ set_env_errors(Conf) when is_list(Conf) -> "application: kernel; erroneous parameter: distributed" = badarg_msg(fun() -> application:set_env([{kernel, [{distributed, config}]}]) end), - %% This will raise in the future - ct:capture_start(), - _ = application:set_env([{foo, []}, {foo, []}]), - timer:sleep(100), - ct:capture_stop(), - [_ | _] = string:find(ct:capture_get(), "duplicate application config: foo"), - - ct:capture_start(), - _ = application:set_env([{foo, [{bar, baz}, {bar, bat}]}]), - timer:sleep(100), - ct:capture_stop(), - [_ | _] = string:find(ct:capture_get(), "application: foo; duplicate parameter: bar"), + "duplicate application config: foo" = + badarg_msg(fun() -> application:set_env([{foo, []}, {foo, []}]) end), + + "application: foo; duplicate parameter: bar" = + badarg_msg(fun() -> application:set_env([{foo, [{bar, baz}, {bar, bat}]}]) end), ok. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 64e0b9d8dd..99fecbe970 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -140,6 +140,11 @@ end_per_testcase(on_load_embedded, Config) -> LinkName = proplists:get_value(link_name, Config), _ = del_link(LinkName), end_per_testcase(Config); +end_per_testcase(upgrade, Config) -> + %% Make sure tracing is turned off even if the test times out. + erlang:trace_pattern({error_handler,undefined_function,3}, false, [global]), + erlang:trace(self(), false, [call]), + end_per_testcase(Config); end_per_testcase(_Func, Config) -> end_per_testcase(Config). @@ -1556,6 +1561,11 @@ on_load_update_code_1(3, Mod) -> %% Test -on_load while trace feature 'on_load' is enabled (OTP-14612) on_load_trace_on_load(Config) -> + %% 'on_load' enables tracing for all newly loaded modules, so we make a dry + %% run to ensure that ancillary modules like 'merl' won't be loaded during + %% the actual test. + on_load_update(Config), + Papa = self(), Tracer = spawn_link(fun F() -> receive M -> Papa ! M end, F() end), {tracer,[]} = erlang:trace_info(self(),tracer), diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 5a8bbd56c4..8dd4ef1987 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -40,7 +40,8 @@ monitor_nodes_errors/1, monitor_nodes_combinations/1, monitor_nodes_cleanup/1, - monitor_nodes_many/1]). + monitor_nodes_many/1, + dist_ctrl_proc_smoke/1]). %% Performs the test at another node. -export([get_socket_priorities/0, @@ -52,7 +53,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --export([start_node/2]). +-export([dist_cntrlr_output_test/2]). -export([pinger/1]). @@ -67,10 +68,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,4}}]. + {timetrap,{minutes,12}}]. all() -> - [tick, tick_change, nodenames, hostnames, illegal_nodenames, + [dist_ctrl_proc_smoke, + tick, tick_change, nodenames, hostnames, illegal_nodenames, connect_node, hidden_node, setopts, table_waste, net_setuptime, inet_dist_options_options, @@ -116,10 +118,12 @@ connect_node(Config) when is_list(Config) -> ok. tick(Config) when is_list(Config) -> - PaDir = filename:dirname(code:which(erl_distribution_SUITE)), + run_dist_configs(fun tick/2, Config). +tick(DCfg, _Config) -> %% First check that the normal case is OK! - {ok, Node} = start_node(dist_test, "-pa " ++ PaDir), + [Name1, Name2] = get_nodenames(2, dist_test), + {ok, Node} = start_node(DCfg, Name1), rpc:call(Node, erl_distribution_SUITE, tick_cli_test, [node()]), erlang:monitor_node(Node, true), @@ -143,14 +147,12 @@ tick(Config) when is_list(Config) -> %% Set the ticktime on the server node to 100 secs so the server %% node doesn't tick the client node within the interval ... - {ok, ServNode} = start_node(dist_test_server, - "-kernel net_ticktime 100 " - "-pa " ++ PaDir), + {ok, ServNode} = start_node(DCfg, Name2, + "-kernel net_ticktime 100"), rpc:call(ServNode, erl_distribution_SUITE, tick_serv_test, [Node, node()]), - {ok, _} = start_node(dist_test, - "-kernel net_ticktime 12 " - "-pa " ++ PaDir), + {ok, Node} = start_node(DCfg, Name1, + "-kernel net_ticktime 12"), rpc:call(Node, erl_distribution_SUITE, tick_cli_test, [ServNode]), spawn_link(erl_distribution_SUITE, keep_conn, [Node]), @@ -180,6 +182,9 @@ tick(Config) when is_list(Config) -> %% Checks that pinging nonexistyent nodes does not waste space in distribution table. table_waste(Config) when is_list(Config) -> + run_dist_configs(fun table_waste/2, Config). + +table_waste(DCfg, _Config) -> {ok, HName} = inet:gethostname(), F = fun(0,_F) -> []; (N,F) -> @@ -189,7 +194,7 @@ table_waste(Config) when is_list(Config) -> F(N-1,F) end, F(256,F), - {ok, N} = start_node(erl_distribution_300,""), + {ok, N} = start_node(DCfg, erl_distribution_300), stop_node(N), ok. @@ -295,13 +300,16 @@ gethostname() -> %% Test that pinging an illegal nodename does not kill the node. illegal_nodenames(Config) when is_list(Config) -> - PaDir = filename:dirname(code:which(erl_distribution_SUITE)), - {ok, Node}=start_node(illegal_nodenames, "-pa " ++ PaDir), + run_dist_configs(fun illegal_nodenames/2, Config). + +illegal_nodenames(DCfg, _Config) -> + {ok, Node}=start_node(DCfg, illegal_nodenames), monitor_node(Node, true), RPid=rpc:call(Node, erlang, spawn, [?MODULE, pinger, [self()]]), receive {RPid, pinged} -> + monitor_node(Node, false), ok; {nodedown, Node} -> ct:fail("Remote node died.") @@ -318,22 +326,25 @@ pinger(Starter) -> %% Test that you can set the net_setuptime properly. net_setuptime(Config) when is_list(Config) -> + run_dist_configs(fun net_setuptime/2, Config). + +net_setuptime(DCfg, _Config) -> + %% In this test case, we reluctantly accept shorter times than the given %% setup time, because the connection attempt can end in a %% "Host unreachable" error before the timeout fires. - Res0 = do_test_setuptime("2"), + Res0 = do_test_setuptime(DCfg, "2"), io:format("Res0 = ~p", [Res0]), true = (Res0 =< 4000), - Res1 = do_test_setuptime("0.3"), + Res1 = do_test_setuptime(DCfg, "0.3"), io:format("Res1 = ~p", [Res1]), true = (Res1 =< 500), ok. -do_test_setuptime(Setuptime) when is_list(Setuptime) -> - PaDir = filename:dirname(code:which(?MODULE)), - {ok, Node} = start_node(dist_setuptime_test, "-pa " ++ PaDir ++ - " -kernel net_setuptime " ++ Setuptime), +do_test_setuptime(DCfg, Setuptime) when is_list(Setuptime) -> + {ok, Node} = start_node(DCfg, dist_setuptime_test, + "-kernel net_setuptime " ++ Setuptime), Res = rpc:call(Node,?MODULE,time_ping,[?DUMMY_NODE]), stop_node(Node), Res. @@ -399,32 +410,36 @@ tick_cli_test1(Node) -> end. setopts(Config) when is_list(Config) -> + run_dist_configs(fun setopts/2, Config). + +setopts(DCfg, _Config) -> register(setopts_regname, self()), [N1,N2,N3,N4] = get_nodenames(4, setopts), - {_N1F,Port1} = start_node_unconnected(N1, ?MODULE, run_remote_test, + {_N1F,Port1} = start_node_unconnected(DCfg, N1, ?MODULE, run_remote_test, ["setopts_do", atom_to_list(node()), "1", "ping"]), 0 = wait_for_port_exit(Port1), - {_N2F,Port2} = start_node_unconnected(N2, ?MODULE, run_remote_test, + {_N2F,Port2} = start_node_unconnected(DCfg, N2, ?MODULE, run_remote_test, ["setopts_do", atom_to_list(node()), "2", "ping"]), 0 = wait_for_port_exit(Port2), {ok, LSock} = gen_tcp:listen(0, [{packet,2}, {active,false}]), {ok, LTcpPort} = inet:port(LSock), - {N3F,Port3} = start_node_unconnected(N3, ?MODULE, run_remote_test, + {N3F,Port3} = start_node_unconnected(DCfg, N3, ?MODULE, run_remote_test, ["setopts_do", atom_to_list(node()), "1", integer_to_list(LTcpPort)]), wait_and_connect(LSock, N3F, Port3), 0 = wait_for_port_exit(Port3), - {N4F,Port4} = start_node_unconnected(N4, ?MODULE, run_remote_test, + {N4F,Port4} = start_node_unconnected(DCfg, N4, ?MODULE, run_remote_test, ["setopts_do", atom_to_list(node()), "2", integer_to_list(LTcpPort)]), wait_and_connect(LSock, N4F, Port4), 0 = wait_for_port_exit(Port4), + unregister(setopts_regname), ok. wait_and_connect(LSock, NodeName, NodePort) -> @@ -518,9 +533,9 @@ opt_from_nr("2") -> {nodelay, false}. change_val(true) -> false; change_val(false) -> true. -start_node_unconnected(Name, Mod, Func, Args) -> +start_node_unconnected(DCfg, Name, Mod, Func, Args) -> FullName = full_node_name(Name), - CmdLine = mk_node_cmdline(Name,Mod,Func,Args), + CmdLine = mk_node_cmdline(DCfg, Name,Mod,Func,Args), io:format("Starting node ~p: ~s~n", [FullName, CmdLine]), case open_port({spawn, CmdLine}, [exit_status]) of Port when is_port(Port) -> @@ -534,7 +549,7 @@ full_node_name(PreName) -> atom_to_list(node())), list_to_atom(atom_to_list(PreName) ++ HostSuffix). -mk_node_cmdline(Name,Mod,Func,Args) -> +mk_node_cmdline(DCfg, Name,Mod,Func,Args) -> Static = "-noinput", Pa = filename:dirname(code:which(?MODULE)), Prog = case catch init:get_argument(progname) of @@ -551,6 +566,7 @@ mk_node_cmdline(Name,Mod,Func,Args) -> Prog ++ " " ++ Static ++ " " ++ NameSw ++ " " ++ NameStr + ++ " " ++ DCfg ++ " -pa " ++ Pa ++ " -env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " -setcookie " ++ atom_to_list(erlang:get_cookie()) @@ -560,7 +576,9 @@ mk_node_cmdline(Name,Mod,Func,Args) -> %% OTP-4255. tick_change(Config) when is_list(Config) -> - PaDir = filename:dirname(code:which(?MODULE)), + run_dist_configs(fun tick_change/2, Config). + +tick_change(DCfg, _Config) -> [BN, CN] = get_nodenames(2, tick_change), DefaultTT = net_kernel:get_net_ticktime(), unchanged = net_kernel:set_net_ticktime(DefaultTT, 60), @@ -577,14 +595,13 @@ tick_change(Config) when is_list(Config) -> end, wait_until(fun () -> 10 == net_kernel:get_net_ticktime() end), - {ok, B} = start_node(BN, "-kernel net_ticktime 10 -pa " ++ PaDir), - {ok, C} = start_node(CN, "-kernel net_ticktime 10 -hidden -pa " - ++ PaDir), + {ok, B} = start_node(DCfg, BN, "-kernel net_ticktime 10"), + {ok, C} = start_node(DCfg, CN, "-kernel net_ticktime 10 -hidden"), OTE = process_flag(trap_exit, true), case catch begin - run_tick_change_test(B, C, 10, 1, PaDir), - run_tick_change_test(B, C, 1, 10, PaDir) + run_tick_change_test(DCfg, B, C, 10, 1), + run_tick_change_test(DCfg, B, C, 1, 10) end of {'EXIT', Reason} -> stop_node(B), @@ -626,7 +643,7 @@ wait_for_nodedowns(Tester, Ref) -> end, wait_for_nodedowns(Tester, Ref). -run_tick_change_test(B, C, PrevTT, TT, PaDir) -> +run_tick_change_test(DCfg, B, C, PrevTT, TT) -> [DN, EN] = get_nodenames(2, tick_change), Tester = self(), @@ -640,8 +657,8 @@ run_tick_change_test(B, C, PrevTT, TT, PaDir) -> wait_for_nodedowns(Tester, Ref) end, - {ok, D} = start_node(DN, "-kernel net_ticktime " - ++ integer_to_list(PrevTT) ++ " -pa " ++ PaDir), + {ok, D} = start_node(DCfg, DN, "-kernel net_ticktime " + ++ integer_to_list(PrevTT)), NMA = spawn_link(fun () -> MonitorNodes([B, C, D]) end), NMB = spawn_link(B, fun () -> MonitorNodes([node(), C, D]) end), @@ -674,8 +691,8 @@ run_tick_change_test(B, C, PrevTT, TT, PaDir) -> sleep(7), change_initiated = rpc:call(C,net_kernel,set_net_ticktime,[TT,10]), - {ok, E} = start_node(EN, "-kernel net_ticktime " - ++ integer_to_list(TT) ++ " -pa " ++ PaDir), + {ok, E} = start_node(DCfg, EN, "-kernel net_ticktime " + ++ integer_to_list(TT)), NME = spawn_link(E, fun () -> MonitorNodes([node(), B, C, D]) end), NMA2 = spawn_link(fun () -> MonitorNodes([E]) end), NMB2 = spawn_link(B, fun () -> MonitorNodes([E]) end), @@ -735,12 +752,13 @@ run_tick_change_test(B, C, PrevTT, TT, PaDir) -> %% %% Basic test of hidden node. hidden_node(Config) when is_list(Config) -> - PaDir = filename:dirname(code:which(?MODULE)), - VArgs = "-pa " ++ PaDir, - HArgs = "-hidden -pa " ++ PaDir, - {ok, V} = start_node(visible_node, VArgs), + run_dist_configs(fun hidden_node/2, Config). + +hidden_node(DCfg, _Config) -> + HArgs = "-hidden", + {ok, V} = start_node(DCfg, visible_node), VMN = start_monitor_nodes_proc(V), - {ok, H} = start_node(hidden_node, HArgs), + {ok, H} = start_node(DCfg, hidden_node, HArgs), %% Connect visible_node -> hidden_node connect_nodes(V, H), test_nodes(V, H), @@ -748,9 +766,9 @@ hidden_node(Config) when is_list(Config) -> sleep(5), check_monitor_nodes_res(VMN, H), stop_node(V), - {ok, H} = start_node(hidden_node, HArgs), + {ok, H} = start_node(DCfg, hidden_node, HArgs), HMN = start_monitor_nodes_proc(H), - {ok, V} = start_node(visible_node, VArgs), + {ok, V} = start_node(DCfg, visible_node), %% Connect hidden_node -> visible_node connect_nodes(H, V), test_nodes(V, H), @@ -850,9 +868,9 @@ do_inet_dist_options_options(Prio) -> "-kernel inet_dist_connect_options "++PriorityString++" " "-kernel inet_dist_listen_options "++PriorityString, {ok,Node1} = - start_node(inet_dist_options_1, InetDistOptions), + start_node("", inet_dist_options_1, InetDistOptions), {ok,Node2} = - start_node(inet_dist_options_2, InetDistOptions), + start_node("", inet_dist_options_2, InetDistOptions), %% pong = rpc:call(Node1, net_adm, ping, [Node2]), @@ -885,6 +903,9 @@ get_socket_priorities() -> %% monitor_nodes_nodedown_reason(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_nodedown_reason/2, Config). + +monitor_nodes_nodedown_reason(DCfg, _Config) -> MonNodeState = monitor_node_state(), ok = net_kernel:monitor_nodes(true), ok = net_kernel:monitor_nodes(true, [nodedown_reason]), @@ -892,10 +913,10 @@ monitor_nodes_nodedown_reason(Config) when is_list(Config) -> Names = get_numbered_nodenames(5, node), [NN1, NN2, NN3, NN4, NN5] = Names, - {ok, N1} = start_node(NN1), - {ok, N2} = start_node(NN2), - {ok, N3} = start_node(NN3), - {ok, N4} = start_node(NN4, "-hidden"), + {ok, N1} = start_node(DCfg, NN1), + {ok, N2} = start_node(DCfg, NN2), + {ok, N3} = start_node(DCfg, NN3), + {ok, N4} = start_node(DCfg, NN4, "-hidden"), receive {nodeup, N1} -> ok end, receive {nodeup, N2} -> ok end, @@ -925,7 +946,7 @@ monitor_nodes_nodedown_reason(Config) when is_list(Config) -> ok = net_kernel:monitor_nodes(false, [nodedown_reason]), - {ok, N5} = start_node(NN5), + {ok, N5} = start_node(DCfg, NN5), stop_node(N5), receive {nodeup, N5} -> ok end, @@ -938,11 +959,14 @@ monitor_nodes_nodedown_reason(Config) when is_list(Config) -> monitor_nodes_complex_nodedown_reason(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_complex_nodedown_reason/2, Config). + +monitor_nodes_complex_nodedown_reason(DCfg, _Config) -> MonNodeState = monitor_node_state(), Me = self(), ok = net_kernel:monitor_nodes(true, [nodedown_reason]), [Name] = get_nodenames(1, monitor_nodes_complex_nodedown_reason), - {ok, Node} = start_node(Name, ""), + {ok, Node} = start_node(DCfg, Name, ""), Pid = spawn(Node, fun() -> Me ! {stuff, @@ -981,16 +1005,19 @@ monitor_nodes_complex_nodedown_reason(Config) when is_list(Config) -> %% monitor_nodes_node_type(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_node_type/2, Config). + +monitor_nodes_node_type(DCfg, _Config) -> MonNodeState = monitor_node_state(), ok = net_kernel:monitor_nodes(true), ok = net_kernel:monitor_nodes(true, [{node_type, all}]), Names = get_numbered_nodenames(9, node), [NN1, NN2, NN3, NN4, NN5, NN6, NN7, NN8, NN9] = Names, - {ok, N1} = start_node(NN1), - {ok, N2} = start_node(NN2), - {ok, N3} = start_node(NN3, "-hidden"), - {ok, N4} = start_node(NN4, "-hidden"), + {ok, N1} = start_node(DCfg, NN1), + {ok, N2} = start_node(DCfg, NN2), + {ok, N3} = start_node(DCfg, NN3, "-hidden"), + {ok, N4} = start_node(DCfg, NN4, "-hidden"), receive {nodeup, N1} -> ok end, receive {nodeup, N2} -> ok end, @@ -1014,15 +1041,15 @@ monitor_nodes_node_type(Config) when is_list(Config) -> receive {nodedown, N4, [{node_type, hidden}]} -> ok end, ok = net_kernel:monitor_nodes(false, [{node_type, all}]), - {ok, N5} = start_node(NN5), + {ok, N5} = start_node(DCfg, NN5), receive {nodeup, N5} -> ok end, stop_node(N5), receive {nodedown, N5} -> ok end, ok = net_kernel:monitor_nodes(true, [{node_type, hidden}]), - {ok, N6} = start_node(NN6), - {ok, N7} = start_node(NN7, "-hidden"), + {ok, N6} = start_node(DCfg, NN6), + {ok, N7} = start_node(DCfg, NN7, "-hidden"), receive {nodeup, N6} -> ok end, @@ -1037,8 +1064,8 @@ monitor_nodes_node_type(Config) when is_list(Config) -> ok = net_kernel:monitor_nodes(false, [{node_type, hidden}]), ok = net_kernel:monitor_nodes(false), - {ok, N8} = start_node(NN8), - {ok, N9} = start_node(NN9, "-hidden"), + {ok, N8} = start_node(DCfg, NN8), + {ok, N9} = start_node(DCfg, NN9, "-hidden"), receive {nodeup, N8, [{node_type, visible}]} -> ok end, stop_node(N8), @@ -1058,6 +1085,9 @@ monitor_nodes_node_type(Config) when is_list(Config) -> %% monitor_nodes_misc(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_misc/2, Config). + +monitor_nodes_misc(DCfg, _Config) -> MonNodeState = monitor_node_state(), ok = net_kernel:monitor_nodes(true), ok = net_kernel:monitor_nodes(true, [{node_type, all}, nodedown_reason]), @@ -1065,8 +1095,8 @@ monitor_nodes_misc(Config) when is_list(Config) -> Names = get_numbered_nodenames(3, node), [NN1, NN2, NN3] = Names, - {ok, N1} = start_node(NN1), - {ok, N2} = start_node(NN2, "-hidden"), + {ok, N1} = start_node(DCfg, NN1), + {ok, N2} = start_node(DCfg, NN2, "-hidden"), receive {nodeup, N1} -> ok end, @@ -1092,7 +1122,7 @@ monitor_nodes_misc(Config) when is_list(Config) -> ok = net_kernel:monitor_nodes(false, [{node_type, all}, nodedown_reason]), - {ok, N3} = start_node(NN3), + {ok, N3} = start_node(DCfg, NN3), receive {nodeup, N3} -> ok end, stop_node(N3), receive {nodedown, N3} -> ok end, @@ -1107,15 +1137,18 @@ monitor_nodes_misc(Config) when is_list(Config) -> %% messages from Node and that {nodedown, Node} messages are %% received after messages from Node. monitor_nodes_otp_6481(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_otp_6481/2, Config). + +monitor_nodes_otp_6481(DCfg, Config) -> io:format("Testing nodedown...~n"), - monitor_nodes_otp_6481_test(Config, nodedown), + monitor_nodes_otp_6481_test(DCfg, Config, nodedown), io:format("ok~n"), io:format("Testing nodeup...~n"), - monitor_nodes_otp_6481_test(Config, nodeup), + monitor_nodes_otp_6481_test(DCfg, Config, nodeup), io:format("ok~n"), ok. -monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> +monitor_nodes_otp_6481_test(DCfg, Config, TestType) when is_list(Config) -> MonNodeState = monitor_node_state(), NodeMsg = make_ref(), Me = self(), @@ -1164,7 +1197,7 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> end ++ MonNodeState, - {ok, Node} = start_node(Name, "", this), + {ok, Node} = start_node(DCfg, Name, "", this), receive {nodeup, Node} -> ok end, RemotePid = spawn(Node, @@ -1249,17 +1282,20 @@ monitor_nodes_errors(Config) when is_list(Config) -> ok. monitor_nodes_combinations(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_combinations/2, Config). + +monitor_nodes_combinations(DCfg, _Config) -> MonNodeState = monitor_node_state(), monitor_nodes_all_comb(true), [VisibleName, HiddenName] = get_nodenames(2, monitor_nodes_combinations), - {ok, Visible} = start_node(VisibleName, ""), + {ok, Visible} = start_node(DCfg, VisibleName, ""), receive_all_comb_nodeup_msgs(visible, Visible), no_msgs(), stop_node(Visible), receive_all_comb_nodedown_msgs(visible, Visible, connection_closed), no_msgs(), - {ok, Hidden} = start_node(HiddenName, "-hidden"), + {ok, Hidden} = start_node(DCfg, HiddenName, "-hidden"), receive_all_comb_nodeup_msgs(hidden, Hidden), no_msgs(), stop_node(Hidden), @@ -1395,6 +1431,9 @@ monitor_nodes_cleanup(Config) when is_list(Config) -> ok. monitor_nodes_many(Config) when is_list(Config) -> + run_dist_configs(fun monitor_nodes_many/2, Config). + +monitor_nodes_many(DCfg, _Config) -> MonNodeState = monitor_node_state(), [Name] = get_nodenames(1, monitor_nodes_many), %% We want to perform more than 2^16 net_kernel:monitor_nodes @@ -1402,7 +1441,7 @@ monitor_nodes_many(Config) when is_list(Config) -> No = (1 bsl 16) + 17, repeat(fun () -> ok = net_kernel:monitor_nodes(true) end, No), No = length(monitor_node_state()) - length(MonNodeState), - {ok, Node} = start_node(Name), + {ok, Node} = start_node(DCfg, Name), repeat(fun () -> receive {nodeup, Node} -> ok end end, No), stop_node(Node), repeat(fun () -> receive {nodedown, Node} -> ok end end, No), @@ -1411,8 +1450,118 @@ monitor_nodes_many(Config) when is_list(Config) -> MonNodeState = monitor_node_state(), ok. +dist_ctrl_proc_smoke(Config) when is_list(Config) -> + ThisNode = node(), + [Name1, Name2] = get_nodenames(2, dist_ctrl_proc_example_smoke), + GetSizeArg = " -gen_tcp_dist_output_loop " + ++ atom_to_list(?MODULE) ++ " " + ++ "dist_cntrlr_output_test", + {ok, Node1} = start_node("", Name1, "-proto_dist gen_tcp"), + {ok, Node2} = start_node("", Name2, "-proto_dist gen_tcp" ++ GetSizeArg), + pong = rpc:call(Node1, net_adm, ping, [Node2]), + NL1 = lists:sort([ThisNode, Node2]), + NL2 = lists:sort([ThisNode, Node1]), + NL1 = lists:sort(rpc:call(Node1, erlang, nodes, [])), + NL2 = lists:sort(rpc:call(Node2, erlang, nodes, [])), + + %% Verify that we actually are executing the distribution + %% module we expect and also massage message passing over + %% it a bit... + Ps1 = rpc:call(Node1, erlang, processes, []), + try + lists:foreach( + fun (P) -> + case rpc:call(Node1, erlang, process_info, [P, current_stacktrace]) of + undefined -> + ok; + {current_stacktrace, StkTrace} -> + lists:foreach(fun ({gen_tcp_dist, + dist_cntrlr_output_loop, + 2, _}) -> + io:format("~p ~p~n", [P, StkTrace]), + throw(found_it); + (_) -> + ok + end, StkTrace) + end + end, Ps1), + exit({missing, dist_cntrlr_output_loop}) + catch + throw:found_it -> ok + end, + + Ps2 = rpc:call(Node2, erlang, processes, []), + try + lists:foreach( + fun (P) -> + case rpc:call(Node2, erlang, process_info, [P, current_stacktrace]) of + undefined -> + ok; + {current_stacktrace, StkTrace} -> + lists:foreach(fun ({erl_distribution_SUITE, + dist_cntrlr_output_loop, + 2, _}) -> + io:format("~p ~p~n", [P, StkTrace]), + throw(found_it); + (_) -> + ok + end, StkTrace) + end + end, Ps2), + exit({missing, dist_cntrlr_output_loop}) + catch + throw:found_it -> ok + end, + + stop_node(Node1), + stop_node(Node2), + ok. + %% Misc. functions +run_dist_configs(Func, Config) -> + GetSizeArg = " -gen_tcp_dist_output_loop " + ++ atom_to_list(?MODULE) ++ " " + ++ "dist_cntrlr_output_test", + lists:map(fun ({DCfgName, DCfg}) -> + io:format("~n~n=== Running ~s configuration ===~n~n", + [DCfgName]), + Func(DCfg, Config) + end, + [{"default", ""}, + {"gen_tcp_dist", "-proto_dist gen_tcp"}, + {"gen_tcp_dist (get_size)", "-proto_dist gen_tcp" ++ GetSizeArg}]). + +dist_cntrlr_output_test(DHandle, Socket) -> + false = erlang:dist_ctrl_get_opt(DHandle, get_size), + false = erlang:dist_ctrl_set_opt(DHandle, get_size, true), + true = erlang:dist_ctrl_get_opt(DHandle, get_size), + true = erlang:dist_ctrl_set_opt(DHandle, get_size, false), + false = erlang:dist_ctrl_get_opt(DHandle, get_size), + false = erlang:dist_ctrl_set_opt(DHandle, get_size, true), + true = erlang:dist_ctrl_get_opt(DHandle, get_size), + dist_cntrlr_output_loop(DHandle, Socket). + +dist_cntrlr_send_data(DHandle, Socket) -> + case erlang:dist_ctrl_get_data(DHandle) of + none -> + erlang:dist_ctrl_get_data_notification(DHandle); + {Size, Data} -> + Size = erlang:iolist_size(Data), + ok = gen_tcp:send(Socket, Data), + dist_cntrlr_send_data(DHandle, Socket) + end. + +dist_cntrlr_output_loop(DHandle, Socket) -> + receive + dist_data -> + %% Outgoing data from this node... + dist_cntrlr_send_data(DHandle, Socket); + _ -> + ok %% Drop garbage message... + end, + dist_cntrlr_output_loop(DHandle, Socket). + monitor_node_state() -> erts_debug:set_internal_state(available_internal_state, true), MonitoringNodes = erts_debug:get_internal_state(monitoring_nodes), @@ -1438,25 +1587,25 @@ print_my_messages() -> sleep(T) -> receive after T * 1000 -> ok end. -start_node(Name, Param, this) -> +start_node(DCfg, Name, Param, this) -> NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), test_server:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]); -start_node(Name, Param, "this") -> - NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), +start_node(DCfg, Name, Param, "this") -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++ DCfg, test_server:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]); -start_node(Name, Param, Rel) when is_atom(Rel) -> - NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), +start_node(DCfg, Name, Param, Rel) when is_atom(Rel) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++ DCfg, test_server:start_node(Name, peer, [{args, NewParam}, {erl, [{release, atom_to_list(Rel)}]}]); -start_node(Name, Param, Rel) when is_list(Rel) -> - NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), +start_node(DCfg, Name, Param, Rel) when is_list(Rel) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++ DCfg, test_server:start_node(Name, peer, [{args, NewParam}, {erl, [{release, Rel}]}]). -start_node(Name, Param) -> - NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), +start_node(DCfg, Name, Param) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++ DCfg, test_server:start_node(Name, slave, [{args, NewParam}]). -start_node(Name) -> - start_node(Name, ""). +start_node(DCfg, Name) -> + start_node(DCfg, Name, ""). stop_node(Node) -> test_server:stop_node(Node). diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index a0ae792ba9..e4c489bd10 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -1459,11 +1459,11 @@ do_open_and_connect(ServerAddresses, AddressToConnectTo) -> do_open_and_connect(ServerAddresses, AddressToConnectTo, Fun). %% do_open_and_connect(ServerAddresses, AddressToConnectTo, Fun) -> - ServerFamily = get_family_by_addrs(ServerAddresses), + {ServerFamily, ServerOpts} = get_family_by_addrs(ServerAddresses), io:format("Serving ~p addresses: ~p~n", [ServerFamily, ServerAddresses]), S1 = ok(gen_sctp:open(0, [{ip,Addr} || Addr <- ServerAddresses] ++ - [ServerFamily])), + [ServerFamily|ServerOpts])), ok = gen_sctp:listen(S1, true), P1 = ok(inet:port(S1)), ClientFamily = get_family_by_addr(AddressToConnectTo), @@ -1493,9 +1493,9 @@ do_open_and_connect(ServerAddresses, AddressToConnectTo, Fun) -> %% If at least one of the addresses is an ipv6 address, return inet6, else inet. get_family_by_addrs(Addresses) -> case lists:usort([get_family_by_addr(Addr) || Addr <- Addresses]) of - [inet, inet6] -> inet6; - [inet] -> inet; - [inet6] -> inet6 + [inet, inet6] -> {inet6, [{ipv6_v6only, false}]}; + [inet] -> {inet, []}; + [inet6] -> {inet6, []} end. get_family_by_addr(Addr) when tuple_size(Addr) =:= 4 -> inet; diff --git a/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c b/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c index b91dca61d4..96938f9071 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c +++ b/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c @@ -30,6 +30,7 @@ #define sock_close(s) closesocket(s) #else #include <sys/socket.h> +#include <unistd.h> #define sock_close(s) close(s) #endif diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 52edfaee29..edf30448c4 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -2086,8 +2086,39 @@ test_pktoptions(Family, Spec, CheckConnect, OSType, OSVer) -> %%% {ok,<<"hi">>} = gen_tcp:recv(S1, 2, Timeout), %% %% Verify returned remote options - {ok,[{pktoptions,OptsVals1}]} = inet:getopts(S1, [pktoptions]), - {ok,[{pktoptions,OptsVals2}]} = inet:getopts(S2, [pktoptions]), + VerifyRemOpts = + fun(S, Role) -> + case inet:getopts(S, [pktoptions]) of + {ok, [{pktoptions, PktOpts1}]} -> + PktOpts1; + {ok, UnexpOK1} -> + io:format("Unexpected OK (~w): " + "~n ~p" + "~n", [Role, UnexpOK1]), + exit({unexpected_getopts_ok, + Role, + Spec, + TrueRecvOpts, + OptsVals, + OptsValsDefault, + UnexpOK1}); + {error, UnexpERR1} -> + io:format("Unexpected ERROR (~w): " + "~n ~p" + "~n", [Role, UnexpERR1]), + exit({unexpected_getopts_failure, + Role, + Spec, + TrueRecvOpts, + OptsVals, + OptsValsDefault, + UnexpERR1}) + end + end, + OptsVals1 = VerifyRemOpts(S1, dest), + OptsVals2 = VerifyRemOpts(S2, orig), + %% {ok,[{pktoptions,OptsVals1}]} = inet:getopts(S1, [pktoptions]), + %% {ok,[{pktoptions,OptsVals2}]} = inet:getopts(S2, [pktoptions]), (Result1 = sets_eq(OptsVals1, OptsVals)) orelse io:format( "Accept differs: ~p neq ~p~n", [OptsVals1,OptsVals]), @@ -3430,7 +3461,7 @@ wait(Mref) -> %% OTP-15536 %% Test that send error works correctly for delay_send -delay_send_error(Config) -> +delay_send_error(_Config) -> {ok, LS} = gen_tcp:listen(0, [{reuseaddr, true}, {packet, 1}, {active, false}]), {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), P = spawn_link( diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 77afb8250c..02bc884e36 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -160,7 +160,7 @@ {'sync_transaction', Retries::non_neg_integer()}. -type table() :: atom(). -type storage_type() :: 'ram_copies' | 'disc_copies' | 'disc_only_copies'. --type index_attr() :: atom() | non_neg_integer(). +-type index_attr() :: atom() | non_neg_integer() | {atom()}. -type write_locks() :: 'write' | 'sticky_write'. -type read_locks() :: 'read'. -type lock_kind() :: write_locks() | read_locks(). @@ -1277,6 +1277,14 @@ match_object(Tid, Ts, Tab, Pat, LockKind) match_object(_Tid, _Ts, Tab, Pat, _LockKind) -> abort({bad_type, Tab, Pat}). +add_written_index(Store, Pos, Tab, Key, Objs) when is_integer(Pos) -> + Pat = setelement(Pos, val({Tab, wild_pattern}), Key), + add_written_match(Store, Pat, Tab, Objs); +add_written_index(Store, Pos, Tab, Key, Objs) when is_tuple(Pos) -> + IxF = mnesia_index:index_vals_f(val({Tab, storage_type}), Tab, Pos), + Ops = find_ops(Store, Tab, '_'), + add_ix_match(Ops, Objs, IxF, Key, val({Tab, setorbag})). + add_written_match(S, Pat, Tab, Objs) -> Ops = find_ops(S, Tab, Pat), FixedRes = add_match(Ops, Objs, val({Tab, setorbag})), @@ -1303,6 +1311,46 @@ add_match([{_Oid, Val, write}|R], Objs, bag) -> add_match([{Oid, Val, write}|R], Objs, set) -> add_match(R, [Val | deloid(Oid,Objs)],set). +add_ix_match([], Objs, _IxF, _Key, _Type) -> + Objs; +add_ix_match(Written, Objs, IxF, Key, ordered_set) -> + %% Must use keysort which is stable + add_ordered_match(lists:keysort(1, ix_filter_ops(IxF, Key, Written)), Objs, []); +add_ix_match([{Oid, _, delete}|R], Objs, IxF, Key, Type) -> + add_ix_match(R, deloid(Oid, Objs), IxF, Key, Type); +add_ix_match([{_Oid, Val, delete_object}|R], Objs, IxF, Key, Type) -> + case ix_match(Val, IxF, Key) of + true -> + add_ix_match(R, lists:delete(Val, Objs), IxF, Key, Type); + false -> + add_ix_match(R, Objs, IxF, Key, Type) + end; +add_ix_match([{_Oid, Val, write}|R], Objs, IxF, Key, bag) -> + case ix_match(Val, IxF, Key) of + true -> + add_ix_match(R, [Val | lists:delete(Val, Objs)], IxF, Key, bag); + false -> + add_ix_match(R, Objs, IxF, Key, bag) + end; +add_ix_match([{Oid, Val, write}|R], Objs, IxF, Key, set) -> + case ix_match(Val, IxF, Key) of + true -> + add_ix_match(R, [Val | deloid(Oid,Objs)],IxF,Key,set); + false -> + add_ix_match(R, Objs, IxF, Key, set) + end. + +ix_match(Val, IxF, Key) -> + lists:member(Key, IxF(Val)). + +ix_filter_ops(IxF, Key, Ops) -> + lists:filter( + fun({_Oid, Obj, write}) -> + ix_match(Obj, IxF, Key); + (_) -> + true + end, Ops). + %% For ordered_set only !! add_ordered_match(Written = [{{_, Key}, _, _}|_], [Obj|Objs], Acc) when Key > element(2, Obj) -> @@ -1641,6 +1689,16 @@ index_match_object(Tid, Ts, Tab, Pat, Attr, LockKind) dirty_index_match_object(Tab, Pat, Attr); % Should be optimized? tid -> case mnesia_schema:attr_tab_to_pos(Tab, Attr) of + {_} -> + case LockKind of + read -> + Store = Ts#tidstore.store, + mnesia_locker:rlock_table(Tid, Store, Tab), + Objs = dirty_match_object(Tab, Pat), + add_written_match(Store, Pat, Tab, Objs); + _ -> + abort({bad_type, Tab, LockKind}) + end; Pos when Pos =< tuple_size(Pat) -> case LockKind of read -> @@ -1688,8 +1746,8 @@ index_read(Tid, Ts, Tab, Key, Attr, LockKind) false -> Store = Ts#tidstore.store, Objs = mnesia_index:read(Tid, Store, Tab, Key, Pos), - Pat = setelement(Pos, val({Tab, wild_pattern}), Key), - add_written_match(Store, Pat, Tab, Objs); + add_written_index( + Ts#tidstore.store, Pos, Tab, Key, Objs); true -> abort({bad_type, Tab, Attr, Key}) end; @@ -1825,7 +1883,7 @@ remote_dirty_match_object(Tab, Pat) -> false -> mnesia_lib:db_match_object(Tab, Pat); true -> - PosList = val({Tab, index}), + PosList = regular_indexes(Tab), remote_dirty_match_object(Tab, Pat, PosList) end. @@ -1857,7 +1915,7 @@ remote_dirty_select(Tab, Spec) -> false -> mnesia_lib:db_select(Tab, Spec); true -> - PosList = val({Tab, index}), + PosList = regular_indexes(Tab), remote_dirty_select(Tab, Spec, PosList) end; _ -> @@ -1924,6 +1982,8 @@ dirty_index_match_object(Pat, _Attr) -> dirty_index_match_object(Tab, Pat, Attr) when is_atom(Tab), Tab /= schema, is_tuple(Pat), tuple_size(Pat) > 2 -> case mnesia_schema:attr_tab_to_pos(Tab, Attr) of + {_} -> + dirty_match_object(Tab, Pat); Pos when Pos =< tuple_size(Pat) -> case has_var(element(2, Pat)) of false -> @@ -3254,3 +3314,7 @@ put_activity_id(Activity) -> mnesia_tm:put_activity_id(Activity). put_activity_id(Activity,Fun) -> mnesia_tm:put_activity_id(Activity,Fun). + +regular_indexes(Tab) -> + PosList = val({Tab, index}), + [P || P <- PosList, is_integer(P)]. diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index 098265d5fc..6f1c21e3b9 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1996-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,7 +14,7 @@ %% 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% %% @@ -37,7 +37,7 @@ db_match_erase/2, get_index_table/2, get_index_table/3, - + tab2filename/2, init_index/2, init_indecies/3, @@ -45,6 +45,7 @@ del_transient/3, del_index_table/3, + index_vals_f/3, index_info/2, ext_index_instances/1]). @@ -60,9 +61,14 @@ read(Tid, Store, Tab, IxKey, Pos) -> ResList = mnesia_locker:ixrlock(Tid, Store, Tab, IxKey, Pos), %% Remove all tuples which don't include Ixkey, happens when Tab is a bag case val({Tab, setorbag}) of - bag -> + bag when is_integer(Pos) -> mnesia_lib:key_search_all(IxKey, Pos, ResList); - _ -> + bag when is_tuple(Pos) -> + TabStorage = val({Tab, storage_type}), + ValsF = index_vals_f(TabStorage, Tab, Pos), + [Obj || Obj <- ResList, + lists:member(IxKey, ValsF(Obj))]; + _ -> ResList end. @@ -136,7 +142,7 @@ del_object_index2([], _, _Storage, _Tab, _K, _Obj) -> ok; del_object_index2([{{Pos, Type}, Ixt} | Tail], SoB, Storage, Tab, K, Obj) -> ValsF = index_vals_f(Storage, Tab, Pos), case SoB of - bag -> + bag -> del_object_bag(Type, ValsF, Tab, K, Obj, Ixt); _ -> %% If set remove the tuple in index table del_ixes(Type, Ixt, ValsF, Obj, K) @@ -197,7 +203,7 @@ merge([], _, _, Ack) -> realkeys(Tab, Pos, IxKey) -> Index = get_index_table(Tab, Pos), db_get(Index, IxKey). % a list on the form [{IxKey, RealKey1} , .... - + dirty_select(Tab, Spec, Pos) when is_integer(Pos) -> %% Assume that we are on the node where the replica is %% Returns the records without applying the match spec @@ -233,7 +239,7 @@ dirty_read2(Tab, IxKey, Pos) -> end, Acc, mnesia_lib:db_get(Storage, Tab, K)) end, [], Keys)). -pick_index([{{{Pfx,_},IxType}, Ixt}|_], _Tab, {_} = Pfx) -> +pick_index([{{{Pfx,_,_},IxType}, Ixt}|_], _Tab, {_} = Pfx) -> {IxType, Ixt}; pick_index([{{Pos,IxType}, Ixt}|_], _Tab, Pos) -> {IxType, Ixt}; @@ -242,7 +248,7 @@ pick_index([_|T], Tab, Pos) -> pick_index([], Tab, Pos) -> mnesia:abort({no_exist, Tab, {index, Pos}}). - + %%%%%%% Creation, Init and deletion routines for index tables %% We can have several indexes on the same table @@ -387,12 +393,12 @@ init_ext_index(Tab, Storage, Alias, Mod, [{Pos,Type} | Tail]) -> create_fun(Cont, Tab, Pos) -> IxF = index_vals_f(disc_only_copies, Tab, Pos), fun(read) -> - Data = + Data = case Cont of {start, KeysPerChunk} -> mnesia_lib:db_init_chunk( disc_only_copies, Tab, KeysPerChunk); - '$end_of_table' -> + '$end_of_table' -> '$end_of_table'; _Else -> mnesia_lib:db_chunk(disc_only_copies, Cont) @@ -462,7 +468,7 @@ add_index_info(Tab, SetOrBag, IxElem) -> %% Check later if mnesia_tm is sensitive about the order mnesia_lib:set({Tab, index_info}, IndexInfo), mnesia_lib:set({Tab, index}, index_positions(IndexInfo)), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit([IndexInfo | Commit])); {value, Old} -> %% We could check for consistency here @@ -470,7 +476,7 @@ add_index_info(Tab, SetOrBag, IxElem) -> mnesia_lib:set({Tab, index_info}, Index), mnesia_lib:set({Tab, index}, index_positions(Index)), NewC = lists:keyreplace(index, 1, Commit, Index), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit(NewC)) end. @@ -488,19 +494,19 @@ del_index_info(Tab, Pos) -> element(1,P)=/=Pos end, Old#index.pos_list) of - [] -> + [] -> IndexInfo = index_info(Old#index.setorbag,[]), mnesia_lib:set({Tab, index_info}, IndexInfo), mnesia_lib:set({Tab, index}, index_positions(IndexInfo)), NewC = lists:keydelete(index, 1, Commit), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit(NewC)); New -> Index = Old#index{pos_list = New}, mnesia_lib:set({Tab, index_info}, Index), mnesia_lib:set({Tab, index}, index_positions(Index)), NewC = lists:keyreplace(index, 1, Commit, Index), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit(NewC)) end end. @@ -537,7 +543,7 @@ db_match_erase({{ext,_,_} = Ext, Ixt}, Pat) -> mnesia_lib:db_match_erase(Ext, Ixt, Pat); db_match_erase({dets, Ixt}, Pat) -> ok = dets:match_delete(Ixt, Pat). - + db_select({ram, Ixt}, Pat) -> ets:select(Ixt, Pat); db_select({{ext,_,_} = Ext, Ixt}, Pat) -> @@ -545,7 +551,7 @@ db_select({{ext,_,_} = Ext, Ixt}, Pat) -> db_select({dets, Ixt}, Pat) -> dets:select(Ixt, Pat). - + get_index_table(Tab, Pos) -> get_index_table(Tab, val({Tab, storage_type}), Pos). diff --git a/lib/mnesia/test/Makefile b/lib/mnesia/test/Makefile index 5b61b1af65..b43bc82801 100644 --- a/lib/mnesia/test/Makefile +++ b/lib/mnesia/test/Makefile @@ -53,7 +53,8 @@ MODULES= \ mnesia_measure_test \ mnesia_cost \ mnesia_dbn_meters \ - ext_test + ext_test \ + mnesia_index_plugin_test DocExamplesDir := ../doc/src/ diff --git a/lib/mnesia/test/mnesia_SUITE.erl b/lib/mnesia/test/mnesia_SUITE.erl index 24c1def6da..b41bf22efa 100644 --- a/lib/mnesia/test/mnesia_SUITE.erl +++ b/lib/mnesia/test/mnesia_SUITE.erl @@ -69,12 +69,13 @@ groups() -> %% covered. [{light, [], [{group, install}, {group, nice}, {group, evil}, - {group, mnesia_frag_test, light}, {group, qlc}, + {group, mnesia_frag_test, light}, {group, qlc}, {group, index_plugins}, {group, registry}, {group, config}, {group, examples}]}, {install, [], [{mnesia_install_test, all}]}, {nice, [], [{mnesia_nice_coverage_test, all}]}, {evil, [], [{mnesia_evil_coverage_test, all}]}, {qlc, [], [{mnesia_qlc_test, all}]}, + {index_plugins, [], [{mnesia_index_plugin_test, all}]}, {registry, [], [{mnesia_registry_test, all}]}, {config, [], [{mnesia_config_test, all}]}, {examples, [], [{mnesia_examples_test, all}]}, diff --git a/lib/mnesia/test/mnesia_index_plugin_test.erl b/lib/mnesia/test/mnesia_index_plugin_test.erl new file mode 100644 index 0000000000..44fe047c50 --- /dev/null +++ b/lib/mnesia/test/mnesia_index_plugin_test.erl @@ -0,0 +1,261 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-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(mnesia_index_plugin_test). +-author('[email protected]'). + +-export([init_per_testcase/2, end_per_testcase/2, + init_per_group/2, end_per_group/2, + init_per_suite/1, end_per_suite/1, + all/0, groups/0]). + +-export([ + add_rm_plugin/1, + tab_with_plugin_index/1, + tab_with_multiple_plugin_indexes/1, + ix_match_w_plugin/1, + ix_match_w_plugin_ordered/1, + ix_match_w_plugin_bag/1 + ]). + +-export([ix_prefixes/3, % test plugin + ix_prefixes2/3]). % test plugin 2 + +-include("mnesia_test_lib.hrl"). + +init_per_suite(Conf) -> + Conf. + +end_per_suite(Conf) -> + Conf. + +init_per_testcase(Func, Conf) -> + mnesia_test_lib:init_per_testcase(Func, Conf). + +end_per_testcase(Func, Conf) -> + mnesia_test_lib:end_per_testcase(Func, Conf). + +all() -> + [add_rm_plugin, + tab_with_plugin_index, + tab_with_multiple_plugin_indexes, + ix_match_w_plugin, + ix_match_w_plugin_ordered, + ix_match_w_plugin_bag]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +add_rm_plugin(suite) -> []; +add_rm_plugin(Config) when is_list(Config) -> + [N1, N2] = Nodes = ?acquire_nodes(2, Config), + ok = add_plugin(), + ok = rpc_check_plugin(N1), + ok = rpc_check_plugin(N2), + ok = add_plugin2(), + ok = del_plugin(), + ok = del_plugin2(), + ok = add_plugin(), + ok = add_plugin2(), + ok = del_plugin(), + ok = del_plugin2(), + ?verify_mnesia(Nodes, []). + +-define(PLUGIN1, {{pfx},?MODULE,ix_prefixes}). +-define(PLUGIN2, {{pfx2},?MODULE,ix_prefixes2}). + +add_plugin() -> + {atomic, ok} = mnesia_schema:add_index_plugin({pfx}, ?MODULE, ix_prefixes), + [?PLUGIN1] = mnesia_schema:index_plugins(), + ok. + +add_plugin2() -> + {atomic, ok} = mnesia_schema:add_index_plugin({pfx2}, ?MODULE, ix_prefixes2), + [?PLUGIN1, ?PLUGIN2] = lists:sort(mnesia_schema:index_plugins()), + ok. + +del_plugin() -> + {atomic, ok} = mnesia_schema:delete_index_plugin({pfx}), + [?PLUGIN2] = mnesia_schema:index_plugins(), + ok. + +del_plugin2() -> + {atomic, ok} = mnesia_schema:delete_index_plugin({pfx2}), + [] = mnesia_schema:index_plugins(), + ok. + +rpc_check_plugin(N) -> + [?PLUGIN1] = + rpc:call(N, mnesia_schema, index_plugins, []), + ok. + +tab_with_plugin_index(suite) -> []; +tab_with_plugin_index(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(t, [{attributes, [k,v1,v2]}, + {index, [{{pfx}, ordered}, + {v1, ordered}, + v2]}]), + [ok,ok,ok,ok] = + [mnesia:dirty_write({t, K, V1, V2}) + || {K,V1,V2} <- [{1,a,"123"}, + {2,b,"12345"}, + {3,c,"6789"}, + {4,d,nil}]], + [{t,1,a,"123"},{t,2,b,"12345"}] = + mnesia:dirty_index_read(t,<<"123">>,{pfx}), + [{t,3,c,"6789"}] = + mnesia:dirty_index_read(t,"6789",v2), + [{t,1,a,"123"}] = + mnesia:dirty_match_object({t,'_',a,"123"}), + [{t,1,a,"123"}] = + mnesia:dirty_select(t, [{ {t,'_',a,"123"}, [], ['$_']}]), + mnesia:dirty_delete(t,2), + [{t,1,a,"123"}] = + mnesia:dirty_index_read(t,<<"123">>,{pfx}), + ?verify_mnesia(Nodes, []). + +tab_with_multiple_plugin_indexes(suite) -> []; +tab_with_multiple_plugin_indexes(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + ok = add_plugin2(), + {atomic, ok} = + mnesia:create_table(u, [{attributes, [k,v1,v2]}, + {index, [{{pfx}, ordered}, + {{pfx2}, ordered}]}]), + [ok,ok,ok,ok] = + [mnesia:dirty_write({u, K, V1, V2}) + || {K,V1,V2} <- [{1,a,"123"}, + {2,b,"12345"}, + {3,c,"6789"}, + {4,d,nil}]], + [{u,1,a,"123"},{u,2,b,"12345"}] = + mnesia:dirty_index_read(u,<<"123">>,{pfx}), + [{u,1,a,"123"},{u,2,b,"12345"}] = + mnesia:dirty_index_read(u,<<"321">>,{pfx2}), + ?verify_mnesia(Nodes, []). + +ix_match_w_plugin(suite) -> []; +ix_match_w_plugin(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(im1, [{attributes, [k, v1, v2]}, + {index, [{{pfx}, ordered}, + {v1, ordered}]}]), + fill_and_test_index_match(im1, set), + ?verify_mnesia(Nodes, []). + + +ix_match_w_plugin_ordered(suite) -> []; +ix_match_w_plugin_ordered(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(im2, [{attributes, [k, v1, v2]}, + {type, ordered_set}, + {index, [{{pfx}, ordered}, + {v1, ordered}]}]), + fill_and_test_index_match(im2, ordered_set), + ?verify_mnesia(Nodes, []). + +ix_match_w_plugin_bag(suite) -> []; +ix_match_w_plugin_bag(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(im3, [{attributes, [k, v1, v2]}, + {type, bag}, + {index, [{{pfx}, ordered}, + {v1, ordered}]}]), + fill_and_test_index_match(im3, bag), + ?verify_mnesia(Nodes, []). + +fill_and_test_index_match(Tab, Type) -> + [ok,ok,ok,ok,ok,ok,ok,ok,ok] = + [mnesia:dirty_write({Tab, K, V1, V2}) + || {K,V1,V2} <- [{1,a,"123"}, + {2,b,"12345"}, + {3,c,"123"}, + {4,d,nil}, + {5,e,nil}, + {6,f,nil}, + {7,g,nil}, %% overwritten if not bag + {7,g,"234"}, + {8,h,"123"}]], + mnesia:activity( + transaction, + fun() -> + ok = mnesia:write({Tab, 1, aa, "1234"}), %% replaces if not bag + ok = mnesia:delete({Tab, 2}), + ok = mnesia:delete({Tab, 4}), + ok = mnesia:write({Tab, 6, ff, nil}), + ok = mnesia:write({Tab, 7, gg, "123"}), + ok = mnesia:write({Tab, 100, x, nil}), + ok = mnesia:delete_object({Tab,3,c,"123"}), + ok = mnesia:delete_object({Tab,5,e,nil}), + Res = mnesia:index_read(Tab, <<"123">>, {pfx}), + SetRes = [{Tab,1,aa,"1234"}, {Tab,7,gg,"123"}, {Tab,8,h,"123"}], + case Type of + set -> + SetRes = lists:sort(Res); + ordered_set -> + SetRes = Res; + bag -> + [{Tab,1,a,"123"}, {Tab,1,aa,"1234"}, + {Tab,7,gg,"123"}, {Tab,8,h,"123"}] = lists:sort(Res) + end + end). + +%% ============================================================ +%% +ix_prefixes(_Tab, _Pos, Obj) -> + lists:foldl( + fun(V, Acc) when is_list(V) -> + try Pfxs = prefixes(list_to_binary(V)), + Pfxs ++ Acc + catch + error:_ -> + Acc + end; + (V, Acc) when is_binary(V) -> + Pfxs = prefixes(V), + Pfxs ++ Acc; + (_, Acc) -> + Acc + end, [], tl(tuple_to_list(Obj))). + +ix_prefixes2(Tab, Pos, Obj) -> + [rev(P) || P <- ix_prefixes(Tab, Pos, Obj)]. + +rev(B) when is_binary(B) -> + list_to_binary(lists:reverse(binary_to_list(B))). + +prefixes(<<P:3/binary, _/binary>>) -> + [P]; +prefixes(_) -> + []. diff --git a/lib/mnesia/test/mt.erl b/lib/mnesia/test/mt.erl index 5a981bf539..037d6adb38 100644 --- a/lib/mnesia/test/mt.erl +++ b/lib/mnesia/test/mt.erl @@ -67,6 +67,7 @@ alias(recovery) -> mnesia_recovery_test; alias(registry) -> mnesia_registry_test; alias(suite) -> mnesia_SUITE; alias(trans) -> mnesia_trans_access_test; +alias(ixp) -> mnesia_index_plugin_test; alias(Other) -> Other. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index 9bcd99fba3..ff3250b383 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -233,9 +233,13 @@ countryName ATTRIBUTE-TYPE-AND-VALUE-CLASS ::= { -- regarding how to handle and sometimes accept incorrect certificates -- we define and use the type below instead of X520countryName + -- We accept utf8String encoding of the US-ASCII + -- country name code and the mix up with other country code systems + -- that uses three characters instead of two. + OTP-X520countryname ::= CHOICE { - printableString PrintableString (SIZE (2)), - utf8String UTF8String (SIZE (2)) + printableString PrintableString (SIZE (2..3)), + utf8String UTF8String (SIZE (2..3)) } serialNumber ATTRIBUTE-TYPE-AND-VALUE-CLASS ::= { diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 9fcedf6ef9..fb81ea68a4 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -423,7 +423,7 @@ <p>Available options:</p> <taglist> - <tag>{verify_fun, fun()}</tag> + <tag>{verify_fun, {fun(), InitialUserState::term()}</tag> <item> <p>The fun must be defined as:</p> diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 806f7c5b0f..e6bcedd1b1 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -42,15 +42,14 @@ encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, KeyDevParams)); - encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data)); - encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, KeyDevParams)). + %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). %% @@ -59,21 +58,20 @@ encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_decrypt(des_cbc, Key, IV, Data); - decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, crypto:block_decrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); - decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_decrypt(rc2_cbc, Key, IV, Data); +decode(Data, Password,"AES-128-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_decrypt(aes_cbc128, Key, IV, Data); +decode(Data, Password,"AES-256-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_decrypt(aes_cbc256, Key, IV, Data). -decode(Data, Password,"AES-128-CBC"= Cipher, IV) -> - %% PKCS5_SALT_LEN is 8 bytes - <<Salt:8/binary,_/binary>> = IV, - {Key, _} = password_to_key_and_iv(Password, Cipher, Salt), - crypto:block_decrypt(aes_cbc128, Key, IV, Data). %%-------------------------------------------------------------------- -spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary(). @@ -131,13 +129,15 @@ password_to_key_and_iv(Password, _Cipher, {#'PBEParameter'{salt = Salt, <<Key:8/binary, IV:8/binary, _/binary>> = pbdkdf1(Password, Salt, Count, Hash), {Key, IV}; -password_to_key_and_iv(Password, Cipher, Salt) -> - KeyLen = derived_key_length(Cipher, undefined), +password_to_key_and_iv(Password, Cipher, KeyDevParams) -> + %% PKCS5_SALT_LEN is 8 bytes + <<Salt:8/binary,_/binary>> = KeyDevParams, + KeyLen = derived_key_length(Cipher, undefined), <<Key:KeyLen/binary, _/binary>> = pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5), %% Old PEM encryption does not use standard encryption method - %% pbdkdf1 and uses then salt as IV - {Key, Salt}. + %% pbdkdf1 + {Key, KeyDevParams}. pem_encrypt(_, _, _, 0, Acc, _) -> Acc; pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> @@ -267,7 +267,9 @@ derived_key_length(Cipher,_) when (Cipher == ?'des-EDE3-CBC') or (Cipher == "DES-EDE3-CBC") -> 24; derived_key_length(Cipher,_) when (Cipher == "AES-128-CBC") -> - 16. + 16; +derived_key_length(Cipher,_) when (Cipher == "AES-256-CBC") -> + 32. cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'desCBC'}) -> "DES-CBC"; diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index d7e5bc3ad8..0fd1453f7c 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -101,10 +101,10 @@ encode_pem_entry({'PrivateKeyInfo', Der, EncParams}) -> EncDer = encode_encrypted_private_keyinfo(Der, EncParams), StartStr = pem_start('EncryptedPrivateKeyInfo'), [StartStr, "\n", b64encode_and_split(EncDer), "\n", pem_end(StartStr) ,"\n\n"]; -encode_pem_entry({Type, Der, {Cipher, Salt}}) -> +encode_pem_entry({Type, Decrypted, {Cipher, Salt}}) -> StartStr = pem_start(Type), [StartStr,"\n", pem_decrypt(),"\n", pem_decrypt_info(Cipher, Salt),"\n\n", - b64encode_and_split(Der), "\n", pem_end(StartStr) ,"\n\n"]. + b64encode_and_split(Decrypted), "\n", pem_end(StartStr) ,"\n\n"]. decode_pem_entries([], Entries) -> lists:reverse(Entries); diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index 523c9e2515..1136267411 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.erl @@ -37,7 +37,7 @@ all() -> [ pbdkdf1, pbdkdf2, - old_enc, + old_pbe, pbes1, pbes2]. @@ -197,23 +197,11 @@ pbdkdf2(Config) when is_list(Config) -> = pubkey_pbe:pbdkdf2("pass\0word", "sa\0lt", 4096, 16, fun crypto:hmac/4, sha, 20). -old_enc() -> - [{doc,"Tests encode/decode RSA key encrypted with different ciphers using old PEM encryption scheme"}]. -old_enc(Config) when is_list(Config) -> - Datadir = proplists:get_value(data_dir, Config), - %% key generated with ssh-keygen -N hello_aes -f old_aes_128_cbc_enc_key.pem - {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "old_aes_128_cbc_enc_key.pem")), - - PemAesCbcEntry = public_key:pem_decode(PemAesCbc), - ct:print("Pem entry: ~p" , [PemAesCbcEntry]), - [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = PubAesCbcEntry] = PemAesCbcEntry, - #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"). - pbes1() -> [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES1"}]. pbes1(Config) when is_list(Config) -> decode_encode_key_file("pbes1_des_cbc_md5_enc_key.pem", "password", "DES-CBC", Config). - + pbes2() -> [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES2"}]. pbes2(Config) when is_list(Config) -> @@ -225,13 +213,33 @@ pbes2(Config) when is_list(Config) -> false -> ok end. +old_pbe() -> + [{doc,"Tests encode/decode with old format used before PBE"}]. +old_pbe(Config) when is_list(Config) -> + Datadir = proplists:get_value(data_dir, Config), + % key generated with ssh-keygen -N hello_aes -f old_aes_128_cbc.pem + {ok, PemAes128Cbc} = file:read_file(filename:join(Datadir, "old_aes_128_cbc.pem")), + + PemAes128CbcEntries = public_key:pem_decode(PemAes128Cbc), + ct:print("Pem entry: ~p" , [PemAes128CbcEntries]), + [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = Aes128CbcEntry] = PemAes128CbcEntries, + #'RSAPrivateKey'{} = Key = public_key:pem_entry_decode(Aes128CbcEntry, "hello_aes"), + + %% Converted with openssl rsa -in old_aes_128_cbc.pem -out old_aes_256_cbc.pem -aes256 + {ok, PemAes256Cbc} = file:read_file(filename:join(Datadir, "old_aes_256_cbc.pem")), + + PemAes256CbcEntries = public_key:pem_decode(PemAes256Cbc), + ct:print("Pem entry: ~p" , [PemAes256CbcEntries]), + [{'RSAPrivateKey', _, {"AES-256-CBC",_}} = Aes256CbcEntry] = PemAes256CbcEntries, + Key = public_key:pem_entry_decode(Aes256CbcEntry, "hello_aes"). + decode_encode_key_file(File, Password, Cipher, Config) -> Datadir = proplists:get_value(data_dir, Config), {ok, PemKey} = file:read_file(filename:join(Datadir, File)), PemEntry = public_key:pem_decode(PemKey), - ct:print("Pem entry: ~p" , [PemEntry]), + ct:pal("Pem entry: ~p" , [PemEntry]), [{Asn1Type, _, {Cipher,_} = CipherInfo} = PubEntry] = PemEntry, #'RSAPrivateKey'{} = KeyInfo = public_key:pem_entry_decode(PubEntry, Password), PemKey1 = public_key:pem_encode([public_key:pem_entry_encode(Asn1Type, KeyInfo, {CipherInfo, Password})]), diff --git a/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc.pem index 34c7543f30..34c7543f30 100644 --- a/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc.pem diff --git a/lib/public_key/test/pbe_SUITE_data/old_aes_256_cbc.pem b/lib/public_key/test/pbe_SUITE_data/old_aes_256_cbc.pem new file mode 100644 index 0000000000..e6aec2869d --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/old_aes_256_cbc.pem @@ -0,0 +1,30 @@ +-----BEGIN RSA PRIVATE KEY----- +Proc-Type: 4,ENCRYPTED +DEK-Info: AES-256-CBC,ABDA22398E511E9465983E1A50706044 + +XhIcPOb6pTWL++pgeeTH5rsx0tackhllVqyXyOfbYMBJnVFRhQ/V/1MDg3Jt4wD1 +Nerhcv5srHeiwmf+vwXwDFOzvFzLVM1jFMUJe/2XloYFX4TBiLZAF/zekQA3uPY6 +DKJuBuO5vVSZ0VlxGpu3jphIAwxbssfZkZmryCP3b1/oX5Y3Em/wEWW3RduaeWFu +Z2nTsPH3yNmHkuqFF3cq0aZs+VxtjcuYo0gbkN5hNVgOoOVxIBzw7DsgBAkdXvr3 +LRCMGg7Y2pVthA963s0xkN37XtZEiYbydoLnzHlW/Kx5QSvED8/Fn94Lcdy5NsQN +7nYWWgYZRH39Wnsi0BrTZv399U5rBe7DnpStKWPn2Sa8Bdu3CX2oLajM1cZjAp1X +y6vuasK7SoZ8rWpcsHQpV1HyNBTl/uRU5nrYc/KGD8l2x7tdNidGx2Hey/6O4H5v +rxL1TB4PlzDYwCsReuyLbEjyuZQ10j0SK/SFzikHuvD2IEpM/oUaPdVFqcW8/sjw +VhcsupAf4EXfsi2dJBylmDjI2W7h9XwBDLzQN+69DtkBmvimE5CguTITf8MAHQQ6 +Q1vYF2ij7W675tj9ulksRPaMxSsI03luai/Jrieh0mPqGEenGEEC5QU0XPOvsfyw +GMYaBUbdYrMpbHM3wFPxM2wRlXf4gX5BhZKRGZX7OaEs54pfglyQtTPuZmD0VcAp +EWHq70G9mbuBlhbMX1rKAomuDmIvgLeLRUpAFf59Qr8KoJSLD1S8TJB3uEPk6i39 +4GnylbpmqS4gv/OIc6WTeOeUZTAD3A77HBwSlELPk3/s1d/MLyfciYClOBEuZ6NB +FXEKCGCEC786zJA678gLEaa2XPNkEM+2gjzNFqtYMIn5ehAq/HRRsFvW+wkTbee4 +z+qe5HbVKAQ3EOfbidvYrDaGd7HvHVG8zosl+O61iIFs04lLEMDFXBIdvIgEncOK +Rq3yXdpBKMg89aoZLniaPobSvuvdjNOMzW6EKlb5FKZduCiR68MEZ+rLHYHTwE3W +Z5+TCbrbV2F6WQpq3zqnB14wGu8igEb5Veq+N2vMkx4iTMTUyCty1SwIjj4NidM1 +dJM7Ighdal6tQ6hIwbDfpIPsY4eGH/UrdVZ0SkxuDR2s76cZ8nFX3lJ/BNwTZLKo +IqAC4NjUOv3ID+0Q6Lz+sxLCi5pLYUf0E+s4pgi1BYAOu+BF3GwxyqnqVoq/Fs5D +LXxuY0946YM+WcrYzke4mq3MPx6QQYj04H5KJ2mzxtnbZJrfLF23PVRVhvgKSjyV +I3/zgJ16fV2H/fb26oCpTNbb11pQvhorkLwdvpwtM+go7dJGebAi1762Nbj/CqnW +fbBPxPRvNPZn6pEodJ/L/APhvGv1K7eC9THj66H7Kmeoq8Lz74idhywP9I3QS0ZO +15ORbTDjuiRYNJPxxu79A3/tWMUlprJ9ljhI/0DXRB0M3UGic52D/32Q64I7eewy +qRNS/3C3ejDShIRBDFTdDkM3s/42LySXJjmjU9bpZY4POQ3kOaJb3EzSvbzTyXzu +3FiHvDQY+b8XwbxtE/kTMaAPQZ7TtWOao7SRi7J94MvCQ5/tbakFP2suM8psnigC +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 9ff20454cd..1f4e281a30 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -162,14 +162,14 @@ supported_algorithms(cipher) -> select_crypto_supported( [ {'[email protected]', [{ciphers,chacha20}, {macs,poly1305}]}, - {'[email protected]', [{ciphers,{aes_gcm,256}}]}, - {'aes256-ctr', [{ciphers,{aes_ctr,256}}]}, - {'aes192-ctr', [{ciphers,{aes_ctr,192}}]}, - {'[email protected]', [{ciphers,{aes_gcm,128}}]}, - {'aes128-ctr', [{ciphers,{aes_ctr,128}}]}, - {'AEAD_AES_256_GCM', [{ciphers,{aes_gcm,256}}]}, - {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, - {'aes128-cbc', [{ciphers,aes_cbc128}]}, + {'[email protected]', [{ciphers,aes_256_gcm}]}, + {'aes256-ctr', [{ciphers,aes_256_ctr}]}, + {'aes192-ctr', [{ciphers,aes_192_ctr}]}, + {'[email protected]', [{ciphers,aes_128_gcm}]}, + {'aes128-ctr', [{ciphers,aes_128_ctr}]}, + {'AEAD_AES_256_GCM', [{ciphers,aes_256_gcm}]}, + {'AEAD_AES_128_GCM', [{ciphers,aes_128_gcm}]}, + {'aes128-cbc', [{ciphers,aes_128_cbc}]}, {'3des-cbc', [{ciphers,des3_cbc}]} ] )); @@ -179,8 +179,8 @@ supported_algorithms(mac) -> [{'hmac-sha2-256', [{macs,hmac}, {hashs,sha256}]}, {'hmac-sha2-512', [{macs,hmac}, {hashs,sha512}]}, {'hmac-sha1', [{macs,hmac}, {hashs,sha}]}, - {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, - {'AEAD_AES_256_GCM', [{ciphers,{aes_gcm,256}}]} + {'AEAD_AES_128_GCM', [{ciphers,aes_128_gcm}]}, + {'AEAD_AES_256_GCM', [{ciphers,aes_256_gcm}]} ] )); supported_algorithms(compression) -> @@ -1256,11 +1256,6 @@ get_length(aead, EncryptedBuffer, Ssh) -> end. -pkt_type('AEAD_AES_128_GCM') -> aead; -pkt_type('AEAD_AES_256_GCM') -> aead; -pkt_type('[email protected]') -> aead; -pkt_type(_) -> common. - payload(<<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) -> PayloadLen = PacketLen - PaddingLen - 1, <<Payload:PayloadLen/binary, _/binary>> = PayloadAndPadding, @@ -1323,162 +1318,115 @@ verify(PlainText, HashAlg, Sig, Key, _) -> %%% Unit: bytes --record(cipher_data, { - key_bytes, - iv_bytes, - block_bytes - }). +-record(cipher, { + impl, + key_bytes, + iv_bytes, + block_bytes, + pkt_type = common + }). %%% Start of a more parameterized crypto handling. cipher('AEAD_AES_128_GCM') -> - #cipher_data{key_bytes = 16, - iv_bytes = 12, - block_bytes = 16}; + #cipher{key_bytes = 16, + iv_bytes = 12, + block_bytes = 16, + pkt_type = aead}; cipher('AEAD_AES_256_GCM') -> - #cipher_data{key_bytes = 32, - iv_bytes = 12, - block_bytes = 16}; + #cipher{key_bytes = 32, + iv_bytes = 12, + block_bytes = 16, + pkt_type = aead}; cipher('3des-cbc') -> - #cipher_data{key_bytes = 24, - iv_bytes = 8, - block_bytes = 8}; + #cipher{impl = des3_cbc, + key_bytes = 24, + iv_bytes = 8, + block_bytes = 8}; cipher('aes128-cbc') -> - #cipher_data{key_bytes = 16, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_cbc, + key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; cipher('aes128-ctr') -> - #cipher_data{key_bytes = 16, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_128_ctr, + key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; cipher('aes192-ctr') -> - #cipher_data{key_bytes = 24, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_192_ctr, + key_bytes = 24, + iv_bytes = 16, + block_bytes = 16}; cipher('aes256-ctr') -> - #cipher_data{key_bytes = 32, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_256_ctr, + key_bytes = 32, + iv_bytes = 16, + block_bytes = 16}; cipher('[email protected]') -> % FIXME: Verify!! - #cipher_data{key_bytes = 32, - iv_bytes = 12, - block_bytes = 8}. - + #cipher{key_bytes = 32, + iv_bytes = 12, + block_bytes = 8, + pkt_type = aead}; + +cipher(_) -> + #cipher{}. + + +pkt_type(SshCipher) -> (cipher(SshCipher))#cipher.pkt_type. + +decrypt_magic(server) -> {"A", "C"}; +decrypt_magic(client) -> {"B", "D"}. + +encrypt_magic(client) -> decrypt_magic(server); +encrypt_magic(server) -> decrypt_magic(client). + encrypt_init(#ssh{encrypt = none} = Ssh) -> {ok, Ssh}; -encrypt_init(#ssh{encrypt = '[email protected]', role = client} = Ssh) -> + +encrypt_init(#ssh{encrypt = '[email protected]', role = Role} = Ssh) -> %% [email protected] uses two independent crypto streams, one (chacha20) %% for the length used in stream mode, and the other (chacha20-poly1305) as AEAD for %% the payload and to MAC the length||payload. %% See draft-josefsson-ssh-chacha20-poly1305-openssh-00 - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "C", 512), + {_, KeyMagic} = encrypt_magic(Role), + <<K2:32/binary,K1:32/binary>> = hash(Ssh, KeyMagic, 8*64), {ok, Ssh#ssh{encrypt_keys = {K1,K2} % encrypt_block_size = 16, %default = 8. What to set it to? 64 (openssl chacha.h) % ctx and iv is setup for each packet }}; -encrypt_init(#ssh{encrypt = '[email protected]', role = server} = Ssh) -> - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "D", 512), - {ok, Ssh#ssh{encrypt_keys = {K1,K2} - % encrypt_block_size = 16, %default = 8. What to set it to? - }}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:16/binary>> = hash(Ssh, "C", 128), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:16/binary>> = hash(Ssh, "D", 128), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_256_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:32/binary>> = hash(Ssh, "C", 256), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_256_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:32/binary>> = hash(Ssh, "D", 256), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = '3des-cbc', role = client} = Ssh) -> - IV = hash(Ssh, "A", 64), - <<K1:8/binary, K2:8/binary, K3:8/binary>> = hash(Ssh, "C", 192), - {ok, Ssh#ssh{encrypt_keys = {K1,K2,K3}, - encrypt_block_size = 8, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = '3des-cbc', role = server} = Ssh) -> - IV = hash(Ssh, "B", 64), - <<K1:8/binary, K2:8/binary, K3:8/binary>> = hash(Ssh, "D", 192), - {ok, Ssh#ssh{encrypt_keys = {K1,K2,K3}, - encrypt_block_size = 8, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'aes128-cbc', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:16/binary>> = hash(Ssh, "C", 128), + +encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; + SshCipher == 'AEAD_AES_256_GCM' -> + {IvMagic, KeyMagic} = encrypt_magic(Role), + #cipher{key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, + encrypt_block_size = BlockBytes, encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'aes128-cbc', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:16/binary>> = hash(Ssh, "D", 128), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'aes128-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:16/binary>> = hash(Ssh, "C", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes192-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:24/binary>> = hash(Ssh, "C", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes256-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:32/binary>> = hash(Ssh, "C", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes128-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:16/binary>> = hash(Ssh, "D", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes192-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:24/binary>> = hash(Ssh, "D", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes256-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:32/binary>> = hash(Ssh, "D", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}. + +encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) -> + {IvMagic, KeyMagic} = encrypt_magic(Role), + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), + Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, true), + {ok, Ssh#ssh{encrypt_block_size = BlockBytes, + encrypt_ctx = Ctx0}}. encrypt_final(Ssh) -> {ok, Ssh#ssh{encrypt = none, @@ -1487,249 +1435,126 @@ encrypt_final(Ssh) -> encrypt_ctx = undefined }}. + encrypt(#ssh{encrypt = none} = Ssh, Data) -> {Ssh, Data}; + encrypt(#ssh{encrypt = '[email protected]', encrypt_keys = {K1,K2}, send_sequence = Seq} = Ssh, <<LenData:4/binary, PayloadData/binary>>) -> %% Encrypt length IV1 = <<0:8/unit:8, Seq:8/unit:8>>, - {_,EncLen} = crypto:stream_encrypt(crypto:stream_init(chacha20, K1, IV1), - LenData), + EncLen = crypto:crypto_one_shot(chacha20, K1, IV1, LenData, true), %% Encrypt payload IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - {_,EncPayloadData} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, IV2), - PayloadData), - + EncPayloadData = crypto:crypto_one_shot(chacha20, K2, IV2, PayloadData, true), %% MAC tag - {_,PolyKey} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), - <<0:32/unit:8>>), + PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), EncBytes = <<EncLen/binary,EncPayloadData/binary>>, Ctag = crypto:poly1305(PolyKey, EncBytes), %% Result {Ssh, {EncBytes,Ctag}}; -encrypt(#ssh{encrypt = 'AEAD_AES_128_GCM', - encrypt_keys = K, + +encrypt(#ssh{encrypt = SshCipher, + encrypt_keys = K, encrypt_ctx = IV0} = Ssh, - <<LenData:4/binary, PayloadData/binary>>) -> - {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), - IV = next_gcm_iv(IV0), - {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; -encrypt(#ssh{encrypt = 'AEAD_AES_256_GCM', - encrypt_keys = K, - encrypt_ctx = IV0} = Ssh, - <<LenData:4/binary, PayloadData/binary>>) -> + <<LenData:4/binary, PayloadData/binary>>) when SshCipher == 'AEAD_AES_128_GCM' ; + SshCipher == 'AEAD_AES_256_GCM' -> {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), IV = next_gcm_iv(IV0), {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; -encrypt(#ssh{encrypt = '3des-cbc', - encrypt_keys = {K1,K2,K3}, - encrypt_ctx = IV0} = Ssh, Data) -> - Enc = crypto:block_encrypt(des3_cbc, [K1,K2,K3], IV0, Data), - IV = crypto:next_iv(des3_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}; -encrypt(#ssh{encrypt = 'aes128-cbc', - encrypt_keys = K, - encrypt_ctx = IV0} = Ssh, Data) -> - Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), - IV = crypto:next_iv(aes_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}; -encrypt(#ssh{encrypt = 'aes128-ctr', - encrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_encrypt(State0,Data), - {Ssh#ssh{encrypt_ctx = State}, Enc}; -encrypt(#ssh{encrypt = 'aes192-ctr', - encrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_encrypt(State0,Data), - {Ssh#ssh{encrypt_ctx = State}, Enc}; -encrypt(#ssh{encrypt = 'aes256-ctr', - encrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_encrypt(State0,Data), - {Ssh#ssh{encrypt_ctx = State}, Enc}. - +encrypt(#ssh{encrypt_ctx = Ctx0} = Ssh, Data) -> + Enc = crypto:crypto_update(Ctx0, Data), + {Ssh, Enc}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Decryption %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% decrypt_init(#ssh{decrypt = none} = Ssh) -> {ok, Ssh}; -decrypt_init(#ssh{decrypt = '[email protected]', role = client} = Ssh) -> - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "D", 512), - {ok, Ssh#ssh{decrypt_keys = {K1,K2} - }}; -decrypt_init(#ssh{decrypt = '[email protected]', role = server} = Ssh) -> - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "C", 512), + +decrypt_init(#ssh{decrypt = '[email protected]', role = Role} = Ssh) -> + {_, KeyMagic} = decrypt_magic(Role), + <<K2:32/binary,K1:32/binary>> = hash(Ssh, KeyMagic, 8*64), {ok, Ssh#ssh{decrypt_keys = {K1,K2} }}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:16/binary>> = hash(Ssh, "D", 128), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_128_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:16/binary>> = hash(Ssh, "C", 128), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_256_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:32/binary>> = hash(Ssh, "D", 256), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_256_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:32/binary>> = hash(Ssh, "C", 256), + +decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; + SshCipher == 'AEAD_AES_256_GCM' -> + {IvMagic, KeyMagic} = decrypt_magic(Role), + #cipher{key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, + decrypt_block_size = BlockBytes, decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = '3des-cbc', role = client} = Ssh) -> - {IV, KD} = {hash(Ssh, "B", 64), - hash(Ssh, "D", 192)}, - <<K1:8/binary, K2:8/binary, K3:8/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = {K1,K2,K3}, decrypt_ctx = IV, - decrypt_block_size = 8}}; -decrypt_init(#ssh{decrypt = '3des-cbc', role = server} = Ssh) -> - {IV, KD} = {hash(Ssh, "A", 64), - hash(Ssh, "C", 192)}, - <<K1:8/binary, K2:8/binary, K3:8/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = {K1, K2, K3}, decrypt_ctx = IV, - decrypt_block_size = 8}}; -decrypt_init(#ssh{decrypt = 'aes128-cbc', role = client} = Ssh) -> - {IV, KD} = {hash(Ssh, "B", 128), - hash(Ssh, "D", 128)}, - <<K:16/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}; -decrypt_init(#ssh{decrypt = 'aes128-cbc', role = server} = Ssh) -> - {IV, KD} = {hash(Ssh, "A", 128), - hash(Ssh, "C", 128)}, - <<K:16/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}; -decrypt_init(#ssh{decrypt = 'aes128-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:16/binary>> = hash(Ssh, "D", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes192-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:24/binary>> = hash(Ssh, "D", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes256-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:32/binary>> = hash(Ssh, "D", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes128-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:16/binary>> = hash(Ssh, "C", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes192-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:24/binary>> = hash(Ssh, "C", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes256-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:32/binary>> = hash(Ssh, "C", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}. - +decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) -> + {IvMagic, KeyMagic} = decrypt_magic(Role), + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), + Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, false), + {ok, Ssh#ssh{decrypt_block_size = BlockBytes, + decrypt_ctx = Ctx0}}. + decrypt_final(Ssh) -> {ok, Ssh#ssh {decrypt = none, decrypt_keys = undefined, decrypt_ctx = undefined, decrypt_block_size = 8}}. + decrypt(Ssh, <<>>) -> {Ssh, <<>>}; + decrypt(#ssh{decrypt = '[email protected]', decrypt_keys = {K1,_K2}, recv_sequence = Seq} = Ssh, {length,EncryptedLen}) -> - {_State,PacketLenBin} = - crypto:stream_decrypt(crypto:stream_init(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>), - EncryptedLen), + PacketLenBin = crypto:crypto_one_shot(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>, EncryptedLen, false), {Ssh, PacketLenBin}; + decrypt(#ssh{decrypt = '[email protected]', decrypt_keys = {_K1,K2}, recv_sequence = Seq} = Ssh, {AAD,Ctext,Ctag}) -> %% The length is already decoded and used to divide the input %% Check the mac (important that it is timing-safe): - {_,PolyKey} = - crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), - <<0:32/unit:8>>), + PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of true -> %% MAC is ok, decode IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - {_,PlainText} = - crypto:stream_decrypt(crypto:stream_init(chacha20,K2,IV2), Ctext), + PlainText = crypto:crypto_one_shot(chacha20, K2, IV2, Ctext, false), {Ssh, PlainText}; false -> {Ssh,error} end; + decrypt(#ssh{decrypt = none} = Ssh, Data) -> {Ssh, Data}; -decrypt(#ssh{decrypt = 'AEAD_AES_128_GCM', - decrypt_keys = K, - decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) -> - Dec = crypto:block_decrypt(aes_gcm, K, IV0, Data), % Dec = PlainText | error - IV = next_gcm_iv(IV0), - {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = 'AEAD_AES_256_GCM', + +decrypt(#ssh{decrypt = SshCipher, decrypt_keys = K, - decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) -> + decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) when SshCipher == 'AEAD_AES_128_GCM' ; + SshCipher == 'AEAD_AES_256_GCM' -> Dec = crypto:block_decrypt(aes_gcm, K, IV0, Data), % Dec = PlainText | error IV = next_gcm_iv(IV0), {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = '3des-cbc', decrypt_keys = Keys, - decrypt_ctx = IV0} = Ssh, Data) -> - {K1, K2, K3} = Keys, - Dec = crypto:block_decrypt(des3_cbc, [K1,K2,K3], IV0, Data), - IV = crypto:next_iv(des3_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, - decrypt_ctx = IV0} = Ssh, Data) -> - Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), - IV = crypto:next_iv(aes_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = 'aes128-ctr', - decrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_decrypt(State0,Data), - {Ssh#ssh{decrypt_ctx = State}, Enc}; -decrypt(#ssh{decrypt = 'aes192-ctr', - decrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_decrypt(State0,Data), - {Ssh#ssh{decrypt_ctx = State}, Enc}; -decrypt(#ssh{decrypt = 'aes256-ctr', - decrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_decrypt(State0,Data), - {Ssh#ssh{decrypt_ctx = State}, Enc}. +decrypt(#ssh{decrypt_ctx = Ctx0} = Ssh, Data) -> + Dec = crypto:crypto_update(Ctx0, Data), + {Ssh, Dec}. next_gcm_iv(<<Fixed:32, InvCtr:64>>) -> <<Fixed:32, (InvCtr+1):64>>. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compression %% @@ -2058,9 +1883,9 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> dh_bits(#alg{encrypt = Encrypt, send_mac = SendMac}) -> C = cipher(Encrypt), - 8 * lists:max([C#cipher_data.key_bytes, - C#cipher_data.block_bytes, - C#cipher_data.iv_bytes, + 8 * lists:max([C#cipher.key_bytes, + C#cipher.block_bytes, + C#cipher.iv_bytes, mac_key_bytes(SendMac) ]). @@ -2091,40 +1916,13 @@ select_crypto_supported(L) -> crypto_supported(Conditions, Supported) -> lists:all( fun({Tag,CryptoName}) when is_atom(CryptoName) -> - crypto_name_supported(Tag,CryptoName,Supported); - ({Tag,{Name,Len}}) when is_integer(Len) -> - crypto_name_supported(Tag,Name,Supported) andalso - len_supported(Name,Len) + crypto_name_supported(Tag,CryptoName,Supported) end, Conditions). crypto_name_supported(Tag, CryptoName, Supported) -> - Vs = case proplists:get_value(Tag,Supported,[]) of - [] when Tag == curves -> crypto:ec_curves(); - L -> L - end, + Vs = proplists:get_value(Tag,Supported,[]), lists:member(CryptoName, Vs). -len_supported(Name, Len) -> - try - case Name of - aes_ctr -> - {_, <<_/binary>>} = - %% Test encryption - crypto:stream_encrypt(crypto:stream_init(Name, <<0:Len>>, <<0:128>>), <<"">>); - aes_gcm -> - {<<_/binary>>, <<_/binary>>} = - crypto:block_encrypt(Name, - _Key = <<0:Len>>, - _IV = <<0:12/unsigned-unit:8>>, - {<<"AAD">>,"PT"}) - end - of - _ -> true - catch - _:_ -> false - end. - - same(Algs) -> [{client2server,Algs}, {server2client,Algs}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 732fdc71e7..a511cb4db3 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,30 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The timeout for a passive receive was sometimes not + cancelled and later caused a server crash. This bug has + now been corrected.</p> + <p> + Own Id: OTP-14701 Aux Id: ERL-883, ERL-884 </p> + </item> + <item> + <p> + Add tag for passive message (active N) in cb_info to + retain transport transparency.</p> + <p> + Own Id: OTP-15679 Aux Id: ERL-861 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.2</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 b145aac6ab..37bf9033a1 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -101,16 +101,21 @@ <datatype> <name name="transport_option"/> <desc> - <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> - for TLS and <c>{gen_udp, udp, udp_closed, udp_error}</c> for - DTLS. Can be used to customize the transport layer. The tag - values should be the values used by the underlying transport - in its active mode messages. For TLS the callback module must implement a - reliable transport protocol, behave as <c>gen_tcp</c>, and have functions - corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, - <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>. - The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> - directly. For DTLS this feature must be considered exprimental. + <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error, + tcp_passive}</c> for TLS (for backward compatibility a four + tuple will be converted to a five tuple with the last element + "second_element"_passive) and <c>{gen_udp, udp, udp_closed, + udp_error}</c> for DTLS (might also be changed to five tuple in + the future). Can be used to customize the transport layer. The + tag values should be the values used by the underlying + transport in its active mode messages. For TLS the callback + module must implement a reliable transport protocol, behave as + <c>gen_tcp</c>, and have functions corresponding to + <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, + <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and + <c>inet:port/1</c>. The callback <c>gen_tcp</c> is treated + specially and calls <c>inet</c> directly. For DTLS this + feature must be considered exprimental. </p> </desc> </datatype> @@ -1658,17 +1663,6 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 22.0">set_log_level(Level) -> ok | {error, Reason}</name> - <fsummary>Sets log level for the SSL application.</fsummary> - <type> - <v>Level = atom()</v> - </type> - <desc> - <p>Sets log level for the SSL application.</p> - </desc> - </func> - - <func> <name since="OTP R14B">shutdown(SslSocket, How) -> ok | {error, Reason}</name> <fsummary>Immediately closes a socket.</fsummary> <type> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 5a2d31ffc2..bfa349c8d8 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -55,8 +55,7 @@ format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc --export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1, - set_log_level/1]). +-export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1]). -deprecated({ssl_accept, 1, eventually}). -deprecated({ssl_accept, 2, eventually}). @@ -96,7 +95,9 @@ -type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | {ssl_error, sslsocket(), Reason::term()} | {ssl_passive, sslsocket()}. -type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), - ClosedTag::atom(), ErrTag::atom()}}. + ClosedTag::atom(), ErrTag::atom()}} | + {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag::atom(), PassiveTag::atom()}}. -type host() :: hostname() | ip_address(). -type hostname() :: string(). -type ip_address() :: inet:ip_address(). @@ -422,9 +423,9 @@ connect(Socket, SslOptions) when is_port(Socket) -> timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. connect(Socket, SslOptions0, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> - {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, - {gen_tcp, tcp, tcp_closed, tcp_error}), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> + CbInfo = handle_option(cb_info, SslOptions0, default_cb_info(tls)), + Transport = element(1, CbInfo), EmulatedOptions = tls_socket:emulated_options(), {ok, SocketValues} = tls_socket:getopts(Transport, Socket, EmulatedOptions), try handle_options(SslOptions0 ++ SocketValues, client) of @@ -572,8 +573,8 @@ handshake(#sslsocket{pid = [Pid|_], fd = {_, _, _}} = Socket, SslOpts, Timeout) end; handshake(Socket, SslOptions, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> - {Transport,_,_,_} = - proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), + CbInfo = handle_option(cb_info, SslOptions, default_cb_info(tls)), + Transport = element(1, CbInfo), EmulatedOptions = tls_socket:emulated_options(), {ok, SocketValues} = tls_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), @@ -625,7 +626,7 @@ close(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT}); close(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, _}}}}) -> dtls_packet_demux:close(Pid); -close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) -> +close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_}}}}) -> Transport:close(ListenSocket). %%-------------------------------------------------------------------- @@ -641,7 +642,7 @@ close(#sslsocket{pid = [TLSPid|_]}, close(#sslsocket{pid = [TLSPid|_]}, Timeout) when is_pid(TLSPid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, Timeout}); -close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}, _) -> +close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_}}}}, _) -> Transport:close(ListenSocket). %%-------------------------------------------------------------------- @@ -657,7 +658,8 @@ send(#sslsocket{pid = {_, #config{transport_info={_, udp, _, _}}}}, _) -> {error,enotconn}; %% Emulate connection behaviour send(#sslsocket{pid = {dtls,_}}, _) -> {error,enotconn}; %% Emulate connection behaviour -send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) -> +send(#sslsocket{pid = {ListenSocket, #config{transport_info = Info}}}, Data) -> + Transport = element(1, Info), Transport:send(ListenSocket, Data). %% {error,enotconn} %%-------------------------------------------------------------------- @@ -675,7 +677,8 @@ recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid), recv(#sslsocket{pid = {dtls,_}}, _, _) -> {error,enotconn}; recv(#sslsocket{pid = {Listen, - #config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)-> + #config{transport_info = Info}}},_,_) when is_port(Listen)-> + Transport = element(1, Info), Transport:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- @@ -690,7 +693,7 @@ controlling_process(#sslsocket{pid = {dtls, _}}, NewOwner) when is_pid(NewOwner) -> ok; %% Meaningless but let it be allowed to conform with TLS controlling_process(#sslsocket{pid = {Listen, - #config{transport_info = {Transport, _, _, _}}}}, + #config{transport_info = {Transport,_,_,_,_}}}}, NewOwner) when is_port(Listen), is_pid(NewOwner) -> %% Meaningless but let it be allowed to conform with normal sockets @@ -733,13 +736,13 @@ connection_information(#sslsocket{pid = [Pid|_]}, Items) when is_pid(Pid) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket,_}}) when is_pid(Pid)-> dtls_socket:peername(Transport, Socket); -peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket,_,_}}) when is_pid(Pid)-> tls_socket:peername(Transport, Socket); -peername(#sslsocket{pid = {dtls, #config{dtls_handler = {_Pid, _}}}}) -> +peername(#sslsocket{pid = {dtls, #config{dtls_handler = {_Pid,_}}}}) -> dtls_socket:peername(dtls, undefined); -peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> +peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_,_}}}}) -> tls_socket:peername(Transport, ListenSocket); %% Will return {error, enotconn} peername(#sslsocket{pid = {dtls,_}}) -> {error,enotconn}. @@ -931,7 +934,7 @@ getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = _:Error -> {error, {options, {socket_options, OptionTags, Error}}} end; -getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, +getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try tls_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> @@ -988,7 +991,7 @@ setopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = _:Error -> {error, {options, {socket_options, Options, Error}}} end; -setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try tls_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; @@ -1032,8 +1035,9 @@ getstat(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}, Options) when %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}, +shutdown(#sslsocket{pid = {Listen, #config{transport_info = Info}}}, How) when is_port(Listen) -> + Transport = element(1, Info), Transport:shutdown(Listen, How); shutdown(#sslsocket{pid = {dtls,_}},_) -> {error, enotconn}; @@ -1045,13 +1049,13 @@ shutdown(#sslsocket{pid = [Pid|_]}, How) when is_pid(Pid) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}) when is_port(Listen) -> +sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_,_,_,_}}}}) when is_port(Listen) -> tls_socket:sockname(Transport, Listen); sockname(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, _}}}}) -> dtls_packet_demux:sockname(Pid); -sockname(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = [Pid|_], fd = {Transport, Socket,_}}) when is_pid(Pid) -> dtls_socket:sockname(Transport, Socket); -sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket,_,_}}) when is_pid(Pid) -> tls_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- @@ -1167,32 +1171,6 @@ suite_to_str(Cipher) -> ssl_cipher_format:suite_to_str(Cipher). -%%-------------------------------------------------------------------- --spec set_log_level(atom()) -> ok | {error, term()}. -%% -%% Description: Set log level for the SSL application -%%-------------------------------------------------------------------- -set_log_level(Level) -> - case application:get_all_key(ssl) of - {ok, PropList} -> - Modules = proplists:get_value(modules, PropList), - set_module_level(Modules, Level); - undefined -> - {error, ssl_not_started} - end. - -set_module_level(Modules, Level) -> - Fun = fun (Module) -> - ok = logger:set_module_level(Module, Level) - end, - try lists:map(Fun, Modules) of - _ -> - ok - catch - error:{badmatch, Error} -> - Error - end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -1211,7 +1189,7 @@ supported_suites(all, Version) -> supported_suites(anonymous, Version) -> ssl_cipher:anonymous_suites(Version). -do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) -> +do_listen(Port, #config{transport_info = {Transport, _, _, _,_}} = Config, tls_connection) -> tls_socket:listen(Transport, Port, Config); do_listen(Port, Config, dtls_connection) -> @@ -1381,7 +1359,7 @@ handle_options(Opts0, Role, Host) -> log_level = handle_option(log_level, Opts, LogLevel) }, - CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), + CbInfo = handle_option(cb_info, Opts, default_cb_info(Protocol)), SslOptions = [protocol, versions, verify, verify_fun, partial_chain, fail_if_no_peer_cert, verify_client_once, depth, cert, certfile, key, keyfile, @@ -1425,6 +1403,10 @@ handle_option(sni_fun, Opts, Default) -> _ -> throw({error, {conflict_options, [sni_fun, sni_hosts]}}) end; +handle_option(cb_info, Opts, Default) -> + CbInfo = proplists:get_value(cb_info, Opts, Default), + true = validate_option(cb_info, CbInfo), + handle_cb_info(CbInfo, Default); handle_option(OptionName, Opts, Default) -> validate_option(OptionName, proplists:get_value(OptionName, Opts, Default)). @@ -1659,9 +1641,29 @@ validate_option(handshake, full = Value) -> Value; validate_option(customize_hostname_check, Value) when is_list(Value) -> Value; +validate_option(cb_info, {V1, V2, V3, V4}) when is_atom(V1), + is_atom(V2), + is_atom(V3), + is_atom(V4) + -> + true; +validate_option(cb_info, {V1, V2, V3, V4, V5}) when is_atom(V1), + is_atom(V2), + is_atom(V3), + is_atom(V4), + is_atom(V5) + -> + true; +validate_option(cb_info, _) -> + false; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). +handle_cb_info({V1, V2, V3, V4}, {_,_,_,_,_}) -> + {V1,V2,V3,V4, list_to_atom(atom_to_list(V2) ++ "passive")}; +handle_cb_info(CbInfo, _) -> + CbInfo. + handle_hashsigns_option(Value, Version) when is_list(Value) andalso Version >= {3, 4} -> case tls_v1:signature_schemes(Version, Value) of @@ -2132,7 +2134,7 @@ default_option_role(_,_,_) -> default_cb_info(tls) -> - {gen_tcp, tcp, tcp_closed, tcp_error}; + {gen_tcp, tcp, tcp_closed, tcp_error, tcp_passive}; default_cb_info(dtls) -> {gen_udp, udp, udp_closed, udp_error}. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index e17476f33b..06b1b005a5 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -161,6 +161,8 @@ description_txt(?INSUFFICIENT_SECURITY) -> "Insufficient Security"; description_txt(?INTERNAL_ERROR) -> "Internal Error"; +description_txt(?INAPPROPRIATE_FALLBACK) -> + "Inappropriate Fallback"; description_txt(?USER_CANCELED) -> "User Canceled"; description_txt(?NO_RENEGOTIATION) -> @@ -179,8 +181,6 @@ description_txt(?BAD_CERTIFICATE_HASH_VALUE) -> "Bad Certificate Hash Value"; description_txt(?UNKNOWN_PSK_IDENTITY) -> "Unknown Psk Identity"; -description_txt(?INAPPROPRIATE_FALLBACK) -> - "Inappropriate Fallback"; description_txt(?CERTIFICATE_REQUIRED) -> "Certificate required"; description_txt(?NO_APPLICATION_PROTOCOL) -> @@ -232,10 +232,14 @@ description_atom(?INSUFFICIENT_SECURITY) -> insufficient_security; description_atom(?INTERNAL_ERROR) -> internal_error; +description_atom(?INAPPROPRIATE_FALLBACK) -> + inappropriate_fallback; description_atom(?USER_CANCELED) -> user_canceled; description_atom(?NO_RENEGOTIATION) -> no_renegotiation; +description_atom(?MISSING_EXTENSION) -> + missing_extension; description_atom(?UNSUPPORTED_EXTENSION) -> unsupported_extension; description_atom(?CERTIFICATE_UNOBTAINABLE) -> @@ -248,9 +252,9 @@ description_atom(?BAD_CERTIFICATE_HASH_VALUE) -> bad_certificate_hash_value; description_atom(?UNKNOWN_PSK_IDENTITY) -> unknown_psk_identity; -description_atom(?INAPPROPRIATE_FALLBACK) -> - inappropriate_fallback; +description_atom(?CERTIFICATE_REQUIRED) -> + certificate_required; description_atom(?NO_APPLICATION_PROTOCOL) -> no_application_protocol; description_atom(_) -> - 'unsupported/unkonwn_alert'. + 'unsupported/unknown_alert'. diff --git a/lib/ssl/src/ssl_app.erl b/lib/ssl/src/ssl_app.erl index 2a5047c75c..9e6d676bef 100644 --- a/lib/ssl/src/ssl_app.erl +++ b/lib/ssl/src/ssl_app.erl @@ -44,11 +44,11 @@ start_logger() -> formatter => {ssl_logger, #{}}}, Filter = {fun logger_filters:domain/2,{log,sub,[otp,ssl]}}, logger:add_handler(ssl_handler, logger_std_h, Config), - logger:add_handler_filter(ssl_handler, filter_non_ssl, Filter). + logger:add_handler_filter(ssl_handler, filter_non_ssl, Filter), + logger:set_application_level(ssl, debug). %% %% Description: Stop SSL logger stop_logger() -> + logger:unset_application_level(ssl), logger:remove_handler(ssl_handler). - - diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 6e751f9ceb..fe8736d2df 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -45,7 +45,7 @@ random_bytes/1, calc_mac_hash/4, calc_mac_hash/6, is_stream_ciphersuite/1, signature_scheme/1, scheme_to_components/1, hash_size/1, effective_key_bits/1, - key_material/1]). + key_material/1, signature_algorithm_to_scheme/1]). %% RFC 8446 TLS 1.3 -export([generate_client_shares/1, generate_server_share/1, add_zero_padding/2]). @@ -900,6 +900,18 @@ scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined}; scheme_to_components(rsa_pkcs1_sha1) -> {sha1, rsa_pkcs1, undefined}; scheme_to_components(ecdsa_sha1) -> {sha1, ecdsa, undefined}. + +%% TODO: Add support for EC and RSA-SSA signatures +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha1WithRSAEncryption}) -> + rsa_pkcs1_sha1; +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha256WithRSAEncryption}) -> + rsa_pkcs1_sha256; +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha384WithRSAEncryption}) -> + rsa_pkcs1_sha384; +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha512WithRSAEncryption}) -> + rsa_pkcs1_sha512. + + %% RFC 5246: 6.2.3.2. CBC Block Cipher %% %% Implementation note: Canvel et al. [CBCTIME] have demonstrated a diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e5b01cce5f..1e97fe046b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -385,7 +385,8 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName, log_alert(SslOpts#ssl_options.log_level, Role, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), Pids = Connection:pids(State), - alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), + alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, + opposite_role(Role), Connection), {stop, {shutdown, normal}, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 201164949a..ff7207a8ce 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -40,6 +40,7 @@ data_tag :: atom(), % ex tcp. close_tag :: atom(), % ex tcp_closed error_tag :: atom(), % ex tcp_error + passive_tag :: atom(), % ex tcp_passive host :: string() | inet:ip_address(), port :: integer(), socket :: port() | tuple(), %% TODO: dtls socket diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 260f603e90..6c95a7edf8 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -79,7 +79,10 @@ select_hashsign_algs/3, empty_extensions/2, add_server_share/3 ]). --export([get_cert_params/1]). +-export([get_cert_params/1, + server_name/3, + validation_fun_and_state/9, + handle_path_validation_error/7]). %%==================================================================== %% Create handshake messages diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index d4233bea9b..b248edcaa9 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -47,7 +47,9 @@ srp_username, is_resumable, time_stamp, - ecc + ecc, %% TLS 1.3 Group + sign_alg, %% TLS 1.3 Signature Algorithm + dh_public_value %% TLS 1.3 DH Public Value from peer }). -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index b82b3937a1..f497315235 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -181,6 +181,11 @@ parse_handshake(Direction, #hello_request{} = HelloRequest) -> [header_prefix(Direction)]), Message = io_lib:format("~p", [?rec_info(hello_request, HelloRequest)]), {Header, Message}; +parse_handshake(Direction, #certificate_request_1_3{} = CertificateRequest) -> + Header = io_lib:format("~s Handshake, CertificateRequest", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(certificate_request_1_3, CertificateRequest)]), + {Header, Message}; parse_handshake(Direction, #certificate_1_3{} = Certificate) -> Header = io_lib:format("~s Handshake, Certificate", [header_prefix(Direction)]), diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 8eb9e56375..fde73cdef1 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -98,7 +98,7 @@ %% Setup %%==================================================================== start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, + User, {CbModule, _,_, _, _} = CbInfo, Timeout) -> try {ok, Sender} = tls_sender:start(), @@ -112,7 +112,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} end; start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, + User, {CbModule, _,_, _, _} = CbInfo, Timeout) -> try {ok, Sender} = tls_sender:start([{spawn_opt, ?DIST_CNTRL_SPAWN_OPTS}]), @@ -251,13 +251,28 @@ next_event(StateName, Record, State, Actions) -> %%% TLS record protocol level application data messages - -handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName0, State0) -> +handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, + #state{start_or_recv_from = From, + socket_options = #socket_options{active = false}} = State0) when From =/= undefined -> + case ssl_connection:read_application_data(Data, State0) of + {stop, _, _} = Stop-> + Stop; + {Record, #state{start_or_recv_from = Caller} = State1} -> + TimerAction = case Caller of + undefined -> %% Passive recv complete cancel timer + [{{timeout, recv}, infinity, timeout}]; + _ -> + [] + end, + {next_state, StateName, State, Actions} = next_event(StateName, Record, State1, TimerAction), + ssl_connection:hibernate_after(StateName, State, Actions) + end; +handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State0) -> case ssl_connection:read_application_data(Data, State0) of {stop, _, _} = Stop-> Stop; {Record, State1} -> - case next_event(StateName0, Record, State1) of + case next_event(StateName, Record, State1) of {next_state, StateName, State, Actions} -> ssl_connection:hibernate_after(StateName, State, Actions); {stop, _, _} = Stop -> @@ -308,9 +323,7 @@ handle_protocol_record(#ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, handle_alerts(Alerts, {next_state, StateName, State}); [] -> ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert), - Version, StateName, State); - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State) + Version, StateName, State) catch _:_ -> ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error), @@ -941,7 +954,7 @@ code_change(_OldVsn, StateName, State, _) -> %%% Internal functions %%-------------------------------------------------------------------- initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, - {CbModule, DataTag, CloseTag, ErrorTag}) -> + {CbModule, DataTag, CloseTag, ErrorTag, PassiveTag}) -> #ssl_options{beast_mitigation = BeastMitigation, erl_dist = IsErlDist} = SSLOptions, ConnectionStates = tls_record:init_connection_states(Role, BeastMitigation), @@ -965,6 +978,7 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac data_tag = DataTag, close_tag = CloseTag, error_tag = ErrorTag, + passive_tag = PassiveTag, host = Host, port = Port, socket = Socket, @@ -1061,8 +1075,9 @@ handle_info({Protocol, _, Data}, StateName, ssl_connection:handle_normal_shutdown(Alert, StateName, State0), {stop, {shutdown, own_alert}, State0} end; -handle_info({tcp_passive, Socket}, StateName, - #state{static_env = #static_env{socket = Socket}, +handle_info({PassiveTag, Socket}, StateName, + #state{static_env = #static_env{socket = Socket, + passive_tag = PassiveTag}, protocol_specific = PS } = State) -> next_event(StateName, no_record, @@ -1135,6 +1150,7 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0) -> encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> tls_record:encode_change_cipher_spec(Version, ConnectionStates). +-spec decode_alerts(binary()) -> list(). decode_alerts(Bin) -> ssl_alert:decode(Bin). diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl index 71ac6a9310..701a5860c2 100644 --- a/lib/ssl/src/tls_connection_1_3.erl +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -110,51 +110,75 @@ %% gen_statem helper functions -export([start/4, negotiated/4, + wait_cert/4, + wait_cv/4, wait_finished/4 ]). -start(internal, - #change_cipher_spec{} = ChangeCipherSpec, State0, _Module) -> - case tls_handshake_1_3:do_start(ChangeCipherSpec, State0) of - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, {3,4}, start, State0); - State1 -> - {Record, State} = tls_connection:next_record(State1), - tls_connection:next_event(?FUNCTION_NAME, Record, State) - end; +start(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); start(internal, #client_hello{} = Hello, State0, _Module) -> case tls_handshake_1_3:do_start(Hello, State0) of #alert{} = Alert -> ssl_connection:handle_own_alert(Alert, {3,4}, start, State0); - {State, _, start} -> + {State, start} -> {next_state, start, State, []}; - {State, Context, negotiated} -> - {next_state, negotiated, State, [{next_event, internal, Context}]} + {State, negotiated} -> + {next_state, negotiated, State, [{next_event, internal, start_handshake}]} end; start(Type, Msg, State, Connection) -> ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). -negotiated(internal, Map, State0, _Module) -> - case tls_handshake_1_3:do_negotiated(Map, State0) of +negotiated(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); +negotiated(internal, Message, State0, _Module) -> + case tls_handshake_1_3:do_negotiated(Message, State0) of #alert{} = Alert -> ssl_connection:handle_own_alert(Alert, {3,4}, negotiated, State0); - State -> - {next_state, wait_finished, State, []} - + {State, NextState} -> + {next_state, NextState, State, []} end. -wait_finished(internal, - #change_cipher_spec{} = ChangeCipherSpec, State0, _Module) -> - case tls_handshake_1_3:do_wait_finished(ChangeCipherSpec, State0) of - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, {3,4}, wait_finished, State0); - State1 -> +wait_cert(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); +wait_cert(internal, + #certificate_1_3{} = Certificate, State0, _Module) -> + case tls_handshake_1_3:do_wait_cert(Certificate, State0) of + {#alert{} = Alert, State} -> + ssl_connection:handle_own_alert(Alert, {3,4}, wait_cert, State); + {State1, NextState} -> {Record, State} = tls_connection:next_record(State1), - tls_connection:next_event(?FUNCTION_NAME, Record, State) + tls_connection:next_event(NextState, Record, State) end; +wait_cert(Type, Msg, State, Connection) -> + ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). + + +wait_cv(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); +wait_cv(internal, + #certificate_verify_1_3{} = CertificateVerify, State0, _Module) -> + case tls_handshake_1_3:do_wait_cv(CertificateVerify, State0) of + {#alert{} = Alert, State} -> + ssl_connection:handle_own_alert(Alert, {3,4}, wait_cv, State); + {State1, NextState} -> + {Record, State} = tls_connection:next_record(State1), + tls_connection:next_event(NextState, Record, State) + end; +wait_cv(Type, Msg, State, Connection) -> + ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). + + +wait_finished(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); wait_finished(internal, #finished{} = Finished, State0, Module) -> case tls_handshake_1_3:do_wait_finished(Finished, State0) of diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 3bc1290361..0efedf3400 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -44,6 +44,8 @@ -export([do_start/2, do_negotiated/2, + do_wait_cert/2, + do_wait_cv/2, do_wait_finished/2]). %%==================================================================== @@ -87,6 +89,36 @@ encrypted_extensions() -> }. +certificate_request(SignAlgs0, SignAlgsCert0) -> + %% Input arguments contain TLS 1.2 algorithms due to backward compatibility + %% reasons. These {Hash, Algo} tuples must be filtered before creating the + %% the extensions. + SignAlgs = filter_tls13_algs(SignAlgs0), + SignAlgsCert = filter_tls13_algs(SignAlgsCert0), + Extensions0 = add_signature_algorithms(#{}, SignAlgs), + Extensions = add_signature_algorithms_cert(Extensions0, SignAlgsCert), + #certificate_request_1_3{ + certificate_request_context = <<>>, + extensions = Extensions}. + + +add_signature_algorithms(Extensions, SignAlgs) -> + Extensions#{signature_algorithms => + #signature_algorithms{signature_scheme_list = SignAlgs}}. + + +add_signature_algorithms_cert(Extensions, undefined) -> + Extensions; +add_signature_algorithms_cert(Extensions, SignAlgsCert) -> + Extensions#{signature_algorithms_cert => + #signature_algorithms{signature_scheme_list = SignAlgsCert}}. + + +filter_tls13_algs(undefined) -> undefined; +filter_tls13_algs(Algo) -> + lists:filter(fun is_atom/1, Algo). + + %% TODO: use maybe monad for error handling! %% enum { %% X509(0), @@ -144,7 +176,7 @@ certificate_verify(PrivateKey, SignatureScheme, %% Digital signatures use the hash function defined by the selected signature %% scheme. - case digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>, + case sign(THash, <<"TLS 1.3, server CertificateVerify">>, HashAlgo, PrivateKey) of {ok, Signature} -> {ok, #certificate_verify_1_3{ @@ -352,7 +384,7 @@ certificate_entry(DER) -> %% 79 %% 00 %% 0101010101010101010101010101010101010101010101010101010101010101 -digitally_sign(THash, Context, HashAlgo, PrivateKey) -> +sign(THash, Context, HashAlgo, PrivateKey) -> Content = build_content(Context, THash), %% The length of the Salt MUST be equal to the length of the output @@ -369,6 +401,23 @@ digitally_sign(THash, Context, HashAlgo, PrivateKey) -> end. +verify(THash, Context, HashAlgo, Signature, PublicKey) -> + Content = build_content(Context, THash), + + %% The length of the Salt MUST be equal to the length of the output + %% of the digest algorithm: rsa_pss_saltlen = -1 + try public_key:verify(Content, HashAlgo, Signature, PublicKey, + [{rsa_padding, rsa_pkcs1_pss_padding}, + {rsa_pss_saltlen, -1}, + {rsa_mgf1_md, HashAlgo}]) of + Result -> + {ok, Result} + catch + error:badarg -> + {error, badarg} + end. + + build_content(Context, THash) -> Prefix = binary:copy(<<32>>, 64), <<Prefix/binary,Context/binary,?BYTE(0),THash/binary>>. @@ -379,36 +428,12 @@ build_content(Context, THash) -> %%==================================================================== -do_start(#change_cipher_spec{}, - #state{connection_states = _ConnectionStates0, - session = #session{session_id = _SessionId, - own_certificate = _OwnCert}, - ssl_options = #ssl_options{} = _SslOpts, - key_share = _KeyShare, - handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, - static_env = #static_env{ - cert_db = _CertDbHandle, - cert_db_ref = _CertDbRef, - socket = _Socket, - transport_cb = _Transport} - } = State0) -> - %% {Ref,Maybe} = maybe(), - - try - - State0 - - catch - {_Ref, {state_not_implemented, State}} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) - end; do_start(#client_hello{cipher_suites = ClientCiphers, session_id = SessionId, extensions = Extensions} = _Hello, #state{connection_states = _ConnectionStates0, ssl_options = #ssl_options{ciphers = ServerCiphers, signature_algs = ServerSignAlgs, - signature_algs_cert = _SignatureSchemes, %% TODO: check! supported_groups = ServerGroups0}, session = #session{own_certificate = Cert}} = State0) -> @@ -454,7 +479,8 @@ do_start(#client_hello{cipher_suites = ClientCiphers, %% Generate server_share KeyShare = ssl_cipher:generate_server_share(Group), - State1 = update_start_state(State0, Cipher, KeyShare, SessionId), + State1 = update_start_state(State0, Cipher, KeyShare, SessionId, + Group, SelectedSignAlg, ClientPubKey), %% 4.1.4. Hello Retry Request %% @@ -462,14 +488,7 @@ do_start(#client_hello{cipher_suites = ClientCiphers, %% 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. - {State2, NextState} = - Maybe(send_hello_retry_request(State1, ClientPubKey, KeyShare, SessionId)), - - %% TODO: Add Context to state? - Context = #{group => Group, - sign_alg => SelectedSignAlg, - client_share => ClientPubKey}, - {State2, Context, NextState} + Maybe(send_hello_retry_request(State1, ClientPubKey, KeyShare, SessionId)) %% TODO: %% - session handling @@ -484,29 +503,29 @@ do_start(#client_hello{cipher_suites = ClientCiphers, {Ref, no_suitable_cipher} -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_cipher); {Ref, {insufficient_security, no_suitable_signature_algorithm}} -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, "No suitable signature algorithm"); {Ref, {insufficient_security, no_suitable_public_key}} -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_public_key) end. -do_negotiated(#{client_share := ClientKey, - group := SelectedGroup, - sign_alg := SignatureScheme - }, - #state{connection_states = ConnectionStates0, - session = #session{session_id = SessionId, - own_certificate = OwnCert}, - ssl_options = #ssl_options{} = _SslOpts, - key_share = KeyShare, - handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, - connection_env = #connection_env{private_key = CertPrivateKey}, - static_env = #static_env{ - cert_db = CertDbHandle, - cert_db_ref = CertDbRef, - socket = _Socket, - transport_cb = _Transport} - } = State0) -> +do_negotiated(start_handshake, + #state{connection_states = ConnectionStates0, + session = #session{session_id = SessionId, + own_certificate = OwnCert, + ecc = SelectedGroup, + sign_alg = SignatureScheme, + dh_public_value = ClientKey}, + ssl_options = #ssl_options{} = SslOpts, + key_share = KeyShare, + handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, + connection_env = #connection_env{private_key = CertPrivateKey}, + static_env = #static_env{ + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + socket = _Socket, + transport_cb = _Transport} + } = State0) -> {Ref,Maybe} = maybe(), try @@ -527,59 +546,71 @@ do_negotiated(#{client_share := ClientKey, %% Encode EncryptedExtensions State4 = tls_connection:queue_handshake(EncryptedExtensions, State3), + %% Create and send CertificateRequest ({verify, verify_peer}) + {State5, NextState} = maybe_send_certificate_request(State4, SslOpts), + %% Create Certificate Certificate = certificate(OwnCert, CertDbHandle, CertDbRef, <<>>, server), %% Encode Certificate - State5 = tls_connection:queue_handshake(Certificate, State4), + State6 = tls_connection:queue_handshake(Certificate, State5), %% Create CertificateVerify CertificateVerify = Maybe(certificate_verify(CertPrivateKey, SignatureScheme, - State5, server)), + State6, server)), %% Encode CertificateVerify - State6 = tls_connection:queue_handshake(CertificateVerify, State5), + State7 = tls_connection:queue_handshake(CertificateVerify, State6), %% Create Finished - Finished = finished(State6), + Finished = finished(State7), %% Encode Finished - State7 = tls_connection:queue_handshake(Finished, State6), + State8 = tls_connection:queue_handshake(Finished, State7), %% Send first flight - {State8, _} = tls_connection:send_handshake_flight(State7), + {State9, _} = tls_connection:send_handshake_flight(State8), - State8 + {State9, NextState} catch - {Ref, {state_not_implemented, State}} -> - %% TODO - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) + {Ref, badarg} -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {digitally_sign, badarg}) end. -do_wait_finished(#change_cipher_spec{}, - #state{connection_states = _ConnectionStates0, - session = #session{session_id = _SessionId, - own_certificate = _OwnCert}, - ssl_options = #ssl_options{} = _SslOpts, - key_share = _KeyShare, - handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, - static_env = #static_env{ - cert_db = _CertDbHandle, - cert_db_ref = _CertDbRef, - socket = _Socket, - transport_cb = _Transport} - } = State0) -> - %% {Ref,Maybe} = maybe(), - +do_wait_cert(#certificate_1_3{} = Certificate, State0) -> + {Ref,Maybe} = maybe(), try + Maybe(process_client_certificate(Certificate, State0)) + catch + {Ref, {certificate_required, State}} -> + {?ALERT_REC(?FATAL, ?CERTIFICATE_REQUIRED, certificate_required), State}; + {Ref, {{certificate_unknown, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, Reason), State}; + {Ref, {{internal_error, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?INTERNAL_ERROR, Reason), State}; + {Ref, {{handshake_failure, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason), State}; + {#alert{} = Alert, State} -> + {Alert, State} + end. - State0 +do_wait_cv(#certificate_verify_1_3{} = CertificateVerify, State0) -> + {Ref,Maybe} = maybe(), + try + Maybe(verify_signature_algorithm(State0, CertificateVerify)), + Maybe(verify_certificate_verify(State0, CertificateVerify)) catch - {_Ref, {state_not_implemented, State}} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) - end; + {Ref, {{bad_certificate, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?BAD_CERTIFICATE, {bad_certificate, Reason}), State}; + {Ref, {badarg, State}} -> + {?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {verify, badarg}), State}; + {Ref, {{handshake_failure, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {handshake_failure, Reason}), State} + end. + + do_wait_finished(#finished{verify_data = VerifyData}, #state{connection_states = _ConnectionStates0, session = #session{session_id = _SessionId, @@ -607,16 +638,19 @@ do_wait_finished(#finished{verify_data = VerifyData}, catch {Ref, decrypt_error} -> - ?ALERT_REC(?FATAL, ?DECRYPT_ERROR, decrypt_error); - {_, {state_not_implemented, State}} -> - %% TODO - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) + ?ALERT_REC(?FATAL, ?DECRYPT_ERROR, decrypt_error) end. %% TODO: Remove this function! -%% not_implemented(State) -> -%% {error, {state_not_implemented, State}}. +%% not_implemented(State, Reason) -> +%% {error, {not_implemented, State, Reason}}. +%% +%% not_implemented(update_secrets, State0, Reason) -> +%% State1 = calculate_traffic_secrets(State0), +%% State = ssl_record:step_encryption_state(State1), +%% {error, {not_implemented, State, Reason}}. + %% Recipients of Finished messages MUST verify that the contents are @@ -659,6 +693,138 @@ send_hello_retry_request(State0, _, _, _) -> {ok, {State0, negotiated}}. +maybe_send_certificate_request(State, #ssl_options{verify = verify_none}) -> + {State, wait_finished}; +maybe_send_certificate_request(State, #ssl_options{ + verify = verify_peer, + signature_algs = SignAlgs, + signature_algs_cert = SignAlgsCert}) -> + CertificateRequest = certificate_request(SignAlgs, SignAlgsCert), + {tls_connection:queue_handshake(CertificateRequest, State), wait_cert}. + + +process_client_certificate(#certificate_1_3{ + certificate_request_context = <<>>, + certificate_list = []}, + #state{ssl_options = + #ssl_options{ + fail_if_no_peer_cert = false}} = State) -> + {ok, {State, wait_finished}}; +process_client_certificate(#certificate_1_3{ + certificate_request_context = <<>>, + certificate_list = []}, + #state{ssl_options = + #ssl_options{ + fail_if_no_peer_cert = true}} = State0) -> + + %% At this point the client believes that the connection is up and starts using + %% its traffic secrets. In order to be able send an proper Alert to the client + %% the server should also change its connection state and use the traffic + %% secrets. + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {certificate_required, State}}; +process_client_certificate(#certificate_1_3{certificate_list = Certs0}, + #state{ssl_options = + #ssl_options{signature_algs = SignAlgs, + signature_algs_cert = SignAlgsCert} = SslOptions, + static_env = + #static_env{ + role = Role, + host = Host, + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + crl_db = CRLDbHandle}} = State0) -> + %% TODO: handle extensions! + + %% Remove extensions from list of certificates! + Certs = convert_certificate_chain(Certs0), + case is_supported_signature_algorithm(Certs, SignAlgs, SignAlgsCert) of + true -> + case validate_certificate_chain(Certs, CertDbHandle, CertDbRef, + SslOptions, CRLDbHandle, Role, Host) of + {ok, {PeerCert, PublicKeyInfo}} -> + State = store_peer_cert(State0, PeerCert, PublicKeyInfo), + {ok, {State, wait_cv}}; + {error, Reason} -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {Reason, State}}; + #alert{} = Alert -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {Alert, State} + end; + false -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {{handshake_failure, + "Client certificate uses unsupported signature algorithm"}, State}} + end. + + +%% TODO: check whole chain! +is_supported_signature_algorithm(Certs, SignAlgs, undefined) -> + is_supported_signature_algorithm(Certs, SignAlgs); +is_supported_signature_algorithm(Certs, _, SignAlgsCert) -> + is_supported_signature_algorithm(Certs, SignAlgsCert). +%% +is_supported_signature_algorithm([BinCert|_], SignAlgs0) -> + #'OTPCertificate'{signatureAlgorithm = SignAlg} = + public_key:pkix_decode_cert(BinCert, otp), + SignAlgs = filter_tls13_algs(SignAlgs0), + Scheme = ssl_cipher:signature_algorithm_to_scheme(SignAlg), + lists:member(Scheme, SignAlgs). + + +validate_certificate_chain(Certs, CertDbHandle, CertDbRef, SslOptions, CRLDbHandle, Role, Host) -> + ServerName = ssl_handshake:server_name(SslOptions#ssl_options.server_name_indication, Host, Role), + [PeerCert | ChainCerts ] = Certs, + try + {TrustedCert, CertPath} = + ssl_certificate:trusted_cert_and_path(Certs, CertDbHandle, CertDbRef, + SslOptions#ssl_options.partial_chain), + ValidationFunAndState = + ssl_handshake:validation_fun_and_state(SslOptions#ssl_options.verify_fun, Role, + CertDbHandle, CertDbRef, ServerName, + SslOptions#ssl_options.customize_hostname_check, + SslOptions#ssl_options.crl_check, CRLDbHandle, CertPath), + Options = [{max_path_length, SslOptions#ssl_options.depth}, + {verify_fun, ValidationFunAndState}], + %% TODO: Validate if Certificate is using a supported signature algorithm + %% (signature_algs_cert)! + case public_key:pkix_path_validation(TrustedCert, CertPath, Options) of + {ok, {PublicKeyInfo,_}} -> + {ok, {PeerCert, PublicKeyInfo}}; + {error, Reason} -> + ssl_handshake:handle_path_validation_error(Reason, PeerCert, ChainCerts, + SslOptions, Options, + CertDbHandle, CertDbRef) + end + catch + error:{badmatch,{asn1, Asn1Reason}} -> + %% ASN-1 decode of certificate somehow failed + {error, {certificate_unknown, {failed_to_decode_certificate, Asn1Reason}}}; + error:OtherReason -> + {error, {internal_error, {unexpected_error, OtherReason}}} + end. + + +store_peer_cert(#state{session = Session, + handshake_env = HsEnv} = State, PeerCert, PublicKeyInfo) -> + State#state{session = Session#session{peer_certificate = PeerCert}, + handshake_env = HsEnv#handshake_env{public_key_info = PublicKeyInfo}}. + + +convert_certificate_chain(Certs) -> + Fun = fun(#certificate_entry{data = Data}) -> + {true, Data}; + (_) -> + false + end, + lists:filtermap(Fun, Certs). + + %% 4.4.1. The Transcript Hash %% %% As an exception to this general rule, when the server responds to a @@ -746,10 +912,8 @@ calculate_traffic_secrets(#state{connection_states = ConnectionStates, MasterSecret = tls_v1:key_schedule(master_secret, HKDFAlgo, HandshakeSecret), - {Messages0, _} = HHistory, - - %% Drop Client Finish - [_|Messages] = Messages0, + %% Get the correct list messages for the handshake context. + Messages = get_handshake_context(HHistory), %% Calculate [sender]_application_traffic_secret_0 ClientAppTrafficSecret0 = @@ -778,6 +942,11 @@ get_private_key(#key_share_entry{ {_, PrivateKey}}) -> PrivateKey. +%% TODO: implement EC keys +get_public_key({?'rsaEncryption', PublicKey, _}) -> + PublicKey. + + %% X25519, X448 calculate_shared_secret(OthersKey, MyKey, Group) when is_binary(OthersKey) andalso is_binary(MyKey) andalso @@ -822,7 +991,8 @@ update_connection_state(ConnectionState = #{security_parameters := SecurityParam update_start_state(#state{connection_states = ConnectionStates0, connection_env = CEnv, session = Session} = State, - Cipher, KeyShare, SessionId) -> + Cipher, KeyShare, SessionId, + Group, SelectedSignAlg, ClientPubKey) -> #{security_parameters := SecParamsR0} = PendingRead = maps:get(pending_read, ConnectionStates0), #{security_parameters := SecParamsW0} = PendingWrite = @@ -834,7 +1004,11 @@ update_start_state(#state{connection_states = ConnectionStates0, pending_write => PendingWrite#{security_parameters => SecParamsW}}, State#state{connection_states = ConnectionStates, key_share = KeyShare, - session = Session#session{session_id = SessionId}, + session = Session#session{session_id = SessionId, + ecc = Group, + sign_alg = SelectedSignAlg, + dh_public_value = ClientPubKey, + cipher_suite = Cipher}, connection_env = CEnv#connection_env{negotiated_version = {3,4}}}. @@ -845,6 +1019,126 @@ cipher_init(Key, IV, FinishedKey) -> tag_len = 16}. +%% Get handshake context for verification of CertificateVerify. +%% +%% Verify CertificateVerify: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% CertificateRequest (server) (13) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Certificate (client) (11) +%% CertificateVerify (client) (15) - Drop! Not included in calculations! +get_handshake_context_cv({[<<15,_/binary>>|Messages], _}) -> + Messages. + + +%% Get handshake context for traffic key calculation. +%% +%% Client is authenticated with certificate: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% CertificateRequest (server) (13) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Certificate (client) (11) - Drop! Not included in calculations! +%% CertificateVerify (client) (15) - Drop! Not included in calculations! +%% Finished (client) (20) - Drop! Not included in calculations! +%% +%% Client is authenticated but sends empty certificate: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% CertificateRequest (server) (13) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Certificate (client) (11) - Drop! Not included in calculations! +%% Finished (client) (20) - Drop! Not included in calculations! +%% +%% Client is not authenticated: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Finished (client) (20) - Drop! Not included in calculations! +%% +%% Drop all client messages from the front of the iolist using the property that +%% incoming messages are binaries. +get_handshake_context({Messages, _}) -> + get_handshake_context(Messages); +get_handshake_context([H|T]) when is_binary(H) -> + get_handshake_context(T); +get_handshake_context(L) -> + L. + + +%% If sent by a client, the signature algorithm used in the signature +%% MUST be one of those present in the supported_signature_algorithms +%% field of the "signature_algorithms" extension in the +%% CertificateRequest message. +verify_signature_algorithm(#state{ssl_options = + #ssl_options{ + signature_algs = ServerSignAlgs}} = State0, + #certificate_verify_1_3{algorithm = ClientSignAlg}) -> + case lists:member(ClientSignAlg, ServerSignAlgs) of + true -> + ok; + false -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {{handshake_failure, + "CertificateVerify uses unsupported signature algorithm"}, State}} + end. + + +verify_certificate_verify(#state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + public_key_info = PublicKeyInfo, + tls_handshake_history = HHistory}} = State0, + #certificate_verify_1_3{ + algorithm = SignatureScheme, + signature = Signature}) -> + #{security_parameters := SecParamsR} = + ssl_record:pending_connection_state(ConnectionStates, write), + #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR, + + {HashAlgo, _, _} = + ssl_cipher:scheme_to_components(SignatureScheme), + + Messages = get_handshake_context_cv(HHistory), + + Context = lists:reverse(Messages), + + %% Transcript-Hash uses the HKDF hash function defined by the cipher suite. + THash = tls_v1:transcript_hash(Context, HKDFAlgo), + + PublicKey = get_public_key(PublicKeyInfo), + + %% Digital signatures use the hash function defined by the selected signature + %% scheme. + case verify(THash, <<"TLS 1.3, client CertificateVerify">>, + HashAlgo, Signature, PublicKey) of + {ok, true} -> + {ok, {State0, wait_finished}}; + {ok, false} -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {{handshake_failure, "Failed to verify CertificateVerify"}, State}}; + {error, badarg} -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {badarg, State}} + end. + + %% 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 @@ -861,7 +1155,6 @@ select_common_groups(ServerGroups, ClientGroups) -> end. - %% RFC 8446 - 4.2.8. Key Share %% This vector MAY be empty if the client is requesting a %% HelloRetryRequest. Each KeyShareEntry value MUST correspond to a diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl index 05acc08392..97331e1510 100644 --- a/lib/ssl/src/tls_record_1_3.erl +++ b/lib/ssl/src/tls_record_1_3.erl @@ -124,6 +124,20 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, {decode_inner_plaintext(PlainFragment), ConnectionStates} end; + +%% RFC8446 - TLS 1.3 (OpenSSL compatibility) +%% Handle unencrypted Alerts from openssl s_client when server's +%% connection states are already stepped into traffic encryption. +%% (E.g. openssl s_client receives a CertificateRequest with +%% a signature_algorithms_cert extension that does not contain +%% the signature algorithm of the client's certificate.) +decode_cipher_text(#ssl_tls{type = ?ALERT, + version = ?LEGACY_VERSION, + fragment = <<2,47>>}, + ConnectionStates0) -> + {#ssl_tls{type = ?ALERT, + version = {3,4}, %% Internally use real version + fragment = <<2,47>>}, ConnectionStates0}; %% RFC8446 - TLS 1.3 %% D.4. Middlebox Compatibility Mode %% - If not offering early data, the client sends a dummy @@ -139,7 +153,6 @@ decode_cipher_text(#ssl_tls{type = ?CHANGE_CIPHER_SPEC, {#ssl_tls{type = ?CHANGE_CIPHER_SPEC, version = {3,4}, %% Internally use real version fragment = <<1>>}, ConnectionStates0}; - decode_cipher_text(#ssl_tls{type = Type, version = ?LEGACY_VERSION, fragment = CipherFragment}, diff --git a/lib/ssl/src/tls_socket.erl b/lib/ssl/src/tls_socket.erl index c3c41d3e12..6c32e6fa04 100644 --- a/lib/ssl/src/tls_socket.erl +++ b/lib/ssl/src/tls_socket.erl @@ -46,7 +46,7 @@ send(Transport, Socket, Data) -> Transport:send(Socket, Data). -listen(Transport, Port, #config{transport_info = {Transport, _, _, _}, +listen(Transport, Port, #config{transport_info = {Transport, _, _, _, _}, inet_user = Options, ssl = SslOpts, emulated = EmOpts} = Config) -> case Transport:listen(Port, Options ++ internal_inet_values()) of @@ -59,7 +59,7 @@ listen(Transport, Port, #config{transport_info = {Transport, _, _, _}, Err end. -accept(ListenSocket, #config{transport_info = {Transport,_,_,_} = CbInfo, +accept(ListenSocket, #config{transport_info = {Transport,_,_,_,_} = CbInfo, connection_cb = ConnectionCb, ssl = SslOpts, emulated = Tracker}, Timeout) -> @@ -80,7 +80,7 @@ accept(ListenSocket, #config{transport_info = {Transport,_,_,_} = CbInfo, {error, Reason} end. -upgrade(Socket, #config{transport_info = {Transport,_,_,_}= CbInfo, +upgrade(Socket, #config{transport_info = {Transport,_,_,_,_}= CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}, Timeout) -> ok = setopts(Transport, Socket, tls_socket:internal_inet_values()), @@ -98,7 +98,7 @@ connect(Address, Port, #config{transport_info = CbInfo, inet_user = UserOpts, ssl = SslOpts, emulated = EmOpts, inet_ssl = SocketOpts, connection_cb = ConnetionCb}, Timeout) -> - {Transport, _, _, _} = CbInfo, + {Transport, _, _, _, _} = CbInfo, try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> ssl_connection:connect(ConnetionCb, Address, Port, Socket, @@ -125,7 +125,7 @@ setopts(gen_tcp, Socket = #sslsocket{pid = {ListenSocket, #config{emulated = Tra ok = set_emulated_opts(Tracker, EmulatedOpts), check_active_n(EmulatedOpts, Socket), inet:setopts(ListenSocket, SockOpts); -setopts(_, Socket = #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}, +setopts(_, Socket = #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_,_}, emulated = Tracker}}}, Options) -> {SockOpts, EmulatedOpts} = split_options(Options), ok = set_emulated_opts(Tracker, EmulatedOpts), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 292916692d..cbc0c2e70b 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -281,7 +281,16 @@ tls13_test_group() -> tls13_1_RTT_handshake, tls13_basic_ssl_server_openssl_client, tls13_custom_groups_ssl_server_openssl_client, - tls13_hello_retry_request_ssl_server_openssl_client]. + tls13_hello_retry_request_ssl_server_openssl_client, + tls13_client_auth_empty_cert_alert_ssl_server_openssl_client, + tls13_client_auth_empty_cert_ssl_server_openssl_client, + tls13_client_auth_ssl_server_openssl_client, + tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client, + tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client, + tls13_hrr_client_auth_ssl_server_openssl_client, + tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client, + tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client, + tls13_connection_information]. %%-------------------------------------------------------------------- init_per_suite(Config0) -> @@ -4078,7 +4087,7 @@ tls_tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), StaticEnv = element(2, State), - Socket = element(10, StaticEnv), + Socket = element(11, StaticEnv), %% Fake tcp error Pid ! {tcp_error, Socket, etimedout}, @@ -5588,6 +5597,281 @@ tls13_hello_retry_request_ssl_server_openssl_client(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close_port(Client). +tls13_client_auth_empty_cert_alert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to true."}]. + +tls13_client_auth_empty_cert_alert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts = proplists:delete(keyfile, ClientOpts1), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, + {error, + {tls_alert, + {certificate_required, + "received SERVER ALERT: Fatal - Certificate required - certificate_required"}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + +tls13_client_auth_empty_cert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to false."}]. + +tls13_client_auth_empty_cert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts = proplists:delete(keyfile, ClientOpts1), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, false}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication."}]. + +tls13_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to true."}]. + +tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts2 = proplists:delete(keyfile, ClientOpts1), + ClientOpts = [{groups,"P-256:X25519"}|ClientOpts2], + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}, + {supported_groups, [x448, x25519]}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, + {error, + {tls_alert, + {certificate_required, + "received SERVER ALERT: Fatal - Certificate required - certificate_required"}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to false."}]. + +tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts2 = proplists:delete(keyfile, ClientOpts1), + ClientOpts = [{groups,"P-256:X25519"}|ClientOpts2], + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, false}, + {supported_groups, [x448, x25519]}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_hrr_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication."}]. + +tls13_hrr_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ClientOpts = [{groups,"P-256:X25519"}|ClientOpts0], + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}, + {supported_groups, [x448, x25519]}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication with unsupported signature_algorithm"}]. + +tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + %% Skip rsa_pkcs1_sha256! + {signature_algs, [rsa_pkcs1_sha384, rsa_pkcs1_sha512]}, + {fail_if_no_peer_cert, true}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result( + Server, + {error, + {tls_alert, + {insufficient_security, + "received SERVER ALERT: Fatal - Insufficient Security - " + "\"No suitable signature algorithm\""}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +%% Triggers Client Alert as openssl s_client does not have a certificate with a +%% signature algorithm supported by the server (signature_algorithms_cert extension +%% of CertificateRequest does not contain the algorithm of the client certificate). +tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication with unsupported signature_algorithm_cert"}]. + +tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {log_level, debug}, + {verify, verify_peer}, + {signature_algs, [rsa_pkcs1_sha256, rsa_pkcs1_sha384, rsa_pss_rsae_sha256]}, + %% Skip rsa_pkcs1_sha256! + {signature_algs_cert, [rsa_pkcs1_sha384, rsa_pkcs1_sha512]}, + {fail_if_no_peer_cert, true}|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, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result( + Server, + {error, + {tls_alert, + {illegal_parameter, + "received CLIENT ALERT: Fatal - Illegal Parameter"}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_connection_information() -> + [{doc,"Test the API function ssl:connection_information/1 in a TLS 1.3 connection"}]. + +tls13_connection_information(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, connection_information_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index f628b4e6d4..7f8e81dbd8 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1114,15 +1114,23 @@ start_basic_client(openssl, Version, Port, ClientOpts) -> Exe = "openssl", Args0 = ["s_client", "-verify", "2", "-port", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-cert", Cert, "-CAfile", CA, - "-key", Key, "-host","localhost", "-msg", "-debug"], - Args = + "-CAfile", CA, "-host", "localhost", "-msg", "-debug"], + Args1 = case Groups0 of undefined -> Args0; G -> Args0 ++ ["-groups", G] end, + Args = + case {Cert, Key} of + {C, K} when C =:= undefined orelse + K =:= undefined -> + Args1; + {C, K} -> + Args1 ++ ["-cert", C, "-key", K] + end, + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), true = port_command(OpenSslPort, "Hello world"), OpenSslPort. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 0d9f907d5c..c4bcc1560c 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.2 +SSL_VSN = 9.2.1 diff --git a/lib/stdlib/doc/src/beam_lib.xml b/lib/stdlib/doc/src/beam_lib.xml index 8bb4cf9101..bb44ca3201 100644 --- a/lib/stdlib/doc/src/beam_lib.xml +++ b/lib/stdlib/doc/src/beam_lib.xml @@ -470,6 +470,18 @@ CryptoKeyFun(clear) -> term()</code> </func> <func> + <name name="strip" arity="2" since=""/> + <fsummary>Remove chunks not needed by the loader from a BEAM file. + </fsummary> + <desc> + <p>Removes all chunks from a BEAM + file except those needed by the loader or passed in. In particular, + the debug information (chunk <c>debug_info</c> and <c>abstract_code</c>) + is removed.</p> + </desc> + </func> + + <func> <name name="strip_files" arity="1" since=""/> <fsummary>Removes chunks not needed by the loader from BEAM files. </fsummary> @@ -483,6 +495,19 @@ CryptoKeyFun(clear) -> term()</code> </func> <func> + <name name="strip_files" arity="2" since=""/> + <fsummary>Removes chunks not needed by the loader from BEAM files. + </fsummary> + <desc> + <p>Removes all chunks except + those needed by the loader or passed in from BEAM files. In particular, + the debug information (chunk <c>debug_info</c> and <c>abstract_code</c>) + is removed. The returned list contains one element for each + specified filename, in the same order as in <c>Files</c>.</p> + </desc> + </func> + + <func> <name name="strip_release" arity="1" since=""/> <fsummary>Remove chunks not needed by the loader from all BEAM files of a release.</fsummary> @@ -497,6 +522,20 @@ CryptoKeyFun(clear) -> term()</code> </func> <func> + <name name="strip_release" arity="2" since=""/> + <fsummary>Remove chunks not needed by the loader from all BEAM files of + a release.</fsummary> + <desc> + <p>Removes all chunks + except those needed by the loader or passed in from the BEAM files of a + release. <c><anno>Dir</anno></c> is to be the installation root + directory. For example, the current OTP release can be + stripped with the call + <c>beam_lib:strip_release(code:root_dir())</c>.</p> + </desc> + </func> + + <func> <name name="version" arity="1" since=""/> <fsummary>Read the module version of the BEAM file.</fsummary> <desc> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index c95f7637f7..86003c953d 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -155,8 +155,10 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native +else +ERL_COMPILE_FLAGS += -Werror endif -ERL_COMPILE_FLAGS += -I../include -I../../kernel/include -Werror +ERL_COMPILE_FLAGS += -I../include -I../../kernel/include # ---------------------------------------------------- # Targets diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl index 939b1fb488..1504326c61 100644 --- a/lib/stdlib/src/array.erl +++ b/lib/stdlib/src/array.erl @@ -126,11 +126,12 @@ %% per write than base 10, but the speedup is only 21%.) -define(DEFAULT, undefined). --define(LEAFSIZE, 10). % the "base" --define(NODESIZE, ?LEAFSIZE). % (no reason to have a different size) +-define(LEAFSIZE, 10). % the "base" (assumed to be > 1) +-define(NODESIZE, ?LEAFSIZE). % must not be LEAFSIZE-1; keep same as leaf -define(NODEPATTERN(S), {_,_,_,_,_,_,_,_,_,_,S}). % NODESIZE+1 elements! --define(NEW_NODE(S), % beware of argument duplication! - setelement((?NODESIZE+1),erlang:make_tuple((?NODESIZE+1),(S)),(S))). +-define(NEW_NODE(E,S), % general case (currently unused) + setelement((?NODESIZE+1),erlang:make_tuple((?NODESIZE+1),(E)),(S))). +-define(NEW_NODE(S), erlang:make_tuple((?NODESIZE+1),(S))). % when E = S -define(NEW_LEAF(D), erlang:make_tuple(?LEAFSIZE,(D))). -define(NODELEAFS, ?NODESIZE*?LEAFSIZE). @@ -605,7 +606,7 @@ grow(I, E, M) -> grow_1(I, E, M). grow_1(I, E, M) when I >= M -> - grow(I, setelement(1, ?NEW_NODE(M), E), ?extend(M)); + grow_1(I, setelement(1, ?NEW_NODE(M), E), ?extend(M)); grow_1(_I, E, M) -> {E, M}. @@ -1631,12 +1632,11 @@ foldl_test_() -> ?_assert(foldl(Sum, 0, from_list(lists:seq(0,10))) =:= 55), ?_assert(foldl(Reverse, [], from_list(lists:seq(0,1000))) =:= lists:reverse(lists:seq(0,1000))), - ?_assert({999,[N0*100+1+2,N0*2+1+1,0]} =:= - foldl(Vals, {0,[]}, + ?_assertEqual({N0*100+1-2,[N0*100+1+2,N0*2+1+1,0]}, + foldl(Vals, {0,[]}, set(N0*100+1,2, set(N0*2+1,1, set(0,0,new()))))) - ]. -endif. @@ -1786,12 +1786,11 @@ foldr_test_() -> ?_assert(foldr(Sum, 0, from_list(lists:seq(0,10))) =:= 55), ?_assert(foldr(List, [], from_list(lists:seq(0,1000))) =:= lists:seq(0,1000)), - ?_assert({999,[0,N0*2+1+1,N0*100+1+2]} =:= - foldr(Vals, {0,[]}, + ?_assertEqual({N0*100+1-2,[0,N0*2+1+1,N0*100+1+2]}, + foldr(Vals, {0,[]}, set(N0*100+1,2, set(N0*2+1,1, set(0,0,new()))))) - ]. -endif. diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 3386cfcbe6..aa992f17ab 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -32,8 +32,12 @@ all_chunks/1, diff_dirs/2, strip/1, + strip/2, strip_files/1, + strip_files/2, strip_release/1, + strip_release/2, + significant_chunks/0, build_module/1, version/1, md5/1, @@ -188,7 +192,16 @@ diff_dirs(Dir1, Dir2) -> Beam2 :: beam(). strip(FileName) -> - try strip_file(FileName) + strip(FileName, []). + +-spec strip(Beam1, AdditionalChunks) -> + {'ok', {module(), Beam2}} | {'error', 'beam_lib', info_rsn()} when + Beam1 :: beam(), + AdditionalChunks :: [chunkid()], + Beam2 :: beam(). + +strip(FileName, AdditionalChunks) -> + try strip_file(FileName, AdditionalChunks) catch Error -> Error end. -spec strip_files(Files) -> @@ -196,8 +209,17 @@ strip(FileName) -> Files :: [beam()], Beam :: beam(). -strip_files(Files) when is_list(Files) -> - try strip_fils(Files) +strip_files(Files) -> + strip_files(Files, []). + +-spec strip_files(Files, AdditionalChunks) -> + {'ok', [{module(), Beam}]} | {'error', 'beam_lib', info_rsn()} when + Files :: [beam()], + AdditionalChunks :: [chunkid()], + Beam :: beam(). + +strip_files(Files, AdditionalChunks) when is_list(Files) -> + try strip_fils(Files, AdditionalChunks) catch Error -> Error end. -spec strip_release(Dir) -> @@ -207,7 +229,17 @@ strip_files(Files) when is_list(Files) -> Reason :: {'not_a_directory', term()} | info_rsn(). strip_release(Root) -> - catch strip_rel(Root). + strip_release(Root, []). + +-spec strip_release(Dir, AdditionalChunks) -> + {'ok', [{module(), file:filename()}]} + | {'error', 'beam_lib', Reason} when + Dir :: atom() | file:filename(), + AdditionalChunks :: [chunkid()], + Reason :: {'not_a_directory', term()} | info_rsn(). + +strip_release(Root, AdditionalChunks) -> + catch strip_rel(Root, AdditionalChunks). -spec version(Beam) -> {'ok', {module(), [Version :: term()]}} | @@ -401,17 +433,17 @@ cmp_lists([{Id, C1} | R1], [{Id, C2} | R2]) -> cmp_lists(_, _) -> error(different_chunks). -strip_rel(Root) -> +strip_rel(Root, AdditionalChunks) -> ok = assert_directory(Root), - strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam"))). + strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam")), AdditionalChunks). %% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) -strip_fils(Files) -> - {ok, [begin {ok, Reply} = strip_file(F), Reply end || F <- Files]}. +strip_fils(Files, AdditionalChunks) -> + {ok, [begin {ok, Reply} = strip_file(F, AdditionalChunks), Reply end || F <- Files]}. %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) -strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), +strip_file(File, AdditionalChunks) -> + {ok, {Mod, Chunks}} = read_significant_chunks(File, AdditionalChunks ++ significant_chunks()), {ok, Stripped0} = build_module(Chunks), Stripped = compress(Stripped0), case File of diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 2939e78d9d..1f8bdc5432 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. 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. @@ -1247,18 +1247,20 @@ split_1(Bin, [_C|_]=Needle, Start, Where, Curr0, Acc) -> end end. -lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps, Ts) when is_integer(CP) -> +lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps0, Ts) when is_integer(CP) -> case lists:member(CP, CPs) of true -> [GC|Cs2] = unicode_util:gc(Cs0), case lists:member(GC, GCs) of true -> - lexemes_m(Cs2, Seps, Ts); + lexemes_m(Cs2, Seps0, Ts); false -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), lexemes_m(Rest, Seps, [Lexeme|Ts]) end; false -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), lexemes_m(Rest, Seps, [Lexeme|Ts]) end; diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 6418dc7eb6..4b2694320e 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -35,7 +35,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - normal/1, error/1, cmp/1, cmp_literals/1, strip/1, otp_6711/1, + normal/1, error/1, cmp/1, cmp_literals/1, strip/1, strip_add_chunks/1, otp_6711/1, building/1, md5/1, encrypted_abstr/1, encrypted_abstr_file/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -45,7 +45,7 @@ suite() -> {timetrap,{minutes,2}}]. all() -> - [error, normal, cmp, cmp_literals, strip, otp_6711, + [error, normal, cmp, cmp_literals, strip, strip_add_chunks, otp_6711, building, md5, encrypted_abstr, encrypted_abstr_file]. groups() -> @@ -401,6 +401,69 @@ strip(Conf) when is_list(Conf) -> Source5D1, BeamFile5D1]), ok. +strip_add_chunks(Conf) when is_list(Conf) -> + PrivDir = ?privdir, + {SourceD1, BeamFileD1} = make_beam(PrivDir, simple, member), + {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat), + {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun), + {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant), + {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines), + + NoOfTables = erlang:system_info(ets_count), + P0 = pps(), + + %% strip binary + verify(not_a_beam_file, beam_lib:strip(<<>>)), + {ok, B1} = file:read_file(BeamFileD1), + {ok, {simple, NB1}} = beam_lib:strip(B1), + + BId1 = chunk_ids(B1), + NBId1 = chunk_ids(NB1), + true = length(BId1) > length(NBId1), + compare_chunks(B1, NB1, NBId1), + + %% Keep all the extra chunks + ExtraChunks = ["Abst" , "Dbgi" , "Attr" , "CInf" , "LocT" , "Atom" ], + {ok, {simple, AB1}} = beam_lib:strip(B1, ExtraChunks), + ABId1 = chunk_ids(AB1), + true = length(BId1) == length(ABId1), + compare_chunks(B1, AB1, ABId1), + + %% strip file - Keep extra chunks + verify(file_error, beam_lib:strip(foo)), + {ok, {simple, _}} = beam_lib:strip(BeamFileD1, ExtraChunks), + compare_chunks(B1, BeamFileD1, ABId1), + + %% strip_files + {ok, B2} = file:read_file(BeamFile2D1), + {ok, [{simple,_},{simple2,_}]} = beam_lib:strip_files([B1, B2], ExtraChunks), + {ok, [{simple,_},{simple2,_},{make_fun,_},{constant,_}]} = + beam_lib:strip_files([BeamFileD1, BeamFile2D1, BeamFile3D1, BeamFile4D1], ExtraChunks), + + %% check that each module can be loaded. + {module, simple} = code:load_abs(filename:rootname(BeamFileD1)), + {module, simple2} = code:load_abs(filename:rootname(BeamFile2D1)), + {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)), + {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)), + + %% check that line number information is still present after stripping + {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = (catch lines:t(atom)), + false = code:purge(lines), + true = code:delete(lines), + {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1), + {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = (catch lines:t(atom)), + + true = (P0 == pps()), + NoOfTables = erlang:system_info(ets_count), + + delete_files([SourceD1, BeamFileD1, + Source2D1, BeamFile2D1, + Source3D1, BeamFile3D1, + Source4D1, BeamFile4D1, + Source5D1, BeamFile5D1]), + ok. otp_6711(Conf) when is_list(Conf) -> {'EXIT',{function_clause,_}} = (catch {a, beam_lib:info(3)}), @@ -729,6 +792,7 @@ make_beam(Dir, Module, F) -> FileBase = filename:join(Dir, atom_to_list(Module)), Source = FileBase ++ ".erl", BeamFile = FileBase ++ ".beam", + file:delete(BeamFile), simple_file(Source, Module, F), {ok, _} = compile:file(Source, [{outdir,Dir}, debug_info, report]), {Source, BeamFile}. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 8561491d50..87ca9bd32c 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -70,7 +70,10 @@ -export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, smp_ordered_iteration/1, smp_select_replace/1, otp_8166/1, otp_8732/1, delete_unfix_race/1]). --export([throughput_benchmark/0, test_throughput_benchmark/1]). +-export([throughput_benchmark/0, + throughput_benchmark/1, + test_throughput_benchmark/1, + long_throughput_benchmark/1]). -export([exit_large_table_owner/1, exit_many_large_table_owner/1, exit_many_tables_owner/1, @@ -93,6 +96,7 @@ -include_lib("stdlib/include/ms_transform.hrl"). % ets:fun2ms -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). -define(m(A,B), assert_eq(A,B)). -define(heap_binary_size, 64). @@ -151,7 +155,8 @@ all() -> take, whereis_table, delete_unfix_race, - test_throughput_benchmark]. + test_throughput_benchmark, + {group, benchmark}]. groups() -> [{new, [], @@ -179,7 +184,9 @@ groups() -> {meta_smp, [], [meta_lookup_unnamed_read, meta_lookup_unnamed_write, meta_lookup_named_read, meta_lookup_named_write, - meta_newdel_unnamed, meta_newdel_named]}]. + meta_newdel_unnamed, meta_newdel_named]}, + {benchmark, [], + [long_throughput_benchmark]}]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -192,9 +199,61 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false), ok. +init_per_group(benchmark, Config) -> + P = self(), + %% Spawn owner of ETS table that is alive until end_per_group is run + EtsProcess = + spawn( + fun()-> + Tab = ets:new(ets_benchmark_result_summary_tab, [public]), + P ! {the_table, Tab}, + receive + kill -> ok + end + end), + Tab = receive {the_table, T} -> T end, + CounterNames = [nr_of_benchmarks, + total_throughput, + nr_of_set_benchmarks, + total_throughput_set, + nr_of_ordered_set_benchmarks, + total_throughput_ordered_set], + lists:foreach(fun(CtrName) -> + ets:insert(Tab, {CtrName, 0.0}) + end, + CounterNames), + [{ets_benchmark_result_summary_tab, Tab}, + {ets_benchmark_result_summary_tab_process, EtsProcess} | Config]; init_per_group(_GroupName, Config) -> Config. +end_per_group(benchmark, Config) -> + T = proplists:get_value(ets_benchmark_result_summary_tab, Config), + EtsProcess = proplists:get_value(ets_benchmark_result_summary_tab_process, Config), + Report = + fun(NOfBenchmarksCtr, TotThroughoutCtr, Name) -> + Average = + ets:lookup_element(T, TotThroughoutCtr, 2) / + ets:lookup_element(T, NOfBenchmarksCtr, 2), + io:format("~p ~p~n", [Name, Average]), + ct_event:notify( + #event{name = benchmark_data, + data = [{suite,"ets_bench"}, + {name, Name}, + {value, Average}]}) + end, + Report(nr_of_benchmarks, + total_throughput, + "Average Throughput"), + Report(nr_of_set_benchmarks, + total_throughput_set, + "Average Throughput Set"), + Report(nr_of_ordered_set_benchmarks, + total_throughput_ordered_set, + "Average Throughput Ordered Set"), + ets:delete(T), + EtsProcess ! kill, + Config; end_per_group(_GroupName, Config) -> Config. @@ -6530,8 +6589,8 @@ whereis_table(Config) when is_list(Config) -> ok. -%% The following work functions are used by -%% throughput_benchmark/4. They are declared on the top level beacuse +%% The following help functions are used by +%% throughput_benchmark. They are declared on the top level beacuse %% declaring them as function local funs cause a scalability issue. get_op([{_,O}], _RandNum) -> O; @@ -6566,10 +6625,131 @@ prefill_table_loop(T, RS0, N, ObjFun) -> ets:insert(T, ObjFun(Key)), prefill_table_loop(T, RS1, N-1, ObjFun). -throughput_benchmark() -> - throughput_benchmark(false, not_set, not_set). +-record(ets_throughput_bench_config, + {benchmark_duration_ms = 3000, + recover_time_ms = 1000, + thread_counts = not_set, + key_ranges = [1000000], + scenarios = + [ + [ + {0.5, insert}, + {0.5, delete} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.8, lookup} + ], + [ + {0.01, insert}, + {0.01, delete}, + {0.98, lookup} + ], + [ + {1.0, lookup} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq10} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq100} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq1000} + ], + [ + {1.0, nextseq1000} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.7999, lookup}, + {0.0001, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.799999, lookup}, + {0.000001, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, partial_select1000} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.7999, lookup}, + {0.0001, partial_select1000} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.799999, lookup}, + {0.000001, partial_select1000} + ] + ], + table_types = + [ + [ordered_set, public], + [ordered_set, public, {write_concurrency, true}], + [ordered_set, public, {read_concurrency, true}], + [ordered_set, public, {write_concurrency, true}, {read_concurrency, true}], + [set, public], + [set, public, {write_concurrency, true}], + [set, public, {read_concurrency, true}], + [set, public, {write_concurrency, true}, {read_concurrency, true}] + ], + etsmem_fun = fun() -> ok end, + verify_etsmem_fun = fun(_) -> true end, + notify_res_fun = fun(_Name, _Throughput) -> ok end, + print_result_paths_fun = + fun(ResultPath, _LatestResultPath) -> + Comment = + io_lib:format("<a href=\"file:///~s\">Result visualization</a>",[ResultPath]), + {comment, Comment} + end + }). + +stdout_notify_res(ResultPath, LatestResultPath) -> + io:format("Result Location: /~s~n", [ResultPath]), + io:format("Latest Result Location: ~s~n", [LatestResultPath]). -throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> +throughput_benchmark() -> + throughput_benchmark( + #ets_throughput_bench_config{ + print_result_paths_fun = fun stdout_notify_res/2}). + +throughput_benchmark( + #ets_throughput_bench_config{ + benchmark_duration_ms = BenchmarkDurationMs, + recover_time_ms = RecoverTimeMs, + thread_counts = ThreadCountsOpt, + key_ranges = KeyRanges, + scenarios = Scenarios, + table_types = TableTypes, + etsmem_fun = ETSMemFun, + verify_etsmem_fun = VerifyETSMemFun, + notify_res_fun = NotifyResFun, + print_result_paths_fun = PrintResultPathsFun}) -> NrOfSchedulers = erlang:system_info(schedulers), %% Definitions of operations that are supported by the benchmark NextSeqOp = @@ -6634,7 +6814,7 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> fun(T,KeyRange) -> NextSeqOp(T,KeyRange,1000) end, selectAll => fun(T,_KeyRange) -> - case -1 =:= ets:select_count(T, ets:fun2ms(fun(X) -> true end)) of + case -1 =:= ets:select_count(T, ets:fun2ms(fun(_X) -> true end)) of true -> io:format("Will never be printed"); false -> ok end @@ -6683,11 +6863,28 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> false -> ok end end, + DataHolder = + fun DataHolderFun(Data)-> + receive + {get_data, Pid} -> Pid ! {ets_bench_data, Data}; + D -> DataHolderFun([Data,D]) + end + end, + DataHolderPid = spawn_link(fun()-> DataHolder([]) end), + PrintData = + fun (Str, List) -> + io:format(Str, List), + DataHolderPid ! io_lib:format(Str, List) + end, + GetData = + fun () -> + DataHolderPid ! {get_data, self()}, + receive {ets_bench_data, Data} -> Data end + end, %% Function that runs a benchmark instance and returns the number %% of operations that were performed RunBenchmark = - fun(NrOfProcs, TableConfig, Scenario, - Range, Duration, RecoverTime) -> + fun({NrOfProcs, TableConfig, Scenario, Range, Duration}) -> ProbHelpTab = CalculateOpsProbHelpTab(Scenario, 0), Table = ets:new(t, TableConfig), Nobj = Range div 2, @@ -6695,16 +6892,15 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> Nobj = ets:info(Table, size), SafeFixTableIfRequired(Table, Scenario, true), ParentPid = self(), + Worker = + fun() -> + receive start -> ok end, + WorksDone = + do_work(0, Table, ProbHelpTab, Range, Operations), + ParentPid ! WorksDone + end, ChildPids = - lists:map( - fun(_N) -> - spawn(fun() -> - receive start -> ok end, - WorksDone = - do_work(0, Table, ProbHelpTab, Range, Operations), - ParentPid ! WorksDone - end) - end, lists:seq(1, NrOfProcs)), + lists:map(fun(_N) ->spawn_link(Worker)end, lists:seq(1, NrOfProcs)), lists:foreach(fun(Pid) -> Pid ! start end, ChildPids), timer:sleep(Duration), lists:foreach(fun(Pid) -> Pid ! stop end, ChildPids), @@ -6716,185 +6912,194 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> end, 0, ChildPids), SafeFixTableIfRequired(Table, Scenario, false), ets:delete(Table), - timer:sleep(RecoverTime), TotalWorksDone end, - %% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% Benchmark Configuration %%%%%%%%%%%%%%%%%%%%%%%% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% - %% Change the following variables to configure the benchmark runs - ThreadCounts = - case TestMode of - true -> [1, NrOfSchedulers]; - false -> CalculateThreadCounts([1]) - end, - KeyRanges = % Sizes of the key ranges - case TestMode of - true -> [50000]; - false -> [1000000] + RunBenchmarkInSepProcess = + fun(ParameterTuple) -> + P = self(), + spawn_link(fun()-> P ! {bench_result, RunBenchmark(ParameterTuple)} end), + Result = receive {bench_result, Res} -> Res end, + timer:sleep(RecoverTimeMs), + Result end, - Duration = - case BenchmarkRunMs of % Duration of a benchmark run in milliseconds - not_set -> 30000; - _ -> BenchmarkRunMs + RunBenchmarkAndReport = + fun(ThreadCount, + TableType, + Scenario, + KeyRange, + Duration) -> + Result = RunBenchmarkInSepProcess({ThreadCount, + TableType, + Scenario, + KeyRange, + Duration}), + Throughput = Result/(Duration/1000.0), + PrintData("; ~f",[Throughput]), + Name = io_lib:format("Scenario: ~w, Key Range Size: ~w, " + "# of Processes: ~w, Table Type: ~w", + [Scenario, KeyRange, ThreadCount, TableType]), + NotifyResFun(Name, Throughput) end, - TimeMsToSleepAfterEachBenchmarkRun = - case RecoverTimeMs of - not_set -> 1000; - _ -> RecoverTimeMs + ThreadCounts = + case ThreadCountsOpt of + not_set -> + CalculateThreadCounts([1]); + _ -> ThreadCountsOpt end, - TableTypes = % The table types that will be benchmarked - [ - [ordered_set, public], - [ordered_set, public, {write_concurrency, true}], - [ordered_set, public, {read_concurrency, true}], - [ordered_set, public, {write_concurrency, true}, {read_concurrency, true}], - [set, public], - [set, public, {write_concurrency, true}], - [set, public, {read_concurrency, true}], - [set, public, {write_concurrency, true}, {read_concurrency, true}] - ], - Scenarios = % Benchmark scenarios (the fractions should add up to approximately 1.0) - [ - [ - {0.5, insert}, - {0.5, delete} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.8, lookup} - ], - [ - {0.01, insert}, - {0.01, delete}, - {0.98, lookup} - ], - [ - {1.0, lookup} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.4, lookup}, - {0.4, nextseq10} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.4, lookup}, - {0.4, nextseq100} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.4, lookup}, - {0.4, nextseq1000} - ], - [ - {1.0, nextseq1000} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.79, lookup}, - {0.01, selectAll} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.7999, lookup}, - {0.0001, selectAll} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.799999, lookup}, - {0.000001, selectAll} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.79, lookup}, - {0.01, partial_select1000} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.7999, lookup}, - {0.0001, partial_select1000} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.799999, lookup}, - {0.000001, partial_select1000} - ] - ], - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% End of Benchmark Configuration %%%%%%%%%%%%%%%% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Prepare for memory check - EtsMem = case TestMode of - true -> etsmem(); - false -> ok - end, %% Run the benchmark - io:format("# Each instance of the benchmark runs for ~w seconds:~n", [Duration/1000]), - io:format("# The result of a benchmark instance is presented as a number representing~n"), - io:format("# the number of operations performed per second:~n~n~n"), - io:format("# To plot graphs for the results below:~n"), - io:format("# 1. Open \"$ERL_TOP/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html\" in a web browser~n"), - io:format("# 2. Copy the lines between \"#BENCHMARK STARTED$\" and \"#BENCHMARK ENDED$\" below~n"), - io:format("# 3. Paste the lines copied in step 2 to the text box in the browser window opened in~n"), - io:format("# step 1 and press the Render button~n~n"), - io:format("#BENCHMARK STARTED$~n"), + PrintData("# Each instance of the benchmark runs for ~w seconds:~n", [BenchmarkDurationMs/1000]), + PrintData("# The result of a benchmark instance is presented as a number representing~n",[]), + PrintData("# the number of operations performed per second:~n~n~n",[]), + PrintData("# To plot graphs for the results below:~n",[]), + PrintData("# 1. Open \"$ERL_TOP/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html\" in a web browser~n",[]), + PrintData("# 2. Copy the lines between \"#BENCHMARK STARTED$\" and \"#BENCHMARK ENDED$\" below~n",[]), + PrintData("# 3. Paste the lines copied in step 2 to the text box in the browser window opened in~n",[]), + PrintData("# step 1 and press the Render button~n~n",[]), + PrintData("#BENCHMARK STARTED$~n",[]), + EtsMem = ETSMemFun(), %% The following loop runs all benchmark scenarios and prints the results (i.e, operations/second) lists:foreach( fun(KeyRange) -> lists:foreach( fun(Scenario) -> - io:format("Scenario: ~s | Key Range Size: ~w$~n", - [RenderScenario(Scenario, ""), - KeyRange]), + PrintData("Scenario: ~s | Key Range Size: ~w$~n", + [RenderScenario(Scenario, ""), KeyRange]), lists:foreach( fun(ThreadCount) -> - io:format("; ~w",[ThreadCount]) + PrintData("; ~w",[ThreadCount]) end, ThreadCounts), - io:format("$~n",[]), + PrintData("$~n",[]), lists:foreach( fun(TableType) -> - io:format("~w ",[TableType]), + PrintData("~w ",[TableType]), lists:foreach( fun(ThreadCount) -> - Result = RunBenchmark(ThreadCount, + RunBenchmarkAndReport(ThreadCount, TableType, Scenario, KeyRange, - Duration, - TimeMsToSleepAfterEachBenchmarkRun), - io:format("; ~f",[Result/(Duration/1000.0)]) + BenchmarkDurationMs) end, ThreadCounts), - io:format("$~n",[]) + PrintData("$~n",[]) end, TableTypes) end, Scenarios) end, KeyRanges), - io:format("~n#BENCHMARK ENDED$~n~n"), - case TestMode of - true -> verify_etsmem(EtsMem); - false -> ok - end. + PrintData("~n#BENCHMARK ENDED$~n~n",[]), + VerifyETSMemFun(EtsMem), + DataDir = filename:join(filename:dirname(code:which(?MODULE)), "ets_SUITE_data"), + TemplatePath = filename:join(DataDir, "visualize_throughput.html"), + {ok, Template} = file:read_file(TemplatePath), + OutputData = string:replace(Template, "#bench_data_placeholder", GetData()), + OutputPath1 = filename:join(DataDir, "ets_bench_result.html"), + {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_datetime(erlang:timestamp()), + StrTime = lists:flatten(io_lib:format("~4..0w-~2..0w-~2..0wT~2..0w:~2..0w:~2..0w",[Year,Month,Day,Hour,Minute,Second])), + OutputPath2 = filename:join(DataDir, io_lib:format("ets_bench_result_~s.html", [StrTime])), + file:write_file(OutputPath1, OutputData), + file:write_file(OutputPath2, OutputData), + PrintResultPathsFun(OutputPath2, OutputPath1). test_throughput_benchmark(Config) when is_list(Config) -> - throughput_benchmark(true, 100, 0). - + throughput_benchmark( + #ets_throughput_bench_config{ + benchmark_duration_ms = 100, + recover_time_ms = 0, + thread_counts = [1, erlang:system_info(schedulers)], + key_ranges = [50000], + etsmem_fun = fun etsmem/0, + verify_etsmem_fun = fun verify_etsmem/1}). + +long_throughput_benchmark(Config) when is_list(Config) -> + N = erlang:system_info(schedulers), + throughput_benchmark( + #ets_throughput_bench_config{ + benchmark_duration_ms = 3000, + recover_time_ms = 1000, + thread_counts = [1, N div 2, N], + key_ranges = [1000000], + scenarios = + [ + [ + {0.5, insert}, + {0.5, delete} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.8, lookup} + ], + [ + {0.01, insert}, + {0.01, delete}, + {0.98, lookup} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq100} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, partial_select1000} + ] + ], + table_types = + [ + [ordered_set, public, {write_concurrency, true}, {read_concurrency, true}], + [set, public, {write_concurrency, true}, {read_concurrency, true}] + ], + etsmem_fun = fun etsmem/0, + verify_etsmem_fun = fun verify_etsmem/1, + notify_res_fun = + fun(Name, Throughput) -> + SummaryTable = + proplists:get_value(ets_benchmark_result_summary_tab, Config), + AddToSummaryCounter = + case SummaryTable of + undefined -> + fun(_, _) -> + ok + end; + Tab -> + fun(CounterName, ToAdd) -> + OldVal = ets:lookup_element(Tab, CounterName, 2), + NewVal = OldVal + ToAdd, + ets:insert(Tab, {CounterName, NewVal}) + end + end, + Record = + fun(NoOfBenchsCtr, TotThrputCtr) -> + AddToSummaryCounter(NoOfBenchsCtr, 1), + AddToSummaryCounter(TotThrputCtr, Throughput) + end, + Record(nr_of_benchmarks, total_throughput), + case string:find(Name, "ordered_set") of + nomatch -> + Record(nr_of_set_benchmarks, total_throughput_set); + _ -> + Record(nr_of_ordered_set_benchmarks, + total_throughput_ordered_set) + end, + ct_event:notify( + #event{name = benchmark_data, + data = [{suite,"ets_bench"}, + {name, Name}, + {value,Throughput}]}) + end + }). add_lists(L1,L2) -> add_lists(L1,L2,[]). diff --git a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html index a2c61aa938..27d6849c60 100644 --- a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html +++ b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html @@ -42,7 +42,7 @@ </p> Paste the generated data in the field below and press the Render button: <br> - <textarea id="dataField" rows="4" cols="50"></textarea> + <textarea id="dataField" rows="4" cols="50">#bench_data_placeholder</textarea> <br> <input type="checkbox" id="barPlot"> Bar Plot <br> @@ -56,13 +56,13 @@ <br> <input type="checkbox" class="showCheck" value="[ordered_set,public,{write_concurrency,true},{read_concurrency,true}]" checked> Show <code>[ordered_set,public,{write_concurrency,true},{read_concurrency,true}]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public]"> Show <code>[set,public]</code> + <input type="checkbox" class="showCheck" value="[set,public]" checked> Show <code>[set,public]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true}]"> Show <code>[set,public,{write_concurrency,true}]</code> + <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true}]" checked> Show <code>[set,public,{write_concurrency,true}]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public,{read_concurrency,true}]"> Show <code>[set,public,{read_concurrency,true}]</code> + <input type="checkbox" class="showCheck" value="[set,public,{read_concurrency,true}]" checked> Show <code>[set,public,{read_concurrency,true}]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true},{read_concurrency,true}]"> Show <code>[set,public,{write_concurrency,true},{read_concurrency,true}]</code> + <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true},{read_concurrency,true}]" checked> Show <code>[set,public,{write_concurrency,true},{read_concurrency,true}]</code> <br> <button id="renderButton" type="button">Render</button> diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec index 4de7c1a0eb..bf64eae2c7 100644 --- a/lib/stdlib/test/stdlib.spec +++ b/lib/stdlib/test/stdlib.spec @@ -2,3 +2,6 @@ {skip_groups,"../stdlib_test",stdlib_bench_SUITE, [binary,base64,gen_server,gen_statem,unicode], "Benchmark only"}. +{skip_groups,"../stdlib_test",ets_SUITE, + [benchmark], + "Benchmark only"}. diff --git a/lib/stdlib/test/stdlib_bench.spec b/lib/stdlib/test/stdlib_bench.spec index 7a0da811a0..6d665f22b6 100644 --- a/lib/stdlib/test/stdlib_bench.spec +++ b/lib/stdlib/test/stdlib_bench.spec @@ -8,3 +8,4 @@ {skip_groups,"../stdlib_test",stdlib_bench_SUITE, [gen_server_comparison,gen_statem_comparison], "Not a benchmark"}. +{groups,"../stdlib_test",ets_SUITE,[benchmark]}. diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 251e09121c..6afe9e7a76 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. 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. @@ -52,7 +52,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,1}}]. + {timetrap,{minutes,2}}]. all() -> [{group, chardata}, {group, list_string}]. @@ -737,10 +737,10 @@ meas(Config) -> case ct:get_timetrap_info() of {_,{_,Scale}} when Scale > 1 -> {skip,{will_not_run_in_debug,Scale}}; - _ -> % No scaling, run at most 1.5 min + _ -> % No scaling, run at most 2 mins Tester = spawn(Exec), receive {test_done, Tester} -> ok - after 90000 -> + after 120000 -> io:format("Timelimit reached stopping~n",[]), exit(Tester, die) end, @@ -754,19 +754,22 @@ do_measure(DataDir) -> io:format("~p~n",[byte_size(Bin)]), Do = fun(Name, Func, Mode) -> {N, Mean, Stddev, _} = time_func(Func, Mode, Bin, 20), - io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + io:format("~15w ~15w ~8.2fms ±~6.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, Do2 = fun(Name, Func, Mode) -> {N, Mean, Stddev, _} = time_func(Func, binary, <<>>, 20), - io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + io:format("~15w ~15w ~8.2fms ±~6.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, + %% lefty_list means a list balanced to the left, like + %% [[[30],31],32]. Only some functions check such lists. + Modes = [list, lefty_list, binary, {many_lists,1}, {many_lists, 4}], io:format("----------------------~n"), Do(old_tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list), Tokens = {lexemes, fun(Str) -> string:lexemes(Str, [$\n,$\r]) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- Modes], S0 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....", S0B = <<"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....">>, @@ -824,17 +827,17 @@ do_measure(DataDir) -> io:format("--~n",[]), NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- Modes], Do2(take_t, repeat(fun() -> string:take(S0, [$.,$y], false, trailing) end), list), Do2(take_t, repeat(fun() -> string:take(S0B, [$.,$y], false, trailing) end), binary), Do2(take_tc, repeat(fun() -> string:take(S0, [$x], true, trailing) end), list), Do2(take_tc, repeat(fun() -> string:take(S0B, [$x], true, trailing) end), binary), Length = {length, fun(Str) -> string:length(Str) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- Modes], Reverse = {reverse, fun(Str) -> string:reverse(Str) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- Modes], ok. @@ -1064,7 +1067,33 @@ time_func(N,Sum,SumSq, _, _, Res, _) -> {N, Mean, Stdev, Res}. mode(binary, Bin) -> Bin; -mode(list, Bin) -> unicode:characters_to_list(Bin). +mode(list, Bin) -> unicode:characters_to_list(Bin); +mode(lefty_list, Bin) -> + L = unicode:characters_to_list(Bin), + to_left(L); +mode({many_lists, N}, Bin) -> + group(unicode:characters_to_list(Bin), N). + +group([], _N) -> + []; +group(L, N) -> + try lists:split(N, L) of + {L1, L2} -> + [L1 | group(L2, N)] + catch + _:_ -> + [L] + end. + +to_left([]) -> + []; +to_left([H|L]) -> + to_left([H], L). + +to_left(V, []) -> + V; +to_left(V, [H|L]) -> + to_left([V,H], L). %% %% Old string lists Test cases starts here. diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index 70eec1a6f2..8636c69a0d 100755..100644 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017. All Rights Reserved. +%% Copyright Ericsson AB 2017-2019. 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. @@ -460,17 +460,73 @@ gen_cp(Fd) -> " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, "cp([C|_]=L) when is_integer(C) -> L;\n"), io:put_chars(Fd, "cp([List]) -> cp(List);\n"), - io:put_chars(Fd, "cp([List|R]) ->\n"), - io:put_chars(Fd, " case cp(List) of\n"), - io:put_chars(Fd, " [] -> cp(R);\n"), - io:put_chars(Fd, " [CP] -> [CP|R];\n"), - io:put_chars(Fd, " [C|R0] -> [C|[R0|R]];\n"), - io:put_chars(Fd, " {error,Error} -> {error,[Error|R]}\n"), - io:put_chars(Fd, " end;\n"), + io:put_chars(Fd, "cp([List|R]) -> cpl(List, R);\n"), io:put_chars(Fd, "cp([]) -> [];\n"), io:put_chars(Fd, "cp(<<C/utf8, R/binary>>) -> [C|R];\n"), io:put_chars(Fd, "cp(<<>>) -> [];\n"), - io:put_chars(Fd, "cp(<<R/binary>>) -> {error,R}.\n\n"), + io:put_chars(Fd, "cp(<<R/binary>>) -> {error,R}.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl([C], R) when is_integer(C) -> [C|cpl_1_cont(R)];\n"), + io:put_chars(Fd, "cpl([C|T], R) when is_integer(C) -> [C|cpl_cont(T, R)];\n"), + io:put_chars(Fd, "cpl([List], R) -> cpl(List, R);\n"), + io:put_chars(Fd, "cpl([List|T], R) -> cpl(List, [T|R]);\n"), + io:put_chars(Fd, "cpl([], R) -> cp(R);\n"), + io:put_chars(Fd, "cpl(<<C/utf8, T/binary>>, R) -> [C,T|R];\n"), + io:put_chars(Fd, "cpl(<<>>, R) -> cp(R);\n"), + io:put_chars(Fd, "cpl(<<B/binary>>, R) -> {error,[B|R]}.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "%%%\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_cont([C|T], R) when is_integer(C) -> [C|cpl_cont2(T, R)];\n"), + io:put_chars(Fd, "cpl_cont([L], R) -> cpl_cont(L, R);\n"), + io:put_chars(Fd, "cpl_cont([L|T], R) -> cpl_cont(L, [T|R]);\n"), + io:put_chars(Fd, "cpl_cont([], R) -> cpl_1_cont(R);\n"), + io:put_chars(Fd, "cpl_cont(T, R) -> [T|R].\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_cont2([C|T], R) when is_integer(C) -> [C|cpl_cont3(T, R)];\n"), + io:put_chars(Fd, "cpl_cont2([L], R) -> cpl_cont2(L, R);\n"), + io:put_chars(Fd, "cpl_cont2([L|T], R) -> cpl_cont2(L, [T|R]);\n"), + io:put_chars(Fd, "cpl_cont2([], R) -> cpl_1_cont2(R);\n"), + io:put_chars(Fd, "cpl_cont2(T, R) -> [T|R].\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_cont3([C], R) when is_integer(C) -> [C|R];\n"), + io:put_chars(Fd, "cpl_cont3([C|T], R) when is_integer(C) -> [C,T|R];\n"), + io:put_chars(Fd, "cpl_cont3([L], R) -> cpl_cont3(L, R);\n"), + io:put_chars(Fd, "cpl_cont3([L|T], R) -> cpl_cont3(L, [T|R]);\n"), + io:put_chars(Fd, "cpl_cont3([], R) -> cpl_1_cont3(R);\n"), + io:put_chars(Fd, "cpl_cont3(T, R) -> [T|R].\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "%%%\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_1_cont([C|T]) when is_integer(C) -> [C|cpl_1_cont2(T)];\n"), + io:put_chars(Fd, "cpl_1_cont([L]) -> cpl_1_cont(L);\n"), + io:put_chars(Fd, "cpl_1_cont([L|T]) -> cpl_cont(L, T);\n"), + io:put_chars(Fd, "cpl_1_cont(T) -> T.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_1_cont2([C|T]) when is_integer(C) -> [C|cpl_1_cont3(T)];\n"), + io:put_chars(Fd, "cpl_1_cont2([L]) -> cpl_1_cont2(L);\n"), + io:put_chars(Fd, "cpl_1_cont2([L|T]) -> cpl_cont2(L, T);\n"), + io:put_chars(Fd, "cpl_1_cont2(T) -> T.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_1_cont3([C|_]=T) when is_integer(C) -> T;\n"), + io:put_chars(Fd, "cpl_1_cont3([L]) -> cpl_1_cont3(L);\n"), + io:put_chars(Fd, "cpl_1_cont3([L|T]) -> cpl_cont3(L, T);\n"), + io:put_chars(Fd, "cpl_1_cont3(T) -> T.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "%%%\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cp_no_bin([C|_]=L) when is_integer(C) -> L;\n"), + io:put_chars(Fd, "cp_no_bin([List]) -> cp_no_bin(List);\n"), + io:put_chars(Fd, "cp_no_bin([List|R]) -> cp_no_binl(List, R);\n"), + io:put_chars(Fd, "cp_no_bin([]) -> [];\n"), + io:put_chars(Fd, "cp_no_bin(_) -> binary_found.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cp_no_binl([C], R) when is_integer(C) -> [C|cpl_1_cont(R)];\n"), + io:put_chars(Fd, "cp_no_binl([C|T], R) when is_integer(C) -> [C|cpl_cont(T, R)];\n"), + io:put_chars(Fd, "cp_no_binl([List], R) -> cp_no_binl(List, R);\n"), + io:put_chars(Fd, "cp_no_binl([List|T], R) -> cp_no_binl(List, [T|R]);\n"), + io:put_chars(Fd, "cp_no_binl([], R) -> cp_no_bin(R);\n"), + io:put_chars(Fd, "cp_no_binl(_, _) -> binary_found.\n\n"), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -481,11 +537,26 @@ gen_gc(Fd, GBP) -> "-spec gc(String::unicode:chardata()) ->" " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, - "gc([CP1, CP2|_]=T)\n" - " when CP1 < 256, CP2 < 256, CP1 =/= $\r -> %% Ascii Fast path\n" - " T;\n" + "gc([]=R) -> R;\n" + "gc([CP]=R) when is_integer(CP) -> R;\n" + "gc([$\\r=CP|R0]) ->\n" + " case cp(R0) of % Don't break CRLF\n" + " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" + " T -> [CP|T]\n" + " end;\n" + "gc([CP1|T1]=T) when CP1 < 256 ->\n" + " case T1 of\n" + " [CP2|_] when CP2 < 256 -> T; %% Ascii Fast path\n" + " _ -> %% Keep the tail binary.\n" + " case cp_no_bin(T1) of\n" + " [CP2|_]=T3 when CP2 < 256 -> [CP1|T3]; %% Asciii Fast path\n" + " binary_found -> gc_1(T);\n" + " T4 -> gc_1([CP1|T4])\n" + " end\n" + " end;\n" + "gc(<<>>) -> [];\n" "gc(<<CP1/utf8, Rest/binary>>) ->\n" - " if CP1 < 256, CP1 =/= $\r ->\n" + " if CP1 < 256, CP1 =/= $\\r ->\n" " case Rest of\n" " <<CP2/utf8, _/binary>> when CP2 < 256 -> %% Ascii Fast path\n" " [CP1|Rest];\n" @@ -493,13 +564,12 @@ gen_gc(Fd, GBP) -> " end;\n" " true -> gc_1([CP1|Rest])\n" " end;\n" + "gc([CP|_]=T) when is_integer(CP) -> gc_1(T);\n" "gc(Str) ->\n" - " gc_1(cp(Str)).\n\n" - "gc_1([$\\r|R0] = R) ->\n" - " case cp(R0) of % Don't break CRLF\n" - " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" - " _ -> R\n" - " end;\n" + " case cp(Str) of\n" + " {error,_}=Error -> Error;\n" + " CPs -> gc(CPs)\n" + " end.\n" ), GenExtP = fun(Range) -> io:format(Fd, "gc_1~s gc_ext_pict(R1,[CP]);\n", [gen_clause(Range)]) end, @@ -507,7 +577,12 @@ gen_gc(Fd, GBP) -> %% Pick codepoints below 256 (some data knowledge here) {ExtendedPictographicLow,ExtendedPictographicHigh} = lists:splitwith(fun({Start,undefined}) -> Start < 256 end,ExtendedPictographic0), - + io:put_chars(Fd, + "\ngc_1([$\\r|R0] = R) ->\n" + " case cp(R0) of % Don't break CRLF\n" + " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" + " _ -> R\n" + " end;\n"), io:put_chars(Fd, "\n%% Handle control\n"), GenControl = fun(Range) -> io:format(Fd, "gc_1~s R0;\n", [gen_clause(Range)]) end, CRs0 = merge_ranges(maps:get(cr, GBP) ++ maps:get(lf, GBP) ++ maps:get(control, GBP), false), @@ -516,7 +591,14 @@ gen_gc(Fd, GBP) -> %%GenControl(R1),GenControl(R2),GenControl(R3), io:put_chars(Fd, "\n%% Optimize Latin-1\n"), [GenExtP(CP) || CP <- merge_ranges(ExtendedPictographicLow)], - io:format(Fd, "gc_1([CP|R]) when CP < 256 -> gc_extend(R,CP);\n\n", []), + + io:format(Fd, + "gc_1([CP|R]=R0) when CP < 256 ->\n" + " case R of\n" + " [CP2|_] when CP2 < 256 -> R0;\n" + " _ -> gc_extend(cp(R), R, CP)\n" + " end;\n", + []), io:put_chars(Fd, "\n%% Continue control\n"), [GenControl(CP) || CP <- Crs], %% One clause per CP @@ -540,7 +622,7 @@ gen_gc(Fd, GBP) -> io:put_chars(Fd, "gc_1([CP|_]=R0) when 44000 < CP, CP < 56000 -> gc_h_lv_lvt(R0, []);\n"), io:put_chars(Fd, "\n%% Handle Regional\n"), - GenRegional = fun(Range) -> io:format(Fd, "gc_1~s gc_regional(R1,[CP]);\n", [gen_clause(Range)]) end, + GenRegional = fun(Range) -> io:format(Fd, "gc_1~s gc_regional(R1,CP);\n", [gen_clause(Range)]) end, [GenRegional(CP) || CP <- merge_ranges(maps:get(regional_indicator,GBP))], %% io:put_chars(Fd, "%% Handle E_Base\n"), %% GenEBase = fun(Range) -> io:format(Fd, "gc_1~s gc_e_cont(R1,[CP]);\n", [gen_clause(Range)]) end, @@ -552,9 +634,7 @@ gen_gc(Fd, GBP) -> io:put_chars(Fd, "%% Handle extended_pictographic\n"), [GenExtP(CP) || CP <- merge_ranges(ExtendedPictographicHigh)], io:put_chars(Fd, "\n%% default clauses\n"), - io:put_chars(Fd, "gc_1([CP|R]) -> gc_extend(R, CP);\n"), - io:put_chars(Fd, "gc_1([]) -> [];\n"), - io:put_chars(Fd, "gc_1({error,_}=Error) -> Error.\n\n"), + io:put_chars(Fd, "gc_1([CP|R]) -> gc_extend(cp(R), R, CP).\n\n"), io:put_chars(Fd, "%% Handle Prepend\n"), io:put_chars(Fd, @@ -581,31 +661,24 @@ gen_gc(Fd, GBP) -> "%% To simplify binary handling in libraries the tail should be kept binary\n" "%% and not a lookahead CP\n" ), - io:put_chars(Fd, "gc_extend(T, Acc) ->\n" - " gc_extend(cp(T), T, Acc).\n\n"), io:put_chars(Fd, - "gc_extend([CP|T], T0, Acc0) ->\n" + "gc_extend([CP|T], T0, CP0) ->\n" " case is_extend(CP) of\n" - " false ->\n" - " case Acc0 of\n" - " [Acc] -> [Acc|T0];\n" - " [_|_]=Acc -> [lists:reverse(Acc)|T0];\n" - " Acc -> [Acc|T0]\n" - " end;\n" - " _TrueOrZWJ ->\n" - " case Acc0 of\n" - " [_|_] -> gc_extend(T, [CP|Acc0]);\n" - " Acc -> gc_extend(T, [CP,Acc])\n" - " end\n" + " false -> [CP0|T0]; % losing work done on T\n" + " _TrueOrZWJ -> gc_extend2(cp(T), T, [CP,CP0])\n" " end;\n" - "gc_extend([], _, Acc0) ->\n" - " case Acc0 of\n" - " [_]=Acc -> Acc;\n" - " [_|_]=Acc -> [lists:reverse(Acc)];\n" - " Acc -> [Acc]\n" + "gc_extend([], _, CP) -> [CP];\n" + "gc_extend({error,R}, _, CP) -> [CP|R].\n\n"), + io:put_chars(Fd, + "gc_extend2([CP|T], T0, Acc) ->\n" + " case is_extend(CP) of\n" + " false -> [lists:reverse(Acc)|T0]; % losing work done on T\n" + " _TrueOrZWJ -> gc_extend2(cp(T), T, [CP|Acc])\n" " end;\n" - "gc_extend({error,R}, T, Acc0) ->\n" - " gc_extend([], T, Acc0) ++ [R].\n\n" + "gc_extend2([], _, Acc) ->\n" + " [lists:reverse(Acc)];\n" + "gc_extend2({error,R}, _, Acc) ->\n" + " [lists:reverse(Acc)] ++ [R].\n\n" ), [ZWJ] = maps:get(zwj, GBP), GenExtend = fun(R) when R =:= ZWJ -> io:format(Fd, "is_extend~s zwj;\n", [gen_single_clause(ZWJ)]); @@ -660,10 +733,10 @@ gen_gc(Fd, GBP) -> %% -------------------- io:put_chars(Fd, "%% Handle Regional\n"), [{RLess,RLarge}] = merge_ranges(maps:get(regional_indicator,GBP)), - io:put_chars(Fd,"gc_regional(R0, Acc) ->\n" + io:put_chars(Fd,"gc_regional(R0, CP0) ->\n" " case cp(R0) of\n"), - io:format(Fd, " [CP|R1] when ~w =< CP,CP =< ~w-> gc_extend(R1,[CP|Acc]);~n",[RLess, RLarge]), - io:put_chars(Fd," R1 -> gc_extend(R1, R0, Acc)\n" + io:format(Fd, " [CP|R1] when ~w =< CP,CP =< ~w-> gc_extend2(cp(R1),R1,[CP,CP0]);~n",[RLess, RLarge]), + io:put_chars(Fd," R1 -> gc_extend(R1, R0, CP0)\n" " end.\n\n"), %% Special hangul @@ -685,16 +758,23 @@ gen_gc(Fd, GBP) -> GenHangulV_2 = fun(Range) -> io:format(Fd, "~8c~s gc_h_T(R1,[CP|Acc]);\n", [$\s,gen_case_clause(Range)]) end, [GenHangulV_2(CP) || CP <- merge_ranges(maps:get(t,GBP))], - io:put_chars(Fd, " R1 -> gc_extend(R1, R0, Acc)\n end.\n\n"), - + io:put_chars(Fd, + " R1 ->\n" + " case Acc of\n" + " [CP] -> gc_extend(R1, R0, CP);\n" + " _ -> gc_extend2(R1, R0, Acc)\n" + " end\n end.\n\n"), io:put_chars(Fd, "%% Handle Hangul T\n"), io:put_chars(Fd, "gc_h_T(R0, Acc) ->\n case cp(R0) of\n"), GenHangulT_1 = fun(Range) -> io:format(Fd, "~8c~s gc_h_T(R1,[CP|Acc]);\n", [$\s,gen_case_clause(Range)]) end, [GenHangulT_1(CP) || CP <- merge_ranges(maps:get(t,GBP))], - io:put_chars(Fd, " R1 -> gc_extend(R1, R0, Acc)\n end.\n\n"), - - io:put_chars(Fd, "gc_h_lv_lvt({error,_}=Error, Acc) -> gc_extend(Error, [], Acc);\n"), + io:put_chars(Fd, + " R1 ->\n" + " case Acc of\n" + " [CP] -> gc_extend(R1, R0, CP);\n" + " _ -> gc_extend2(R1, R0, Acc)\n" + " end\n end.\n\n"), io:put_chars(Fd, "%% Handle Hangul LV\n"), GenHangulLV = fun(Range) -> io:format(Fd, "gc_h_lv_lvt~s gc_h_V(R1,[CP|Acc]);\n", [gen_clause2(Range)]) end, @@ -703,8 +783,10 @@ gen_gc(Fd, GBP) -> GenHangulLVT = fun(Range) -> io:format(Fd, "gc_h_lv_lvt~s gc_h_T(R1,[CP|Acc]);\n", [gen_clause2(Range)]) end, [GenHangulLVT(CP) || CP <- merge_ranges(maps:get(lvt,GBP))], - io:put_chars(Fd, "gc_h_lv_lvt([CP|R], []) -> gc_extend(R, CP);\n"), %% From gc_1/1 - io:put_chars(Fd, "gc_h_lv_lvt(R, Acc) -> gc_extend(R, Acc).\n\n"), + io:put_chars(Fd, "gc_h_lv_lvt([CP|R], []) -> gc_extend(cp(R), R, CP);\n"), %% From gc_1/1 + io:put_chars(Fd, "%% Also handles error tuples\n"), + io:put_chars(Fd, "gc_h_lv_lvt(R, [CP]) -> gc_extend(R, R, CP);\n"), + io:put_chars(Fd, "gc_h_lv_lvt(R, Acc) -> gc_extend2(R, R, Acc).\n\n"), ok. gen_compose_pairs(Fd, ExclData, Data) -> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 3cbe9daa60..38c0eba92b 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -905,8 +905,10 @@ resulting regexp is surrounded by \\_< and \\_>." "dist_get_stat" "dist_ctrl_get_data" "dist_ctrl_get_data_notification" + "dist_ctrl_get_opt" "dist_ctrl_input_handler" "dist_ctrl_put_data" + "dist_ctrl_set_opt" "dmonitor_node" "dt_append_vm_tag_data" "dt_get_tag" diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index 7f6874e36b..d6b6dfdfb5 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -32,6 +32,28 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.20</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Handling of character references in attributes are fixed.</p> + <p> + Own Id: OTP-15684 Aux Id: ERL-837 </p> + </item> + <item> + <p> + Normalization of whitespace characters in attributes are + fixed so it works when character references are used.</p> + <p> + Own Id: OTP-15685 Aux Id: ERL-475 </p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.19</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index e543a5a11e..d76ed5c820 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -2410,15 +2410,22 @@ scan_att_chars("&" ++ T, S0, Delim, Acc, TmpAcc,AT,IsNorm) -> % Reference true -> scan_att_chars(T1,S1,Delim,[ExpRef|Acc],[ExpRef|TmpAcc],AT,IsNorm); _ -> - Ch = string_to_char_set(S#xmerl_scanner.encoding, ExpRef), case T of "#" ++ _ -> %% normalization rules (sec 3.3.3) require that for %% character references, the referenced character be %% added directly to the normalized value - scan_att_chars(T1, S1, Delim, Ch ++ Acc,TmpAcc, AT,IsNorm); + {T2,S2,IsNorm2} = + if + ?whitespace(hd(ExpRef)) -> + normalize(T1, S1, IsNorm); + true -> + {T1, S1, IsNorm} + end, + scan_att_chars(T2, S2, Delim, ExpRef ++ Acc, TmpAcc, AT, IsNorm2); _ -> - scan_att_chars(Ch ++ T1, S1, Delim, Acc,TmpAcc, AT,IsNorm) + Ch = string_to_char_set(S#xmerl_scanner.encoding, ExpRef), + scan_att_chars(Ch ++ T1, S1, Delim, Acc, TmpAcc, AT, IsNorm) end end; scan_att_chars("<" ++ _T, S0, _Delim, _Acc,_, _,_) -> % Tags not allowed here @@ -3964,7 +3971,7 @@ normalize(T,S,IsNorm) -> {_,T,S} -> {T,S,IsNorm}; {_,T1,S1} -> - {T1,S1,true} + normalize(T1,S1,true) end. diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index b6486681c2..31ffa6e749 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.19 +XMERL_VSN = 1.3.20 diff --git a/make/otp_patch_solve_forward_merge_version b/make/otp_patch_solve_forward_merge_version index 7f8f011eb7..45a4fb75db 100644 --- a/make/otp_patch_solve_forward_merge_version +++ b/make/otp_patch_solve_forward_merge_version @@ -1 +1 @@ -7 +8 diff --git a/make/otp_version_tickets_in_merge b/make/otp_version_tickets_in_merge index 77633c2ce2..e69de29bb2 100644 --- a/make/otp_version_tickets_in_merge +++ b/make/otp_version_tickets_in_merge @@ -1,79 +0,0 @@ -OTP-14702 -OTP-15229 -OTP-15298 -OTP-15369 -OTP-15375 -OTP-15398 -OTP-15423 -OTP-15442 -OTP-15445 -OTP-15447 -OTP-15460 -OTP-15479 -OTP-15484 -OTP-15490 -OTP-15493 -OTP-15494 -OTP-15498 -OTP-15502 -OTP-15503 -OTP-15508 -OTP-15514 -OTP-15518 -OTP-15519 -OTP-15527 -OTP-15529 -OTP-15539 -OTP-15540 -OTP-15541 -OTP-15542 -OTP-15545 -OTP-15552 -OTP-15553 -OTP-15555 -OTP-15556 -OTP-15557 -OTP-15558 -OTP-15561 -OTP-15562 -OTP-15567 -OTP-15569 -OTP-15570 -OTP-15572 -OTP-15576 -OTP-15577 -OTP-15578 -OTP-15580 -OTP-15583 -OTP-15584 -OTP-15586 -OTP-15587 -OTP-15592 -OTP-15599 -OTP-15600 -OTP-15601 -OTP-15602 -OTP-15604 -OTP-15605 -OTP-15619 -OTP-15624 -OTP-15625 -OTP-15629 -OTP-15630 -OTP-15634 -OTP-15637 -OTP-15639 -OTP-15642 -OTP-15647 -OTP-15650 -OTP-15654 -OTP-15657 -OTP-15659 -OTP-15660 -OTP-15662 -OTP-15663 -OTP-15665 -OTP-15666 -OTP-15667 -OTP-15669 -OTP-15670 diff --git a/otp_versions.table b/otp_versions.table index eef6a9c8fe..cc5d331b06 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-21.3.2 : erts-10.3.1 xmerl-1.3.20 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 ssl-9.2.1 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 : +OTP-21.3.1 : erl_interface-3.11.1 ssl-9.2.1 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erts-10.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.19 : OTP-21.3 : common_test-1.17 compiler-7.3.2 crypto-4.4.1 dialyzer-3.3.2 diameter-2.2 edoc-0.10 erl_docgen-0.9 erl_interface-3.11 erts-10.3 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 kernel-6.3 mnesia-4.15.6 observer-2.9 odbc-2.12.3 public_key-1.6.5 runtime_tools-1.13.2 ssh-4.7.4 ssl-9.2 stdlib-3.8 syntax_tools-2.1.7 tools-3.1 wx-1.8.7 # asn1-5.0.8 debugger-4.2.6 eldap-1.2.6 et-1.6.4 eunit-2.3.7 jinterface-1.9.1 megaco-3.18.4 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 sasl-3.3 snmp-5.2.12 tftp-1.0.1 xmerl-1.3.19 : OTP-21.2.7 : erts-10.2.5 kernel-6.2.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.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.5 jinterface-1.9.1 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 ssl-9.1.2 stdlib-3.7.1 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 : OTP-21.2.6 : erts-10.2.4 stdlib-3.7.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.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.5 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 ssl-9.1.2 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 : |