diff options
131 files changed, 4457 insertions, 1998 deletions
diff --git a/.gitignore b/.gitignore index 011463cbc9..cbf7881ae7 100644 --- a/.gitignore +++ b/.gitignore @@ -132,6 +132,7 @@ JAVADOC-GENERATED /bootstrap/lib/ic /bootstrap/lib/orber /bootstrap/lib/parsetools +/bootstrap/lib/runtime_tools /bootstrap/lib/sasl /bootstrap/lib/snmp /bootstrap/lib/syntax_tools diff --git a/Makefile.in b/Makefile.in index 3289f1d86b..ca31955c7d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -694,6 +694,8 @@ tertiary_bootstrap_copy: $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; fi + $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools ; fi + $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include ; fi $(V_at)for x in lib/ic/ebin/*.beam; do \ BN=`basename $$x`; \ TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin/$$BN; \ @@ -782,6 +784,18 @@ tertiary_bootstrap_copy: cp $$x $$TF; \ true; \ done + +# copy runtime_tool includes to be able to compile with include_lib + $(V_at)for x in lib/runtime_tools/include/*.hrl; do \ + BN=`basename $$x`; \ + TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include/$$BN; \ + test -f $$TF && \ + test '!' -z "`find $$x -newer $$TF -print`" && \ + cp $$x $$TF; \ + test '!' -f $$TF && \ + cp $$x $$TF; \ + true; \ + done # $(V_at)cp lib/syntax_tools/ebin/*.beam $(BOOTSTRAP_ROOT)/bootstrap/lib/syntax_tools/ebin doc_bootstrap_build: diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex 98c44e8fba..61ed6a107a 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/erts/configure.in b/erts/configure.in index 2f6043ee85..f15bb56435 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1356,12 +1356,16 @@ error ],[ AC_MSG_RESULT(no) ]) + +if test "$Z_LIB" != ""; then + AC_MSG_CHECKING(for zlib inflateGetDictionary presence) + AC_SEARCH_LIBS(inflateGetDictionary, [z], + AC_DEFINE(HAVE_ZLIB_INFLATEGETDICTIONARY, 1, + [Define if your zlib version defines inflateGetDictionary.])) +fi + LIBS=$zlib_save_LIBS -AC_MSG_CHECKING(for zlib inflateGetDictionary presence) -AC_SEARCH_LIBS(inflateGetDictionary, [z], - AC_DEFINE(HAVE_ZLIB_INFLATEGETDICTIONARY, 1, - [Define if your zlib version defines inflateGetDictionary.])) fi AC_SUBST(Z_LIB) diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index ca9d458e1e..c790872fe4 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -2304,8 +2304,13 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> buffer is too small, a value > <c>0</c> is returned and <c>*value_size</c> has been set to the buffer size needed.</p> <warning> - <p>Do <em>not</em> use libc's <c>getenv</c> or similar C library - interfaces from a driver.</p> + <p>This function reads the emulated environment used by + <seealso marker="os:getenv/1"><c>os:getenv/1</c></seealso> and not + the environment used by libc's <c>getenv(3)</c> or similar. Drivers + that <em>require</em> that these are in sync will need to do so + themselves, but keep in mind that they are segregated for a reason; + <c>getenv(3)</c> and its friends are <em>not thread-safe</em> and + may cause unrelated code to misbehave or crash the emulator.</p> </warning> <p>This function is thread-safe.</p> </desc> @@ -2650,8 +2655,13 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0] environment variable is removed.</p> </note> <warning> - <p>Do <em>not</em> use libc's <c>putenv</c> or similar C library - interfaces from a driver.</p> + <p>This function modifies the emulated environment used by + <seealso marker="os:putenv/2"><c>os:putenv/2</c></seealso> and not + the environment used by libc's <c>putenv(3)</c> or similar. Drivers + that <em>require</em> that these are in sync will need to do so + themselves, but keep in mind that they are segregated for a reason; + <c>putenv(3)</c> and its friends are <em>not thread-safe</em> and + may cause unrelated code to misbehave or crash the emulator.</p> </warning> <p>This function is thread-safe.</p> </desc> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index d7404fa3ce..24e0773e41 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1444,11 +1444,14 @@ b</pre> the process to terminate, it has no return value. Example:</p> <pre> > <input>catch error(foobar).</input> -{'EXIT',{foobar,[{erl_eval,do_apply,5}, - {erl_eval,expr,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]}}</pre> +{'EXIT',{foobar,[{shell,apply_fun,3, + [{file,"shell.erl"},{line,906}]}, + {erl_eval,do_apply,6,[{file,"erl_eval.erl"},{line,677}]}, + {erl_eval,expr,5,[{file,"erl_eval.erl"},{line,430}]}, + {shell,exprs,7,[{file,"shell.erl"},{line,687}]}, + {shell,eval_exprs,7,[{file,"shell.erl"},{line,642}]}, + {shell,eval_loop,3,[{file,"shell.erl"},{line,627}]}]}} +</pre> </desc> </func> @@ -8963,7 +8966,7 @@ ok <c>erlang:now()</c>. This is also the default if no time stamp flag is specified. If <c>cpu_timestamp</c> has been enabled through - <seealso marker="erlang:trace/3"><c>erlang:trace/3</c></seealso>, + <seealso marker="#trace/3"><c>erlang:trace/3</c></seealso>, this also effects the time stamp produced in profiling messages when flag <c>timestamp</c> is enabled.</p> </item> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 15b65f1c71..9c79bf3da0 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -903,6 +903,7 @@ else OS_OBJS = \ $(OBJDIR)/sys.o \ $(OBJDIR)/sys_drivers.o \ + $(OBJDIR)/sys_env.o \ $(OBJDIR)/sys_uds.o \ $(OBJDIR)/driver_tab.o \ $(OBJDIR)/elib_memmove.o \ @@ -944,7 +945,8 @@ endif OS_OBJS += $(OBJDIR)/erl_poll.o \ $(OBJDIR)/erl_check_io.o \ $(OBJDIR)/erl_mseg.o \ - $(OBJDIR)/erl_mmap.o \ + $(OBJDIR)/erl_mmap.o \ + $(OBJDIR)/erl_osenv.o \ $(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \ $(OBJDIR)/erl_mtrace_sys_wrap.o \ $(OBJDIR)/erl_sys_common_misc.o \ diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e43f7fda2c..beaef0951e 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2017. All Rights Reserved. + * Copyright Ericsson AB 1996-2018. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -40,6 +40,7 @@ #include "erl_zlib.h" #include "erl_map.h" #include "erl_process_dict.h" +#include "erl_unicode.h" #ifdef HIPE #include "hipe_bif0.h" @@ -1806,7 +1807,7 @@ read_line_table(LoaderState* stp) GetInt(stp, 2, n); GetString(stp, fname, n); - stp->fname[i] = erts_atom_put(fname, n, ERTS_ATOM_ENC_LATIN1, 1); + stp->fname[i] = erts_atom_put(fname, n, ERTS_ATOM_ENC_UTF8, 1); } } @@ -6254,8 +6255,7 @@ erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p) file_term = buf_to_intlist(&hp, ".erl", 4, NIL); file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term); } else { - Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1])); - file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, NIL); + file_term = erts_atom_to_string(&hp, (fi->fname_ptr)[file-1]); } tuple = TUPLE2(hp, am_line, make_small(line)); diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c index 01bda7f3c1..f0c9496341 100644 --- a/erts/emulator/beam/beam_ranges.c +++ b/erts/emulator/beam/beam_ranges.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2016. All Rights Reserved. + * Copyright Ericsson AB 2012-2018. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -26,6 +26,7 @@ #include "erl_vm.h" #include "global.h" #include "beam_load.h" +#include "erl_unicode.h" typedef struct { BeamInstr* start; /* Pointer to start of module. */ @@ -341,8 +342,7 @@ lookup_loc(FunctionInfo* fi, const BeamInstr* pc, Atom* mod_atom = atom_tab(atom_val(fi->mfa->module)); fi->needed += 2*(mod_atom->len+4); } else { - Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1])); - fi->needed += 2*ap->len; + fi->needed += 2*erts_atom_to_string_length((fi->fname_ptr)[file-1]); } return; } else { diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 0e5f7bb22b..f086c434ea 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2244,20 +2244,15 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) send_message: { ErtsProcLocks rp_locks = 0; - Sint res; if (p == rp) rp_locks |= ERTS_PROC_LOCK_MAIN; /* send to local process */ - res = erts_send_message(p, rp, &rp_locks, msg, 0); - if (erts_use_sender_punish) - res *= 4; - else - res = 0; + erts_send_message(p, rp, &rp_locks, msg, 0); erts_proc_unlock(rp, p == rp ? (rp_locks & ~ERTS_PROC_LOCK_MAIN) : rp_locks); - return res; + return 0; } } @@ -2312,8 +2307,8 @@ BIF_RETTYPE send_3(BIF_ALIST_3) result = do_send(p, to, msg, &ref, ctx); ERTS_MSACC_POP_STATE_M_X(); - if (result > 0) { - ERTS_VBUMP_REDS(p, result); + if (result >= 0) { + ERTS_VBUMP_REDS(p, 4); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; ERTS_BIF_PREP_RET(retval, am_ok); @@ -2321,12 +2316,6 @@ BIF_RETTYPE send_3(BIF_ALIST_3) } switch (result) { - case 0: - /* May need to yield even though we do not bump reds here... */ - if (ERTS_IS_PROC_OUT_OF_REDS(p)) - goto yield_return; - ERTS_BIF_PREP_RET(retval, am_ok); - break; case SEND_NOCONNECT: if (ctx->connect) { ERTS_BIF_PREP_RET(retval, am_ok); @@ -2443,8 +2432,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_MSACC_POP_STATE_M_X(); - if (result > 0) { - ERTS_VBUMP_REDS(p, result); + if (result >= 0) { + ERTS_VBUMP_REDS(p, 4); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; ERTS_BIF_PREP_RET(retval, msg); @@ -2452,12 +2441,6 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) } switch (result) { - case 0: - /* May need to yield even though we do not bump reds here... */ - if (ERTS_IS_PROC_OUT_OF_REDS(p)) - goto yield_return; - ERTS_BIF_PREP_RET(retval, msg); - break; case SEND_NOCONNECT: ERTS_BIF_PREP_RET(retval, msg); break; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 33f6eef652..c0d5e8ce74 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -376,9 +376,10 @@ bif ets:match_spec_run_r/3 # Bifs in os module. # -bif os:putenv/2 -bif os:getenv/0 -bif os:getenv/1 +bif os:get_env_var/1 +bif os:set_env_var/2 +bif os:unset_env_var/1 +bif os:list_env_vars/0 bif os:getpid/0 bif os:timestamp/0 bif os:system_time/0 @@ -619,7 +620,6 @@ bif erlang:float_to_binary/2 bif erlang:binary_to_float/1 bif io:printable_range/0 -bif os:unsetenv/1 # # New in 17.0 diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index ca3e48e205..d4db1a4188 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -60,14 +60,36 @@ erts_init_binary(void) } +static ERTS_INLINE +Eterm build_proc_bin(ErlOffHeap* ohp, Eterm* hp, Binary* bptr) +{ + ProcBin* pb = (ProcBin *) hp; + pb->thing_word = HEADER_PROC_BIN; + pb->size = bptr->orig_size; + pb->next = ohp->first; + ohp->first = (struct erl_off_heap_header*)pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(ohp, pb->size / sizeof(Eterm)); + + return make_binary(pb); +} + +/** @brief Initiate a ProcBin for a full Binary. + * @param hp must point to PROC_BIN_SIZE available heap words. + */ +Eterm erts_build_proc_bin(ErlOffHeap* ohp, Eterm* hp, Binary* bptr) +{ + return build_proc_bin(ohp, hp, bptr); +} + /* * Create a brand new binary from scratch. */ - Eterm new_binary(Process *p, byte *buf, Uint len) { - ProcBin* pb; Binary* bptr; if (len <= ERL_ONHEAP_BIN_LIMIT) { @@ -88,23 +110,7 @@ new_binary(Process *p, byte *buf, Uint len) sys_memcpy(bptr->orig_bytes, buf, len); } - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = len; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - /* - * Miscellaneous updates. Return the tagged binary. - */ - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); - return make_binary(pb); + return build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), bptr); } /* @@ -113,7 +119,6 @@ new_binary(Process *p, byte *buf, Uint len) Eterm erts_new_mso_binary(Process *p, byte *buf, Uint len) { - ProcBin* pb; Binary* bptr; /* @@ -124,23 +129,7 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, Uint len) sys_memcpy(bptr->orig_bytes, buf, len); } - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = len; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - /* - * Miscellaneous updates. Return the tagged binary. - */ - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); - return make_binary(pb); + return build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), bptr); } /* diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 2cff05c7f3..e7acea0c5f 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -775,16 +775,16 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) * - write dump until alarm or file is written completely */ - if (erts_sys_getenv__("ERL_CRASH_DUMP_SECONDS", env, &envsz) != 0) { - env_erl_crash_dump_seconds_set = 0; - secs = -1; + if (erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_SECONDS", env, &envsz) == 1) { + env_erl_crash_dump_seconds_set = 1; + secs = atoi(env); } else { - env_erl_crash_dump_seconds_set = 1; - secs = atoi(env); + env_erl_crash_dump_seconds_set = 0; + secs = -1; } if (secs == 0) { - return; + return; } /* erts_sys_prepare_crash_dump returns 1 if heart port is found, otherwise 0 @@ -800,7 +800,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) crash_dump_limit = ERTS_SINT64_MAX; envsz = sizeof(env); - if (erts_sys_getenv__("ERL_CRASH_DUMP_BYTES", env, &envsz) == 0) { + if (erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_BYTES", env, &envsz) == 1) { Sint64 limit; char* endptr; errno = 0; @@ -813,7 +813,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) } } - if (erts_sys_getenv__("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0) + if (erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 1) dumpname = "erl_crash.dump"; else dumpname = &dumpnamebuf[0]; diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 7ff7462bf6..30390cdb5e 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1212,7 +1212,7 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) # define PURIFY_MSG(msg) \ do { \ char buf__[1]; size_t bufsz__ = sizeof(buf__); \ - if (erts_sys_getenv_raw("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \ + if (erts_sys_explicit_8bit_getenv("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \ VALGRIND_PRINTF_XML("<erlang_error_log>" \ "%s, line %d: %s</erlang_error_log>\n", \ __FILE__, __LINE__, msg); \ diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index c6cc5c78b3..8107f133aa 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -283,6 +283,8 @@ type THR_PRGR_DATA LONG_LIVED SYSTEM thr_prgr_data type T_THR_PRGR_DATA SHORT_LIVED SYSTEM temp_thr_prgr_data type RELEASE_LAREA SHORT_LIVED SYSTEM release_literal_area +type ENVIRONMENT SYSTEM SYSTEM environment + # # Types used for special emulators # @@ -370,8 +372,6 @@ type SYS_READ_BUF TEMPORARY SYSTEM sys_read_buf type FD_TAB LONG_LIVED SYSTEM fd_tab type FD_ENTRY_BUF STANDARD SYSTEM fd_entry_buf type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path -type ENVIRONMENT TEMPORARY SYSTEM environment -type PUTENV_STR SYSTEM SYSTEM putenv_string type PRT_REP_EXIT STANDARD SYSTEM port_report_exit type SYS_BLOCKING STANDARD SYSTEM sys_blocking @@ -383,9 +383,7 @@ type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf type PRELOADED LONG_LIVED SYSTEM preloaded -type PUTENV_STR SYSTEM SYSTEM putenv_string type WAITER_OBJ LONG_LIVED SYSTEM waiter_object -type ENVIRONMENT SYSTEM SYSTEM environment type CON_VPRINTF_BUF TEMPORARY SYSTEM con_vprintf_buf +endif diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 4cafa499a9..41c2ae08d3 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -2825,28 +2825,21 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2) BIF_TRAP2(&binary_copy_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2); } else { Binary *save; - ProcBin* pb; + Eterm resbin; Uint target_size = cbs->result->orig_size; while (pos < target_size) { memcpy(t+pos,cbs->source, size); pos += size; } - save = cbs->result; + save = cbs->result; cbs->result = NULL; cleanup_copy_bin_state(mb); /* now cbs is dead */ - pb = (ProcBin *) HAlloc(BIF_P, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = target_size; - pb->next = MSO(BIF_P).first; - MSO(BIF_P).first = (struct erl_off_heap_header*) pb; - pb->val = save; - pb->bytes = t; - pb->flags = 0; - - OH_OVERHEAD(&(MSO(BIF_P)), target_size / sizeof(Eterm)); - BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR); - - BIF_RET(make_binary(pb)); + + resbin = erts_build_proc_bin(&MSO(BIF_P), + HAlloc(BIF_P, PROC_BIN_SIZE), + save); + BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR); + BIF_RET(resbin); } } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 2f6f2c6e0a..903f54e2fb 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1754,7 +1754,7 @@ static int check_if_xml(void) { char buf[1]; size_t bufsz = sizeof(buf); - return erts_sys_getenv_raw("VALGRIND_LOG_XML", buf, &bufsz) >= 0; + return erts_sys_explicit_8bit_getenv("VALGRIND_LOG_XML", buf, &bufsz) >= 0; } #else #define check_if_xml() 0 @@ -4334,6 +4334,19 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(res); } } + else if (ERTS_IS_ATOM_STR("binary", BIF_ARG_1)) { + Sint64 size; + if (term_to_Sint64(BIF_ARG_2, &size)) { + Binary* refbin = erts_bin_drv_alloc_fnf(size); + if (!refbin) + BIF_RET(am_false); + sys_memset(refbin->orig_bytes, 0, size); + BIF_RET(erts_build_proc_bin(&MSO(BIF_P), + HAlloc(BIF_P, PROC_BIN_SIZE), + refbin)); + } + } + } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 910325a2f4..ce2b27409b 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -36,8 +36,7 @@ #include "big.h" #include "dist.h" #include "erl_version.h" - -static int check_env_name(char *name); +#include "erl_osenv.h" /* * Return the pid for the Erlang process in the host OS. @@ -67,148 +66,78 @@ BIF_RETTYPE os_getpid_0(BIF_ALIST_0) BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL)); } -BIF_RETTYPE os_getenv_0(BIF_ALIST_0) +static void os_getenv_foreach(Process *process, Eterm *result, Eterm key, Eterm value) { - GETENV_STATE state; - char *cp; - Eterm* hp; - Eterm ret; - Eterm str; + Eterm kvp_term, *hp; - init_getenv_state(&state); + hp = HAlloc(process, 5); + kvp_term = TUPLE2(hp, key, value); + hp += 3; - ret = NIL; - while ((cp = getenv_string(&state)) != NULL) { - str = erts_convert_native_to_filename(BIF_P,(byte *)cp); - hp = HAlloc(BIF_P, 2); - ret = CONS(hp, str, ret); - } + (*result) = CONS(hp, kvp_term, (*result)); +} - fini_getenv_state(&state); +BIF_RETTYPE os_list_env_vars_0(BIF_ALIST_0) +{ + const erts_osenv_t *global_env; + Eterm result = NIL; + + global_env = erts_sys_rlock_global_osenv(); + erts_osenv_foreach_term(global_env, BIF_P, &result, (void*)&os_getenv_foreach); + erts_sys_runlock_global_osenv(); - return ret; + return result; } -#define STATIC_BUF_SIZE 1024 -BIF_RETTYPE os_getenv_1(BIF_ALIST_1) +BIF_RETTYPE os_get_env_var_1(BIF_ALIST_1) { - Process* p = BIF_P; - Eterm str; - Sint len; - int res; - char *key_str, *val; - char buf[STATIC_BUF_SIZE]; - size_t val_size = sizeof(buf); - - key_str = erts_convert_filename_to_native(BIF_ARG_1,buf,STATIC_BUF_SIZE, - ERTS_ALC_T_TMP,1,0,&len); - - if (!check_env_name(key_str)) { - if (key_str && key_str != &buf[0]) - erts_free(ERTS_ALC_T_TMP, key_str); - BIF_ERROR(p, BADARG); - } + const erts_osenv_t *global_env; + Eterm out_term; + int error; - if (key_str != &buf[0]) - val = &buf[0]; - else { - /* len includes zero byte */ - val_size -= len; - val = &buf[len]; - } - res = erts_sys_getenv(key_str, val, &val_size); - - if (res < 0) { - no_var: - str = am_false; - } else { - if (res > 0) { - val = erts_alloc(ERTS_ALC_T_TMP, val_size); - while (1) { - res = erts_sys_getenv(key_str, val, &val_size); - if (res == 0) - break; - else if (res < 0) - goto no_var; - else - val = erts_realloc(ERTS_ALC_T_TMP, val, val_size); - } - } - str = erts_convert_native_to_filename(p,(byte *)val); - } - if (key_str != &buf[0]) - erts_free(ERTS_ALC_T_TMP, key_str); - if (val < &buf[0] || &buf[sizeof(buf)-1] < val) - erts_free(ERTS_ALC_T_TMP, val); - BIF_RET(str); + global_env = erts_sys_rlock_global_osenv(); + error = erts_osenv_get_term(global_env, BIF_P, BIF_ARG_1, &out_term); + erts_sys_runlock_global_osenv(); + + if (error == 0) { + return am_false; + } else if (error < 0) { + BIF_ERROR(BIF_P, BADARG); + } + + return out_term; } -BIF_RETTYPE os_putenv_2(BIF_ALIST_2) +BIF_RETTYPE os_set_env_var_2(BIF_ALIST_2) { - char def_buf_key[STATIC_BUF_SIZE]; - char def_buf_value[STATIC_BUF_SIZE]; - char *key_buf = NULL, *value_buf = NULL; - - key_buf = erts_convert_filename_to_native(BIF_ARG_1,def_buf_key, - STATIC_BUF_SIZE, - ERTS_ALC_T_TMP,0,0,NULL); - if (!check_env_name(key_buf)) - goto badarg; - - value_buf = erts_convert_filename_to_native(BIF_ARG_2,def_buf_value, - STATIC_BUF_SIZE, - ERTS_ALC_T_TMP,1,0, - NULL); - if (!value_buf) - goto badarg; - - if (erts_sys_putenv(key_buf, value_buf)) { - if (key_buf != def_buf_key) { - erts_free(ERTS_ALC_T_TMP, key_buf); - } - if (value_buf != def_buf_value) { - erts_free(ERTS_ALC_T_TMP, value_buf); - } - BIF_ERROR(BIF_P, BADARG); - } - if (key_buf != def_buf_key) { - erts_free(ERTS_ALC_T_TMP, key_buf); - } - if (value_buf != def_buf_value) { - erts_free(ERTS_ALC_T_TMP, value_buf); + erts_osenv_t *global_env; + int error; + + global_env = erts_sys_rwlock_global_osenv(); + error = erts_osenv_put_term(global_env, BIF_ARG_1, BIF_ARG_2); + erts_sys_rwunlock_global_osenv(); + + if (error < 0) { + BIF_ERROR(BIF_P, BADARG); } - BIF_RET(am_true); -badarg: - if (key_buf && key_buf != def_buf_key) - erts_free(ERTS_ALC_T_TMP, key_buf); - if (value_buf && value_buf != def_buf_value) - erts_free(ERTS_ALC_T_TMP, value_buf); - BIF_ERROR(BIF_P, BADARG); + BIF_RET(am_true); } -BIF_RETTYPE os_unsetenv_1(BIF_ALIST_1) +BIF_RETTYPE os_unset_env_var_1(BIF_ALIST_1) { - char *key_buf; - char buf[STATIC_BUF_SIZE]; + erts_osenv_t *global_env; + int error; - key_buf = erts_convert_filename_to_native(BIF_ARG_1,buf,STATIC_BUF_SIZE, - ERTS_ALC_T_TMP,0,0,NULL); - if (!check_env_name(key_buf)) - goto badarg; + global_env = erts_sys_rwlock_global_osenv(); + error = erts_osenv_unset_term(global_env, BIF_ARG_1); + erts_sys_rwunlock_global_osenv(); - if (erts_sys_unsetenv(key_buf)) - goto badarg; - - if (key_buf != buf) { - erts_free(ERTS_ALC_T_TMP, key_buf); + if (error < 0) { + BIF_ERROR(BIF_P, BADARG); } - BIF_RET(am_true); -badarg: - if (key_buf && key_buf != buf) - erts_free(ERTS_ALC_T_TMP, key_buf); - BIF_ERROR(BIF_P, BADARG); + BIF_RET(am_true); } BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) { @@ -224,27 +153,3 @@ BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) { error: BIF_ERROR(BIF_P, BADARG); } - -static int -check_env_name(char *raw_name) -{ - byte *c = (byte *) raw_name; - int encoding; - - if (!c) - return 0; - - encoding = erts_get_native_filename_encoding(); - - if (erts_raw_env_char_is_7bit_ascii_char('\0', c, encoding)) - return 0; /* Do not allow empty name... */ - - /* Verify no '=' characters in variable name... */ - do { - if (erts_raw_env_char_is_7bit_ascii_char('=', c, encoding)) - return 0; - c = erts_raw_env_next_char(c, encoding); - } while (!erts_raw_env_char_is_7bit_ascii_char('\0', c, encoding)); - - return 1; /* Seems ok... */ -} diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index c4a4dd5863..9f0c90ff7b 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -45,7 +45,7 @@ #include "dtrace-wrapper.h" static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump); -static char* convert_environment(Eterm env); +static int merge_global_environment(erts_osenv_t *env, Eterm key_value_pairs); static char **convert_args(Eterm); static void free_args(char **); @@ -651,6 +651,7 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1) static Port * open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) { + int merged_environment = 0; Sint i; Eterm option; Uint arity; @@ -672,12 +673,13 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) opts.read_write = 0; opts.hide_window = 0; opts.wd = NULL; - opts.envir = NULL; opts.exit_status = 0; opts.overlapped_io = 0; opts.spawn_type = ERTS_SPAWN_ANY; opts.argv = NULL; opts.parallelism = erts_port_parallelism; + erts_osenv_init(&opts.envir); + linebuf = 0; *err_nump = 0; @@ -718,11 +720,16 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) goto badarg; } } else if (option == am_env) { - if (opts.envir) /* ignore previous env option... */ - erts_free(ERTS_ALC_T_OPEN_PORT_ENV, opts.envir); - opts.envir = convert_environment(*tp); - if (!opts.envir) - goto badarg; + if (merged_environment) { + /* Ignore previous env option */ + erts_osenv_clear(&opts.envir); + } + + merged_environment = 1; + + if (merge_global_environment(&opts.envir, *tp)) { + goto badarg; + } } else if (option == am_args) { char **av; char **oav = opts.argv; @@ -807,6 +814,12 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) if((linebuf && opts.packet_bytes) || (opts.redir_stderr && !opts.use_stdio)) { goto badarg; +} + + /* If we lacked an env option, fill in the global environment without + * changes. */ + if (!merged_environment) { + merge_global_environment(&opts.envir, NIL); } /* @@ -956,8 +969,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) erts_atomic32_read_bor_relb(&port->state, sflgs); do_return: - if (opts.envir) - erts_free(ERTS_ALC_T_OPEN_PORT_ENV, opts.envir); + erts_osenv_clear(&opts.envir); if (name_buf) erts_free(ERTS_ALC_T_TMP, (void *) name_buf); if (opts.argv) { @@ -977,6 +989,45 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) goto do_return; } +/* Merges the the global environment and the given {Key, Value} list into env, + * unsetting all keys whose value is either 'false' or NIL. The behavior on + * NIL is undocumented and perhaps surprising, but the previous implementation + * worked in this manner. */ +static int merge_global_environment(erts_osenv_t *env, Eterm key_value_pairs) { + const erts_osenv_t *global_env = erts_sys_rlock_global_osenv(); + erts_osenv_merge(env, global_env, 0); + erts_sys_runlock_global_osenv(); + + while (is_list(key_value_pairs)) { + Eterm *cell, *tuple; + + cell = list_val(key_value_pairs); + + if(!is_tuple_arity(CAR(cell), 2)) { + return -1; + } + + tuple = tuple_val(CAR(cell)); + key_value_pairs = CDR(cell); + + if(is_nil(tuple[2]) || tuple[2] == am_false) { + if(erts_osenv_unset_term(env, tuple[1]) < 0) { + return -1; + } + } else { + if(erts_osenv_put_term(env, tuple[1], tuple[2]) < 0) { + return -1; + } + } + } + + if(!is_nil(key_value_pairs)) { + return -1; + } + + return 0; +} + /* Arguments can be given i unicode and as raw binaries, convert filename is used to convert */ static char **convert_args(Eterm l) { @@ -1024,130 +1075,6 @@ static void free_args(char **av) erts_free(ERTS_ALC_T_TMP, av); } -#ifdef DEBUG -#define ERTS_CONV_ENV_BUF_EXTRA 2 -#else -#define ERTS_CONV_ENV_BUF_EXTRA 1024 -#endif - -static char* convert_environment(Eterm env) -{ - /* - * Returns environment buffer in memory allocated - * as ERTS_ALC_T_OPEN_PORT_ENV. Caller *needs* - * to deallocate... - */ - - Sint size, alloc_size; - byte* bytes; - int encoding = erts_get_native_filename_encoding(); - - alloc_size = ERTS_CONV_ENV_BUF_EXTRA; - bytes = erts_alloc(ERTS_ALC_T_OPEN_PORT_ENV, - alloc_size); - size = 0; - - /* ERTS_CONV_ENV_BUF_EXTRA >= for end delimiter... */ - ERTS_CT_ASSERT(ERTS_CONV_ENV_BUF_EXTRA >= 2); - - while (is_list(env)) { - Sint var_sz, val_sz, need; - byte *str, *limit; - Eterm tmp, *tp, *consp; - - consp = list_val(env); - tmp = CAR(consp); - if (is_not_tuple_arity(tmp, 2)) - goto error; - - tp = tuple_val(tmp); - - /* Check encoding of env variable... */ - if (is_not_list(tp[1])) - goto error; - var_sz = erts_native_filename_need(tp[1], encoding); - if (var_sz <= 0) - goto error; - /* Check encoding of value... */ - if (tp[2] == am_false || is_nil(tp[2])) - val_sz = 0; - else if (is_not_list(tp[2])) - goto error; - else { - val_sz = erts_native_filename_need(tp[2], encoding); - if (val_sz < 0) - goto error; - } - - /* Ensure enough memory... */ - need = size; - need += var_sz + val_sz; - /* '=' and '\0' */ - need += 2 * erts_raw_env_7bit_ascii_char_need(encoding); - if (need > alloc_size) { - alloc_size = (need - alloc_size) + alloc_size; - alloc_size += ERTS_CONV_ENV_BUF_EXTRA; - bytes = erts_realloc(ERTS_ALC_T_OPEN_PORT_ENV, - bytes, alloc_size); - } - - /* Write environment variable name... */ - str = bytes + size; - erts_native_filename_put(tp[1], encoding, str); - /* empty variable name is not allowed... */ - if (erts_raw_env_char_is_7bit_ascii_char('\0', str, encoding)) - goto error; - - /* - * Drop null characters at the end and verify that we do - * not have any '=' characters in the name... - */ - limit = str + var_sz; - while (str < limit) { - if (erts_raw_env_char_is_7bit_ascii_char('\0', str, encoding)) - break; - if (erts_raw_env_char_is_7bit_ascii_char('=', str, encoding)) - goto error; - str = erts_raw_env_next_char(str, encoding); - } - - /* Write the equals sign... */ - str = erts_raw_env_7bit_ascii_char_put('=', str, encoding); - - /* Write the value... */ - if (val_sz > 0) { - limit = str + val_sz; - erts_native_filename_put(tp[2], encoding, str); - while (str < limit) { - if (erts_raw_env_char_is_7bit_ascii_char('\0', str, encoding)) - break; - str = erts_raw_env_next_char(str, encoding); - } - } - - /* Delimit... */ - str = erts_raw_env_7bit_ascii_char_put('\0', str, encoding); - - size = str - bytes; - ASSERT(size <= alloc_size); - - env = CDR(consp); - } - - /* End delimit... */ - (void) erts_raw_env_7bit_ascii_char_put('\0', &bytes[size], encoding); - - if (is_nil(env)) - return (char *) bytes; - -error: - - if (bytes) - erts_free(ERTS_ALC_T_OPEN_PORT_ENV, bytes); - - return (char *) NULL; /* error... */ -} - /* ------------ decode_packet() and friends: */ struct packet_callback_args diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 6cef9bd0e3..4846ccd2d3 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -50,7 +50,7 @@ #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" #include "erl_check_io.h" - +#include "erl_osenv.h" #ifdef HIPE #include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */ #include "hipe_signal.h" /* for hipe_signal_init() */ @@ -155,9 +155,6 @@ erts_atomic32_t erts_writing_erl_crash_dump; erts_tsd_key_t erts_is_crash_dumping_key; int erts_initialized = 0; - -int erts_use_sender_punish; - /* * Configurable parameters. */ @@ -758,8 +755,6 @@ early_init(int *argc, char **argv) /* erts_initialized = 0; - erts_use_sender_punish = 1; - erts_pre_early_init_cpu_topology(&max_reader_groups, &ncpu, &ncpuonln, @@ -803,8 +798,9 @@ early_init(int *argc, char **argv) /* envbufsz = sizeof(envbuf); - /* erts_sys_getenv(_raw)() not initialized yet; need erts_sys_getenv__() */ - if (erts_sys_getenv__("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0) + /* erts_osenv hasn't been initialized yet, so we need to fall back to + * erts_sys_explicit_host_getenv() */ + if (erts_sys_explicit_host_getenv("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 1) erts_async_max_threads = atoi(envbuf); else erts_async_max_threads = ERTS_DEFAULT_NO_ASYNC_THREADS; @@ -1210,20 +1206,20 @@ erl_start(int argc, char **argv) &time_warp_mode); envbufsz = sizeof(envbuf); - if (erts_sys_getenv_raw(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0) + if (erts_sys_explicit_8bit_getenv(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 1) user_requested_db_max_tabs = atoi(envbuf); else user_requested_db_max_tabs = 0; envbufsz = sizeof(envbuf); - if (erts_sys_getenv_raw("ERL_FULLSWEEP_AFTER", envbuf, &envbufsz) == 0) { + if (erts_sys_explicit_8bit_getenv("ERL_FULLSWEEP_AFTER", envbuf, &envbufsz) == 1) { Uint16 max_gen_gcs = atoi(envbuf); erts_atomic32_set_nob(&erts_max_gen_gcs, (erts_aint32_t) max_gen_gcs); } envbufsz = sizeof(envbuf); - if (erts_sys_getenv_raw("ERL_MAX_PORTS", envbuf, &envbufsz) == 0) { + if (erts_sys_explicit_8bit_getenv("ERL_MAX_PORTS", envbuf, &envbufsz) == 1) { port_tab_sz = atoi(envbuf); port_tab_sz_ignore_files = 1; } @@ -1764,8 +1760,6 @@ erl_start(int argc, char **argv) erts_usage(); } } - else if (sys_strcmp("nsp", sub_param) == 0) - erts_use_sender_punish = 0; else if (has_prefix("tbt", sub_param)) { arg = get_arg(sub_param+3, argv[i+1], &i); res = erts_init_scheduler_bind_type_string(arg); diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c index 40d69ea6b0..c93b5248d9 100644 --- a/erts/emulator/beam/erl_io_queue.c +++ b/erts/emulator/beam/erl_io_queue.c @@ -817,24 +817,15 @@ static Eterm iol2v_make_sub_bin(iol2v_state_t *state, Eterm bin_term, } static Eterm iol2v_promote_acc(iol2v_state_t *state) { - ProcBin *pb; - - state->acc = erts_bin_realloc(state->acc, state->acc_size); - - pb = (ProcBin*)HAlloc(state->process, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = state->acc_size; - pb->val = state->acc; - pb->bytes = (byte*)(state->acc)->orig_bytes; - pb->flags = 0; - pb->next = MSO(state->process).first; - OH_OVERHEAD(&(MSO(state->process)), pb->size / sizeof(Eterm)); - MSO(state->process).first = (struct erl_off_heap_header*)pb; + Eterm bin; + bin = erts_build_proc_bin(&MSO(state->process), + HAlloc(state->process, PROC_BIN_SIZE), + erts_bin_realloc(state->acc, state->acc_size)); state->acc_size = 0; state->acc = NULL; - return make_binary(pb); + return bin; } /* Destructively enqueues a term to the result list, saving us the hassle of diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 0a5fe026db..94ebf88b56 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1317,21 +1317,11 @@ Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin) } else if (bin->ref_bin != NULL) { Binary* bptr = bin->ref_bin; - ProcBin* pb; Eterm bin_term; - /* !! Copy-paste from new_binary() !! */ - pb = (ProcBin *) alloc_heap(env, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = bptr->orig_size; - pb->next = MSO(env->proc).first; - MSO(env->proc).first = (struct erl_off_heap_header*) pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - OH_OVERHEAD(&(MSO(env->proc)), pb->size / sizeof(Eterm)); - bin_term = make_binary(pb); + bin_term = erts_build_proc_bin(&MSO(env->proc), + alloc_heap(env, PROC_BIN_SIZE), + bptr); if (erts_refc_read(&bptr->intern.refc, 1) == 1) { /* Total ownership transfer */ bin->ref_bin = NULL; diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index b7a5c45fea..604f0be127 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2017. All Rights Reserved. + * Copyright Ericsson AB 2008-2018. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1158,14 +1158,15 @@ static ERTS_INLINE int analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left, Sint *num_latin1_chars, Uint max_chars) { + int res = ERTS_UTF8_OK; Uint latin1_count; int is_latin1; + Uint nchars = 0; *err_pos = source; if (num_latin1_chars) { is_latin1 = 1; latin1_count = 0; } - *num_chars = 0; while (size) { if (((*source) & ((byte) 0x80)) == 0) { source++; @@ -1174,11 +1175,13 @@ analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left latin1_count++; } else if (((*source) & ((byte) 0xE0)) == 0xC0) { if (size < 2) { - return ERTS_UTF8_INCOMPLETE; + res = ERTS_UTF8_INCOMPLETE; + break; } if (((source[1] & ((byte) 0xC0)) != 0x80) || ((*source) < 0xC2) /* overlong */) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } if (num_latin1_chars) { latin1_count++; @@ -1189,16 +1192,19 @@ analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left size -= 2; } else if (((*source) & ((byte) 0xF0)) == 0xE0) { if (size < 3) { - return ERTS_UTF8_INCOMPLETE; + res = ERTS_UTF8_INCOMPLETE; + break; } if (((source[1] & ((byte) 0xC0)) != 0x80) || ((source[2] & ((byte) 0xC0)) != 0x80) || (((*source) == 0xE0) && (source[1] < 0xA0)) /* overlong */ ) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } if ((((*source) & ((byte) 0xF)) == 0xD) && ((source[1] & 0x20) != 0)) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } source += 3; size -= 3; @@ -1206,37 +1212,47 @@ analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left is_latin1 = 0; } else if (((*source) & ((byte) 0xF8)) == 0xF0) { if (size < 4) { - return ERTS_UTF8_INCOMPLETE; + res = ERTS_UTF8_INCOMPLETE; + break; } if (((source[1] & ((byte) 0xC0)) != 0x80) || ((source[2] & ((byte) 0xC0)) != 0x80) || ((source[3] & ((byte) 0xC0)) != 0x80) || (((*source) == 0xF0) && (source[1] < 0x90)) /* overlong */) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } if ((((*source) & ((byte)0x7)) > 0x4U) || ((((*source) & ((byte)0x7)) == 0x4U) && ((source[1] & ((byte)0x3F)) > 0xFU))) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } source += 4; size -= 4; if (num_latin1_chars) is_latin1 = 0; } else { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } - ++(*num_chars); + ++nchars; *err_pos = source; - if (max_chars && size > 0 && *num_chars == max_chars) - return ERTS_UTF8_OK_MAX_CHARS; + if (max_chars && size > 0 && nchars == max_chars) { + res = ERTS_UTF8_OK_MAX_CHARS; + break; + } if (left && --(*left) <= 0 && size) { - return ERTS_UTF8_ANALYZE_MORE; + res = ERTS_UTF8_ANALYZE_MORE; + break; } } + + *num_chars = nchars; if (num_latin1_chars) *num_latin1_chars = is_latin1 ? latin1_count : -1; - return ERTS_UTF8_OK; + + return res; } int erts_analyze_utf8(byte *source, Uint size, @@ -1252,29 +1268,18 @@ int erts_analyze_utf8_x(byte *source, Uint size, return analyze_utf8(source, size, err_pos, num_chars, left, num_latin1_chars, max_chars); } -/* - * No errors should be able to occur - no overlongs, no malformed, no nothing - */ -static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, - Uint left, - Uint *num_built, Uint *num_eaten, Eterm tail) +static ERTS_INLINE Eterm +make_list_from_utf8_buf(Eterm **hpp, Uint num, + byte *bytes, Uint sz, + Uint *num_built, Uint *num_eaten, + Eterm tail) { Eterm *hp; Eterm ret; + Uint left = num; byte *source, *ssource; Uint unipoint; - - ASSERT(num > 0); - if (left < num) { - if (left > 0) - num = left; - else - num = 1; - } - - *num_built = num; /* Always */ - - hp = HAlloc(p,num * 2); + hp = *hpp; ret = tail; source = bytes + sz; ssource = source; @@ -1302,20 +1307,97 @@ static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, } ret = CONS(hp,make_small(unipoint),ret); hp += 2; - if (--num <= 0) { + if (--left <= 0) { break; } } + *hpp = hp; + *num_built = num; /* Always */ *num_eaten = (ssource - source); return ret; } +/* + * No errors should be able to occur - no overlongs, no malformed, no nothing + */ +static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, + Uint left, + Uint *num_built, Uint *num_eaten, Eterm tail) +{ + Eterm *hp; + + ASSERT(num > 0); + if (left < num) { + if (left > 0) + num = left; + else + num = 1; + } + + hp = HAlloc(p,num * 2); + + return make_list_from_utf8_buf(&hp, num, bytes, sz, + num_built, num_eaten, + tail); +} Eterm erts_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, Uint left, Uint *num_built, Uint *num_eaten, Eterm tail) { return do_utf8_to_list(p, num, bytes, sz, left, num_built, num_eaten, tail); } +Uint erts_atom_to_string_length(Eterm atom) +{ + Atom *ap; + + ASSERT(is_atom(atom)); + ap = atom_tab(atom_val(atom)); + + if (ap->latin1_chars >= 0) + return (Uint) ap->len; + else { + byte* err_pos; + Uint num_chars; +#ifdef DEBUG + int ares = +#endif + erts_analyze_utf8(ap->name, ap->len, &err_pos, &num_chars, NULL); + ASSERT(ares == ERTS_UTF8_OK); + + return num_chars; + } +} + +Eterm erts_atom_to_string(Eterm **hpp, Eterm atom) +{ + Atom *ap; + + ASSERT(is_atom(atom)); + ap = atom_tab(atom_val(atom)); + if (ap->latin1_chars >= 0) + return buf_to_intlist(hpp, (char*)ap->name, ap->len, NIL); + else { + Eterm res; + byte* err_pos; + Uint num_chars, num_built, num_eaten; +#ifdef DEBUG + Eterm *hp_start = *hpp; + int ares = +#endif + erts_analyze_utf8(ap->name, ap->len, &err_pos, &num_chars, NULL); + ASSERT(ares == ERTS_UTF8_OK); + + res = make_list_from_utf8_buf(hpp, num_chars, ap->name, ap->len, + &num_built, &num_eaten, NIL); + + ASSERT(num_built == num_chars); + ASSERT(num_eaten == ap->len); + ASSERT(*hpp - hp_start == 2*num_chars); + + return res; + } +} + static int is_candidate(Uint cp) { int index,pos; @@ -2083,18 +2165,9 @@ char* erts_convert_filename_to_wchar(byte* bytes, Uint size, return name_buf; } - -static int filename_len_16bit(byte *str) -{ - byte *p = str; - while(*p != '\0' || p[1] != '\0') { - p += 2; - } - return (p - str); -} -Eterm erts_convert_native_to_filename(Process *p, byte *bytes) +Eterm erts_convert_native_to_filename(Process *p, size_t size, byte *bytes) { - Uint size,num_chars; + Uint num_chars; Eterm *hp; byte *err_pos; Uint num_built; /* characters */ @@ -2108,7 +2181,6 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes) case ERL_FILENAME_UTF8_MAC: mac = 1; case ERL_FILENAME_UTF8: - size = strlen((char *) bytes); if (size == 0) return NIL; if (erts_analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != ERTS_UTF8_OK) { @@ -2123,7 +2195,6 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes) } return ret; case ERL_FILENAME_WIN_WCHAR: - size=filename_len_16bit(bytes); if ((size % 2) != 0) { /* Panic fixup to avoid crashing the emulator */ size--; hp = HAlloc(p, size+2); @@ -2146,7 +2217,6 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes) goto noconvert; } noconvert: - size = strlen((char *) bytes); hp = HAlloc(p, 2 * size); return erts_bin_bytes_to_list(NIL, hp, bytes, size, 0); } @@ -2158,7 +2228,6 @@ Sint erts_native_filename_need(Eterm ioterm, int encoding) Eterm obj; DECLARE_ESTACK(stack); Sint need = 0; - int seen_null = 0; if (is_atom(ioterm)) { Atom* ap; @@ -2203,9 +2272,7 @@ Sint erts_native_filename_need(Eterm ioterm, int encoding) byte *name = ap->name; int len = ap->len; for (i = 0; i < len; i++) { - if (name[i] == 0) - seen_null = 1; - else if (seen_null) { + if (name[i] == 0) { need = -1; break; } @@ -2245,9 +2312,7 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ * Do not allow null in * the middle of filenames */ - if (x == 0) - seen_null = 1; - else if (seen_null) { + if (x == 0) { DESTROY_ESTACK(stack); return ((Sint) -1); } @@ -2580,7 +2645,6 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) BIF_ERROR(BIF_P,BADARG); } if (is_binary(BIF_ARG_1)) { - int seen_null = 0; byte *temp_alloc = NULL; byte *bytes; byte *err_pos; @@ -2597,8 +2661,6 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) for (i = 0; i < size; i++) { /* Don't allow null in the middle of filenames... */ if (bytes[i] == 0) - seen_null = 1; - else if (seen_null) goto bin_name_error; bin_p[i] = bytes[i]; } @@ -2617,8 +2679,6 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1) while (size--) { /* Don't allow null in the middle of filenames... */ if (*bytes == 0) - seen_null = 1; - else if (seen_null) goto bin_name_error; *bin_p++ = *bytes++; *bin_p++ = 0; diff --git a/erts/emulator/beam/erl_unicode.h b/erts/emulator/beam/erl_unicode.h index e01eaa787e..31369fc8f9 100644 --- a/erts/emulator/beam/erl_unicode.h +++ b/erts/emulator/beam/erl_unicode.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * Copyright Ericsson AB 2008-2018. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -21,4 +21,7 @@ #ifndef _ERL_UNICODE_H #define _ERL_UNICODE_H +Uint erts_atom_to_string_length(Eterm atom); +Eterm erts_atom_to_string(Eterm **hpp, Eterm atom); + #endif /* _ERL_UNICODE_H */ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9cc5e71afa..b12a021e41 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -2032,23 +2032,14 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla level = context->s.ec.level; BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); if (level == 0 || real_size < 6) { /* We are done */ - ProcBin* pb; return_normal: context->s.ec.result_bin = NULL; context->alive = 0; - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = real_size; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = result_bin; - pb->bytes = (byte*) result_bin->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) { erts_bin_free(context_b); } - return make_binary(pb); + return erts_build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), + result_bin); } /* Continue with compression... */ /* To make absolutely sure that zlib does not barf on a reallocated context, @@ -2105,16 +2096,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla result_bin = erts_bin_realloc(context->s.cc.destination_bin, context->s.cc.dest_len+6); context->s.cc.destination_bin = NULL; - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = context->s.cc.dest_len+6; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = result_bin; ASSERT(erts_refc_read(&result_bin->intern.refc, 1)); - pb->bytes = (byte*) result_bin->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); erts_bin_free(context->s.cc.result_bin); context->s.cc.result_bin = NULL; context->alive = 0; @@ -2122,7 +2104,9 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) { erts_bin_free(context_b); } - return make_binary(pb); + return erts_build_proc_bin(&MSO(p), + HAlloc(p, PROC_BIN_SIZE), + result_bin); } default: /* Compression error, revert to uncompressed binary (still in context) */ @@ -3584,18 +3568,9 @@ dec_term_atom_common: *objp = make_binary(hb); } else { Binary* dbin = erts_bin_nrml_alloc(n); - ProcBin* pb; - pb = (ProcBin *) hp; + + *objp = erts_build_proc_bin(factory->off_heap, hp, dbin); hp += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = n; - pb->next = factory->off_heap->first; - factory->off_heap->first = (struct erl_off_heap_header*)pb; - OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm)); - pb->val = dbin; - pb->bytes = (byte*) dbin->orig_bytes; - pb->flags = 0; - *objp = make_binary(pb); if (ctx) { int n_limit = reds * B2T_MEMCPY_FACTOR; if (n > n_limit) { @@ -3635,18 +3610,9 @@ dec_term_atom_common: ep += n; } else { Binary* dbin = erts_bin_nrml_alloc(n); - ProcBin* pb; + Uint n_copy = n; - pb = (ProcBin *) hp; - pb->thing_word = HEADER_PROC_BIN; - pb->size = n; - pb->next = factory->off_heap->first; - factory->off_heap->first = (struct erl_off_heap_header*)pb; - OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm)); - pb->val = dbin; - pb->bytes = (byte*) dbin->orig_bytes; - pb->flags = 0; - bin = make_binary(pb); + bin = erts_build_proc_bin(factory->off_heap, hp, dbin); hp += PROC_BIN_SIZE; if (ctx) { int n_limit = reds * B2T_MEMCPY_FACTOR; @@ -3654,15 +3620,15 @@ dec_term_atom_common: ctx->state = B2TDecodeBinary; ctx->u.dc.remaining_n = n - n_limit; ctx->u.dc.remaining_bytes = dbin->orig_bytes + n_limit; - n = n_limit; + n_copy = n_limit; reds = 0; } - else + else { reds -= n / B2T_MEMCPY_FACTOR; + } } - sys_memcpy(dbin->orig_bytes, ep, n); - ep += n; - n = pb->size; + sys_memcpy(dbin->orig_bytes, ep, n_copy); + ep += n_copy; } if (bitsize == 8 || n == 0) { diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 09207364eb..86e2c351af 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -861,6 +861,7 @@ Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap); Eterm erts_new_mso_binary(Process*, byte*, Uint); Eterm new_binary(Process*, byte*, Uint); Eterm erts_realloc_binary(Eterm bin, size_t size); +Eterm erts_build_proc_bin(ErlOffHeap*, Eterm*, Binary*); /* erl_bif_info.c */ @@ -1122,7 +1123,6 @@ extern int erts_no_line_info; extern Eterm erts_error_logger_warnings; extern int erts_initialized; extern int erts_compat_rel; -extern int erts_use_sender_punish; void erl_start(int, char**); void erts_usage(void); Eterm erts_preloaded(Process* p); @@ -1264,7 +1264,7 @@ char* erts_convert_filename_to_wchar(byte* bytes, Uint size, char *statbuf, size_t statbuf_size, ErtsAlcType_t alloc_type, Sint* used, Uint extra_wchars); -Eterm erts_convert_native_to_filename(Process *p, byte *bytes); +Eterm erts_convert_native_to_filename(Process *p, size_t size, byte *bytes); Eterm erts_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, Uint left, Uint *num_built, Uint *num_eaten, Eterm tail); int erts_utf8_to_latin1(byte* dest, const byte* source, int slen); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 9933c8dda4..2c1b7871c4 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3384,24 +3384,11 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) { listp = buf_to_intlist(&hp, buf, len, listp); } else if (buf != NULL) { - ProcBin* pb; - Binary* bptr; - - bptr = erts_bin_nrml_alloc(len); + Binary* bptr = erts_bin_nrml_alloc(len); sys_memcpy(bptr->orig_bytes, buf, len); - pb = (ProcBin *) hp; - pb->thing_word = HEADER_PROC_BIN; - pb->size = len; - pb->next = ohp->first; - ohp->first = (struct erl_off_heap_header*)pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; + listp = erts_build_proc_bin(ohp, hp, bptr); hp += PROC_BIN_SIZE; - - OH_OVERHEAD(ohp, pb->size / sizeof(Eterm)); - listp = make_binary(pb); } /* Prepend the header */ @@ -4204,17 +4191,9 @@ write_port_control_result(int control_flags, else { dbin = (ErlDrvBinary *) resp_bufp; if (dbin->orig_size > ERL_ONHEAP_BIN_LIMIT) { - ProcBin* pb = (ProcBin *) *hpp; + res = erts_build_proc_bin(ohp, *hpp, ErlDrvBinary2Binary(dbin)); *hpp += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = dbin->orig_size; - pb->next = ohp->first; - ohp->first = (struct erl_off_heap_header *) pb; - pb->val = ErlDrvBinary2Binary(dbin); - pb->bytes = (byte*) dbin->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(ohp, dbin->orig_size / sizeof(Eterm)); - return make_binary(pb); + return res; } resp_bufp = dbin->orig_bytes; resp_size = dbin->orig_size; @@ -5978,21 +5957,12 @@ driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len) mess = make_binary(hbp); } else { - ProcBin* pbp; + Eterm* hp; Binary* bp = erts_bin_nrml_alloc(size); ASSERT(bufp); sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size); - pbp = (ProcBin *) erts_produce_heap(&factory, - PROC_BIN_SIZE, HEAP_EXTRA); - pbp->thing_word = HEADER_PROC_BIN; - pbp->size = size; - pbp->next = factory.off_heap->first; - factory.off_heap->first = (struct erl_off_heap_header*)pbp; - pbp->val = bp; - pbp->bytes = (byte*) bp->orig_bytes; - pbp->flags = 0; - OH_OVERHEAD(factory.off_heap, pbp->size / sizeof(Eterm)); - mess = make_binary(pbp); + hp = erts_produce_heap(&factory, PROC_BIN_SIZE, HEAP_EXTRA); + mess = erts_build_proc_bin(factory.off_heap, hp, bp); } ptr += 2; break; @@ -7715,13 +7685,27 @@ int null_func(void) int erl_drv_putenv(const char *key, char *value) { - return erts_sys_putenv_raw((char*)key, value); + switch (erts_sys_explicit_8bit_putenv((char*)key, value)) { + case -1: /* Insufficient buffer space */ + return 1; + case 1: /* Success */ + return 0; + default: /* Not found */ + return -1; + } } int erl_drv_getenv(const char *key, char *value, size_t *value_size) { - return erts_sys_getenv_raw((char*)key, value, value_size); + switch (erts_sys_explicit_8bit_getenv((char*)key, value, value_size)) { + case -1: /* Insufficient buffer space */ + return 1; + case 1: /* Success */ + return 0; + default: /* Not found */ + return -1; + } } /* get heart_port diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index bf7d310568..290e0b209a 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -636,6 +636,8 @@ typedef struct preload { */ typedef Eterm ErtsTracer; +#include "erl_osenv.h" + /* * This structure contains options to all built in drivers. * None of the drivers use all of the fields. @@ -651,8 +653,7 @@ typedef struct _SysDriverOpts { int hide_window; /* Hide this windows (Windows). */ int exit_status; /* Report exit status of subprocess. */ int overlapped_io; /* Only has effect on windows NT et al */ - char *envir; /* Environment of the port process, */ - /* in Windows format. */ + erts_osenv_t envir; /* Environment of the port process */ char **argv; /* Argument vector in Unix'ish format. */ char *wd; /* Working directory. */ unsigned spawn_type; /* Bitfield of ERTS_SPAWN_DRIVER | @@ -782,9 +783,6 @@ void set_break_quit(void (*)(void), void (*)(void)); void os_flavor(char*, unsigned); void os_version(int*, int*, int*); -void init_getenv_state(GETENV_STATE *); -char * getenv_string(GETENV_STATE *); -void fini_getenv_state(GETENV_STATE *); #define HAVE_ERTS_CHECK_IO_DEBUG typedef struct { @@ -805,20 +803,21 @@ int sys_double_to_chars_ext(double, char*, size_t, size_t); int sys_double_to_chars_fast(double, char*, int, int, int); void sys_get_pid(char *, size_t); -/* erts_sys_putenv() returns, 0 on success and a value != 0 on failure. */ -int erts_sys_putenv(char *key, char *value); -/* Simple variant used from drivers, raw eightbit interface */ -int erts_sys_putenv_raw(char *key, char *value); -/* erts_sys_getenv() returns 0 on success (length of value string in - *size), a value > 0 if value buffer is too small (*size is set to needed - size), and a value < 0 on failure. */ -int erts_sys_getenv(char *key, char *value, size_t *size); -/* Simple variant used from drivers, raw eightbit interface */ -int erts_sys_getenv_raw(char *key, char *value, size_t *size); -/* erts_sys_getenv__() is only allowed to be used in early init phase */ -int erts_sys_getenv__(char *key, char *value, size_t *size); -/* erst_sys_unsetenv() returns 0 on success and a value != 0 on failure. */ -int erts_sys_unsetenv(char *key); +/* erl_drv_get/putenv have been implicitly 8-bit for so long that we can't + * change them without breaking things on Windows. Their return values are + * identical to erts_osenv_get/putenv */ +int erts_sys_explicit_8bit_getenv(char *key, char *value, size_t *size); +int erts_sys_explicit_8bit_putenv(char *key, char *value); + +/* This is identical to erts_sys_explicit_8bit_getenv but falls down to the + * host OS implementation instead of erts_osenv. */ +int erts_sys_explicit_host_getenv(char *key, char *value, size_t *size); + +const erts_osenv_t *erts_sys_rlock_global_osenv(void); +void erts_sys_runlock_global_osenv(void); + +erts_osenv_t *erts_sys_rwlock_global_osenv(void); +void erts_sys_rwunlock_global_osenv(void); /* Easier to use, but not as efficient, environment functions */ char *erts_read_env(char *key); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 993585be10..fe9f1c7606 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -4360,15 +4360,20 @@ erts_read_env(char *key) char *value = erts_alloc(ERTS_ALC_T_TMP, value_len); int res; while (1) { - res = erts_sys_getenv_raw(key, value, &value_len); - if (res <= 0) - break; - value = erts_realloc(ERTS_ALC_T_TMP, value, value_len); + res = erts_sys_explicit_8bit_getenv(key, value, &value_len); + + if (res >= 0) { + break; + } + + value = erts_realloc(ERTS_ALC_T_TMP, value, value_len); } - if (res != 0) { - erts_free(ERTS_ALC_T_TMP, value); - return NULL; + + if (res != 1) { + erts_free(ERTS_ALC_T_TMP, value); + return NULL; } + return value; } diff --git a/erts/emulator/sys/common/erl_osenv.c b/erts/emulator/sys/common/erl_osenv.c new file mode 100644 index 0000000000..9f54d1dff0 --- /dev/null +++ b/erts/emulator/sys/common/erl_osenv.c @@ -0,0 +1,396 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2017. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#include "erl_osenv.h" + +#include "global.h" +#include "erl_alloc.h" +#include "erl_process.h" + +#define STACKBUF_SIZE (512) + +typedef struct __env_rbtnode_t { + struct __env_rbtnode_t *parent; + struct __env_rbtnode_t *left; + struct __env_rbtnode_t *right; + + int is_red; + + erts_osenv_data_t key; + erts_osenv_data_t value; +} env_rbtnode_t; + +#define ERTS_RBT_PREFIX env +#define ERTS_RBT_T env_rbtnode_t +#define ERTS_RBT_KEY_T erts_osenv_data_t +#define ERTS_RBT_FLAGS_T int +#define ERTS_RBT_INIT_EMPTY_TNODE(T) \ + do { \ + (T)->parent = NULL; \ + (T)->left = NULL; \ + (T)->right = NULL; \ + (T)->is_red = 0; \ + } while(0) +#define ERTS_RBT_IS_RED(T) ((T)->is_red) +#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1) +#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T)) +#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0) +#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red) +#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F) +#define ERTS_RBT_GET_PARENT(T) ((T)->parent) +#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P) +#define ERTS_RBT_GET_RIGHT(T) ((T)->right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->key) +#define ERTS_RBT_IS_LT(KX, KY) (compare_env_keys(KX, KY) < 0) +#define ERTS_RBT_IS_EQ(KX, KY) (compare_env_keys(KX, KY) == 0) +#define ERTS_RBT_WANT_FOREACH_DESTROY +#define ERTS_RBT_WANT_FOREACH +#define ERTS_RBT_WANT_REPLACE +#define ERTS_RBT_WANT_DELETE +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP + +static int compare_env_keys(const erts_osenv_data_t a, const erts_osenv_data_t b); + +#include "erl_rbtree.h" + +static int compare_env_keys(const erts_osenv_data_t a, const erts_osenv_data_t b) { + int relation = sys_memcmp(a.data, b.data, MIN(a.length, b.length)); + + if(relation != 0) { + return relation; + } + + if(a.length < b.length) { + return -1; + } else if(a.length == b.length) { + return 0; + } else { + return 1; + } +} + +static void *convert_value_to_native(Eterm term, char *stackbuf, + int stackbuf_size, Sint *length) { + int encoding; + void *result; + + if(is_atom(term)) { + return NULL; + } + + encoding = erts_get_native_filename_encoding(); + *length = erts_native_filename_need(term, encoding); + + if(*length < 0) { + return NULL; + } else if(*length >= stackbuf_size) { + result = erts_alloc(ERTS_ALC_T_TMP, *length); + } else { + result = stackbuf; + } + + erts_native_filename_put(term, encoding, (byte*)result); + + return result; +} + +static void *convert_key_to_native(Eterm term, char *stackbuf, + int stackbuf_size, Sint *length) { + byte *name_iterator, *name_end; + void *result; + int encoding; + + result = convert_value_to_native(term, stackbuf, stackbuf_size, length); + + if(result == NULL || length == 0) { + return NULL; + } + + encoding = erts_get_native_filename_encoding(); + + name_iterator = (byte*)result; + name_end = &name_iterator[*length]; + +#ifdef __WIN32__ + /* Windows stores per-drive working directories as variables starting with + * '=', so we skip the first character to tolerate that. */ + name_iterator = erts_raw_env_next_char(name_iterator, encoding); +#endif + + while(name_iterator < name_end) { + if(erts_raw_env_char_is_7bit_ascii_char('=', name_iterator, encoding)) { + if(result != stackbuf) { + erts_free(ERTS_ALC_T_TMP, result); + } + + return NULL; + } + + name_iterator = erts_raw_env_next_char(name_iterator, encoding); + } + + return result; +} + +void erts_osenv_init(erts_osenv_t *env) { + env->variable_count = 0; + env->content_size = 0; + env->tree = NULL; +} + +static void destroy_foreach(env_rbtnode_t *node, void *_state) { + erts_free(ERTS_ALC_T_ENVIRONMENT, node); + (void)_state; +} + +void erts_osenv_clear(erts_osenv_t *env) { + env_rbt_foreach_destroy(&env->tree, &destroy_foreach, NULL); + erts_osenv_init(env); +} + +struct __env_merge { + int overwrite_existing; + erts_osenv_t *env; +}; + +static void merge_foreach(env_rbtnode_t *node, void *_state) { + struct __env_merge *state = (struct __env_merge*)(_state); + env_rbtnode_t *existing_node; + + existing_node = env_rbt_lookup(state->env->tree, node->key); + + if(existing_node == NULL || state->overwrite_existing) { + erts_osenv_put_native(state->env, &node->key, &node->value); + } +} + +void erts_osenv_merge(erts_osenv_t *env, const erts_osenv_t *with, int overwrite) { + struct __env_merge merge_state; + + merge_state.overwrite_existing = overwrite; + merge_state.env = env; + + env_rbt_foreach(with->tree, merge_foreach, &merge_state); +} + +struct __env_foreach_term { + erts_osenv_foreach_term_cb_t user_callback; + struct process *process; + void *user_state; +}; + +static void foreach_term_wrapper(env_rbtnode_t *node, void *_state) { + struct __env_foreach_term *state = (struct __env_foreach_term*)_state; + Eterm key, value; + + key = erts_convert_native_to_filename(state->process, + node->key.length, (byte*)node->key.data); + value = erts_convert_native_to_filename(state->process, + node->value.length, (byte*)node->value.data); + + state->user_callback(state->process, state->user_state, key, value); +} + +void erts_osenv_foreach_term(const erts_osenv_t *env, struct process *process, + void *state, erts_osenv_foreach_term_cb_t callback) { + struct __env_foreach_term wrapper_state; + + wrapper_state.user_callback = callback; + wrapper_state.user_state = state; + wrapper_state.process = process; + + env_rbt_foreach(env->tree, foreach_term_wrapper, &wrapper_state); +} + +int erts_osenv_get_term(const erts_osenv_t *env, Process *process, + Eterm key_term, Eterm *out_term) { + char key_stackbuf[STACKBUF_SIZE]; + erts_osenv_data_t key; + int result; + + key.data = convert_key_to_native(key_term, key_stackbuf, + STACKBUF_SIZE, &key.length); + result = -1; + + if(key.data != NULL) { + env_rbtnode_t *node; + + node = env_rbt_lookup(env->tree, key); + result = 0; + + if(node != NULL) { + (*out_term) = erts_convert_native_to_filename(process, + node->value.length, (byte*)node->value.data); + result = 1; + } + + if(key.data != key_stackbuf) { + erts_free(ERTS_ALC_T_TMP, key.data); + } + } + + return result; +} + +int erts_osenv_put_term(erts_osenv_t *env, Eterm key_term, Eterm value_term) { + char key_stackbuf[STACKBUF_SIZE], value_stackbuf[STACKBUF_SIZE]; + erts_osenv_data_t key, value; + int result; + + key.data = convert_key_to_native(key_term, key_stackbuf, + STACKBUF_SIZE, &key.length); + value.data = convert_value_to_native(value_term, value_stackbuf, + STACKBUF_SIZE, &value.length); + result = -1; + + if(value.data != NULL && key.data != NULL) { + result = erts_osenv_put_native(env, &key, &value); + } + + if(value.data != NULL && value.data != value_stackbuf) { + erts_free(ERTS_ALC_T_TMP, value.data); + } + + if(key.data != NULL && key.data != key_stackbuf) { + erts_free(ERTS_ALC_T_TMP, key.data); + } + + return result; +} + +int erts_osenv_unset_term(erts_osenv_t *env, Eterm key_term) { + char key_stackbuf[STACKBUF_SIZE]; + erts_osenv_data_t key; + int result; + + key.data = convert_key_to_native(key_term, key_stackbuf, + STACKBUF_SIZE, &key.length); + result = -1; + + if(key.data != NULL) { + result = erts_osenv_unset_native(env, &key); + + if(key.data != key_stackbuf) { + erts_free(ERTS_ALC_T_TMP, key.data); + } + } + + return result; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +struct __env_foreach_native { + erts_osenv_foreach_native_cb_t user_callback; + void *user_state; +}; + +static void foreach_native_wrapper(env_rbtnode_t *node, void *_state) { + struct __env_foreach_native *state = (struct __env_foreach_native*)_state; + + state->user_callback(state->user_state, &node->key, &node->value); +} + +void erts_osenv_foreach_native(const erts_osenv_t *env, void *state, + erts_osenv_foreach_native_cb_t callback) { + struct __env_foreach_native wrapper_state; + + wrapper_state.user_callback = callback; + wrapper_state.user_state = state; + + env_rbt_foreach(env->tree, foreach_native_wrapper, &wrapper_state); +} + +int erts_osenv_get_native(const erts_osenv_t *env, + const erts_osenv_data_t *key, + erts_osenv_data_t *value) { + env_rbtnode_t *node = env_rbt_lookup(env->tree, *key); + + if(node != NULL) { + if(value != NULL) { + if(node->value.length > value->length) { + return -1; + } + + sys_memcpy(value->data, node->value.data, node->value.length); + value->length = node->value.length; + } + + return 1; + } + + return 0; +} + +int erts_osenv_put_native(erts_osenv_t *env, const erts_osenv_data_t *key, + const erts_osenv_data_t *value) { + env_rbtnode_t *old_node, *new_node; + + new_node = erts_alloc(ERTS_ALC_T_ENVIRONMENT, sizeof(env_rbtnode_t) + + key->length + value->length); + + new_node->key.data = (char*)(&new_node[1]); + new_node->key.length = key->length; + new_node->value.data = &((char*)new_node->key.data)[key->length]; + new_node->value.length = value->length; + + sys_memcpy(new_node->key.data, key->data, key->length); + sys_memcpy(new_node->value.data, value->data, value->length); + + old_node = env_rbt_lookup(env->tree, *key); + + if(old_node != NULL) { + env->content_size -= old_node->value.length; + env->content_size -= old_node->key.length; + env_rbt_replace(&env->tree, old_node, new_node); + } else { + env_rbt_insert(&env->tree, new_node); + env->variable_count++; + } + + env->content_size += new_node->value.length; + env->content_size += new_node->key.length; + + if(old_node != NULL) { + erts_free(ERTS_ALC_T_ENVIRONMENT, old_node); + } + + return 1; +} + +int erts_osenv_unset_native(erts_osenv_t *env, const erts_osenv_data_t *key) { + env_rbtnode_t *old_node = env_rbt_lookup(env->tree, *key); + + if(old_node != NULL) { + env->content_size -= old_node->value.length; + env->content_size -= old_node->key.length; + env->variable_count -= 1; + + env_rbt_delete(&env->tree, old_node); + erts_free(ERTS_ALC_T_ENVIRONMENT, old_node); + return 1; + } + + return 0; +} diff --git a/erts/emulator/sys/common/erl_osenv.h b/erts/emulator/sys/common/erl_osenv.h new file mode 100644 index 0000000000..4777f2148a --- /dev/null +++ b/erts/emulator/sys/common/erl_osenv.h @@ -0,0 +1,121 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2017. 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% + */ + +/* This is a replacement for getenv(3) and friends, operating on instances so + * we can keep a common implementation for both the global and local (per-port) + * environments. + * + * The instances are not thread-safe on their own but unlike getenv(3) we're + * guaranteed to be the only user, so placing locks around all our accesses + * will suffice. + * + * Use erts_sys_rwlock_global_osenv to access the global environment. */ + +#ifndef __ERL_OSENV_H__ +#define __ERL_OSENV_H__ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +typedef struct __erts_osenv_data_t erts_osenv_data_t; + +typedef struct __erts_osenv_t { + struct __env_rbtnode_t *tree; + int variable_count; + int content_size; +} erts_osenv_t; + +#include "sys.h" + +struct __erts_osenv_data_t { + Sint length; + void *data; +}; + +void erts_osenv_init(erts_osenv_t *env); +void erts_osenv_clear(erts_osenv_t *env); + +/* @brief Merges \c with into \c env + * + * @param overwrite Whether to overwrite existing entries or keep them as they + * are. */ +void erts_osenv_merge(erts_osenv_t *env, const erts_osenv_t *with, int overwrite); + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +/* @brief Copies env[key] into \c value + * + * @return 1 on success, 0 if the key couldn't be found, and -1 if the input + * was invalid. */ +int erts_osenv_get_term(const erts_osenv_t *env, struct process *process, + Eterm key, Eterm *value); + +/* @brief Copies \c value into \c env[key] + * + * @return 1 on success, -1 if the input was invalid. */ +int erts_osenv_put_term(erts_osenv_t *env, Eterm key, Eterm value); + +/* @brief Removes \c env[key] + * + * @return 1 on success, 0 if the key couldn't be found, and -1 if the input + * was invalid. */ +int erts_osenv_unset_term(erts_osenv_t *env, Eterm key); + +/* @brief Copies env[key] into \c value + * + * @param value [in,out] The buffer to copy the value into, may be NULL if you + * only wish to query presence. + * + * @return 1 on success, 0 if the key couldn't be found, and -1 if if the value + * didn't fit into the buffer. */ +int erts_osenv_get_native(const erts_osenv_t *env, const erts_osenv_data_t *key, + erts_osenv_data_t *value); + +/* @brief Copies \c value into \c env[key] + * + * @return 1 on success, -1 on failure. */ +int erts_osenv_put_native(erts_osenv_t *env, const erts_osenv_data_t *key, + const erts_osenv_data_t *value); + +/* @brief Removes \c key from the env. + * + * @return 1 on success, 0 if the key couldn't be found. */ +int erts_osenv_unset_native(erts_osenv_t *env, const erts_osenv_data_t *key); + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +typedef void (*erts_osenv_foreach_term_cb_t)(struct process *process, + void *state, Eterm key, Eterm value); + +typedef void (*erts_osenv_foreach_native_cb_t)(void *state, + const erts_osenv_data_t *key, + const erts_osenv_data_t *value); + +/* @brief Walks through all environment variables, calling \c callback for each + * one. It's unsafe to modify \c env within the callback. */ +void erts_osenv_foreach_term(const erts_osenv_t *env, struct process *process, + void *state, erts_osenv_foreach_term_cb_t callback); + +/* @copydoc erts_osenv_foreach_term */ +void erts_osenv_foreach_native(const erts_osenv_t *env, void *state, + erts_osenv_foreach_native_cb_t callback); + +#endif diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index b6f5b319ee..e367d565a7 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -133,7 +133,7 @@ #define ERTS_SYS_CONTINOUS_FD_NUMBERS -typedef void *GETENV_STATE; +void erts_sys_env_init(void); /* ** For the erl_timer_sup module. diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 6315135151..189ca083d7 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -62,9 +62,6 @@ #include "erl_mseg.h" -extern char **environ; -erts_rwmtx_t environ_rwmtx; - #define MAX_VSIZE 16 /* Max number of entries allowed in an I/O * vector sock_sendv(). */ @@ -77,7 +74,7 @@ erts_rwmtx_t environ_rwmtx; #include "erl_check_io.h" #include "erl_cpu_topology.h" - +#include "erl_osenv.h" extern int driver_interrupt(int, int); extern void do_break(void); @@ -454,10 +451,10 @@ prepare_crash_dump(int secs) close(crashdump_companion_cube_fd); envsz = sizeof(env); - i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz); + i = erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_NICE", env, &envsz); if (i >= 0) { int nice_val; - nice_val = i != 0 ? 0 : atoi(env); + nice_val = i != 1 ? 0 : atoi(env); if (nice_val > 39) { nice_val = 39; } @@ -749,34 +746,6 @@ void os_version(int *pMajor, int *pMinor, int *pBuild) { *pBuild = get_number(&release); /* Pointer to build number. */ } -void init_getenv_state(GETENV_STATE *state) -{ - erts_rwmtx_rlock(&environ_rwmtx); - *state = NULL; -} - -char *getenv_string(GETENV_STATE *state0) -{ - char **state = (char **) *state0; - char *cp; - - ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&environ_rwmtx)); - - if (state == NULL) - state = environ; - - cp = *state++; - *state0 = (GETENV_STATE) state; - - return cp; -} - -void fini_getenv_state(GETENV_STATE *state) -{ - *state = NULL; - erts_rwmtx_runlock(&environ_rwmtx); -} - void erts_do_break_handling(void) { struct termios temp_mode; @@ -830,90 +799,6 @@ void sys_get_pid(char *buffer, size_t buffer_size){ erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p); } -int -erts_sys_putenv_raw(char *key, char *value) { - return erts_sys_putenv(key, value); -} -int -erts_sys_putenv(char *key, char *value) -{ - int res; - char *env; - Uint need = strlen(key) + strlen(value) + 2; - -#ifdef HAVE_COPYING_PUTENV - env = erts_alloc(ERTS_ALC_T_TMP, need); -#else - env = erts_alloc(ERTS_ALC_T_PUTENV_STR, need); - erts_atomic_add_nob(&sys_misc_mem_sz, need); -#endif - strcpy(env,key); - strcat(env,"="); - strcat(env,value); - erts_rwmtx_rwlock(&environ_rwmtx); - res = putenv(env); - erts_rwmtx_rwunlock(&environ_rwmtx); -#ifdef HAVE_COPYING_PUTENV - erts_free(ERTS_ALC_T_TMP, env); -#endif - return res; -} - -int -erts_sys_getenv__(char *key, char *value, size_t *size) -{ - int res; - char *orig_value = getenv(key); - if (!orig_value) - res = -1; - else { - size_t len = sys_strlen(orig_value); - if (len >= *size) { - *size = len + 1; - res = 1; - } - else { - *size = len; - sys_memcpy((void *) value, (void *) orig_value, len+1); - res = 0; - } - } - return res; -} - -int -erts_sys_getenv_raw(char *key, char *value, size_t *size) { - return erts_sys_getenv(key, value, size); -} - -/* - * erts_sys_getenv - * returns: - * -1, if environment key is not set with a value - * 0, if environment key is set and value fits into buffer size - * 1, if environment key is set but does not fit into buffer size - * size is set with the needed buffer size value - */ - -int -erts_sys_getenv(char *key, char *value, size_t *size) -{ - int res; - erts_rwmtx_rlock(&environ_rwmtx); - res = erts_sys_getenv__(key, value, size); - erts_rwmtx_runlock(&environ_rwmtx); - return res; -} - -int -erts_sys_unsetenv(char *key) -{ - int res; - erts_rwmtx_rwlock(&environ_rwmtx); - res = unsetenv(key); - erts_rwmtx_rwunlock(&environ_rwmtx); - return res; -} void sys_init_io(void) { } void erts_sys_alloc_init(void) { } @@ -1260,14 +1145,9 @@ erts_sys_main_thread(void) } } - void erl_sys_args(int* argc, char** argv) { - - erts_rwmtx_init(&environ_rwmtx, "environ", NIL, - ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); - ASSERT(argc && argv); max_files = erts_check_io_max_files(); @@ -1275,4 +1155,5 @@ erl_sys_args(int* argc, char** argv) init_smp_sig_notify(); init_smp_sig_suspend(); + erts_sys_env_init(); } diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 0228e1af54..b7ac89d89a 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -55,9 +55,6 @@ #include "erl_threads.h" -extern char **environ; -extern erts_rwmtx_t environ_rwmtx; - extern erts_atomic_t sys_misc_mem_sz; static Eterm forker_port; @@ -180,7 +177,7 @@ erl_sys_late_init(void) opts.read_write = 0; opts.hide_window = 0; opts.wd = NULL; - opts.envir = NULL; + erts_osenv_init(&opts.envir); opts.exit_status = 0; opts.overlapped_io = 0; opts.spawn_type = ERTS_SPAWN_ANY; @@ -443,85 +440,55 @@ static void close_pipes(int ifd[2], int ofd[2]) close(ofd[1]); } -static char **build_unix_environment(char *block) +struct __add_spawn_env_state { + struct iovec *iov; + int *iov_index; + + Sint32 *payload_size; + char *env_block; +}; + +static void add_spawn_env_block_foreach(void *_state, + const erts_osenv_data_t *key, + const erts_osenv_data_t *value) { - int i; - int j; - int len; - char *cp; - char **cpp; - char** old_env; - - ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&environ_rwmtx)); - - cp = block; - len = 0; - while (*cp != '\0') { - cp += strlen(cp) + 1; - len++; - } - old_env = environ; - while (*old_env++ != NULL) { - len++; - } - - cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT, - sizeof(char *) * (len+1)); - if (cpp == NULL) { - return NULL; - } + struct __add_spawn_env_state *state; + struct iovec *iov; - cp = block; - len = 0; - while (*cp != '\0') { - cpp[len] = cp; - cp += strlen(cp) + 1; - len++; - } - - i = len; - for (old_env = environ; *old_env; old_env++) { - char* old = *old_env; - - for (j = 0; j < len; j++) { - char *s, *t; - - /* check if cpp[j] equals old - before the = sign, - i.e. - "TMPDIR=/tmp/" */ - s = cpp[j]; - t = old; - while (*s == *t && *s != '=') { - s++, t++; - } - if (*s == '=' && *t == '=') { - break; - } - } + state = (struct __add_spawn_env_state*)(_state); + iov = &state->iov[*state->iov_index]; - if (j == len) { /* New version not found */ - cpp[len++] = old; - } - } + iov->iov_base = state->env_block; - for (j = 0; j < i; ) { - size_t last = strlen(cpp[j])-1; - if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) { - cpp[j] = cpp[--len]; - if (len < i) { - i--; - } else { - j++; - } - } - else { - j++; - } - } + sys_memcpy(state->env_block, key->data, key->length); + state->env_block += key->length; + *state->env_block++ = '='; + sys_memcpy(state->env_block, value->data, value->length); + state->env_block += value->length; + *state->env_block++ = '\0'; - cpp[len] = NULL; - return cpp; + iov->iov_len = state->env_block - (char*)iov->iov_base; + + (*state->payload_size) += iov->iov_len; + (*state->iov_index)++; +} + +static void *add_spawn_env_block(const erts_osenv_t *env, struct iovec *iov, + int *iov_index, Sint32 *payload_size) { + struct __add_spawn_env_state add_state; + char *env_block; + + env_block = erts_alloc(ERTS_ALC_T_TMP, env->content_size + + env->variable_count * sizeof("=\0")); + + add_state.iov = iov; + add_state.iov_index = iov_index; + add_state.env_block = env_block; + add_state.payload_size = payload_size; + + erts_osenv_foreach_native(env, &add_state, add_spawn_env_block_foreach); + + return env_block; } static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, @@ -531,7 +498,6 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, #define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) int len; - char **new_environ; ErtsSysDriverData *dd; char *cmd_line; char wd_buff[MAXPATHLEN+1]; @@ -598,19 +564,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; len = CMD_LINE_PREFIX_STR_SZ + len + 1; - } - - erts_rwmtx_rlock(&environ_rwmtx); - - if (opts->envir == NULL) { - new_environ = environ; - } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { - erts_rwmtx_runlock(&environ_rwmtx); - close_pipes(ifd, ofd); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } +} if ((cwd = getcwd(wd_buff, MAXPATHLEN+1)) == NULL) { /* on some OSs this call opens a fd in the @@ -619,9 +573,6 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, int err = errno; close_pipes(ifd, ofd); erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - erts_rwmtx_runlock(&environ_rwmtx); errno = err; return ERL_DRV_ERROR_ERRNO; } @@ -629,6 +580,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, wd = opts->wd; { + void *environment_block; struct iovec *io_vector; int iov_len = 5; char nullbuff[] = "\0"; @@ -641,10 +593,8 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, if (wd) iov_len++; - /* count number of elements in environment */ - while(new_environ[env_len] != NULL) - env_len++; - iov_len += 1 + env_len; /* num envs including size int */ + /* num envs including size int */ + iov_len += 1 + opts->envir.variable_count; /* count number of element in argument list */ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { @@ -661,10 +611,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, if (!io_vector) { close_pipes(ifd, ofd); - erts_rwmtx_runlock(&environ_rwmtx); erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); errno = ENOMEM; return ERL_DRV_ERROR_ERRNO; } @@ -699,16 +646,13 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, io_vector[i++].iov_len = 1; buffsz += io_vector[i-1].iov_len; + env_len = htonl(opts->envir.variable_count); io_vector[i].iov_base = (void*)&env_len; - env_len = htonl(env_len); io_vector[i++].iov_len = sizeof(env_len); buffsz += io_vector[i-1].iov_len; - for (j = 0; new_environ[j] != NULL; j++) { - io_vector[i].iov_base = new_environ[j]; - io_vector[i++].iov_len = strlen(new_environ[j]) + 1; - buffsz += io_vector[i-1].iov_len; - } + environment_block = add_spawn_env_block(&opts->envir, io_vector, &i, + &buffsz); /* only append arguments if this was a spawn_executable */ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { @@ -744,9 +688,6 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, int err = errno; close_pipes(ifd, ofd); erts_free(ERTS_ALC_T_TMP, io_vector); - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - erts_rwmtx_runlock(&environ_rwmtx); erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); errno = err; return ERL_DRV_ERROR_ERRNO; @@ -767,16 +708,12 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, driver_select(port_num, ofd[1], ERL_DRV_WRITE|ERL_DRV_USE, 1); } + erts_free(ERTS_ALC_T_TMP, environment_block); erts_free(ERTS_ALC_T_TMP, io_vector); } erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - - erts_rwmtx_runlock(&environ_rwmtx); - dd = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, DO_WRITE | DO_READ, opts->exit_status, 0, 0); @@ -1652,15 +1589,13 @@ static ErlDrvData forker_start(ErlDrvPort port_num, char* name, forker_port = erts_drvport2id(port_num); - res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); - if (res != 0) { - if (res < 0) - erts_exit(1, - "Environment variable BINDIR is not set\n"); - if (res > 0) - erts_exit(1, - "Value of environment variable BINDIR is too large\n"); + res = erts_sys_explicit_8bit_getenv("BINDIR", bindir, &bindirsz); + if (res == 0) { + erts_exit(1, "Environment variable BINDIR is not set\n"); + } else if(res < 0) { + erts_exit(1, "Value of environment variable BINDIR is too large\n"); } + if (bindir[0] != DIR_SEPARATOR_CHAR) erts_exit(1, "Environment variable BINDIR does not contain an" diff --git a/erts/emulator/sys/unix/sys_env.c b/erts/emulator/sys/unix/sys_env.c new file mode 100644 index 0000000000..4d8301f985 --- /dev/null +++ b/erts/emulator/sys/unix/sys_env.c @@ -0,0 +1,133 @@ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_osenv.h" +#include "erl_alloc.h" + +#include "erl_thr_progress.h" + +static erts_osenv_t sysenv_global_env; +static erts_rwmtx_t sysenv_rwmtx; + +extern char **environ; + +static void import_initial_env(void); + +void erts_sys_env_init() { + erts_rwmtx_init(&sysenv_rwmtx, "environ", NIL, + ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); + + erts_osenv_init(&sysenv_global_env); + import_initial_env(); +} + +const erts_osenv_t *erts_sys_rlock_global_osenv() { + erts_rwmtx_rlock(&sysenv_rwmtx); + return &sysenv_global_env; +} + +erts_osenv_t *erts_sys_rwlock_global_osenv() { + erts_rwmtx_rwlock(&sysenv_rwmtx); + return &sysenv_global_env; +} + +void erts_sys_rwunlock_global_osenv() { + erts_rwmtx_rwunlock(&sysenv_rwmtx); +} + +void erts_sys_runlock_global_osenv() { + erts_rwmtx_runlock(&sysenv_rwmtx); +} + +int erts_sys_explicit_8bit_putenv(char *key, char *value) { + erts_osenv_data_t env_key, env_value; + int result; + + env_key.length = sys_strlen(key); + env_key.data = key; + + env_value.length = sys_strlen(value); + env_value.data = value; + + { + erts_osenv_t *env = erts_sys_rwlock_global_osenv(); + result = erts_osenv_put_native(env, &env_key, &env_value); + erts_sys_rwunlock_global_osenv(); + } + + return result; +} + +int erts_sys_explicit_8bit_getenv(char *key, char *value, size_t *size) { + erts_osenv_data_t env_key, env_value; + int result; + + env_key.length = sys_strlen(key); + env_key.data = key; + + /* Reserve space for NUL termination. */ + env_value.length = *size - 1; + env_value.data = value; + + { + const erts_osenv_t *env = erts_sys_rlock_global_osenv(); + result = erts_osenv_get_native(env, &env_key, &env_value); + erts_sys_runlock_global_osenv(); + } + + if(result == 1) { + value[env_value.length] = '\0'; + } + + *size = env_value.length; + + return result; +} + +int erts_sys_explicit_host_getenv(char *key, char *value, size_t *size) { + char *orig_value; + size_t length; + + orig_value = getenv(key); + + if(orig_value == NULL) { + return 0; + } + + length = sys_strlen(orig_value); + + if (length >= *size) { + *size = length + 1; + return -1; + } + + sys_memcpy((void*)value, (void*)orig_value, length + 1); + *size = length; + + return 1; +} + +static void import_initial_env(void) { + char **environ_iterator, *environ_variable; + + environ_iterator = environ; + + while ((environ_variable = *(environ_iterator++)) != NULL) { + char *separator_index = strchr(environ_variable, '='); + + if (separator_index != NULL) { + erts_osenv_data_t env_key, env_value; + + env_key.length = separator_index - environ_variable; + env_key.data = environ_variable; + + env_value.length = sys_strlen(separator_index) - 1; + env_value.data = separator_index + 1; + + erts_osenv_put_native(&sysenv_global_env, &env_key, &env_value); + } + } +} diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c index 274133a346..fc2179328f 100644 --- a/erts/emulator/sys/win32/erl_win32_sys_ddll.c +++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c @@ -46,9 +46,17 @@ static TWinDynDriverCallbacks wddc; static TWinDynNifCallbacks nif_callbacks; void erl_sys_ddll_init(void) { + WCHAR cwd_buffer[MAX_PATH]; + tls_index = TlsAlloc(); ERL_INIT_CALLBACK_STRUCTURE(wddc); + /* LOAD_WITH_ALTERED_SEARCH_PATH removes the startup directory from the + * search path, so we add it separately to be backwards compatible. */ + if (GetCurrentDirectoryW(sizeof(cwd_buffer), cwd_buffer)) { + SetDllDirectoryW(cwd_buffer); + } + #define ERL_NIF_API_FUNC_DECL(RET,NAME,ARGS) nif_callbacks.NAME = NAME #include "erl_nif_api_funcs.h" #undef ERL_NIF_API_FUNC_DECL @@ -81,7 +89,10 @@ int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* e ERTS_ALC_T_TMP, &used, EXT_LEN); wcscpy(&wcp[used/2 - 1], FILE_EXT_WCHAR); - if ((hinstance = LoadLibraryW(wcp)) == NULL) { + /* LOAD_WITH_ALTERED_SEARCH_PATH adds the specified DLL's directory to the + * dependency search path. This also removes the directory we started in, + * but we've explicitly added that in in erl_sys_ddll_init. */ + if ((hinstance = LoadLibraryExW(wcp, NULL, LOAD_WITH_ALTERED_SEARCH_PATH)) == NULL) { code = ERL_DE_DYNAMIC_ERROR_OFFSET - GetLastError(); if (err != NULL) { err->str = erts_sys_ddll_error(code); diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 0598a12351..a1c630d68a 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -77,6 +77,7 @@ static int create_pipe(LPHANDLE, LPHANDLE, BOOL, BOOL); static int application_type(const wchar_t* originalName, wchar_t fullPath[MAX_PATH], BOOL search_in_path, BOOL handle_quotes, int *error_return); +static void *build_env_block(const erts_osenv_t *env); HANDLE erts_service_event; @@ -1190,7 +1191,6 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts) int ok; int neededSelects = 0; SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE}; - char* envir = opts->envir; int errno_return = -1; wchar_t *name; int len; @@ -1265,29 +1265,33 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts) name[i] = L'\0'; } DEBUGF(("Spawning \"%S\"\n", name)); - envir = win_build_environment(envir); /* Always a unicode environment */ - ok = create_child_process(name, - hChildStdin, - hChildStdout, - hChildStderr, - &dp->port_pid, - &pid, - opts->hide_window, - (LPVOID) envir, - (wchar_t *) opts->wd, - opts->spawn_type, - (wchar_t **) opts->argv, - &errno_return); - CloseHandle(hChildStdin); - CloseHandle(hChildStdout); - if (close_child_stderr && hChildStderr != INVALID_HANDLE_VALUE && - hChildStderr != 0) { - CloseHandle(hChildStderr); - } - erts_free(ERTS_ALC_T_TMP, name); - - if (envir != NULL) { - erts_free(ERTS_ALC_T_ENVIRONMENT, envir); + + { + void *environment_block = build_env_block(&opts->envir); + + ok = create_child_process(name, + hChildStdin, + hChildStdout, + hChildStderr, + &dp->port_pid, + &pid, + opts->hide_window, + environment_block, + (wchar_t *) opts->wd, + opts->spawn_type, + (wchar_t **) opts->argv, + &errno_return); + + CloseHandle(hChildStdin); + CloseHandle(hChildStdout); + + if (close_child_stderr && hChildStderr != INVALID_HANDLE_VALUE && + hChildStderr != 0) { + CloseHandle(hChildStderr); + } + + erts_free(ERTS_ALC_T_TMP, environment_block); + erts_free(ERTS_ALC_T_TMP, name); } if (!ok) { @@ -1338,6 +1342,41 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts) return retval; } +struct __build_env_state { + WCHAR *next_variable; +}; + +static void build_env_foreach(void *_state, const erts_osenv_data_t *key, + const erts_osenv_data_t *value) +{ + struct __build_env_state *state = (struct __build_env_state*)(_state); + + sys_memcpy(state->next_variable, key->data, key->length); + state->next_variable += (int)key->length / sizeof(WCHAR); + *state->next_variable++ = L'='; + + sys_memcpy(state->next_variable, value->data, value->length); + state->next_variable += (int)value->length / sizeof(WCHAR); + *state->next_variable++ = L'\0'; +} + +/* Builds an environment block suitable for CreateProcessW. */ +static void *build_env_block(const erts_osenv_t *env) { + struct __build_env_state build_state; + WCHAR *env_block; + + env_block = erts_alloc(ERTS_ALC_T_TMP, env->content_size + + (env->variable_count * sizeof(L"=\0") + sizeof(L'\0'))); + + build_state.next_variable = env_block; + + erts_osenv_foreach_native(env, &build_state, build_env_foreach); + + (*build_state.next_variable) = L'\0'; + + return env_block; +} + static int create_file_thread(AsyncIo* aio, int mode) { diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c index 5792816267..c78161b344 100644 --- a/erts/emulator/sys/win32/sys_env.c +++ b/erts/emulator/sys/win32/sys_env.c @@ -1,319 +1,212 @@ -/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-2016. 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%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_sys_driver.h"
-#include "erl_alloc.h"
-
-static WCHAR *merge_environment(WCHAR *current, WCHAR *add);
-static WCHAR *arg_to_env(WCHAR **arg);
-static WCHAR **env_to_arg(WCHAR *env);
-static WCHAR **find_arg(WCHAR **arg, WCHAR *str);
-static int compare(const void *a, const void *b);
-
-static erts_rwmtx_t environ_rwmtx; -
-void
-erts_sys_env_init(void)
-{
- erts_rwmtx_init(&environ_rwmtx, "environ", NIL, - ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
-}
-
-int
-erts_sys_putenv_raw(char *key, char *value)
-{
- int res;
- erts_rwmtx_rwlock(&environ_rwmtx); - res = (SetEnvironmentVariable((LPCTSTR) key,
- (LPCTSTR) value) ? 0 : 1);
- erts_rwmtx_rwunlock(&environ_rwmtx); - return res;
-}
-
-int
-erts_sys_putenv(char *key, char *value)
-{
- int res;
- WCHAR *wkey = (WCHAR *) key;
- WCHAR *wvalue = (WCHAR *) value;
- erts_rwmtx_rwlock(&environ_rwmtx); - res = (SetEnvironmentVariableW(wkey,
- wvalue) ? 0 : 1);
- erts_rwmtx_rwunlock(&environ_rwmtx); - return res;
-}
-
-int
-erts_sys_getenv(char *key, char *value, size_t *size)
-{
- size_t req_size = 0;
- int res = 0;
- DWORD new_size;
- WCHAR *wkey = (WCHAR *) key;
- WCHAR *wvalue = (WCHAR *) value;
- DWORD wsize = *size / (sizeof(WCHAR) / sizeof(char));
-
- SetLastError(0);
- erts_rwmtx_rlock(&environ_rwmtx); - new_size = GetEnvironmentVariableW(wkey,
- wvalue,
- (DWORD) wsize);
- res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0;
- erts_rwmtx_runlock(&environ_rwmtx); - if (res < 0)
- return res;
- res = new_size > wsize ? 1 : 0;
- *size = new_size * (sizeof(WCHAR) / sizeof(char));
- return res;
-}
-int
-erts_sys_getenv__(char *key, char *value, size_t *size)
-{
- size_t req_size = 0;
- int res = 0;
- DWORD new_size;
-
- SetLastError(0);
- new_size = GetEnvironmentVariable((LPCTSTR) key,
- (LPTSTR) value,
- (DWORD) *size);
- res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0;
- if (res < 0)
- return res;
- res = new_size > *size ? 1 : 0;
- *size = new_size;
- return res;
-}
-
-int
-erts_sys_getenv_raw(char *key, char *value, size_t *size)
-{
- int res;
- erts_rwmtx_rlock(&environ_rwmtx); - res = erts_sys_getenv__(key, value, size);
- erts_rwmtx_runlock(&environ_rwmtx); - return res;
-}
-
-void init_getenv_state(GETENV_STATE *state)
-{
- erts_rwmtx_rlock(&environ_rwmtx); - state->environment_strings = GetEnvironmentStringsW();
- state->next_string = state->environment_strings;
-}
-
-char *getenv_string(GETENV_STATE *state)
-{
- ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&environ_rwmtx)); - if (state->next_string[0] == L'\0') {
- return NULL;
- } else {
- WCHAR *res = state->next_string;
- state->next_string += wcslen(res) + 1;
- return (char *) res;
- }
-}
-
-void fini_getenv_state(GETENV_STATE *state)
-{
- FreeEnvironmentStringsW(state->environment_strings);
- state->environment_strings = state->next_string = NULL;
- erts_rwmtx_runlock(&environ_rwmtx); -}
-
-int erts_sys_unsetenv(char *key)
-{
- int res = 0;
- WCHAR *wkey = (WCHAR *) key;
-
- SetLastError(0);
- erts_rwmtx_rlock(&environ_rwmtx); - GetEnvironmentVariableW(wkey,
- NULL,
- 0);
- if (GetLastError() != ERROR_ENVVAR_NOT_FOUND) {
- res = (SetEnvironmentVariableW(wkey,
- NULL) ? 0 : 1);
- }
- erts_rwmtx_runlock(&environ_rwmtx); - return res;
-}
-
-char*
-win_build_environment(char* new_env)
-{
- if (new_env == NULL) {
- return NULL;
- } else {
- WCHAR *tmp, *merged, *tmp_new;
-
- tmp_new = (WCHAR *) new_env;
-
- erts_rwmtx_rlock(&environ_rwmtx); - tmp = GetEnvironmentStringsW();
- merged = merge_environment(tmp, tmp_new);
-
- FreeEnvironmentStringsW(tmp);
- erts_rwmtx_runlock(&environ_rwmtx); - return (char *) merged;
- }
-}
-
-static WCHAR *
-merge_environment(WCHAR *old, WCHAR *add)
-{
- WCHAR **a_arg = env_to_arg(add);
- WCHAR **c_arg = env_to_arg(old);
- WCHAR *ret;
- int i, j;
-
- for(i = 0; c_arg[i] != NULL; ++i)
- ;
-
- for(j = 0; a_arg[j] != NULL; ++j)
- ;
-
- c_arg = erts_realloc(ERTS_ALC_T_TMP,
- c_arg, (i+j+1) * sizeof(WCHAR *));
-
- for(j = 0; a_arg[j] != NULL; ++j){
- WCHAR **tmp;
- WCHAR *current = a_arg[j];
- WCHAR *eq_p = wcschr(current,L'=');
- int unset = (eq_p!=NULL && eq_p[1]==L'\0');
-
- if ((tmp = find_arg(c_arg, current)) != NULL) {
- if (!unset) {
- *tmp = current;
- } else {
- *tmp = c_arg[--i];
- c_arg[i] = NULL;
- }
- } else if (!unset) {
- c_arg[i++] = current;
- c_arg[i] = NULL;
- }
- }
- ret = arg_to_env(c_arg);
- erts_free(ERTS_ALC_T_TMP, c_arg);
- erts_free(ERTS_ALC_T_TMP, a_arg);
- return ret;
-}
-
-static WCHAR**
-find_arg(WCHAR **arg, WCHAR *str)
-{
- WCHAR *tmp;
- int len;
-
- if ((tmp = wcschr(str, L'=')) != NULL) {
- tmp++;
- len = tmp - str;
- while (*arg != NULL){
- if (_wcsnicmp(*arg, str, len) == 0){
- return arg;
- }
- ++arg;
- }
- }
- return NULL;
-}
-
-static int
-compare(const void *a, const void *b)
-{
- WCHAR *s1 = *((WCHAR **) a);
- WCHAR *s2 = *((WCHAR **) b);
- WCHAR *e1 = wcschr(s1,L'=');
- WCHAR *e2 = wcschr(s2,L'=');
- int ret;
- int len;
-
- if(!e1)
- e1 = s1 + wcslen(s1);
- if(!e2)
- e2 = s2 + wcslen(s2);
-
- if((e1 - s1) > (e2 - s2))
- len = (e2 - s2);
- else
- len = (e1 - s1);
-
- ret = _wcsnicmp(s1,s2,len);
- if (ret == 0)
- return ((e1 - s1) - (e2 - s2));
- else
- return ret;
-}
-
-static WCHAR**
-env_to_arg(WCHAR *env)
-{
- WCHAR **ret;
- WCHAR *tmp;
- int i;
- int num_strings = 0;
-
- for(tmp = env; *tmp != '\0'; tmp += wcslen(tmp)+1) {
- ++num_strings;
- }
- ret = erts_alloc(ERTS_ALC_T_TMP, sizeof(WCHAR *) * (num_strings + 1));
- i = 0;
- for(tmp = env; *tmp != '\0'; tmp += wcslen(tmp)+1){
- ret[i++] = tmp;
- }
- ret[i] = NULL;
- return ret;
-}
-
-static WCHAR *
-arg_to_env(WCHAR **arg)
-{
- WCHAR *block;
- WCHAR *ptr;
- int i;
- int totlen = 1; /* extra '\0' */
-
- for(i = 0; arg[i] != NULL; ++i) {
- totlen += wcslen(arg[i])+1;
- }
-
- /* sort the environment vector */
- qsort(arg, i, sizeof(WCHAR *), &compare);
-
- if (totlen == 1){
- block = erts_alloc(ERTS_ALC_T_ENVIRONMENT, 2 * sizeof(WCHAR));
- block[0] = block[1] = '\0';
- } else {
- block = erts_alloc(ERTS_ALC_T_ENVIRONMENT, totlen * sizeof(WCHAR));
- ptr = block;
- for(i=0; arg[i] != NULL; ++i){
- wcscpy(ptr, arg[i]);
- ptr += wcslen(ptr)+1;
- }
- *ptr = '\0';
- }
- return block;
-}
+/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2017. 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_sys_driver.h" +#include "erl_alloc.h" + +static erts_osenv_t sysenv_global_env; +static erts_rwmtx_t sysenv_rwmtx; + +static void import_initial_env(void); + +void erts_sys_env_init() { + erts_rwmtx_init(&sysenv_rwmtx, "environ", NIL, + ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC); + + erts_osenv_init(&sysenv_global_env); + import_initial_env(); +} + +const erts_osenv_t *erts_sys_rlock_global_osenv() { + erts_rwmtx_rlock(&sysenv_rwmtx); + return &sysenv_global_env; +} + +erts_osenv_t *erts_sys_rwlock_global_osenv() { + erts_rwmtx_rwlock(&sysenv_rwmtx); + return &sysenv_global_env; +} + +void erts_sys_runlock_global_osenv() { + erts_rwmtx_runlock(&sysenv_rwmtx); +} + +void erts_sys_rwunlock_global_osenv() { + erts_rwmtx_rwunlock(&sysenv_rwmtx); +} + +int erts_sys_explicit_host_getenv(char *key, char *value, size_t *size) { + size_t new_size = GetEnvironmentVariableA(key, value, (DWORD)*size); + + if(new_size == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + return 0; + } else if(new_size > *size) { + return -1; + } + + *size = new_size; + return 1; +} + +int erts_sys_explicit_8bit_putenv(char *key, char *value) { + WCHAR *wide_key, *wide_value; + int key_length, value_length; + int result; + + /* Note that we do *NOT* honor the filename encoding flags (+fnu/+fnl) + * here; the previous implementation used SetEnvironmentVariableA and + * things may break if we step away from that. */ + + key_length = MultiByteToWideChar(CP_ACP, 0, key, -1, NULL, 0); + value_length = MultiByteToWideChar(CP_ACP, 0, value, -1, NULL, 0); + + /* Report "not found" if either string isn't convertible. */ + if(key_length == 0 || value_length == 0) { + return 0; + } + + wide_key = erts_alloc(ERTS_ALC_T_TMP, key_length * sizeof(WCHAR)); + wide_value = erts_alloc(ERTS_ALC_T_TMP, value_length * sizeof(WCHAR)); + + MultiByteToWideChar(CP_ACP, 0, key, -1, wide_key, key_length); + MultiByteToWideChar(CP_ACP, 0, value, -1, wide_value, value_length); + + { + erts_osenv_data_t env_key, env_value; + erts_osenv_t *env; + + env = erts_sys_rwlock_global_osenv(); + + /* -1 to exclude the NUL terminator. */ + env_key.length = (key_length - 1) * sizeof(WCHAR); + env_key.data = wide_key; + + env_value.length = (value_length - 1) * sizeof(WCHAR); + env_value.data = wide_value; + + result = erts_osenv_put_native(env, &env_key, &env_value); + erts_sys_rwunlock_global_osenv(); + } + + erts_free(ERTS_ALC_T_TMP, wide_key); + erts_free(ERTS_ALC_T_TMP, wide_value); + + return result; +} + +int erts_sys_explicit_8bit_getenv(char *key, char *value, size_t *size) { + erts_osenv_data_t env_key, env_value; + int key_length, value_length, result; + WCHAR *wide_key, *wide_value; + + key_length = MultiByteToWideChar(CP_ACP, 0, key, -1, NULL, 0); + + /* Report "not found" if the string isn't convertible. */ + if(key_length == 0) { + return 0; + } + + wide_key = erts_alloc(ERTS_ALC_T_TMP, key_length * sizeof(WCHAR)); + MultiByteToWideChar(CP_ACP, 0, key, -1, wide_key, key_length); + + /* We assume that the worst possible size is twice the output buffer width, + * as we could theoretically be on a code page that requires surrogates. */ + value_length = (*size) * 2; + wide_value = erts_alloc(ERTS_ALC_T_TMP, value_length * sizeof(WCHAR)); + + { + const erts_osenv_t *env = erts_sys_rlock_global_osenv(); + + /* -1 to exclude the NUL terminator. */ + env_key.length = (key_length - 1) * sizeof(WCHAR); + env_key.data = wide_key; + + env_value.length = value_length * sizeof(WCHAR); + env_value.data = wide_value; + + result = erts_osenv_get_native(env, &env_key, &env_value); + erts_sys_runlock_global_osenv(); + } + + if(result == 1 && env_value.length > 0) { + /* This function doesn't NUL-terminate if the provided size is >= 0, + * so we pass (*size - 1) to reserve space for it and then do it + * manually. */ + *size = WideCharToMultiByte(CP_ACP, 0, env_value.data, + env_value.length / sizeof(WCHAR), value, *size - 1, NULL, NULL); + + if(*size == 0) { + if(GetLastError() == ERROR_INSUFFICIENT_BUFFER) { + result = -1; + } else { + result = 0; + } + } + } else { + *size = 0; + } + + if(*size > 0) { + value[*size] = '\0'; + } + + erts_free(ERTS_ALC_T_TMP, wide_key); + erts_free(ERTS_ALC_T_TMP, wide_value); + + return result; +} + +static void import_initial_env(void) { + WCHAR *environment_block, *current_variable; + + environment_block = GetEnvironmentStringsW(); + current_variable = environment_block; + + while(wcslen(current_variable) > 0) { + WCHAR *separator_index = wcschr(current_variable, L'='); + + /* We tolerate environment variables starting with '=' as the per-drive + * working directories are stored this way. */ + if(separator_index == current_variable) { + separator_index = wcschr(separator_index + 1, L'='); + } + + if(separator_index != NULL && separator_index != current_variable) { + erts_osenv_data_t env_key, env_value; + + env_key.length = (separator_index - current_variable) * sizeof(WCHAR); + env_key.data = current_variable; + + env_value.length = (wcslen(separator_index) - 1) * sizeof(WCHAR); + env_value.data = separator_index + 1; + + erts_osenv_put_native(&sysenv_global_env, &env_key, &env_value); + } + + current_variable += wcslen(current_variable) + 1; + } + + FreeEnvironmentStringsW(environment_block); +} diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index dca600bc7b..661a2ee6c9 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,7 +27,8 @@ constant_pools/1,constant_refc_binaries/1, fake_literals/1, false_dependency/1,coverage/1,fun_confusion/1, - t_copy_literals/1, t_copy_literals_frags/1]). + t_copy_literals/1, t_copy_literals_frags/1, + erl_544/1]). -define(line_trace, 1). -include_lib("common_test/include/ct.hrl"). @@ -41,7 +42,8 @@ all() -> module_md5, constant_pools, constant_refc_binaries, fake_literals, false_dependency, - coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. + coverage, fun_confusion, t_copy_literals, t_copy_literals_frags, + erl_544]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -918,6 +920,53 @@ reloader(Mod,Code,Time) -> reloader(Mod,Code,Time) end. +erl_544(Config) when is_list(Config) -> + case file:native_name_encoding() of + utf8 -> + {ok, CWD} = file:get_cwd(), + try + Mod = erl_544, + FileName = atom_to_list(Mod) ++ ".erl", + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + {ok, FileContent} = file:read_file(filename:join(Data, + FileName)), + Dir = filename:join(Priv, [16#2620,16#2620,16#2620]), + File = filename:join(Dir, FileName), + io:format("~ts~n", [File]), + ok = file:make_dir(Dir), + ok = file:set_cwd(Dir), + ok = file:write_file(File, [FileContent]), + {ok, Mod} = compile:file(File), + Res1 = (catch Mod:err()), + io:format("~p~n", [Res1]), + {'EXIT', {err, [{Mod, err, 0, Info1}|_]}} = Res1, + File = proplists:get_value(file, Info1), + Me = self(), + Go = make_ref(), + Tester = spawn_link(fun () -> + Mod:wait(Me, Go), + Mod:err() + end), + receive Go -> ok end, + Res2 = process_info(Tester, current_stacktrace), + io:format("~p~n", [Res2]), + {current_stacktrace, Stack} = Res2, + [{Mod, wait, 2, Info2}|_] = Stack, + File = proplists:get_value(file, Info2), + StackFun = fun(_, _, _) -> false end, + FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, + Formated = + lib:format_stacktrace(1, Stack, StackFun, FormatFun), + true = is_list(Formated), + ok + after + ok = file:set_cwd(CWD) + end, + ok; + _Enc -> + {skipped, "Only run when native file name encoding is utf8"} + end. %% Utilities. diff --git a/erts/emulator/test/code_SUITE_data/erl_544.erl b/erts/emulator/test/code_SUITE_data/erl_544.erl new file mode 100644 index 0000000000..c93f3ef5bc --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/erl_544.erl @@ -0,0 +1,35 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_544). + +-export([err/0, wait/2]). + +err() -> + erlang:error(err). + +wait(Pid, Msg) -> + erlang:yield(), + Pid ! Msg, + receive + after infinity -> + ok + end, + err(). diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index e133349216..294c42780d 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -80,6 +80,7 @@ async_blast/1, thr_msg_blast/1, consume_timeslice/1, + env/1, z_test/1]). -export([bin_prefix/2]). @@ -166,6 +167,7 @@ all() -> %% Keep a_test first and z_test last... async_blast, thr_msg_blast, consume_timeslice, + env, z_test]. groups() -> @@ -2363,6 +2365,51 @@ count_proc_sched(Ps, PNs) -> PNs end. +%% +%% Tests whether erl_drv_putenv reflects in os:getenv and vice versa. +%% +env(Config) when is_list(Config) -> + ok = load_driver(proplists:get_value(data_dir, Config), env_drv), + Port = open_port({spawn_driver, env_drv}, []), + true = is_port(Port), + + Keys = ["env_drv_a_key", "env_drv_b_key", "env_drv_c_key"], + Values = ["a_value", "b_value", "c_value"], + + [env_put_test(Port, Key, Value) || Key <- Keys, Value <- Values], + [env_get_test(Port, Key, Value) || Key <- Keys, Value <- Values], + [env_oversize_test(Port, Key) || Key <- Keys], + [env_notfound_test(Port, Key) || Key <- Keys], + + true = port_close(Port), + erl_ddll:unload_driver(env_drv), + ok. + +env_control(Port, Command, Key, Value) -> + KeyBin = list_to_binary(Key), + ValueBin = list_to_binary(Value), + Header = <<(byte_size(KeyBin)), (byte_size(ValueBin))>>, + Payload = <<KeyBin/binary, ValueBin/binary>>, + port_control(Port, Command, <<Header/binary, Payload/binary>>). + +env_put_test(Port, Key, Value) -> + os:unsetenv(Key), + [0] = env_control(Port, 0, Key, Value), + Value = os:getenv(Key). + +env_get_test(Port, Key, ExpectedValue) -> + true = os:putenv(Key, ExpectedValue), + [0] = env_control(Port, 1, Key, ExpectedValue). + +env_oversize_test(Port, Key) -> + os:putenv(Key, [$A || _ <- lists:seq(1, 1024)]), + [127] = env_control(Port, 1, Key, ""). + +env_notfound_test(Port, Key) -> + true = os:unsetenv(Key), + [255] = env_control(Port, 1, Key, ""). + + a_test(Config) when is_list(Config) -> rpc(Config, fun check_io_debug/0). diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index 1fedd72200..bcabaa689d 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -16,7 +16,8 @@ MISC_DRVS = outputv_drv@dll@ \ thr_free_drv@dll@ \ async_blast_drv@dll@ \ thr_msg_blast_drv@dll@ \ - consume_timeslice_drv@dll@ + consume_timeslice_drv@dll@ \ + env_drv@dll@ SYS_INFO_DRVS = sys_info_base_drv@dll@ \ sys_info_prev_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/env_drv.c b/erts/emulator/test/driver_SUITE_data/env_drv.c new file mode 100644 index 0000000000..0e910eeb84 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/env_drv.c @@ -0,0 +1,108 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2017. 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% + */ + +/* Tests whether erl_drv_putenv/erl_drv_getenv work correctly and reflect + * changes to os:putenv/getenv. */ + +#include <string.h> +#include <stdio.h> + +#include "erl_driver.h" + +static ErlDrvSSizeT env_drv_ctl(ErlDrvData drv_data, unsigned int cmd, + char* buf, ErlDrvSizeT len, char** rbuf, ErlDrvSizeT rsize); + +static ErlDrvEntry env_drv_entry = { + NULL /* init */, + NULL /* start */, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "env_drv", + NULL /* finish */, + NULL /* handle */, + env_drv_ctl, + NULL /* timeout */, + NULL /* outputv*/, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call*/, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(env_drv) { + return &env_drv_entry; +} + +static int test_putenv(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + char key[256], value[256]; + int key_len, value_len; + + key_len = buf[0]; + value_len = buf[1]; + + sprintf(key, "%.*s", key_len, &buf[2]); + sprintf(value, "%.*s", value_len, &buf[2 + key_len]); + + return erl_drv_putenv(key, value); +} + +static int test_getenv(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + char expected_value[256], stored_value[256], key[256]; + int expected_value_len, key_len; + size_t stored_value_len; + int res; + + key_len = buf[0]; + sprintf(key, "%.*s", key_len, &buf[2]); + + expected_value_len = buf[1]; + sprintf(expected_value, "%.*s", expected_value_len, &buf[2 + key_len]); + + stored_value_len = sizeof(stored_value); + res = erl_drv_getenv(key, stored_value, &stored_value_len); + + if(res == 0) { + return strcmp(stored_value, expected_value) != 0; + } else if(res == 1) { + return 127; + } + + return 255; +} + +static ErlDrvSSizeT env_drv_ctl(ErlDrvData drv_data, unsigned int cmd, + char* buf, ErlDrvSizeT len, char** rbuf, ErlDrvSizeT rsize) { + + if(cmd == 0) { + (**rbuf) = (char)test_putenv(drv_data, buf, len); + } else { + (**rbuf) = (char)test_getenv(drv_data, buf, len); + } + + return 1; +} diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index f3c83b9949..278a485a01 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2454,7 +2454,7 @@ term_to_binary(_Term) -> Term :: term(), Options :: [compressed | {compressed, Level :: 0..9} | - {minor_version, Version :: 0..1} ]. + {minor_version, Version :: 0..2} ]. term_to_binary(_Term, _Options) -> erlang:nif_error(undefined). diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index b98a704e28..bfeffa969f 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -1355,8 +1355,8 @@ xref_export_all(_Config) -> [] -> ok; [_|_] -> - S = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused], - io:format("There are unused functions:\n\n~s\n", [S]), + Msg = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused], + io:format("There are unused functions:\n\n~s\n", [Msg]), ?t:fail(unused_functions) end. diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 6f09dc4be4..7df2edd714 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -58,7 +58,8 @@ rename_instrs([{call_only,A,F}|Is]) -> rename_instrs([{call_ext_only,A,F}|Is]) -> [{call_ext,A,F},return|rename_instrs(Is)]; rename_instrs([{'%live',_}|Is]) -> - %% When compiling from old .S files. + %% Ignore old type of live annotation. Only happens when compiling + %% from very old .S files. rename_instrs(Is); rename_instrs([I|Is]) -> [rename_instr(I)|rename_instrs(Is)]; diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index fe1ce6f60b..39ae8d5347 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -23,25 +23,32 @@ -module(beam_block). -export([module/2]). --import(lists, [reverse/1,reverse/2,foldl/3,member/2]). +-import(lists, [reverse/1,reverse/2,member/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], +module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> + Blockify = not member(no_blockify, Opts), + Fs = [function(F, Blockify) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}) -> +function({function,Name,Arity,CLabel,Is0}, Blockify) -> try %% Collect basic blocks and optimize them. - Is1 = blockify(Is0), - Is2 = embed_lines(Is1), + Is2 = case Blockify of + true -> + Is1 = blockify(Is0), + embed_lines(Is1); + false -> + Is0 + end, Is3 = beam_utils:anno_defs(Is2), Is4 = move_allocates(Is3), Is5 = beam_utils:live_opt(Is4), Is6 = opt_blocks(Is5), - Is = beam_utils:delete_live_annos(Is6), + Is7 = beam_utils:delete_annos(Is6), + Is = opt_allocs(Is7), %% Done. {function,Name,Arity,CLabel,Is} @@ -136,17 +143,16 @@ embed_lines([], Acc) -> Acc. opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. - [{'%live',_,_}|Bl] = Bl0, + [{'%anno',_}|Bl] = Bl0, [{block,opt_block(Bl)}|opt_blocks(Is)]; opt_blocks([I|Is]) -> [I|opt_blocks(Is)]; opt_blocks([]) -> []. opt_block(Is0) -> - Is = find_fixpoint(fun(Is) -> - opt_tuple_element(opt(Is)) - end, Is0), - opt_alloc(Is). + find_fixpoint(fun(Is) -> + opt_tuple_element(opt(Is)) + end, Is0). find_fixpoint(OptFun, Is0) -> case OptFun(Is0) of @@ -196,7 +202,7 @@ move_allocates([I|Is]) -> [I|move_allocates(Is)]; move_allocates([]) -> []. -move_allocates_1([{'%def',_}|Is], Acc) -> +move_allocates_1([{'%anno',_}|Is], Acc) -> move_allocates_1(Is, Acc); move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) -> case alloc_may_pass(I) of @@ -240,10 +246,14 @@ opt([{set,_,_,{line,_}}=Line1, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> opt([Line2,I2,Line1,I1|Is]); +opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,L}}}=I1, + {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,L}}}=I2|Is]) + when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> + opt([I2,I1|Is]); opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; -opt([{'%live',_,_}=I|Is]) -> +opt([{'%anno',_}=I|Is]) -> [I|opt(Is)]; opt([]) -> []. @@ -411,31 +421,47 @@ eliminate_use_of_from_reg([I]=Is, From, _To, Acc) -> no end. +%% opt_allocs(Instructions) -> Instructions. Optimize allocate +%% instructions inside blocks. If safe, replace an allocate_zero +%% instruction with the slightly cheaper allocate instruction. + +opt_allocs(Is) -> + D = beam_utils:index_labels(Is), + opt_allocs_1(Is, D). + +opt_allocs_1([{block,Bl0}|Is], D) -> + Bl = opt_alloc(Bl0, {D,Is}), + [{block,Bl}|opt_allocs_1(Is, D)]; +opt_allocs_1([I|Is], D) -> + [I|opt_allocs_1(Is, D)]; +opt_allocs_1([], _) -> []. + %% opt_alloc(Instructions) -> Instructions' %% Optimises all allocate instructions. opt_alloc([{set,[],[],{alloc,Live0,Info0}}, - {set,[],[],{alloc,Live,Info}}|Is]) -> + {set,[],[],{alloc,Live,Info}}|Is], D) -> Live = Live0, %Assertion. Alloc = combine_alloc(Info0, Info), I = {set,[],[],{alloc,Live,Alloc}}, - opt_alloc([I|Is]); -opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) -> - [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is]; -opt_alloc([I|Is]) -> [I|opt_alloc(Is)]; -opt_alloc([]) -> []. + opt_alloc([I|Is], D); +opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is], D) -> + [{set,[],[],opt_alloc(Is, D, Ns, Nh, R)}|Is]; +opt_alloc([I|Is], D) -> [I|opt_alloc(Is, D)]; +opt_alloc([], _) -> []. combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> {zero,Ns,beam_utils:combine_heap_needs(Nh1, Nh2),Init}. - + %% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr] %% Generates the optimal sequence of instructions for %% allocating and initalizing the stack frame and needed heap. -opt_alloc(_Is, nostack, Nh, LivingRegs) -> +opt_alloc(_Is, _D, nostack, Nh, LivingRegs) -> {alloc,LivingRegs,{nozero,nostack,Nh,[]}}; -opt_alloc(Is, Ns, Nh, LivingRegs) -> - InitRegs = init_yreg(Is, 0), +opt_alloc(Bl, {D,OuterIs}, Ns, Nh, LivingRegs) -> + Is = [{block,Bl}|OuterIs], + InitRegs = init_yregs(Ns, Is, D), case count_ones(InitRegs) of N when N*2 > Ns -> {alloc,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}}; @@ -451,19 +477,14 @@ gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 -> gen_init(Fs, Regs, Y, Acc) -> gen_init(Fs, Regs bsr 1, Y+1, Acc). -%% init_yreg(Instructions, RegSet) -> RegSetInitialized -%% Calculate the set of initialized y registers. - -init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg; -init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg; -init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg; -init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg)); -init_yreg(_Is, Reg) -> Reg. - -add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys). - -add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y); -add_yreg(_, Reg) -> Reg. +init_yregs(Y, Is, D) when Y >= 0 -> + case beam_utils:is_killed({y,Y}, Is, D) of + true -> + (1 bsl Y) bor init_yregs(Y-1, Is, D); + false -> + init_yregs(Y-1, Is, D) + end; +init_yregs(_, _, _) -> 0. count_ones(Bits) -> count_ones(Bits, 0). count_ones(0, Acc) -> Acc; @@ -514,7 +535,7 @@ x_live([], Regs) -> Regs. %% Given a reversed instruction stream, determine the %% the registers that are defined. -defined_regs([{'%def',Def}|_], Regs) -> +defined_regs([{'%anno',{def,Def}}|_], Regs) -> Def bor Regs; defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) -> x_live(Ds, Regs bor ((1 bsl Live) - 1)); diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 9ea5a3eb92..9f3b9d788f 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -124,20 +124,21 @@ btb_opt_1([{test,bs_get_binary2,F,_,[Reg,{atom,all},U,Fs],Reg}=I0|Is], D, Acc0) end, btb_opt_1(Is, D, Acc) end; -btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is], D, Acc0) -> - case btb_reaches_match(Is, [Ctx,Dst], D) of +btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is0], D, Acc0) -> + case btb_reaches_match(Is0, [Ctx,Dst], D) of {error,Reason} -> Comment = btb_comment_no_opt(Reason, Fs), - btb_opt_1(Is, D, [Comment,I0|Acc0]); + btb_opt_1(Is0, D, [Comment,I0|Acc0]); {ok,MustSave} when U =:= 1 -> Comment = btb_comment_opt(Fs), - Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), - Acc = [{move,Ctx,Dst}|Acc1], + Acc = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), + Is = prepend_move(Ctx, Dst, Is0), btb_opt_1(Is, D, Acc); {ok,MustSave} -> Comment = btb_comment_opt(Fs), Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), - Acc = [{move,Ctx,Dst},{test,bs_test_unit,F,[Ctx,U]}|Acc1], + Acc = [{test,bs_test_unit,F,[Ctx,U]}|Acc1], + Is = prepend_move(Ctx, Dst, Is0), btb_opt_1(Is, D, Acc) end; btb_opt_1([I|Is], D, Acc) -> @@ -150,6 +151,12 @@ btb_gen_save(true, Reg, Acc) -> [{bs_save2,Reg,{atom,start}}|Acc]; btb_gen_save(false, _, Acc) -> Acc. +prepend_move(Ctx, Dst, [{block,Bl0}|Is]) -> + Bl = [{set,[Dst],[Ctx],move}|Bl0], + [{block,Bl}|Is]; +prepend_move(Ctx, Dst, Is) -> + [{move,Ctx,Dst}|Is]. + %% btb_reaches_match([Instruction], [Register], D) -> %% {ok,MustSave}|{error,Reason} %% diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl index db1053e48c..58a6de6775 100644 --- a/lib/compiler/src/beam_record.erl +++ b/lib/compiler/src/beam_record.erl @@ -71,7 +71,7 @@ rewrite([{test,test_arity,Fail,[Src,N]}=TA, I = {test,is_tagged_tuple,Fail,[Src,N,Atom]}, rewrite(Is, Idx, Def, [I|Acc]) end; -rewrite([{block,[{'%def',Def}|Bl]}|Is], Idx, _Def, Acc) -> +rewrite([{block,[{'%anno',{def,Def}}|Bl]}|Is], Idx, _Def, Acc) -> rewrite(Is, Idx, Def, [{block,Bl}|Acc]); rewrite([{label,L}=I|Is], Idx0, Def, Acc) -> Idx = beam_utils:index_label(L, Acc, Idx0), diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 16d5a36447..3b6bf49961 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -40,7 +40,7 @@ function({function,Name,Arity,CLabel,Asm0}) -> Asm1 = beam_utils:live_opt(Asm0), Asm2 = opt(Asm1, [], tdb_new()), Asm3 = beam_utils:live_opt(Asm2), - Asm = beam_utils:delete_live_annos(Asm3), + Asm = beam_utils:delete_annos(Asm3), {function,Name,Arity,CLabel,Asm} catch Class:Error:Stack -> @@ -92,7 +92,7 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of - {tuple,_,[Contents]} -> + {tuple,_,_,[Contents]} -> simplify_basic_1([{set,[D],[Contents],move}|Is0], Ts0, Acc); _ -> Ts = update(I, Ts0), @@ -113,12 +113,12 @@ simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> end; simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of - {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc); + {tuple,_,_,_} -> simplify_basic_1(Is, Ts, Acc); _ -> simplify_basic_1(Is, Ts, [I|Acc]) end; simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> case tdb_find(R, Ts0) of - {tuple,Arity,_} -> + {tuple,exact_size,Arity,_} -> simplify_basic_1(Is, Ts0, Acc); _Other -> Ts = update(I, Ts0), @@ -148,7 +148,7 @@ simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) - simplify_basic_1(Is0, Ts, Acc); simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0, Acc) -> case tdb_find(R, Ts0) of - {tuple,Arity,[Tag]} -> + {tuple,exact_size,Arity,[Tag]} -> simplify_basic_1(Is, Ts0, Acc); _Other -> Ts = update(I, Ts0), @@ -300,7 +300,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. %% Combine two blocks and eliminate any move instructions that assign %% to registers that are killed later in the block. %% -merge_blocks(B1, [{'%live',_,_}|B2]) -> +merge_blocks(B1, [{'%anno',_}|B2]) -> merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; @@ -349,27 +349,17 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> {[],H+1,Fl}; flt_need_heap_2({set,_,_,put}, H, Fl) -> {[],H+1,Fl}; -%% Then the "neutral" instructions. We just pass them. -flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,[],[],fclearerror}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,[],[],fcheckerror}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{bif,_,_}}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,move}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,get_list}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) -> - {[],H,Fl}; -%% All other instructions should cause the insertion of an allocation +%% The following instructions cause the insertion of an allocation %% instruction if needed. +flt_need_heap_2({set,_,_,{alloc,_,_}}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +flt_need_heap_2({set,_,_,{set_tuple_element,_}}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +flt_need_heap_2({'%anno',_}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +%% All other instructions are "neutral". We just pass them. flt_need_heap_2(_, H, Fl) -> - {flt_alloc(H, Fl),0,0}. + {[],H,Fl}. flt_alloc(0, 0) -> []; @@ -392,7 +382,7 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}. %% is not continous at an allocation function (e.g. if {x,0} and {x,2} %% are live, but not {x,1}). -flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) -> +flt_liveness([{'%anno',{used,Regs}}=LiveInstr|Is]) -> flt_liveness_1(Is, Regs, [LiveInstr]). flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> @@ -404,7 +394,7 @@ flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) -> Regs = x_live(Ds, Regs0), flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([{'%live',_,_}], _Regs, Acc) -> +flt_liveness_1([{'%anno',_}], _Regs, Acc) -> reverse(Acc). init_regs(Live) -> @@ -428,13 +418,14 @@ x_live([], Regs) -> Regs. %% Update the type database to account for executing an instruction. %% %% First the cases for instructions inside basic blocks. -update({'%live',_,_}, Ts) -> Ts; +update({'%anno',_}, Ts) -> + Ts; update({set,[D],[S],move}, Ts) -> tdb_copy(S, D, Ts); update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); + tdb_update([{Reg,{tuple,min_size,I,[]}},{D,kill}], Ts0); update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); + tdb_update([{Reg,{tuple,min_size,0,[]}},{D,kill}], Ts0); update({set,[D],Args,{bif,N,_}}, Ts0) -> Ar = length(Args), BoolOp = erl_internal:new_type_test(N, Ar) orelse @@ -492,7 +483,7 @@ update({kill,D}, Ts) -> update({test,is_float,_Fail,[Src]}, Ts0) -> tdb_update([{Src,float}], Ts0); update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> - tdb_update([{Src,{tuple,Arity,[]}}], Ts0); + tdb_update([{Src,{tuple,exact_size,Arity,[]}}], Ts0); update({test,is_map,_Fail,[Src]}, Ts0) -> tdb_update([{Src,map}], Ts0); update({get_map_elements,_,Src,{list,Elems0}}, Ts0) -> @@ -506,12 +497,12 @@ update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> error -> Ts; {tuple_element,TupleReg,0} -> - tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts); + tdb_update([{TupleReg,{tuple,min_size,1,[Atom]}}], Ts); _ -> Ts end; update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> - tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts); + tdb_update([{Src,{tuple,exact_size,Arity,[Tag]}}], Ts); %% Binary matching @@ -553,7 +544,7 @@ update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> Ts = tdb_kill_xregs(Ts0), case tdb_find({x,1}, Ts0) of - {tuple,Sz,_}=T0 -> + {tuple,SzKind,Sz,_}=T0 -> T = case tdb_find({x,0}, Ts0) of {integer,{I,I}} when I > 1 -> %% First element is not changed. The result @@ -562,7 +553,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> _ -> %% Position is 1 or unknown. May change the %% first element of the tuple. - {tuple,Sz,[]} + {tuple,SzKind,Sz,[]} end, tdb_update([{{x,0},T}], Ts); _ -> @@ -646,7 +637,7 @@ possibly_numeric(_) -> false. max_tuple_size(Reg, Ts) -> case tdb_find(Reg, Ts) of - {tuple,Sz,_} -> Sz; + {tuple,_,Sz,_} -> Sz; _Other -> 0 end. @@ -802,11 +793,12 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% -%%% {tuple,Size,First} means that the corresponding register contains a -%%% tuple with *at least* Size elements. An tuple with unknown -%%% size is represented as {tuple,0,[]}. First is either [] (meaning that -%%% the tuple's first element is unknown) or [FirstElement] (the contents -%%% of the first element). +%%% {tuple,min_size,Size,First} means that the corresponding register contains +%%% a tuple with *at least* Size elements (conversely, exact_size means that it +%%% contains a tuple with *exactly* Size elements). An tuple with unknown size +%%% is represented as {tuple,min_size,0,[]}. First is either [] (meaning that +%%% the tuple's first element is unknown) or [FirstElement] (the contents of +%%% the first element). %%% %%% 'float' means that the register contains a float. %%% @@ -850,7 +842,7 @@ tdb_copy(Literal, D, Ts) -> {literal,#{}} -> map; {literal,Tuple} when tuple_size(Tuple) >= 1 -> Lit = tag_literal(element(1, Tuple)), - {tuple,tuple_size(Tuple),[Lit]}; + {tuple,exact_size,tuple_size(Tuple),[Lit]}; _ -> term end, if @@ -872,14 +864,14 @@ tag_literal(Lit) -> {literal,Lit}. %% Updates a type database. If a 'kill' operation is given, the type %% information for that register will be removed from the database. %% A kill operation takes precedence over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the +%% register (i.e. [{{x,0},kill},{{x,0},{tuple,min_size,5,[]}}] means that the %% the existing type information, if any, will be discarded, and the -%% the '{tuple,5,[]}' information ignored. +%% the '{tuple,min_size,5,[]}' information ignored. %% %% If NewInfo information is given and there exists information about %% the register, the old and new type information will be merged. -%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce -%% {tuple,10,_}. +%% For instance, {tuple,min_size,5,_} and {tuple,min_size,10,_} will be merged +%% to produce {tuple,min_size,10,_}. tdb_update(Uis0, Ts0) -> Uis1 = filter(fun ({{x,_},_Op}) -> true; @@ -917,16 +909,20 @@ tdb_kill_xregs([]) -> []. remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops); remove_key(_, Ops) -> Ops. - + merge_type_info(I, I) -> I; -merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 -> +merge_type_info({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 -> Max; -merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 -> +merge_type_info({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> Max; -merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) -> - merge_type_info({tuple,Sz1,First}, Tuple2); -merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) -> - merge_type_info(Tuple1, {tuple,Sz2,First}); +merge_type_info({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) -> + Exact; +merge_type_info({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) -> + Exact; +merge_type_info({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) -> + merge_type_info({tuple,SzKind1,Sz1,First}, Tuple2); +merge_type_info({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) -> + merge_type_info(Tuple1, {tuple,SzKind2,Sz2,First}); merge_type_info(integer, {integer,_}=Int) -> Int; merge_type_info({integer,_}=Int, integer) -> @@ -944,7 +940,7 @@ verify_type({integer,{Min,Max}}) when is_integer(Min), is_integer(Max) -> ok; verify_type(map) -> ok; verify_type(nonempty_list) -> ok; -verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; -verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; +verify_type({tuple,_,Sz,[]}) when is_integer(Sz) -> ok; +verify_type({tuple,_,Sz,[_]}) when is_integer(Sz) -> ok; verify_type({tuple_element,_,_}) -> ok; verify_type(float) -> ok. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 60221578bd..901588ee3b 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -25,7 +25,7 @@ is_not_used/3,usage/3, empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, code_at/2,bif_to_test/3,is_pure_test/1, - live_opt/1,delete_live_annos/1,combine_heap_needs/2, + live_opt/1,delete_annos/1,combine_heap_needs/2, anno_defs/1, split_even/1 ]). @@ -95,7 +95,7 @@ is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> X >= Live; is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is)); -is_killed_block(R, [{'%live',_,Regs}|Is]) -> +is_killed_block(R, [{'%anno',{used,Regs}}|Is]) -> case R of {x,X} when (Regs bsr X) band 1 =:= 0 -> true; _ -> is_killed_block(R, Is) @@ -118,6 +118,7 @@ is_killed(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; + {exit_not_used,_} -> true; {_,_} -> false end. @@ -130,6 +131,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> St0 = #live{lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of {killed,_} -> true; + {exit_not_used,_} -> true; {_,_} -> false end. @@ -146,6 +148,7 @@ is_not_used(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {used,_} -> false; + {exit_not_used,_} -> false; {_,_} -> true end. @@ -267,7 +270,7 @@ is_pure_test({test,Op,_,Ops}) -> %% Go through the instruction sequence in reverse execution %% order, keep track of liveness and remove 'move' instructions %% whose destination is a register that will not be used. -%% Also insert {'%live',Live,Regs} annotations at the beginning +%% Also insert {used,Regs} annotations at the beginning %% and end of each block. -spec live_opt([instruction()]) -> [instruction()]. @@ -282,22 +285,22 @@ live_opt(Is0) -> Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. -%% delete_live_annos([Instruction]) -> [Instruction]. -%% Delete all live annotations. +%% delete_annos([Instruction]) -> [Instruction]. +%% Delete all annotations. --spec delete_live_annos([instruction()]) -> [instruction()]. +-spec delete_annos([instruction()]) -> [instruction()]. -delete_live_annos([{block,Bl0}|Is]) -> - case delete_live_annos(Bl0) of - [] -> delete_live_annos(Is); - [_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)] +delete_annos([{block,Bl0}|Is]) -> + case delete_annos(Bl0) of + [] -> delete_annos(Is); + [_|_]=Bl -> [{block,Bl}|delete_annos(Is)] end; -delete_live_annos([{'%live',_,_}|Is]) -> - delete_live_annos(Is); -delete_live_annos([I|Is]) -> - [I|delete_live_annos(Is)]; -delete_live_annos([]) -> []. - +delete_annos([{'%anno',_}|Is]) -> + delete_annos(Is); +delete_annos([I|Is]) -> + [I|delete_annos(Is)]; +delete_annos([]) -> []. + %% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed %% Combine the heap need for two allocation instructions. @@ -309,11 +312,11 @@ delete_live_annos([]) -> []. combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> H1 + H2; combine_heap_needs(H1, H2) -> - combine_alloc_lists([H1,H2]). + {alloc,combine_alloc_lists([H1,H2])}. %% anno_defs(Instructions) -> Instructions' -%% Add {'%def',RegisterBitmap} annotations to the beginning of +%% Add {def,RegisterBitmap} annotations to the beginning of %% each block. Iff bit X is set in the the bitmap, it means %% that {x,X} is defined when the block is entered. @@ -347,6 +350,9 @@ split_even(Rs) -> split_even(Rs, [], []). %% %% killed - Reg is assigned or killed by an allocation instruction. %% not_used - the value of Reg is not used, but Reg must not be garbage +%% exit_not_used - the value of Reg is not used, but must not be garbage +%% because the stack will be scanned because an +%% exit BIF will raise an exception %% used - Reg is used check_liveness(R, [{block,Blk}|Is], St0) -> @@ -370,6 +376,8 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> case check_liveness_at(R, Fail, St0) of {killed,St1} -> check_liveness(R, Is, St1); + {exit_not_used,St1} -> + check_liveness(R, Is, St1); {not_used,St1} -> not_used(check_liveness(R, Is, St1)); {used,_}=Used -> @@ -389,6 +397,8 @@ check_liveness(R, [{jump,{f,F}}|_], St) -> check_liveness_at(R, F, St); check_liveness(R, [{case_end,Used}|_], St) -> check_liveness_ret(R, Used, St); +check_liveness(R, [{try_case_end,Used}|_], St) -> + check_liveness_ret(R, Used, St); check_liveness(R, [{badmatch,Used}|_], St) -> check_liveness_ret(R, Used, St); check_liveness(_, [if_end|_], St) -> @@ -432,7 +442,7 @@ check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> false -> if R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) + true -> not_used(check_liveness(R, Is, St)) end end end; @@ -466,7 +476,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> %% We must make sure we don't check beyond this %% instruction or we will fall through into random %% unrelated code and get stuck in a loop. - {killed,St} + {exit_not_used,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> @@ -514,16 +524,12 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> {x,_} -> {killed,St}; {y,_} -> not_used(check_liveness(R, Is, St)) end; -check_liveness({x,_}=R, [{'catch',_,_}|Is], St) -> - %% All x registers will be killed if an exception occurs. - %% Therefore we only need to check the liveness for the - %% instructions following the catch instruction. - check_liveness(R, Is, St); -check_liveness({x,_}=R, [{'try',_,_}|Is], St) -> - %% All x registers will be killed if an exception occurs. - %% Therefore we only need to check the liveness for the - %% instructions inside the 'try' block. - check_liveness(R, Is, St); +check_liveness(R, [{'catch'=Op,Y,Fail}|Is], St) -> + Set = {set,[Y],[],{try_catch,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); +check_liveness(R, [{'try'=Op,Y,Fail}|Is], St) -> + Set = {set,[Y],[],{try_catch,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); check_liveness(R, [{try_end,Y}|Is], St) -> case R of Y -> @@ -584,6 +590,12 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) -> Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}}, check_liveness(R, [{block,[Set]}||Is], St); +check_liveness(R, [{put_tuple,Ar,D}|Is], St) -> + Set = {set,[D],[],{put_tuple,Ar}}, + check_liveness(R, [{block,[Set]}||Is], St); +check_liveness(R, [{put_list,S1,S2,D}|Is], St) -> + Set = {set,[D],[S1,S2],put_list}, + check_liveness(R, [{block,[Set]}||Is], St); check_liveness(R, [{test_heap,N,Live}|Is], St) -> I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, check_liveness(R, [I|Is], St); @@ -597,6 +609,12 @@ check_liveness(R, [remove_message|Is], St) -> check_liveness(R, Is, St); check_liveness({x,X}, [build_stacktrace|_], St) when X > 0 -> {killed,St}; +check_liveness(R, [{recv_mark,_}|Is], St) -> + check_liveness(R, Is, St); +check_liveness(R, [{recv_set,_}|Is], St) -> + check_liveness(R, Is, St); +check_liveness(R, [{'%',_}|Is], St) -> + check_liveness(R, Is, St); check_liveness(_R, Is, St) when is_list(Is) -> %% Not implemented. Conservatively assume that the register is used. {used,St}. @@ -631,6 +649,7 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} end. +not_used({exit_not_used,St}) -> {not_used,St}; not_used({killed,St}) -> {not_used,St}; not_used({_,_}=Res) -> Res. @@ -649,7 +668,7 @@ check_liveness_ret(_, _, St) -> {killed,St}. %% alloc_used - Used only in an allocate instruction %% used - Reg is explicitly used by an instruction %% -%% '%live' annotations are not allowed. +%% Annotations are not allowed. %% %% (Unknown instructions will cause an exception.) @@ -659,13 +678,30 @@ check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) -> {killed,St0}; true -> case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of - {killed,St} -> {not_used,St}; {transparent,St} -> {alloc_used,St}; - {_,_}=Res -> Res + {_,_}=Res -> not_used(Res) end end; -check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) -> - check_liveness_block_1(R, Ss, Ds, Op, Is, St); +check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St0) -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {transparent,St} -> {alloc_used,St}; + {_,_}=Res -> not_used(Res) + end; +check_liveness_block({y,_}=R, [{set,Ds,Ss,{try_catch,_,Op}}|Is], St0) -> + case Ds of + [R] -> + {killed,St0}; + _ -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {exit_not_used,St} -> + {used,St}; + {transparent,St} -> + %% Conservatively assumed that it is used. + {used,St}; + {_,_}=Res -> + Res + end + end; check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) -> check_liveness_block_1(R, Ss, Ds, Op, Is, St); check_liveness_block(_, [], St) -> {transparent,St}. @@ -681,6 +717,11 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> true -> {killed,St}; false -> check_liveness_block(R, Is, St) end; + {exit_not_used,St} -> + case member(R, Ds) of + true -> {exit_not_used,St}; + false -> check_liveness_block(R, Is, St) + end; {not_used,St} -> not_used(case member(R, Ds) of true -> {killed,St}; @@ -824,9 +865,9 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> %% Other instructions. live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> - Live0 = {'%live',live_regs(Regs0),Regs0}, + Live0 = make_anno({used,Regs0}), {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), - Live = {'%live',live_regs(Regs),Regs}, + Live = make_anno({used,Regs}), live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); live_opt([build_stacktrace=I|Is], _, D, Acc) -> live_opt(Is, live_call(1), D, [I|Acc]); @@ -871,7 +912,8 @@ live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) -> Regs1 = x_live(Ss, Regs0), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) -> +live_opt([{select,_,Src,Fail,List}=I|Is], _, D, Acc) -> + Regs0 = 0, Regs1 = x_live([Src], Regs0), Regs = live_join_labels([Fail|List], D, Regs1), live_opt(Is, Regs, D, [I|Acc]); @@ -894,6 +936,25 @@ live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) -> Regs1 = x_live([Src|Ss], x_dead(Ds, Regs0)), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); +live_opt([{gc_bif,N,F,R,As,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],As,{alloc,R,{gc_bif,N,F}}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{bif,N,F,As,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],As,{bif,N,F}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{get_tuple_element,Src,Idx,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],[Src],{get_tuple_element,Idx}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{move,Src,Dst}=I|Is], Regs0, D, Acc) -> + Regs = x_live([Src], x_dead([Dst], Regs0)), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{put_map,F,Op,S,Dst,R,{list,Puts}}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],[S|Puts],{alloc,R,{put_map,Op,F}}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); %% Transparent instructions - they neither use nor modify x registers. live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> @@ -910,6 +971,10 @@ live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{'catch',_,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{'try',_,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been %% started from a .S file using the 'from_asm' option. @@ -940,7 +1005,7 @@ live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) -> _ -> live_opt_block(Is, Regs, D, [I|Acc]) end; -live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) -> +live_opt_block([{'%anno',_}|Is], Regs, D, Acc) -> live_opt_block(Is, Regs, D, Acc); live_opt_block([], Regs, _, Acc) -> {Acc,Regs}. @@ -1015,7 +1080,7 @@ defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) -> [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; defs([{block,Block0}|Is], Regs0, D0) -> {Block,Regs,D} = defs_list(Block0, Regs0, D0), - [{block,[{'%def',Regs0}|Block]}|defs(Is, Regs, D)]; + [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)]; defs([{bs_init,{f,L},_,_,_,Dst}=I|Is], Regs0, D) -> Regs = def_regs([Dst], Regs0), [I|defs(Is, Regs, update_regs(L, Regs, D))]; @@ -1205,3 +1270,13 @@ update_regs(L, Regs0, D) -> all_defined(Live, Regs) -> All = (1 bsl Live) - 1, Regs band All =:= All. + +%%% +%%% Utilities. +%%% + +%% make_anno(Anno) -> WrappedAnno. +%% Wrap an annotation term. + +make_anno(Anno) -> + {'%anno',Anno}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 2ad9747940..4feb26c513 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -530,9 +530,10 @@ valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> Type = bif_type(Op, Src, Vst), set_type_reg(Type, Dst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), St = kill_heap_allocation(St0), Vst1 = Vst0#vst{current=St}, - verify_live(Live, Vst1), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), validate_src(Src, Vst), @@ -686,6 +687,7 @@ valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), if is_integer(Sz) -> ok; @@ -698,6 +700,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), if is_integer(Sz) -> ok; @@ -710,6 +713,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), assert_term(Bits, Vst0), assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), @@ -945,6 +949,7 @@ deallocate(#vst{current=St}=Vst) -> test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), heap_alloc(Heap, Vst). diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 770aa2c6c1..1409c358c2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -775,6 +775,8 @@ asm_passes() -> {iff,drecv,{listing,"recv"}}, {unless,no_record_opt,{pass,beam_record}}, {iff,drecord,{listing,"record"}}, + {unless,no_blk2,?pass(block2)}, + {iff,dblk2,{listing,"block2"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, @@ -1350,6 +1352,10 @@ v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,St} end. +block2(Code0, #compile{options=Opts}=St) -> + {ok,Code} = beam_block:module(Code0, [no_blockify|Opts]), + {ok,Code,St}. + test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index e28d48acf5..46816fe24a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -145,14 +145,9 @@ find_fixpoint(OptFun, Core0, Max) -> body(Body, Sub) -> body(Body, value, Sub). -body(#c_values{anno=A,es=Es0}, Ctxt, Sub) -> - Es1 = expr_list(Es0, Ctxt, Sub), - case Ctxt of - value -> - #c_values{anno=A,es=Es1}; - effect -> - make_effect_seq(Es1, Sub) - end; +body(#c_values{anno=A,es=Es0}, value, Sub) -> + Es1 = expr_list(Es0, value, Sub), + #c_values{anno=A,es=Es1}; body(E, Ctxt, Sub) -> ?ASSERT(verify_scope(E, Sub)), expr(E, Ctxt, Sub). @@ -313,9 +308,15 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case is_safe_simple(Arg, Sub) of - true -> B1; - false -> Seq0#c_seq{arg=Arg,body=B1} + case {Ctxt,is_safe_simple(Arg, Sub)} of + {effect,true} -> B1; + {effect,false} -> + case is_safe_simple(B1, Sub) of + true -> Arg; + false -> Seq0#c_seq{arg=Arg,body=B1} + end; + {value,true} -> B1; + {value,false} -> Seq0#c_seq{arg=Arg,body=B1} end end; expr(#c_let{}=Let0, Ctxt, Sub) -> @@ -379,10 +380,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), - case move_case_into_arg(Case, Sub) of - impossible -> Expr; - Other -> Other - end; + move_case_into_arg(Expr, Sub); Other -> expr(Other, Ctxt, Sub) end; @@ -2664,53 +2662,93 @@ opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), BodySub = update_let_types(Vs, Args, Sub1), + Sub = Sub1#sub{v=[],s=cerl_sets:new()}, B = body(B0, Ctxt, BodySub), Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + opt_simple_let_2(Let, Vs, Arg, B, B0, Sub). + + +%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core. +%% Do final simplifications of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. -opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> - case N1 =:= N2 of - true -> - %% let <Var> = Arg in <Var> ==> Arg - Arg1; - false -> - %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), - #c_seq{arg=Arg,body=Body} - end; + {[#c_var{name=V}],Arg1,#c_var{name=V}} -> + %% let <Var> = Arg in <Var> ==> Arg + Arg1; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - case Ctxt of - effect -> - %% Throw away the literal body. - Arg; - value -> - %% Since the variable is not used in the body, we - %% can rewrite the let to a sequence. - %% let <Var> = Arg in Literal ==> seq Arg Literal - #c_seq{arg=Arg,body=Body} - end; - {Vs,Arg1,Body} -> - %% If none of the variables are used in the body, we can - %% rewrite the let to a sequence: - %% let <Var> = Arg in BodyWithoutVar ==> - %% seq Arg BodyWithoutVar - case is_any_var_used(Vs, Body) of - false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - #c_seq{arg=Arg,body=Body}; - true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - opt_bool_case_in_let(Let1, Sub) + {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} -> + case core_lib:is_var_used(V, Body) of + false when Vars =:= [] -> + %% If the variable is not used in the body, we can + %% rewrite the let to a sequence: + %% let <Var> = Arg in BodyWithoutVar ==> + %% seq Arg BodyWithoutVar + Arg = maybe_suppress_warnings(Arg1, Var, PrevBody), + #c_seq{arg=Arg,body=Body}; + false -> + %% There are multiple values returned by the argument + %% and the first value is not used (this is a 'case' + %% with exported variables, but the return value is + %% ignored). We can remove the first variable and the + %% the first value returned from the 'let' argument. + Arg2 = remove_first_value(Arg1, Sub), + Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, + post_opt_let(Let1, Sub); + true -> + Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body}, + post_opt_let(Let1, Sub) end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' +%% post_opt_let(Let, Sub) +%% Final optimizations of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. + +post_opt_let(Let, Sub) -> + opt_bool_case_in_let(Let, Sub). + + +%% remove_first_value(Core0, Sub) -> Core. +%% Core0 is an expression that returns at least two values. +%% Remove the first value returned from Core0. + +remove_first_value(#c_values{es=[V|Vs]}, Sub) -> + Values = core_lib:make_values(Vs), + case is_safe_simple(V, Sub) of + false -> + #c_seq{arg=V,body=Values}; + true -> + Values + end; +remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Core#c_case{clauses=Cs}; +remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Act = remove_first_value(Act0, Sub), + Core#c_receive{clauses=Cs,action=Act}; +remove_first_value(#c_let{body=B}=Core, Sub) -> + Core#c_let{body=remove_first_value(B, Sub)}; +remove_first_value(#c_seq{body=B}=Core, Sub) -> + Core#c_seq{body=remove_first_value(B, Sub)}; +remove_first_value(#c_primop{}=Core, _Sub) -> + Core; +remove_first_value(#c_call{}=Core, _Sub) -> + Core. + +remove_first_value_cs(Cs, Sub) -> + [C#c_clause{body=remove_first_value(B, Sub)} || + #c_clause{body=B}=C <- Cs]. + +%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2721,12 +2759,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, Vs, PrevBody) -> +maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> - case is_any_var_used(Vs, PrevBody) of + case core_lib:is_var_used(V, PrevBody) of true -> suppress_warning([Arg]); false -> @@ -2815,7 +2853,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, Outer#c_case{arg=OuterArg, clauses=[OuterCa,OuterCb]}; false -> - impossible + Inner0 end; move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, clauses=InnerClauses}=Inner, _Sub) -> @@ -2831,15 +2869,8 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, %% Outer#c_seq{arg=OuterArg, body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; -move_case_into_arg(_, _) -> - impossible. - -is_any_var_used([#c_var{name=V}|Vs], Expr) -> - case core_lib:is_var_used(V, Expr) of - false -> is_any_var_used(Vs, Expr); - true -> true - end; -is_any_var_used([], _) -> false. +move_case_into_arg(Expr, _) -> + Expr. %%% %%% Retrieving information about types. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 86146c614f..fe856b12b6 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -22,7 +22,8 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, integers/1,coverage/1,booleans/1,setelement/1,cons/1, - tuple/1,record_float/1,binary_float/1,float_compare/1]). + tuple/1,record_float/1,binary_float/1,float_compare/1, + arity_checks/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -40,7 +41,8 @@ groups() -> tuple, record_float, binary_float, - float_compare + float_compare, + arity_checks ]}]. init_per_suite(Config) -> @@ -171,6 +173,31 @@ do_float_compare(X) -> _T -> Y > 0 end. +arity_checks(_Config) -> + %% ERL-549: an unsafe optimization removed a test_arity instruction, + %% causing the following to return 'broken' instead of 'ok'. + ok = do_record_arity_check({rgb, 255, 255, 255, 1}), + ok = do_tuple_arity_check({255, 255, 255, 1}). + +-record(rgb, {r = 255, g = 255, b = 255}). + +do_record_arity_check(RGB) when + (element(2, RGB) >= 0), (element(2, RGB) =< 255), + (element(3, RGB) >= 0), (element(3, RGB) =< 255), + (element(4, RGB) >= 0), (element(4, RGB) =< 255) -> + if + element(1, RGB) =:= rgb, is_record(RGB, rgb) -> broken; + true -> ok + end. + +do_tuple_arity_check(RGB) when is_tuple(RGB), + (element(1, RGB) >= 0), (element(1, RGB) =< 255), + (element(2, RGB) >= 0), (element(2, RGB) =< 255), + (element(3, RGB) >= 0), (element(3, RGB) =< 255) -> + case RGB of + {255, _, _} -> broken; + _ -> ok + end. id(I) -> I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 7e1a432511..7557d6d57b 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -40,7 +40,7 @@ map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, parse_xml/1,get_payload/1,escape/1,num_slots_different/1, - check_bitstring_list/1,guard/1]). + beam_bsm/1,guard/1,is_ascii/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -73,7 +73,7 @@ groups() -> map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, get_payload,escape,num_slots_different, - check_bitstring_list,guard]}]. + beam_bsm,guard,is_ascii]}]. init_per_suite(Config) -> @@ -801,7 +801,7 @@ multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false. first_after(Data, Offset) -> case byte_size(Data) > Offset of false -> - {First, Rest} = {ok, ok}, + {_First, _Rest} = {ok, ok}, ok; true -> <<_:Offset/binary, Rest/binary>> = Data, @@ -1515,7 +1515,7 @@ is_next_char_whitespace(<<C/utf8,_/binary>>) -> {this_hdr = 17, ext_hdr_opts}). -get_payload(Config) -> +get_payload(_Config) -> <<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}), {'EXIT',_} = (catch do_get_payload(#ext_header{})), ok. @@ -1574,10 +1574,22 @@ lgettext(<<"de">>, <<"navigation">>, <<"Results">>) -> lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) -> {ok, <<"Ressourcen">>}. -%% Cover more code in beam_bsm. -check_bitstring_list(_Config) -> +%% Test more code in beam_bsm. +beam_bsm(_Config) -> true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]), false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]), + + true = bsm_validate_scheme(<<>>), + true = bsm_validate_scheme(<<5,10>>), + false = bsm_validate_scheme(<<5,10,11,12>>), + true = bsm_validate_scheme([]), + true = bsm_validate_scheme([5,10]), + false = bsm_validate_scheme([5,6,7]), + + <<1,2,3>> = bsm_must_save_and_not_save(<<1,2,3>>, []), + D = fun(N) -> 2*N end, + [2,4|<<3>>] = bsm_must_save_and_not_save(<<1,2,3>>, [D,D]), + ok. check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> @@ -1587,8 +1599,32 @@ check_bitstring_list(<<>>, []) -> check_bitstring_list(_, _) -> false. +bsm_validate_scheme([]) -> true; +bsm_validate_scheme([H|T]) -> + case bsm_is_scheme(H) of + true -> bsm_validate_scheme(T); + false -> false + end; +bsm_validate_scheme(<<>>) -> true; +bsm_validate_scheme(<<H, Rest/binary>>) -> + case bsm_is_scheme(H) of + true -> bsm_validate_scheme(Rest); + false -> false + end. + +bsm_is_scheme(Int) -> + Int rem 5 =:= 0. + +%% NOT OPTIMIZED: different control paths use different positions in the binary +bsm_must_save_and_not_save(Bin, []) -> + Bin; +bsm_must_save_and_not_save(<<H,T/binary>>, [F|Fs]) -> + [F(H)|bsm_must_save_and_not_save(T, Fs)]; +bsm_must_save_and_not_save(<<>>, []) -> + []. + guard(_Config) -> - Tuple = id({a,b}), + _Tuple = id({a,b}), ok = guard_1(<<1,2,3>>, {1,2,3}), ok = guard_2(<<42>>, #{}), ok. @@ -1601,6 +1637,24 @@ guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} -> guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} -> ok. +is_ascii(_Config) -> + true = do_is_ascii(<<>>), + true = do_is_ascii(<<"string">>), + false = do_is_ascii(<<1024/utf8>>), + {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<$A,0:3>>)), + {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<16#80,0:3>>)), + ok. + +do_is_ascii(<<>>) -> + true; +do_is_ascii(<<C,_/binary>>) when C >= 16#80 -> + %% This clause must fail to match if the size of the argument in + %% bits is not divisible by 8. Beware of unsafe optimizations. + false; +do_is_ascii(<<_, T/binary>>) -> + do_is_ascii(T). + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 262967d03d..4fd1f84569 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -27,7 +27,7 @@ multiple_aliases/1,redundant_boolean_clauses/1, mixed_matching_clauses/1,unnecessary_building/1, no_no_file/1,configuration/1,supplies/1, - redundant_stack_frame/1]). + redundant_stack_frame/1,export_from_case/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -47,7 +47,7 @@ groups() -> multiple_aliases,redundant_boolean_clauses, mixed_matching_clauses,unnecessary_building, no_no_file,configuration,supplies, - redundant_stack_frame]}]. + redundant_stack_frame,export_from_case]}]. init_per_suite(Config) -> @@ -551,4 +551,38 @@ do_redundant_stack_frame(Map) -> end, {X, Y}. +%% Cover some clauses in sys_core_fold:remove_first_value/2. + +-record(export_from_case, {val}). + +export_from_case(_Config) -> + a = export_from_case_1(true), + b = export_from_case_1(false), + + R = #export_from_case{val=0}, + {ok,R} = export_from_case_2(false, R), + {ok,#export_from_case{val=42}} = export_from_case_2(true, R), + + ok. + +export_from_case_1(Bool) -> + case Bool of + true -> + id(42), + Result = a; + false -> + Result = b + end, + id(Result). + +export_from_case_2(Bool, Rec) -> + case Bool of + false -> + Result = Rec; + true -> + Result = Rec#export_from_case{val=42} + end, + {ok,Result}. + + id(I) -> I. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 6957d25774..9a3ea07c97 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -179,6 +179,12 @@ # define HAVE_ECB_IVEC_BUG #endif +#define HAVE_RSA_SSLV23_PADDING +#if defined(HAS_LIBRESSL) \ + && LIBRESSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(2,6,1) +# undef HAVE_RSA_SSLV23_PADDING +#endif + #if defined(HAVE_CMAC) #include <openssl/cmac.h> #endif @@ -659,7 +665,9 @@ static ERL_NIF_TERM atom_rsa_oaep_md; static ERL_NIF_TERM atom_rsa_pad; /* backwards compatibility */ static ERL_NIF_TERM atom_rsa_padding; static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding; +#ifdef HAVE_RSA_SSLV23_PADDING static ERL_NIF_TERM atom_rsa_sslv23_padding; +#endif static ERL_NIF_TERM atom_rsa_x931_padding; static ERL_NIF_TERM atom_rsa_pss_saltlen; static ERL_NIF_TERM atom_sha224; @@ -1064,7 +1072,9 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_rsa_pad = enif_make_atom(env,"rsa_pad"); /* backwards compatibility */ atom_rsa_padding = enif_make_atom(env,"rsa_padding"); atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding"); +#ifdef HAVE_RSA_SSLV23_PADDING atom_rsa_sslv23_padding = enif_make_atom(env,"rsa_sslv23_padding"); +#endif atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding"); atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen"); atom_sha224 = enif_make_atom(env,"sha224"); @@ -4449,8 +4459,10 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI opt->rsa_padding = RSA_PKCS1_PADDING; } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) { opt->rsa_padding = RSA_PKCS1_OAEP_PADDING; +#ifdef HAVE_RSA_SSLV23_PADDING } else if (tpl_terms[1] == atom_rsa_sslv23_padding) { opt->rsa_padding = RSA_SSLV23_PADDING; +#endif } else if (tpl_terms[1] == atom_rsa_x931_padding) { opt->rsa_padding = RSA_X931_PADDING; } else if (tpl_terms[1] == atom_rsa_no_padding) { @@ -4516,7 +4528,10 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM #endif PKeyCryptOptions crypt_opt; ErlNifBinary in_bin, out_bin, tmp_bin; - size_t outlen, tmplen; + size_t outlen; +#ifdef HAVE_RSA_SSLV23_PADDING + size_t tmplen; +#endif int is_private = (argv[4] == atom_true), is_encrypt = (argv[5] == atom_true); int algo_init = 0; @@ -4596,6 +4611,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM if (crypt_opt.signature_md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0) goto badarg; +#ifdef HAVE_RSA_SSLV23_PADDING if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { if (is_encrypt) { RSA *rsa = EVP_PKEY_get1_RSA(pkey); @@ -4607,9 +4623,11 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM in_bin = tmp_bin; } if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg; - } else { + } else +#endif + { if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg; - } + } #ifdef HAVE_RSA_OAEP_MD if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) { if (crypt_opt.rsa_oaep_md != NULL @@ -4728,6 +4746,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM #endif if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) { +#ifdef HAVE_RSA_SSLV23_PADDING if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { RSA *rsa = EVP_PKEY_get1_RSA(pkey); unsigned char *p; @@ -4745,6 +4764,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM i = 1; } } +#endif } if (tmp_bin.data != NULL) { diff --git a/lib/dialyzer/test/small_SUITE_data/src/abs.erl b/lib/dialyzer/test/small_SUITE_data/src/abs.erl index 251e24cdfc..0e38c3dbb7 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/abs.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/abs.erl @@ -5,7 +5,7 @@ -export([t/0]). t() -> - Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0], + Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0, fun erl_551/0], _ = [catch F() || F <- Fs], ok. @@ -60,6 +60,13 @@ f1() -> f1(A) -> abs(A). +erl_551() -> + accept(9), + accept(-3). + +accept(Number) when abs(Number) >= 8 -> first; +accept(_Number) -> second. + -spec int() -> integer(). int() -> diff --git a/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl b/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl new file mode 100644 index 0000000000..2dc00d272a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl @@ -0,0 +1,14 @@ +-module(erl_tar_table). + +%% OTP-14860, PR 1670. + +-export([t/0, v/0, x/0]). + +t() -> + {ok, ["file"]} = erl_tar:table("table.tar"). + +v() -> + {ok, [{_,_,_,_,_,_,_}]} = erl_tar:table("table.tar", [verbose]). + +x() -> + {ok, ["file"]} = erl_tar:table("table.tar", []). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 462a1f9dcd..fc6a844e22 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1974,9 +1974,11 @@ arith_abs(X1, Opaques) -> case infinity_geq(Min1, 0) of true -> {Min1, Max1}; false -> + NegMin1 = infinity_inv(Min1), + NegMax1 = infinity_inv(Max1), case infinity_geq(Max1, 0) of - true -> {0, infinity_inv(Min1)}; - false -> {infinity_inv(Max1), infinity_inv(Min1)} + true -> {0, max(NegMin1, Max1)}; + false -> {NegMax1, NegMin1} end end, t_from_range(NewMin, NewMax) diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index b9e7d93570..aa85626857 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -279,13 +279,22 @@ bad_floats() -> %% (incorrectly) signed. huge_binaries() -> - AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), case erlang:system_info(wordsize) of - 4 -> huge_binaries_32(AlmostIllegal); + 4 -> + Old = erts_debug:set_internal_state(available_internal_state, true), + case erts_debug:set_internal_state(binary, (1 bsl 29)-1) of + false -> + io:format("\nNot enough memory to create 512Mb binary\n",[]); + Bin-> + huge_binaries_32(Bin) + end, + erts_debug:set_internal_state(available_internal_state, Old); + 8 -> ok end, garbage_collect(), id(<<0:(id((1 bsl 31)-1))>>), + garbage_collect(), id(<<0:(id((1 bsl 30)-1))>>), garbage_collect(), ok. diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c index b3a18e03d4..446b46ad82 100644 --- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c @@ -1365,8 +1365,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1579,8 +1579,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c index 40c7328f03..d6a78d2481 100644 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c @@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c index 33cfe71322..17ef21f4f4 100644 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c @@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 58abb35428..8477b0e148 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -93,13 +93,6 @@ are now <em>rejected</em> and will cause primitive file operations fail. </p></note> - <warning><p> - Currently null characters at the end of the filename - will be accepted by primitive file operations. Such - filenames are however still documented as invalid. The - implementation will also change in the future and - reject such filenames. - </p></warning> </description> diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 169a76463b..abb045b744 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -197,6 +197,9 @@ fe80::204:acff:fe17:bf38 <datatype> <name name="address_family"/> </datatype> + <datatype> + <name name="socket_protocol"/> + </datatype> </datatypes> <funcs> @@ -461,6 +464,61 @@ get_tcpi_sacked(Sock) -> </func> <func> + <name name="i" arity="0" /> + <name name="i" arity="1" /> + <name name="i" arity="2" /> + <fsummary>Displays information and statistics about sockets on the terminal</fsummary> + <desc> + <p> + Lists all TCP, UDP and SCTP sockets, including those that the Erlang runtime system uses as well as + those created by the application. + </p> + <p> + The following options are available: + </p> + + <taglist> + <tag><c>port</c></tag> + <item> + <p>The internal index of the port.</p> + </item> + <tag><c>module</c></tag> + <item> + <p>The callback module of the socket.</p> + </item> + <tag><c>recv</c></tag> + <item> + <p>Number of bytes received by the socket.</p> + </item> + <tag><c>sent</c></tag> + <item> + <p>Number of bytes sent from the socket.</p> + </item> + <tag><c>owner</c></tag> + <item> + <p>The socket owner process.</p> + </item> + <tag><c>local_address</c></tag> + <item> + <p>The local address of the socket.</p> + </item> + <tag><c>foreign_address</c></tag> + <item> + <p>The address and port of the other end of the connection.</p> + </item> + <tag><c>state</c></tag> + <item> + <p>The connection state.</p> + </item> + <tag><c>type</c></tag> + <item> + <p>STREAM or DGRAM or SEQPACKET.</p> + </item> + </taglist> + </desc> + </func> + + <func> <name name="ntoa" arity="1" /> <fsummary>Convert IPv6/IPV4 address to ASCII.</fsummary> <desc> @@ -1214,7 +1272,7 @@ inet:setopts(Sock,[{raw,6,8,<<30:32/native>>}]),]]></code> For one-to-many style sockets, the special value <c>0</c> is defined to mean that the returned addresses must be without any particular association. - How different SCTP implementations interprets this varies somewhat. + How different SCTP implementations interpret this varies somewhat. </p> </desc> </func> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index e5ac031539..0762cebc94 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1996</year><year>2017</year> + <year>1996</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -469,8 +469,12 @@ MaxT = TickTime + TickTime / 4</code> <item><c>ObjSuffix = string()</c></item> <item><c>SrcSuffix = string()</c></item> </list> - <p>Specifies a list of rules for use by <c>filelib:find_file/2</c> and - <c>filelib:find_source/2</c>. If this is set to some other value + <p>Specifies a list of rules for use by + <seealso marker="stdlib:filelib#find_file/2"> + <c>filelib:find_file/2</c></seealso> + <seealso marker="stdlib:filelib#find_source/2"> + <c>filelib:find_source/2</c></seealso> + If this is set to some other value than the empty list, it replaces the default rules. Rules can be simple pairs of directory suffixes, such as <c>{"ebin", "src"}</c>, which are used by <c>filelib:find_file/2</c>, or @@ -478,6 +482,16 @@ MaxT = TickTime + TickTime / 4</code> file name extensions, for example <c>[{".beam", ".erl", [{"ebin", "src"}]}</c>, which are used by <c>filelib:find_source/2</c>. Both kinds of rules can be mixed in the list.</p> + <p>The interpretation of <c>ObjDirSuffix</c> and <c>SrcDirSuffix</c> + is as follows: if the end of the directory name where an + object is located matches <c>ObjDirSuffix</c>, then the + name created by replacing <c>ObjDirSuffix</c> with + <c>SrcDirSuffix</c> is expanded by calling + <seealso marker="stdlib:filelib#wildcard/1"> + <c>filelib:wildcard/1</c></seealso>, and the first regular + file found among the matches is the source file. + </p> + </item> </taglist> </section> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 0a08e2c78a..c27182ff0b 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -58,17 +58,6 @@ operations to fail. </p> </note> - <warning> - <p> - Currently null characters at the end of filenames, - environment variable names and values will be accepted - by the primitive operations. Such filenames, environment - variable names and values are however still documented as - invalid. The implementation will also change in the - future and reject such filenames, environment variable - names and values. - </p> - </warning> </description> <datatypes> @@ -143,12 +132,8 @@ <warning><p>Previous implementation used to allow all characters as long as they were integer values greater than or equal to zero. This sometimes lead to unwanted results since null characters - (integer value zero) often are interpreted as string termination. - Current implementation still accepts null characters at the end - of <c><anno>Command</anno></c> even though the documentation - states that no null characters are allowed. This will however - be changed in the future so that no null characters at all will - be accepted.</p></warning> + (integer value zero) often are interpreted as string termination. The + current implementation rejects these.</p></warning> <p><em>Examples:</em></p> <code type="none"> LsOut = os:cmd("ls"), % on unix platform diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index dc20c21c77..fe91b0d33e 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -72,7 +72,7 @@ %% timer interface -export([start_timer/1, timeout/1, timeout/2, stop_timer/1]). --export_type([address_family/0, hostent/0, hostname/0, ip4_address/0, +-export_type([address_family/0, socket_protocol/0, hostent/0, hostname/0, ip4_address/0, ip6_address/0, ip_address/0, port_number/0, local_address/0, socket_address/0, returned_non_ip_address/0, socket_setopt/0, socket_getopt/0, @@ -1452,11 +1452,14 @@ fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) -> %% socket stat %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec i() -> ok. i() -> i(tcp), i(udp), i(sctp). +-spec i(socket_protocol()) -> ok. i(Proto) -> i(Proto, [port, module, recv, sent, owner, local_address, foreign_address, state, type]). +-spec i(socket_protocol(), [atom()]) -> ok. i(tcp, Fs) -> ii(tcp_sockets(), Fs, tcp); i(udp, Fs) -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index b5f19d4b99..fbc046c8f9 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -27,12 +27,13 @@ -export_type([env_var_name/0, env_var_value/0, env_var_name_value/0, command_input/0]). +-export([getenv/0, getenv/1, getenv/2, putenv/2, unsetenv/1]). + %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, - perf_counter/0, perf_counter/1, - putenv/2, set_signal/2, system_time/0, system_time/1, - timestamp/0, unsetenv/1]). +-export([get_env_var/1, getpid/0, list_env_vars/0, perf_counter/0, + perf_counter/1, set_env_var/2, set_signal/2, system_time/0, + system_time/1, timestamp/0, unset_env_var/1]). -type env_var_name() :: nonempty_string(). @@ -42,29 +43,15 @@ -type command_input() :: atom() | io_lib:chars(). --spec getenv() -> [env_var_name_value()]. - -getenv() -> erlang:nif_error(undef). - --spec getenv(VarName) -> Value | false when - VarName :: env_var_name(), - Value :: env_var_value(). - -getenv(_) -> +-spec list_env_vars() -> [{env_var_name(), env_var_value()}]. +list_env_vars() -> erlang:nif_error(undef). --spec getenv(VarName, DefaultValue) -> Value when +-spec get_env_var(VarName) -> Value | false when VarName :: env_var_name(), - DefaultValue :: env_var_value(), Value :: env_var_value(). - -getenv(VarName, DefaultValue) -> - case os:getenv(VarName) of - false -> - DefaultValue; - Value -> - Value - end. +get_env_var(_VarName) -> + erlang:nif_error(undef). -spec getpid() -> Value when Value :: string(). @@ -84,11 +71,10 @@ perf_counter() -> perf_counter(Unit) -> erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). --spec putenv(VarName, Value) -> true when +-spec set_env_var(VarName, Value) -> true when VarName :: env_var_name(), Value :: env_var_value(). - -putenv(_, _) -> +set_env_var(_, _) -> erlang:nif_error(undef). -spec system_time() -> integer(). @@ -108,10 +94,9 @@ system_time(_Unit) -> timestamp() -> erlang:nif_error(undef). --spec unsetenv(VarName) -> true when +-spec unset_env_var(VarName) -> true when VarName :: env_var_name(). - -unsetenv(_) -> +unset_env_var(_) -> erlang:nif_error(undef). -spec set_signal(Signal, Option) -> 'ok' when @@ -125,6 +110,39 @@ set_signal(_Signal, _Option) -> %%% End of BIFs +-spec getenv() -> [env_var_name_value()]. +getenv() -> + [lists:flatten([Key, $=, Value]) || {Key, Value} <- os:list_env_vars() ]. + +-spec getenv(VarName) -> Value | false when + VarName :: env_var_name(), + Value :: env_var_value(). +getenv(VarName) -> + os:get_env_var(VarName). + +-spec getenv(VarName, DefaultValue) -> Value when + VarName :: env_var_name(), + DefaultValue :: env_var_value(), + Value :: env_var_value(). +getenv(VarName, DefaultValue) -> + case os:getenv(VarName) of + false -> + DefaultValue; + Value -> + Value + end. + +-spec putenv(VarName, Value) -> true when + VarName :: env_var_name(), + Value :: env_var_value(). +putenv(VarName, Value) -> + os:set_env_var(VarName, Value). + +-spec unsetenv(VarName) -> true when + VarName :: env_var_name(). +unsetenv(VarName) -> + os:unset_env_var(VarName). + -spec type() -> {Osfamily, Osname} when Osfamily :: unix | win32, Osname :: atom(). diff --git a/lib/observer/include/etop.hrl b/lib/observer/include/etop.hrl index 002937e522..f8d370450b 100644 --- a/lib/observer/include/etop.hrl +++ b/lib/observer/include/etop.hrl @@ -18,4 +18,4 @@ %% %CopyrightEnd% %% --include("../../runtime_tools/include/observer_backend.hrl"). +-include_lib("runtime_tools/include/observer_backend.hrl"). diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index f6d282638a..6c4739042b 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -48,6 +48,7 @@ init([Id, Data, ParentFrame, Callback, App, Parent]) -> display_progress(ParentFrame,App), case Callback:get_details(Id, Data) of {ok,Details} -> + display_progress_pulse(Callback,Id), init(Id,ParentFrame,Callback,App,Parent,Details); {yes_no, Info, Fun} -> destroy_progress(App), @@ -69,8 +70,16 @@ display_progress(ParentFrame,cdv) -> "Reading data"); display_progress(_,_) -> ok. + +%% Display pulse while creating process detail page with much data +display_progress_pulse(cdv_proc_cb,Pid) -> + observer_lib:report_progress({ok,"Displaying data for "++Pid}), + observer_lib:report_progress({ok,start_pulse}); +display_progress_pulse(_,_) -> + ok. + destroy_progress(cdv) -> - observer_lib:destroy_progress_dialog(); + observer_lib:sync_destroy_progress_dialog(); destroy_progress(_) -> ok. diff --git a/lib/observer/src/cdv_info_wx.erl b/lib/observer/src/cdv_info_wx.erl index 7e416dd11a..07c28610e2 100644 --- a/lib/observer/src/cdv_info_wx.erl +++ b/lib/observer/src/cdv_info_wx.erl @@ -95,6 +95,10 @@ handle_cast(Msg, State) -> io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down},userData=Target}, State) -> cdv_virtual_list_wx:start_detail_win(Target), {noreply, State}; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index f197e72b90..bba97624a7 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -1240,7 +1240,7 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> "Last calls" -> get_procinfo(Fd,Fun,Proc#proc{last_calls=get_last_calls(Fd)},WS); "Link list" -> - {Links,Monitors,MonitoredBy} = parse_link_list(bytes(Fd),[],[],[]), + {Links,Monitors,MonitoredBy} = get_link_list(Fd), get_procinfo(Fd,Fun,Proc#proc{links=Links, monitors=Monitors, mon_by=MonitoredBy},WS); @@ -1322,86 +1322,64 @@ get_last_calls(Fd,<<>>,Acc,Lines) -> lists:reverse(Lines,[byte_list_to_string(lists:reverse(Acc))]) end. -parse_link_list([SB|Str],Links,Monitors,MonitoredBy) when SB==$[; SB==$] -> - parse_link_list(Str,Links,Monitors,MonitoredBy); -parse_link_list("#Port"++_=Str,Links,Monitors,MonitoredBy) -> - {Link,Rest} = parse_port(Str), - parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy); -parse_link_list("<"++_=Str,Links,Monitors,MonitoredBy) -> - {Link,Rest} = parse_pid(Str), - parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy); -parse_link_list("{to,"++Str,Links,Monitors,MonitoredBy) -> - {Mon,Rest} = parse_monitor(Str), - parse_link_list(Rest,Links,[Mon|Monitors],MonitoredBy); -parse_link_list("{from,"++Str,Links,Monitors,MonitoredBy) -> - {Mon,Rest} = parse_monitor(Str), - parse_link_list(Rest,Links,Monitors,[Mon|MonitoredBy]); -parse_link_list(", "++Rest,Links,Monitors,MonitoredBy) -> - parse_link_list(Rest,Links,Monitors,MonitoredBy); -parse_link_list([],Links,Monitors,MonitoredBy) -> - {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)}; -parse_link_list(Unexpected,Links,Monitors,MonitoredBy) -> - io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), - parse_link_list([],Links,Monitors,MonitoredBy). - - -parse_port(Str) -> - {Port,Rest} = parse_link(Str,[]), - {{Port,Port},Rest}. - -parse_pid(Str) -> - {Pid,Rest} = parse_link(Str,[]), - {{Pid,Pid},Rest}. - -parse_monitor("{"++Str) -> - %% Named process - {Name,Node,Rest1} = parse_name_node(Str,[]), - Pid = get_pid_from_name(Name,Node), - case parse_link(string:trim(Rest1,leading,","),[]) of - {Ref,"}"++Rest2} -> - %% Bug in break.c - prints an extra "}" for remote - %% nodes... thus the strip - {{Pid,"{"++Name++","++Node++"} ("++Ref++")"}, - string:trim(Rest2,leading,"}")}; - {Ref,[]} -> - {{Pid,"{"++Name++","++Node++"} ("++Ref++")"},[]} - end; -parse_monitor(Str) -> - case parse_link(Str,[]) of - {Pid,","++Rest1} -> - case parse_link(Rest1,[]) of - {Ref,"}"++Rest2} -> - {{Pid,Pid++" ("++Ref++")"},Rest2}; - {Ref,[]} -> - {{Pid,Pid++" ("++Ref++")"},[]} - end; - {Pid,[]} -> - {{Pid,Pid++" (unknown_ref)"},[]} +get_link_list(Fd) -> + case get_chunk(Fd) of + {ok,<<"[",Bin/binary>>} -> + #{links:=Links, + mons:=Monitors, + mon_by:=MonitoredBy} = + get_link_list(Fd,Bin,#{links=>[],mons=>[],mon_by=>[]}), + {lists:reverse(Links), + lists:reverse(Monitors), + lists:reverse(MonitoredBy)}; + eof -> + {[],[],[]} end. -parse_link(">"++Rest,Acc) -> - {lists:reverse(Acc,">"),Rest}; -parse_link([H|T],Acc) -> - parse_link(T,[H|Acc]); -parse_link([],Acc) -> - %% truncated - {lists:reverse(Acc),[]}. +get_link_list(Fd,<<NL:8,_/binary>>=Bin,Acc) when NL=:=$\r; NL=:=$\n-> + skip(Fd,Bin), + Acc; +get_link_list(Fd,Bin,Acc) -> + case binary:split(Bin,[<<", ">>,<<"]">>]) of + [Link,Rest] -> + get_link_list(Fd,Rest,get_link(Link,Acc)); + [Incomplete] -> + case get_chunk(Fd) of + {ok,More} -> + get_link_list(Fd,<<Incomplete/binary,More/binary>>,Acc); + eof -> + Acc + end + end. -parse_name_node(","++Rest,Name) -> - parse_name_node(Rest,Name,[]); -parse_name_node([H|T],Name) -> - parse_name_node(T,[H|Name]); -parse_name_node([],Name) -> - %% truncated - {lists:reverse(Name),[],[]}. - -parse_name_node("}"++Rest,Name,Node) -> - {lists:reverse(Name),lists:reverse(Node),Rest}; -parse_name_node([H|T],Name,Node) -> - parse_name_node(T,Name,[H|Node]); -parse_name_node([],Name,Node) -> - %% truncated - {lists:reverse(Name),lists:reverse(Node),[]}. +get_link(<<"#Port",_/binary>>=PortBin,#{links:=Links}=Acc) -> + PortStr = binary_to_list(PortBin), + Acc#{links=>[{PortStr,PortStr}|Links]}; +get_link(<<"<",_/binary>>=PidBin,#{links:=Links}=Acc) -> + PidStr = binary_to_list(PidBin), + Acc#{links=>[{PidStr,PidStr}|Links]}; +get_link(<<"{to,",Bin/binary>>,#{mons:=Monitors}=Acc) -> + Acc#{mons=>[parse_monitor(Bin)|Monitors]}; +get_link(<<"{from,",Bin/binary>>,#{mon_by:=MonitoredBy}=Acc) -> + Acc#{mon_by=>[parse_monitor(Bin)|MonitoredBy]}; +get_link(Unexpected,Acc) -> + io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), + Acc. + +parse_monitor(MonBin) -> + case binary:split(MonBin,[<<",">>,<<"{">>,<<"}">>],[global]) of + [PidBin,RefBin,<<>>] -> + PidStr = binary_to_list(PidBin), + RefStr = binary_to_list(RefBin), + {PidStr,PidStr++" ("++RefStr++")"}; + [<<>>,NameBin,NodeBin,<<>>,RefBin,<<>>] -> + %% Named process + NameStr = binary_to_list(NameBin), + NodeStr = binary_to_list(NodeBin), + PidStr = get_pid_from_name(NameStr,NodeStr), + RefStr = binary_to_list(RefBin), + {PidStr,"{"++NameStr++","++NodeStr++"} ("++RefStr++")"} + end. get_pid_from_name(Name,Node) -> case ets:lookup(cdv_reg_proc_table,cdv_dump_node_name) of @@ -2029,12 +2007,16 @@ all_modinfo(Fd,LM,LineHead,DecodeOpts) -> end. get_attribute(Fd, DecodeOpts) -> + Term = do_get_attribute(Fd, DecodeOpts), + io_lib:format("~tp~n",[Term]). + +do_get_attribute(Fd, DecodeOpts) -> Bytes = bytes(Fd, ""), try get_binary(Bytes, DecodeOpts) of {Bin,_} -> try binary_to_term(Bin) of Term -> - io_lib:format("~tp~n",[Term]) + Term catch _:_ -> {"WARNING: The term is probably truncated!", diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 52e6c3e52a..0678b64134 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -21,7 +21,8 @@ -export([get_wx_parent/1, display_info_dialog/2, display_yes_no_dialog/1, - display_progress_dialog/3, destroy_progress_dialog/0, + display_progress_dialog/3, + destroy_progress_dialog/0, sync_destroy_progress_dialog/0, wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, interval_dialog/4, start_timer/1, start_timer/2, stop_timer/1, timer_config/1, @@ -31,7 +32,8 @@ set_listctrl_col_size/2, create_status_bar/1, html_window/1, html_window/2, - make_obsbin/2 + make_obsbin/2, + add_scroll_entries/2 ]). -include_lib("wx/include/wx.hrl"). @@ -40,6 +42,8 @@ -define(SINGLE_LINE_STYLE, ?wxBORDER_NONE bor ?wxTE_READONLY bor ?wxTE_RICH2). -define(MULTI_LINE_STYLE, ?SINGLE_LINE_STYLE bor ?wxTE_MULTILINE). +-define(NUM_SCROLL_ITEMS,8). + -define(pulse_timeout,50). get_wx_parent(Window) -> @@ -397,17 +401,18 @@ get_box_info({Title, left, List}) -> {Title, ?wxALIGN_LEFT, List}; get_box_info({Title, right, List}) -> {Title, ?wxALIGN_RIGHT, List}. add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) -> - Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]), + NumStr = " ("++integer_to_list(length(List))++")", + Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title ++ NumStr}]), Scroll = wxScrolledWindow:new(Panel), wxScrolledWindow:enableScrolling(Scroll,true,true), wxScrolledWindow:setScrollbars(Scroll,1,1,0,0), ScrollSizer = wxBoxSizer:new(?wxVERTICAL), wxScrolledWindow:setSizer(Scroll, ScrollSizer), wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM), - add_entries(Format, List, Scroll, ScrollSizer, Cursor), + Entries = add_entries(Format, List, Scroll, ScrollSizer, Cursor), wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]), wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]), - {Scroll,ScrollSizer,length(List)}. + {Scroll,ScrollSizer,length(Entries)}. add_entries(click, List, Scroll, ScrollSizer, Cursor) -> Add = fun(Link) -> @@ -415,7 +420,20 @@ add_entries(click, List, Scroll, ScrollSizer, Cursor) -> wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) end, - [Add(Link) || Link <- List]; + if length(List) > ?NUM_SCROLL_ITEMS -> + {List1,Rest} = lists:split(?NUM_SCROLL_ITEMS,List), + LinkEntries = [Add(Link) || Link <- List1], + NStr = integer_to_list(length(Rest)), + TC = link_entry2(Scroll, + {{more,{Rest,Scroll,ScrollSizer}},"more..."}, + Cursor, + "Click to see " ++ NStr ++ " more entries"), + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + E = wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]), + LinkEntries ++ [E]; + true -> + [Add(Link) || Link <- List] + end; add_entries(plain, List, Scroll, ScrollSizer, _) -> Add = fun(String) -> TC = wxStaticText:new(Scroll, ?wxID_ANY, String), @@ -423,6 +441,23 @@ add_entries(plain, List, Scroll, ScrollSizer, _) -> end, [Add(String) || String <- List]. +add_scroll_entries(MoreEntry,{List, Scroll, ScrollSizer}) -> + wx:batch( + fun() -> + wxSizer:remove(ScrollSizer,?NUM_SCROLL_ITEMS), + wxStaticText:destroy(MoreEntry), + Cursor = wxCursor:new(?wxCURSOR_HAND), + Add = fun(Link) -> + TC = link_entry(Scroll, Link, Cursor), + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) + end, + Entries = [Add(Link) || Link <- List], + wxCursor:destroy(Cursor), + wxSizer:layout(ScrollSizer), + wxSizer:setVirtualSizeHints(ScrollSizer,Scroll), + Entries + end). create_box(_Panel, {scroll_boxes,[]}) -> undefined; @@ -449,7 +484,7 @@ create_box(Panel, {scroll_boxes,Data}) -> {_,H} = wxWindow:getSize(Dummy), wxTextCtrl:destroy(Dummy), - MaxH = if MaxL > 8 -> 8*H; + MaxH = if MaxL > ?NUM_SCROLL_ITEMS -> ?NUM_SCROLL_ITEMS*H; true -> MaxL*H end, [wxWindow:setMinSize(B,{0,MaxH}) || {B,_,_} <- Boxes], @@ -504,20 +539,22 @@ create_box(Parent, Data) -> link_entry(Panel, Link) -> Cursor = wxCursor:new(?wxCURSOR_HAND), - TC = link_entry2(Panel, to_link(Link), Cursor), + TC = link_entry(Panel, Link, Cursor), wxCursor:destroy(Cursor), TC. link_entry(Panel, Link, Cursor) -> - link_entry2(Panel, to_link(Link), Cursor). + link_entry2(Panel,to_link(Link),Cursor). link_entry2(Panel,{Target,Str},Cursor) -> + link_entry2(Panel,{Target,Str},Cursor,"Click to see properties for " ++ Str). +link_entry2(Panel,{Target,Str},Cursor,ToolTipText) -> TC = wxStaticText:new(Panel, ?wxID_ANY, Str), wxWindow:setForegroundColour(TC,?wxBLUE), wxWindow:setCursor(TC, Cursor), wxWindow:connect(TC, left_down, [{userData,Target}]), wxWindow:connect(TC, enter_window), wxWindow:connect(TC, leave_window), - ToolTip = wxToolTip:new("Click to see properties for " ++ Str), + ToolTip = wxToolTip:new(ToolTipText), wxWindow:setToolTip(TC, ToolTip), TC. @@ -708,6 +745,11 @@ wait_for_progress() -> destroy_progress_dialog() -> report_progress(finish). +sync_destroy_progress_dialog() -> + Ref = erlang:monitor(process,?progress_handler), + destroy_progress_dialog(), + receive {'DOWN',Ref,process,_,_} -> ok end. + report_progress(Progress) -> case whereis(?progress_handler) of Pid when is_pid(Pid) -> @@ -787,9 +829,8 @@ progress_dialog_new(Parent,Title,Str) -> [{style,?wxDEFAULT_DIALOG_STYLE}]), Panel = wxPanel:new(Dialog), Sizer = wxBoxSizer:new(?wxVERTICAL), - Message = wxStaticText:new(Panel, 1, Str), - Gauge = wxGauge:new(Panel, 2, 100, [{size, {170, -1}}, - {style, ?wxGA_HORIZONTAL}]), + Message = wxStaticText:new(Panel, 1, Str,[{size,{220,-1}}]), + Gauge = wxGauge:new(Panel, 2, 100, [{style, ?wxGA_HORIZONTAL}]), SizerFlags = ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT bor ?wxTOP, wxSizer:add(Sizer, Message, [{flag,SizerFlags},{border,15}]), wxSizer:add(Sizer, Gauge, [{flag, SizerFlags bor ?wxBOTTOM},{border,15}]), diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 5908e99e36..f7ae07fb85 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -242,6 +242,10 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> observer ! {open_link, TargetPid}, {noreply, State}; diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index 2e5fe0bc1a..d612e0a1c5 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -27,7 +27,7 @@ handle_event/2, handle_cast/2]). -include_lib("wx/include/wx.hrl"). --include("../include/etop.hrl"). +-include("etop.hrl"). -include("observer_defs.hrl"). -include("etop_defs.hrl"). diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 4ce38e439d..4d3f306a0a 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -120,6 +120,10 @@ handle_event(#wx{id=?REFRESH}, #state{frame=Frame, pid=Pid, pages=Pages, expand_ end, {noreply, State}; +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> observer ! {open_link, TargetPid}, {noreply, State}; diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index bb1755f530..b5e94a893a 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -83,6 +83,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> link(OtherPid), % own node link(Pid2), % external node erlang:monitor(process,OtherPid), + erlang:monitor(process,init), % named process erlang:monitor(process,Pid2), code:load_file(?MODULE), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 9fbd1a62a4..32773a779e 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -459,6 +459,27 @@ special(File,Procs) -> old_attrib=undefined, old_comp_info=undefined}=Mod2, ok; + ".trunc_mod" -> + ModName = atom_to_list(?helper_mod), + {ok,Mod=#loaded_mod{},[TW]} = + crashdump_viewer:loaded_mod_details(ModName), + "WARNING: The crash dump is truncated here."++_ = TW, + #loaded_mod{current_attrib=CA,current_comp_info=CCI, + old_attrib=OA,old_comp_info=OCI} = Mod, + case lists:all(fun(undefined) -> + true; + (S) when is_list(S) -> + io_lib:printable_unicode_list(lists:flatten(S)); + (_) -> false + end, + [CA,CCI,OA,OCI]) of + true -> + ok; + false -> + ct:fail({should_be_printable_strings_or_undefined, + {CA,CCI,OA,OCI}}) + end, + ok; ".trunc_bin1" -> %% This is 'full_dist' truncated after the first %% "=binary:" @@ -658,13 +679,32 @@ do_create_dumps(DataDir,Rel) -> CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"), CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), CD7 = dump_with_maps(DataDir,Rel,"maps"), - TruncatedDumps = truncate_dump(CD1), - {[CD1,CD2,CD3,CD4,CD5,CD6,CD7|TruncatedDumps], DosDump}; + TruncDumpMod = truncate_dump_mod(CD1), + TruncatedDumpsBinary = truncate_dump_binary(CD1), + {[CD1,CD2,CD3,CD4,CD5,CD6,CD7,TruncDumpMod|TruncatedDumpsBinary], + DosDump}; _ -> {[CD1,CD2], DosDump} end. -truncate_dump(File) -> +truncate_dump_mod(File) -> + {ok,Bin} = file:read_file(File), + ModNameBin = atom_to_binary(?helper_mod,latin1), + NewLine = case os:type() of + {win32,_} -> <<"\r\n">>; + _ -> <<"\n">> + end, + RE = <<NewLine/binary,"=mod:",ModNameBin/binary, + NewLine/binary,"Current size: [0-9]*", + NewLine/binary,"Current attributes: ...">>, + {match,[{Pos,Len}]} = re:run(Bin,RE), + Size = Pos + Len, + <<Truncated:Size/binary,_/binary>> = Bin, + DumpName = filename:rootname(File) ++ ".trunc_mod", + file:write_file(DumpName,Truncated), + DumpName. + +truncate_dump_binary(File) -> {ok,Bin} = file:read_file(File), BinTag = <<"\n=binary:">>, Colon = <<":">>, diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 92109c9a74..119d7cc3d4 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -75,43 +75,37 @@ load_report(file, File) -> load_report(data, from_file(File)); load_report(data, Report) -> ok = start_internal(), gen_server:call(?SERVER, {load_report, Report}, infinity). -report() -> [ - {init_arguments, init:get_arguments()}, - {code_paths, code:get_path()}, - {code, code()}, - {system_info, erlang_system_info()}, - {erts_compile_info, erlang:system_info(compile_info)}, - {beam_dynamic_libraries, get_dynamic_libraries()}, - {environment_erts, os_getenv_erts_specific()}, - {environment, [split_env(Env) || Env <- os:getenv()]}, - {sanity_check, sanity_check()} - ]. +report() -> + %% This is ugly but beats having to maintain two distinct implementations, + %% and we don't really care about memory use since it's internal and + %% undocumented. + {ok, Fd} = file:open([], [ram, read, write]), + to_fd(Fd), + {ok, _} = file:position(Fd, bof), + from_fd(Fd). -spec to_file(FileName) -> ok | {error, Reason} when FileName :: file:name_all(), Reason :: file:posix() | badarg | terminated | system_limit. to_file(File) -> - file:write_file(File, iolist_to_binary([ - io_lib:format("{system_information_version, ~p}.~n", [ - ?REPORT_FILE_VSN - ]), - io_lib:format("{system_information, ~p}.~n", [ - report() - ]) - ])). + case file:open(File, [raw, write, binary, delayed_write]) of + {ok, Fd} -> + try + to_fd(Fd) + after + file:close(Fd) + end; + {error, Reason} -> + {error, Reason} + end. from_file(File) -> - case file:consult(File) of - {ok, Data} -> - case get_value([system_information_version], Data) of - ?REPORT_FILE_VSN -> - get_value([system_information], Data); - Vsn -> - erlang:error({unknown_version, Vsn}) - end; - _ -> - erlang:error(bad_report_file) + {ok, Fd} = file:open(File, [raw, read]), + try + from_fd(Fd) + after + file:close(Fd) end. applications() -> applications([]). @@ -457,61 +451,151 @@ split_env([$=|Vs], Key) -> {lists:reverse(Key), Vs}; split_env([I|Vs], Key) -> split_env(Vs, [I|Key]); split_env([], KV) -> lists:reverse(KV). % should not happen. -%% get applications +from_fd(Fd) -> + try + [{system_information_version, "1.0"}, + {system_information, Data}] = consult_fd(Fd), + Data + catch + _:_ -> erlang:error(bad_report_file) + end. -code() -> - % order is important - get_code_from_paths(code:get_path()). +consult_fd(Fd) -> + consult_fd_1(Fd, [], {ok, []}). +consult_fd_1(Fd, Cont0, ReadResult) -> + Data = + case ReadResult of + {ok, Characters} -> Characters; + eof -> eof + end, + case erl_scan:tokens(Cont0, Data, 1) of + {done, {ok, Tokens, _}, Next} -> + {ok, Term} = erl_parse:parse_term(Tokens), + [Term | consult_fd_1(Fd, [], {ok, Next})]; + {more, Cont} -> + consult_fd_1(Fd, Cont, file:read(Fd, 1 bsl 20)); + {done, {eof, _}, eof} -> [] + end. -get_code_from_paths([]) -> []; -get_code_from_paths([Path|Paths]) -> - case is_application_path(Path) of - true -> - [{application, get_application_from_path(Path)}|get_code_from_paths(Paths)]; - false -> - [{code, [ - {path, Path}, - {modules, get_modules_from_path(Path)} - ]}|get_code_from_paths(Paths)] +%% +%% Dumps a system_information tuple to the given Fd, writing the term in chunks +%% to avoid eating too much memory on large systems. +%% + +to_fd(Fd) -> + EmitChunk = + fun(Format, Args) -> + ok = file:write(Fd, io_lib:format(Format, Args)) + end, + + EmitChunk("{system_information_version, ~p}.~n" + "{system_information,[" + "{init_arguments,~p}," + "{code_paths,~p},", + [?REPORT_FILE_VSN, + init:get_arguments(), + code:get_path()]), + + emit_code_info(EmitChunk), + + EmitChunk( "," %% Note the leading comma! + "{system_info,~p}," + "{erts_compile_info,~p}," + "{beam_dynamic_libraries,~p}," + "{environment_erts,~p}," + "{environment,~p}," + "{sanity_check,~p}" + "]}.~n", + [erlang_system_info(), + erlang:system_info(compile_info), + get_dynamic_libraries(), + os_getenv_erts_specific(), + [split_env(Env) || Env <- os:getenv()], + sanity_check()]). + +%% Emits all modules/applications in the *code path order* +emit_code_info(EmitChunk) -> + EmitChunk("{code, [", []), + comma_separated_foreach(EmitChunk, + fun(Path) -> + case is_application_path(Path) of + true -> emit_application_info(EmitChunk, Path); + false -> emit_code_path_info(EmitChunk, Path) + end + end, code:get_path()), + EmitChunk("]}", []). + +emit_application_info(EmitChunk, Path) -> + [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), + case file:consult(Appfile) of + {ok, [{application, App, Info}]} -> + RtDeps = proplists:get_value(runtime_dependencies, Info, []), + Description = proplists:get_value(description, Info, []), + Version = proplists:get_value(vsn, Info, []), + + EmitChunk("{application, {~p,[" + "{description,~p}," + "{vsn,~p}," + "{path,~p}," + "{runtime_dependencies,~p},", + [App, Description, Version, Path, RtDeps]), + emit_module_info_from_path(EmitChunk, Path), + EmitChunk("]}}", []) end. +emit_code_path_info(EmitChunk, Path) -> + EmitChunk("{code, [" + "{path, ~p},", [Path]), + emit_module_info_from_path(EmitChunk, Path), + EmitChunk("]}", []). + +emit_module_info_from_path(EmitChunk, Path) -> + BeamFiles = filelib:wildcard(filename:join(Path, "*.beam")), + + EmitChunk("{modules, [", []), + comma_separated_foreach(EmitChunk, + fun(Beam) -> + emit_module_info(EmitChunk, Beam) + end, BeamFiles), + EmitChunk("]}", []). + +emit_module_info(EmitChunk, Beam) -> + %% FIXME: The next three calls load *all* significant chunks onto the heap, + %% which may cause us to run out of memory if there's a huge module in the + %% code path. + {ok,{Mod, Md5}} = beam_lib:md5(Beam), + + CompilerVersion = get_compiler_version(Beam), + Native = beam_is_native_compiled(Beam), + + Loaded = case code:is_loaded(Mod) of + false -> false; + _ -> true + end, + + EmitChunk("{~p,[" + "{loaded,~p}," + "{native,~p}," + "{compiler,~p}," + "{md5,~p}" + "]}", + [Mod, Loaded, Native, CompilerVersion, hexstring(Md5)]). + +comma_separated_foreach(_EmitChunk, _Fun, []) -> + ok; +comma_separated_foreach(_EmitChunk, Fun, [H]) -> + Fun(H); +comma_separated_foreach(EmitChunk, Fun, [H | T]) -> + Fun(H), + EmitChunk(",", []), + comma_separated_foreach(EmitChunk, Fun, T). + is_application_path(Path) -> case filelib:wildcard(filename:join(Path, "*.app")) of [] -> false; _ -> true end. -get_application_from_path(Path) -> - [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), - case file:consult(Appfile) of - {ok, [{application, App, Info}]} -> - {App, [ - {description, proplists:get_value(description, Info, [])}, - {vsn, proplists:get_value(vsn, Info, [])}, - {path, Path}, - {runtime_dependencies, - proplists:get_value(runtime_dependencies, Info, [])}, - {modules, get_modules_from_path(Path)} - ]} - end. - -get_modules_from_path(Path) -> - [ - begin - {ok,{Mod, Md5}} = beam_lib:md5(Beam), - Loaded = case code:is_loaded(Mod) of - false -> false; - _ -> true - end, - {Mod, [ - {loaded, Loaded}, - {native, beam_is_native_compiled(Beam)}, - {compiler, get_compiler_version(Beam)}, - {md5, hexstring(Md5)} - ]} - end || Beam <- filelib:wildcard(filename:join(Path, "*.beam")) - ]. - hexstring(Bin) when is_binary(Bin) -> lists:flatten([io_lib:format("~2.16.0b", [V]) || <<V>> <= Bin]). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 154894cda8..ad9efc4755 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -54,7 +54,7 @@ sha/1, sign/3, verify/5]). %%% For test suites --export([pack/3]). +-export([pack/3, adjust_algs_for_peer_version/2]). -export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove -define(Estring(X), ?STRING((if is_binary(X) -> X; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index a18383d148..21359a0386 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -37,6 +37,7 @@ MODULES= \ ssh_renegotiate_SUITE \ ssh_basic_SUITE \ ssh_bench_SUITE \ + ssh_compat_SUITE \ ssh_connection_SUITE \ ssh_engine_SUITE \ ssh_protocol_SUITE \ diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl new file mode 100644 index 0000000000..74ab5aca3a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -0,0 +1,814 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_compat_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). % #ssh_msg_kexinit{} +-include_lib("kernel/include/inet.hrl"). % #hostent{} +-include_lib("kernel/include/file.hrl"). % #file_info{} +-include("ssh_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(USER,"sshtester"). +-define(PWD, "foobar"). +-define(DOCKER_PFX, "ssh_compat_suite-ssh"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [%%{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,40}}]. + +all() -> + [{group,G} || G <- vers()]. + +groups() -> + [{G, [], tests()} || G <- vers()]. + +tests() -> + [login_with_password_otp_is_client, + login_with_password_otp_is_server, + login_with_keyboard_interactive_otp_is_client, + login_with_keyboard_interactive_otp_is_server, + login_with_all_public_keys_otp_is_client, + login_with_all_public_keys_otp_is_server, + all_algorithms_otp_is_client, + all_algorithms_otp_is_server + ]. + + + +vers() -> + try + %% Find all useful containers in such a way that undefined command, too low + %% priviliges, no containers and containers found give meaningful result: + L0 = ["REPOSITORY"++_|_] = string:tokens(os:cmd("docker images"), "\r\n"), + [["REPOSITORY","TAG"|_]|L1] = [string:tokens(E, " ") || E<-L0], + [list_to_atom(V) || [?DOCKER_PFX,V|_] <- L1] + of + Vs -> + lists:sort(Vs) + catch + error:{badmatch,_} -> + [] + end. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ?CHECK_CRYPTO( + case os:find_executable("docker") of + false -> + {skip, "No docker"}; + _ -> + ssh:start(), + ct:log("Crypto info: ~p",[crypto:info_lib()]), + Config + end). + +end_per_suite(Config) -> + %% Remove all containers that are not running: +%%% os:cmd("docker rm $(docker ps -aq -f status=exited)"), + %% Remove dangling images: +%%% os:cmd("docker rmi $(docker images -f dangling=true -q)"), + Config. + + + +init_per_group(G, Config) -> + case lists:member(G, vers()) of + true -> + try start_docker(G) of + {ok,ID} -> + ct:log("==> ~p",[G]), + [Vssh|VsslRest] = string:tokens(atom_to_list(G), "-"), + Vssl = lists:flatten(lists:join($-,VsslRest)), + ct:comment("+++ ~s + ~s +++",[Vssh,Vssl]), + %% Find the algorithms that both client and server supports: + {IP,Port} = ip_port([{id,ID}]), + try common_algs([{id,ID}|Config], IP, Port) of + {ok, RemoteServerCommon, RemoteClientCommon} -> + [{ssh_version,Vssh},{ssl_version,Vssl}, + {id,ID}, + {common_server_algs,RemoteServerCommon}, + {common_client_algs,RemoteClientCommon} + |Config]; + Other -> + ct:log("Error in init_per_group: ~p",[Other]), + stop_docker(ID), + {fail, "Can't contact docker sshd"} + catch + Class:Exc -> + ST = erlang:get_stacktrace(), + ct:log("common_algs: ~p:~p~n~p",[Class,Exc,ST]), + stop_docker(ID), + {fail, "Failed during setup"} + end + catch + cant_start_docker -> + {skip, "Can't start docker"}; + + C:E -> + ST = erlang:get_stacktrace(), + ct:log("No ~p~n~p:~p~n~p",[G,C,E,ST]), + {skip, "Can't start docker"} + end; + + false -> + Config + end. + +end_per_group(_, Config) -> + catch stop_docker(proplists:get_value(id,Config)), + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +login_with_password_otp_is_client(Config) -> + {IP,Port} = ip_port(Config), + {ok,C} = ssh:connect(IP, Port, [{auth_methods,"password"}, + {user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + ssh:close(C). + +%%-------------------------------------------------------------------- +login_with_password_otp_is_server(Config) -> + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods,"password"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, new_dir(Config)}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+2]).\r\n'", + [<<"Answer=3">>], + ""), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +login_with_keyboard_interactive_otp_is_client(Config) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{auth_methods,"keyboard-interactive"}, + {user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + ssh:close(C). + +%%-------------------------------------------------------------------- +login_with_keyboard_interactive_otp_is_server(Config) -> + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods,"keyboard-interactive"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, new_dir(Config)}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+3]).\r\n'", + [<<"Answer=4">>], + ""), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +login_with_all_public_keys_otp_is_client(Config) -> + CommonAlgs = [{public_key_from_host,A} + || {public_key,A} <- proplists:get_value(common_server_algs, Config)], + {DockerIP,DockerPort} = ip_port(Config), + chk_all_algos(CommonAlgs, Config, + fun(_Tag,Alg) -> + ssh:connect(DockerIP, DockerPort, + [{auth_methods, "publickey"}, + {user, ?USER}, + {user_dir, setup_remote_auth_keys_and_local_priv(Alg, Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) + end). + +%%-------------------------------------------------------------------- +login_with_all_public_keys_otp_is_server(Config) -> + CommonAlgs = [{public_key_to_host,A} + || {public_key,A} <- proplists:get_value(common_client_algs, Config)], + UserDir = new_dir(Config), + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods, "publickey"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, UserDir}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + + R = chk_all_algos(CommonAlgs, Config, + fun(_Tag,Alg) -> + setup_remote_priv_and_local_auth_keys(Alg, clear_dir(UserDir), Config), + exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+4]).\r\n'", + [<<"Answer=5">>], + "") + end), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +all_algorithms_otp_is_client(Config) -> + CommonAlgs = proplists:get_value(common_server_algs, Config), + {IP,Port} = ip_port(Config), + chk_all_algos(CommonAlgs, Config, + fun(Tag, Alg) -> + ssh:connect(IP, Port, [{user,?USER}, + {password,?PWD}, + {auth_methods, "password"}, + {user_dir, new_dir(Config)}, + {preferred_algorithms, [{Tag,[Alg]}]}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) + end). + +%%-------------------------------------------------------------------- +all_algorithms_otp_is_server(Config) -> + CommonAlgs = proplists:get_value(common_client_algs, Config), + UserDir = setup_remote_priv_and_local_auth_keys('ssh-rsa', Config), + chk_all_algos(CommonAlgs, Config, + fun(Tag,Alg) -> + HostKeyAlg = case Tag of + public_key -> Alg; + _ -> 'ssh-rsa' + end, + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{preferred_algorithms, [{Tag,[Alg]}]}, + {system_dir, setup_local_hostdir(HostKeyAlg, Config)}, + {user_dir, UserDir}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "hi_there.\r\n", + [<<"hi_there">>], + ""), + ssh:stop_daemon(Server), + R + end). + +%%-------------------------------------------------------------------- +%% Utilities --------------------------------------------------------- +%%-------------------------------------------------------------------- +exec_from_docker(WhatEver, {0,0,0,0}, HostPort, Command, Expects, ExtraSshArg) -> + exec_from_docker(WhatEver, host_ip(), HostPort, Command, Expects, ExtraSshArg); + +exec_from_docker(Config, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)), + is_list(Config) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + R = exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg), + ssh:close(C), + R; + +exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)) -> + SSH_from_docker = + lists:concat(["sshpass -p ",?PWD," ", + "/buildroot/ssh/bin/ssh -p ",HostPort," -o 'CheckHostIP=no' -o 'StrictHostKeyChecking=no' ", + ExtraSshArg," ", + inet_parse:ntoa(HostIP)," " + ]), + ExecCommand = SSH_from_docker ++ Command, + R = exec(C, ExecCommand), + case R of + {ok,{ExitStatus,Result}} when ExitStatus == 0 -> + case binary:match(Result, Expects) of + nomatch -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Bad answer"}; + _ -> + ok + end; + {ok,_} -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Exit status =/= 0"}; + _ -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Couldn't login to host"} + end. + + + + +exec(C, Cmd) -> + ct:log("~s",[Cmd]), + {ok,Ch} = ssh_connection:session_channel(C, 10000), + success = ssh_connection:exec(C, Ch, Cmd, 10000), + exec_result(C, Ch). + + +exec_result(C, Ch) -> + exec_result(C, Ch, undefined, <<>>). + +exec_result(C, Ch, ExitStatus, Acc) -> + receive + {ssh_cm,C,{closed,Ch}} -> + %%ct:log("CHAN ~p got *closed*",[Ch]), + {ok, {ExitStatus, Acc}}; + + {ssh_cm,C,{exit_status,Ch,ExStat}} when ExitStatus == undefined -> + %%ct:log("CHAN ~p got *exit status ~p*",[Ch,ExStat]), + exec_result(C, Ch, ExStat, Acc); + + {ssh_cm,C,{data,Ch,_,Data}=_X} when ExitStatus == undefined -> + %%ct:log("CHAN ~p got ~p",[Ch,_X]), + exec_result(C, Ch, ExitStatus, <<Acc/binary, Data/binary>>); + + _Other -> + %%ct:log("OTHER: ~p",[_Other]), + exec_result(C, Ch, ExitStatus, Acc) + + after 5000 -> + %%ct:log("NO MORE, received so far:~n~s",[Acc]), + {error, timeout} + end. + + +chk_all_algos(CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> + ct:comment("~p algorithms",[length(CommonAlgs)]), + %% Check each algorithm + Failed = + lists:foldl( + fun({Tag,Alg}, FailedAlgos) -> + ct:log("Try ~p",[Alg]), + case DoTestFun(Tag,Alg) of + {ok,C} -> + ssh:close(C), + FailedAlgos; + ok -> + FailedAlgos; + Other -> + ct:log("FAILED! ~p ~p: ~p",[Tag,Alg,Other]), + [Alg|FailedAlgos] + end + end, [], CommonAlgs), + ct:pal("~s", [format_result_table_use_all_algos(Config, CommonAlgs, Failed)]), + case Failed of + [] -> + ok; + _ -> + {fail, Failed} + end. + +setup_local_hostdir(KeyAlg, Config) -> + setup_local_hostdir(KeyAlg, new_dir(Config), Config). +setup_local_hostdir(KeyAlg, HostDir, Config) -> + {ok, {Priv,Publ}} = host_priv_pub_keys(Config, KeyAlg), + %% Local private and public key + DstFile = filename:join(HostDir, dst_filename(host,KeyAlg)), + ok = file:write_file(DstFile, Priv), + ok = file:write_file(DstFile++".pub", Publ), + HostDir. + + +setup_remote_auth_keys_and_local_priv(KeyAlg, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, UserDir, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, Config) -> + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config) -> + {ok, {Priv,Publ}} = user_priv_pub_keys(Config, KeyAlg), + %% Local private and public keys + DstFile = filename:join(UserDir, dst_filename(user,KeyAlg)), + ok = file:write_file(DstFile, Priv), + ok = file:write_file(DstFile++".pub", Publ), + %% Remote auth_methods with public key + {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, + {password, ?PWD }, + {auth_methods, "password"}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + _ = ssh_sftp:make_dir(Ch, ".ssh"), + ok = ssh_sftp:write_file(Ch, ".ssh/authorized_keys", Publ), + ok = ssh_sftp:write_file_info(Ch, ".ssh/authorized_keys", #file_info{mode=8#700}), + ok = ssh_sftp:write_file_info(Ch, ".ssh", #file_info{mode=8#700}), + ok = ssh_sftp:stop_channel(Ch), + ok = ssh:close(Cc), + UserDir. + + +setup_remote_priv_and_local_auth_keys(KeyAlg, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, UserDir, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, Config) -> + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config) -> + {ok, {Priv,Publ}} = user_priv_pub_keys(Config, KeyAlg), + %% Local auth_methods with public key + AuthKeyFile = filename:join(UserDir, "authorized_keys"), + ok = file:write_file(AuthKeyFile, Publ), + %% Remote private and public key + {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, + {password, ?PWD }, + {auth_methods, "password"}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + _ = ssh_sftp:make_dir(Ch, ".ssh"), + DstFile = filename:join(".ssh", dst_filename(user,KeyAlg)), + ok = ssh_sftp:write_file(Ch, DstFile, Priv), + ok = ssh_sftp:write_file_info(Ch, DstFile, #file_info{mode=8#700}), + ok = ssh_sftp:write_file(Ch, DstFile++".pub", Publ), + ok = ssh_sftp:write_file_info(Ch, ".ssh", #file_info{mode=8#700}), + ok = ssh_sftp:stop_channel(Ch), + ok = ssh:close(Cc), + UserDir. + +user_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("users_keys", user, Config, KeyAlg). +host_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("host_keys", host, Config, KeyAlg). + +priv_pub_keys(KeySubDir, Type, Config, KeyAlg) -> + KeyDir = filename:join(proplists:get_value(data_dir,Config), KeySubDir), + {ok,Priv} = file:read_file(filename:join(KeyDir,src_filename(Type,KeyAlg))), + {ok,Publ} = file:read_file(filename:join(KeyDir,src_filename(Type,KeyAlg)++".pub")), + {ok, {Priv,Publ}}. + + +src_filename(user, 'ssh-rsa' ) -> "id_rsa"; +src_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; +src_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; +src_filename(user, 'ssh-dss' ) -> "id_dsa"; +src_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa256"; +src_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa384"; +src_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa521"; +src_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +src_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +src_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +src_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +src_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key256"; +src_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key384"; +src_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key521". + +dst_filename(user, 'ssh-rsa' ) -> "id_rsa"; +dst_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; +dst_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; +dst_filename(user, 'ssh-dss' ) -> "id_dsa"; +dst_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa"; +dst_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa"; +dst_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa"; +dst_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key". + + +format_result_table_use_all_algos(Config, CommonAlgs, Failed) -> + %% Write a nice table with the result + AlgHead = 'Algorithm', + AlgWidth = lists:max([length(atom_to_list(A)) || {_,A} <- CommonAlgs]), + {ResultTable,_} = + lists:mapfoldl( + fun({T,A}, Tprev) -> + Tag = case T of + Tprev -> ""; + _ -> io_lib:format('~s~n',[T]) + end, + {io_lib:format('~s ~*s ~s~n', + [Tag, -AlgWidth, A, + case lists:member(A,Failed) of + true -> "<<<< FAIL <<<<"; + false-> "(ok)" + end]), + T} + end, undefined, CommonAlgs), + + Vssh = proplists:get_value(ssh_version,Config,""), + Vssl = proplists:get_value(ssl_version,Config,""), + io_lib:format("~nResults, Peer versions: ~s and ~s~n" + "Tag ~*s Result~n" + "=====~*..=s=======~n~s" + ,[Vssh,Vssl, + -AlgWidth,AlgHead, + AlgWidth, "", ResultTable]). + + +start_docker(Ver) -> + Cmnd = lists:concat(["docker run -itd --rm -p 1234 ",?DOCKER_PFX,":",Ver]), + Id0 = os:cmd(Cmnd), + ct:log("Ver = ~p, Cmnd ~p~n-> ~p",[Ver,Cmnd,Id0]), + case is_docker_sha(Id0) of + true -> + Id = hd(string:tokens(Id0, "\n")), + IP = ip(Id), + Port = 1234, + {ok, {Ver,{IP,Port},Id}}; + false -> + throw(cant_start_docker) + end. + + +stop_docker({_Ver,_,Id}) -> + Cmnd = lists:concat(["docker kill ",Id]), + os:cmd(Cmnd). + +is_docker_sha(L) -> + lists:all(fun(C) when $a =< C,C =< $z -> true; + (C) when $0 =< C,C =< $9 -> true; + ($\n) -> true; + (_) -> false + end, L). + +ip_port(Config) -> + {_Ver,{IP,Port},_} = proplists:get_value(id,Config), + {IP,Port}. + +port_mapped_to(Id) -> + Cmnd = lists:concat(["docker ps --format \"{{.Ports}}\" --filter id=",Id]), + [_, PortStr | _] = string:tokens(os:cmd(Cmnd), ":->/"), + list_to_integer(PortStr). + +ip(Id) -> + Cmnd = lists:concat(["docker inspect --format='{{range .NetworkSettings.Networks}}{{.IPAddress}}{{end}}' ", + Id]), + IPstr0 = os:cmd(Cmnd), + ct:log("Cmnd ~p~n-> ~p",[Cmnd,IPstr0]), + IPstr = hd(string:tokens(IPstr0, "\n")), + {ok,IP} = inet:parse_address(IPstr), + IP. + +new_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + SubDirName = integer_to_list(erlang:system_time()), + Dir = filename:join(PrivDir, SubDirName), + case file:read_file_info(Dir) of + {error,enoent} -> + ok = file:make_dir(Dir), + Dir; + _ -> + timer:sleep(25), + new_dir(Config) + end. + +clear_dir(Dir) -> + delete_all_contents(Dir), + {ok,[]} = file:list_dir(Dir), + Dir. + +delete_all_contents(Dir) -> + {ok,Fs} = file:list_dir(Dir), + lists:map(fun(F0) -> + F = filename:join(Dir, F0), + case filelib:is_file(F) of + true -> + file:delete(F); + false -> + case filelib:is_dir(F) of + true -> + delete_all_contents(F), + file:del_dir(F); + false -> + ct:log("Neither file nor dir: ~p",[F]) + end + end + end, Fs). + +common_algs(Config, IP, Port) -> + case remote_server_algs(IP, Port) of + {ok, {RemoteHelloBin, RemoteServerKexInit}} -> + case remote_client_algs(Config) of + {ok,{_Hello,RemoteClientKexInit}} -> + RemoteServerAlgs = kexint_msg2default_algorithms(RemoteServerKexInit), + Server = find_common_algs(RemoteServerAlgs, + use_algorithms(RemoteHelloBin)), + RemoteClientAlgs = kexint_msg2default_algorithms(RemoteClientKexInit), + Client = find_common_algs(RemoteClientAlgs, + use_algorithms(RemoteHelloBin)), + ct:log("Docker server algorithms:~n ~p~n~nDocker client algorithms:~n ~p", + [RemoteServerAlgs,RemoteClientAlgs]), + {ok, Server, Client}; + Other -> + Other + end; + Other -> + Other + end. + + +find_common_algs(Remote, Local) -> + [{T,V} || {T,Vs} <- ssh_test_lib:extract_algos( + ssh_test_lib:intersection(Remote, + Local)), + V <- Vs]. + + +use_algorithms(RemoteHelloBin) -> + MyAlgos = ssh:chk_algos_opts( + [{modify_algorithms, + [{append, + [{kex,['diffie-hellman-group1-sha1']} + ]} + ]} + ]), + ssh_transport:adjust_algs_for_peer_version(binary_to_list(RemoteHelloBin)++"\r\n", + MyAlgos). + +kexint_msg2default_algorithms(#ssh_msg_kexinit{kex_algorithms = Kex, + server_host_key_algorithms = PubKey, + encryption_algorithms_client_to_server = CipherC2S, + encryption_algorithms_server_to_client = CipherS2C, + mac_algorithms_client_to_server = MacC2S, + mac_algorithms_server_to_client = MacS2C, + compression_algorithms_client_to_server = CompC2S, + compression_algorithms_server_to_client = CompS2C + }) -> + [{kex, ssh_test_lib:to_atoms(Kex)}, + {public_key, ssh_test_lib:to_atoms(PubKey)}, + {cipher, [{client2server,ssh_test_lib:to_atoms(CipherC2S)}, + {server2client,ssh_test_lib:to_atoms(CipherS2C)}]}, + {mac, [{client2server,ssh_test_lib:to_atoms(MacC2S)}, + {server2client,ssh_test_lib:to_atoms(MacS2C)}]}, + {compression, [{client2server,ssh_test_lib:to_atoms(CompC2S)}, + {server2client,ssh_test_lib:to_atoms(CompS2C)}]}]. + + + +remote_server_algs(IP, Port) -> + case try_gen_tcp_connect(IP, Port, 5) of + {ok,S} -> + ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), + receive_hello(S, <<>>); + {error,Error} -> + {error,Error} + end. + +try_gen_tcp_connect(IP, Port, N) when N>0 -> + case gen_tcp:connect(IP, Port, [binary]) of + {ok,S} -> + {ok,S}; + {error,_Error} when N>1 -> + receive after 1000 -> ok end, + try_gen_tcp_connect(IP, Port, N-1); + {error,Error} -> + {error,Error} + end; +try_gen_tcp_connect(_, _, _) -> + {error, "No contact"}. + + +remote_client_algs(Config) -> + Parent = self(), + Ref = make_ref(), + spawn( + fun() -> + {ok,Sl} = gen_tcp:listen(0, [binary]), + {ok,{IP,Port}} = inet:sockname(Sl), + Parent ! {addr,Ref,IP,Port}, + {ok,S} = gen_tcp:accept(Sl), + ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), + Parent ! {Ref,receive_hello(S, <<>>)} + end), + receive + {addr,Ref,IP,Port} -> + spawn(fun() -> + exec_from_docker(Config, IP, Port, + "howdy.\r\n", + [<<"howdy">>], + "") + end), + receive + {Ref, Result} -> + Result + after 15000 -> + {error, timeout2} + end + after 15000 -> + {error, timeout1} + end. + + + +receive_hello(S, Ack) -> + %% The Ack is to collect bytes until the full message is received + receive + {tcp, S, Bin0} when is_binary(Bin0) -> + case binary:split(<<Ack/binary, Bin0/binary>>, [<<"\r\n">>,<<"\r">>,<<"\n">>]) of + [Hello = <<"SSH-2.0-",_/binary>>, NextPacket] -> + ct:log("Got 2.0 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + {ok, {Hello, receive_kexinit(S, NextPacket)}}; + + [Hello = <<"SSH-1.99-",_/binary>>, NextPacket] -> + ct:comment("Old SSH ~s",["1.99"]), + ct:log("Got 1.99 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + {ok, {Hello, receive_kexinit(S, NextPacket)}}; + + [Bin] when size(Bin) < 256 -> + ct:log("Got part of hello (~p chars):~n~s~n~s",[size(Bin),Bin, + [io_lib:format('~2.16.0b ',[C]) + || C <- binary_to_list(Bin0) + ] + ]), + receive_hello(S, Bin0); + + _ -> + ct:log("Bad hello string (line ~p, ~p chars):~n~s~n~s",[?LINE,size(Bin0),Bin0, + [io_lib:format('~2.16.0b ',[C]) + || C <- binary_to_list(Bin0) + ] + ]), + ct:fail("Bad hello string received") + end; + Other -> + ct:log("Bad hello string (line ~p):~n~p",[?LINE,Other]), + ct:fail("Bad hello string received") + + after 10000 -> + ct:log("Timeout waiting for hello!~n~s",[Ack]), + throw(timeout) + end. + + +receive_kexinit(_S, <<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) + when PacketLen < 5000, % heuristic max len to stop huge attempts if packet decodeing get out of sync + size(PayloadAndPadding) >= (PacketLen-1) % Need more bytes? + -> + ct:log("Has all ~p packet bytes",[PacketLen]), + PayloadLen = PacketLen - PaddingLen - 1, + <<Payload:PayloadLen/binary, _Padding:PaddingLen/binary>> = PayloadAndPadding, + ssh_message:decode(Payload); + +receive_kexinit(S, Ack) -> + ct:log("Has ~p bytes, need more",[size(Ack)]), + receive + {tcp, S, Bin0} when is_binary(Bin0) -> + receive_kexinit(S, <<Ack/binary, Bin0/binary>>); + Other -> + ct:log("Bad hello string (line ~p):~n~p",[?LINE,Other]), + ct:fail("Bad hello string received") + + after 10000 -> + ct:log("Timeout waiting for kexinit!~n~s",[Ack]), + throw(timeout) + end. + + + +host_ip() -> + {ok,Name} = inet:gethostname(), + {ok,#hostent{h_addr_list = [IP|_]}} = inet_res:gethostbyname(Name), + IP. + + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image new file mode 100755 index 0000000000..1cb7bf33e1 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image @@ -0,0 +1,38 @@ +#!/bin/sh + +UBUNTU_VER=${1:-16.04} + +USER=sshtester +PWD=foobar + +docker build \ + -t ubuntubuildbase \ + --build-arg https_proxy=$HTTPS_PROXY \ + --build-arg http_proxy=$HTTP_PROXY \ + - <<EOF + + FROM ubuntu:$UBUNTU_VER + WORKDIR /buildroot + + # Prepare for installing OpenSSH + RUN apt-get update + RUN apt-get upgrade -y + RUN apt-get -y install apt-utils + RUN apt-get -y install build-essential zlib1g-dev + RUN apt-get -y install sudo iputils-ping tcptraceroute net-tools + RUN apt-get -y install sshpass expect + RUN apt-get -y install libpam0g-dev + + # A user for the tests + RUN (echo $PWD; echo $PWD; echo; echo; echo; echo; echo; echo ) | adduser $USER + RUN adduser $USER sudo + + # Prepare the privsep preauth environment for openssh + RUN mkdir -p /var/empty + RUN chown root:sys /var/empty + RUN chmod 755 /var/empty + RUN groupadd -f sshd + RUN ls /bin/false + RUN id -u sshd 2> /dev/null || useradd -g sshd -c 'sshd privsep' -d /var/empty -s /bin/false sshd + +EOF diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image new file mode 100755 index 0000000000..983c57b18b --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image @@ -0,0 +1,71 @@ +#!/bin/sh + +# ./create-image openssh 7.3p1 openssl 1.0.2m + +set -x + +case $1 in + openssh) + FAMssh=openssh + VERssh=$2 + PFX=https://ftp.eu.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + *) + echo "Unsupported: $1" + exit +esac + +FAMssl=$3 +VERssl=$4 + +VER=${FAMssh}${VERssh}-${FAMssl}${VERssl} + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ssh_compat_suite-${FAMssl}:${VERssl} + + LABEL openssh-version=${VER} + + WORKDIR /buildroot + + COPY ${TMP} . + RUN tar xf ${TMP} + + # Build and install + + WORKDIR ${FAMssh}-${VERssh} + + # Probably VERY OpenSSH dependent...: + RUN ./configure --without-pie \ + --prefix=/buildroot/ssh \ + --with-ssl-dir=/buildroot/ssl \ + --with-pam + RUN make + RUN make install + RUN echo UsePAM yes >> /buildroot/ssh/etc/sshd_config + + RUN echo Built ${VER} + + # Start the daemon, but keep it in foreground to avoid killing the container + CMD /buildroot/ssh/sbin/sshd -D -p 1234 + +EOF + +# Fetch the tar file. This could be done in an "ADD ..." in the Dockerfile, +# but then we hit the proxy problem... +wget -O $TMP $PFX$VERssh$SFX + +# Build the image: +docker build -t ssh_compat_suite-ssh:$VER -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image new file mode 100755 index 0000000000..66f8358b8a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image @@ -0,0 +1,61 @@ +#!/bin/sh + +# ./create-image openssl 1.0.2m + +case "$1" in + "openssl") + FAM=openssl + VER=$2 + PFX=https://www.openssl.org/source/openssl- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + "libressl") + FAM=libressl + VER=$2 + PFX=https://ftp.openbsd.org/pub/OpenBSD/LibreSSL/libressl- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + *) + echo No lib type + exit + ;; +esac + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ubuntubuildbase + + LABEL version=$FAM-$VER + + WORKDIR /buildroot + + COPY ${TMP} . + RUN tar xf ${TMP} + + WORKDIR ${FAM}-${VER} + + RUN ./config --prefix=/buildroot/ssl + + RUN make + RUN make install + + RUN echo Built ${FAM}-${VER} +EOF + +# Fetch the tar file. This could be done in an "ADD ..." in the Dockerfile, +# but then we hit the proxy problem... +wget -O $TMP $PFX$VER$SFX + +# Build the image: +docker build -t ssh_compat_suite-$FAM:$VER -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all new file mode 100755 index 0000000000..16b9c21d9f --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all @@ -0,0 +1,87 @@ +#!/bin/bash + +UBUNTU_VERSION=16.04 + +SSH_SSL_VERSIONS=(\ + openssh 4.4p1 openssl 0.9.8zh \ + openssh 4.5p1 openssl 0.9.8zh \ + openssh 5.0p1 openssl 0.9.8zh \ + openssh 6.2p2 openssl 0.9.8zh \ + openssh 6.3p1 openssl 0.9.8zh \ + \ + openssh 7.1p1 openssl 1.0.0t \ + \ + openssh 7.1p1 openssl 1.0.1p \ + \ + openssh 6.6p1 openssl 1.0.2n \ + openssh 7.1p1 openssl 1.0.2n \ + openssh 7.6p1 openssl 1.0.2n \ + ) + +if [ "x$1" == "x-b" ] +then + shift + SKIP_CREATE_BASE=true +fi + +WHAT_TO_DO=$1 + +function create_one_image () +{ + SSH_FAM=$1 + SSH_VER=$2 + SSL_FAM=$3 + SSL_VER=$4 + + [ "x$SKIP_CREATE_BASE" == "xtrue" ] || ./create-base-image || (echo "Create base failed." >&2; exit 1) + ./create-ssl-image $SSL_FAM $SSL_VER \ + || (echo "Create $SSL_FAM $SSL_VER failed." >&2; exit 2) + + ./create-ssh-image $SSH_FAM $SSH_VER $SSL_FAM $SSL_VER \ + || (echo "Create $SSH_FAM $SSH_VER on $SSL_FAM $SSL_VER failed." >&2; exit 3) +} + + +case ${WHAT_TO_DO} in + list) + ;; + listatoms) + PRE="[" + POST="]" + C=\' + COMMA=, + ;; + build_one) + if [ $# != 5 ] + then + echo "$0 build_one openssh SSH_ver openssl SSL_ver " && exit + else + create_one_image $2 $3 $4 $5 + exit + fi + ;; + build_all) + ;; + *) + echo "$0 [-b] list | listatoms | build_one openssh SSH_ver openssl SSL_ver | build_all" && exit + ;; +esac + + +echo -n $PRE +i=0 +while [ "x${SSH_SSL_VERSIONS[i]}" != "x" ] +do + case ${WHAT_TO_DO} in + list*) + [ $i -eq 0 ] || echo $COMMA + echo -n $C${SSH_SSL_VERSIONS[$i]}${SSH_SSL_VERSIONS[$(( $i + 1 ))]}-${SSH_SSL_VERSIONS[$(( $i + 2 ))]}${SSH_SSL_VERSIONS[$(( $i + 3 ))]}$C + ;; + build_all) + create_one_image ${SSH_SSL_VERSIONS[$i]} ${SSH_SSL_VERSIONS[$(( $i + 1 ))]} ${SSH_SSL_VERSIONS[$(( $i + 2 ))]} ${SSH_SSL_VERSIONS[$(( $i + 3 ))]} + ;; + esac + + i=$(( $i + 4 )) +done +echo $POST diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key new file mode 100644 index 0000000000..8b2354a7ea --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBugIBAAKBgQDlXDEddxFbTtPsu2bRTbSONFVKMxe430iqBoXoKK2Gyhlqn7J8 +SRGlmvTN7T06+9iFqgJi+x+dlSJGlNEY/v67Z8C7rWfJynYuRier4TujLwP452RT +YrsnCq47pGJXHb9xAWr7UGMv85uDrECUiIdK4xIrwpW/gMb5zPSThDGNiwIVANts +B9nBX0NH/B0lXthVCg2jRSkpAoGAIS3vG8VmjQNYrGfdcdvQtGubFXs4jZJO6iDe +9u9/O95dcnH4ZIL4y3ZPHbw73dCKXFe5NlqI/POmn3MyFdpyqH5FTHWB/aAFrma6 +qo00F1mv83DkQCEfg6fwE/SaaBjDecr5I14hWOtocpYqlY1/x1aspahwK6NLPp/D +A4aAt78CgYAmNgr3dnHgMXrEsAeHswioAad3YLtnPvdFdHqd5j4oSbgKwFd7Xmyq +blfeQ6rRo8dmUF0rkUU8cn71IqbhpsCJQEZPt9WBlhHiY95B1ELKYHoHCbZA8qrZ +iEIcfwch85Da0/uzv4VE0UHTC0P3WRD3sZDfXd9dZLdc80n6ImYRpgIURgW8SZGj +X0mMkMJv/Ltdt0gYx60= +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..9116493472 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAOVcMR13EVtO0+y7ZtFNtI40VUozF7jfSKoGhegorYbKGWqfsnxJEaWa9M3tPTr72IWqAmL7H52VIkaU0Rj+/rtnwLutZ8nKdi5GJ6vhO6MvA/jnZFNiuycKrjukYlcdv3EBavtQYy/zm4OsQJSIh0rjEivClb+AxvnM9JOEMY2LAAAAFQDbbAfZwV9DR/wdJV7YVQoNo0UpKQAAAIAhLe8bxWaNA1isZ91x29C0a5sVeziNkk7qIN7273873l1ycfhkgvjLdk8dvDvd0IpcV7k2Woj886afczIV2nKofkVMdYH9oAWuZrqqjTQXWa/zcORAIR+Dp/AT9JpoGMN5yvkjXiFY62hyliqVjX/HVqylqHAro0s+n8MDhoC3vwAAAIAmNgr3dnHgMXrEsAeHswioAad3YLtnPvdFdHqd5j4oSbgKwFd7XmyqblfeQ6rRo8dmUF0rkUU8cn71IqbhpsCJQEZPt9WBlhHiY95B1ELKYHoHCbZA8qrZiEIcfwch85Da0/uzv4VE0UHTC0P3WRD3sZDfXd9dZLdc80n6ImYRpg== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 new file mode 100644 index 0000000000..5ed2b361cc --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEILwQIf+Jul+oygeJn7cBSvn2LGqnW1ZfiHDQMDXZ96mooAoGCCqGSM49 +AwEHoUQDQgAEJUo0gCIhXEPJYvxec23IAjq7BjV1xw8deI8JV9vL5BMCZNhyj5Vt +NbFPbKPuL/Sikn8p4YP/5y336ug7szvYrg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub new file mode 100644 index 0000000000..240387d901 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBCVKNIAiIVxDyWL8XnNtyAI6uwY1dccPHXiPCVfby+QTAmTYco+VbTWxT2yj7i/0opJ/KeGD/+ct9+roO7M72K4= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 new file mode 100644 index 0000000000..9d31d75cd5 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDBw+P1sic2i41wTGQgjyUlBtxQfnY77L8TFcDngoRiVrbCugnDrioNo +JogqymWhSC+gBwYFK4EEACKhZANiAATwaqEp3vyLzfb08kqgIZLv/mAYJyGD+JMt +f11OswGs3uFkbHZOErFCgeLuBvarSTAFkOlMR9GZGaDEfcrPBTtvKj+jEaAvh6yr +JxS97rtwk2uadDMem2x4w9Ga4jw4S8E= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub new file mode 100644 index 0000000000..cca85bda72 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBPBqoSne/IvN9vTySqAhku/+YBgnIYP4ky1/XU6zAaze4WRsdk4SsUKB4u4G9qtJMAWQ6UxH0ZkZoMR9ys8FO28qP6MRoC+HrKsnFL3uu3CTa5p0Mx6bbHjD0ZriPDhLwQ== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 new file mode 100644 index 0000000000..b698be1ec9 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHcAgEBBEIBtGVvyn7kGX7BfWAYHK2ZXmhWscTOV0J0mAfab0u0ZMw0id2a3O9s +sBjJoCqoAXTJ7d/OUw85qqQNDE5GDQpDFq6gBwYFK4EEACOhgYkDgYYABAHPWfUD +tQ/JmfwmmSdWWjGm94hFqwaivI4H43acDdd71+vods4rN2Yh3X7fSUvJkeOhXFOJ +yO9F+61ssKgS0a0nxQEvdXks3QyfKTPjYQuBUvY+AV/A4AskPBz731xCDmbYuWuh +RPekZ7d5bF0U0pGlExbX+naQJMSbJSdZrPM9993EmA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub new file mode 100644 index 0000000000..d181d30d69 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHPWfUDtQ/JmfwmmSdWWjGm94hFqwaivI4H43acDdd71+vods4rN2Yh3X7fSUvJkeOhXFOJyO9F+61ssKgS0a0nxQEvdXks3QyfKTPjYQuBUvY+AV/A4AskPBz731xCDmbYuWuhRPekZ7d5bF0U0pGlExbX+naQJMSbJSdZrPM9993EmA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key new file mode 100644 index 0000000000..84096298ca --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAuC6uxC0P8voYQCrwJzczo9iSiwsovPv4etd2BLnu8cKWdnjR +34tWvtguw2kO+iDyt4hFGGfDBQf2SXl+ZEsE2N1RlSp5A73me2byw/L4MreX2rbU +TwyNXF3TBvKb3Gbpx7PoiB9frcb9RCMxtypBvGQD6bx6h5UWKuSkYzARaRLv3kbB +swcqfrA3PfWybkIoaa2RO1Ca86u6K0v+a4r0OfRxTnghuakZkH6CD7+uU3irliPI +UFt2wTI/qWmnDrMFh4RffToHK0QZHXdkq4ama5kRZdZ0svSorxqkl8EWGPhReoUj +Yrz0bCNevSlDxHCxLi8epRxuv+AhZHW0YdMCCwIDAQABAoIBAHUyj1aZbfqolWHP +cL0jbSKnHqiHU0bd9sED9T8QqTEBJwj/3Fwop+wMV8VURol3CbsrZPwgmoHLDTa3 +rmtXKSBtxAns2tA8uDpxyaxSIQj0thYgHHyoehL6SNu06OSYP84pdp+XhyRm6KXA +11O7+dRMuAi1PCql/VMR5mCPJ6T5qWAVYHFyEBvMm4q5yYSRSPaAaZHC6WbEsxHN +jGzcyl3tvmOyN0+M7v0U86lQ+H2tSXH+nQg/Ig6hWgFGg8AYoos/9yUGOY+e9bUE +serYdsuiyxBfo4CgoSeDsjwNp1lAZ5UOrIDdRqK9C8jGVkHDzwfmmtczWXkVVzGZ +Bd05izECgYEA31yHzSA/umamyZAQbi/5psk1Fc5m6MzsgmJmB6jm7hUZ0EbpSV4C +6b1nOrk/IAtA12rvDHgWy0zpkJbC5b03C77RnBgTRgLQyolrcpLDJ47+Kxf/AHGk +m63KaCpwZEQ4f9ARBXySD/jNoW9gz5S6Xa3RnHOC70DsIIk5VOCjWk0CgYEA0xiM +Ay27PJcbAG/4tnjH8DZfHb8SULfnfUj8kMe3V2SDPDWbhY8zheo45wTBDRflFU5I +XyGmfuZ7PTTnFVrJz8ua3mAMOzkFn4MmdaRCX9XtuE4YWq3lFvxlrJvfXSjEL0km +8UwlhJMixaEPqFQjsKc9BHwWKRiKcF4zFQ1DybcCgYB46yfdhYLaj23lmqc6b6Bw +iWbCql2N1DqJj2l65hY2d5fk6C6s+EcNcOrsoJKq70yoEgzdrDlyz+11yBg0tU2S +fzgMkAAHG8kajHBts0QRK1kvzSrQe7VITjpQUAFOVpxbnTFJzhloqiHwLlKzremC +g3IBh4svqO7r4j32VDI61QKBgQCQL4gS872cWSncVp7vI/iNHtZBHy2HbNX1QVEi +Iwgb7U+mZIdh5roukhlj0l96bgPPVbUhJX7v1sX+vI/KikSmZk/V7IzuNrich5xR +ZmzfwOOqq8z+wyBjXuqjx6P9oca+9Zxf3L8Tmtx5WNW1CCOImfKXiZopX9XPgsgp +bPIMaQKBgQCql4uTSacSQ5s6rEEdvR+y6nTohF3zxhOQ+6xivm3Hf1mgTk40lQ+t +sr6HsSTv8j/ZbhhtaUUb2efro3pDztjlxXFvITar9ZDB2B4QMlpSsDR9UNk8xKGY +J9aYLr4fJC6J6VA7Wf0yq6LpjSXRH/2GeNtmMl5rFRsHt+VU7GZK9g== +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..4ac6e7b124 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4Lq7ELQ/y+hhAKvAnNzOj2JKLCyi8+/h613YEue7xwpZ2eNHfi1a+2C7DaQ76IPK3iEUYZ8MFB/ZJeX5kSwTY3VGVKnkDveZ7ZvLD8vgyt5fattRPDI1cXdMG8pvcZunHs+iIH1+txv1EIzG3KkG8ZAPpvHqHlRYq5KRjMBFpEu/eRsGzByp+sDc99bJuQihprZE7UJrzq7orS/5rivQ59HFOeCG5qRmQfoIPv65TeKuWI8hQW3bBMj+paacOswWHhF99OgcrRBkdd2SrhqZrmRFl1nSy9KivGqSXwRYY+FF6hSNivPRsI169KUPEcLEuLx6lHG6/4CFkdbRh0wIL uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa new file mode 100644 index 0000000000..01a88acea2 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQC97XncQDaa9PQYEWK7llBxZQ2suVYTz1eadw2HtY+Y8ZKdUBLd +9LUQ2lymUC9yq66rb5pBBR13k/9Zcbu8I0nafrZT4wJ4H0YGD6Ob5O4HR4EHjO5q +hgnMJ17e1XnzI31MW5xAuAHTLLClNvnG05T1jaU+tRAsVSCHin3+sOenowIVAMSe +ANBvw7fm5+Lw+ziOAHPjeYzRAoGBALkWCGpKmlJ65F3Y/RcownHQvsrDAllzKF/a +cSfriCVVP5qVZ3Ach28ZZ9BFEnRE2SKqVsyBAiceb/+ISlu8CqKEvvoNIMJAu5rU +MwZh+PeHN4ES6tWTwBGAwu84ke6N4BgV+6Q4qkcyywHsT5oU0EdVbn2zzAZw8c7v +BpbsJ1KsAoGABraHWqSFhaX4+GHmtKwXZFVRKh/4R6GR2LpkFzGm3Ixv+eo9K5CI +TjiBYiVMrWH23G1LiDuJyMGqHEnIef+sorNfNzdnwq+8qRCTS6mbpRXkUt9p1arJ +MIKmosS+GFhTN6Z85gCwC51S2EDC4GW7J4ViHKacr1FwJSw9RC9F+WsCFQCRJayH +P4vM1XUOVEeX7u04K1EAFg== +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub new file mode 100644 index 0000000000..30661d5adf --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAL3tedxANpr09BgRYruWUHFlDay5VhPPV5p3DYe1j5jxkp1QEt30tRDaXKZQL3KrrqtvmkEFHXeT/1lxu7wjSdp+tlPjAngfRgYPo5vk7gdHgQeM7mqGCcwnXt7VefMjfUxbnEC4AdMssKU2+cbTlPWNpT61ECxVIIeKff6w56ejAAAAFQDEngDQb8O35ufi8Ps4jgBz43mM0QAAAIEAuRYIakqaUnrkXdj9FyjCcdC+ysMCWXMoX9pxJ+uIJVU/mpVncByHbxln0EUSdETZIqpWzIECJx5v/4hKW7wKooS++g0gwkC7mtQzBmH494c3gRLq1ZPAEYDC7ziR7o3gGBX7pDiqRzLLAexPmhTQR1VufbPMBnDxzu8GluwnUqwAAACABraHWqSFhaX4+GHmtKwXZFVRKh/4R6GR2LpkFzGm3Ixv+eo9K5CITjiBYiVMrWH23G1LiDuJyMGqHEnIef+sorNfNzdnwq+8qRCTS6mbpRXkUt9p1arJMIKmosS+GFhTN6Z85gCwC51S2EDC4GW7J4ViHKacr1FwJSw9RC9F+Ws= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa new file mode 100644 index 0000000000..60e8f6eb6e --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIC557KPgmq+pWOAh1L8DV8GWW0u7W5vz6mim3FFB1l8koAoGCCqGSM49 +AwEHoUQDQgAEC3J5fQ8+8xQso0lhBdoLdvD14oSsQiMuweXq+Dy2+4Mjdw2/bbw0 +CvbE2+KWNcgwxRLycNGcMCBdf/cOgNyGkA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 new file mode 100644 index 0000000000..60e8f6eb6e --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIC557KPgmq+pWOAh1L8DV8GWW0u7W5vz6mim3FFB1l8koAoGCCqGSM49 +AwEHoUQDQgAEC3J5fQ8+8xQso0lhBdoLdvD14oSsQiMuweXq+Dy2+4Mjdw2/bbw0 +CvbE2+KWNcgwxRLycNGcMCBdf/cOgNyGkA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub new file mode 100644 index 0000000000..b349d26da3 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAtyeX0PPvMULKNJYQXaC3bw9eKErEIjLsHl6vg8tvuDI3cNv228NAr2xNviljXIMMUS8nDRnDAgXX/3DoDchpA= sshtester@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 new file mode 100644 index 0000000000..ece6c8f284 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDBdgJs/xThHiy/aY1ymtQ4B0URNnRCm8l2WZMFjua57+nvq4Duf+igN +pN/5p/+azLKgBwYFK4EEACKhZANiAATUw6pT/UW2HvTW6lL2BGY7NfUGEX285XVi +9AcTXH1K+TOekbGmcpSirlGzSb15Wycajpmaae5vAzH1nnvcVd3FYODVdDXTHgV/ +FeXQ+vaw7CZnEAKZsr8mjXRX3fEyO1E= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub new file mode 100644 index 0000000000..fd81e220f7 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBNTDqlP9RbYe9NbqUvYEZjs19QYRfbzldWL0BxNcfUr5M56RsaZylKKuUbNJvXlbJxqOmZpp7m8DMfWee9xV3cVg4NV0NdMeBX8V5dD69rDsJmcQApmyvyaNdFfd8TI7UQ== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 new file mode 100644 index 0000000000..21c000ea03 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHbAgEBBEEhm0w3xcGILU8eP61mThVBwCJfyzrFktGf7cCa1ciL4YLsukd20Q3Z +yp0YcEDLcEm36CZGabgkEvblJ1Rx2lPTu6AHBgUrgQQAI6GBiQOBhgAEAYep8cX2 +7wUPw5pNYwFkWQXrJ2GSkmO8iHwkWJ6srRay/sF3WoPF/dyDVymFgirtsSTJ+D0u +ex4qphOOJxkd1Yf+ANHvDFN9LoBvbgtNLTRJlpuNLCdWQlt+mEnPMDGMV/HWHHiz +7/mWE+XUVIcQjhm5uv0ObI/wroZEurXMGEhTis3L +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub new file mode 100644 index 0000000000..d9830da5de --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAGHqfHF9u8FD8OaTWMBZFkF6ydhkpJjvIh8JFierK0Wsv7Bd1qDxf3cg1cphYIq7bEkyfg9LnseKqYTjicZHdWH/gDR7wxTfS6Ab24LTS00SZabjSwnVkJbfphJzzAxjFfx1hx4s+/5lhPl1FSHEI4Zubr9DmyP8K6GRLq1zBhIU4rNyw== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa new file mode 100644 index 0000000000..2e50ac2304 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpQIBAAKCAQEA7+C3gLoflKybq4I+clbg2SWf6cXyHpnLNDnZeMvIbOz2X/Ce +XUm17DFeexTaVBs9Zq9WwDFOFkLQhbuXgpvB0shSY0nr+Em7InRM8AiRLxPe0txM +mFFhL+v083dYwgaJOo1PthNM/tGRZJu+0sQDqrmN7CusFHdZg2NTzTzbwWqPiuP/ +mf3o7W4CWqDTBzbYTgpWlH7vRZf9FYwT4on5YWzLA8TvO2TwBGTfTMK5nswH++iO +v4jKecoEwyBFMUSKqZ9UYHGw/kshHbltM65Ye/xjXEX0GxDdxu8ZyVKXd4acNbJJ +P0tcxN4GzKJiR6zNYwCzDhjqDEbM5qCGhShhgQIDAQABAoIBAQCucdGBP9mvmUcs +Fu+q3xttTztYGqfVMSrhtCA/BJOhA0K4ypegZ/Zw6gY3pBaSi6y/fEuuQSz0a2qR +lra8OOFflGa15hBA4/2/NKyu8swCXITy+1qIesYev43HcMePcolhl1qcorSfq2/8 +pnbDd+Diy0Y2thvSVmk2b4mF+/gkUx3CHLhgRMcxCHLG1VeqIfLf+pa0jIw94tZ5 +CoIoI096pDTsneO9xhh1QxWQRRFVqdf3Q9zyiBgJCggpX+1fVsbQejuEK4hKRBKx +SRPX/pX5aU+7+KSZ/DbtXGg1sCw9NUDFTIEV3UPmko4oWawNGv/CQAK80g3go28v +UnVf11BBAoGBAP2amIFp+Ps33A5eesT7g/NNkGqBEi5W37K8qzYJxqXJvH0xmpFo +8a3Je3PQRrzbTUJyISA6/XNnA62+bEvWiEXPiK3stQzNHoVz7ftCb19zgW4sLKRW +Qhjq7QsGeRrdksJnZ7ekfzOv658vHJPElS1MdPu2WWhiNvAjtmdyFQulAoGBAPIk +6831QAnCdp/ffH/K+cqV9vQYOFig8n4mQNNC+sLghrtZh9kbmTuuNKAhF56vdCCn +ABD/+RiLXKVsF0PvQ5g9wRLKaiJubXI7XEBemCCLhjtESxGpWEV8GalslUgE1cKs +d1pwSVjd0sYt0gOAf2VRhlbpSWhXA2xVll34xgetAoGAHaI089pYN7K9SgiMO/xP +3NxRZcCTSUrpdM9LClN2HOVH2zEyqI8kvnPuswfBXEwb6QnBCS0bdKKy8Vhw+yOk +ZNPtWrVwKoDFcj6rrlKDBRpQI3mR9doGezboYANvn04I2iKPIgxcuMNzuvQcWL/9 +1n86pDcYl3Pyi3kA1XGlN+kCgYEAz1boBxpqdDDsjGa8X1y5WUviAw8+KD3ghj5R +IdTnjbjeBUxbc38bTawUac0MQZexE0iMWQImFGs4sHkGzufwdErkqSdjjAoMc1T6 +4C9fifaOwO7wbLYZ3J2wB4/vn5RsSV6OcIVXeN2wXnvbqZ38+A+/vWnSrqJbTwdW +Uy7yup0CgYEA8M9vjpAoCr3XzNDwJyWRQcT7e+nRYUNDlXBl3jpQhHuJtnSnkoUv +HXYXEwvp8peycNzeVz5OwFVMzCH8OG4WiGN4Pmo0rDWHED/W7eIRHIitHGTzZ+Qw +gRxscoewblSLSkYMXidBLmQjr4U5bDBesRuGhm5NuLyMTa1f3Pc/90k= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub new file mode 100644 index 0000000000..26e560d4f8 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDv4LeAuh+UrJurgj5yVuDZJZ/pxfIemcs0Odl4y8hs7PZf8J5dSbXsMV57FNpUGz1mr1bAMU4WQtCFu5eCm8HSyFJjSev4SbsidEzwCJEvE97S3EyYUWEv6/Tzd1jCBok6jU+2E0z+0ZFkm77SxAOquY3sK6wUd1mDY1PNPNvBao+K4/+Z/ejtbgJaoNMHNthOClaUfu9Fl/0VjBPiiflhbMsDxO87ZPAEZN9MwrmezAf76I6/iMp5ygTDIEUxRIqpn1RgcbD+SyEduW0zrlh7/GNcRfQbEN3G7xnJUpd3hpw1skk/S1zE3gbMomJHrM1jALMOGOoMRszmoIaFKGGB uabhnil@elxadlj3q32 diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index f317dfded4..e4109dd080 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -42,9 +42,11 @@ TLS-1.1, and TLS-1.2.</item> <item>For security reasons SSL-2.0 is not supported.</item> <item>For security reasons SSL-3.0 is no longer supported by default, - but can be configured.</item> + but can be configured. (OTP 19) </item> + <item>For security reasons RSA key exchange cipher suites are no longer supported by default, + but can be configured. (OTP 21) </item> <item>For security reasons DES cipher suites are no longer supported by default, - but can be configured.</item> + but can be configured. (OTP 20) </item> <item> Renegotiation Indication Extension <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url> is supported </item> <item>Ephemeral Diffie-Hellman cipher suites are supported, diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index b0e38fb9ad..dba8e5a311 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -38,7 +38,7 @@ cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, - rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1]). @@ -324,7 +324,8 @@ all_suites({3, _} = Version) -> ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) - ++ des_suites(Version); + ++ des_suites(Version) + ++ rsa_suites(Version); all_suites(Version) -> dtls_v1:all_suites(Version). @@ -373,7 +374,6 @@ anonymous_suites(N) when N == 0; %%-------------------------------------------------------------------- psk_suites({3, N}) -> psk_suites(N); - psk_suites(N) when N >= 3 -> [ @@ -394,7 +394,6 @@ psk_suites(N) ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_PSK_WITH_AES_128_CBC_SHA256 ] ++ psk_suites(0); - psk_suites(_) -> [?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, @@ -430,7 +429,7 @@ srp_suites() -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec rc4_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +-spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the RSA|(ECDH/RSA)| (ECDH/ECDSA) %% with RC4 cipher suites, only supported if explicitly set by user. @@ -438,13 +437,15 @@ srp_suites() -> %% belonged to the user configured only category. %%-------------------------------------------------------------------- rc4_suites({3, 0}) -> + rc4_suites(0); +rc4_suites({3, Minor}) -> + rc4_suites(Minor) ++ rc4_suites(0); +rc4_suites(0) -> [?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5]; -rc4_suites({3, N}) when N =< 3 -> +rc4_suites(N) when N =< 3 -> [?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- @@ -459,6 +460,29 @@ des_suites(_)-> ?TLS_RSA_WITH_DES_CBC_SHA]. %%-------------------------------------------------------------------- +-spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the RSA key exchange +%% cipher suites, only supported if explicitly set by user. +%% Are not considered secure any more. +%%-------------------------------------------------------------------- +rsa_suites({3, 0}) -> + rsa_suites(0); +rsa_suites({3, Minor}) -> + rsa_suites(Minor) ++ rsa_suites(0); +rsa_suites(0) -> + [?TLS_RSA_WITH_AES_256_CBC_SHA, + ?TLS_RSA_WITH_AES_128_CBC_SHA, + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA + ]; +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 + ]. +%%-------------------------------------------------------------------- -spec suite_definition(cipher_suite()) -> erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. @@ -2301,7 +2325,7 @@ calc_mac_hash(Type, Version, MacSecret, SeqNo, Type, Length, PlainFragment). -is_stream_ciphersuite({_, rc4_128, _, _}) -> +is_stream_ciphersuite(#{cipher := rc4_128}) -> true; is_stream_ciphersuite(_) -> false. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index a8fe119bf8..af3f037477 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -202,7 +202,6 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?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_RSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, @@ -210,15 +209,13 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?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_RSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA ]; suites(3) -> [?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, @@ -238,8 +235,6 @@ suites(3) -> ?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_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_RSA_WITH_AES_256_CBC_SHA256, ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, @@ -253,9 +248,7 @@ suites(3) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_WITH_AES_128_CBC_SHA256 + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256 %% not supported %% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384, @@ -264,8 +257,6 @@ suites(3) -> %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256 ] ++ suites(2). - - signature_algs({3, 3}, HashSigns) -> CryptoSupports = crypto:supports(), Hashes = proplists:get_value(hashs, CryptoSupports), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 3b4ca40058..dc602910a1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -280,8 +280,11 @@ end_per_suite(_Config) -> init_per_group(GroupName, Config) when GroupName == basic_tls; GroupName == options_tls; + GroupName == options; GroupName == basic; - GroupName == options -> + GroupName == session; + GroupName == error_handling_tests_tls + -> ssl_test_lib:clean_tls_version(Config); init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of @@ -381,12 +384,12 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites; TestCase == anonymous_cipher_suites; TestCase == psk_anon_cipher_suites; TestCase == psk_anon_with_hint_cipher_suites; - TestCase == srp_cipher_suites, - TestCase == srp_anon_cipher_suites, - TestCase == srp_dsa_cipher_suites, - TestCase == des_rsa_cipher_suites, - TestCase == des_ecdh_rsa_cipher_suites, - TestCase == versions_option, + TestCase == srp_cipher_suites; + TestCase == srp_anon_cipher_suites; + TestCase == srp_dsa_cipher_suites; + TestCase == des_rsa_cipher_suites; + TestCase == des_ecdh_rsa_cipher_suites; + TestCase == versions_option; TestCase == tls_tcp_connect_big -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 60}), @@ -427,6 +430,12 @@ init_per_testcase(rizzo_disabled, Config) -> ct:timetrap({seconds, 60}), rizzo_add_mitigation_option(disabled, Config); +init_per_testcase(TestCase, Config) when TestCase == no_reuses_session_server_restart_new_cert_file; + TestCase == no_reuses_session_server_restart_new_cert -> + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), + ct:timetrap({seconds, 15}), + Config; + init_per_testcase(prf, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 40}), @@ -655,7 +664,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa, aes_128_cbc, sha}]} | + [{ciphers,[{dhe_rsa, aes_128_cbc, sha}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -663,7 +672,7 @@ connection_info(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}}, + ServerMsg = ClientMsg = {ok, {Version, {dhe_rsa, aes_128_cbc, sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -1278,9 +1287,14 @@ cipher_suites() -> [{doc,"Test API function cipher_suites/0"}]. cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, - [_|_] = Suites = ssl:cipher_suites(), - true = lists:member(MandatoryCipherSuite, Suites), + MandatoryCipherSuiteTLS1_0TLS1_1 = {rsa,'3des_ede_cbc',sha}, + MandatoryCipherSuiteTLS1_0TLS1_2 = {rsa,'aes_128_cbc',sha} , + [_|_] = Suites = ssl:cipher_suites(), + AllSuites = ssl:cipher_suites(all), + %% The mandantory suites will no longer be supported by default + %% due to security reasons + true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_1, AllSuites), + true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_2, AllSuites), Suites = ssl:cipher_suites(erlang), [_|_] =ssl:cipher_suites(openssl). @@ -1289,7 +1303,7 @@ cipher_suites_mix() -> [{doc,"Test to have old and new cipher suites at the same time"}]. cipher_suites_mix(Config) when is_list(Config) -> - CipherSuites = [{ecdh_rsa,aes_128_cbc,sha256,sha256}, {rsa,aes_128_cbc,sha}], + CipherSuites = [{dhe_rsa,aes_128_cbc,sha256,sha256}, {dhe_rsa,aes_128_cbc,sha}], ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), @@ -3234,16 +3248,16 @@ tls_tcp_reuseaddr(Config) when is_list(Config) -> honor_server_cipher_order() -> [{doc,"Test API honor server cipher order."}]. honor_server_cipher_order(Config) when is_list(Config) -> - ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}], - ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}], -honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {rsa, aes_256_cbc, sha}). + ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}], + ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}], +honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {dhe_rsa, aes_256_cbc, sha}). honor_client_cipher_order() -> [{doc,"Test API honor server cipher order."}]. honor_client_cipher_order(Config) when is_list(Config) -> - ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}], - ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}], -honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {rsa, aes_128_cbc, sha}). + ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}], + ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}], +honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {dhe_rsa, aes_128_cbc, sha}). honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) -> ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), @@ -4600,38 +4614,39 @@ client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. run_suites(Ciphers, Config, Type) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), ct:log("Running cipher suites ~p~n", [Ciphers]), {ClientOpts, ServerOpts} = case Type of rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_verification_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; dsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_dsa_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_dsa_opts, Config)]}; anonymous -> %% No certs in opts! {ssl_test_lib:ssl_options(client_verification_opts, Config), - [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options([], Config)]}; psk -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk, Config)]}; psk_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_hint, Config) ]}; psk_anon -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_anon, Config)]}; psk_anon_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), @@ -4644,7 +4659,8 @@ run_suites(Ciphers, Config, Type) -> ssl_test_lib:ssl_options(server_srp_dsa, Config)}; ecdsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_ecdsa_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; ecdh_rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}; @@ -4669,7 +4685,6 @@ run_suites(Ciphers, Config, Type) -> [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_verification_opts, Config)]} end, - Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, ssl_test_lib:filter_suites(Ciphers, Version)), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 03c3ed9be3..e74529b455 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1024,15 +1024,26 @@ string_regex_filter(Str, Search) when is_list(Str) -> string_regex_filter(_Str, _Search) -> false. -anonymous_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]. - -psk_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]. - -psk_anon_suites(Version) -> - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]. - +anonymous_suites({3,_ } = Version) -> + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]; +anonymous_suites(DTLSVersion) -> + Version = dtls_v1:corresponding_tls_version(DTLSVersion), + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version)), + not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. + +psk_suites({3,_ } = Version) -> + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]; +psk_suites(DTLSVersion) -> + Version = dtls_v1:corresponding_tls_version(DTLSVersion), + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version)), + not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. + +psk_anon_suites({3,_ } = Version) -> + [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]; +psk_anon_suites(DTLSVersion) -> + Version = dtls_v1:corresponding_tls_version(DTLSVersion), + [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite), + not ssl_cipher:is_stream_ciphersuite(tuple_to_map(Suite))]. srp_suites() -> [ssl_cipher:erl_suite_definition(Suite) || Suite <- @@ -1335,8 +1346,9 @@ enough_openssl_crl_support(_) -> true. wait_for_openssl_server(Port, tls) -> do_wait_for_openssl_tls_server(Port, 10); -wait_for_openssl_server(Port, dtls) -> - do_wait_for_openssl_dtls_server(Port, 10). +wait_for_openssl_server(_Port, dtls) -> + ok. %% No need to wait for DTLS over UDP server + %% client will retransmitt until it is up. do_wait_for_openssl_tls_server(_, 0) -> exit(failed_to_connect_to_openssl); @@ -1349,21 +1361,6 @@ do_wait_for_openssl_tls_server(Port, N) -> do_wait_for_openssl_tls_server(Port, N-1) end. -do_wait_for_openssl_dtls_server(_, 0) -> - %%exit(failed_to_connect_to_openssl); - ok; -do_wait_for_openssl_dtls_server(Port, N) -> - %% case gen_udp:open(0) of - %% {ok, S} -> - %% gen_udp:connect(S, "localhost", Port), - %% gen_udp:close(S); - %% _ -> - %% ct:sleep(?SLEEP), - %% do_wait_for_openssl_dtls_server(Port, N-1) - %% end. - ct:sleep(500), - do_wait_for_openssl_dtls_server(Port, N-1). - version_flag(tlsv1) -> "-tls1"; version_flag('tlsv1.1') -> @@ -1664,78 +1661,3 @@ hardcode_dsa_key(3) -> y = 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358, x = 1457508827177594730669011716588605181448418352823}. -dtls_hello() -> - [1, - <<0,1,4>>, - <<0,0>>, - <<0,0,0>>, - <<0,1,4>>, - <<254,253,88, - 156,129,61, - 131,216,15, - 131,194,242, - 46,154,190, - 20,228,234, - 234,150,44, - 62,96,96,103, - 127,95,103, - 23,24,42,138, - 13,142,32,57, - 230,177,32, - 210,154,152, - 188,121,134, - 136,53,105, - 118,96,106, - 103,231,223, - 133,10,165, - 50,32,211, - 227,193,14, - 181,143,48, - 66,0,0,100,0, - 255,192,44, - 192,48,192, - 36,192,40, - 192,46,192, - 50,192,38, - 192,42,0,159, - 0,163,0,107, - 0,106,0,157, - 0,61,192,43, - 192,47,192, - 35,192,39, - 192,45,192, - 49,192,37, - 192,41,0,158, - 0,162,0,103, - 0,64,0,156,0, - 60,192,10, - 192,20,0,57, - 0,56,192,5, - 192,15,0,53, - 192,8,192,18, - 0,22,0,19, - 192,3,192,13, - 0,10,192,9, - 192,19,0,51, - 0,50,192,4, - 192,14,0,47, - 1,0,0,86,0,0, - 0,14,0,12,0, - 0,9,108,111, - 99,97,108, - 104,111,115, - 116,0,10,0, - 58,0,56,0,14, - 0,13,0,25,0, - 28,0,11,0,12, - 0,27,0,24,0, - 9,0,10,0,26, - 0,22,0,23,0, - 8,0,6,0,7,0, - 20,0,21,0,4, - 0,5,0,18,0, - 19,0,1,0,2,0, - 3,0,15,0,16, - 0,17,0,11,0, - 2,1,0>>]. - diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 9118e4b7e3..bbb925e742 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -201,11 +201,11 @@ init_per_testcase(expired_session, Config) -> init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs; TestCase == ciphers_dsa_signed_certs -> - ct:timetrap({seconds, 60}), + ct:timetrap({seconds, 90}), special_init(TestCase, Config); init_per_testcase(TestCase, Config) -> - ct:timetrap({seconds, 20}), + ct:timetrap({seconds, 35}), special_init(TestCase, Config). special_init(TestCase, Config) diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 5e631aac21..3b5be75bc0 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2003</year><year>2017</year> + <year>2003</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -296,7 +296,7 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code> for a file with the extension <c>.beam</c>, the default rule is to look for a file with a corresponding extension <c>.erl</c> by replacing the suffix <c>"ebin"</c> of the object directory path with - <c>"src"</c>. + <c>"src"</c> or <c>"src/*"</c>. The file search is done through <seealso marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of the object file is always tried before any other directory specified diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index d2608ad542..ce19f70df0 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2017</year> + <year>1997</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -399,15 +399,18 @@ true tuples <c>{<anno>BinSuffix</anno>, <anno>SourceSuffix</anno>}</c> and is interpreted as follows: if the end of the directory name where the object is located matches <c><anno>BinSuffix</anno></c>, then the - source code directory has the same name, but with - <c><anno>BinSuffix</anno></c> replaced by - <c><anno>SourceSuffix</anno></c>. <c><anno>Rules</anno></c> defaults + name created by replacing <c><anno>BinSuffix</anno></c> with + <c><anno>SourceSuffix</anno></c> is expanded by calling + <seealso marker="filelib#wildcard/1"> + <c>filelib:wildcard/1</c></seealso>. + If a regular file is found among the matches, the function + returns that location together with <c><anno>Options</anno></c>. + Otherwise the next rule is tried, and so on.</p> + <p><c><anno>Rules</anno></c> defaults to:</p> <code type="none"> -[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}]</code> - <p>If the source file is found in the resulting directory, the function - returns that location together with <c><anno>Options</anno></c>. - Otherwise the next rule is tried, and so on.</p> +[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}, + {"ebin", "src/*"}, {"ebin", "esrc/*"}]</code> <p>The function returns <c>{<anno>SourceFile</anno>, <anno>Options</anno>}</c> if it succeeds. <c><anno>SourceFile</anno></c> is the absolute path to the source diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index 64fcf4379f..72c774e6ef 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -257,8 +257,9 @@ ok</pre> \x{400} ok 5> <input>io:fwrite("~s~n",[[1024]]).</input> -** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, - ...</pre> +** exception error: bad argument + in function io:format/3 + called as io:format(<0.53.0>,"~s~n",[[1024]])</pre> </item> <tag><c>w</c></tag> <item> @@ -454,12 +455,9 @@ ok</pre> abc def 'abc def' {foo,1} A ok 2> <input>io:fwrite("~s", [65]).</input> -** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, - {erl_eval,do_apply,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]} - in function io:o_request/2</pre> +** exception error: bad argument + in function io:format/3 + called as io:format(<0.53.0>,"~s","A")</pre> <p>In this example, an attempt was made to output the single character 65 with the aid of the string formatting directive <c>"~s"</c>.</p> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index eafee346eb..4ee11383da 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -69,6 +69,9 @@ -type(non_local_function_handler() :: {value, nlfun_handler()} | none). +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + %% exprs(ExpressionSeq, Bindings) %% exprs(ExpressionSeq, Bindings, LocalFuncHandler) %% exprs(ExpressionSeq, Bindings, LocalFuncHandler, ExternalFuncHandler) @@ -90,7 +93,7 @@ exprs(Exprs, Bs) -> ok -> exprs(Exprs, Bs, none, none, none); {error,{_Line,_Mod,Error}} -> - erlang:raise(error, Error, [{?MODULE,exprs,2}]) + erlang:raise(error, Error, ?STACKTRACE) end. -spec(exprs(Expressions, Bindings, LocalFunctionHandler) -> @@ -141,7 +144,7 @@ expr(E, Bs) -> ok -> expr(E, Bs, none, none, none); {error,{_Line,_Mod,Error}} -> - erlang:raise(error, Error, [{?MODULE,expr,2}]) + erlang:raise(error, Error, ?STACKTRACE) end. -spec(expr(Expression, Bindings, LocalFunctionHandler) -> @@ -182,7 +185,7 @@ check_command(Es, Bs) -> fun_data(F) when is_function(F) -> case erlang:fun_info(F, module) of - {module,erl_eval} -> + {module,?MODULE} -> case erlang:fun_info(F, env) of {env,[{FBs,_FLf,_FEf,FCs}]} -> {fun_data,FBs,FCs}; @@ -209,8 +212,8 @@ expr({var,_,V}, Bs, _Lf, _Ef, RBs) -> case binding(V, Bs) of {value,Val} -> ret_expr(Val, Bs, RBs); - unbound -> % Should not happen. - erlang:raise(error, {unbound,V}, stacktrace()) + unbound -> % Cannot not happen if checked by erl_lint + erlang:raise(error, {unbound,V}, ?STACKTRACE) end; expr({char,_,C}, Bs, _Lf, _Ef, RBs) -> ret_expr(C, Bs, RBs); @@ -236,13 +239,13 @@ expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) -> {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef), ret_expr(list_to_tuple(Vs), Bs, RBs); expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); %% map expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> @@ -281,7 +284,7 @@ expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 %% Don't know what to do... - erlang:raise(error, undef, [{erl_eval,Name,Arity}|stacktrace()]); + erlang:raise(error, undef, [{?MODULE,Name,Arity}|?STACKTRACE]); expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> %% Save only used variables in the function environment. %% {value,L,V} are hidden while lint finds used variables. @@ -326,7 +329,7 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Info) end; _Other -> erlang:raise(error, {'argument_limit',{'fun',Line,Cs}}, - stacktrace()) + ?STACKTRACE) end, ret_expr(F, Bs, RBs); expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> @@ -378,7 +381,7 @@ expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> RF, Info) end; _Other -> erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}}, - stacktrace()) + ?STACKTRACE) end, ret_expr(F, Bs, RBs); expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]}, @@ -422,25 +425,28 @@ expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {As,Bs2} = expr_list(As0, Bs1, Lf, Ef), case Func of {M,F} when is_atom(M), is_atom(F) -> - erlang:raise(error, {badfun,Func}, stacktrace()); + erlang:raise(error, {badfun,Func}, ?STACKTRACE); _ -> do_apply(Func, As, Bs2, Ef, RBs) end; expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) -> - Ref = make_ref(), - case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of - {Ref,{value,V,Bs}} -> % Nothing was thrown (guaranteed). - ret_expr(V, Bs, RBs); - Other -> - ret_expr(Other, Bs0, RBs) + try expr(Expr, Bs0, Lf, Ef, none) of + {value,V,Bs} -> + ret_expr(V, Bs, RBs) + catch + throw:Term -> + ret_expr(Term, Bs0, RBs); + exit:Reason -> + ret_expr({'EXIT',Reason}, Bs0, RBs); + error:Reason:Stacktrace -> + ret_expr({'EXIT',{Reason,Stacktrace}}, Bs0, RBs) end; expr({match,_,Lhs,Rhs0}, Bs0, Lf, Ef, RBs) -> {value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none), case match(Lhs, Rhs, Bs1) of {match,Bs} -> ret_expr(Rhs, Bs, RBs); - nomatch -> - erlang:raise(error, {badmatch,Rhs}, stacktrace()) + nomatch -> erlang:raise(error, {badmatch,Rhs}, ?STACKTRACE) end; expr({op,_,Op,A0}, Bs0, Lf, Ef, RBs) -> {value,A,Bs} = expr(A0, Bs0, Lf, Ef, none), @@ -452,7 +458,7 @@ expr({op,_,'andalso',L0,R0}, Bs0, Lf, Ef, RBs) -> {value,R,_} = expr(R0, Bs1, Lf, Ef, none), R; false -> false; - _ -> erlang:raise(error, {badarg,L}, stacktrace()) + _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE) end, ret_expr(V, Bs1, RBs); expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) -> @@ -462,7 +468,7 @@ expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) -> false -> {value,R,_} = expr(R0, Bs1, Lf, Ef, none), R; - _ -> erlang:raise(error, {badarg,L}, stacktrace()) + _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE) end, ret_expr(V, Bs1, RBs); expr({op,_,Op,L0,R0}, Bs0, Lf, Ef, RBs) -> @@ -474,7 +480,7 @@ expr({bin,_,Fs}, Bs0, Lf, Ef, RBs) -> {value,V,Bs} = eval_bits:expr_grp(Fs, Bs0, EvalFun), ret_expr(V, Bs, RBs); expr({remote,_,_,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {badexpr,':'}, stacktrace()); + erlang:raise(error, {badexpr,':'}, ?STACKTRACE); expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values. ret_expr(Val, Bs, RBs). @@ -570,7 +576,7 @@ local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> - erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). + erlang:raise(error, undef, [{?MODULE,Func,length(As0)}|?STACKTRACE]). local_func2({value,V,Bs}, RBs) -> ret_expr(V, Bs, RBs); @@ -637,7 +643,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> {{arity, Arity}, Arity} -> eval_fun(FCs, As, FBs, FLf, FEf, NRBs); _ -> - erlang:raise(error, {badarity,{Func,As}},stacktrace()) + erlang:raise(error, {badarity,{Func,As}},?STACKTRACE) end; {{env,[{FBs,FLf,FEf,FCs,FName}]},_} -> NRBs = if @@ -648,7 +654,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> {{arity, Arity}, Arity} -> eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs); _ -> - erlang:raise(error, {badarity,{Func,As}},stacktrace()) + erlang:raise(error, {badarity,{Func,As}},?STACKTRACE) end; {no_env,none} when RBs =:= value -> %% Make tail recursive calls when possible. @@ -730,7 +736,7 @@ eval_generate([V|Rest], P, Bs0, Lf, Ef, CompFun, Acc) -> eval_generate([], _P, _Bs0, _Lf, _Ef, _CompFun, Acc) -> Acc; eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> - erlang:raise(error, {bad_generator,Term}, stacktrace()). + erlang:raise(error, {bad_generator,Term}, ?STACKTRACE). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> Mfun = match_fun(Bs0), @@ -746,7 +752,7 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> Acc end; eval_b_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> - erlang:raise(error, {bad_generator,Term}, stacktrace()). + erlang:raise(error, {bad_generator,Term}, ?STACKTRACE). eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> case erl_lint:is_guard_test(F) of @@ -760,7 +766,7 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> {value,true,Bs1} -> CompFun(Bs1); {value,false,_} -> Acc; {value,V,_} -> - erlang:raise(error, {bad_filter,V}, stacktrace()) + erlang:raise(error, {bad_filter,V}, ?STACKTRACE) end end. @@ -816,7 +822,7 @@ eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) -> end; eval_fun([], As, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, function_clause, - [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]). eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) -> @@ -836,7 +842,7 @@ eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) -> end; eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) -> erlang:raise(error, function_clause, - [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]). %% expr_list(ExpressionList, Bindings) @@ -894,13 +900,13 @@ if_clauses([{clause,_,[],G,B}|Cs], Bs, Lf, Ef, RBs) -> false -> if_clauses(Cs, Bs, Lf, Ef, RBs) end; if_clauses([], _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, if_clause, stacktrace()). + erlang:raise(error, if_clause, ?STACKTRACE). %% try_clauses(Body, CaseClauses, CatchClauses, AfterBody, Bindings, %% LocalFuncHandler, ExtFuncHandler, RBs) -%% When/if variable bindings between the different parts of a -%% try-catch expression are introduced this will have to be rewritten. + try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> + check_stacktrace_vars(Catches, Bs), try exprs(B, Bs, Lf, Ef, none) of {value,V,Bs1} when Cases =:= [] -> ret_expr(V, Bs1, RBs); @@ -909,23 +915,18 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> {B2,Bs2} -> exprs(B2, Bs2, Lf, Ef, RBs); nomatch -> - erlang:raise(error, {try_clause,V}, stacktrace()) + erlang:raise(error, {try_clause,V}, ?STACKTRACE) end catch - Class:Reason when Catches =:= [] -> - %% Rethrow - erlang:raise(Class, Reason, stacktrace()); - Class:Reason -> -%%% %% Set stacktrace -%%% try erlang:raise(Class, Reason, stacktrace()) -%%% catch _:_ -> ok -%%% end, - V = {Class,Reason,erlang:get_stacktrace()}, - case match_clause(Catches, [V],Bs, Lf, Ef) of + Class:Reason:Stacktrace when Catches =:= [] -> + erlang:raise(Class, Reason, Stacktrace); + Class:Reason:Stacktrace -> + V = {Class,Reason,Stacktrace}, + case match_clause(Catches, [V], Bs, Lf, Ef) of {B2,Bs2} -> exprs(B2, Bs2, Lf, Ef, RBs); nomatch -> - erlang:raise(Class, Reason, stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end after if AB =:= [] -> @@ -935,6 +936,23 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> end end. +check_stacktrace_vars([{clause,_,[{tuple,_,[_,_,STV]}],_,_}|Cs], Bs) -> + case STV of + {var,_,V} -> + case binding(V, Bs) of + {value, _} -> + erlang:raise(error, stacktrace_bound, ?STACKTRACE); + unbound -> + check_stacktrace_vars(Cs, Bs) + end; + _ -> + erlang:raise(error, + {illegal_stacktrace_variable,STV}, + ?STACKTRACE) + end; +check_stacktrace_vars([], _Bs) -> + ok. + %% case_clauses(Value, Clauses, Bindings, LocalFuncHandler, ExtFuncHandler, %% RBs) @@ -943,7 +961,7 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) -> {B, Bs1} -> exprs(B, Bs1, Lf, Ef, RBs); nomatch -> - erlang:raise(error, {case_clause,Val}, stacktrace()) + erlang:raise(error, {case_clause,Val}, ?STACKTRACE) end. %% @@ -1018,7 +1036,7 @@ guard0([G|Gs], Bs0, Lf, Ef) -> {value,false,_} -> false end; false -> - erlang:raise(error, guard_expr, stacktrace()) + erlang:raise(error, guard_expr, ?STACKTRACE) end; guard0([], _Bs, _Lf, _Ef) -> true. @@ -1073,7 +1091,7 @@ match(Pat, Term, Bs) -> match(Pat, Term, Bs, BBs) -> case catch match1(Pat, Term, Bs, BBs) of invalid -> - erlang:raise(error, {illegal_pattern,Pat}, stacktrace()); + erlang:raise(error, {illegal_pattern,Pat}, ?STACKTRACE); Other -> Other end. @@ -1254,7 +1272,7 @@ merge_bindings(Bs1, Bs2) -> case orddict:find(Name, Bs) of {ok,Val} -> Bs; %Already with SAME value {ok,V1} -> - erlang:raise(error, {badmatch,V1}, stacktrace()); + erlang:raise(error, {badmatch,V1}, ?STACKTRACE); error -> orddict:store(Name, Val, Bs) end end, Bs2, orddict:to_list(Bs1)). @@ -1264,7 +1282,7 @@ merge_bindings(Bs1, Bs2) -> %% fun (Name, Val, Bs) -> %% case orddict:find(Name, Bs) of %% {ok,Val} -> orddict:erase(Name, Bs); -%% {ok,V1} -> erlang:raise(error,{badmatch,V1},stacktrace()); +%% {ok,V1} -> erlang:raise(error,{badmatch,V1},?STACKTRACE); %% error -> Bs %% end %% end, Bs2, Bs1). @@ -1326,7 +1344,3 @@ ret_expr(_Old, New) -> New. line(Expr) -> element(2, Expr). - -%% {?MODULE,expr,3} is still the stacktrace, despite the -%% fact that expr() now takes two, three or four arguments... -stacktrace() -> [{?MODULE,expr,3}]. diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 76f0b38108..5ee584d612 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -189,7 +189,7 @@ table(Name) -> %% Returns a list of names of the files in the tar file Name. %% Options accepted: compressed, verbose, cooked. -spec table(open_handle(), [compressed | verbose | cooked]) -> - {ok, [tar_entry()]} | {error, term()}. + {ok, [string() | tar_entry()]} | {error, term()}. table(Name, Opts) when is_list(Opts) -> foldl_read(Name, fun table1/4, [], table_opts(Opts)). diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 631faa3be5..bb86a65c72 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -25,6 +25,9 @@ -export([expr_grp/3,expr_grp/5,match_bits/6, match_bits/7,bin_gen/6]). +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + %% Types used in this module: %% @type bindings(). An abstract structure for bindings between %% variables and values (the environment) @@ -93,9 +96,9 @@ eval_exp_field1(V, Size, Unit, Type, Endian, Sign) -> eval_exp_field(V, Size, Unit, Type, Endian, Sign) catch error:system_limit -> - error(system_limit); + erlang:raise(error, system_limit, ?STACKTRACE); error:_ -> - error(badarg) + erlang:raise(error, badarg, ?STACKTRACE) end. eval_exp_field(Val, Size, Unit, integer, little, signed) -> @@ -131,7 +134,7 @@ eval_exp_field(Val, all, Unit, binary, _, _) -> Size when Size rem Unit =:= 0 -> <<Val:Size/binary-unit:1>>; _ -> - error(badarg) + erlang:raise(error, badarg, ?STACKTRACE) end; eval_exp_field(Val, Size, Unit, binary, _, _) -> <<Val:(Size*Unit)/binary-unit:1>>. @@ -377,12 +380,12 @@ make_bit_type(Line, default, Type0) -> {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}; - {error,Reason} -> error(Reason) + {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end; make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' case erl_bits:set_bit_type(Size, Type0) of {ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)}; - {error,Reason} -> error(Reason) + {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end. match_check_size(Mfun, Size, Bs) -> @@ -405,9 +408,3 @@ match_check_size(_, {value,_,_}, _Bs, _AllowAll) -> ok; %From the debugger. match_check_size(_, _, _Bs, _AllowAll) -> throw(invalid). - -%% error(Reason) -> exception thrown -%% Throw a nice-looking exception, similar to exceptions from erl_eval. -error(Reason) -> - erlang:raise(error, Reason, [{erl_eval,expr,3}]). - diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 0f90b3fc33..de839be5cf 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -582,17 +582,16 @@ default_search_rules() -> {"", ".c", c_source_search_rules()}, {"", ".in", basic_source_search_rules()}, %% plain old directory rules, backwards compatible - {"", ""}, - {"ebin","src"}, - {"ebin","esrc"} - ]. + {"", ""}] ++ erl_source_search_rules(). basic_source_search_rules() -> (erl_source_search_rules() ++ c_source_search_rules()). erl_source_search_rules() -> - [{"ebin","src"}, {"ebin","esrc"}]. + [{"ebin","src"}, {"ebin","esrc"}, + {"ebin",filename:join("src", "*")}, + {"ebin",filename:join("esrc", "*")}]. c_source_search_rules() -> [{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}]. @@ -672,8 +671,16 @@ try_dir_rule(Dir, Filename, From, To) -> Src = filename:join(NewDir, Filename), case is_regular(Src) of true -> {ok, Src}; - false -> error + false -> find_regular_file(wildcard(Src)) end; false -> error end. + +find_regular_file([]) -> + error; +find_regular_file([File|Files]) -> + case is_regular(File) of + true -> {ok, File}; + false -> find_regular_file(Files) + end. diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index a7980cc294..51e0c3f77e 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -551,7 +551,7 @@ format_stacktrace1(S0, Stack0, PF, SF, Enc) -> format_stacktrace2(S, Stack, 1, PF, Enc). format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~ts ~s">>, + [io_lib:fwrite(<<"~s~s ~ts ~ts">>, [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A, Enc), location(L)]) @@ -573,7 +573,7 @@ location(L) -> Line = proplists:get_value(line, L), if File =/= undefined, Line =/= undefined -> - io_lib:format("(~s, line ~w)", [File, Line]); + io_lib:format("(~ts, line ~w)", [File, Line]); true -> "" end. diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 212b143b1d..ad4984b64c 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -701,7 +701,9 @@ exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) -> {W,V0}; true -> case result_will_be_saved() of true -> V0; - false -> ignored + false -> + erlang:garbage_collect(), + ignored end end, {{value,V,Bs,get()},Bs}; diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c3ef4eb051..8eb85cab8e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. 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. @@ -41,6 +41,7 @@ otp_8133/1, otp_10622/1, otp_13228/1, + otp_14826/1, funs/1, try_catch/1, eval_expr_5/1, @@ -57,6 +58,7 @@ -export([count_down/2, count_down_fun/0, do_apply/2, local_func/3, local_func_value/2]). +-export([simple/0]). -ifdef(STANDALONE). -define(config(A,B),config(A,B)). @@ -83,7 +85,7 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, otp_10622, otp_13228, + otp_8133, otp_10622, otp_13228, otp_14826, funs, try_catch, eval_expr_5, zero_width, eep37, eep43]. @@ -988,6 +990,173 @@ otp_13228(_Config) -> EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end}, {value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH). +%% OTP-14826: more accurate stacktrace. +otp_14826(_Config) -> + backtrace_check("fun(P) when is_pid(P) -> true end(a).", + function_clause, + [{erl_eval,'-inside-an-interpreted-fun-',[a],[]}, + {erl_eval,eval_fun,6}, + ?MODULE]), + backtrace_check("B.", + {unbound_var, 'B'}, + [{erl_eval,expr,2}, ?MODULE]), + backtrace_check("B.", + {unbound, 'B'}, + [{erl_eval,expr,5}, ?MODULE], + none, none), + backtrace_check("1/0.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("catch 1/0.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + check(fun() -> catch exit(foo) end, + "catch exit(foo).", + {'EXIT', foo}), + check(fun() -> catch throw(foo) end, + "catch throw(foo).", + foo), + backtrace_check("try 1/0 after foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("catch (try 1/0 after foo end).", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("try catch 1/0 after foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_check("try a of b -> bar after foo end.", + {try_clause,a}, + [{erl_eval,try_clauses,8}]), + check(fun() -> X = try foo:bar() catch A:B:C -> {A,B} end, X end, + "try foo:bar() catch A:B:C -> {A,B} end.", + {error, undef}), + backtrace_check("C = 4, try foo:bar() catch A:B:C -> {A,B,C} end.", + stacktrace_bound, + [{erl_eval,check_stacktrace_vars,2}, + {erl_eval,try_clauses,8}], + none, none), + backtrace_catch("catch (try a of b -> bar after foo end).", + {try_clause,a}, + [{erl_eval,try_clauses,8}]), + backtrace_check("try 1/0 catch exit:a -> foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + Es = [{'try',1,[{call,1,{remote,1,{atom,1,foo},{atom,1,bar}},[]}], + [], + [{clause,1,[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}], + [],[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}]}],[]}], + try + erl_eval:exprs(Es, [], none, none), + ct:fail(stacktrace_variable) + catch + error:{illegal_stacktrace_variable,{atom,1,'C'}}:S -> + [{erl_eval,check_stacktrace_vars,2,_}, + {erl_eval,try_clauses,8,_}|_] = S + end, + backtrace_check("{1,1} = {A = 1, A = 2}.", + {badmatch, 1}, + [erl_eval, {lists,foldl,3}]), + backtrace_check("case a of a when foo:bar() -> x end.", + guard_expr, + [{erl_eval,guard0,4}], none, none), + backtrace_check("case a of foo() -> ok end.", + {illegal_pattern,{call,1,{atom,1,foo},[]}}, + [{erl_eval,match,4}], none, none), + backtrace_check("case a of b -> ok end.", + {case_clause,a}, + [{erl_eval,case_clauses,6}, ?MODULE]), + backtrace_check("if a =:= b -> ok end.", + if_clause, + [{erl_eval,if_clauses,5}, ?MODULE]), + backtrace_check("fun A(b) -> ok end(a).", + function_clause, + [{erl_eval,'-inside-an-interpreted-fun-',[a],[]}, + {erl_eval,eval_named_fun,8}, + ?MODULE]), + backtrace_check("[A || A <- a].", + {bad_generator, a}, + [{erl_eval,eval_generate,7}, {erl_eval, eval_lc, 6}]), + backtrace_check("<< <<A>> || <<A>> <= a>>.", + {bad_generator, a}, + [{erl_eval,eval_b_generate,7}, {erl_eval, eval_bc, 6}]), + backtrace_check("[A || A <- [1], begin a end].", + {bad_filter, a}, + [{erl_eval,eval_filter,6}, {erl_eval, eval_generate, 7}]), + fun() -> + {'EXIT', {{badarity, {_Fun, []}}, BT}} = + (catch parse_and_run("fun(A) -> A end().")), + check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT) + end(), + fun() -> + {'EXIT', {{badarity, {_Fun, []}}, BT}} = + (catch parse_and_run("fun F(A) -> A end().")), + check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT) + end(), + backtrace_check("foo().", + undef, + [{erl_eval,foo,0},{erl_eval,local_func,6}], + none, none), + backtrace_check("a orelse false.", + {badarg, a}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("a andalso false.", + {badarg, a}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("t = u.", + {badmatch, u}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("{math,sqrt}(2).", + {badfun, {math,sqrt}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("erl_eval_SUITE:simple().", + simple, + [{?MODULE,simple1,0},{?MODULE,simple,0},erl_eval]), + Args = [{integer,1,I} || I <- lists:seq(1, 30)], + backtrace_check("fun(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18," + "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.", + {argument_limit, + {'fun',1,[{clause,1,Args,[],[{atom,1,a}]}]}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("fun F(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18," + "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.", + {argument_limit, + {named_fun,1,'F',[{clause,1,Args,[],[{atom,1,a}]}]}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("#r{}.", + {undef_record,r}, + [{erl_eval,expr,5}, ?MODULE], + none, none), + %% eval_bits + backtrace_check("<<100:8/bitstring>>.", + badarg, + [{eval_bits,eval_exp_field1,6}, + eval_bits,eval_bits,erl_eval]), + backtrace_check("<<100:8/foo>>.", + {undefined_bittype,foo}, + [{eval_bits,make_bit_type,3},eval_bits, + eval_bits,erl_eval], + none, none), + backtrace_check("B = <<\"foo\">>, <<B/binary-unit:7>>.", + badarg, + [{eval_bits,eval_exp_field1,6}, + eval_bits,eval_bits,erl_eval], + none, none), + ok. + +simple() -> + A = simple1(), + {A}. + +simple1() -> + erlang:error(simple). + %% Simple cases, just to cover some code. funs(Config) when is_list(Config) -> do_funs(none, none), @@ -1488,6 +1657,43 @@ error_check(String, Result, LFH, EFH) -> ct:fail({eval, Other, Result}) end. +backtrace_check(String, Result, Backtrace) -> + case catch parse_and_run(String) of + {'EXIT', {Result, BT}} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +backtrace_check(String, Result, Backtrace, LFH, EFH) -> + case catch parse_and_run(String, LFH, EFH) of + {'EXIT', {Result, BT}} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +backtrace_catch(String, Result, Backtrace) -> + case parse_and_run(String) of + {value, {'EXIT', {Result, BT}}, _Bindings} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +check_backtrace([B1|Backtrace], [B2|BT]) -> + case {B1, B2} of + {M, {M,_,_,_}} -> + ok; + {{M,F,A}, {M,F,A,_}} -> + ok; + {B, B} -> + ok + end, + check_backtrace(Backtrace, BT); +check_backtrace([], _) -> + ok. + eval_string(String) -> {value, Result, _} = parse_and_run(String), Result. @@ -1499,8 +1705,8 @@ parse_and_run(String) -> parse_and_run(String, LFH, EFH) -> {ok,Tokens,_} = erl_scan:string(String), - {ok, [Expr]} = erl_parse:parse_exprs(Tokens), - erl_eval:expr(Expr, [], LFH, EFH). + {ok, Exprs} = erl_parse:parse_exprs(Tokens), + erl_eval:exprs(Exprs, [], LFH, EFH). no_final_dot(S) -> case lists:reverse(S) of diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 930cea347f..7403d52881 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2017. All Rights Reserved. +%% Copyright Ericsson AB 2005-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, - find_source/1]). + find_source/1, find_source_subdir/1]). -import(lists, [foreach/2]). @@ -49,7 +49,7 @@ all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, wildcard_symlink, is_file_symlink, file_props_symlink, - find_source]. + find_source, find_source_subdir]. groups() -> []. @@ -567,16 +567,18 @@ find_source(Config) when is_list(Config) -> [{".erl",".yrl",[{"",""}]}]), {ok, ParserErl} = filelib:find_source(code:which(core_parse)), + ParserErlName = filename:basename(ParserErl), + ParserErlDir = filename:dirname(ParserErl), {ok, ParserYrl} = filelib:find_source(ParserErl), "lry." ++ _ = lists:reverse(ParserYrl), - {ok, ParserYrl} = filelib:find_source(ParserErl, + {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir, [{".beam",".erl",[{"ebin","src"}]}, {".erl",".yrl",[{"",""}]}]), %% find_source automatically checks the local directory regardless of rules {ok, ParserYrl} = filelib:find_source(ParserErl), - {ok, ParserYrl} = filelib:find_source(ParserErl, - [{".beam",".erl",[{"ebin","src"}]}]), + {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir, + [{".erl",".yrl",[{"ebin","src"}]}]), %% find_file does not check the local directory unless in the rules ParserYrlName = filename:basename(ParserYrl), @@ -590,3 +592,24 @@ find_source(Config) when is_list(Config) -> {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir), {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []), ok. + +find_source_subdir(Config) when is_list(Config) -> + BeamFile = code:which(inets), % Located in lib/inets/src/inets_app/ + BeamName = filename:basename(BeamFile), + BeamDir = filename:dirname(BeamFile), + SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", + + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir), + SrcName = filename:basename(SrcFile), + + {error, not_found} = + filelib:find_source(BeamName, BeamDir, + [{".beam",".erl",[{"ebin","src"}]}]), + {ok, SrcFile} = + filelib:find_source(BeamName, BeamDir, + [{".beam",".erl", + [{"ebin",filename:join("src", "*")}]}]), + + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), + + ok. diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl index cc7e070dbd..9ad4bae2f5 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2017. All Rights Reserved. +%% Copyright Ericsson AB 2012-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -281,7 +281,7 @@ comparison(Kind) -> SimpleTimerMon = norm(SimpleTimerMon0, Simple0), Generic = norm(Generic0, Simple0), GenericTimer = norm(GenericTimer0, Simple0), - {Parallelism, _N, Message} = bench_params(Kind), + {Parallelism, Message} = bench_params(Kind), Wordsize = erlang:system_info(wordsize), MSize = Wordsize * erts_debug:flat_size(Message), What = io_lib:format("#parallel gen_server instances: ~.4w, " @@ -296,79 +296,78 @@ comparison(Kind) -> {comment, C}. norm(T, Ref) -> - io_lib:format("~.2f", [T/Ref]). + io_lib:format("~.2f", [Ref/T]). + +-define(MAX_TIME_SECS, 3). % s +-define(MAX_TIME, 1000 * ?MAX_TIME_SECS). % ms +-define(CALLS_PER_LOOP, 5). do_tests(Test, ParamSet) -> {Client, ServerMod} = bench(Test), - {Parallelism, N, Message} = bench_params(ParamSet), - Fun = create_clients(N, Message, ServerMod, Client, Parallelism), - Time = run_test(Fun), - TimesPerTest = 5, - PerSecond = Parallelism * TimesPerTest * round((1000 * N) / Time), + {Parallelism, Message} = bench_params(ParamSet), + Fun = create_clients(Message, ServerMod, Client, Parallelism), + {TotalLoops, AllPidTime} = run_test(Fun), + PerSecond = ?CALLS_PER_LOOP * round((1000 * TotalLoops) / AllPidTime), ct_event:notify(#event{name = benchmark_data, data = [{suite,"stdlib_gen_server"}, {value,PerSecond}]}), - Time. + PerSecond. + +-define(COUNTER, n). -simple_client(0, _, _P) -> - ok; simple_client(N, M, P) -> + put(?COUNTER, N), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), - simple_client(N-1, M, P). + simple_client(N+1, M, P). -simple_client_timer(0, _, _P) -> - ok; simple_client_timer(N, M, P) -> + put(?COUNTER, N), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), - simple_client_timer(N-1, M, P). + simple_client_timer(N+1, M, P). -simple_client_mon(0, _, _P) -> - ok; simple_client_mon(N, M, P) -> + put(?COUNTER, N), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), - simple_client_mon(N-1, M, P). + simple_client_mon(N+1, M, P). -simple_client_timer_mon(0, _, _P) -> - ok; simple_client_timer_mon(N, M, P) -> + put(?COUNTER, N), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), - simple_client_timer_mon(N-1, M, P). + simple_client_timer_mon(N+1, M, P). -generic_client(0, _, _P) -> - ok; generic_client(N, M, P) -> + put(?COUNTER, N), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), - generic_client(N-1, M, P). + generic_client(N+1, M, P). -generic_timer_client(0, _, _P) -> - ok; generic_timer_client(N, M, P) -> + put(?COUNTER, N), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), - generic_timer_client(N-1, M, P). + generic_timer_client(N+1, M, P). bench(simple) -> {fun simple_client/3, simple_server}; @@ -383,16 +382,16 @@ bench(generic) -> bench(generic_timer) -> {fun generic_timer_client/3, generic_server_timer}. -%% -> {Parallelism, NumberOfMessages, MessageTerm} -bench_params(single_small) -> {1, 700000, small()}; -bench_params(single_medium) -> {1, 350000, medium()}; -bench_params(single_big) -> {1, 70000, big()}; -bench_params(sched_small) -> {parallelism(), 200000, small()}; -bench_params(sched_medium) -> {parallelism(), 100000, medium()}; -bench_params(sched_big) -> {parallelism(), 20000, big()}; -bench_params(multi_small) -> {400, 2000, small()}; -bench_params(multi_medium) -> {400, 1000, medium()}; -bench_params(multi_big) -> {400, 200, big()}. +%% -> {Parallelism, MessageTerm} +bench_params(single_small) -> {1, small()}; +bench_params(single_medium) -> {1, medium()}; +bench_params(single_big) -> {1, big()}; +bench_params(sched_small) -> {parallelism(), small()}; +bench_params(sched_medium) -> {parallelism(), medium()}; +bench_params(sched_big) -> {parallelism(), big()}; +bench_params(multi_small) -> {400, small()}; +bench_params(multi_medium) -> {400, medium()}; +bench_params(multi_big) -> {400, big()}. small() -> small. @@ -409,19 +408,38 @@ parallelism() -> _ -> 1 end. -create_clients(N, M, ServerMod, Client, Parallel) -> +create_clients(M, ServerMod, Client, Parallel) -> fun() -> State = term, ServerPid = ServerMod:start(State), - PidRefs = [spawn_monitor(fun() -> Client(N, M, ServerPid) end) || + PidRefs = [spawn_monitor(fun() -> Client(0, M, ServerPid) end) || _ <- lists:seq(1, Parallel)], - _ = [receive {'DOWN', Ref, _, _, _} -> ok end || - {_Pid, Ref} <- PidRefs], - ok = ServerMod:stop(ServerPid) + timer:sleep(?MAX_TIME), + try + AllPidsN = collect(PidRefs, []), + TotalLoops = lists:sum(AllPidsN), + TotalLoops + after + ok = ServerMod:stop(ServerPid) + end end. +collect([], Result) -> + Result; +collect([{Pid, Ref}|PidRefs], Result) -> + N = case erlang:process_info(Pid, dictionary) of + {dictionary, Dict} -> + {?COUNTER, N0} = lists:keyfind(?COUNTER, 1, Dict), + N0; + undefined -> % Process did not start in ?MAX_TIME_SECS. + 0 + end, + exit(Pid, kill), + receive {'DOWN', Ref, _, _, _} -> ok end, + collect(PidRefs, [N|Result]). + run_test(Test) -> {T1, _} = statistics(runtime), - Test(), + Result = Test(), {T2, _} = statistics(runtime), - T2 - T1. + {Result, T2 - T1}. diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index f03f326278..60a15c8e3f 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -780,8 +780,7 @@ lay_2(Node, Ctxt) -> '_' -> beside(D1, beside(text(":"), D2)); _ -> - D3 = lay(erl_syntax:class_qualifier_stacktrace(Node), - Ctxt1), + D3 = lay(Stacktrace, Ctxt1), beside(D1, beside(beside(text(":"), D2), beside(text(":"), D3))) end; diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index ed552b73df..b816c0699c 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -3895,7 +3895,9 @@ fold_try_clause({clause, Pos, [P], Guard, Body}) -> unfold_try_clauses(Cs) -> [unfold_try_clause(C) || C <- Cs]. -unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, V, _]}], +unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, + V, + [{var, _, '_'}]]}], Guard, Body}) -> {clause, Pos, [V], Guard, Body}; unfold_try_clause({clause, Pos, [{tuple, _, [C, V, Stacktrace]}], @@ -7761,8 +7763,9 @@ subtrees(T) -> catch_expr -> [[catch_expr_body(T)]]; class_qualifier -> - [[class_qualifier_argument(T)], - [class_qualifier_body(T)]]; + [[class_qualifier_argument(T)], + [class_qualifier_body(T)], + [class_qualifier_stacktrace(T)]]; clause -> case clause_guard(T) of none -> @@ -7983,6 +7986,7 @@ make_tree(block_expr, [B]) -> block_expr(B); make_tree(case_expr, [[A], C]) -> case_expr(A, C); make_tree(catch_expr, [[B]]) -> catch_expr(B); make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B); +make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C); make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); make_tree(cond_expr, [C]) -> cond_expr(C); diff --git a/system/doc/getting_started/seq_prog.xml b/system/doc/getting_started/seq_prog.xml index 6b7e1cd24f..2b0750ff80 100644 --- a/system/doc/getting_started/seq_prog.xml +++ b/system/doc/getting_started/seq_prog.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2016</year> + <year>2003</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -271,11 +271,12 @@ convert(N, centimeter) -> {'EXIT',{function_clause,[{tut2,convert, [3,miles], [{file,"tut2.erl"},{line,4}]}, - {erl_eval,do_apply,5,[{file,"erl_eval.erl"},{line,482}]}, - {shell,exprs,7,[{file,"shell.erl"},{line,666}]}, - {shell,eval_exprs,7,[{file,"shell.erl"},{line,621}]}, - {shell,eval_loop,3,[{file,"shell.erl"},{line,606}]}]}}</pre> - + {erl_eval,do_apply,6, + [{file,"erl_eval.erl"},{line,677}]}, + {shell,exprs,7,[{file,"shell.erl"},{line,687}]}, + {shell,eval_exprs,7,[{file,"shell.erl"},{line,642}]}, + {shell,eval_loop,3, + [{file,"shell.erl"},{line,627}]}]}}</pre> </section> <section> |