diff options
85 files changed, 2728 insertions, 678 deletions
diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index b3d30761e2..3bf6be8c89 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -604,7 +604,7 @@ using the similar steps just described. $ (cd $ERL_TOP/erts/emulator && make $TYPE) -where `$TYPE` is `opt`, `gcov`, `gprof`, `debug`, `valgrind`, or `lcnt`. +where `$TYPE` is `opt`, `gcov`, `gprof`, `debug`, `valgrind`, `asan` or `lcnt`. These different beam types are useful for debugging and profiling purposes. diff --git a/HOWTO/TESTING.md b/HOWTO/TESTING.md index 020be0309c..7a7f6982f2 100644 --- a/HOWTO/TESTING.md +++ b/HOWTO/TESTING.md @@ -185,6 +185,52 @@ examine the results so far for the currently executing test suite (in R14B02 and later you want to open the `release/tests/test_server/all_runs.html` file to get to the currently running test) + +Run tests with Address Sanitizer +-------------------------------- + +First build emulator with `asan` build target. +See [$ERL_TOP/HOWTO/INSTALL.md][]. + +Set environment variable `ASAN_LOG_DIR` to the directory +where the error logs will be generated. + + export ASAN_LOG_DIR=$TESTROOT/test_server/asan_logs + mkdir $ASAN_LOG_DIR + +Set environment variable `TS_RUN_EMU` to `asan`. + + export TS_RUN_EMU=asan + +Then run the tests you want with `ts:run` as described above. Either +inspect the log files directly or use the script at +`$ERL_TOP/erts/emulator/asan/asan_logs_to_html` to read all log files +in `$ASAN_LOG_DIR` and distill them into one html page +`asan_summary.html`. Repeated reports from the same memory leak will +for example be ignored by the script and make it easier to analyze. + + +Run tests with Valgrind +----------------------- + +First make sure [valgrind][] is installed, then build OTP from source +and build the emulator with `valgrind` build target. See +[$ERL_TOP/HOWTO/INSTALL.md][]. + +Set environment variable `VALGRIND_LOG_DIR` to the directory +where the valgrind error logs will be generated. + + export VALGRIND_LOG_DIR=$TESTROOT/test_server/vg_logs + mkdir $VALGRIND_LOG_DIR + +Set environment variable `TS_RUN_EMU` to `valgrind`. + + export TS_RUN_EMU=valgrind + +Then run the tests you want with `ts:run` as described above and +inspect the log file(s) in `$VALGRIND_LOG_DIR`. + + [ct_run]: http://www.erlang.org/doc/man/ct_run.html [ct hook]: http://www.erlang.org/doc/apps/common_test/ct_hooks_chapter.html [$ERL_TOP/HOWTO/INSTALL.md]: INSTALL.md @@ -192,5 +238,6 @@ get to the currently running test) [common_test]: http://www.erlang.org/doc/man/ct.html [data_dir]: http://www.erlang.org/doc/apps/common_test/write_test_chapter.html#data_priv_dir [configuring the tests]: #configuring-the-test-environment + [valgrind]: https://valgrind.org [?TOC]: true diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index cd04b49c2b..726845e7b8 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -144,6 +144,14 @@ TYPE_FLAGS = $(DEBUG_CFLAGS) -DVALGRIND -DNO_JUMP_TABLE ENABLE_ALLOC_TYPE_VARS += valgrind else +ifeq ($(TYPE),asan) +PURIFY = +TYPEMARKER = .asan +TYPE_FLAGS = $(DEBUG_CFLAGS) -fsanitize=address -fsanitize-recover=address -fno-omit-frame-pointer -DADDRESS_SANITIZER +LDFLAGS += -fsanitize=address +ENABLE_ALLOC_TYPE_VARS += asan +else + ifeq ($(TYPE),gprof) TYPEMARKER = .gprof TYPE_FLAGS = @CFLAGS@ -DGPROF -pg -DERTS_CAN_INLINE=0 -DERTS_INLINE= @@ -180,6 +188,7 @@ endif endif endif endif +endif LIBS += $(TYPE_LIBS) diff --git a/erts/emulator/asan/asan_logs_to_html b/erts/emulator/asan/asan_logs_to_html new file mode 100755 index 0000000000..9e20d4051b --- /dev/null +++ b/erts/emulator/asan/asan_logs_to_html @@ -0,0 +1,234 @@ +#!/usr/bin/env escript +%% -*- erlang -*- + +%% Parse address sanitizer log files generated from test runs with +%% with environment variables ASAN_LOG_DIR and TS_RUN_EMU=asan set. + +%% Repeated leak reports are ignored and additional leaks of same type +%% as seen before are identified as such. + +-mode(compile). + +main([]) -> + help(); +main(["--help"]) -> + help(); +main([OutDir]) -> + case os:getenv("ASAN_LOG_DIR") of + false -> + io:format(standard_error, + "\nMissing asan log directory argument and environment\n" + "variable ASAN_LOG_DIR is not set.\n\n",[]), + help(); + InDir -> + run(OutDir, InDir) + end; +main([OutDir, InDir]) -> + run(OutDir, InDir). + + +help() -> + io:format("\nSyntax: asan_log_to_html OutDir [InDir]\n" + "\nParses all address-sanetizer log files in InDir\n" + "and generates a summary file OutDir/asan_summary.html.\n" + "Environment variable ASAN_LOG_DIR is used if InDir\n" + "is not specified\n\n", []). + +run(OutDir, InDir) -> + {ok, InFilesUS} = file:list_dir(InDir), + InFiles = lists:sort(InFilesUS), + + OutFile = filename:join(OutDir, "asan_summary.html"), + {ok, FD} = file:open(OutFile, [write]), + + ok = file:write(FD, <<"<!DOCTYPE html>\n" + "<html>\n" + "<head><title>Address Sanitizer</title></head>\n" + "<body>\n" + "<h1>Address Sanitizer</h1>\n">>), + + lists:foldl(fun(File, Acc) -> + io:format("analyze ~s\n", [File]), + analyze_log_file(filename:join(InDir,File), + FD, Acc) + end, + {#{}, none, none}, + InFiles), + + ok = io:format(FD, "<hr>\n", []), + + Time = calendar:system_time_to_rfc3339(erlang:system_time(second), + [{time_designator, 32}]), + %%{_, _, ThisFile} = code:get_object_code(?MODULE), + ThisFile = escript:script_name(), + User = string:trim(os:cmd("whoami")), + {ok, Host} = inet:gethostname(), + ok = io:format(FD, "<p><small>This page was generated ~s\n" + " by <tt>~s</tt>\n" + " run by ~s@~s.</small></p>\n", + [Time, ThisFile, User, Host]), + + ok = file:write(FD, <<"</body>\n</html>\n">>), + ok = file:close(FD), + io:format("Generated file ~s\n", [OutFile]), + ok. + +analyze_log_file(SrcFile, OutFD, {LeakMap0, PrevApp, RegEx0}) -> + + [_Exe, App | _] = string:lexemes(filename:basename(SrcFile), "-"), + case App of + PrevApp -> ignore; + _ -> + Line = case PrevApp of + none -> ""; + _ -> "<hr>" + end, + ok = io:format(OutFD, "~s<h2>~s</h2>\n", [Line, App]) + end, + + {ok, Bin} = file:read_file(SrcFile), + + {Leaks, RegEx1} = + run_regex(Bin, RegEx0, + %% LeakReport + "(?:(Direct|Indirect) leak of ([0-9]+) byte\\(s\\) " + "in ([0-9]+) object\\(s\\) allocated from:\n" + "((?:[ \t]*#[0-9]+.+\n)+))" % Call stack + "|" + %% ErrorReport + "(?:(==ERROR: AddressSanitizer:.*\n" + "(?:.*\n)+?)" % any lines (non-greedy) + "^(?:==|--))" % stop at line begining with == or -- + "|" + %% Skipped + "(?:^[=-]+$)" % skip lines consisting only of = or - + "|" + "Objects leaked above:\n" % if LSAN_OPTIONS="report_objects=1" + "(?:0x.+\n)+" + "|" + "^\n", % empty lines + [multiline], + [global, {capture, all, index}]), + + %% We indentify a leak by its type (direct or indirect) + %% and its full call stack. + + BP = fun(PartIx) -> binary:part(Bin, PartIx) end, + + LeakChecker = + fun([ErrorReport, {-1,0}, {-1,0}, {-1,0}, {-1,0}, Captured], + {Out, PrevEnd, Unmatched0, LM0}) -> + {Start,MatchLen} = ErrorReport, + FD = fd(Out), + ok = io:format(FD, "<p><pre~s>\n", [style(error)]), + ok = file:write(FD, BP(Captured)), + ok = io:format(FD, "</pre></p>\n", []), + Unmatched1 = [BP({PrevEnd, Start-PrevEnd}) | Unmatched0], + End = Start + MatchLen, + {FD, End, Unmatched1, LM0}; + + ([LeakReport, TypeIx, BytesIx, BlocksIx, StackIx | _], + {Out, PrevEnd, Unmatched0, LM0}) -> + {Start, MatchLen} = LeakReport, + Bytes = binary_to_integer(BP(BytesIx)), + Blocks = binary_to_integer(BP(BlocksIx)), + End = Start + MatchLen, + Unmatched1 = [BP({PrevEnd, Start-PrevEnd})|Unmatched0], + TypeBin = BP(TypeIx), + Key = {TypeBin, BP(StackIx)}, + case lookup_leak(LM0, Key) of + undefined -> + %% A new leak + LM1 = insert_leak(LM0, Key, Bytes, Blocks), + FD = fd(Out), + ok = io:format(FD, "<p><pre~s>\n", [style(new, TypeBin)]), + ok = file:write(FD, BP(LeakReport)), + ok = io:format(FD, "</pre></p>\n", []), + {FD, End, Unmatched1, LM1}; + + {Bytes, Blocks} -> + %% Exact same leak(s) repeated, ignore + {Out, End, Unmatched1, LM0}; + + {OldBytes, OldBlocks} -> + %% More leaked bytes/blocks of same type&stack as before + LM1 = insert_leak(LM0, Key, Bytes, Blocks), + FD = fd(Out), + ok = io:format(FD, "<p><pre~s>\n", [style(more, TypeBin)]), + ok = io:format(FD, "More ~s leak of ~w(~w) byte(s) " + "in ~w(~w) object(s) allocated from:\n", + [TypeBin, Bytes - OldBytes, Bytes, + Blocks - OldBlocks, Blocks]), + ok = file:write(FD, BP(StackIx)), + ok = io:format(FD, "</pre></p>\n", []), + {FD, End, Unmatched1, LM1} + end; + ([SkipLine], {Out, PrevEnd, Unmatched0, LM0}) -> + {Start, MatchLen} = SkipLine, + %%nomatch = binary:match(BP(SkipLine), <<"\n">>), % Assert single line + End = Start + MatchLen, + Unmatched1 = [BP({PrevEnd, Start-PrevEnd})|Unmatched0], + {Out, End, Unmatched1, LM0} + end, + Out0 = {OutFD, SrcFile}, + {Out1, LastEnd, Unmatched1, LeakMap1} = lists:foldl(LeakChecker, + {Out0, 0, [], LeakMap0}, + Leaks), + + Unmatched2 = [BP({LastEnd, byte_size(Bin)-LastEnd}) | Unmatched1], + + case iolist_size(Unmatched2) > 500 of + true -> + FD = fd(Out1), + ok = io:format(FD, "<h2>WARNING!!! May be unmatched error reports" + " in file ~s:</h2>\n<p><pre>~s</pre></p>", [SrcFile, Unmatched2]), + FD; + false -> + Out1 + end, + {LeakMap1, App, RegEx1}. + +lookup_leak(LeakMap, Key) -> + maps:get(Key, LeakMap, undefined). + +insert_leak(LeakMap, Key, Bytes, Blocks) -> + LeakMap#{Key => {Bytes, Blocks}}. + +fd({FD, SrcFile}) -> + TcFile = filename:basename(SrcFile), + case string:lexemes(TcFile, "-") of + [_Exe, App, _Rest] -> + ok = io:format(FD, "<h3>Before first test case of ~s</h3>\n", + [App]); + [_Exe, _App, "tc", Num, Mod, Rest] -> + [Func | _] = string:lexemes(Rest, "."), + ok = io:format(FD, "<h3>Test case #~s ~s:~s</h3>\n", [Num, Mod, Func]); + _ -> + ok = io:format(FD, "<h3>Strange log file name '~s'</h3>\n", + [SrcFile]) + end, + FD; +fd(FD) -> + FD. + +style(error) -> + " style=\"background-color:Tomato;\"". + +style(new, <<"Direct">>) -> + " style=\"background-color:orange;\""; +style(new, <<"Indirect">>) -> + ""; +style(more, _) -> + " style=\"background-color:yellow;\"". + + +run_regex(Bin, none, RegExString, CompileOpts, RunOpts) -> + {ok, RegEx} = re:compile(RegExString, CompileOpts), + run_regex(Bin, RegEx, none, none, RunOpts); +run_regex(Bin, RegEx, _, _, RunOpts) -> + case re:run(Bin, RegEx, RunOpts) of + nomatch -> + {[], RegEx}; + {match, List} -> + {List, RegEx} + end. diff --git a/erts/emulator/asan/suppress b/erts/emulator/asan/suppress new file mode 100644 index 0000000000..5625938f37 --- /dev/null +++ b/erts/emulator/asan/suppress @@ -0,0 +1,18 @@ +leak:erts_alloc_permanent_cache_aligned + +# Harmless leak of ErtsThrPrgrData from async threads in exiting emulator +leak:erts_thr_progress_register_unmanaged_thread + +# Block passed to sigaltstack() +leak:sys_thread_init_signal_stack + +#Copied from valgrind/suppress.standard: +#Crypto internal... loading gives expected errors when curves are tried. +#But including <openssl/err.h> and removing them triggers compiler errors on Windows +#fun:valid_curve +#fun:init_curves +leak:init_curve_types +#fun:init_algorithms_types +#fun:initialize +#fun:load +#fun:erts_load_nif diff --git a/erts/emulator/beam/emu/msg_instrs.tab b/erts/emulator/beam/emu/msg_instrs.tab index afc94d4520..9d14cc8c60 100644 --- a/erts/emulator/beam/emu/msg_instrs.tab +++ b/erts/emulator/beam/emu/msg_instrs.tab @@ -50,7 +50,7 @@ i_recv_mark() { * * Save the current end of message queue */ - erts_msgq_recv_marker_insert(c_p, am_default); + erts_msgq_recv_marker_insert_bind(c_p, am_default); /* inlined here... */ } i_recv_set() { @@ -60,7 +60,7 @@ i_recv_set() { * * If previously saved recv mark, set save pointer to it */ - erts_msgq_recv_marker_set_save(c_p, am_default); + erts_msgq_recv_marker_set_save(c_p, am_default); /* inlined here... */ SET_I($NEXT_INSTRUCTION); goto loop_rec_top__; //| -no_next diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 8d739ba654..72497ef6a1 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -66,7 +66,7 @@ #define ERTS_ALC_DEFAULT_MAX_THR_PREF ERTS_MAX_NO_OF_SCHEDULERS -#if defined(SMALL_MEMORY) || defined(VALGRIND) +#if defined(SMALL_MEMORY) || defined(VALGRIND) || defined(ADDRESS_SANITIZER) #define AU_ALLOC_DEFAULT_ENABLE(X) 0 #else #define AU_ALLOC_DEFAULT_ENABLE(X) (X) @@ -284,7 +284,11 @@ static void set_default_literal_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); +#ifdef ADDRESS_SANITIZER + ip->enable = 0; +#else ip->enable = 1; +#endif ip->thr_spec = 0; ip->disable_allowed = 0; ip->thr_spec_allowed = 0; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index c13cf3f5b0..831e7ab0a7 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -358,24 +358,11 @@ erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr); #define ERTS_ALC_CACHE_LINE_ALIGN_SIZE(SZ) \ (((((SZ) - 1) / ERTS_CACHE_LINE_SIZE) + 1) * ERTS_CACHE_LINE_SIZE) +#if !defined(VALGRIND) && !defined(ADDRESS_SANITIZER) + #define ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, (void) 0, (void) 0, (void) 0) -#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ -ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) - -#define ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) \ -static erts_spinlock_t NAME##_lck; \ -ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, \ - erts_spinlock_init(&NAME##_lck, #NAME "_alloc_lock", NIL, \ - ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\ - erts_spin_lock(&NAME##_lck), \ - erts_spin_unlock(&NAME##_lck)) - - -#define ERTS_PALLOC_IMPL(NAME, TYPE, PASZ) \ - ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) - #define ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, ILCK, LCK, ULCK) \ ERTS_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ, ILCK, LCK, ULCK) \ @@ -606,6 +593,69 @@ NAME##_free(TYPE *p) \ (char *) p); \ } +#else /* !defined(VALGRIND) && !defined(ADDRESS_SANITIZER) */ + +/* + * For VALGRIND and ADDRESS_SANITIZER we short circuit all preallocation + * with dummy wrappers around malloc and free. + */ + +#define ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ + ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, (void) 0, (void) 0, (void) 0) + +#define ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, ILCK, LCK, ULCK) \ +static void init_##NAME##_alloc(void) \ +{ \ +} \ +static ERTS_INLINE TYPE* NAME##_alloc(void) \ +{ \ + return malloc(sizeof(TYPE)); \ +} \ +static ERTS_INLINE void NAME##_free(TYPE *p) \ +{ \ + free((void *) p); \ +} + +#define ERTS_SCHED_PREF_PALLOC_IMPL(NAME, TYPE, PASZ) \ + ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) + +#define ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \ +ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ) + +#define ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ + ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) + +#define ERTS_THR_PREF_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ +void erts_##NAME##_pre_alloc_init_thread(void) \ +{ \ +} \ +static void init_##NAME##_alloc(int nthreads) \ +{ \ +} \ +static ERTS_INLINE TYPE* NAME##_alloc(void) \ +{ \ + return malloc(sizeof(TYPE)); \ +} \ +static ERTS_INLINE void NAME##_free(TYPE *p) \ +{ \ + free(p); \ +} + +#define ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) \ +static void init_##NAME##_alloc(void) \ +{ \ +} \ +static TYPE* NAME##_alloc(void) \ +{ \ + return (TYPE *) malloc(sizeof(TYPE)); \ +} \ +static int NAME##_free(TYPE *p) \ +{ \ + free(p); \ + return 1; \ +} + +#endif /* VALGRIND || ADDRESS_SANITIZER */ #ifdef DEBUG #define ERTS_ALC_DBG_BLK_SZ(PTR) (*(((UWord *) (PTR)) - 2)) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index f237ad81e3..66825f3d2e 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -59,8 +59,11 @@ #endif #ifdef VALGRIND -#include <valgrind/valgrind.h> -#include <valgrind/memcheck.h> +# include <valgrind/valgrind.h> +# include <valgrind/memcheck.h> +#endif +#ifdef ADDRESS_SANITIZER +# include <sanitizer/lsan_interface.h> #endif static Export* alloc_info_trap = NULL; @@ -125,6 +128,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef VALGRIND " [valgrind-compiled]" #endif +#ifdef ADDRESS_SANITIZER + " [address-sanitizer]" +#endif #ifdef ERTS_FRMPTR " [frame-pointer]" #endif @@ -2119,6 +2125,28 @@ current_stacktrace(Process *p, ErtsHeapFactory *hfact, Process* rp, return res; } +#if defined(VALGRIND) || defined(ADDRESS_SANITIZER) +static int iolist_to_tmp_buf(Eterm iolist, char** bufp) +{ + ErlDrvSizeT buf_size = 1024; /* Try with 1KB first */ + char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); + ErlDrvSizeT r = erts_iolist_to_buf(iolist, (char*) buf, buf_size - 1); + if (ERTS_IOLIST_TO_BUF_FAILED(r)) { + erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (erts_iolist_size(iolist, &buf_size)) { + return 0; + } + buf_size++; + buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); + r = erts_iolist_to_buf(iolist, (char*) buf, buf_size - 1); + ASSERT(r == buf_size - 1); + } + buf[buf_size - 1 - r] = '\0'; + *bufp = buf; + return 1; +} +#endif + /* * This function takes care of calls to erlang:system_info/1 when the argument * is a tuple. @@ -2181,40 +2209,72 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ goto badarg; ERTS_BIF_PREP_TRAP1(ret, erts_format_cpu_topology_trap, BIF_P, res); return ret; -#if defined(VALGRIND) - } else if (ERTS_IS_ATOM_STR("error_checker", sel) - || ERTS_IS_ATOM_STR("valgrind", sel)) { - if (*tp == am_memory) { -# ifdef VALGRIND_DO_ADDED_LEAK_CHECK + } else if (ERTS_IS_ATOM_STR("memory_checker", sel)) { + if (arity == 2 && ERTS_IS_ATOM_STR("test_leak", *tp)) { +#if defined(VALGRIND) || defined(ADDRESS_SANITIZER) + erts_alloc(ERTS_ALC_T_HEAP , 100); +#endif + BIF_RET(am_ok); + } + else if (arity == 2 && ERTS_IS_ATOM_STR("test_overflow", *tp)) { + static int test[2]; + BIF_RET(make_small(test[2])); + } +#if defined(VALGRIND) || defined(ADDRESS_SANITIZER) + if (arity == 2 && *tp == am_running) { +# if defined(VALGRIND) + if (RUNNING_ON_VALGRIND) + BIF_RET(ERTS_MAKE_AM("valgrind")); +# elif defined(ADDRESS_SANITIZER) + BIF_RET(ERTS_MAKE_AM("asan")); +# endif + } + else if (arity == 2 && ERTS_IS_ATOM_STR("check_leaks", *tp)) { +# if defined(VALGRIND) +# ifdef VALGRIND_DO_ADDED_LEAK_CHECK VALGRIND_DO_ADDED_LEAK_CHECK; -# else +# else VALGRIND_DO_LEAK_CHECK; +# endif + BIF_RET(am_ok); +# elif defined(ADDRESS_SANITIZER) + __lsan_do_recoverable_leak_check(); + BIF_RET(am_ok); # endif - BIF_RET(make_small(0)); - } else if (*tp == am_fd) { - /* Not present in valgrind... */ - BIF_RET(make_small(0)); - } else if (*tp == am_running) { - BIF_RET(RUNNING_ON_VALGRIND ? am_true : am_false); - } else if (is_list(*tp)) { - ErlDrvSizeT buf_size = 8*1024; /* Try with 8KB first */ - char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); - ErlDrvSizeT r = erts_iolist_to_buf(*tp, (char*) buf, buf_size - 1); - if (ERTS_IOLIST_TO_BUF_FAILED(r)) { - erts_free(ERTS_ALC_T_TMP, (void *) buf); - if (erts_iolist_size(*tp, &buf_size)) { - goto badarg; - } - buf_size++; - buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); - r = erts_iolist_to_buf(*tp, (char*) buf, buf_size - 1); - ASSERT(r == buf_size - 1); - } - buf[buf_size - 1 - r] = '\0'; + } +# if defined(VALGRIND) + if (arity == 3 && tp[0] == am_print && is_list(tp[1])) { + char* buf; + if (!iolist_to_tmp_buf(tp[1], &buf)) + goto badarg; VALGRIND_PRINTF("%s\n", buf); erts_free(ERTS_ALC_T_TMP, (void *) buf); BIF_RET(am_true); } +# endif +# if defined(ADDRESS_SANITIZER) + if (arity == 3 && ERTS_IS_ATOM_STR("log",tp[0]) && is_list(tp[1])) { + static char *active_log = NULL; + static int active_log_len; + Eterm ret = NIL; + char* buf; + if (!iolist_to_tmp_buf(tp[1], &buf)) + goto badarg; + erts_rwmtx_rwlock(&erts_dist_table_rwmtx); /* random lock abuse */ + __sanitizer_set_report_path(buf); + if (active_log) { + Eterm *hp = HAlloc(BIF_P, 2 * active_log_len); + ret = erts_bld_string_n(&hp, 0, active_log, active_log_len); + erts_free(ERTS_ALC_T_DEBUG, active_log); + } + active_log_len = sys_strlen(buf); + active_log = erts_alloc(ERTS_ALC_T_DEBUG, active_log_len + 1); + sys_memcpy(active_log, buf, active_log_len + 1); + erts_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(ret); + } +# endif #endif #if defined(__GNUC__) && defined(HAVE_SOLARIS_SPARC_PERFMON) } else if (ERTS_IS_ATOM_STR("ultrasparc_set_pcr", sel)) { @@ -2411,6 +2471,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #elif defined(VALGRIND) ERTS_DECL_AM(valgrind); BIF_RET(AM_valgrind); +#elif defined(ADDRESS_SANITIZER) + ERTS_DECL_AM(asan); + BIF_RET(AM_asan); #elif defined(GPROF) ERTS_DECL_AM(gprof); BIF_RET(AM_gprof); @@ -4476,24 +4539,27 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } else if (ERTS_IS_ATOM_STR("recv_marker_insert", BIF_ARG_1)) { /* receive_SUITE (emulator) */ - if (is_internal_ref(BIF_ARG_2)) { - erts_msgq_recv_marker_insert(BIF_P, BIF_ARG_2); + Eterm res = erts_msgq_recv_marker_insert(BIF_P); + ASSERT(is_small(res) || is_big(res) || res == am_undefined); + BIF_RET(res); + } + else if (ERTS_IS_ATOM_STR("recv_marker_bind", BIF_ARG_1)) { + /* receive_SUITE (emulator) */ + if (is_tuple_arity(BIF_ARG_2, 2)) { + Eterm *tp = tuple_val(BIF_ARG_2); + erts_msgq_recv_marker_bind(BIF_P, tp[1], tp[2]); BIF_RET(am_ok); } } else if (ERTS_IS_ATOM_STR("recv_marker_set_save", BIF_ARG_1)) { /* receive_SUITE (emulator) */ - if (is_internal_ref(BIF_ARG_2)) { - erts_msgq_recv_marker_set_save(BIF_P, BIF_ARG_2); - BIF_RET(am_ok); - } + erts_msgq_recv_marker_set_save(BIF_P, BIF_ARG_2); + BIF_RET(am_ok); } else if (ERTS_IS_ATOM_STR("recv_marker_clear", BIF_ARG_1)) { /* receive_SUITE (emulator) */ - if (is_internal_ref(BIF_ARG_2)) { - erts_msgq_recv_marker_clear(BIF_P, BIF_ARG_2); - BIF_RET(am_ok); - } + erts_msgq_recv_marker_clear(BIF_P, BIF_ARG_2); + BIF_RET(am_ok); } else if (ERTS_IS_ATOM_STR("block", BIF_ARG_1) || ERTS_IS_ATOM_STR("sleep", BIF_ARG_1)) { diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index ce2f7bf2ee..bd3669d896 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -369,7 +369,7 @@ erts_free_aligned_binary_bytes(byte* buf) ** These extra bytes where earlier (< R13B04) added by an alignment-bug ** in this code. Do we dare remove this in some major release (R14?) maybe? */ -#if defined(DEBUG) || defined(VALGRIND) +#if defined(DEBUG) || defined(VALGRIND) || defined(ADDRESS_SANITIZER) # define CHICKEN_PAD 0 #else # define CHICKEN_PAD (sizeof(void*) - 1) diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 4cfda963f3..e3f8dbe3a4 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -246,8 +246,8 @@ typedef struct { signed char set_save; signed char in_sigq; signed char in_msgq; - signed char prev_used_ix; - signed char next_used_ix; + signed char prev_ix; + signed char next_ix; #ifdef DEBUG signed char used; Process *proc; @@ -326,6 +326,7 @@ typedef struct { /* Common for inner and middle queue */ ErtsRecvMarkerBlock *recv_mrk_blk; + Sint64 recv_mrk_uniq; Sint len; /* NOT message queue length (see above) */ Uint32 flags; } ErtsSignalPrivQueues; diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 1c1d0737db..11473a18a5 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -2640,18 +2640,18 @@ recv_marker_deallocate(Process *c_p, ErtsRecvMarker *markp) ASSERT(blkp); ERTS_HDBG_CHK_RECV_MRKS(c_p); - nix = markp->next_used_ix; + nix = markp->next_ix; ASSERT(nix >= 0); ix = ERTS_RECV_MARKER_IX__(blkp, markp); if (nix == ix) { - ASSERT(markp->prev_used_ix == ix); + ASSERT(markp->prev_ix == ix); erts_free(ERTS_ALC_T_RECV_MARK_BLK, blkp); c_p->sig_qs.recv_mrk_blk = NULL; } else { - int pix = markp->prev_used_ix; + int pix = markp->prev_ix; ASSERT(pix >= 0); if (blkp->ref[ix] == am_undefined) { @@ -2665,15 +2665,15 @@ recv_marker_deallocate(Process *c_p, ErtsRecvMarker *markp) } #endif - - blkp->marker[pix].next_used_ix = nix; - blkp->marker[nix].prev_used_ix = pix; + blkp->marker[pix].next_ix = nix; + blkp->marker[nix].prev_ix = pix; if (blkp->used_ix == ix) blkp->used_ix = nix; - blkp->ref[ix] = make_small(blkp->free_ix); + blkp->marker[ix].next_ix = blkp->free_ix; blkp->free_ix = ix; + blkp->ref[ix] = am_free; #ifdef DEBUG markp->used = 0; #endif @@ -2718,9 +2718,28 @@ recv_marker_dequeue(Process *c_p, ErtsRecvMarker *markp) ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0); } + +static ERTS_INLINE Eterm +recv_marker_uniq(Process *c_p, Eterm *uniqp) +{ + Eterm res = *uniqp; + if (res == am_new_uniq) { + Sint64 val = c_p->sig_qs.recv_mrk_uniq++; + Uint hsz = ERTS_SINT64_HEAP_SIZE(val); + if (hsz == 0) + res = make_small((Sint) val); + else { + Eterm *hp = HAlloc(c_p, hsz); + res = erts_sint64_to_big(val, &hp); + } + *uniqp = res; + } + return res; +} + static ERTS_INLINE ErtsRecvMarker * recv_marker_alloc_block(Process *c_p, ErtsRecvMarkerBlock **blkpp, - int *ixp, Eterm mqref) + int *ixp, Eterm *uniqp) { ErtsRecvMarkerBlock *blkp; ErtsRecvMarker *markp; @@ -2730,15 +2749,15 @@ recv_marker_alloc_block(Process *c_p, ErtsRecvMarkerBlock **blkpp, sizeof(ErtsRecvMarkerBlock)); *blkpp = blkp; - /* Allocate marker for 'mqref' in index zero... */ + /* Allocate marker for 'uniqp' in index zero... */ *ixp = 0; - blkp->ref[0] = mqref; + blkp->ref[0] = recv_marker_uniq(c_p, uniqp); markp = &blkp->marker[0]; - markp->next_used_ix = markp->prev_used_ix = 0; + markp->next_ix = markp->prev_ix = 0; blkp->used_ix = 0; #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS - if (mqref == am_default) + if (*uniqp == am_default) blkp->default_recv_marker_ix = 0; else blkp->default_recv_marker_ix = -1; @@ -2746,10 +2765,13 @@ recv_marker_alloc_block(Process *c_p, ErtsRecvMarkerBlock **blkpp, /* Put the rest in a free list in the ref words... */ blkp->free_ix = 1; - for (ix = 1; ix < ERTS_RECV_MARKER_BLOCK_SIZE - 1; ix++) - blkp->ref[ix] = make_small(ix+1); - /* end of list... */ - blkp->ref[ERTS_RECV_MARKER_BLOCK_SIZE-1] = make_small(-1); + for (ix = 1; ix < ERTS_RECV_MARKER_BLOCK_SIZE; ix++) { + blkp->ref[ix] = am_free; + if (ix == ERTS_RECV_MARKER_BLOCK_SIZE - 1) + blkp->marker[ix].next_ix = -1; /* End of list */ + else + blkp->marker[ix].next_ix = ix + 1; + } blkp->unused = 0; blkp->pending_set_save_ix = -1; @@ -2801,12 +2823,12 @@ recv_marker_reuse(Process *c_p, int *ixp) if (blkp->ref[used_ix] == am_undefined) blkp->unused--; ix = used_ix; - blkp->used_ix = used_ix = markp->next_used_ix; + blkp->used_ix = used_ix = markp->next_ix; } else { int pix, nix; - ix = markp->next_used_ix; + ix = markp->next_ix; ASSERT(ix != used_ix); while (!0) { markp = &blkp->marker[ix]; @@ -2818,24 +2840,24 @@ recv_marker_reuse(Process *c_p, int *ixp) blkp->unused--; break; } - ix = markp->next_used_ix; + ix = markp->next_ix; ASSERT(ix != used_ix); } /* * Move this marker to be most recently - * allocated marker (prev_used_ix of used_ix), + * allocated marker (prev_ix of used_ix), * so that the search property still holds... */ - pix = markp->prev_used_ix; - nix = markp->next_used_ix; - blkp->marker[pix].next_used_ix = nix; - blkp->marker[nix].prev_used_ix = pix; + pix = markp->prev_ix; + nix = markp->next_ix; + blkp->marker[pix].next_ix = nix; + blkp->marker[nix].prev_ix = pix; - pix = blkp->marker[used_ix].prev_used_ix; - blkp->marker[used_ix].prev_used_ix = ix; - blkp->marker[pix].next_used_ix = ix; - markp->next_used_ix = used_ix; - markp->prev_used_ix = pix; + pix = blkp->marker[used_ix].prev_ix; + blkp->marker[used_ix].prev_ix = ix; + blkp->marker[pix].next_ix = ix; + markp->next_ix = used_ix; + markp->prev_ix = pix; } *ixp = ix; @@ -2863,16 +2885,18 @@ recv_marker_reuse(Process *c_p, int *ixp) static ERTS_INLINE ErtsRecvMarker * recv_marker_alloc(Process *c_p, ErtsRecvMarkerBlock **blkpp, - int *ixp, Eterm mqref) + int *ixp, Eterm *uniqp) { ErtsRecvMarkerBlock *blkp = *blkpp; ErtsRecvMarker *markp; int ix; - ASSERT(ERTS_RECV_MARKER_IS_VALID_REF(mqref)); + ASSERT(is_small(*uniqp) || is_big(*uniqp) || *uniqp == am_new_uniq + || *uniqp == am_default || *uniqp == NIL + || is_internal_ref(*uniqp)); if (!blkp) - return recv_marker_alloc_block(c_p, blkpp, ixp, mqref); + return recv_marker_alloc_block(c_p, blkpp, ixp, uniqp); ERTS_HDBG_CHK_RECV_MRKS(c_p); @@ -2884,24 +2908,26 @@ recv_marker_alloc(Process *c_p, ErtsRecvMarkerBlock **blkpp, } else { int used_ix = blkp->used_ix; - ASSERT(is_small(blkp->ref[ix])); - blkp->free_ix = signed_val(blkp->ref[ix]); + ASSERT(blkp->ref[ix] == am_free); markp = &blkp->marker[ix]; - markp->prev_used_ix = blkp->marker[used_ix].prev_used_ix; - markp->next_used_ix = used_ix; + blkp->free_ix = markp->next_ix; + ASSERT(-1 <= blkp->free_ix + && blkp->free_ix < ERTS_RECV_MARKER_BLOCK_SIZE); + markp->prev_ix = blkp->marker[used_ix].prev_ix; + markp->next_ix = used_ix; #ifdef DEBUG markp->used = !0; #endif - blkp->marker[markp->prev_used_ix].next_used_ix = ix; - blkp->marker[used_ix].prev_used_ix = ix; + blkp->marker[markp->prev_ix].next_ix = ix; + blkp->marker[used_ix].prev_ix = ix; } *ixp = ix; - blkp->ref[ix] = mqref; + blkp->ref[ix] = recv_marker_uniq(c_p, uniqp); #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS - if (mqref == am_default) { + if (*uniqp == am_default) { ASSERT(blkp->default_recv_marker_ix == -1); blkp->default_recv_marker_ix = ix; } @@ -2959,22 +2985,30 @@ recv_marker_insert(Process *c_p, ErtsRecvMarker *markp) ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0); } -void -erts_msgq_recv_marker_create_insert(Process *c_p, Eterm mqref) +Eterm +erts_msgq_recv_marker_create_insert(Process *c_p, Eterm uniq) { int ix; + Eterm new_uniq = uniq; ErtsRecvMarkerBlock **blkpp = &c_p->sig_qs.recv_mrk_blk; - ErtsRecvMarker *markp = recv_marker_alloc(c_p, blkpp, &ix, mqref); - if (markp) - recv_marker_insert(c_p, markp); + ErtsRecvMarker *markp = recv_marker_alloc(c_p, blkpp, &ix, &new_uniq); + if (!markp) + return am_undefined; + recv_marker_insert(c_p, markp); + ASSERT(is_small(new_uniq) + || is_big(new_uniq) + || new_uniq == am_default + || new_uniq == NIL + || is_internal_ref(new_uniq)); + return new_uniq; } void -erts_msgq_recv_marker_create_insert_set_save(Process *c_p, Eterm mqref) +erts_msgq_recv_marker_create_insert_set_save(Process *c_p, Eterm id) { int ix = -1; /* Shut up faulty warning... */ ErtsRecvMarkerBlock **blkpp = &c_p->sig_qs.recv_mrk_blk; - ErtsRecvMarker *markp = recv_marker_alloc(c_p, blkpp, &ix, mqref); + ErtsRecvMarker *markp = recv_marker_alloc(c_p, blkpp, &ix, &id); if (markp) { recv_marker_insert(c_p, markp); @@ -6496,12 +6530,16 @@ erl_proc_sig_hdbg_chk_recv_marker_block(Process *c_p) ErtsRecvMarker *markp = &blkp->marker[ix]; Eterm ref = blkp->ref[ix]; - ERTS_ASSERT(is_internal_ref(ref) #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS + ERTS_ASSERT(is_internal_ref(ref) || ref == am_default -#endif || ref == am_undefined || is_nil(ref)); +#else + ERTS_ASSERT(is_internal_ref(ref) + || ref == am_undefined + || is_nil(ref)); +#endif #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS if (ref == am_default) { @@ -6515,13 +6553,13 @@ erl_proc_sig_hdbg_chk_recv_marker_block(Process *c_p) ASSERT(markp->used); - pix = markp->prev_used_ix; - nix = markp->next_used_ix; + pix = markp->prev_ix; + nix = markp->next_ix; ERTS_ASSERT(0 <= pix && pix < ERTS_RECV_MARKER_BLOCK_SIZE); ERTS_ASSERT(0 <= nix && nix < ERTS_RECV_MARKER_BLOCK_SIZE); - ERTS_ASSERT(blkp->marker[pix].next_used_ix == ix); - ERTS_ASSERT(blkp->marker[nix].prev_used_ix == ix); + ERTS_ASSERT(blkp->marker[pix].next_ix == ix); + ERTS_ASSERT(blkp->marker[nix].prev_ix == ix); used++; ERTS_ASSERT(used <= ERTS_RECV_MARKER_BLOCK_SIZE); @@ -6539,11 +6577,11 @@ erl_proc_sig_hdbg_chk_recv_marker_block(Process *c_p) do { Eterm ref = blkp->ref[ix]; - ERTS_ASSERT(is_small(ref)); + ERTS_ASSERT(ref == am_free); ASSERT(!blkp->marker[ix].used); free++; ERTS_ASSERT(free < ERTS_RECV_MARKER_BLOCK_SIZE); - ix = signed_val(ref); + ix = blkp->marker[ix].next_ix; } while (ix >= 0); } diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h index 6f118971a2..f7e30468ea 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.h +++ b/erts/emulator/beam/erl_proc_sig_queue.h @@ -183,21 +183,6 @@ typedef struct { #define ERTS_RECV_MARKER_PASS_MAX 4 -#ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS -#define ERTS_RECV_MARKER_IS_VALID_USER_REF(VAL) \ - (is_internal_ref((VAL)) || (VAL) == am_default) -#else -#define ERTS_RECV_MARKER_IS_VALID_USER_REF(VAL) \ - (is_internal_ref((VAL))) -#endif - -#define ERTS_RECV_MARKER_IS_VALID_REF(VAL) \ - (ERTS_RECV_MARKER_IS_VALID_USER_REF((VAL)) || is_nil((VAL))) -#define ERTS_RECV_MARKER_IS_VALID_REF_VAL(VAL) \ - (ERTS_RECV_MARKER_IS_VALID_REF((VAL)) \ - || is_small((VAL)) || \ - (VAL) == am_undefined) - #define ERTS_SIG_HANDLE_REDS_MAX_PREFERED (CONTEXT_REDS/40) #ifdef ERTS_PROC_SIG_HARD_DEBUG @@ -1172,17 +1157,61 @@ erts_proc_sig_cleanup_non_msg_signal(ErtsMessage *sig); /** * * @brief Create and insert a receive marker at the end of the - * signal queue of the calling process. + * signal queue of the calling process unless the + * signal queue is empty. + * + * + * @param[in] c_p Pointer to process struct of + * currently executing process. + * + * @return A process unique integer + * identifying the unbound + * receive marker, or the atom + * 'undefined' if no marker was + * inserted. + */ +ERTS_GLB_INLINE Eterm erts_msgq_recv_marker_insert(Process *c_p); + +/** + * + * @brief Bind a previously inserted receive marker to a + * reference. + * + * + * @param[in] c_p Pointer to process struct of + * currently executing process. + * + * @param[in] insert_id Receive marker identifier return + * by erts_msgq_recv_marker_insert(). + * + * @param[in] bind_id An internal reference to bind the + * receive marker to. Other terms + * are allowed to be passed as well, + * but will be ignored. + */ +ERTS_GLB_INLINE void erts_msgq_recv_marker_bind(Process *c_p, + Eterm insert_id, + Eterm bind_id); + +/** + * + * @brief Create, insert, and bind a receive marker at the end + * of the signal queue of the calling process and unless + * the signal queue is empty. * * * @param[in] c_p Pointer to process struct of * currently executing process. * - * @param[in] mqref Reference (or atom 'default') - * to associate with the receive - * marker. + * @param[in] bind_id An internal reference, or the + * atom 'default' to bind the + * receive marker to. Other terms + * are allowed to be passed as well, + * but will be ignored. */ -ERTS_GLB_INLINE void erts_msgq_recv_marker_insert(Process *c_p, Eterm mqref); +ERTS_GLB_INLINE void erts_msgq_recv_marker_insert_bind(Process *c_p, + Eterm id); + /** * @@ -1193,24 +1222,26 @@ ERTS_GLB_INLINE void erts_msgq_recv_marker_insert(Process *c_p, Eterm mqref); * @param[in] c_p Pointer to process struct of * currently executing process. * - * @param[in] mqref Reference (or atom 'default') - * associated with a receive marker. + * @param[in] id Internal reference associated with + * a receive marker. Other terms + * are allowed to be passed as well, + * but will be ignored. */ -ERTS_GLB_INLINE void erts_msgq_recv_marker_set_save(Process *c_p, Eterm mqref); +ERTS_GLB_INLINE void erts_msgq_recv_marker_set_save(Process *c_p, Eterm id); /** * * @brief Clear receive marker corresponding to the argument - * mqref. + * id. * * * @param[in] c_p Pointer to process struct of * currently executing process. * - * @param[in] mqref Reference (or atom 'default') + * @param[in] id Reference (or atom 'default') * associated with a receive marker. */ -ERTS_GLB_INLINE void erts_msgq_recv_marker_clear(Process *c_p, Eterm mqref); +ERTS_GLB_INLINE void erts_msgq_recv_marker_clear(Process *c_p, Eterm id); /** @@ -1308,13 +1339,13 @@ extern Process *erts_dirty_process_signal_handler_max; /* Helpers... */ void erts_proc_sig_fetch__(Process *proc); Sint erts_proc_sig_fetch_msgq_len_offs__(Process *proc); -ERTS_GLB_INLINE int erts_msgq_eq_internal_ref__(Eterm ref1, Eterm ref2); +ERTS_GLB_INLINE int erts_msgq_eq_recv_mark_id__(Eterm term1, Eterm term2); ERTS_GLB_INLINE void erts_msgq_recv_marker_set_save__(Process *c_p, ErtsRecvMarkerBlock *blkp, ErtsRecvMarker *markp, int ix); -void erts_msgq_recv_marker_create_insert(Process *c_p, Eterm mqref); -void erts_msgq_recv_marker_create_insert_set_save(Process *c_p, Eterm mqref); +Eterm erts_msgq_recv_marker_create_insert(Process *c_p, Eterm id); +void erts_msgq_recv_marker_create_insert_set_save(Process *c_p, Eterm id); ErtsMessage **erts_msgq_pass_recv_markers(Process *c_p, ErtsMessage **markpp); void erts_msgq_remove_leading_recv_markers(Process *c_p); @@ -1424,23 +1455,40 @@ erts_proc_notify_new_sig(Process* rp, erts_aint32_t state, #endif ERTS_GLB_INLINE int -erts_msgq_eq_internal_ref__(Eterm ref1, Eterm ref2) +erts_msgq_eq_recv_mark_id__(Eterm term1, Eterm term2) { - Eterm *r1, *r2; - int i, a1, a2; + int ix, arity; + Eterm *tp1, *tp2; - ASSERT(is_internal_ref(ref1)); - ASSERT(is_internal_ref(ref2)); - - r1 = internal_ref_val(ref1); - a1 = (int) thing_arityval(*r1); - r2 = internal_ref_val(ref2); - a2 = (int) thing_arityval(*r2); +#ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS + ASSERT(term1 == am_free || term1 == am_undefined || term1 == NIL + || term1 == am_default || is_small(term1) || is_big(term1) + || is_internal_ref(term1)); + ASSERT(term2 == am_free || term2 == am_undefined || term2 == NIL + || term2 == am_default || is_small(term2) || is_big(term2) + || is_internal_ref(term2)); +#else + ASSERT(term1 == am_free || term1 == am_undefined || term1 == NIL + || is_small(term1) || is_big(term1) || is_internal_ref(term1)); + ASSERT(term2 == am_free || term2 == am_undefined || term2 == NIL + || is_small(term2) || is_big(term2) || is_internal_ref(term2)); +#endif + + if (term1 == term2) + return !0; + + if (!is_boxed(term1) || !is_boxed(term2)) + return 0; + + tp1 = boxed_val(term1); + tp2 = boxed_val(term2); - if (a1 != a2) + if (*tp1 != *tp2) return 0; - for (i = 1; i <= a1; i++) { - if (r1[i] != r2[i]) + + arity = (int) thing_arityval(*tp1); + for (ix = 1; ix <= arity; ix++) { + if (tp1[ix] != tp2[ix]) return 0; } return !0; @@ -1485,30 +1533,24 @@ erts_msgq_recv_marker_set_save__(Process *c_p, } ERTS_GLB_INLINE void -erts_msgq_recv_marker_clear(Process *c_p, Eterm mqref) +erts_msgq_recv_marker_clear(Process *c_p, Eterm id) { ErtsRecvMarkerBlock *blkp = c_p->sig_qs.recv_mrk_blk; int ix; - ASSERT(ERTS_RECV_MARKER_IS_VALID_USER_REF(mqref)); - - if (!blkp) - return; - + if (!is_small(id) && !is_big(id) && !is_internal_ref(id)) { #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS - if (mqref == am_default) { - ERTS_PROC_SIG_RECV_MARK_CLEAR_DEFAULT__(blkp); + if (id == am_default && blkp) + ERTS_PROC_SIG_RECV_MARK_CLEAR_DEFAULT__(blkp); +#endif return; } -#endif + if (!blkp) + return; + for (ix = 0; ix < ERTS_RECV_MARKER_BLOCK_SIZE; ix++) { - Eterm val = blkp->ref[ix]; - ASSERT(ERTS_RECV_MARKER_IS_VALID_REF_VAL(val)); - if (val == mqref - || (is_not_immed(val) - && is_not_immed(mqref) - && erts_msgq_eq_internal_ref__(val, mqref))) { + if (erts_msgq_eq_recv_mark_id__(blkp->ref[ix], id)) { blkp->unused++; blkp->ref[ix] = am_undefined; blkp->marker[ix].pass = ERTS_RECV_MARKER_PASS_MAX; @@ -1517,54 +1559,89 @@ erts_msgq_recv_marker_clear(Process *c_p, Eterm mqref) } } -ERTS_GLB_INLINE void -erts_msgq_recv_marker_insert(Process *c_p, Eterm mqref) +ERTS_GLB_INLINE Eterm +erts_msgq_recv_marker_insert(Process *c_p) { - ASSERT(ERTS_RECV_MARKER_IS_VALID_USER_REF(mqref)); - erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ); erts_proc_sig_fetch(c_p); erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ); + if (c_p->sig_qs.cont || c_p->sig_qs.first) + return erts_msgq_recv_marker_create_insert(c_p, am_new_uniq); + return am_undefined; +} + +ERTS_GLB_INLINE void erts_msgq_recv_marker_bind(Process *c_p, + Eterm insert_id, + Eterm bind_id) +{ + if (is_small(insert_id) || is_big(insert_id)) { + ErtsRecvMarkerBlock *blkp = c_p->sig_qs.recv_mrk_blk; + + if (blkp) { + int ix; + for (ix = 0; ix < ERTS_RECV_MARKER_BLOCK_SIZE; ix++) { + if (erts_msgq_eq_recv_mark_id__(blkp->ref[ix], insert_id)) { + if (is_internal_ref(bind_id)) + blkp->ref[ix] = bind_id; + else { + blkp->unused++; + blkp->ref[ix] = am_undefined; + blkp->marker[ix].pass = ERTS_RECV_MARKER_PASS_MAX; + } + break; + } + } + } + } +} + + +ERTS_GLB_INLINE void +erts_msgq_recv_marker_insert_bind(Process *c_p, Eterm id) +{ + if (is_internal_ref(id) #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS - if (mqref == am_default && c_p->sig_qs.recv_mrk_blk) - ERTS_PROC_SIG_RECV_MARK_CLEAR_DEFAULT__(c_p->sig_qs.recv_mrk_blk); + || id == am_default #endif + ) { - if (c_p->sig_qs.cont || c_p->sig_qs.first) - erts_msgq_recv_marker_create_insert(c_p, mqref); + erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ); + erts_proc_sig_fetch(c_p); + erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ); + +#ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS + if (c_p->sig_qs.recv_mrk_blk) + ERTS_PROC_SIG_RECV_MARK_CLEAR_DEFAULT__(c_p->sig_qs.recv_mrk_blk); +#endif + + if (c_p->sig_qs.cont || c_p->sig_qs.first) + (void) erts_msgq_recv_marker_create_insert(c_p, id); + } } ERTS_GLB_INLINE void -erts_msgq_recv_marker_set_save(Process *c_p, Eterm mqref) +erts_msgq_recv_marker_set_save(Process *c_p, Eterm id) { - ErtsRecvMarkerBlock *blkp = c_p->sig_qs.recv_mrk_blk; - - ASSERT(ERTS_RECV_MARKER_IS_VALID_USER_REF(mqref)); - - if (blkp) { - int ix; - for (ix = 0; ix < ERTS_RECV_MARKER_BLOCK_SIZE; ix++) { - Eterm val = blkp->ref[ix]; - ASSERT(ERTS_RECV_MARKER_IS_VALID_REF_VAL(val)); - if (val == mqref - || (is_not_immed(val) - && is_not_immed(mqref) - && erts_msgq_eq_internal_ref__(val, mqref))) { - ErtsRecvMarker *markp = &blkp->marker[ix]; - erts_msgq_recv_marker_set_save__(c_p, blkp, markp, ix); - return; /* Done... */ + if (is_internal_ref(id) +#ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS + || id == am_default +#endif + ) { + ErtsRecvMarkerBlock *blkp = c_p->sig_qs.recv_mrk_blk; + + if (blkp) { + int ix; + for (ix = 0; ix < ERTS_RECV_MARKER_BLOCK_SIZE; ix++) { + if (erts_msgq_eq_recv_mark_id__(blkp->ref[ix], id)) { + ErtsRecvMarker *markp = &blkp->marker[ix]; + erts_msgq_recv_marker_set_save__(c_p, blkp, markp, ix); + break; + } } } - } - /* Set to head of queue... */ - - if (c_p->sig_qs.first - && ERTS_SIG_IS_RECV_MARKER(c_p->sig_qs.first)) { - erts_msgq_remove_leading_recv_markers(c_p); } - c_p->sig_qs.save = &c_p->sig_qs.first; } ERTS_GLB_INLINE ErtsMessage * diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9df15d4b73..afb9fa1f55 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11924,6 +11924,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->sig_qs.cont_last = &p->sig_qs.cont; p->sig_qs.save = &p->sig_qs.first; p->sig_qs.recv_mrk_blk = NULL; + p->sig_qs.recv_mrk_uniq = MIN_SMALL; p->sig_qs.len = 0; p->sig_qs.nmsigs.next = NULL; p->sig_qs.nmsigs.last = NULL; @@ -12427,6 +12428,7 @@ void erts_init_empty_process(Process *p) p->sig_qs.cont_last = &p->sig_qs.cont; p->sig_qs.save = &p->sig_qs.first; p->sig_qs.recv_mrk_blk = NULL; + p->sig_qs.recv_mrk_uniq = MIN_SMALL; p->sig_qs.len = 0; p->sig_qs.nmsigs.next = NULL; p->sig_qs.nmsigs.last = NULL; diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c index 9766e76a83..d24bb727ce 100644 --- a/erts/emulator/beam/erl_sched_spec_pre_alloc.c +++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c @@ -32,6 +32,7 @@ # include "config.h" #endif +#if !defined(VALGRIND) && !defined(ADDRESS_SANITIZER) #include "erl_process.h" #include "erl_thr_progress.h" @@ -347,3 +348,4 @@ erts_sspa_process_remote_frees(erts_sspa_chunk_header_t *chdr, return res; } +#endif /* !defined(VALGRIND) && !defined(ADDRESS_SANITIZER) */ diff --git a/erts/emulator/beam/jit/instr_msg.cpp b/erts/emulator/beam/jit/instr_msg.cpp index f82effaca7..25e5300b4b 100644 --- a/erts/emulator/beam/jit/instr_msg.cpp +++ b/erts/emulator/beam/jit/instr_msg.cpp @@ -51,7 +51,7 @@ static ErtsMessage *decode_dist(Process *c_p, ErtsMessage *msgp) { #ifdef ERTS_SUPPORT_OLD_RECV_MARK_INSTRS static void recv_mark(Process *p) { - erts_msgq_recv_marker_insert(p, am_default); /* inlined here... */ + erts_msgq_recv_marker_insert_bind(p, am_default); /* inlined here... */ } static void recv_mark_set(Process *p) { diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index fb46aeabcc..bb09590b1b 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -2153,13 +2153,18 @@ void erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) { static int is_first_call = 1; - int virtual_map = 0; char *start = NULL, *end = NULL; UWord pagesize; + int virtual_map = 0; + + (void)virtual_map; + #if defined(__WIN32__) - SYSTEM_INFO sysinfo; - GetSystemInfo(&sysinfo); - pagesize = (UWord) sysinfo.dwPageSize; + { + SYSTEM_INFO sysinfo; + GetSystemInfo(&sysinfo); + pagesize = (UWord) sysinfo.dwPageSize; + } #elif defined(_SC_PAGESIZE) pagesize = (UWord) sysconf(_SC_PAGESIZE); #elif defined(HAVE_GETPAGESIZE) diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index c75afb14f3..7113ebc323 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -49,7 +49,8 @@ * See the following message on how MAP_NORESERVE was treated on FreeBSD: * <http://lists.llvm.org/pipermail/cfe-commits/Week-of-Mon-20150202/122958.html> */ -# if defined(MAP_FIXED) && (defined(MAP_NORESERVE) || defined(__FreeBSD__)) +# if (defined(MAP_FIXED) && (defined(MAP_NORESERVE) || defined(__FreeBSD__)) \ + && !defined(ADDRESS_SANITIZER)) # define ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION 1 # endif #endif diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index a277201056..4fc10cc4f3 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -49,6 +49,10 @@ #include <sys/ioctl.h> #endif +#ifdef ADDRESS_SANITIZER +# include <sanitizer/asan_interface.h> +#endif + #define ERTS_WANT_BREAK_HANDLING #define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ #include "sys.h" @@ -381,6 +385,9 @@ void erts_sys_sigsegv_handler(int signo) { */ int erts_sys_is_area_readable(char *start, char *stop) { +#ifdef ADDRESS_SANITIZER + return __asan_region_is_poisoned(start, stop-start) == NULL; +#else int fds[2]; if (!pipe(fds)) { /* We let write try to figure out if the pointers are readable */ @@ -395,7 +402,7 @@ erts_sys_is_area_readable(char *start, char *stop) { return 1; } return 0; - +#endif } static ERTS_INLINE int diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 51406c6934..a9c816efb5 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -19,8 +19,8 @@ -module(alloc_SUITE). -author('rickard.green@uab.ericsson.se'). --export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). - +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2, + init_per_suite/1, end_per_suite/1]). -export([basic/1, coalesce/1, threads/1, @@ -47,6 +47,18 @@ all() -> bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration, cpool_opt]. +init_per_suite(Config) -> + case test_server:is_asan() of + true -> + %% No point testing own allocators under address sanitizer. + {skip, "Address sanitizer"}; + false -> + Config + end. + +end_per_suite(_Config) -> + ok. + init_per_testcase(Case, Config) when is_list(Config) -> [{testcase, Case},{debug,false}|Config]. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index 8eb2bb9719..fd47688628 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -790,7 +790,12 @@ erlang_halt(Config) when is_list(Config) -> % This test triggers a segfault when dumping a crash dump % to make sure that we can handle it properly. + + %% Prevent address sanitizer from catching SEGV in slave node + AsanOpts = add_asan_opt("handle_segv=0"), {ok,N4} = slave:start(H, halt_node4), + reset_asan_opts(AsanOpts), + CrashDump = filename:join(proplists:get_value(priv_dir,Config), "segfault_erl_crash.dump"), true = rpc:call(N4, os, putenv, ["ERL_CRASH_DUMP",CrashDump]), @@ -808,6 +813,25 @@ erlang_halt(Config) when is_list(Config) -> ok end. +add_asan_opt(Opt) -> + case test_server:is_asan() of + true -> + case os:getenv("ASAN_OPTIONS") of + false -> + os:putenv("ASAN_OPTIONS", Opt), + undefined; + AO -> + os:putenv("ASAN_OPTIONS", AO ++ [$: | Opt]), + AO + end; + _ -> + false + end. + +reset_asan_opts(false) -> ok; +reset_asan_opts(undefined) -> os:unsetenv("ASAN_OPTIONS"); +reset_asan_opts(AO) -> os:putenv("ASAN_OPTIONS", AO). + wait_until_stable_size(_File,-10) -> {error,enoent}; wait_until_stable_size(File,PrevSz) -> diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 71df875efc..844d344ef3 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -258,7 +258,10 @@ alloc_blocks_size(Config) when is_list(Config) -> ok = rpc:call(Node, ?MODULE, do_alloc_blocks_size, []), true = test_server:stop_node(Node) end, - F("+Meamax"), + case test_server:is_asan() of + false -> F("+Meamax"); + true -> skip + end, F("+Meamin"), F(""), ok. diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index c4a700d1a7..86b4460b38 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -640,13 +640,18 @@ test_phash2_plus_bin_helper2(Bin, TransformerFun, ExtraBytes, ExtraBits, Expecte end. run_when_enough_resources(Fun) -> - case {total_memory(), erlang:system_info(wordsize)} of - {Mem, 8} when is_integer(Mem) andalso Mem >= 31 -> + Bits = 8 * erlang:system_info({wordsize,external}), + Mem = total_memory(), + Build = erlang:system_info(build_type), + + if Bits =:= 64, is_integer(Mem), Mem >= 31, + Build =/= valgrind, Build =/= asan -> Fun(); - {Mem, WordSize} -> + + true -> {skipped, - io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)", - [Mem, WordSize])} + io_lib:format("Not enough resources (System Memory = ~p, Bits = ~p, Build = ~p)", + [Mem, Bits, Build])} end. %% Total memory in GB diff --git a/erts/emulator/test/os_signal_SUITE.erl b/erts/emulator/test/os_signal_SUITE.erl index 6bafb0e18c..7bd8985dc7 100644 --- a/erts/emulator/test/os_signal_SUITE.erl +++ b/erts/emulator/test/os_signal_SUITE.erl @@ -275,6 +275,15 @@ t_sigalrm(_Config) -> ok. t_sigchld_fork(_Config) -> + case test_server:is_asan() of + true -> + %% Avoid false leak reports from forked process + {skip, "Address sanitizer"}; + false -> + sigchld_fork() + end. + +sigchld_fork() -> Pid1 = setup_service(), ok = os:set_signal(sigchld, handle), {ok,OsPid} = os_signal_SUITE:fork(), diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index 6af1a135e0..d9be11f4cc 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -57,7 +57,8 @@ init_per_testcase(erl_1199, Config) -> [{schedulers_online, SO}|Config]; init_per_testcase(MultiRecvOpt, Config) when MultiRecvOpt == multi_recv_opt; MultiRecvOpt == multi_recv_opt_clear -> - %% To be removed when we got compiler support... + %% To be removed when we got compiler support for new + %% recv marker instructions... erts_debug:set_internal_state(available_internal_state, true), Config; init_per_testcase(_, Config) -> @@ -468,11 +469,15 @@ multi_call(Srv) -> multi_call(_Srv, 0, _Msg, _Responses, _Clear, _Fun) -> ok; multi_call(Srv, N, Msg, Responses, Clear, Fun) -> - Mref = erlang:monitor(process, Srv), %% To be removed when we got compiler support... - erts_debug:set_internal_state(recv_marker_insert, Mref), + IId = erts_debug:set_internal_state(recv_marker_insert, ok), + + Mref = erlang:monitor(process, Srv), + %% To be removed when we got compiler support... + erts_debug:set_internal_state(recv_marker_bind, {IId, Mref}), + Srv ! {Mref, self(), Msg, Responses}, Fun(), multi_receive(Mref, Msg, Responses), @@ -481,8 +486,10 @@ multi_call(Srv, N, Msg, Responses, Clear, Fun) -> false -> ok; true -> + %% To be removed when we got compiler support... erts_debug:set_internal_state(recv_marker_clear, Mref) + end, multi_call(Srv, N-1, Msg, Responses, Clear, Fun). diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 575ef80e88..f617736e43 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -40,6 +40,7 @@ # -xxgdb FIXME currently disabled # -gcov Run emulator compiled for gcov # -valgrind Run emulator compiled for valgrind +# -asan Run emulator compiled for address-sanitizer # -lcnt Run emulator compiled for lock counting # -icount Run emulator compiled for instruction counting # -rr Run emulator under "rr record" @@ -73,8 +74,8 @@ GDBBP= GDBARGS= TYPE= FLAVOR= -debug= run_valgrind=no +run_asan=no run_rr=no skip_erlexec=no @@ -203,6 +204,12 @@ while [ $# -gt 0 ]; do run_valgrind=yes skip_erlexec=yes ;; + "-asan") + shift + cargs="$cargs -asan" + run_asan=yes + TYPE=.asan + ;; "-emu_type") shift cargs="$cargs -emu_type $1" @@ -265,6 +272,28 @@ if [ $skip_erlexec = yes ]; then set -- $beam_args IFS="$SAVE_IFS" fi +if [ $run_asan = yes ]; then + # Leak sanitizer options + if [ "x${LSAN_OPTIONS#*suppressions=}" = "x$LSAN_OPTIONS" ]; then + export LSAN_OPTIONS + if [ "x$ERL_TOP" != "x" ]; then + LSAN_OPTIONS="$LSAN_OPTIONS:suppressions=$ERL_TOP/erts/emulator/asan/suppress" + else + echo "No leak-sanitizer suppression file found in \$LSAN_OPTIONS" + echo "and \$ERL_TOP not set." + fi + fi + # Address sanitizer options + export ASAN_OPTIONS + if [ "x$ASAN_LOG_DIR" != "x" ]; then + if [ "x${ASAN_OPTIONS#*log_path=}" = "x$ASAN_OPTIONS" ]; then + ASAN_OPTIONS="$ASAN_OPTIONS:log_path=$ASAN_LOG_DIR/$EMU_NAME-$ASAN_LOGFILE_PREFIX-0" + fi + fi + if [ "x${ASAN_OPTIONS#*halt_on_error=}" = "x$ASAN_OPTIONS" ]; then + ASAN_OPTIONS="$ASAN_OPTIONS:halt_on_error=false" + fi +fi if [ "x$GDB" = "x" ]; then if [ $run_valgrind = yes ]; then valversion=`valgrind --version` diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in index 45ff7639d4..2851c8cb02 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -66,6 +66,11 @@ CFLAGS=@DEBUG_CFLAGS@ -DVALGRIND TYPE_SUFFIX=.valgrind PRE_LD= else +ifeq ($(TYPE),asan) +CFLAGS=@DEBUG_CFLAGS@ +TYPE_SUFFIX=.asan +PRE_LD= +else ifeq ($(TYPE),gprof) CFLAGS += -DGPROF -pg TYPE_SUFFIX=.gprof @@ -99,6 +104,7 @@ endif endif endif endif +endif OPSYS=@OPSYS@ sol2CFLAGS= diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 20c229dde4..afc5373278 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -21,7 +21,7 @@ -define(DEFAULT_TIMETRAP_SECS, 60). %%% TEST_SERVER_CTRL INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([run_test_case_apply/1,init_target_info/0,init_valgrind/0]). +-export([run_test_case_apply/1,init_target_info/0,init_memory_checker/0]). -export([cover_compile/1,cover_analyse/2]). %%% TEST_SERVER_SUP INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -48,10 +48,8 @@ -export([is_cover/0,is_debug/0,is_commercial/0]). -export([break/1,break/2,break/3,continue/0,continue/1]). +-export([is_valgrind/0, is_asan/0]). -%%% DEBUGGER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([valgrind_new_leaks/0, valgrind_format/2, - is_valgrind/0]). %%% PRIVATE EXPORTED %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -export([]). @@ -60,6 +58,7 @@ -include("test_server_internal.hrl"). -include_lib("kernel/include/file.hrl"). + init_target_info() -> [$.|Emu] = code:objfile_extension(), {_, OTPRel} = init:script_id(), @@ -73,8 +72,8 @@ init_target_info() -> username=test_server_sup:get_username(), cookie=atom_to_list(erlang:get_cookie())}. -init_valgrind() -> - valgrind_new_leaks(). +init_memory_checker() -> + check_memory_leaks(). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -367,19 +366,50 @@ stick_all_sticky(Node,Sticky) -> %% cover. run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> - case is_valgrind() of - false -> - ok; - true -> - valgrind_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), - os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ - atom_to_list(Func)++"-") - end, + MC = case {Func, memory_checker()} of + {init_per_suite, _} -> none; % skip init/end_per_suite/group + {init_per_group, _} -> none; % as CaseNum is always 0 + {end_per_group, _} -> none; + {end_per_suite, _} -> none; + {_, valgrind} -> + valgrind_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), + os:putenv("VALGRIND_LOGFILE_INFIX",atom_to_list(Mod)++"."++ + atom_to_list(Func)++"-"), + valgrind; + {_, asan} -> + %% Address sanitizer does not support printf in log file + %% but it lets us change the log file on the fly. So we use + %% that to give each test case its own log file. + case asan_take_logpath() of + false -> false; + {LogPath, OtherOpts} -> + LogDir = filename:dirname(LogPath), + LogFile = filename:basename(LogPath), + [Exe, App | _ ] = string:lexemes(LogFile, "-"), + NewLogFile = io_lib:format("~s-~s-tc-~4..0w-~w-~w", + [Exe,App,CaseNum, Mod, Func]), + NewLogPath = filename:join(LogDir, NewLogFile), + + %% Do leak check and then change asan log file + %% for this running beam executable. + erlang:system_info({memory_checker, check_leaks}), + _PrevLog = erlang:system_info({memory_checker, log, NewLogPath}), + + %% Set log file name for subnodes + %% that may be created by this test case + NewOpts = asan_make_opts(["log_path="++NewLogPath++".subnode" + | OtherOpts]), + os:putenv("ASAN_OPTIONS", NewOpts) + end, + asan; + {_, none} -> + node + end, ProcBef = erlang:system_info(process_count), Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData), ProcAft = erlang:system_info(process_count), - valgrind_new_leaks(), + check_memory_leaks(MC), DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. @@ -2053,7 +2083,8 @@ timetrap_scale_factor() -> { 3, fun() -> has_superfluous_schedulers() end}, { 6, fun() -> is_debug() end}, {10, fun() -> is_cover() end}, - {10, fun() -> is_valgrind() end} + {10, fun() -> is_valgrind() end}, + {2, fun() -> is_asan() end} ]). timetrap_scale_factor(Scales) -> @@ -2962,22 +2993,36 @@ is_commercial() -> %% %% Returns true if valgrind is running, else false is_valgrind() -> - case catch erlang:system_info({valgrind, running}) of - {'EXIT', _} -> false; - Res -> Res + memory_checker() =:= valgrind. + +%% Returns true if address-sanitizer is running, else false +is_asan() -> + memory_checker() =:= asan. + +%% Returns the error checker running (valgrind | asan | none). +memory_checker() -> + case catch erlang:system_info({memory_checker, running}) of + {'EXIT', _} -> none; + EC -> EC end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% DEBUGGER INTERFACE %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% valgrind_new_leaks() -> ok +%% check_memory_leaks() -> ok %% -%% Checks for new memory leaks if Valgrind is active. -valgrind_new_leaks() -> - catch erlang:system_info({valgrind, memory}), +%% Checks for memory leaks if Valgrind or Address-sanitizer is active. +check_memory_leaks() -> + check_memory_leaks(memory_checker()). + +check_memory_leaks(valgrind) -> + catch erlang:system_info({memory_checker, check_leaks}), + ok; +check_memory_leaks(_) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2987,9 +3032,31 @@ valgrind_new_leaks() -> %% %% Outputs the formatted string to Valgrind's logfile,if Valgrind is active. valgrind_format(Format, Args) -> - (catch erlang:system_info({valgrind, io_lib:format(Format, Args)})), + (catch erlang:system_info({valgrind, print, io_lib:format(Format, Args)})), ok. +asan_take_logpath() -> + case os:getenv("ASAN_OPTIONS") of + false -> false; + S -> + Opts = string:lexemes(S, ":"), + asan_take_logpath_loop(Opts, []) + end. + +asan_take_logpath_loop(["log_path="++LogPath | T], Acc) -> + {LogPath, T ++ Acc}; +asan_take_logpath_loop([Opt | T], Acc) -> + asan_take_logpath_loop(T, [Opt | Acc]); +asan_take_logpath_loop([], _) -> + false. + +asan_make_opts([A|T]) -> + asan_make_opts(T, A). + +asan_make_opts([], Acc) -> + Acc; +asan_make_opts([A|T], Acc) -> + asan_make_opts(T, A ++ [$: | Acc]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 995594dd59..dbd5537206 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -2195,7 +2195,7 @@ do_add_end_per_suite_and_skip(LastMod, LastRef, Mod, FwMod) -> %% Runs the specified tests, then displays/logs the summary. run_test_cases(TestSpec, Config, TimetrapData) -> - test_server:init_valgrind(), + test_server:init_memory_checker(), case lists:member(no_src, get(test_server_logopts)) of true -> ok; diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl index 7e12b9652c..ce454dce9c 100644 --- a/lib/common_test/test_server/ts_run.erl +++ b/lib/common_test/test_server/ts_run.erl @@ -197,17 +197,25 @@ make_command(Vars, Spec, State) -> {ok,Cwd} = file:get_cwd(), TestDir = State#state.test_dir, TestPath = filename:nativename(TestDir), - Erl = case os:getenv("TS_RUN_VALGRIND") of + Erl = case os:getenv("TS_RUN_EMU") of false -> ct:get_progname(); - _ -> + "valgrind" -> case State#state.file of Dir when is_list(Dir) -> os:putenv("VALGRIND_LOGFILE_PREFIX", Dir++"-"); _ -> ok end, - "cerl -valgrind" + "cerl -valgrind"; + "asan" -> + case State#state.file of + App when is_list(App) -> + os:putenv("ASAN_LOGFILE_PREFIX", App); + _ -> + ok + end, + "cerl -asan" end, Naming = case ts_lib:var(longnames, Vars) of @@ -261,9 +269,10 @@ run_batch(Vars, _Spec, State) -> ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]), io:format(user, "Command: ~ts~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof, exit_status]), - Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of + Timeout = 30000 * case os:getenv("TS_RUN_EMU") of false -> 1; - _ -> 100 + "valgrind" -> 100; + "asan" -> 2 end, tricky_print_data(Port, Timeout). diff --git a/lib/compiler/test/property_test/compile_prop.erl b/lib/compiler/test/property_test/compile_prop.erl index 5fdd6409d6..fde11d0677 100644 --- a/lib/compiler/test/property_test/compile_prop.erl +++ b/lib/compiler/test/property_test/compile_prop.erl @@ -43,7 +43,7 @@ compile() -> compile_1() -> Opts = [{resize,true}], - ?FORALL(Abstr, proper_abstr:module(Opts), + ?FORALL(Abstr, proper_erlang_abstract_code:module(Opts), ?WHENFAIL( begin io:format("~ts\n", [[erl_pp:form(F) || F <- Abstr]]), diff --git a/lib/compiler/test/random_code_SUITE.erl b/lib/compiler/test/random_code_SUITE.erl index 747a9aebd1..a24be35128 100644 --- a/lib/compiler/test/random_code_SUITE.erl +++ b/lib/compiler/test/random_code_SUITE.erl @@ -38,12 +38,12 @@ groups() -> init_per_suite(Config0) -> case ct_property_test:init_per_suite(Config0) of [_|_]=Config -> - try proper_abstr:module() of + try proper_erlang_abstract_code:module() of _ -> Config catch error:undef -> - {skip,"No proper_abstr module"} + {skip,"No proper_erlang_abstract_code module"} end; Other -> Other diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 8695946409..5aacef3310 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -1414,7 +1414,9 @@ test_raise_4(Expr) -> try do_test_raise_4(Expr) catch - exit:{exception,C,E,Stk}:Stk -> + exit:{exception,C,E,StkTerm}:Stk -> + %% it's not allowed to do the matching directly in the clause head + true = (Stk =:= StkTerm), try Expr() catch diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index b9ecc39f58..f962b7b9ad 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -59,11 +59,17 @@ TYPEMARKER = .gprof TYPE_EXTRA_CFLAGS = -DGPROF -pg TYPE_FLAGS = $(CFLAGS) $(TYPE_EXTRA_CFLAGS) else +ifeq ($(TYPE),asan) +TYPEMARKER = .asan +TYPE_FLAGS = $(CFLAGS) -fsanitize=address -fsanitize-recover=address -fno-omit-frame-pointer -DADDRESS_SANITIZER +LDFLAGS += -fsanitize=address +else TYPEMARKER = TYPE_FLAGS = $(CFLAGS) endif endif endif +endif # ---------------------------------------------------- # Release directory specification @@ -158,7 +164,7 @@ ALL_STATIC_CFLAGS = @DED_STATIC_CFLAGS@ $(TYPE_EXTRA_CFLAGS) $(CONFIGURE_ARGS) $ _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB) $(TEST_ENGINE_LIB) +debug opt valgrind asan: $(NIF_LIB) $(CALLBACK_LIB) $(TEST_ENGINE_LIB) static_lib: $(NIF_ARCHIVE) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 7bf6265166..5c0a1ccf6a 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -162,8 +162,8 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) const ERL_NIF_TERM* tpl_array; int vernum; ErlNifBinary lib_bin; - char lib_buf[1000]; #ifdef HAVE_DYNAMIC_CRYPTO_LIB + char lib_buf[1000]; void *handle; #endif diff --git a/lib/crypto/c_src/info.c b/lib/crypto/c_src/info.c index 573039203c..1d7e744995 100644 --- a/lib/crypto/c_src/info.c +++ b/lib/crypto/c_src/info.c @@ -26,6 +26,8 @@ char *crypto_callback_name = "crypto_callback.debug"; # elif defined(VALGRIND) char *crypto_callback_name = "crypto_callback.valgrind"; +# elif defined(ADDRESS_SANITIZER) +char *crypto_callback_name = "crypto_callback.asan"; # else char *crypto_callback_name = "crypto_callback"; # endif diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile index f48a79e8d1..b4926d6d7c 100644 --- a/lib/crypto/doc/src/Makefile +++ b/lib/crypto/doc/src/Makefile @@ -48,4 +48,4 @@ TOP_SPECS_FILE = specs.xml include $(ERL_TOP)/make/doc.mk -valgrind: +valgrind asan: diff --git a/lib/crypto/src/Makefile b/lib/crypto/src/Makefile index 1753ba4f36..c3f1c859e5 100644 --- a/lib/crypto/src/Makefile +++ b/lib/crypto/src/Makefile @@ -61,7 +61,7 @@ ERL_COMPILE_FLAGS += -DCRYPTO_VSN=\"$(VSN)\" -Werror -I../include # Targets # ---------------------------------------------------- -debug opt valgrind: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) +debug opt valgrind asan: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index f83866803b..a9c18a3779 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -2494,10 +2494,10 @@ get_test_engine() -> end. check_otp_test_engine(LibDir) -> - case filelib:wildcard("otp_test_engine*", LibDir) of - [] -> + case choose_otp_test_engine(LibDir) of + false -> {error, notexist}; - [LibName|_] -> % In case of Valgrind there could be more than one + LibName -> LibPath = filename:join(LibDir,LibName), case filelib:is_file(LibPath) of true -> @@ -2508,3 +2508,20 @@ check_otp_test_engine(LibDir) -> end. +choose_otp_test_engine(LibDir) -> + LibNames = filelib:wildcard("otp_test_engine.*", LibDir), + Type = atom_to_list(erlang:system_info(build_type)), + choose_otp_test_engine(LibNames, Type, false). + +choose_otp_test_engine([LibName | T], Type, Acc) -> + case string:lexemes(LibName, ".") of + [_, Type, _SO] -> + LibName; %% Choose typed if exists (valgrind,asan) + [_, _SO] -> + %% Fallback on typeless (opt) + choose_otp_test_engine(T, Type, LibName); + _ -> + choose_otp_test_engine(T, Type, Acc) + end; +choose_otp_test_engine([], _, Acc) -> + Acc. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index a95bfeb49e..2f25da2a37 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -1143,27 +1143,33 @@ handle_try(Tree, Map, State) -> Vars = cerl:try_vars(Tree), Body = cerl:try_body(Tree), Handler = cerl:try_handler(Tree), - {State1, Map1, ArgType} = traverse(Arg, Map, State), - Map2 = mark_as_fresh(Vars, Map1), - {SuccState, SuccMap, SuccType} = - case bind_pat_vars(Vars, t_to_tlist(ArgType), [], Map2, State1) of - {error, _, _, _, _} -> - {State1, map__new(), t_none()}; - {SuccMap1, VarTypes} -> - %% Try to bind the argument. Will only succeed if - %% it is a simple structured term. - SuccMap2 = - case bind_pat_vars_reverse([Arg], [t_product(VarTypes)], [], - SuccMap1, State1) of - {error, _, _, _, _} -> SuccMap1; - {SM, _} -> SM - end, - traverse(Body, SuccMap2, State1) - end, - ExcMap1 = mark_as_fresh(EVars, Map), - {State2, ExcMap2, HandlerType} = traverse(Handler, ExcMap1, SuccState), - TryType = t_sup(SuccType, HandlerType), - {State2, join_maps([ExcMap2, SuccMap], Map1), TryType}. + {State1, Map1, ArgType} = SMA = traverse(Arg, Map, State), + TypeList = t_to_tlist(ArgType), + if + length(Vars) =/= length(TypeList) -> + SMA; + true -> + Map2 = mark_as_fresh(Vars, Map1), + {SuccState, SuccMap, SuccType} = + case bind_pat_vars(Vars, TypeList, [], Map2, State1) of + {error, _, _, _, _} -> + {State1, map__new(), t_none()}; + {SuccMap1, VarTypes} -> + %% Try to bind the argument. Will only succeed if + %% it is a simple structured term. + SuccMap2 = + case bind_pat_vars_reverse([Arg], [t_product(VarTypes)], [], + SuccMap1, State1) of + {error, _, _, _, _} -> SuccMap1; + {SM, _} -> SM + end, + traverse(Body, SuccMap2, State1) + end, + ExcMap1 = mark_as_fresh(EVars, Map), + {State2, ExcMap2, HandlerType} = traverse(Handler, ExcMap1, SuccState), + TryType = t_sup(SuccType, HandlerType), + {State2, join_maps([ExcMap2, SuccMap], Map1), TryType} + end. %%---------------------------------------- diff --git a/lib/dialyzer/test/small_SUITE_data/results/try2 b/lib/dialyzer/test/small_SUITE_data/results/try2 new file mode 100644 index 0000000000..e96cb22057 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/try2 @@ -0,0 +1,2 @@ + +try2.erl:33: Function run3/2 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/src/try2.erl b/lib/dialyzer/test/small_SUITE_data/src/try2.erl new file mode 100644 index 0000000000..e85b241ca9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/try2.erl @@ -0,0 +1,46 @@ +-module(try2). +-export([main/0, run/2, run2/2, run3/2]). + +main() -> + try A = foo() of + _ -> A + after ok + end. + +foo() -> 1. + +run(Module, Args) -> + try + Module:main(Args), + halt(0) + catch + Class:Reason:StackTrace -> + format_exception(Class, Reason, StackTrace) + end. + +run2(Module, Args) -> + try + Result = Module:main(Args), + ok + of + ok -> + Result + catch + Class:Reason:StackTrace -> + format_exception(Class, Reason, StackTrace) + end. + +run3(Module, Args) -> %Function run3/2 has no local return + try + Result = error(badarg), + ok + of + ok -> + Result + catch + Class:Reason:StackTrace -> + format_exception(Class, Reason, StackTrace) + end. + +format_exception(Class, Reason, StackTrace) -> + erlang:raise(Class, Reason, StackTrace). diff --git a/lib/erl_interface/src/misc/ei_printterm.c b/lib/erl_interface/src/misc/ei_printterm.c index d7d3c0e3e3..0bad730095 100644 --- a/lib/erl_interface/src/misc/ei_printterm.c +++ b/lib/erl_interface/src/misc/ei_printterm.c @@ -87,24 +87,73 @@ static char *ei_big_to_str(erlang_big *b) { int buf_len; char *s,*buf; + unsigned int no_digits; unsigned short *sp; int i; + int printed; - buf_len = 64+b->is_neg+10*b->arity; - if ( (buf=malloc(buf_len)) == NULL) return NULL; + /* Number of 16-bit digits */ + no_digits = (b->arity + 1) / 2; + + if (no_digits <= 4) { + EI_ULONGLONG val; + buf_len = 22; + s = buf = malloc(buf_len); + if (!buf) + return NULL; + val = 0; + sp=b->digits; + for (i = 0; i < no_digits; i++) + val |= ((EI_ULONGLONG) sp[i]) << (i*16); + if (b->is_neg) + s += sprintf(s,"-"); + sprintf(s, "%llu", val); + return buf; + } - memset(buf,(char)0,buf_len); + /* big nums this large gets printed in base 16... */ + buf_len = (!!b->is_neg /* "-" */ + + 3 /* "16#" */ + + 4*no_digits /* 16-bit digits in base 16 */ + + 1); /* \0 */ + if ( (buf=malloc(buf_len)) == NULL) return NULL; s = buf; if ( b->is_neg ) - s += sprintf(s,"-"); - s += sprintf(s,"#integer(%d) = {",b->arity); - for(sp=b->digits,i=0;i<b->arity;i++) { - s += sprintf(s,"%d",sp[i]); - if ( (i+1) != b->arity ) - s += sprintf(s,","); + *(s++) = '-'; + *(s++) = '1'; + *(s++) = '6'; + *(s++) = '#'; + + sp = b->digits; + printed = 0; + for (i = no_digits - 1; i >= 0; i--) { + unsigned short val = sp[i]; + int j; + + for (j = 3; j >= 0; j--) { + char c = (char) ((val >> (j*4)) & 0xf); + if (c < 10) + c += '0'; + else + c += 'A' - 10; + + if (printed) + *(s++) = c; + else if (c != '0') { + *(s++) = c; + printed = !0; + } + } } - s += sprintf(s,"}"); + + if (!printed) { + /* very strange to encode zero like this... */ + *(s++) = '0'; + } + + + *s = '\0'; return buf; } diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl index 25dd95649d..43d74066a2 100644 --- a/lib/erl_interface/test/ei_print_SUITE.erl +++ b/lib/erl_interface/test/ei_print_SUITE.erl @@ -27,7 +27,8 @@ -export([all/0, suite/0, init_per_testcase/2, atoms/1, tuples/1, lists/1, strings/1, - maps/1, funs/1, binaries/1, bitstrings/1]). + maps/1, funs/1, binaries/1, bitstrings/1, + integers/1]). -import(runner, [get_term/1]). @@ -38,7 +39,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [atoms, tuples, lists, strings, maps, funs, binaries, bitstrings]. + [atoms, tuples, lists, strings, maps, funs, binaries, bitstrings, integers]. init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). @@ -198,6 +199,69 @@ bitstrings(Config) -> runner:recv_eot(P), ok. +integers(Config) -> + Port = runner:start(Config, ?integers), + + test_integers(Port, -1000, 1000), + test_integers(Port, (1 bsl 27) - 1000, (1 bsl 27) + 1000), + test_integers(Port, -(1 bsl 27) - 1000, -(1 bsl 27) + 1000), + test_integers(Port, (1 bsl 28) - 1000, (1 bsl 28) + 1000), + test_integers(Port, -(1 bsl 28) - 1000, -(1 bsl 28) + 1000), + test_integers(Port, (1 bsl 31) - 1000, (1 bsl 31) + 1000), + test_integers(Port, -(1 bsl 31) - 1000, -(1 bsl 31) + 1000), + test_integers(Port, (1 bsl 32) - 1000, (1 bsl 32) + 1000), + test_integers(Port, -(1 bsl 32) - 1000, -(1 bsl 32) + 1000), + test_integers(Port, (1 bsl 60) - 1000, (1 bsl 60) + 1000), + test_integers(Port, -(1 bsl 60) - 1000, -(1 bsl 60) + 1000), + test_integers(Port, 16#feeddeaddeadbeef - 1000, 16#feeddeaddeadbeef + 1000), + test_integers(Port, -16#feeddeaddeadbeef - 1000, -16#feeddeaddeadbeef + 1000), + test_integers(Port, (1 bsl 64) - 1000, (1 bsl 64) + 1000), + test_integers(Port, 16#addfeeddeaddeadbeef - 1000, 16#addfeeddeaddeadbeef + 1000), + test_integers(Port, -16#addfeeddeaddeadbeef - 1000, -16#addfeeddeaddeadbeef + 1000), + test_integers(Port, -(1 bsl 64) - 1000, -(1 bsl 64) + 1000), + test_integers(Port, (1 bsl 8192) - 1000, (1 bsl 8192) + 1000), + test_integers(Port, -(1 bsl 8192) - 1000, -(1 bsl 8192) + 1000), + + "done" = send_term_get_printed(Port, done), + + runner:recv_eot(Port), + + ok. + +test_integer(Port, Int, Print) when is_integer(Int) -> + Res = send_term_get_printed(Port, Int), + case Print of + true -> + io:format("Res: ~s~n", [Res]); + false -> + ok + end, + %% Large bignums are printed in base 16... + Exp = case Res of + "16#" ++ _ -> + "16#" ++ integer_to_list(Int, 16); + "-16#" ++ _ -> + "-16#" ++ integer_to_list(-1*Int, 16); + _ -> + integer_to_list(Int) + end, + case Exp =:= Res of + true -> + ok; + false -> + io:format("Exp: ~s~nRes: ~s~n", [Exp, Res]), + ct:fail({Exp, Res}) + end. + +test_integers(Port, FromInt, ToInt) -> + test_integers(Port, FromInt, ToInt, true). + +test_integers(_Port, FromInt, ToInt, _Print) when FromInt > ToInt -> + ok; +test_integers(Port, FromInt, ToInt, Print) -> + ok = test_integer(Port, FromInt, Print), + NewFromInt = FromInt + 1, + test_integers(Port, NewFromInt, ToInt, NewFromInt == ToInt). send_term_get_printed(Port, Term) -> diff --git a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c index 4b23701e82..b840c4aca0 100644 --- a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c +++ b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c @@ -345,3 +345,70 @@ TESTCASE(bitstrings) } report(1); } + +TESTCASE(integers) +{ + char *buf; + long len; + int err, n, index, done; + ei_x_buff x; + + ei_init(); + + done = 0; + do { + int type, type_len; + buf = read_packet(NULL); + + index = 0; + err = ei_decode_version(buf, &index, NULL); + if (err != 0) + fail1("ei_decode_version returned %d", err); + err = ei_get_type(buf, &index, &type, &type_len); + if (err) + fail1("ei_get_type() returned %d", err); + switch (type) { + case ERL_SMALL_INTEGER_EXT: + case ERL_INTEGER_EXT: { + long val; + err = ei_decode_long(buf, &index, &val); + if (err) + fail1("ei_decode_long() returned %d", err); + break; + } + case ERL_SMALL_BIG_EXT: + case ERL_LARGE_BIG_EXT: { + erlang_big *big = ei_alloc_big(type_len); + if (!big) + fail1("ei_alloc_big() failed %d", ENOMEM); + err = ei_decode_big(buf, &index, big); + if (err) + fail1("ei_decode_big() failed %d", err); + ei_free_big(big); + break; + } + case ERL_ATOM_EXT: { + char abuf[MAXATOMLEN]; + err = ei_decode_atom(buf, &index, &abuf[0]); + if (err) + fail1("ei_decode_atom() failed %d", err); + if (strcmp("done", &abuf[0]) == 0) + done = 1; + break; + } + default: + fail1("Unexpected type %d", type); + break; + } + + ei_x_new(&x); + ei_x_append_buf(&x, buf, index); + send_printed_buf(&x); + ei_x_free(&x); + + free_packet(buf); + + } while (!done); + + report(1); +} diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index d4f707951d..74cf089918 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -446,10 +446,16 @@ MaxT = TickTime + TickTime / 4</code> using this service.</p> <p>Defaults to <c>false</c>.</p> </item> - <tag><c>shell_history = enabled | disabled </c></tag> + <tag><c>shell_history = enabled | disabled | module()</c></tag> <item> <p>Specifies whether shell history should be logged to disk - between usages of <c>erl</c>.</p> + between usages of <c>erl</c> (<c>enabled</c>), not logged + at all (<c>disabled</c>), or a user-specified module will + be used to log shell history. This module should export + <c>load() -> [string()]</c> returning a list of strings to + load in the shell when it starts, and <c>add(iodata()) -> ok.</c> + called every time new line is entered in the shell. By default + logging is disabled.</p> </item> <tag><c>shell_history_drop = [string()]</c></tag> <item> diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl index bbe5a8077e..c196b0c1a9 100644 --- a/lib/kernel/src/group_history.erl +++ b/lib/kernel/src/group_history.erl @@ -73,8 +73,10 @@ load() -> % the node is shutting down. Ignore it. exit:_ -> [] end; - _ -> - [] + disabled -> + []; + Provider -> + Provider:load() end. %% @doc adds a log line to the erlang history log, if configured to do so. @@ -98,7 +100,9 @@ add(Line, enabled) -> ok end; add(_Line, disabled) -> - ok. + ok; +add(Line, Provider) -> + lists:member(Line, to_drop()) orelse Provider:add(Line). %%%%%%%%%%%%%%% %%% PRIVATE %%% @@ -129,13 +133,13 @@ repair_log(Name) -> load(). %% Return whether the shell history is enabled or not --spec history_status() -> enabled | disabled. +-spec history_status() -> enabled | disabled | module(). history_status() -> %% Don't run for user proc or if the emulator's tearing down Skip = is_user() orelse not init_running(), case application:get_env(kernel, shell_history) of - {ok, enabled} when not Skip -> - enabled; + {ok, Atom} when not Skip, is_atom(Atom) -> + Atom; undefined when not Skip -> ?DEFAULT_STATUS; _ -> diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index a77e9cb856..ada0823b0a 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -77,16 +77,16 @@ old_solaris_cases() -> extensive_cases() -> [api_open_close, api_listen, api_connect_init, - api_opts, xfer_min, xfer_active, def_sndrcvinfo, implicit_inet6, - open_multihoming_ipv4_socket, - open_unihoming_ipv6_socket, - open_multihoming_ipv6_socket, - open_multihoming_ipv4_and_ipv6_socket, active_n, - xfer_stream_min, peeloff_active_once, - peeloff_active_true, peeloff_active_n, buffers, - names_unihoming_ipv4, names_unihoming_ipv6, - names_multihoming_ipv4, names_multihoming_ipv6, - recv_close]. + api_opts, xfer_min, xfer_active, def_sndrcvinfo, implicit_inet6, + open_multihoming_ipv4_socket, + open_unihoming_ipv6_socket, + open_multihoming_ipv6_socket, + open_multihoming_ipv4_and_ipv6_socket, active_n, + xfer_stream_min, peeloff_active_once, + peeloff_active_true, peeloff_active_n, buffers, + names_unihoming_ipv4, names_unihoming_ipv6, + names_multihoming_ipv4, names_multihoming_ipv6, + recv_close]. init_per_suite(_Config) -> case gen_sctp:open() of @@ -757,8 +757,24 @@ do_implicit_inet6(_Config) -> %% Second ?P("try create server socket (2)"), - Localhost = log_ok(inet:getaddr("localhost", inet6)), - S2 = log_ok(gen_sctp:open(0, [{ip,Localhost}])), + Localhost = + case inet:getaddr("localhost", inet6) of + {ok, LH} -> + LH; + {error, nxdomain = Reason_getaddr} -> + ?SKIPT(Reason_getaddr); + {error, Reason_getaddr} -> + ?line ct:fail({unexpected, Reason_getaddr}) + end, + S2 = case gen_sctp:open(0, [{ip, Localhost}]) of + {ok, S} -> + S; + {error, nxdomain = Reason_open} -> + ?SKIPT(Reason_open); + {error, Reason_open} -> + ?line ct:fail({unexpected, Reason_open}) + end, + ?P("*** ~s: ~p ***", ["localhost", Localhost]), implicit_inet6(S2, Localhost), ok = gen_sctp:close(S2), @@ -1497,10 +1513,16 @@ mk_data(_, _, Bin) -> %% Test opening a multihoming ipv4 socket. open_multihoming_ipv4_socket(Config) when is_list(Config) -> + ?P("get addrs by family (inet)"), case get_addrs_by_family(inet, 2) of {ok, [Addr1, Addr2]} -> + ?P("got addrs: " + "~n Addr1: ~p" + "~n Addr2: ~p", [Addr1, Addr2]), do_open_and_connect([Addr1, Addr2], Addr1); {error, Reason} -> + ?P("failed get addrs: " + "~n ~p", [Reason]), {skip, Reason} end. @@ -1655,10 +1677,16 @@ get_addrs_by_family(Family, NumAddrs) -> get_addrs_by_family_aux(Family, NumAddrs) when Family =:= inet; Family =:= inet6 -> case inet:getaddr(localhost, Family) of - {error,eafnosupport} -> - {skip, ?F("No support for ~p", Family)}; + {error, eafnosupport = Reason} -> + ?P("failed get (~w) addrs for localhost: ~p", [Family, Reason]), + {error, ?F("No support for ~p (~p)", [Family, Reason])}; + {error, nxdomain = Reason} -> + ?P("failed get (~w) addrs for localhost: ~p", [Family, Reason]), + {error, ?F("No support for ~p (~p)", [Family, Reason])}; {ok, _} -> + ?P("got addr for localhost (ignored)"), IfAddrs = ok(inet:getifaddrs()), + ?P("IfAddrs: ~p", [IfAddrs]), case filter_addrs_by_family(IfAddrs, Family) of Addrs when length(Addrs) >= NumAddrs -> {ok, lists:sublist(Addrs, NumAddrs)}; @@ -1672,10 +1700,14 @@ get_addrs_by_family_aux(Family, NumAddrs) when Family =:= inet; end end; get_addrs_by_family_aux(inet_and_inet6, NumAddrs) -> - catch {ok, [case get_addrs_by_family_aux(Family, NumAddrs) of - {ok, Addrs} -> Addrs; - {error, Reason} -> throw({error, Reason}) - end || Family <- [inet, inet6]]}. + try {ok, [case get_addrs_by_family_aux(Family, NumAddrs) of + {ok, Addrs} -> Addrs; + {error, Reason} -> throw({error, Reason}) + end || Family <- [inet, inet6]]} + catch + throw:{error, _} = ERROR -> + ERROR + end. filter_addrs_by_family(IfAddrs, Family) -> lists:flatten([[Addr || {addr, Addr} <- Info, diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 07b83dd79d..e09b3750ac 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -2742,6 +2742,7 @@ recvtclass(Config) -> %% platforms - change {unix,_} to false? %% pktoptions is not supported for IPv4 +recvtos_ok({unix,netbsd}, _OSVer) -> false; recvtos_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,8,0}); recvtos_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,4,0}); %% Using the option returns einval, so it is not implemented. @@ -2754,6 +2755,7 @@ recvtos_ok({unix,_}, _) -> true; recvtos_ok(_, _) -> false. %% pktoptions is not supported for IPv4 +recvttl_ok({unix,netbsd}, _OSVer) -> false; recvttl_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,8,0}); recvttl_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,4,0}); %% Using the option returns einval, so it is not implemented. @@ -2766,6 +2768,7 @@ recvttl_ok({unix,_}, _) -> true; recvttl_ok(_, _) -> false. %% pktoptions is not supported for IPv6 +recvtclass_ok({unix,netbsd}, _OSVer) -> false; recvtclass_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,8,0}); recvtclass_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,4,0}); recvtclass_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index a71237e11f..2e9080d2ac 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -754,6 +754,8 @@ recvtos_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {17,6,0}); %% Using the option returns einval, so it is not implemented. recvtos_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,8,0}); %% Using the option returns einval, so it is not implemented. +recvtos_ok({unix,netbsd}, _OSVer) -> false; +%% Using the option returns einval, so it is not implemented. recvtos_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); %% recvtos_ok({unix,_}, _) -> true; @@ -781,6 +783,7 @@ recvtclass_ok(_, _) -> false. %% Using the option returns einval, so it is not implemented. sendtos_ok({unix,darwin}, OSVer) -> not semver_lt(OSVer, {19,0,0}); +sendtos_ok({unix,netbsd}, OSVer) -> false; sendtos_ok({unix,openbsd}, OSVer) -> not semver_lt(OSVer, {6,8,0}); sendtos_ok({unix,sunos}, OSVer) -> not semver_lt(OSVer, {5,12,0}); sendtos_ok({unix,linux}, OSVer) -> not semver_lt(OSVer, {4,0,0}); diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index f058b53497..0dc02e55f0 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, get_columns_and_rows/1, exit_initial/1, job_control_local/1, - job_control_remote/1,stop_during_init/1, + job_control_remote/1,stop_during_init/1, custom_shell_history/1, job_control_remote_noshell/1,ctrl_keys/1, get_columns_and_rows_escript/1, remsh/1, remsh_longnames/1, remsh_no_epmd/1]). @@ -30,6 +30,8 @@ -export([init_per_testcase/2, end_per_testcase/2]). %% For spawn -export([toerl_server/3]). +%% Exports for custom shell history module +-export([load/0, add/1]). init_per_testcase(_Func, Config) -> Config. @@ -45,7 +47,7 @@ all() -> [get_columns_and_rows_escript,get_columns_and_rows, exit_initial, job_control_local, job_control_remote, job_control_remote_noshell, - ctrl_keys, stop_during_init, + ctrl_keys, stop_during_init, custom_shell_history, remsh, remsh_longnames, remsh_no_epmd]. groups() -> @@ -216,13 +218,34 @@ stop_during_init(Config) when is_list(Config) -> {error, Reason2} -> {skip, Reason2}; Tempdir -> - XArg = " -kernel shell_history true -s init stop", + XArg = " -kernel shell_history enabled -s init stop", start_runerl_command(RunErl, Tempdir, "\\\""++Erl++"\\\""++XArg), {ok, Binary} = file:read_file(filename:join(Tempdir, "erlang.log.1")), nomatch = binary:match(Binary, <<"*** ERROR: Shell process terminated! ***">>) end end. +custom_shell_history(Config) when is_list(Config) -> + case proplists:get_value(default_shell, Config) of + old -> {skip, "Not supported in old shell"}; + new ->%% Up key: Ctrl + P = Cp=[$\^p] + rtnode([ + {putline, ""}, + {putline, [$\^p]}, + {putline_raw, ""}, + {getline, "0"}, + {putline, "echo."}, + {getline, "!echo"} %% exclamation sign is printed by custom history module + ], [], [], " -kernel shell_history " ++ atom_to_list(?MODULE) ++ + " -pz " ++ filename:dirname(code:which(?MODULE))) + end. + +load() -> + ["0.\n\n"]. + +add(_Line) -> + io:format("!", []). + %% Tests that local shell can be started by means of job control. job_control_local(Config) when is_list(Config) -> case proplists:get_value(default_shell,Config) of @@ -766,7 +789,7 @@ start_runerl_node(RunErl,Erl,Tempdir,Nodename,Args) -> start_runerl_command(RunErl, Tempdir, Cmd) -> FullCmd = "\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++" \""++Cmd++"\"", - ct:pal("~s",[FullCmd]), + ct:pal("~ts",[FullCmd]), os:cmd(FullCmd). start_toerl_server(ToErl,Tempdir) -> diff --git a/lib/megaco/test/megaco_mess_SUITE.erl b/lib/megaco/test/megaco_mess_SUITE.erl index be523f42a2..9ff3ac1468 100644 --- a/lib/megaco/test/megaco_mess_SUITE.erl +++ b/lib/megaco/test/megaco_mess_SUITE.erl @@ -13324,17 +13324,17 @@ otp_8183_request1(Config) when is_list(Config) -> try_tc(otp8183r1, Pre, Case, Post). do_otp_8183_request1([MgNode]) -> - d("[MG] start the simulator "), + i("[MG] start the simulator "), {ok, Mg} = megaco_test_megaco_generator:start_link("MG", MgNode), - d("[MG] create the event sequence"), + i("[MG] create the event sequence"), MgMid = {deviceName,"mg"}, MgEvSeq = otp_8183_r1_mg_event_sequence(MgMid), i("wait some time before starting the MG simulation"), sleep(1000), - d("[MG] start the simulation"), + i("[MG] start the simulation"), {ok, MgId} = megaco_test_megaco_generator:exec(Mg, MgEvSeq), i("await the transport module service change send_message event"), @@ -13357,11 +13357,13 @@ do_otp_8183_request1([MgNode]) -> i("wait some before issuing the notify reply (twice)"), sleep(500), - i("send the notify reply - twice"), + i("create notify reply"), NotifyReply = otp_8183_r1_mgc_notify_reply_msg(MgcMid, TransId2, Cid2, TermId2), + i("send the first notify reply"), megaco_test_generic_transport:incomming_message(Pid, NotifyReply), sleep(100), %% This is to "make sure" the events come in the "right" order + i("send the second notify reply"), megaco_test_generic_transport:incomming_message(Pid, NotifyReply), d("await the generator reply"), diff --git a/lib/megaco/test/megaco_test_generic_transport.erl b/lib/megaco/test/megaco_test_generic_transport.erl index cd387f748a..62ffcfbdf1 100644 --- a/lib/megaco/test/megaco_test_generic_transport.erl +++ b/lib/megaco/test/megaco_test_generic_transport.erl @@ -75,7 +75,8 @@ start(RH) -> start_transport() -> %% GS_ARGS = [{debug,[trace]}], GS_ARGS = [], - {ok, Pid} = gen_server:start_link({local, ?SERVER}, ?MODULE, [self()], GS_ARGS), + {ok, Pid} = gen_server:start_link({local, ?SERVER}, ?MODULE, [self()], + GS_ARGS), unlink(Pid), {ok, Pid}. @@ -94,15 +95,25 @@ stop() -> %%---------------------------------------------------------------------- send_message(SendHandle, Bin) -> + d("send_message -> entry with" + "~n SendHandle: ~p", [SendHandle]), call({transport, {send_message, SendHandle, Bin}}). send_message(SendHandle, Bin, Resend) -> + d("send_message -> entry with" + "~n SendHandle: ~p" + "~n Resend: ~p", [SendHandle, Resend]), call({transport, {send_message, SendHandle, Bin, Resend}}). resend_message(SendHandle, Bin) -> + d("resend_message -> entry with" + "~n SendHandle: ~p", [SendHandle]), call({transport, {resend_message, SendHandle, Bin}}). incomming_message(Pid, Msg) -> + d("incomming_message -> entry with" + "~n Pid: ~p" + "~n Msg: ~p", [Pid, Msg]), cast(Pid, {incomming_message, Msg}). @@ -138,6 +149,8 @@ handle_call({connect, _Sup, Opts}, _From, State) -> SendHandle = self(), ControlPid = self(), Reply = {ok, SendHandle, ControlPid}, + d("handle_call(connect) -> done when" + "~n Reply: ~p", [Reply]), {reply, Reply, State#state{controller = Controller, receive_handle = ReceiveHandle}}; @@ -149,7 +162,10 @@ handle_call({listen, _Sup, Opts}, _From, State) -> SendHandle = self(), ControlPid = self(), Reply = {ok, SendHandle, ControlPid}, + d("handle_call(listen) -> inform controller"), Controller ! {listen, ReceiveHandle, SendHandle, ControlPid}, + d("handle_call(listen) -> done when" + "~n Reply: ~p", [Reply]), {reply, Reply, State#state{controller = Controller, receive_handle = ReceiveHandle}}; @@ -164,6 +180,8 @@ handle_call({transport, Event}, _From, d("handle_call(transport) -> entry with" "~n Event: ~p", [Event]), Reply = handle_transport(Pid, RH, Event), + d("handle_call(transport) -> done when" + "~n Reply: ~p", [Reply]), {reply, Reply, State}; handle_call(Req, From, State) -> diff --git a/lib/megaco/test/megaco_test_megaco_generator.erl b/lib/megaco/test/megaco_test_megaco_generator.erl index 4eedd8d731..57cc6bda28 100644 --- a/lib/megaco/test/megaco_test_megaco_generator.erl +++ b/lib/megaco/test/megaco_test_megaco_generator.erl @@ -426,7 +426,7 @@ handle_exec({megaco_start_user, Mid, RecvInfo, Conf}, State) -> {ok, State1}; handle_exec(megaco_stop_user, #state{mid = Mid} = State) - when Mid /= undefined -> + when Mid =/= undefined -> p("stop megaco user: ~p", [Mid]), megaco_cleanup(State), ok = megaco:stop_user(Mid), @@ -435,7 +435,7 @@ handle_exec(megaco_stop_user, #state{mid = Mid} = State) handle_exec(start_transport, #state{recv_handle = #megaco_receive_handle{send_mod = TM}} = State) -> p("start transport ~p", [TM]), - case (catch TM:start_transport()) of + try TM:start_transport() of {ok, Sup} -> d("transport started: Sup: ~p", [Sup]), {ok, State#state{transport_sup = Sup}}; @@ -447,6 +447,13 @@ handle_exec(start_transport, e("failed starting transport (~w): " "~n ~p", [TM, Crap]), error({failed_starting_transport, TM, Crap}) + catch + C:E:S -> + e("failed starting transport (~w) - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [TM, C, E, S]), + error({failed_starting_transport, TM, {E, E, S}}) end; handle_exec({listen, Opts0, MaybeRetry}, @@ -457,33 +464,63 @@ handle_exec({listen, Opts0, MaybeRetry}, {port, Port}, {receive_handle, RH}, {tcp_options, [{nodelay, true}]} | Opts0], - case (catch handle_exec_listen_tcp(Pid, Opts, MaybeRetry)) of + try handle_exec_listen_tcp(Pid, Opts, MaybeRetry) of ok -> + p("listen(tcp) -> ok"), {ok, State}; Else -> + e("failed tcp listen: " + "~n Else: ~p", [Else]), error({tcp_listen_failed, Opts0, Else}) + catch + C:E:S -> + e("failed starting transport (~w) - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({tc_listen_failed, Opts0, {E, E, S}}) end; handle_exec({listen, Opts0, _MaybeRetry}, #state{recv_handle = RH, port = Port, transport_sup = Pid} = State) when RH#megaco_receive_handle.send_mod =:= megaco_udp -> p("listen(udp) - open"), Opts = [{module, ?DELIVER_MOD}, {port, Port}, {receive_handle, RH}|Opts0], - case (catch megaco_udp:open(Pid, Opts)) of + try megaco_udp:open(Pid, Opts) of {ok, _SH, _CtrlPid} -> + p("listen(udp) -> ok"), {ok, State}; Else -> + e("[listen] failed udp open: " + "~n Else: ~p", [Else]), error({udp_open, Opts0, Else}) + catch + C:E:S -> + e("[listen] failed udp open - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({udp_open, Opts0, {C, E, S}}) end; handle_exec({listen, Opts0, _MaybeRetry}, #state{recv_handle = RH, port = Port, transport_sup = Pid} = State) when RH#megaco_receive_handle.send_mod =:= megaco_test_generic_transport -> p("listen(generic)"), Opts = [{module, ?DELIVER_MOD}, {port, Port}, {receive_handle, RH}|Opts0], - case (catch megaco_test_generic_transport:listen(Pid, Opts)) of + try megaco_test_generic_transport:listen(Pid, Opts) of {ok, _SH, _CtrlPid} -> + p("listen(generic) -> ok"), {ok, State}; Else -> - error({udp_open, Opts0, Else}) + e("[listen] failed generic: " + "~n Else: ~p", [Else]), + error({generic_listen, Opts0, Else}) + catch + C:E:S -> + e("[listen] failed generic - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({generic_listen, Opts0, {C, E, S}}) end; handle_exec({connect, Host, Opts0, MaybeRetry}, @@ -497,14 +534,23 @@ handle_exec({connect, Host, Opts0, MaybeRetry}, {port, Port}, {receive_handle, RH}, {tcp_options, [{nodelay, true}]} | Opts0], - case (catch handle_exec_connect_tcp(Host, Opts, Sup, MaybeRetry)) of + try handle_exec_connect_tcp(Host, Opts, Sup, MaybeRetry) of {ok, SH, ControlPid} -> - d("connected(tcp): ~p, ~p", [SH, ControlPid]), + p("connected(tcp): ~p, ~p", [SH, ControlPid]), megaco_connector_start(RH, PrelMid, SH, ControlPid), {ok, State#state{send_handle = SH, ctrl_pid = ControlPid}}; Error -> + e("tcp connect failed: " + "~n Error: ~p", [Error]), error({tcp_connect_failed, Host, Opts0, Error}) + catch + C:E:S -> + e("tcp connect failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({tcp_connect_failed, Host, Opts0, {C, E, S}}) end; handle_exec({connect, Host, Opts0, _MaybeRetry}, @@ -516,7 +562,7 @@ handle_exec({connect, Host, Opts0, _MaybeRetry}, PrelMid = preliminary_mid, Opts = [{port, 0}, {receive_handle, RH}|Opts0], d("udp open", []), - case (catch megaco_udp:open(Sup, Opts)) of + try megaco_udp:open(Sup, Opts) of {ok, Handle, ControlPid} -> d("opened(udp): ~p, ~p", [Handle, ControlPid]), SH = megaco_udp:create_send_handle(Handle, Host, Port), @@ -524,7 +570,16 @@ handle_exec({connect, Host, Opts0, _MaybeRetry}, {ok, State#state{send_handle = SH, ctrl_pid = ControlPid}}; Error -> + e("udp connect (open) failed: " + "~n Error: ~p", [Error]), error({udp_connect_failed, Host, Opts0, Error}) + catch + C:E:S -> + e("udp connect (open) failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({tcp_connect_failed, Host, Opts0, {C, E, S}}) end; handle_exec({connect, Host, Opts0, _MaybeRetry}, @@ -535,14 +590,23 @@ handle_exec({connect, Host, Opts0, _MaybeRetry}, p("connect(generic) to ~p", [Host]), PrelMid = preliminary_mid, Opts = [{host, Host}, {port, Port}, {receive_handle, RH}|Opts0], - case (catch megaco_test_generic_transport:connect(Sup, Opts)) of + try megaco_test_generic_transport:connect(Sup, Opts) of {ok, SH, ControlPid} -> d("connected(generic): ~p, ~p", [SH, ControlPid]), megaco_connector_start(RH, PrelMid, SH, ControlPid), {ok, State#state{send_handle = SH, ctrl_pid = ControlPid}}; Error -> + e("generic connect failed: " + "~n Error: ~p", [Error]), error({generic_connect_failed, Host, Opts0, Error}) + catch + C:E:S -> + e("generic connect failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({generic_connect_failed, Host, Opts0, {C, E, S}}) end; handle_exec(megaco_connect, State) -> @@ -553,8 +617,8 @@ handle_exec(megaco_connect, State) -> {ok, State#state{conn_handle = CH}}; {megaco_connect_result, Error} -> p("received failed megaco_connect: ~p", [Error]), - #state{result = Res} = State, - {ok, State#state{result = [Error|Res]}} + #state{result = AccRes} = State, + {ok, State#state{result = [Error|AccRes]}} end; handle_exec({megaco_connect, Mid}, @@ -565,12 +629,12 @@ handle_exec({megaco_connect, Mid}, megaco_connector_start(RH, Mid, SH, ControlPid), {ok, State}; -handle_exec({megaco_user_info, Tag}, #state{mid = Mid, result = Res} = State) +handle_exec({megaco_user_info, Tag}, #state{mid = Mid, result = AccRes} = State) when Mid /= undefined -> p("megaco user-info: ~w", [Tag]), Val = (catch megaco:user_info(Mid, Tag)), d("megaco_user_info: ~p", [Val]), - {ok, State#state{result = [Val|Res]}}; + {ok, State#state{result = [Val|AccRes]}}; handle_exec({megaco_update_user_info, Tag, Val}, #state{mid = Mid} = State) when Mid /= undefined -> @@ -590,28 +654,53 @@ handle_exec({megaco_update_conn_info, Tag, Val}, #state{conn_handle = CH} = State) when CH /= undefined -> p("update megaco conn-info: ~w -> ~p", [Tag, Val]), - case megaco:update_conn_info(CH, Tag, Val) of + try megaco:update_conn_info(CH, Tag, Val) of ok -> {ok, State}; Error -> + e("failed updating connection info: " + "~n Tag: ~p" + "~n Val: ~p" + "~n CH: ~p" + "~n Error: ~p", [Tag, Val, CH, Error]), error({failed_updating_conn_info, Tag, Val, Error}) + catch + C:E:S -> + e("failed updating connection info: " + "~n Tag: ~p" + "~n Val: ~p" + "~n CH: ~p" + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [Tag, Val, CH, C, E, S]), + error({failed_updating_conn_info, Tag, Val, {C, E, S}}) end; -handle_exec(megaco_info, #state{result = Res} = State) -> +handle_exec(megaco_info, #state{result = AccRes} = State) -> p("megaco info", []), Val = (catch megaco:info()), d("megaco_info: ~p", [Val]), - {ok, State#state{result = [Val|Res]}}; + {ok, State#state{result = [Val|AccRes]}}; -handle_exec({megaco_system_info, Tag, Verify}, #state{result = Res} = State) -> +handle_exec({megaco_system_info, Tag, Verify}, + #state{result = AccRes} = State) -> p("megaco system-info: ~w", [Tag]), Val = (catch megaco:system_info(Tag)), d("megaco system-info: ~p", [Val]), - case Verify(Val) of + try Verify(Val) of ok -> - {ok, State#state{result = [Val|Res]}}; + {ok, State#state{result = [Val|AccRes]}}; Error -> - {error, State#state{result = [Error|Res]}} + e("verification failed: " + "~n Error: ~p", [Error]), + {error, State#state{result = [Error|AccRes]}} + catch + C:E:S -> + e("verification failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + {error, State#state{result = [{catched, {C, E, S}}|AccRes]}} end; %% This is either a MG or a MGC which is only connected to one MG @@ -640,21 +729,32 @@ handle_exec({megaco_call, RemoteMid, ARs, Opts}, #state{mid = Mid} = State) -> {ok, State}; %% This is either a MG or a MGC which is only connected to one MG -handle_exec({megaco_cast, ARs, Opts}, #state{conn_handle = CH} = State) +handle_exec({megaco_cast, ARs, Opts}, #state{conn_handle = CH, + result = AccRes} = State) when CH =/= undefined -> p("megaco_cast: " "~n CH: ~p" "~n ARs: ~p", [CH, ARs]), - case megaco:cast(CH, ARs, Opts) of + try megaco:cast(CH, ARs, Opts) of ok -> + p("megaco cast ok"), {ok, State}; Error -> - e("failed sending (cast) message: ~n~p", [Error]), - #state{result = Acc} = State, - {error, State#state{result = [Error|Acc]}} + e("failed sending (cast) message: " + "~n Error: ~p", [Error]), + {error, State#state{result = [Error|AccRes]}} + catch + C:E:S -> + e("failed sending (cast) message - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + {error, State#state{result = [{catched, {C, E, S}}|AccRes]}} end; -handle_exec({megaco_cast, RemoteMid, ARs, Opts}, #state{mid = Mid} = State) -> +handle_exec({megaco_cast, RemoteMid, ARs, Opts}, + #state{mid = Mid, + result = AccRes} = State) -> p("megaco_cast with ~p", [RemoteMid]), %% First we have to find the CH for this Mid Conns = megaco:user_info(Mid, connections), @@ -670,8 +770,7 @@ handle_exec({megaco_cast, RemoteMid, ARs, Opts}, #state{mid = Mid} = State) -> Error -> e("failed sending (cast) message: " "~n ~p", [Error]), - #state{result = Acc} = State, - {error, State#state{result = [Error|Acc]}} + {error, State#state{result = [Error|AccRes]}} end; %% Nothing shall happen for atleast Timeout time @@ -680,9 +779,9 @@ handle_exec({megaco_callback, nocall, Timeout}, State) -> receive {handle_megaco_callback, Type, Msg, Pid} -> e("received unexpected megaco callback: ~n~p", [Msg]), - #state{result = Res} = State, + #state{result = AccRes} = State, Err = {unexpected_callback, Type, Msg, Pid}, - {error, State#state{result = [Err|Res]}} + {error, State#state{result = [Err|AccRes]}} after Timeout -> p("got no callback (~p) as expected", [Timeout]), {ok, State} @@ -694,7 +793,7 @@ handle_exec({megaco_callback, Tag, Verify}, State) when is_function(Verify) -> {handle_megaco_callback, Type, Msg, Pid} -> d("received megaco callback:" "~n ~p", [Msg]), - case Verify(Msg) of + try Verify(Msg) of {VRes, Res, Reply} -> d("megaco_callback [~w] ~w", [Tag, VRes]), handle_megaco_callback_reply(Pid, Type, Reply), @@ -703,6 +802,13 @@ handle_exec({megaco_callback, Tag, Verify}, State) when is_function(Verify) -> d("megaco_callback [~w] ~w, ~w", [Tag,Delay,VRes]), handle_megaco_callback_reply(Pid, Type, Delay, Reply), validate(VRes, Tag, Res, State) + catch + C:E:S -> + e("megaco callback - verification failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({megaco_callback_verification_failed, Tag, {C, E, S}}) end end; @@ -715,7 +821,7 @@ handle_exec({megaco_callback, Tag, {VMod, VFunc, VArgs}}, State) "~n VMod: ~w" "~n VFunc: ~w" "~n VArgs: ~p", [Msg, VMod, VFunc, VArgs]), - case apply(VMod, VFunc, [Msg|VArgs]) of + try apply(VMod, VFunc, [Msg|VArgs]) of {VRes, Res, Reply} -> d("megaco_callback [~w] ~w",[Tag, VRes]), handle_megaco_callback_reply(Pid, Type, Reply), @@ -724,17 +830,25 @@ handle_exec({megaco_callback, Tag, {VMod, VFunc, VArgs}}, State) d("megaco_callback [~w] ~w, ~w",[Tag,Delay,VRes]), handle_megaco_callback_reply(Pid, Type, Delay, Reply), validate(VRes, Tag, Res, State) + catch + C:E:S -> + e("megaco callback - verification failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({megaco_callback_verification_failed, Tag, {C, E, S}}) end end; -handle_exec({megaco_callback, Tag, Verify, Timeout}, State) +handle_exec({megaco_callback, Tag, Verify, Timeout}, + #state{result = AccRes} = State) when (is_function(Verify) andalso (is_integer(Timeout) andalso (Timeout > 0))) -> p("expect megaco_callback ~w (with ~w)", [Tag, Timeout]), receive {handle_megaco_callback, Type, Msg, Pid} -> d("received megaco callback: ~n~p", [Msg]), - case Verify(Msg) of + try Verify(Msg) of {VRes, Res, Reply} -> d("megaco_callback [~w] ~w",[Tag,VRes]), handle_megaco_callback_reply(Pid, Type, Reply), @@ -743,12 +857,18 @@ handle_exec({megaco_callback, Tag, Verify, Timeout}, State) d("megaco_callback [~w] ~w, ~w",[Tag,Delay,VRes]), handle_megaco_callback_reply(Pid, Type, Delay, Reply), validate(VRes, Tag, Res, State) + catch + C:E:S -> + e("megaco callback - verification failed - catched: " + "~n C: ~p" + "~n E: ~p" + "~n S: ~p", [C, E, S]), + error({megaco_callback_verification_failed, Tag, {C, E, S}}) end after Timeout -> e("megaco_callback ~w timeout", [Tag]), - #state{result = Res} = State, Err = {callback_timeout, Tag, Timeout}, - {error, State#state{result = [Err|Res]}} + {error, State#state{result = [Err|AccRes]}} end; handle_exec({megaco_callback, Verifiers}, State) -> @@ -762,8 +882,8 @@ handle_exec({megaco_cancel, Reason}, #state{conn_handle = CH} = State) -> {ok, State}; Error -> e("failed cancel: ~n~p", [Error]), - #state{result = Acc} = State, - {error, State#state{result = [Error|Acc]}} + #state{result = AccRes} = State, + {error, State#state{result = [Error|AccRes]}} end; handle_exec({trigger, Trigger}, State) when is_function(Trigger) -> diff --git a/lib/odbc/test/README b/lib/odbc/test/README index 0a8495afbb..5ae6073d9a 100644 --- a/lib/odbc/test/README +++ b/lib/odbc/test/README @@ -47,7 +47,7 @@ something like this: --- Start example of .odbc.ini ---- -[Postgres] +[PostgresLinux64Ubuntu] Driver=/usr/lib/psqlodbc.so Description=Postgres driver ServerName=myhost diff --git a/lib/odbc/test/postgres.erl b/lib/odbc/test/postgres.erl index 1955358206..e055be9544 100644 --- a/lib/odbc/test/postgres.erl +++ b/lib/odbc/test/postgres.erl @@ -207,7 +207,7 @@ bit_true_selected() -> %------------------------------------------------------------------------- float_min() -> - 1.79e-307. + 5.0e-324. float_max() -> 1.79e+308. @@ -215,7 +215,7 @@ create_float_table() -> " (FIELD float)". float_underflow() -> - "1.80e-308". + "2.4e-324". float_overflow() -> "1.80e+308". @@ -288,7 +288,7 @@ describe_string() -> {"str4",{sql_varchar,10}}]}. describe_floating() -> - {ok,[{"f",sql_real},{"r",sql_real},{"d",{sql_float,15}}]}. + {ok,[{"f",sql_real},{"r",sql_real},{"d",{sql_float,17}}]}. describe_dec_num() -> {ok,[{"mydec",{sql_numeric,9,3}},{"mynum",{sql_numeric,9,2}}]}. diff --git a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl index 6ae51d9a26..9ab61b89d2 100644 --- a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl +++ b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl @@ -25,7 +25,9 @@ -include_lib("common_test/include/ct.hrl"). %-compile(export_all). --export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). %% Testcases -export([basic/1]). @@ -40,6 +42,18 @@ suite() -> all() -> [basic]. +init_per_suite(Config) -> + case test_server:is_asan() of + true -> + %% No point testing own allocators under address sanitizer. + {skip, "Address sanitizer"}; + false -> + Config + end. + +end_per_suite(_Config) -> + ok. + init_per_testcase(Case, Config) when is_list(Config) -> [{testcase, Case}, {erl_flags_env, save_env()} | Config]. diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index da2762c3fb..fc582089b7 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -123,13 +123,16 @@ init_all(Config) when is_list(Config) -> ?IPRINT("init_all -> entry with" - "~n Config: ~p",[Config]), + "~n Config: ~p", [Config]), - %% -- + %% -- %% Start nodes - %% + %% + ?IPRINT("init_all -> start sub-agent node"), ?line {ok, SaNode} = start_node(snmp_sa), + + ?IPRINT("init_all -> start manager node"), ?line {ok, MgrNode} = start_node(snmp_mgr), @@ -137,33 +140,41 @@ init_all(Config) when is_list(Config) -> %% Create necessary files ( and dirs ) %% + ?IPRINT("init_all -> create suite top dir"), SuiteTopDir = ?config(snmp_suite_top_dir, Config), ?DBG("init_all -> SuiteTopDir ~p", [SuiteTopDir]), + ?IPRINT("init_all -> create agent dir"), AgentDir = join(SuiteTopDir, "agent/"), ?line ok = file:make_dir(AgentDir), ?DBG("init_all -> AgentDir ~p", [AgentDir]), + ?IPRINT("init_all -> create agent db dir"), AgentDbDir = join(AgentDir, "db/"), ?line ok = file:make_dir(AgentDbDir), ?DBG("init_all -> AgentDbDir ~p", [AgentDbDir]), + ?IPRINT("init_all -> create agent log dir"), AgentLogDir = join(AgentDir, "log/"), ?line ok = file:make_dir(AgentLogDir), ?DBG("init_all -> AgentLogDir ~p", [AgentLogDir]), + ?IPRINT("init_all -> create agent config dir"), AgentConfDir = join(AgentDir, "conf/"), ?line ok = file:make_dir(AgentConfDir), ?DBG("init_all -> AgentConfDir ~p", [AgentConfDir]), + ?IPRINT("init_all -> create manager dir"), MgrDir = join(SuiteTopDir, "mgr/"), ?line ok = file:make_dir(MgrDir), ?DBG("init_all -> MgrDir ~p", [MgrDir]), + ?IPRINT("init_all -> create sub-agent dir"), SaDir = join(SuiteTopDir, "sa/"), ?line ok = file:make_dir(SaDir), ?DBG("init_all -> SaDir ~p", [SaDir]), + ?IPRINT("init_all -> create sub-agent db dir"), SaDbDir = join(SaDir, "db/"), ?line ok = file:make_dir(SaDbDir), ?DBG("init_all -> SaDbDir ~p", [SaDbDir]), @@ -176,29 +187,33 @@ init_all(Config) when is_list(Config) -> %% Start and initiate mnesia %% - ?DBG("init_all -> load application mnesia", []), + ?IPRINT("init_all -> load mnesia application (local)"), ?line ok = application:load(mnesia), - ?DBG("init_all -> load application mnesia on node ~p", [SaNode]), + ?IPRINT("init_all -> load application mnesia on node ~p", [SaNode]), ?line ok = rpc:call(SaNode, application, load, [mnesia]), - ?DBG("init_all -> application mnesia: set_env dir",[]), + ?IPRINT("init_all -> application mnesia (local): set_env dir"), ?line application_controller:set_env(mnesia, dir, join(AgentDbDir, "Mnesia1")), - ?DBG("init_all -> application mnesia: set_env dir on node ~p",[SaNode]), + ?IPRINT("init_all -> application mnesia: set_env dir on node ~p", [SaNode]), ?line rpc:call(SaNode, application_controller, set_env, [mnesia, dir, join(SaDir, "Mnesia2")]), - ?DBG("init_all -> create mnesia schema",[]), + ?IPRINT("init_all -> create mnesia schema"), ?line ok = mnesia:create_schema([SaNode, node()]), - ?DBG("init_all -> start application mnesia",[]), + ?IPRINT("init_all -> start application mnesia (local)"), ?line ok = application:start(mnesia), - ?DBG("init_all -> start application mnesia on ~p",[SaNode]), + ?IPRINT("init_all -> start application mnesia on ~p", [SaNode]), ?line ok = rpc:call(SaNode, application, start, [mnesia]), + + ?IPRINT("init_all -> get localhost"), Ip = ?LOCALHOST(), + + ?IPRINT("init_all -> done"), [{snmp_sa, SaNode}, {snmp_mgr, MgrNode}, {snmp_master, node()}, @@ -215,11 +230,24 @@ init_all(Config) when is_list(Config) -> finish_all(Config) when is_list(Config) -> - SaNode = ?config(snmp_sa, Config), + + ?IPRINT("finish_all -> entry with" + "~n Config: ~p", [Config]), + + SaNode = ?config(snmp_sa, Config), MgrNode = ?config(snmp_mgr, Config), + + ?IPRINT("finish_all -> stop sub-agent node ~p", [SaNode]), stop_node(SaNode), + + ?IPRINT("finish_all -> stop manager node ~p", [MgrNode]), stop_node(MgrNode), - application:stop(mnesia). + + ?IPRINT("finish_all -> stop mnesia application"), + application:stop(mnesia), + + ?IPRINT("finish_all -> stop"), + ok. %% --- This one *must* be run first in each case --- @@ -242,7 +270,6 @@ init_case(Config) when is_list(Config) -> {ok, MIP} = snmp_misc:ip(MgrHost, IpFamily), {ok, SIP} = snmp_misc:ip(SaHost, IpFamily), - put(mgr_node, MgrNode), put(sa_node, SaNode), put(master_node, MasterNode), @@ -263,11 +290,12 @@ init_case(Config) when is_list(Config) -> put(mgr_dir, MgrDir), put(vsn, ?config(vsn, Config)), - ?DBG("init_case -> exit with" - "~n MasterNode: ~p" - "~n SaNode: ~p" - "~n MgrNode: ~p" - "~n MibDir: ~p", [MasterNode, SaNode, MgrNode, MibDir]), + + ?IPRINT("init_case -> done with" + "~n MasterNode: ~p" + "~n SaNode: ~p" + "~n MgrNode: ~p" + "~n MibDir: ~p", [MasterNode, SaNode, MgrNode, MibDir]), {SaNode, MgrNode, MibDir}. diff --git a/lib/snmp/test/snmp_manager_SUITE.erl b/lib/snmp/test/snmp_manager_SUITE.erl index 6cc84d1e35..1f0dd506b5 100644 --- a/lib/snmp/test/snmp_manager_SUITE.erl +++ b/lib/snmp/test/snmp_manager_SUITE.erl @@ -1420,14 +1420,14 @@ usm_priv_aes(Config) when is_list(Config) -> {dir, ConfDir}, {db_dir, DbDir}]}], - io:format("[~s] try starting manager", [?FTS()]), + ?IPRINT("try starting manager"), ok = snmpm:start(Opts), ?SLEEP(1000), % Give it time to settle ok end, Case = fun(_) -> do_usm_priv_aes(Config) end, Post = fun(_) -> - io:format("[~s] try stop manager", [?FTS()]), + ?IPRINT("try stop manager"), ok = snmpm:stop(), ?SLEEP(1000), % Give it time to settle ok @@ -1435,10 +1435,13 @@ usm_priv_aes(Config) when is_list(Config) -> ?TC_TRY(usm_priv_aes, Pre, Case, Post). do_usm_priv_aes(Config) -> - io:format("[~s] starting with Config: " - "~n ~p", [?FTS(), Config]), + ?IPRINT("starting with Config: " + "~n ~p", [Config]), - io:format("[~s] generate AES-encrypted message", [?FTS()]), + put(sname, "TC[usm-priv-aes]"), + put(verbosity, trace), + + ?IPRINT("generate AES-encrypted message"), EngineID = [128,0,0,0,6], SecName = "v3_user", @@ -1465,6 +1468,7 @@ do_usm_priv_aes(Config) -> {sec_name, SecName} ], + ?IPRINT("register user, usm-user and agent"), snmpm:register_user(SecName, snmpm_user_default, nil), snmpm:register_usm_user(EngineID, SecName, Credentials), snmpm:register_agent(SecName, "v3_agent", AgentConfig), @@ -1494,9 +1498,11 @@ do_usm_priv_aes(Config) -> _MsgPrivacyParameters = PrivKey }, + ?IPRINT("get engine mms"), {ok, MsgMaxSize} = snmpm_config:get_engine_max_message_size(), + ?IPRINT("encode scoped pdu"), Message = { message, _Version = 'version-3', @@ -1515,6 +1521,7 @@ do_usm_priv_aes(Config) -> SecLevel = 2, + ?IPRINT("generate outgoing message"), Msg = snmpm_usm:generate_outgoing_msg( Message, @@ -1524,12 +1531,14 @@ do_usm_priv_aes(Config) -> SecLevel ), - io:format("[~s] got AES-encrypted message, now decrypt: " - "~n ~p", [?FTS(), Msg]), + ?IPRINT("got AES-encrypted message, now decrypt: " + "~n ~p", [Msg]), {message, _Version, Hdr, NextData} = snmp_pdus:dec_message_only(Msg), + ?IPRINT("AES-encrypted message decrypted - now match"), + { v3_hdr, _MsgID, _MsgMaxSize, @@ -1539,6 +1548,8 @@ do_usm_priv_aes(Config) -> _Hdr_size } = Hdr, + ?IPRINT("process incoming message"), + { ok, { _MsgAuthEngineID, _SecName, @@ -1555,7 +1566,7 @@ do_usm_priv_aes(Config) -> Data = ScopedPDUBytes, - io:format("[~s] Message decrypted", [?FTS()]), + ?IPRINT("message decrypted"), ok. @@ -2139,10 +2150,22 @@ do_simple_sync_get3(Config, Get, PostVerify) -> do_simple_sync_get3(Node, TargetName, Oids, Get, PostVerify) when is_function(Get, 3) andalso is_function(PostVerify, 0) -> - ?line {ok, Reply, _Rem} = Get(Node, TargetName, Oids), - ?DBG("~n Reply: ~p" - "~n Rem: ~w", [Reply, _Rem]), + ?IPRINT("try get for ~p (on ~p):" + "~n Oids: ~p", [TargetName, Node, Oids]), + ?line Reply = + case Get(Node, TargetName, Oids) of + {ok, R, _Rem} -> + ?IPRINT("get reply: " + "~n Reply: ~p" + "~n Rem: ~w", [R, _Rem]), + + R; + {error, Reason} = ERROR -> + ?EPRINT("get failed: " + "~n ~p", [Reason]), + ERROR + end, %% verify that the operation actually worked: %% The order should be the same, so no need to search @@ -5320,11 +5343,11 @@ start_manager(Node, Vsns, Config) -> start_manager(Node, Vsns, Config, []). start_manager(Node, Vsns, Conf0, _Opts) -> - ?DBG("start_manager -> entry with" - "~n Node: ~p" - "~n Vsns: ~p" - "~n Conf0: ~p" - "~n Opts: ~p", [Node, Vsns, Conf0, _Opts]), + ?IPRINT("start_manager -> entry with" + "~n Node: ~p" + "~n Vsns: ~p" + "~n Conf0: ~p" + "~n Opts: ~p", [Node, Vsns, Conf0, _Opts]), AtlDir = ?config(manager_log_dir, Conf0), ConfDir = ?config(manager_conf_dir, Conf0), @@ -5490,16 +5513,16 @@ start_manager_node() -> start_node(Name) -> start_node(Name, true). start_node(Name, Retry) -> + + ?IPRINT("start_node -> entry with" + "~n Name: ~p" + "~n when" + "~n hostname of this node: ~p", + [Name, list_to_atom(?HOSTNAME(node()))]), + Pa = filename:dirname(code:which(?MODULE)), - Args = case init:get_argument('CC_TEST') of - {ok, [[]]} -> - " -pa /clearcase/otp/libraries/snmp/ebin "; - {ok, [[Path]]} -> - " -pa " ++ Path; - error -> - "" - end, - A = Args ++ " -pa " ++ Pa ++ + + A = " -pa " ++ Pa ++ " -s " ++ atom_to_list(snmp_test_sys_monitor) ++ " start" ++ " -s global sync", try ?START_NODE(Name, A) of diff --git a/lib/snmp/test/snmp_manager_user.erl b/lib/snmp/test/snmp_manager_user.erl index 60a6844875..5c56ed5c15 100644 --- a/lib/snmp/test/snmp_manager_user.erl +++ b/lib/snmp/test/snmp_manager_user.erl @@ -321,11 +321,14 @@ loop(#state{parent = Parent, id = Id} = S) -> {{sync_get2, TargetName, Oids, SendOpts}, From, Ref} when is_list(TargetName) -> + snmpm:verbosity(server, trace), d("loop -> received sync_get2 request with" "~n TargetName: ~p" "~n Oids: ~p" "~n SendOpts: ~p", [TargetName, Oids, SendOpts]), Res = snmpm:sync_get2(Id, TargetName, Oids, SendOpts), + d("loop -> result:" + "~n ~p", [Res]), reply(From, Res, Ref), loop(S); @@ -637,6 +640,6 @@ d(F, A) -> d(get(debug), F, A). d(true, F, A) -> - io:format("~w:" ++ F ++ "~n", [?SERVER|A]); + ?IPRINT("~w:" ++ F, [?SERVER|A]); d(_, _, _) -> ok. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 6bc7f6e353..a7fac8722b 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -530,13 +530,15 @@ rsa_suites(0) -> ?TLS_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_3DES_EDE_CBC_SHA ]; -rsa_suites(N) when N =< 4 -> +rsa_suites(N) when N >= 3 -> [ ?TLS_RSA_WITH_AES_256_GCM_SHA384, ?TLS_RSA_WITH_AES_256_CBC_SHA256, ?TLS_RSA_WITH_AES_128_GCM_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 - ]. + ]; +rsa_suites(_) -> + []. %%-------------------------------------------------------------------- -spec filter(undefined | binary(), [ssl_cipher_format:cipher_suite()], diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 0a7c4560fb..9f2141b6f8 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -260,6 +260,18 @@ %% TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA = { 0xC0, 0x0A } -define(TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#0A)>>). +%% TLS_ECDHE_ECDSA_WITH_AES_128_CCM = {0xC0,0xAC} +-define(TLS_ECDHE_ECDSA_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#AC)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_256_CCM = {0xC0,0xAD} +-define(TLS_ECDHE_ECDSA_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#AD)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8 = {0xC0,0xAE} +-define(TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#AE)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8 = {0xC0,0xAF} +-define(TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#AF)>>). + %% ECDH_RSA %% TLS_ECDH_RSA_WITH_NULL_SHA = { 0xC0, 0x0B } diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl index 49855f4b74..589b0facf8 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -77,13 +77,13 @@ suite_map_to_str(#{key_exchange := Kex, cipher := Cipher, mac := aead, prf := PRF}) -> - "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ + "TLS_" ++ kex_str(Kex) ++ "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ - "_" ++ string:to_upper(atom_to_list(PRF)); + prf_str("_", PRF); suite_map_to_str(#{key_exchange := Kex, cipher := Cipher, mac := Mac}) -> - "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ + "TLS_" ++ kex_str(Kex) ++ "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(Mac)). @@ -97,12 +97,6 @@ suite_str_to_map(SuiteStr)-> case string:split(Str0, "_WITH_") of [Rest] -> tls_1_3_suite_str_to_map(Rest); - [Prefix, Kex | Rest] when Prefix == "SPR"; - Prefix == "PSK"; - Prefix == "DHE"; - Prefix == "ECDHE" - -> - pre_tls_1_3_suite_str_to_map(Prefix ++ "_" ++ Kex, Rest); [Kex| Rest] -> pre_tls_1_3_suite_str_to_map(Kex, Rest) end. @@ -116,26 +110,36 @@ suite_map_to_openssl_str(#{key_exchange := null} = Suite) -> suite_map_to_str(Suite); suite_map_to_openssl_str(#{key_exchange := rsa = Kex, cipher := Cipher, - mac := Mac}) when Cipher == "des_cbc"; - Cipher == "3des_ede_cbc" -> + mac := aead, + prf := PRF}) when PRF =/= default_prf -> + openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ + "-" ++ string:to_upper(atom_to_list(PRF)); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := Cipher, + mac := Mac}) when (Kex == rsa) orelse + (Kex == srp_anon) + andalso + (Cipher == "des_cbc") orelse + (Cipher == "3des_ede_cbc") -> openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ "-" ++ string:to_upper(atom_to_list(Mac)); suite_map_to_openssl_str(#{key_exchange := Kex, cipher := chacha20_poly1305 = Cipher, - mac := aead}) -> - openssl_suite_start(string:to_upper(atom_to_list(Kex)), Cipher) - ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))); + mac := aead, + prf := sha256}) -> + openssl_suite_start(kex_str(Kex), Cipher) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))); suite_map_to_openssl_str(#{key_exchange := Kex, cipher := Cipher, mac := aead, prf := PRF}) -> - openssl_suite_start(string:to_upper(atom_to_list(Kex)), Cipher) + openssl_suite_start(kex_str(Kex), Cipher) ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ - "-" ++ string:to_upper(atom_to_list(PRF)); + prf_str("-", PRF); suite_map_to_openssl_str(#{key_exchange := Kex, - cipher := Cipher, - mac := Mac}) -> - openssl_suite_start(string:to_upper(atom_to_list(Kex)), Cipher) + cipher := Cipher, + mac := Mac}) -> + openssl_suite_start(kex_str(Kex), Cipher) ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ "-" ++ string:to_upper(atom_to_list(Mac)). @@ -148,14 +152,20 @@ suite_openssl_str_to_map("DES-CBC3-SHA") -> suite_str_to_map("TLS_RSA_WITH_3DES_EDE_CBC_SHA"); suite_openssl_str_to_map("SRP-DSS-DES-CBC3-SHA") -> suite_str_to_map("TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA"); +suite_openssl_str_to_map("ADH" ++ Rest) -> + suite_openssl_str_to_map("DH-anon", Rest); +suite_openssl_str_to_map("AECDH" ++ Rest) -> + suite_openssl_str_to_map("ECDH-anon", Rest); suite_openssl_str_to_map("EDH-RSA" ++ Rest) -> suite_openssl_str_to_map("DHE-RSA", Rest); +suite_openssl_str_to_map("EDH-DSS-" ++ Rest) -> + suite_openssl_str_to_map("DHE-DSS", Rest); suite_openssl_str_to_map("DHE-RSA-" ++ Rest) -> suite_openssl_str_to_map("DHE-RSA", Rest); suite_openssl_str_to_map("DHE-DSS-" ++ Rest) -> suite_openssl_str_to_map("DHE-DSS", Rest); -suite_openssl_str_to_map("EDH-DSS-" ++ Rest) -> - suite_openssl_str_to_map("DHE-DSS", Rest); +suite_openssl_str_to_map("DHE-PSK-" ++ Rest) -> + suite_openssl_str_to_map("DHE-PSK", Rest); suite_openssl_str_to_map("DES" ++ _ = Rest) -> suite_openssl_str_to_map("RSA", Rest); suite_openssl_str_to_map("AES" ++ _ = Rest) -> @@ -174,8 +184,6 @@ suite_openssl_str_to_map("RSA-PSK-" ++ Rest) -> suite_openssl_str_to_map("RSA-PSK", Rest); suite_openssl_str_to_map("RSA-" ++ Rest) -> suite_openssl_str_to_map("RSA", Rest); -suite_openssl_str_to_map("DHE-PSK-" ++ Rest) -> - suite_openssl_str_to_map("DHE-PSK", Rest); suite_openssl_str_to_map("ECDHE-PSK-" ++ Rest) -> suite_openssl_str_to_map("ECDHE-PSK", Rest); suite_openssl_str_to_map("PSK-" ++ Rest) -> @@ -348,12 +356,12 @@ suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_cbc, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dh_anon, cipher => aes_256_cbc, mac => sha256, - prf => default_prf}; + prf => sha256}; %%% PSK Cipher Suites RFC 4279 suite_bin_to_map(?TLS_PSK_WITH_RC4_128_SHA) -> #{key_exchange => psk, @@ -466,7 +474,7 @@ suite_bin_to_map(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => psk, cipher => aes_128_cbc, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => psk, cipher => aes_256_cbc, @@ -476,7 +484,7 @@ suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_cbc, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_cbc, @@ -506,7 +514,7 @@ suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA256) -> #{key_exchange => dhe_psk, cipher => null, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA384) -> #{key_exchange => dhe_psk, cipher => null, @@ -516,7 +524,7 @@ suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA256) -> #{key_exchange => rsa_psk, cipher => null, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA384) -> #{key_exchange => rsa_psk, cipher => null, @@ -547,7 +555,7 @@ suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_cbc, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_psk, cipher => aes_256_cbc, @@ -557,7 +565,7 @@ suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> #{key_exchange => ecdhe_psk, cipher => null, mac => sha256, - prf => default_prf}; + prf => sha256}; suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> #{key_exchange => ecdhe_psk, cipher => null, mac => sha384, @@ -566,22 +574,22 @@ suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_psk, cipher => aes_256_gcm, - mac => null, + mac => aead, prf => sha384}; suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_ccm, - mac => null, + mac => aead, prf => sha256}; suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_ccm_8, - mac => null, + mac => aead, prf => sha256}; %%% SRP Cipher Suites RFC 5054 suite_bin_to_map(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> @@ -680,6 +688,26 @@ suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> cipher => aes_256_cbc, mac => sha, prf => default_prf}; +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_CCM) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_ccm, + mac => aead, + prf => default_prf}; +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CCM) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_ccm, + mac => aead, + prf => default_prf}; +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_128_ccm_8, + mac => aead, + prf => default_prf}; +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8) -> + #{key_exchange => ecdhe_ecdsa, + cipher => aes_256_ccm_8, + mac => aead, + prf => default_prf}; suite_bin_to_map(?TLS_ECDH_RSA_WITH_NULL_SHA) -> #{key_exchange => ecdh_rsa, cipher => null, @@ -840,7 +868,7 @@ suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> suite_bin_to_map(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_dss, cipher => aes_128_gcm, - mac => null, + mac => aead, prf => sha256}; suite_bin_to_map(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_dss, @@ -902,42 +930,42 @@ suite_bin_to_map(?TLS_PSK_WITH_AES_128_CCM) -> #{key_exchange => psk, cipher => aes_128_ccm, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_PSK_WITH_AES_256_CCM) -> #{key_exchange => psk, cipher => aes_256_ccm, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CCM) -> #{key_exchange => dhe_psk, cipher => aes_128_ccm, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CCM) -> #{key_exchange => dhe_psk, cipher => aes_256_ccm, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_PSK_WITH_AES_128_CCM_8) -> #{key_exchange => psk, cipher => aes_128_ccm_8, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_PSK_WITH_AES_256_CCM_8) -> #{key_exchange => psk, cipher => aes_256_ccm_8, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_PSK_DHE_WITH_AES_128_CCM_8) -> #{key_exchange => dhe_psk, cipher => aes_128_ccm_8, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(?TLS_PSK_DHE_WITH_AES_256_CCM_8) -> #{key_exchange => dhe_psk, cipher => aes_256_ccm_8, mac => aead, - prf => sha256}; + prf => default_prf}; suite_bin_to_map(#{key_exchange := psk_dhe, cipher := aes_256_ccm_8, mac := aead, @@ -1297,22 +1325,22 @@ suite_map_to_bin(#{key_exchange := ecdhe_psk, %%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_gcm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_gcm, - mac := null, + mac := aead, prf := sha384}) -> ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_ccm_8, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_ccm, - mac := null, + mac := aead, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; %%% SRP Cipher Suites RFC 5054 @@ -1393,6 +1421,22 @@ suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_ccm, + mac := aead}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CCM; +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_ccm, + mac := aead}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CCM; +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, + cipher := aes_128_ccm_8, + mac := aead}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8; +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, + cipher := aes_256_ccm_8, + mac := aead}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8; suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := null, mac := sha}) -> @@ -1616,22 +1660,22 @@ suite_map_to_bin(#{key_exchange := dhe_rsa, suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_ccm, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_PSK_WITH_AES_128_CCM; suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_ccm, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_PSK_WITH_AES_256_CCM; suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_ccm, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_DHE_PSK_WITH_AES_128_CCM; suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_ccm, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_DHE_PSK_WITH_AES_256_CCM; suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_ccm, @@ -1641,7 +1685,7 @@ suite_map_to_bin(#{key_exchange := rsa, suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_ccm, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_RSA_WITH_AES_256_CCM; suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_ccm, @@ -1651,48 +1695,48 @@ suite_map_to_bin(#{key_exchange := dhe_rsa, suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_ccm, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_DHE_RSA_WITH_AES_256_CCM; suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_PSK_WITH_AES_128_CCM_8; suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_PSK_WITH_AES_256_CCM_8; suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_PSK_DHE_WITH_AES_128_CCM_8; suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_PSK_DHE_WITH_AES_256_CCM_8; suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_RSA_WITH_AES_128_CCM_8; suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_RSA_WITH_AES_256_CCM_8; suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_DHE_RSA_WITH_AES_128_CCM_8; suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_ccm_8, mac := aead, - prf := sha256}) -> + prf := default_prf}) -> ?TLS_DHE_RSA_WITH_AES_256_CCM_8; %% TLS 1.3 Cipher Suites RFC8446 @@ -1740,21 +1784,42 @@ pre_tls_1_3_suite_str_to_map(KexStr, Rest) -> cipher => Cipher, prf => Prf }. - -cipher_str_to_algs(_, CipherStr, "CCM"= End) -> %% PRE TLS 1.3 - Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), - {Cipher, aead, sha256}; -cipher_str_to_algs(_, CipherStr, "8" = End) -> %% PRE TLS 1.3 - Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), - {Cipher, aead, sha256}; -cipher_str_to_algs(_, CipherStr, "CHACHA20_POLY1305" = End) -> %% PRE TLS 1.3 - Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), - {Cipher, aead, sha256}; -cipher_str_to_algs(_, CipherStr0, "") -> %% TLS 1.3 + +kex_str(srp_dss) -> + "SRP_SHA_DSS"; +kex_str(srp_rsa) -> + "SRP_SHA_RSA"; +kex_str(srp_anon) -> + "SRP_SHA"; +kex_str(dh_anon) -> + "DH_anon"; +kex_str(ecdh_anon) -> + "ECDH_anon"; +kex_str(Kex) -> + string:to_upper(atom_to_list(Kex)). + +prf_str(_, default_prf) -> + ""; +prf_str(Prefix, PRF) -> + Prefix ++ string:to_upper(atom_to_list(PRF)). + +cipher_str_to_algs(any, CipherStr0, "") -> %% TLS 1.3 [CipherStr, AlgStr] = string:split(CipherStr0, "_", trailing), Hash = algo_str_to_atom(AlgStr), Cipher = algo_str_to_atom(CipherStr), {Cipher, aead, Hash}; +cipher_str_to_algs(_Kex, CipherStr, "CCM"= End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, default_prf}; +cipher_str_to_algs(_Kex, CipherStr, "GCM"= End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, default_prf}; +cipher_str_to_algs(_Kex, CipherStr, "8" = End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, default_prf}; +cipher_str_to_algs(_Kex, "CHACHA20_POLY1305" = CipherStr, "") -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr), + {Cipher, aead, sha256}; cipher_str_to_algs(Kex, CipherStr, HashStr) -> %% PRE TLS 1.3 Hash = algo_str_to_atom(HashStr), Cipher = algo_str_to_atom(CipherStr), @@ -1796,48 +1861,80 @@ openssl_is_aead_cipher("CHACHA20-POLY1305") -> openssl_is_aead_cipher(CipherStr) -> case string:split(CipherStr, "-", trailing) of [_, Rest] -> - (Rest == "GCM") orelse (Rest == "CCM") orelse (Rest == "8"); + (Rest == "GCM") orelse (Rest == "CCM") orelse (Rest == "CCM8"); [_] -> false end. algo_str_to_atom("SRP_SHA_DSS") -> srp_dss; +algo_str_to_atom("SRP_SHA_RSA") -> + srp_rsa; +algo_str_to_atom("SRP_SHA") -> + srp_anon; +algo_str_to_atom("SRP") -> + srp_anon; algo_str_to_atom(AlgoStr) -> erlang:list_to_existing_atom(string:to_lower(AlgoStr)). +openssl_cipher_name(Kex, "3DES_EDE_CBC" ++ _) when Kex == ecdhe_psk; + Kex == srp_anon; + Kex == psk; + Kex == dhe_psk -> + "3DES-EDE-CBC"; openssl_cipher_name(_, "3DES_EDE_CBC" ++ _) -> "DES-CBC3"; openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == rsa; Kex == dhe_rsa; + Kex == dhe_dss; + Kex == ecdh_rsa; Kex == ecdhe_rsa; - Kex == ecdhe_ecdsa -> + Kex == ecdh_ecdsa; + Kex == ecdhe_ecdsa; + Kex == ecdh_anon; + Kex == dh_anon -> openssl_name_concat(CipherStr); openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == rsa; Kex == dhe_rsa; + Kex == dhe_dss; + Kex == ecdh_rsa; Kex == ecdhe_rsa; - Kex == ecdhe_ecdsa -> + Kex == ecdh_ecdsa; + Kex == ecdhe_ecdsa; + Kex == ecdh_anon; + Kex == dh_anon -> openssl_name_concat(CipherStr); -openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == srp; +openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == srp_anon; Kex == srp_rsa -> lists:append(string:replace(CipherStr, "_", "-", all)); -openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == srp; +openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == srp_anon; Kex == srp_rsa -> lists:append(string:replace(CipherStr, "_", "-", all)); openssl_cipher_name(_, "AES_128_CBC" ++ _ = CipherStr) -> openssl_name_concat(CipherStr) ++ "-CBC"; openssl_cipher_name(_, "AES_256_CBC" ++ _ = CipherStr) -> openssl_name_concat(CipherStr) ++ "-CBC"; +openssl_cipher_name(_, "AES_128_GCM_8") -> + openssl_name_concat("AES_128_GCM") ++ "-GCM8"; +openssl_cipher_name(_, "AES_256_GCM_8") -> + openssl_name_concat("AES_256_GCM") ++ "-GCM8"; +openssl_cipher_name(_, "AES_128_CCM_8") -> + openssl_name_concat("AES_128_CCM") ++ "-CCM8"; +openssl_cipher_name(_, "AES_256_CCM_8") -> + openssl_name_concat("AES_256_CCM") ++ "-CCM8"; openssl_cipher_name(_, "AES_128_GCM" ++ _ = CipherStr) -> openssl_name_concat(CipherStr) ++ "-GCM"; openssl_cipher_name(_, "AES_256_GCM" ++ _ = CipherStr) -> openssl_name_concat(CipherStr) ++ "-GCM"; +openssl_cipher_name(_, "AES_128_CCM" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-CCM"; +openssl_cipher_name(_, "AES_256_CCM" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-CCM"; openssl_cipher_name(_, "RC4" ++ _) -> "RC4"; openssl_cipher_name(_, CipherStr) -> lists:append(string:replace(CipherStr, "_", "-", all)). - openssl_suite_start(Kex, Cipher) -> case openssl_kex_name(Kex, Cipher) of "" -> @@ -1848,6 +1945,16 @@ openssl_suite_start(Kex, Cipher) -> openssl_kex_name("RSA", _) -> ""; +openssl_kex_name("DH_anon", _) -> + "ADH"; +openssl_kex_name("ECDH_anon", _) -> + "AECDH"; +openssl_kex_name("SRP_SHA", _) -> + "SRP"; +openssl_kex_name("SRP_SHA_RSA", _) -> + "SRP-RSA"; +openssl_kex_name("SRP_SHA_DSS", _) -> + "SRP-DSS"; openssl_kex_name("DHE_RSA", Cipher) when Cipher == des_cbc; Cipher == '3des_ede_cbc' -> "EDH-RSA"; @@ -1856,7 +1963,9 @@ openssl_kex_name(Kex, _) -> kex_name_from_openssl(Kex) -> case lists:append(string:replace(Kex, "-", "_", all)) of "EDH-RSA" -> - "DHE_RSA"; + "DHE_RSA"; + "SRP" -> + "SRP_SHA"; Str -> Str end. @@ -1865,26 +1974,30 @@ cipher_name_from_openssl("AES128") -> "AES_128_CBC"; cipher_name_from_openssl("AES256") -> "AES_256_CBC"; -cipher_name_from_openssl("AES128-CBC") -> - "AES_128_CBC"; -cipher_name_from_openssl("AES256-CBC") -> - "AES_256_CBC"; -cipher_name_from_openssl("AES-128-CBC") -> - "AES_128_CBC"; -cipher_name_from_openssl("AES-256-CBC") -> - "AES_256_CBC"; -cipher_name_from_openssl("AES128-GCM") -> - "AES_128_GCM"; -cipher_name_from_openssl("AES256-GCM") -> - "AES_256_GCM"; +cipher_name_from_openssl("AES128-CCM8") -> + "AES_128_CCM_8"; +cipher_name_from_openssl("AES256-CCM8") -> + "AES_256_CCM_8"; +cipher_name_from_openssl("AES128-" ++ Suffix) -> + "AES_128_" ++ lists:append(string:replace(Suffix, "-", "_", all)); +cipher_name_from_openssl("AES256-" ++ Suffix) -> + "AES_256_" ++ lists:append(string:replace(Suffix, "-", "_", all)); +cipher_name_from_openssl("AES128_" ++ Suffix) -> + "AES_128_" ++ Suffix; +cipher_name_from_openssl("AES256_" ++ Suffix) -> + "AES_256_" ++ Suffix; cipher_name_from_openssl("DES-CBC") -> "DES_CBC"; cipher_name_from_openssl("DES-CBC3") -> "3DES_EDE_CBC"; +cipher_name_from_openssl("3DES-EDE-CBC") -> + "3DES_EDE_CBC"; cipher_name_from_openssl("RC4") -> "RC4_128"; +cipher_name_from_openssl("CHACHA20-POLY1305") -> + "CHACHA20_POLY1305"; cipher_name_from_openssl(Str) -> - Str. + lists:append(string:replace(Str, "-", "_", all)). openssl_name_concat(Str0) -> [Str, _] = string:split(Str0, "_", trailing), @@ -1894,8 +2007,8 @@ openssl_name_concat(Str0) -> suite_openssl_str_to_map(Kex0, Rest) -> Kex = algo_str_to_atom(kex_name_from_openssl(Kex0)), - [CipherStr, AlgStr] = string:split(Rest, "-", trailing), - {Cipher, Mac, Prf} = openssl_cipher_str_to_algs(Kex, CipherStr, AlgStr), + [Part1, Part2] = string:split(Rest, "-", trailing), + {Cipher, Mac, Prf} = openssl_cipher_str_to_algs(Kex, Part1, Part2), #{key_exchange => Kex, mac => Mac, cipher => Cipher, @@ -1903,19 +2016,25 @@ suite_openssl_str_to_map(Kex0, Rest) -> }. %% Does only need own implementation PRE TLS 1.3 -openssl_cipher_str_to_algs(_, CipherStr, "CCM"= End) -> - Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), - {Cipher, aead, sha256}; -openssl_cipher_str_to_algs(_, CipherStr, "8" = End) -> - Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), +openssl_cipher_str_to_algs(_, Part1, "CCM" = End) -> + Cipher = algo_str_to_atom(cipher_name_from_openssl(Part1 ++ "_" ++ End)), + {Cipher, aead, default_prf}; +openssl_cipher_str_to_algs(_, Part1, "GCM" = End) -> + Cipher = algo_str_to_atom(cipher_name_from_openssl(Part1 ++ "_" ++ End)), + {Cipher, aead, default_prf}; +openssl_cipher_str_to_algs(_, Part2, "CCM8") -> + Cipher = algo_str_to_atom(cipher_name_from_openssl(Part2 ++ "-CCM-8")), + {Cipher, aead, default_prf}; +openssl_cipher_str_to_algs(_, Part2, "GCM8") -> + Cipher = algo_str_to_atom(cipher_name_from_openssl(Part2 ++ "-GCM-8")), + {Cipher, aead, default_prf}; +openssl_cipher_str_to_algs(_, "CHACHA20", "POLY1305") -> + Cipher = chacha20_poly1305, {Cipher, aead, sha256}; -openssl_cipher_str_to_algs(_, CipherStr, "POLY1305" = End) -> - Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), - {Cipher, aead, sha256}; -openssl_cipher_str_to_algs(Kex, CipherStr, HashStr) -> - Hash = algo_str_to_atom(HashStr), - Cipher = algo_str_to_atom(cipher_name_from_openssl(string:strip(CipherStr, left, $-))), - case openssl_is_aead_cipher(CipherStr) of +openssl_cipher_str_to_algs(Kex, Part1, Part2) -> + Hash = algo_str_to_atom(Part2), + Cipher = algo_str_to_atom(cipher_name_from_openssl(string:strip(Part1, left, $-))), + case openssl_is_aead_cipher(Part1) of true -> {Cipher, aead, Hash}; false -> diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 8e6807d0ab..02b7c8eb78 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -486,26 +486,12 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, -spec suites(1|2|3|4) -> [ssl_cipher_format:cipher_suite()]. suites(Minor) when Minor == 1; Minor == 2 -> - [ - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, - - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA - ]; + exclusive_suites(2); suites(3) -> - exclusive_suites(3) ++ suites(2); + exclusive_suites(3) ++ exclusive_suites(2); suites(4) -> - exclusive_suites(4) ++ suites(3). + exclusive_suites(4) ++ exclusive_suites(3). exclusive_suites(4) -> [?TLS_AES_256_GCM_SHA384, @@ -518,36 +504,42 @@ exclusive_suites(3) -> [?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_ECDSA_WITH_AES_256_CCM, + ?TLS_ECDHE_ECDSA_WITH_AES_256_CCM_8, + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, + + ?TLS_ECDHE_ECDSA_WITH_AES_128_CCM, + ?TLS_ECDHE_ECDSA_WITH_AES_128_CCM_8, + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, - - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, - - ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, - - ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, + + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, @@ -564,19 +556,19 @@ exclusive_suites(3) -> ]; exclusive_suites(Minor) when Minor == 1; Minor == 2 -> [ - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, - - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, + + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA ]. signature_algs({3, 4}, HashSigns) -> diff --git a/lib/ssl/test/openssl_cipher_suite_SUITE.erl b/lib/ssl/test/openssl_cipher_suite_SUITE.erl index 64c3899889..61297a5f18 100644 --- a/lib/ssl/test/openssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/openssl_cipher_suite_SUITE.erl @@ -82,7 +82,11 @@ aes_128_gcm_sha256/1, chacha20_poly1305_sha256/1, aes_128_ccm_sha256/1, - aes_128_ccm_8_sha256/1 + aes_128_ccm_8_sha256/1, + ecdhe_ecdsa_with_aes_128_ccm/1, + ecdhe_ecdsa_with_aes_256_ccm/1, + ecdhe_ecdsa_with_aes_128_ccm_8/1, + ecdhe_ecdsa_with_aes_256_ccm_8/1 ]). -define(DEFAULT_TIMEOUT, {seconds, 6}). @@ -140,7 +144,11 @@ groups() -> ecdhe_ecdsa_aes_128_gcm, ecdhe_ecdsa_aes_256_cbc, ecdhe_ecdsa_aes_256_gcm, - ecdhe_ecdsa_chacha20_poly1305 + ecdhe_ecdsa_chacha20_poly1305, + ecdhe_ecdsa_with_aes_128_ccm, + ecdhe_ecdsa_with_aes_256_ccm, + ecdhe_ecdsa_with_aes_128_ccm_8, + ecdhe_ecdsa_with_aes_256_ccm_8 ]}, {rsa, [], [rsa_des_cbc, rsa_3des_ede_cbc, @@ -298,7 +306,8 @@ do_init_per_group(ecdhe_ecdsa = GroupName, Config) -> end; do_init_per_group(dhe_dss = GroupName, Config) -> PKAlg = proplists:get_value(public_keys, crypto:supports()), - case lists:member(dss, PKAlg) andalso lists:member(dh, PKAlg) of + case lists:member(dss, PKAlg) andalso lists:member(dh, PKAlg) + andalso (ssl_test_lib:openssl_dsa_suites() =/= []) of true -> init_certs(GroupName, Config); false -> @@ -306,7 +315,8 @@ do_init_per_group(dhe_dss = GroupName, Config) -> end; do_init_per_group(srp_dss = GroupName, Config) -> PKAlg = proplists:get_value(public_keys, crypto:supports()), - case lists:member(dss, PKAlg) andalso lists:member(srp, PKAlg) of + case lists:member(dss, PKAlg) andalso lists:member(srp, PKAlg) + andalso (ssl_test_lib:openssl_dsa_suites() =/= []) of true -> init_certs(GroupName, Config); false -> @@ -339,11 +349,11 @@ do_init_per_group(dhe_rsa = GroupName, Config) -> end; do_init_per_group(rsa = GroupName, Config) -> PKAlg = proplists:get_value(public_keys, crypto:supports()), - case lists:member(rsa, PKAlg) of + case lists:member(rsa, PKAlg) andalso ssl_test_lib:openssl_support_rsa_kex() of true -> init_certs(GroupName, Config); false -> - {skip, "Missing SRP crypto support"} + {skip, "Missing RSA key exchange support"} end; do_init_per_group(dh_anon = GroupName, Config) -> PKAlg = proplists:get_value(public_keys, crypto:supports()), @@ -478,6 +488,28 @@ init_per_testcase(aes_128_ccm_8_sha256, Config) -> {skip, "Missing AES_128_CCM_8 crypto support"} end; +init_per_testcase(TestCase, Config) when TestCase == ecdhe_ecdsa_with_aes_128_ccm; + TestCase == ecdhe_ecdsa_with_aes_128_ccm_8-> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_128_ccm, SupCiphers) of + true -> + ct:timetrap(?DEFAULT_TIMEOUT), + Config; + _ -> + {skip, "Missing AES_128_CCM crypto support"} + end; + +init_per_testcase(TestCase, Config) when TestCase == ecdhe_ecdsa_with_aes_256_ccm; + TestCase == ecdhe_ecdsa_with_aes_256_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_256_ccm, SupCiphers) of + true -> + ct:timetrap(?DEFAULT_TIMEOUT), + Config; + _ -> + {skip, "Missing AES_256_CCM crypto support"} + end; + init_per_testcase(TestCase, Config) -> Cipher = ssl_test_lib:test_cipher(TestCase, Config), SupCiphers = proplists:get_value(ciphers, crypto:supports()), @@ -728,6 +760,18 @@ ecdhe_ecdsa_aes_256_gcm(Config) when is_list(Config) -> ecdhe_ecdsa_chacha20_poly1305(Config) when is_list(Config) -> run_ciphers_test(ecdhe_ecdsa, 'chacha20_poly1305', Config). + +ecdhe_ecdsa_with_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_ccm', Config). + +ecdhe_ecdsa_with_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_ccm', Config). + +ecdhe_ecdsa_with_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_ccm_8', Config). + +ecdhe_ecdsa_with_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_ccm_8', Config). %%-------------------------------------------------------------------- %% DHE_DSS -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -897,7 +941,7 @@ run_ciphers_test(Kex, Cipher, Config) -> {skip, {not_sup, Kex, Cipher, Version}} end. -cipher_suite_test(CipherSuite, _Version, Config) -> +cipher_suite_test(CipherSuite, Version, Config) -> #{server_config := SOpts, client_config := COpts} = proplists:get_value(tls_config, Config), ServerOpts = ssl_test_lib:ssl_options(SOpts, Config), @@ -905,11 +949,17 @@ cipher_suite_test(CipherSuite, _Version, Config) -> ct:log("Testing CipherSuite ~p~n", [CipherSuite]), ct:log("Server Opts ~p~n", [ServerOpts]), ct:log("Client Opts ~p~n", [ClientOpts]), - ssl_test_lib:basic_test([{ciphers, [CipherSuite]} | COpts], SOpts, Config). - + case proplists:get_value(server_type, Config) of + erlang -> + ssl_test_lib:basic_test([{ciphers, ssl:cipher_suites(all, Version)} | COpts], + [{ciphers, [CipherSuite]} | SOpts], Config); + _ -> + ssl_test_lib:basic_test([{versions, [Version]}, {ciphers, [CipherSuite]} | COpts], + [{ciphers, ssl:cipher_suites(all, Version)} | SOpts], Config) + end. test_ciphers(Kex, Cipher, Version) -> - Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, Version) ++ ssl:cipher_suites(anonymous, Version), + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, Version) ++ ssl:cipher_suites(anonymous, Version), [{key_exchange, fun(Kex0) when (Kex0 == Kex) andalso (Version =/= 'tlsv1.3') -> true; (Kex0) when (Kex0 == any) andalso (Version == 'tlsv1.3') -> true; diff --git a/lib/ssl/test/openssl_client_cert_SUITE.erl b/lib/ssl/test/openssl_client_cert_SUITE.erl index 7adfdf32a5..7e8d842f14 100644 --- a/lib/ssl/test/openssl_client_cert_SUITE.erl +++ b/lib/ssl/test/openssl_client_cert_SUITE.erl @@ -292,7 +292,8 @@ end_per_group(GroupName, Config) -> init_per_testcase(TestCase, Config) when TestCase == client_auth_empty_cert_accepted; TestCase == client_auth_empty_cert_rejected -> - Version = proplists:get_value(version,Config), + Version = ssl_test_lib:protocol_version(Config), + case Version of sslv3 -> %% Openssl client sends "No Certificate Reserved" warning ALERT diff --git a/lib/ssl/test/openssl_server_cert_SUITE.erl b/lib/ssl/test/openssl_server_cert_SUITE.erl index 4402765ea2..e71bfc8e5c 100644 --- a/lib/ssl/test/openssl_server_cert_SUITE.erl +++ b/lib/ssl/test/openssl_server_cert_SUITE.erl @@ -275,7 +275,7 @@ init_per_group(ecdsa_1_3 = Group, Config0) -> COpts = proplists:get_value(client_ecdsa_opts, Config), SOpts = proplists:get_value(server_ecdsa_opts, Config), %% Make sure ecdh* suite is choosen by ssl_test_lib:start_server - Version = proplists:get_value(version,Config), + Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_cert_tests:test_ciphers(undefined, Version), case Ciphers of [_|_] -> @@ -301,7 +301,7 @@ init_per_group(Group, Config0) when Group == dsa -> COpts = proplists:get_value(client_dsa_opts, Config), SOpts = proplists:get_value(server_dsa_opts, Config), %% Make sure dhe_dss* suite is choosen by ssl_test_lib:start_server - Version = proplists:get_value(version,Config), + Version = ssl_test_lib:protocol_version(Config), Ciphers = ssl_cert_tests:test_ciphers(fun(dh_dss) -> true; (dhe_dss) -> diff --git a/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl b/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl index b661ec8806..cf6ed755f7 100644 --- a/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl +++ b/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl @@ -73,6 +73,21 @@ prop_tls_cipher_suite_rfc_name() -> prop_tls_cipher_suite_openssl_name() -> ?FORALL({CipherSuite, _TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), case ssl:str_to_suite(ssl:suite_to_openssl_str(CipherSuite)) of + CipherSuite -> + case ssl:suite_to_openssl_str(CipherSuite) of + "TLS_" ++ _ -> + true; + OpensslName -> + lists:member(OpensslName, openssl_legacy_names()) + end; + _ -> + false + end + ). + +prop_tls_anon_cipher_suite_rfc_name() -> + ?FORALL({CipherSuite, _TLSVersion}, ?LET(Version, pre_tls_1_3_version(), {anon_cipher_suite(Version), Version}), + case ssl:str_to_suite(ssl:suite_to_str(CipherSuite)) of CipherSuite -> true; _ -> @@ -80,6 +95,15 @@ prop_tls_cipher_suite_openssl_name() -> end ). +prop_tls_anon_cipher_suite_openssl_name() -> + ?FORALL({CipherSuite, _TLSVersion}, ?LET(Version, pre_tls_1_3_version(), {anon_cipher_suite(Version), Version}), + case ssl:str_to_suite(ssl:suite_to_openssl_str(CipherSuite)) of + CipherSuite -> + lists:member(ssl:suite_to_openssl_str(CipherSuite), openssl_legacy_names()); + _ -> + false + end + ). %%-------------------------------------------------------------------- %% Generators ----------------------------------------------- @@ -87,9 +111,164 @@ prop_tls_cipher_suite_openssl_name() -> tls_version() -> oneof([?'TLS_v1.3', ?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1']). +pre_tls_1_3_version() -> + oneof([?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1']). + cipher_suite(Version) -> oneof(cipher_suites(Version)). cipher_suites(Version) -> - ssl:cipher_suites(all, Version). + ssl:cipher_suites(default, Version). + +anon_cipher_suite(Version) -> + oneof(ssl:cipher_suites(anonymous, Version)). + +openssl_legacy_names() -> + %% Only include names that we support + [ + %% Legacy with RSA keyexchange + "AES128-SHA", + "AES256-SHA", + "AES128-SHA256", + "AES256-SHA256", + "AES256-GCM-SHA256", + "AES256-GCM-SHA384", + "DES-CBC-SHA", + "DES-CBC3-SHA", + "RC4-MD5", + "RC4-SHA", + + %% DH based + "DH-RSA-AES128-SHA", + "DH-RSA-AES256-SHA", + "DH-RSA-AES128-SHA256", + "DH-RSA-AES256-SHA256", + "DH-DSS-AES128-SHA", + "DH-DSS-AES256-SHA", + "DH-DSS-AES128-SHA256", + "DH-DSS-AES256-SHA256", + "EDH-RSA-DES-CBC-SHA", + "EDH-RSA-DES-CBC3-SHA", + "DHE-RSA-AES128-SHA", + "DHE-RSA-AES256-SHA", + "DHE-RSA-AES128-SHA256", + "DHE-RSA-AES256-SHA256", + "DHE-RSA-AES256-SHA384", + "DHE-RSA-AES128-GCM-SHA256", + "DHE-RSA-AES256-GCM-SHA384", + "DHE-RSA-AES128-CCM-SHA256", + "DHE-RSA-AES256-CCM-SHA384", + "DHE-RSA-AES128-CCM8-SHA256", + "DHE-RSA-AES256-CCM8-SHA384", + "DHE-RSA-CHACHA20-POLY1305", + "EDH-DSS-DES-CBC-SHA", + "EDH-DSS-DES-CBC3-SHA", + "DHE-DSS-AES128-SHA", + "DHE-DSS-AES256-SHA", + "DHE-DSS-AES128-SHA256", + "DHE-DSS-AES256-SHA256", + "DHE-DSS-AES256-SHA384", + "DHE-DSS-AES128-GCM-SHA256", + "DHE-DSS-AES256-GCM-SHA384", + "DHE-DSS-RC4-SHA", + "ADH-AES128-SHA256", + "ADH-AES256-SHA256", + "ADH-AES128-CBC-SHA256", + "ADH-AES128-GCM-SHA256", + "ADH-AES256-GCM-SHA384", + "ADH-RC4-MD5", + "ADH-DES-CBC-SHA", + "ADH-DES-CBC3-SHA", + "ADH-AES256-SHA", + "ADH-AES256-SHA256", + + %% ECDH based + "ECDH-ECDSA-AES128-SHA", + "ECDH-ECDSA-AES256-SHA", + "ECDH-ECDSA-AES128-SHA256", + "ECDH-ECDSA-AES256-SHA384", + "ECDH-ECDSA-AES128-GCM-SHA256", + "ECDH-ECDSA-AES256-GCM-SHA384", + "ECDHE-ECDSA-AES128-CCM", + "ECDHE-ECDSA-AES128-CCM8", + "ECDHE-ECDSA-AES256-CCM", + "ECDHE-ECDSA-AES256-CCM8", + "ECDH-ECDSA-CHACHA20-POLY1305", + "ECDHE-ECDSA-AES128-SHA", + "ECDHE-ECDSA-AES256-SHA", + "ECDHE-ECDSA-AES128-SHA256", + "ECDHE-ECDSA-AES256-SHA384", + "ECDHE-ECDSA-AES128-GCM-SHA256", + "ECDHE-ECDSA-AES256-GCM-SHA384", + "ECDHE-ECDSA-CHACHA20-POLY1305", + "ECDH-RSA-AES128-SHA", + "ECDH-RSA-AES256-SHA", + "ECDH-RSA-AES128-SHA256", + "ECDH-RSA-AES256-SHA384", + "ECDH-RSA-AES128-GCM-SHA256", + "ECDH-RSA-AES256-GCM-SHA384", + "ECDHE-RSA-AES128-SHA", + "ECDHE-RSA-AES256-SHA", + "ECDHE-RSA-AES128-SHA256", + "ECDHE-RSA-AES256-SHA384", + "ECDHE-RSA-AES128-GCM-SHA256", + "ECDHE-RSA-AES128-GCM-SHA384", + "ECDHE-RSA-AES256-GCM-SHA256", + "ECDHE-RSA-AES256-GCM-SHA384", + "ECDHE-RSA-CHACHA20-POLY1305", + "ECDHE-PSK-RC4-SHA", + "ECDHE-PSK-3DES-EDE-CBC-SHA", + "ECDHE-PSK-AES128-CBC-SHA", + "ECDHE-PSK-AES128-CBC-SHA256", + "ECDHE-PSK-AES256-CBC-SHA384", + "ECDHE-PSK-AES128-GCM-SHA256", + "ECDHE-PSK-AES256-GCM-SHA384", + "ECDHE-PSK-AES128-CCM-SHA256", + "ECDHE-PSK-AES128-CCM8-SHA256", + "ECDHE-PSK-CHACHA20-POLY1305", + "AECDH-DES-CBC3-SHA", + "AECDH-AES128-SHA", + "AECDH-AES256-SHA", + %% PSK based + "DHE-PSK-NULL-SHA", + "DHE-PSK-RC4-SHA", + "DHE-PSK-3DES-EDE-CBC-SHA", + "DHE-PSK-AES128-CBC-SHA", + "DHE-PSK-AES256-CBC-SHA", + "DHE-PSK-AES128-CBC-SHA256", + "DHE-PSK-AES256-CBC-SHA384", + "DHE-PSK-AES128-GCM-SHA256", + "DHE-PSK-AES256-GCM-SHA384", + "DHE-PSK-AES128-CCM", + "DHE-PSK-AES128-CCM8", + "DHE-PSK-AES256-CCM", + "DHE-PSK-AES256-CCM8", + "DHE-PSK-AES128-CCM-SHA256", + "DHE-PSK-AES128-CCM8-SHA256", + "DHE-PSK-CHACHA20-POLY1305", + "PSK-NULL-SHA", + "PSK-RC4-SHA", + "PSK-3DES-EDE-CBC-SHA", + "PSK-AES128-CBC-SHA", + "PSK-AES256-CBC-SHA", + "PSK-AES128-CBC-SHA256", + "PSK-AES256-CBC-SHA256", + "PSK-AES128-CCM", + "PSK-AES128-CCM8", + "PSK-AES256-CCM", + "PSK-AES256-CCM8", + "PSK-AES128-GCM-SHA256", + "PSK-AES256-CBC-SHA384", + "PSK-AES256-GCM-SHA384", + "PSK-CHACHA20-POLY1305", + "RSA-PSK-NULL-SHA", + "RSA-PSK-CHACHA20-POLY1305", + + %% SRP based + "SRP-3DES-EDE-CBC-SHA", + "SRP-RSA-3DES-EDE-CBC-SHA", + "SRP-DSS-3DES-EDE-CBC-SHA", + "SRP-AES-128-CBC-SHA", + "SRP-AES-256-CBC-SHA" + ]. diff --git a/lib/ssl/test/ssl_api_SUITE.erl b/lib/ssl/test/ssl_api_SUITE.erl index 92ffb29f21..93ecff0706 100644 --- a/lib/ssl/test/ssl_api_SUITE.erl +++ b/lib/ssl/test/ssl_api_SUITE.erl @@ -776,7 +776,11 @@ handshake_continue_tls13_client(Config) when is_list(Config) -> ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - + SCiphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, 'tlsv1.3'), + [{key_exchange, fun(srp_rsa) -> false; + (srp_anon) -> false; + (srp_dss) -> false; + (_) -> true end}]), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -784,6 +788,7 @@ handshake_continue_tls13_client(Config) when is_list(Config) -> {options, ssl_test_lib:ssl_options([{reuseaddr, true}, {log_level, debug}, {verify, verify_peer}, + {ciphers, SCiphers}, {handshake, hello} | ServerOpts ], Config)}, @@ -826,6 +831,7 @@ handshake_continue_tls13_client(Config) when is_list(Config) -> 'tlsv1.1', 'tlsv1' ]}, + {ciphers, ssl:cipher_suites(all, 'tlsv1.3')}, {verify, verify_peer} | ClientOpts ], Config)}, diff --git a/lib/ssl/test/ssl_cipher_suite_SUITE.erl b/lib/ssl/test/ssl_cipher_suite_SUITE.erl index 99911af370..22dbc3663c 100644 --- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl @@ -124,7 +124,11 @@ aes_128_gcm_sha256/1, chacha20_poly1305_sha256/1, aes_128_ccm_sha256/1, - aes_128_ccm_8_sha256/1 + aes_128_ccm_8_sha256/1, + ecdhe_ecdsa_with_aes_128_ccm/1, + ecdhe_ecdsa_with_aes_256_ccm/1, + ecdhe_ecdsa_with_aes_128_ccm_8/1, + ecdhe_ecdsa_with_aes_256_ccm_8/1 ]). -define(TIMEOUT, {seconds, 10}). @@ -171,7 +175,11 @@ groups() -> ecdhe_ecdsa_aes_128_gcm, ecdhe_ecdsa_aes_256_cbc, ecdhe_ecdsa_aes_256_gcm, - ecdhe_ecdsa_chacha20_poly1305 + ecdhe_ecdsa_chacha20_poly1305, + ecdhe_ecdsa_with_aes_128_ccm, + ecdhe_ecdsa_with_aes_256_ccm, + ecdhe_ecdsa_with_aes_128_ccm_8, + ecdhe_ecdsa_with_aes_256_ccm_8 ]}, {rsa, [], [rsa_3des_ede_cbc, rsa_aes_128_cbc, @@ -482,6 +490,26 @@ init_per_testcase(aes_128_ccm_8_sha256, Config) -> _ -> {skip, "Missing AES_128_CCM_8_SHA256 crypto support"} end; +init_per_testcase(TestCase, Config) when TestCase == ecdhe_ecdsa_with_aes_128_ccm; + TestCase == ecdhe_ecdsa_with_aes_128_ccm_8-> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_128_ccm, SupCiphers) of + true -> + ct:timetrap(?TIMEOUT), + Config; + _ -> + {skip, "Missing AES_128_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == ecdhe_ecdsa_with_aes_256_ccm; + TestCase == ecdhe_ecdsa_with_aes_256_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_256_ccm, SupCiphers) of + true -> + ct:timetrap(?TIMEOUT), + Config; + _ -> + {skip, "Missing AES_256_CCM crypto support"} + end; init_per_testcase(TestCase, Config) -> Cipher = ssl_test_lib:test_cipher(TestCase, Config), SupCiphers = proplists:get_value(ciphers, crypto:supports()), @@ -744,6 +772,18 @@ ecdhe_ecdsa_aes_256_gcm(Config) when is_list(Config) -> ecdhe_ecdsa_chacha20_poly1305(Config) when is_list(Config) -> run_ciphers_test(ecdhe_ecdsa, 'chacha20_poly1305', Config). + +ecdhe_ecdsa_with_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_ccm', Config). + +ecdhe_ecdsa_with_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_ccm', Config). + +ecdhe_ecdsa_with_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_ccm_8', Config). + +ecdhe_ecdsa_with_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_ccm_8', Config). %%-------------------------------------------------------------------- %% DHE_DSS -------------------------------------------------------- %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_eqc_SUITE.erl b/lib/ssl/test/ssl_eqc_SUITE.erl index 15f8782d8a..3c9a1d0ab0 100644 --- a/lib/ssl/test/ssl_eqc_SUITE.erl +++ b/lib/ssl/test/ssl_eqc_SUITE.erl @@ -34,6 +34,8 @@ -export([tls_handshake_encoding/1, tls_cipher_suite_names/1, tls_cipher_openssl_suite_names/1, + tls_anon_cipher_suite_names/1, + tls_anon_cipher_openssl_suite_names/1, tls_unorded_chains/1, tls_extraneous_chain/1, tls_extraneous_chains/1, @@ -49,6 +51,8 @@ all() -> tls_handshake_encoding, tls_cipher_suite_names, tls_cipher_openssl_suite_names, + tls_anon_cipher_suite_names, + tls_anon_cipher_openssl_suite_names, tls_unorded_chains, tls_extraneous_chain, tls_extraneous_chains, @@ -85,6 +89,15 @@ tls_cipher_openssl_suite_names(Config) when is_list(Config) -> %% manual test: proper:quickcheck(ssl_eqc_handshake:prop_tls_cipher_suite_openssl_name()). true = ct_property_test:quickcheck(ssl_eqc_cipher_format:prop_tls_cipher_suite_openssl_name(), Config). +tls_anon_cipher_suite_names(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(ssl_eqc_cipher_format:prop_tls_cipher_suite_rfc_name()). + true = ct_property_test:quickcheck(ssl_eqc_cipher_format:prop_tls_anon_cipher_suite_rfc_name(), + Config). + +tls_anon_cipher_openssl_suite_names(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(ssl_eqc_handshake:prop_tls_cipher_suite_openssl_name()). + true = ct_property_test:quickcheck(ssl_eqc_cipher_format:prop_tls_anon_cipher_suite_openssl_name(), + Config). tls_unorded_chains(Config) when is_list(Config) -> %% manual test: proper:quickcheck(ssl_eqc_chain:prop_tls_ordered_path("/tmp") diff --git a/lib/ssl/test/ssl_session_SUITE.erl b/lib/ssl/test/ssl_session_SUITE.erl index 0a614f8b8c..b11e49ad89 100644 --- a/lib/ssl/test/ssl_session_SUITE.erl +++ b/lib/ssl/test/ssl_session_SUITE.erl @@ -143,8 +143,9 @@ reuse_session() -> reuse_session(Config) when is_list(Config) -> ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), - - ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). + Version = ssl_test_lib:protocol_version(Config), + ssl_test_lib:reuse_session([{versions,[Version]} | ClientOpts], + [{versions,[Version]} | ServerOpts], Config). %%-------------------------------------------------------------------- reuse_session_expired() -> [{doc,"Test sessions is not reused when it has expired"}]. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index a001d49cf2..2f3b8afdb0 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -132,7 +132,8 @@ reuse_session/3, test_ciphers/3, test_cipher/2, - openssl_ciphers/0 + openssl_ciphers/0, + openssl_support_rsa_kex/0 ]). -export([tls_version/1, @@ -271,7 +272,7 @@ init_per_group(GroupName, Config0) -> case is_protocol_version(GroupName) andalso sufficient_crypto_support(GroupName) of true -> Config = clean_protocol_version(Config0), - init_protocol_version(GroupName, Config); + [{version, GroupName}|init_protocol_version(GroupName, Config)]; _ -> case sufficient_crypto_support(GroupName) of true -> @@ -282,9 +283,10 @@ init_per_group(GroupName, Config0) -> end end. -init_per_group_openssl(GroupName, Config) -> +init_per_group_openssl(GroupName, Config0) -> case is_tls_version(GroupName) andalso sufficient_crypto_support(GroupName) of true -> + Config = clean_protocol_version(Config0), case openssl_tls_version_support(GroupName, Config) of true -> @@ -296,7 +298,7 @@ init_per_group_openssl(GroupName, Config) -> case sufficient_crypto_support(GroupName) of true -> ssl:start(), - Config; + Config0; false -> {skip, "Missing crypto support"} end @@ -320,7 +322,21 @@ openssl_ocsp_support() -> openssl_ciphers() -> Str = portable_cmd("openssl", ["ciphers"]), - string:split(string:strip(Str, right, $\n), ":", all). + Ciphers = string:split(string:strip(Str, right, $\n), ":", all), + case portable_cmd("openssl", ["version"]) of + "LibreSSL 3." ++ _ -> + Ciphers -- ["DES-CBC3-SHA","AES128-SHA", "AES256-SHA", "RC4-SHA", "RC4-MD5"]; + _ -> + Ciphers + end. + +openssl_support_rsa_kex() -> + case portable_cmd("openssl", ["version"]) of + "OpenSSL 1.1.1" ++ _Rest -> + false; + _ -> + true + end. %%==================================================================== %% Internal functions @@ -2020,13 +2036,12 @@ start_server(openssl, ClientOpts, ServerOpts, Config) -> start_server(erlang, _, ServerOpts, Config) -> {_, ServerNode, _} = run_where(Config), KeyEx = proplists:get_value(check_keyex, Config, false), - Versions = protocol_versions(Config), Server = start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}}, - {options, [{verify, verify_peer}, {versions, Versions} | ServerOpts]}]), + {options, [{verify, verify_peer} | ServerOpts]}]), {Server, inet_port(Server)}. sig_algs(undefined) -> @@ -2077,7 +2092,6 @@ openssl_maxfag_option(Int) -> openssl_debug_options() -> ["-msg", "-debug"]. - start_server_with_raw_key(erlang, ServerOpts, Config) -> {_, ServerNode, _} = run_where(Config), Server = start_server([{node, ServerNode}, {port, 0}, @@ -2144,7 +2158,8 @@ openssl_cert_options(Opts, Role) -> Other end; _ -> - cert_option("-cert", Cert) ++ cert_option("-CAfile", CA) ++ + cert_option("-cert", Cert) ++ cert_option("-CAfile", CA) + ++ cert_option("-cert_chain", CA) ++ cert_option("-key", Key) ++ openssl_verify(Opts) ++ ["2"] end. @@ -2158,6 +2173,13 @@ openssl_verify(Opts) -> cert_option(_, undefined) -> []; +cert_option("-cert_chain", Value) -> + case portable_cmd("openssl", ["version"]) of + "OpenSSL 1.1.1" ++ _ -> + ["-cert_chain", Value]; + _ -> + "" + end; cert_option(Opt, Value) -> [Opt, Value]. @@ -2405,7 +2427,7 @@ init_protocol_version(Version, Config) -> [{protocol, tls} | NewConfig]. clean_protocol_version(Config) -> - proplists:delete(protocol_opts, proplists:delete(protocol, Config)). + proplists:delete(version, proplists:delete(protocol_opts, proplists:delete(protocol, Config))). sufficient_crypto_support(Version) when Version == 'tlsv1.3' -> diff --git a/lib/ssl/test/tls_1_3_version_SUITE.erl b/lib/ssl/test/tls_1_3_version_SUITE.erl index 3fd1683029..03fcb9afe5 100644 --- a/lib/ssl/test/tls_1_3_version_SUITE.erl +++ b/lib/ssl/test/tls_1_3_version_SUITE.erl @@ -59,25 +59,27 @@ %%-------------------------------------------------------------------- all() -> [ - {group, 'tlsv1.3'} + cert_groups() ]. groups() -> [ - {'tlsv1.3', [], cert_groups()}, - {rsa, [], tests()}, - {ecdsa, [], tests()} + {rsa, [], tls_1_3_1_2_tests() ++ legacy_tests()}, + {ecdsa, [], tls_1_3_1_2_tests()} ]. cert_groups() -> [{group, rsa}, {group, ecdsa}]. -tests() -> +tls_1_3_1_2_tests() -> [tls13_client_tls12_server, tls13_client_with_ext_tls12_server, tls12_client_tls13_server, - tls_client_tls10_server, + tls_client_tls12_server, + tls12_client_tls_server]. +legacy_tests() -> + [tls_client_tls10_server, tls_client_tls11_server, tls_client_tls12_server, tls10_client_tls_server, @@ -88,9 +90,14 @@ init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of ok -> - ssl_test_lib:clean_start(), - [{client_type, erlang}, {server_type, erlang} | - Config] + case ssl_test_lib:sufficient_crypto_support('tlsv1.3') of + true -> + ssl_test_lib:clean_start(), + [{client_type, erlang}, {server_type, erlang} | + Config]; + false -> + {skip, "Insufficient crypto support for TLS-1.3"} + end catch _:_ -> {skip, "Crypto did not start"} end. @@ -99,23 +106,14 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -init_per_group(GroupName, Config) -> - case ssl_test_lib:is_protocol_version(GroupName) of - true -> - ssl_test_lib:init_per_group(GroupName, - [{client_type, erlang}, - {server_type, erlang} | Config]); - false -> - do_init_per_group(GroupName, Config) - end. - -do_init_per_group(rsa, Config0) -> +init_per_group(rsa, Config0) -> Config = ssl_test_lib:make_rsa_cert(Config0), COpts = proplists:get_value(client_rsa_opts, Config), SOpts = proplists:get_value(server_rsa_opts, Config), - [{client_cert_opts, COpts}, {server_cert_opts, SOpts} | + [{client_type, erlang}, + {server_type, erlang},{client_cert_opts, COpts}, {server_cert_opts, SOpts} | lists:delete(server_cert_opts, lists:delete(client_cert_opts, Config))]; -do_init_per_group(ecdsa, Config0) -> +init_per_group(ecdsa, Config0) -> PKAlg = crypto:supports(public_keys), case lists:member(ecdsa, PKAlg) andalso (lists:member(ecdh, PKAlg) orelse lists:member(dh, PKAlg)) of @@ -123,7 +121,8 @@ do_init_per_group(ecdsa, Config0) -> Config = ssl_test_lib:make_ecdsa_cert(Config0), COpts = proplists:get_value(client_ecdsa_opts, Config), SOpts = proplists:get_value(server_ecdsa_opts, Config), - [{client_cert_opts, COpts}, {server_cert_opts, SOpts} | + [{client_type, erlang}, + {server_type, erlang},{client_cert_opts, COpts}, {server_cert_opts, SOpts} | lists:delete(server_cert_opts, lists:delete(client_cert_opts, Config))]; false -> {skip, "Missing EC crypto support"} @@ -175,21 +174,38 @@ tls12_client_tls13_server(Config) when is_list(Config) -> tls_client_tls10_server() -> [{doc,"Test that a TLS 1.0-1.3 client can connect to a TLS 1.0 server."}]. tls_client_tls10_server(Config) when is_list(Config) -> + CCiphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, 'tlsv1.3'), + [{key_exchange, fun(srp_rsa) -> false; + (srp_anon) -> false; + (srp_dss) -> false; + (_) -> true end}]), ClientOpts = [{versions, - ['tlsv1', 'tlsv1.1', 'tlsv1.2', 'tlsv1.3']} | + ['tlsv1', 'tlsv1.1', 'tlsv1.2', 'tlsv1.3']}, + {ciphers, CCiphers} + | ssl_test_lib:ssl_options(client_cert_opts, Config)], ServerOpts = [{versions, - ['tlsv1']} | ssl_test_lib:ssl_options(server_cert_opts, Config)], + ['tlsv1']}, + {ciphers, ssl:cipher_suites(all, 'tlsv1')} + | ssl_test_lib:ssl_options(server_cert_opts, Config)], ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config). tls_client_tls11_server() -> [{doc,"Test that a TLS 1.0-1.3 client can connect to a TLS 1.1 server."}]. tls_client_tls11_server(Config) when is_list(Config) -> + CCiphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, 'tlsv1.3'), + [{key_exchange, fun(srp_rsa) -> false; + (srp_anon) -> false; + (srp_dss) -> false; + (_) -> true end}]), ClientOpts = [{versions, - ['tlsv1', 'tlsv1.1', 'tlsv1.2', 'tlsv1.3']} | + ['tlsv1', 'tlsv1.1', 'tlsv1.2', 'tlsv1.3']}, + {ciphers, CCiphers} | ssl_test_lib:ssl_options(client_cert_opts, Config)], ServerOpts = [{versions, - ['tlsv1.1']} | ssl_test_lib:ssl_options(server_cert_opts, Config)], + ['tlsv1.1']}, + {ciphers, ssl:cipher_suites(all, 'tlsv1.1')} + | ssl_test_lib:ssl_options(server_cert_opts, Config)], ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config). tls_client_tls12_server() -> @@ -205,20 +221,36 @@ tls_client_tls12_server(Config) when is_list(Config) -> tls10_client_tls_server() -> [{doc,"Test that a TLS 1.0 client can connect to a TLS 1.0-1.3 server."}]. tls10_client_tls_server(Config) when is_list(Config) -> + SCiphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, 'tlsv1.3'), + [{key_exchange, fun(srp_rsa) -> false; + (srp_anon) -> false; + (srp_dss) -> false; + (_) -> true end}]), ClientOpts = [{versions, - ['tlsv1']} | ssl_test_lib:ssl_options(client_cert_opts, Config)], + ['tlsv1']}, {ciphers, ssl:cipher_suites(all, 'tlsv1')} | ssl_test_lib:ssl_options(client_cert_opts, Config)], ServerOpts = [{versions, - ['tlsv1','tlsv1.1', 'tlsv1.2', 'tlsv1.3']} | + ['tlsv1','tlsv1.1', 'tlsv1.2', 'tlsv1.3']}, + {ciphers, SCiphers} + | ssl_test_lib:ssl_options(server_cert_opts, Config)], ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config). tls11_client_tls_server() -> [{doc,"Test that a TLS 1.1 client can connect to a TLS 1.0-1.3 server."}]. tls11_client_tls_server(Config) when is_list(Config) -> + SCiphers = ssl:filter_cipher_suites(ssl:cipher_suites(all, 'tlsv1.3'), + [{key_exchange, fun(srp_rsa) -> false; + (srp_anon) -> false; + (srp_dss) -> false; + (_) -> true end}]), + ClientOpts = [{versions, - ['tlsv1.1']} | ssl_test_lib:ssl_options(client_cert_opts, Config)], + ['tlsv1.1']}, {ciphers, ssl:cipher_suites(all, 'tlsv1.1')} | + ssl_test_lib:ssl_options(client_cert_opts, Config)], ServerOpts = [{versions, - ['tlsv1','tlsv1.1', 'tlsv1.2', 'tlsv1.3']} | + ['tlsv1','tlsv1.1', 'tlsv1.2', 'tlsv1.3']}, + {ciphers, SCiphers} + | ssl_test_lib:ssl_options(server_cert_opts, Config)], ssl_test_lib:basic_test(ClientOpts, ServerOpts, Config). diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 5a35087050..f7a1b04b55 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -147,7 +147,6 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: #{ta() => #typeinfo{}}, exp_types=gb_sets:empty() %Exported types :: gb_sets:set(ta()), - in_try_head=false :: boolean(), %In a try head. bvt = none :: 'none' | [any()], %Variables in binary pattern gexpr_context = guard %Context of guard expression :: gexpr_context() @@ -3335,11 +3334,10 @@ is_module_dialyzer_option(Option) -> try_clauses(Scs, Ccs, In, Vt, Uvt, St0) -> {Csvt0,St1} = icrt_clauses(Scs, Vt, St0), - St2 = St1#lint{in_try_head=true}, - {Csvt1,St3} = icrt_clauses(Ccs, vtupdate(Uvt, Vt), St2), + {Csvt1,St2} = catch_clauses(Ccs, vtupdate(Uvt, Vt), St1), Csvt = Csvt0 ++ Csvt1, - UpdVt = icrt_export(Csvt, Vt, In, St3), - {UpdVt,St3#lint{in_try_head=false}}. + UpdVt = icrt_export(Csvt, Vt, In, St2), + {UpdVt,St2}. %% icrt_clauses(Clauses, In, ImportVarTable, State) -> %% {UpdVt,State}. @@ -3356,29 +3354,40 @@ icrt_clauses(Cs, Vt, St) -> mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs). icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> - Vt1 = taint_stack_var(Vt0, H, St0), - {Hvt,Hnew,St1} = head(H, Vt1, St0), - Vt2 = vtupdate(Hvt, Hnew), - Vt3 = taint_stack_var(Vt2, H, St0), - {Gvt,St2} = guard(G, vtupdate(Vt3, Vt0), St1#lint{in_try_head=false}), - Vt4 = vtupdate(Gvt, Vt2), - {Bvt,St3} = exprs(B, vtupdate(Vt4, Vt0), St2), - {vtupdate(Bvt, Vt4),St3}. - -taint_stack_var(Vt, Pat, #lint{in_try_head=true}) -> - [{tuple,_,[_,_,{var,_,Stk}]}] = Pat, - case Stk of - '_' -> - Vt; - _ -> - lists:map(fun({V,{bound,Used,Lines}}) when V =:= Stk -> - {V,{stacktrace,Used,Lines}}; - (B) -> - B - end, Vt) - end; -taint_stack_var(Vt, _Pat, #lint{in_try_head=false}) -> - Vt. + {Hvt,Hnew,St1} = head(H, Vt0, St0), + Vt1 = vtupdate(Hvt, Hnew), + {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1), + Vt2 = vtupdate(Gvt, Vt1), + {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2), + {vtupdate(Bvt, Vt2),St3}. + +catch_clauses(Cs, Vt, St) -> + mapfoldl(fun(C, St0) -> catch_clause(C, Vt, St0) end, St, Cs). + +catch_clause({clause,_Line,H,G,B}, Vt0, St0) -> + [{tuple,_,[_,_,Stack]}] = H, + {Hvt,Hnew,St1} = head(H, Vt0, St0), + Vt1 = vtupdate(Hvt, Hnew), + %% check and mark the stack trace variable before checking the guard + {GuardVt,St2} = taint_stack_var(Stack, vtupdate(Vt1, Vt0), St1), + {Gvt,St3} = guard(G, GuardVt, St2), + Vt2 = vtupdate(Gvt, Vt1), + {Bvt,St4} = exprs(B, vtupdate(Vt2, Vt0), St3), + {vtupdate(Bvt, Vt2),St4}. + +taint_stack_var({var,L,V}, Vt, St) when V =/= '_' -> + St1 = case orddict:find(V, Vt) of + {ok,{_,used,_}} -> + %% the stack var must be unused after processing the pattern; + %% it can be used either if bound/unsafe before the try, or + %% if it occurs in the class or term part of the pattern + add_error(L, {stacktrace_bound,V}, St); + _ -> + St + end, + {vtupdate([{V,{stacktrace,unused,[L]}}], Vt), St1}; +taint_stack_var(_, Vt, St) -> + {Vt, St}. icrt_export(Vts, Vt, {Tag,Attrs}, St) -> {_File,Loc} = loc(Attrs, St), @@ -3622,9 +3631,6 @@ pat_var(V, Line, Vt, New, St) -> {[{V,{bound,used,Ls}}],[], %% As this is matching, exported vars are risky. add_warning(Line, {exported_var,V,From}, St)}; - {ok,{stacktrace,_Usage,Ls}} -> - {[{V,{bound,used,Ls}}],[], - add_error(Line, {stacktrace_bound,V}, St)}; error when St#lint.recdef_top -> {[],[{V,{bound,unused,[Line]}}], add_error(Line, {variable_in_record_def,V}, St)}; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index eb81e1b518..65eef5a57c 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -466,12 +466,14 @@ try_clause -> pat_expr clause_guard clause_body : {clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}. try_clause -> atom ':' pat_expr try_opt_stacktrace clause_guard clause_body : A = ?anno('$1'), - {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}. + T = case '$4' of '_' -> {var,A,'_'}; V -> V end, + {clause,A,[{tuple,A,['$1','$3',T]}],'$5','$6'}. try_clause -> var ':' pat_expr try_opt_stacktrace clause_guard clause_body : A = ?anno('$1'), - {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}. + T = case '$4' of '_' -> {var,A,'_'}; V -> V end, + {clause,A,[{tuple,A,['$1','$3',T]}],'$5','$6'}. -try_opt_stacktrace -> ':' var : element(3, '$2'). +try_opt_stacktrace -> ':' var : '$2'. try_opt_stacktrace -> '$empty' : '_'. argument_list -> '(' ')' : {[],?anno('$1')}. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 85567c88cb..d5d099bbbd 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -4224,6 +4224,14 @@ stacktrace_syntax(Config) -> ">>, [], {errors,[{4,erl_lint,{stacktrace_bound,'Stk'}}],[]}}, + {bound_in_pattern, + <<"t1() -> + try error(foo) + catch _:{x,T}:T -> ok + end. + ">>, + [], + {errors,[{3,erl_lint,{stacktrace_bound,'T'}}],[]}}, {guard_and_bound, <<"t1() -> Stk = [], diff --git a/lib/tools/doc/src/fprof.xml b/lib/tools/doc/src/fprof.xml index db1a28d53e..7a0b751e66 100644 --- a/lib/tools/doc/src/fprof.xml +++ b/lib/tools/doc/src/fprof.xml @@ -520,7 +520,7 @@ -module(foo). -export([create_file_slow/2]). -create_file_slow(Name, N) when integer(N), N >= 0 -> +create_file_slow(Name, N) when is_integer(N), N >= 0 -> {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]), if N > 256 -> diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index de7a23d16e..936eb19327 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -19,7 +19,7 @@ %% -module(instrument_SUITE). --export([all/0, suite/0]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). -export([allocations_enabled/1, allocations_disabled/1, allocations_ramv/1, carriers_enabled/1, carriers_disabled/1]). @@ -37,6 +37,19 @@ all() -> [allocations_enabled, allocations_disabled, allocations_ramv, carriers_enabled, carriers_disabled]. +init_per_suite(Config) -> + case test_server:is_asan() of + true -> + %% No point testing own allocators under address sanitizer. + {skip, "Address sanitizer"}; + false -> + Config + end. + +end_per_suite(_Config) -> + ok. + + -define(GENERATED_SBC_BLOCK_COUNT, 1000). -define(GENERATED_MBC_BLOCK_COUNT, ?GENERATED_SBC_BLOCK_COUNT). diff --git a/make/otp_subdir.mk b/make/otp_subdir.mk index 19c744955c..f9b993e048 100644 --- a/make/otp_subdir.mk +++ b/make/otp_subdir.mk @@ -20,12 +20,12 @@ # Make include file for otp .PHONY: debug opt lcnt release docs release_docs tests release_tests \ - clean depend valgrind static_lib + clean depend valgrind asan static_lib # # Targets that don't affect documentation directories # -opt debug lcnt release docs release_docs tests release_tests clean depend valgrind static_lib xmllint: +opt debug lcnt release docs release_docs tests release_tests clean depend valgrind asan static_lib xmllint: @set -e ; \ app_pwd=`pwd` ; \ if test -f vsn.mk; then \ diff --git a/make/run_make.mk b/make/run_make.mk index d66339d28e..4185927f72 100644 --- a/make/run_make.mk +++ b/make/run_make.mk @@ -29,9 +29,9 @@ include $(ERL_TOP)/make/output.mk include $(ERL_TOP)/make/target.mk -.PHONY: valgrind +.PHONY: valgrind asan -opt debug valgrind gcov gprof lcnt frmptr icount: +opt debug valgrind asan gcov gprof lcnt frmptr icount: $(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@ emu jit: diff --git a/system/doc/oam/oam_intro.xml b/system/doc/oam/oam_intro.xml index 3d08a5f3b1..1f12d240c6 100644 --- a/system/doc/oam/oam_intro.xml +++ b/system/doc/oam/oam_intro.xml @@ -219,7 +219,7 @@ snmp:c("MY-MIB", [{il, ["snmp/priv/mibs"]}]).</code> code-only, while others need a server. One way, used by the code-only MIB implementations, is for the user to call a function such as - <c>snmpa:unload_mibs(Agent, [Mib])</c> + <c>snmpa:load_mibs(Agent, [Mib])</c> to load the MIB, and <c>snmpa:unload_mibs(Agent, [Mib])</c> to unload the MIB. See the manual page for each application for diff --git a/system/doc/programming_examples/list_comprehensions.xml b/system/doc/programming_examples/list_comprehensions.xml index 706cb337ad..f9ce57f478 100644 --- a/system/doc/programming_examples/list_comprehensions.xml +++ b/system/doc/programming_examples/list_comprehensions.xml @@ -40,10 +40,10 @@ <c>[1,2,a,...]</c> and X is greater than 3.</p> <p>The notation <c><![CDATA[X <- [1,2,a,...]]]></c> is a generator and the expression <c>X > 3</c> is a filter.</p> - <p>An additional filter, <c>integer(X)</c>, can be added to restrict + <p>An additional filter, <c>is_integer(X)</c>, can be added to restrict the result to integers:</p> <pre> -> <input>[X || X <- [1,2,a,3,4,b,5,6], integer(X), X > 3].</input> +> <input>[X || X <- [1,2,a,3,4,b,5,6], is_integer(X), X > 3].</input> [4,5,6]</pre> <p>Generators can be combined. For example, the Cartesian product of two lists can be written as follows:</p> diff --git a/system/doc/programming_examples/records.xml b/system/doc/programming_examples/records.xml index d74ce22e4e..04c06816c5 100644 --- a/system/doc/programming_examples/records.xml +++ b/system/doc/programming_examples/records.xml @@ -222,7 +222,7 @@ print(#person{name = Name, age = Age, %% Demonstrates type testing, selector, updating. -birthday(P) when record(P, person) -> +birthday(P) when is_record(P, person) -> P#person{age = P#person.age + 1}. register_two_hackers() -> diff --git a/xcomp/erl-xcomp-x86_64-android.conf b/xcomp/erl-xcomp-x86_64-android.conf new file mode 100644 index 0000000000..6c9747353d --- /dev/null +++ b/xcomp/erl-xcomp-x86_64-android.conf @@ -0,0 +1,280 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2021. 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% +## +## File: erl-xcomp-x86_64-android.conf +## Author: Paulo Oliveira +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host=x86_64-linux-android + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--disable-hipe --without-termcap --without-wx \ + --enable-builtin-zlib" + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC=x86_64-linux-$NDK_ABI_PLAT-clang + +# * `CFLAGS' - C compiler flags. +#CFLAGS= + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +#CPP= + +# * `CPPFLAGS' - C pre-processor flags. +#CPPFLAGS= + +# * `CXX' - C++ compiler. +CXX=x86_64-linux-$NDK_ABI_PLAT-clang++ + +# * `CXXFLAGS' - C++ compiler flags. +#CXXFLAGS= + +# * `LD' - Linker. +LD=x86_64-linux-android-ld.gold + +# * `LDFLAGS' - Linker flags. +#LDFLAGS= + +# * `LIBS' - Libraries. +#LIBS= + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +#RANLIB= + +# * `AR' - `ar' archiving tool. +#AR= + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +erl_xcomp_sysroot="$NDK_ROOT/sys_root" + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot= + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the +# target system must have doubles in "middle-endian" format. If +# `no`, it has "regular" endianness. This can often be automatically +# detected, but not always. If not automatically detected, +# `configure` will fail unless this variable is set. Since no +# default value is used, `configure` will try to figure this out +# automatically. +#erl_xcomp_double_middle_endian + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +#erl_xcomp_poll= + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +# * `erl_xcomp_posix_memalign' - `yes|no'. Defaults to `yes' if `posix_memalign' +# system call exists; otherwise `no'. If `yes', the target system must have a +# `posix_memalign' implementation that accepts larger than page size +# alignment. +#erl_xcomp_posix_memalign= + +# * `erl_xcomp_code_model_small` - `yes|no`. Default to `no`. If `yes`, the target +# system must place the beam.smp executable in the lower 2 GB of memory. That is it +# should not use position independent executable. +#erl_xcomp_code_model_small= + +## ----------------------------------------------------------------------------- |