diff options
88 files changed, 2107 insertions, 792 deletions
diff --git a/HOWTO/INSTALL-WIN32.md b/HOWTO/INSTALL-WIN32.md index c74107d749..4304fb3fb8 100644 --- a/HOWTO/INSTALL-WIN32.md +++ b/HOWTO/INSTALL-WIN32.md @@ -612,7 +612,7 @@ tools: We would recommend using 1.0.2d. -* Building with wxWidgets. Download wxWidgets-3.0.2 or higher. +* Building with wxWidgets. Download wxWidgets-3.0.3 or higher. Install or unpack it to the pgm folder: Cygwin: @@ -622,19 +622,19 @@ tools: MSYS2: `DRIVE:/PATH/msys<32/64>/opt/local/pgm` - If the `wxUSE_POSTSCRIPT` isn't enabled in `<path\to\pgm>\wxMSW-3.0.2\include\wx\msw\setup.h`, + If the `wxUSE_POSTSCRIPT` isn't enabled in `<path\to\pgm>\wxMSW-3.0.3\include\wx\msw\setup.h`, enable it. build: From a command prompt with the VC tools available (See the instructions for OpenSSL build above for help on starting the proper command prompt in RELEASE mode): - C:\...\> cd <path\to\pgm>\wxMSW-3.0.2\build\msw + C:\...\> cd <path\to\pgm>\wxMSW-3.0.3\build\msw C:\...\> nmake BUILD=release SHARED=0 DIR_SUFFIX_CPU= -f makefile.vc Or - if building a 64bit version: - C:\...\> cd <path\to\pgm>\wxMSW-3.0.2\build\msw + C:\...\> cd <path\to\pgm>\wxMSW-3.0.3\build\msw C:\...\> nmake TARGET_CPU=amd64 BUILD=release SHARED=0 DIR_SUFFIX_CPU= -f makefile.vc * Get the Erlang source distribution (from <http://www.erlang.org/download.html>). diff --git a/erts/Makefile b/erts/Makefile index e9928b6b47..12d2ec57a8 100644 --- a/erts/Makefile +++ b/erts/Makefile @@ -40,8 +40,8 @@ all: $(FLAVORS) docs: $(V_at)( cd doc/src && $(MAKE) $@ ) -.PHONY: debug opt clean -debug opt clean: +.PHONY: debug opt lcnt clean +debug opt lcnt clean: $(V_at)for d in emulator $(ERTSDIRS); do \ if test -d $$d; then \ ( cd $$d && $(MAKE) $@ FLAVOR=$(FLAVOR) ) || exit $$? ; \ @@ -56,7 +56,9 @@ debug opt clean: .PHONY: $(FLAVORS) $(FLAVORS): - $(V_at)( $(MAKE) opt FLAVOR=$@ ) + $(V_at)for type in $(TYPES); do \ + ( $(MAKE) $$type FLAVOR=$@ ); \ + done # Make erl script and erlc in $(ERL_TOP)/bin which runs the compiled version # Note that erlc is not a script and requires extra handling on cygwin. @@ -128,7 +130,9 @@ makefiles: .PHONY: release release: $(V_at)for f in $(FLAVORS); do \ - ( cd emulator && $(MAKE) release FLAVOR=$$f ) \ + for t in $(TYPES); do \ + ( cd emulator && $(MAKE) release FLAVOR=$$f TYPE=$$t ) \ + done \ done $(V_at)for d in $(ERTSDIRS) $(XINSTDIRS); do \ if test -d $$d; then \ diff --git a/erts/configure.in b/erts/configure.in index c82ebaa74c..830e3d7776 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1002,6 +1002,7 @@ else fi FLAVORS= +TYPES=opt ERTS_BUILD_SMP_EMU=$enable_smp_support AC_MSG_CHECKING(whether an emulator with smp support should be built) case $ERTS_BUILD_SMP_EMU in @@ -1210,6 +1211,7 @@ esac AC_SUBST(ERTS_BUILD_PLAIN_EMU) AC_SUBST(FLAVORS) +AC_SUBST(TYPES) case "$ERTS_BUILD_PLAIN_EMU-$ERTS_BUILD_SMP_EMU" in no-no) @@ -1365,7 +1367,7 @@ else AC_MSG_CHECKING(whether lock counters should be enabled) AC_MSG_RESULT($enable_lock_count) if test "x$enable_lock_count" != "xno"; then - EMU_THR_DEFS="$EMU_THR_DEFS -DERTS_ENABLE_LOCK_COUNT" + TYPES="$TYPES lcnt" fi case $host_os in diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 6046e94599..e1aa5ce76e 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -239,6 +239,13 @@ <item> <p>Useful for debugging. Prints the arguments sent to the emulator.</p> </item> + <tag><c><![CDATA[-emu_type Type]]></c></tag> + <item> + <p>Start an emulator of a different type. For example, to start + the lock-counter emualator, use <c>-emu_type lcnt</c>. (The emulator + must already be built. Use the <c>configure</c> option + <c>--enable-lock-counter</c> to build the lock-counter emulator.)</p> + </item> <tag><c><![CDATA[-env Variable Value]]></c></tag> <item> <p>Sets the host OS environment variable <c><![CDATA[Variable]]></c> to diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 6f70ae4a52..6d165e9eff 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1813,8 +1813,9 @@ true</pre> <fsummary>Get the call stack back-trace of the last exception.</fsummary> <type name="stack_item"/> <desc> - <p>Gets the call stack back-trace (<em>stacktrace</em>) of the - last exception in the calling process as a list of + <p>Gets the call stack back-trace (<em>stacktrace</em>) for an + exception that has just been caught + in the calling process as a list of <c>{<anno>Module</anno>,<anno>Function</anno>,<anno>Arity</anno>,<anno>Location</anno>}</c> tuples. Field <c><anno>Arity</anno></c> in the first tuple can be the argument list of that function call instead of an arity integer, @@ -1822,6 +1823,29 @@ true</pre> <p>If there has not been any exceptions in a process, the stacktrace is <c>[]</c>. After a code change for the process, the stacktrace can also be reset to <c>[]</c>.</p> + <p><c>erlang:get_stacktrace/0</c> is only guaranteed to return + a stacktrace if called (directly or indirectly) from within the + scope of a <c>try</c> expression. That is, the following call works:</p> +<pre> +try Expr +catch + C:R -> + {C,R,erlang:get_stacktrace()} +end</pre> + <p>As does this call:</p> +<pre> +try Expr +catch + C:R -> + {C,R,helper()} +end + +helper() -> + erlang:get_stacktrace().</pre> + + <warning><p>In a future release, + <c>erlang:get_stacktrace/0</c> will return <c>[]</c> if called + from outside a <c>try</c> expression.</p></warning> <p>The stacktrace is the same data as operator <c>catch</c> returns, for example:</p> <pre> diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 4baee7900b..1f6feade1c 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2266,21 +2266,6 @@ Eterm big_minus(Eterm x, Eterm y, Eterm *r) } /* -** Subtract a digit from big number -*/ -Eterm big_minus_small(Eterm x, Eterm y, Eterm *r) -{ - Eterm* xp = big_val(x); - - if (BIG_SIGN(xp)) - return big_norm(r, D_add(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, BIG_V(r)), - (short) BIG_SIGN(xp)); - else - return big_norm(r, D_sub(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, BIG_V(r)), - (short) BIG_SIGN(xp)); -} - -/* ** Multiply smallnums */ @@ -2412,16 +2397,6 @@ Eterm big_rem(Eterm x, Eterm y, Eterm *r) } } -Eterm big_neg(Eterm x, Eterm *r) -{ - Eterm* xp = big_val(x); - dsize_t xsz = BIG_SIZE(xp); - short xsgn = BIG_SIGN(xp); - - MOVE_DIGITS(BIG_V(r), BIG_V(xp), xsz); - return big_norm(r, xsz, (short) !xsgn); -} - Eterm big_band(Eterm x, Eterm y, Eterm *r) { Eterm* xp = big_val(x); diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 4a96d971c3..258038a157 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -118,9 +118,7 @@ Eterm big_minus(Eterm, Eterm, Eterm*); Eterm big_times(Eterm, Eterm, Eterm*); Eterm big_div(Eterm, Eterm, Eterm*); Eterm big_rem(Eterm, Eterm, Eterm*); -Eterm big_neg(Eterm, Eterm*); -Eterm big_minus_small(Eterm, Uint, Eterm*); Eterm big_plus_small(Eterm, Uint, Eterm*); Eterm big_times_small(Eterm, Uint, Eterm*); diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index b2c1133ded..169e1e423d 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -3512,28 +3512,6 @@ void erts_allctr_wrapper_pre_unlock(void) } - -/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ - * Deprecated functions * - * * - * These functions are still defined since "non-OTP linked in drivers" may * - * contain (illegal) calls to them. * -\* */ - -/* --- DO *NOT* USE THESE FUNCTIONS --- */ - -void *sys_alloc(Uint sz) -{ return erts_alloc_fnf(ERTS_ALC_T_UNDEF, sz); } -void *sys_realloc(void *ptr, Uint sz) -{ return erts_realloc_fnf(ERTS_ALC_T_UNDEF, ptr, sz); } -void sys_free(void *ptr) -{ erts_free(ERTS_ALC_T_UNDEF, ptr); } -void *safe_alloc(Uint sz) -{ return erts_alloc(ERTS_ALC_T_UNDEF, sz); } -void *safe_realloc(void *ptr, Uint sz) -{ return erts_realloc(ERTS_ALC_T_UNDEF, ptr, sz); } - - /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * NOTE: erts_alc_test() is only supposed to be used for testing. * * * diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 56a3b73bf9..758d529f87 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -173,13 +173,6 @@ __decl_noreturn void erts_realloc_n_enomem(ErtsAlcType_t,void*,Uint) __decl_noreturn void erts_alc_fatal_error(int,int,ErtsAlcType_t,...) __noreturn; -/* --- DO *NOT* USE THESE DEPRECATED FUNCTIONS --- Instead use: */ -void *safe_alloc(Uint) __deprecated; /* erts_alloc() */ -void *safe_realloc(void *, Uint) __deprecated; /* erts_realloc() */ -void sys_free(void *) __deprecated; /* erts_free() */ -void *sys_alloc(Uint ) __deprecated; /* erts_alloc_fnf() */ -void *sys_realloc(void *, Uint) __deprecated; /* erts_realloc_fnf() */ - #undef ERTS_HAVE_IS_IN_LITERAL_RANGE #if defined(ARCH_32) || defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) # define ERTS_HAVE_IS_IN_LITERAL_RANGE diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 28aaeeb479..4347f9f2b7 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -827,17 +827,6 @@ erts_sched_bind_atfork_child(int unbind) return 0; } -char * -erts_sched_bind_atvfork_child(int unbind) -{ - if (unbind) { - ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&cpuinfo_rwmtx) - || erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx)); - return erts_get_unbind_from_cpu_str(cpuinfo); - } - return "false"; -} - void erts_sched_bind_atfork_parent(int unbind) { diff --git a/erts/emulator/beam/erl_cpu_topology.h b/erts/emulator/beam/erl_cpu_topology.h index 45324ac4a0..cf139d95a9 100644 --- a/erts/emulator/beam/erl_cpu_topology.h +++ b/erts/emulator/beam/erl_cpu_topology.h @@ -85,22 +85,14 @@ void erts_sched_bind_atthrcreate_parent(int unbind); int erts_sched_bind_atfork_prepare(void); int erts_sched_bind_atfork_child(int unbind); -char *erts_sched_bind_atvfork_child(int unbind); void erts_sched_bind_atfork_parent(int unbind); Eterm erts_fake_scheduler_bindings(Process *p, Eterm how); Eterm erts_debug_cpu_groups_map(Process *c_p, int groups); - typedef void (*erts_cpu_groups_callback_t)(int, ErtsSchedulerData *, int, void *); -void erts_add_cpu_groups(int groups, - erts_cpu_groups_callback_t callback, - void *arg); -void erts_remove_cpu_groups(erts_cpu_groups_callback_t callback, - void *arg); - #endif diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index eaed15b14b..13eacaa8a9 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1301,11 +1301,6 @@ int db_match_keeps_key(int keypos, Eterm match, Eterm guard, Eterm body) return 0; } -/* This is used when tracing */ -Eterm erts_match_set_lint(Process *p, Eterm matchexpr) { - return db_match_set_lint(p, matchexpr, DCOMP_TRACE); -} - Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags) { Eterm l; @@ -2017,7 +2012,8 @@ restart: do_catch = 0; fail_label = -1; build_proc = psp; - esdp->current_process = psp; + if (esdp) + esdp->current_process = psp; #ifdef DEBUG ASSERT(variables == mpsp->u.variables); @@ -2686,7 +2682,8 @@ restart: do_catch = 1; if (in_flags & ERTS_PAM_COPY_RESULT) { build_proc = c_p; - esdp->current_process = c_p; + if (esdp) + esdp->current_process = c_p; } break; case matchHalt: diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index a7a8da4ed8..2ff49c97b3 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -439,7 +439,7 @@ Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) { return erts_gc_after_bif_call_lhf(p, ERTS_INVALID_HFRAG_PTR, - result, regs, arity); + result, regs, arity); } static ERTS_INLINE void reset_active_writer(Process *p) diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index fb38327d02..ac99f043e6 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -309,30 +309,6 @@ void erl_error(char *fmt, va_list args) static int early_init(int *argc, char **argv); -void -erts_short_init(void) -{ - - int ncpu; - int time_correction; - ErtsTimeWarpMode time_warp_mode; - - set_default_time_adj(&time_correction, - &time_warp_mode); - ncpu = early_init(NULL, NULL); - erl_init(ncpu, - ERTS_DEFAULT_MAX_PROCESSES, - 0, - ERTS_DEFAULT_MAX_PORTS, - 0, - 0, - time_correction, - time_warp_mode, - ERTS_NODE_TAB_DELAY_GC_DEFAULT, - ERTS_DB_SPNCNT_NORMAL); - erts_initialized = 1; -} - static void erl_init(int ncpu, int proc_tab_sz, diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index bbdadafade..c305732d63 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -177,8 +177,8 @@ ERL_NIF_API_FUNC_DECL(int,enif_thread_type,(void)); ERL_NIF_API_FUNC_DECL(int,enif_snprintf,(char * buffer, size_t size, const char *format, ...)); ERL_NIF_API_FUNC_DECL(int,enif_select,(ErlNifEnv* env, ErlNifEvent e, enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, ERL_NIF_TERM ref)); ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type_x,(ErlNifEnv*, const char* name_str, const ErlNifResourceTypeInit*, ErlNifResourceFlags flags, ErlNifResourceFlags* tried)); -ERL_NIF_API_FUNC_DECL(int, enif_monitor_process,(ErlNifEnv*,void* obj,const ErlNifPid*,ErlDrvMonitor *monitor)); -ERL_NIF_API_FUNC_DECL(int, enif_demonitor_process,(ErlNifEnv*,void* obj,const ErlDrvMonitor *monitor)); +ERL_NIF_API_FUNC_DECL(int, enif_monitor_process,(ErlNifEnv*,void* obj,const ErlNifPid*,ErlNifMonitor *monitor)); +ERL_NIF_API_FUNC_DECL(int, enif_demonitor_process,(ErlNifEnv*,void* obj,const ErlNifMonitor *monitor)); ERL_NIF_API_FUNC_DECL(int, enif_compare_monitors,(const ErlNifMonitor*,const ErlNifMonitor*)); ERL_NIF_API_FUNC_DECL(ErlNifUInt64,enif_hash,(ErlNifHash type, ERL_NIF_TERM term, ErlNifUInt64 salt)); diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 206078903d..5c947ad1c0 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -988,16 +988,6 @@ typedef enum { ERTS_PORT_OP_DONE } ErtsPortOpResult; -ErtsPortOpResult -erts_schedule_proc2port_signal(Process *, - Port *, - Eterm, - Eterm *, - ErtsProc2PortSigData *, - int, - ErtsPortTaskHandle *, - ErtsProc2PortSigCallback); - int erts_deliver_port_exit(Port *, Eterm, Eterm, int, int); /* diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 4836b9e2d3..55526e1d5e 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -2161,13 +2161,6 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) #endif } -int -erts_port_is_scheduled(Port *pp) -{ - erts_aint32_t flags = erts_smp_atomic32_read_acqb(&pp->sched.flags); - return (flags & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)) != 0; -} - #ifdef ERTS_SMP void diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 858ddfe029..ab536c6f27 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -267,7 +267,6 @@ int erts_port_task_schedule(Eterm, ErtsPortTaskType, ...); void erts_port_task_free_port(Port *); -int erts_port_is_scheduled(Port *); ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data(void); ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr); void erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index a56ef4aedb..da27c7e7c6 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1538,12 +1538,6 @@ proclist_destroy(ErtsProcList *plp) } ErtsProcList * -erts_proclist_copy(ErtsProcList *plp) -{ - return proclist_copy(plp); -} - -ErtsProcList * erts_proclist_create(Process *p) { return proclist_create(p); @@ -3275,13 +3269,6 @@ thr_prgr_fin_wait(void *vssi) static void init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp); -void -erts_interupt_aux_thread_timed(ErtsMonotonicTime timeout_time) -{ - /* TODO only poke when needed (based on timeout_time) */ - erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(-1)); -} - static void * aux_thread(void *unused) { @@ -9316,17 +9303,6 @@ erts_pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, } /* - * Like erts_pid2proc_not_running(), but hands over the process - * in a suspended state unless (c_p is looked up). - */ -Process * -erts_pid2proc_suspend(Process *c_p, ErtsProcLocks c_p_locks, - Eterm pid, ErtsProcLocks pid_locks) -{ - return pid2proc_not_running(c_p, c_p_locks, pid, pid_locks, 1); -} - -/* * erts_pid2proc_nropt() is normally the same as * erts_pid2proc_not_running(). However it is only * to be used when 'not running' is a pure optimization, @@ -9444,21 +9420,6 @@ handle_pend_bif_async_suspend(Process *suspendee, } } -#else - -/* - * Non-smp version of erts_pid2proc_suspend(). - */ -Process * -erts_pid2proc_suspend(Process *c_p, ErtsProcLocks c_p_locks, - Eterm pid, ErtsProcLocks pid_locks) -{ - Process *rp = erts_pid2proc(c_p, c_p_locks, pid, pid_locks); - if (rp) - erts_suspend(rp, pid_locks, NULL); - return rp; -} - #endif /* ERTS_SMP */ /* diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 6113c8aa05..2b169bb9ce 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1606,7 +1606,6 @@ Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); ErtsProcList *erts_proclist_create(Process *); -ErtsProcList *erts_proclist_copy(ErtsProcList *); void erts_proclist_destroy(ErtsProcList *); ERTS_GLB_INLINE int erts_proclist_same(ErtsProcList *, Process *); @@ -2556,10 +2555,6 @@ ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start, ErtsMonotonicTime end) } #endif -Process *erts_pid2proc_suspend(Process *, - ErtsProcLocks, - Eterm, - ErtsProcLocks); #ifdef ERTS_SMP Process *erts_pid2proc_not_running(Process *, @@ -2601,8 +2596,6 @@ extern int erts_disable_proc_not_running_opt; void erts_smp_notify_inc_runq(ErtsRunQueue *runq); -void erts_interupt_aux_thread_timed(ErtsMonotonicTime timeout_time); - #ifdef ERTS_SMP void erts_sched_finish_poke(ErtsSchedulerSleepInfo *, erts_aint32_t); ERTS_GLB_INLINE void erts_sched_poke(ErtsSchedulerSleepInfo *ssi); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index e3be6a5a22..fc95535ec3 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1132,7 +1132,6 @@ extern erts_tid_t erts_main_thread; #endif extern int erts_compat_rel; extern int erts_use_sender_punish; -void erts_short_init(void); void erl_start(int, char**); void erts_usage(void); Eterm erts_preloaded(Process* p); @@ -1439,7 +1438,6 @@ do { \ #define MatchSetGetSource(MPSP) erts_match_set_get_source(MPSP) extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr, Eterm MFA); -Eterm erts_match_set_lint(Process *p, Eterm matchexpr); extern void erts_match_set_release_result(Process* p); ERTS_GLB_INLINE void erts_match_set_release_result_trace(Process* p, Eterm); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 93a5ed4397..d25e53ada0 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1511,7 +1511,7 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg, Port* prt) } -ErtsPortOpResult +static ErtsPortOpResult erts_schedule_proc2port_signal(Process *c_p, Port *prt, Eterm caller, diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index f73c4ef1ca..70520eea15 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -184,17 +184,6 @@ static char *plusz_val_switches[] = { #endif #define SMP_SUFFIX ".smp" -#define DEBUG_SUFFIX ".debug" -#define EMU_TYPE_SUFFIX_LENGTH strlen(DEBUG_SUFFIX) - -/* - * Define flags for different memory architectures. - */ -#define EMU_TYPE_SMP 0x0001 - -#ifdef __WIN32__ -#define EMU_TYPE_DEBUG 0x0004 -#endif void usage(const char *switchname); static void usage_format(char *format, ...); @@ -221,7 +210,7 @@ static void *erealloc(void *p, size_t size); static void efree(void *p); static char* strsave(char* string); static int is_one_of_strings(char *str, char *strs[]); -static char *write_str(char *to, char *from); +static char *write_str(char *to, const char *from); static void get_home(void); static void add_epmd_port(void); #ifdef __WIN32__ @@ -255,9 +244,8 @@ static int verbose = 0; /* If non-zero, print some extra information. */ static int start_detached = 0; /* If non-zero, the emulator should be * started detached (in the background). */ -static int emu_type = 0; /* If non-zero, start beam.ARCH or beam.ARCH.exe - * instead of beam or beam.exe, where ARCH is defined by flags. */ -static int emu_type_passed = 0; /* Types explicitly set */ +static int start_smp_emu = 0; /* Start the smp emulator. */ +static const char* emu_type = 0; /* Type of emulator (lcnt, valgrind, etc) */ #ifdef __WIN32__ static char *start_emulator_program = NULL; /* For detachec mode - @@ -352,11 +340,11 @@ free_env_val(char *value) } /* - * Add the architecture suffix to the program name if needed, - * except on Windows, where we insert it just before ".DLL". + * Add the type and architecture suffix to the program name if needed. + * On Windows, we insert it just before ".DLL". */ static char* -add_extra_suffixes(char *prog, int type) +add_extra_suffixes(char *prog) { char *res; char *p; @@ -366,16 +354,10 @@ add_extra_suffixes(char *prog, int type) int dll = 0; #endif - if (!type) { - return prog; - } - len = strlen(prog); - /* Worst-case allocation */ - p = emalloc(len + - EMU_TYPE_SUFFIX_LENGTH + - + 1); + /* Allocate enough extra space for suffixes */ + p = emalloc(len + 100); res = p; p = write_str(p, prog); @@ -392,13 +374,11 @@ add_extra_suffixes(char *prog, int type) } #endif -#ifdef __WIN32__ - if (type & EMU_TYPE_DEBUG) { - p = write_str(p, DEBUG_SUFFIX); - type &= ~(EMU_TYPE_DEBUG); + if (emu_type) { + p = write_str(p, "."); + p = write_str(p, emu_type); } -#endif - if (type == EMU_TYPE_SMP) { + if (start_smp_emu) { p = write_str(p, SMP_SUFFIX); } #ifdef __WIN32__ @@ -489,12 +469,11 @@ int main(int argc, char **argv) cpuinfo = erts_cpu_info_create(); /* '-smp auto' is default */ #ifdef ERTS_HAVE_SMP_EMU - emu_type |= EMU_TYPE_SMP; + start_smp_emu = 1; #endif #if defined(__WIN32__) && defined(WIN32_ALWAYS_DEBUG) - emu_type_passed |= EMU_TYPE_DEBUG; - emu_type |= EMU_TYPE_DEBUG; + emu_type = "debug"; #endif /* We need to do this before the ordinary processing. */ @@ -519,57 +498,42 @@ int main(int argc, char **argv) if (strcmp(argv[i+1], "auto") == 0) { i++; - smp_auto: - emu_type_passed |= EMU_TYPE_SMP; -#if defined(ERTS_HAVE_PLAIN_EMU) && !defined(ERTS_HAVE_SMP_EMU) - emu_type &= ~EMU_TYPE_SMP; -#else - emu_type |= EMU_TYPE_SMP; -#endif - } - else if (strcmp(argv[i+1], "enable") == 0) { + } else if (strcmp(argv[i+1], "enable") == 0) { i++; smp_enable: - emu_type_passed |= EMU_TYPE_SMP; -#ifdef ERTS_HAVE_SMP_EMU - emu_type |= EMU_TYPE_SMP; -#else + ; +#if !defined(ERTS_HAVE_SMP_EMU) usage_notsup("-smp enable", ""); #endif - } - else if (strcmp(argv[i+1], "disable") == 0) { + } else if (strcmp(argv[i+1], "disable") == 0) { i++; smp_disable: - emu_type_passed &= ~EMU_TYPE_SMP; #ifdef ERTS_HAVE_PLAIN_EMU - emu_type &= ~EMU_TYPE_SMP; + start_smp_emu = 0; #else usage_notsup("-smp disable", " Use \"+S 1\" instead."); #endif - } - else { + } else { smp: - - emu_type_passed |= EMU_TYPE_SMP; -#ifdef ERTS_HAVE_SMP_EMU - emu_type |= EMU_TYPE_SMP; -#else + ; +#if !defined(ERTS_HAVE_SMP_EMU) usage_notsup("-smp", ""); #endif } } else if (strcmp(argv[i], "-smpenable") == 0) { goto smp_enable; } else if (strcmp(argv[i], "-smpauto") == 0) { - goto smp_auto; + ; } else if (strcmp(argv[i], "-smpdisable") == 0) { goto smp_disable; -#ifdef __WIN32__ - } else if (strcmp(argv[i], "-debug") == 0) { - emu_type_passed |= EMU_TYPE_DEBUG; - emu_type |= EMU_TYPE_DEBUG; -#endif } else if (strcmp(argv[i], "-extra") == 0) { break; + } else if (strcmp(argv[i], "-emu_type") == 0) { + if (i + 1 >= argc) { + usage(argv[i]); + } + emu_type = argv[i+1]; + i++; } } i++; @@ -582,7 +546,7 @@ int main(int argc, char **argv) if (strcmp(malloc_lib, "libc") != 0) usage("+MYm"); } - emu = add_extra_suffixes(emu, emu_type); + emu = add_extra_suffixes(emu); emu_name = strsave(emu); erts_snprintf(tmpStr, sizeof(tmpStr), "%s" DIRSEP "%s" BINARY_EXT, bindir, emu); emu = strsave(tmpStr); @@ -1176,7 +1140,11 @@ int main(int argc, char **argv) { execv(emu, Eargsp); } - error("Error %d executing \'%s\'.", errno, emu); + if (errno == ENOENT) { + error("The emulator \'%s\' does not exist.", emu); + } else { + error("Error %d executing \'%s\'.", errno, emu); + } return 1; #endif } @@ -1376,7 +1344,7 @@ is_one_of_strings(char *str, char *strs[]) return 0; } -static char *write_str(char *to, char *from) +static char *write_str(char *to, const char *from) { while (*from) *(to++) = *(from++); @@ -1903,6 +1871,7 @@ read_args_file(char *filename) #undef SAVE_CHAR } + typedef struct { char **argv; int argc; diff --git a/erts/etc/unix/Makefile b/erts/etc/unix/Makefile index 2fa9cd047b..17de4d8878 100644 --- a/erts/etc/unix/Makefile +++ b/erts/etc/unix/Makefile @@ -24,7 +24,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk -opt debug: etc +opt debug lcnt: etc .PHONY: etc etc: etp-commands @@ -44,4 +44,4 @@ clean: include $(ERL_TOP)/make/otp_release_targets.mk .PHONY: release_spec -release_spec: etc
\ No newline at end of file +release_spec: etc diff --git a/erts/start_scripts/Makefile b/erts/start_scripts/Makefile index ae2521474e..047e42170a 100644 --- a/erts/start_scripts/Makefile +++ b/erts/start_scripts/Makefile @@ -68,7 +68,7 @@ include $(LIBPATH)/stdlib/vsn.mk ############################################################################## -debug opt script: rel $(INSTALL_SCRIPTS) $(RELEASES_SRC) +debug opt lcnt script: rel $(INSTALL_SCRIPTS) $(RELEASES_SRC) rel: $(REL_SCRIPTS) diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index fed68037c1..10164890f2 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -629,6 +629,14 @@ module.beam: module.erl \ <p>Turns off warnings for unused record types. Default is to emit warnings for unused locally defined record types.</p> </item> + + <tag><c>nowarn_get_stacktrace</c></tag> + <item> + <p>Turns off warnings for using <c>get_stacktrace/0</c> in a context + where it will probably not work in a future release. For example, + by default there will be a warning if <c>get_stacktrace/0</c> is + used following a <c>catch</c> expression.</p> + </item> </taglist> <p>Another class of warnings is generated by the compiler diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 3f0439ed80..793cff166c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1089,9 +1089,6 @@ static void init_algorithms_types(ErlNifEnv* env) #ifndef OPENSSL_NO_RC4 algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc4"); #endif -#if defined(HAVE_GCM) - algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm"); -#endif #if defined(HAVE_CHACHA20_POLY1305) algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305"); #endif diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml index 696b7dfa31..acf0d2163a 100644 --- a/lib/inets/doc/src/http_uri.xml +++ b/lib/inets/doc/src/http_uri.xml @@ -45,6 +45,7 @@ this module:</p> <p><c>boolean() = true | false</c></p> <p><c>string()</c> = list of ASCII characters</p> + <p><c>unicode_binary()</c> = binary() with characters encoded in the UTF-8 coding standard</p> </section> @@ -53,22 +54,22 @@ <p>Type definitions that are related to URI:</p> <taglist> - <tag><c>uri() = string()</c></tag> + <tag><c>uri() = string() | unicode:unicode_binary()</c></tag> <item><p>Syntax according to the URI definition in RFC 3986, for example, "http://www.erlang.org/"</p></item> - <tag><c>user_info() = string()</c></tag> + <tag><c>user_info() = string() | unicode:unicode_binary()</c></tag> <item><p></p></item> <tag><c>scheme() = atom()</c></tag> <item><p>Example: http, https</p></item> - <tag><c>host() = string()</c></tag> + <tag><c>host() = string() | unicode:unicode_binary()</c></tag> <item><p></p></item> <tag><c>port() = pos_integer()</c></tag> <item><p></p></item> - <tag><c>path() = string()</c></tag> + <tag><c>path() = string() | unicode:unicode_binary()</c></tag> <item><p>Represents a file path or directory path</p></item> - <tag><c>query() = string()</c></tag> + <tag><c>query() = string() | unicode:unicode_binary()</c></tag> <item><p></p></item> - <tag><c>fragment() = string()</c></tag> + <tag><c>fragment() = string() | unicode:unicode_binary()</c></tag> <item><p></p></item> </taglist> @@ -83,7 +84,7 @@ <fsummary>Decodes a hexadecimal encoded URI.</fsummary> <type> - <v>HexEncodedURI = string() - A possibly hexadecimal encoded URI</v> + <v>HexEncodedURI = string() | unicode:unicode_binary() - A possibly hexadecimal encoded URI</v> <v>URI = uri()</v> </type> @@ -98,7 +99,7 @@ <fsummary>Encodes a hexadecimal encoded URI.</fsummary> <type> <v>URI = uri()</v> - <v>HexEncodedURI = string() - Hexadecimal encoded URI</v> + <v>HexEncodedURI = string() | unicode:unicode_binary() - Hexadecimal encoded URI</v> </type> <desc> @@ -145,7 +146,7 @@ <p>Scheme validation fun is to be defined as follows:</p> <code> -fun(SchemeStr :: string()) -> +fun(SchemeStr :: string() | unicode:unicode_binary()) -> valid | {error, Reason :: term()}. </code> diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 4217b3c4fb..46484977c9 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -344,7 +344,7 @@ <tag><c><![CDATA[ssl]]></c></tag> <item> <p>This is the <c>SSL/TLS</c> connectin configuration option.</p> - <p>Defaults to <c>[]</c>. See <seealso marker="ssl:ssl">ssl:connect/[2, 3,4]</seealso> for availble options.</p> + <p>Defaults to <c>[]</c>. See <seealso marker="ssl:ssl">ssl:connect/[2,3,4]</seealso> for available options.</p> </item> <tag><c><![CDATA[autoredirect]]></c></tag> diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index cb3e107ccf..4568d165e7 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -102,16 +102,23 @@ parse(AbsURI, Opts) -> reserved() -> sets:from_list([$;, $:, $@, $&, $=, $+, $,, $/, $?, - $#, $[, $], $<, $>, $\", ${, $}, $|, + $#, $[, $], $<, $>, $\", ${, $}, $|, %" $\\, $', $^, $%, $ ]). -encode(URI) -> +encode(URI) when is_list(URI) -> Reserved = reserved(), - lists:append([uri_encode(Char, Reserved) || Char <- URI]). + lists:append([uri_encode(Char, Reserved) || Char <- URI]); +encode(URI) when is_binary(URI) -> + Reserved = reserved(), + << <<(uri_encode_binary(Char, Reserved))/binary>> || <<Char>> <= URI >>. -decode(String) -> - do_decode(String). +decode(String) when is_list(String) -> + do_decode(String); +decode(String) when is_binary(String) -> + do_decode_binary(String). +do_decode([$+|Rest]) -> + [$ |do_decode(Rest)]; do_decode([$%,Hex1,Hex2|Rest]) -> [hex2dec(Hex1)*16+hex2dec(Hex2)|do_decode(Rest)]; do_decode([First|Rest]) -> @@ -119,6 +126,14 @@ do_decode([First|Rest]) -> do_decode([]) -> []. +do_decode_binary(<<$+, Rest/bits>>) -> + <<$ , (do_decode_binary(Rest))/binary>>; +do_decode_binary(<<$%, Hex:2/binary, Rest/bits>>) -> + <<(binary_to_integer(Hex, 16)), (do_decode_binary(Rest))/binary>>; +do_decode_binary(<<First:1/binary, Rest/bits>>) -> + <<First/binary, (do_decode_binary(Rest))/binary>>; +do_decode_binary(<<>>) -> + <<>>. %%%======================================================================== %%% Internal functions @@ -162,9 +177,30 @@ extract_scheme(Str, Opts) -> {error, Error} end; _ -> - {ok, list_to_atom(http_util:to_lower(Str))} + {ok, to_atom(http_util:to_lower(Str))} end. +to_atom(S) when is_list(S) -> + list_to_atom(S); +to_atom(S) when is_binary(S) -> + binary_to_atom(S, unicode). + +parse_uri_rest(Scheme, DefaultPort, <<"//", URIPart/binary>>, Opts) -> + {Authority, PathQueryFragment} = + split_uri(URIPart, "[/?#]", {URIPart, <<"">>}, 1, 0), + {RawPath, QueryFragment} = + split_uri(PathQueryFragment, "[?#]", {PathQueryFragment, <<"">>}, 1, 0), + {Query, Fragment} = + split_uri(QueryFragment, "#", {QueryFragment, <<"">>}, 1, 0), + {UserInfo, HostPort} = split_uri(Authority, "@", {<<"">>, Authority}, 1, 1), + {Host, Port} = parse_host_port(Scheme, DefaultPort, HostPort, Opts), + Path = path(RawPath), + case lists:keyfind(fragment, 1, Opts) of + {fragment, true} -> + {ok, {Scheme, UserInfo, Host, Port, Path, Query, Fragment}}; + _ -> + {ok, {Scheme, UserInfo, Host, Port, Path, Query}} + end; parse_uri_rest(Scheme, DefaultPort, "//" ++ URIPart, Opts) -> {Authority, PathQueryFragment} = split_uri(URIPart, "[/?#]", {URIPart, ""}, 1, 0), @@ -185,6 +221,11 @@ parse_uri_rest(Scheme, DefaultPort, "//" ++ URIPart, Opts) -> %% In this version of the function, we no longer need %% the Scheme argument, but just in case... +parse_host_port(_Scheme, DefaultPort, <<"[", HostPort/binary>>, Opts) -> %ipv6 + {Host, ColonPort} = split_uri(HostPort, "\\]", {HostPort, <<"">>}, 1, 1), + Host2 = maybe_ipv6_host_with_brackets(Host, Opts), + {_, Port} = split_uri(ColonPort, ":", {<<"">>, DefaultPort}, 0, 1), + {Host2, int_port(Port)}; parse_host_port(_Scheme, DefaultPort, "[" ++ HostPort, Opts) -> %ipv6 {Host, ColonPort} = split_uri(HostPort, "\\]", {HostPort, ""}, 1, 1), Host2 = maybe_ipv6_host_with_brackets(Host, Opts), @@ -198,12 +239,19 @@ parse_host_port(_Scheme, DefaultPort, HostPort, _Opts) -> split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> case re:run(UriPart, SplitChar, [{capture, first}]) of {match, [{Match, _}]} -> - {string:substr(UriPart, 1, Match + 1 - SkipLeft), - string:substr(UriPart, Match + 1 + SkipRight, length(UriPart))}; + {string:slice(UriPart, 0, Match + 1 - SkipLeft), + string:slice(UriPart, Match + SkipRight, string:length(UriPart))}; nomatch -> NoMatchResult end. +maybe_ipv6_host_with_brackets(Host, Opts) when is_binary(Host) -> + case lists:keysearch(ipv6_host_with_brackets, 1, Opts) of + {value, {ipv6_host_with_brackets, true}} -> + <<"[", Host/binary, "]">>; + _ -> + Host + end; maybe_ipv6_host_with_brackets(Host, Opts) -> case lists:keysearch(ipv6_host_with_brackets, 1, Opts) of {value, {ipv6_host_with_brackets, true}} -> @@ -212,15 +260,18 @@ maybe_ipv6_host_with_brackets(Host, Opts) -> Host end. - int_port(Port) when is_integer(Port) -> Port; +int_port(Port) when is_binary(Port) -> + binary_to_integer(Port); int_port(Port) when is_list(Port) -> list_to_integer(Port); %% This is the case where no port was found and there was no default port int_port(no_default_port) -> throw({error, no_default_port}). +path(<<"">>) -> + <<"/">>; path("") -> "/"; path(Path) -> @@ -234,6 +285,14 @@ uri_encode(Char, Reserved) -> [Char] end. +uri_encode_binary(Char, Reserved) -> + case sets:is_element(Char, Reserved) of + true -> + << $%, (integer_to_binary(Char, 16))/binary >>; + false -> + <<Char>> + end. + hex2dec(X) when (X>=$0) andalso (X=<$9) -> X-$0; hex2dec(X) when (X>=$A) andalso (X=<$F) -> X-$A+10; hex2dec(X) when (X>=$a) andalso (X=<$f) -> X-$a+10. diff --git a/lib/inets/src/http_lib/http_util.erl b/lib/inets/src/http_lib/http_util.erl index 20c342dd66..78b0aa2885 100644 --- a/lib/inets/src/http_lib/http_util.erl +++ b/lib/inets/src/http_lib/http_util.erl @@ -35,10 +35,10 @@ %%% Internal application API %%%========================================================================= to_upper(Str) -> - string:to_upper(Str). + string:uppercase(Str). to_lower(Str) -> - string:to_lower(Str). + string:lowercase(Str). %% Example: Mon, 09-Dec-2002 13:46:00 GMT convert_netscapecookie_date([_D,_A,_Y, $,, $ , diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl index b26c645821..d055af59e3 100644 --- a/lib/inets/test/uri_SUITE.erl +++ b/lib/inets/test/uri_SUITE.erl @@ -25,6 +25,7 @@ -module(uri_SUITE). +-include_lib("eunit/include/eunit.hrl"). -include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). @@ -50,7 +51,8 @@ all() -> fragments, escaped, hexed_query, - scheme_validation + scheme_validation, + encode_decode ]. %%-------------------------------------------------------------------- @@ -73,7 +75,10 @@ end_per_testcase(_Case, _Config) -> ipv4(Config) when is_list(Config) -> {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = - http_uri:parse("http://127.0.0.1/foobar.html"). + http_uri:parse("http://127.0.0.1/foobar.html"), + + {ok, {http,<<>>,<<"127.0.0.1">>,80,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://127.0.0.1/foobar.html">>). ipv6(Config) when is_list(Config) -> {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = @@ -89,24 +94,52 @@ ipv6(Config) when is_list(Config) -> [{foo, false}]), {error, {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = - http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"). + http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"), + + {ok, {http,<<>>,<<"2010:836B:4179::836B:4179">>,80,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://[2010:836B:4179::836B:4179]/foobar.html">>), + {ok, {http,<<>>,<<"[2010:836B:4179::836B:4179]">>,80,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://[2010:836B:4179::836B:4179]/foobar.html">>, + [{ipv6_host_with_brackets, true}]), + {ok, {http,<<>>,<<"2010:836B:4179::836B:4179">>,80,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://[2010:836B:4179::836B:4179]/foobar.html">>, + [{ipv6_host_with_brackets, false}]), + {ok, {http,<<>>,<<"2010:836B:4179::836B:4179">>,80,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://[2010:836B:4179::836B:4179]/foobar.html">>, + [{foo, false}]), + {error, + {malformed_url, _, <<"http://2010:836B:4179::836B:4179/foobar.html">>}} = + http_uri:parse(<<"http://2010:836B:4179::836B:4179/foobar.html">>). host(Config) when is_list(Config) -> {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = - http_uri:parse("http://localhost:8888/foobar.html"). + http_uri:parse("http://localhost:8888/foobar.html"), + + {ok, {http,<<>>,<<"localhost">>,8888,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://localhost:8888/foobar.html">>). userinfo(Config) when is_list(Config) -> {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = - http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"). + http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"), + + {ok, {http,<<"nisse:foobar">>,<<"localhost">>,8888,<<"/foobar.html">>,<<>>}} = + http_uri:parse(<<"http://nisse:foobar@localhost:8888/foobar.html">>). scheme(Config) when is_list(Config) -> {error, no_scheme} = http_uri:parse("localhost/foobar.html"), {error, {malformed_url, _, _}} = - http_uri:parse("localhost:8888/foobar.html"). + http_uri:parse("localhost:8888/foobar.html"), + + {error, no_scheme} = http_uri:parse(<<"localhost/foobar.html">>), + {error, {malformed_url, _, _}} = + http_uri:parse(<<"localhost:8888/foobar.html">>). queries(Config) when is_list(Config) -> {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = - http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"). + http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"), + + {ok, {http,<<>>,<<"localhost">>,8888,<<"/foobar.html">>,<<"?foo=bar&foobar=42">>}} = + http_uri:parse(<<"http://localhost:8888/foobar.html?foo=bar&foobar=42">>). fragments(Config) when is_list(Config) -> {ok, {http,[],"localhost",80,"/",""}} = @@ -142,6 +175,41 @@ fragments(Config) when is_list(Config) -> http_uri:parse("http://localhost?query#", [{fragment,true}]), {ok, {http,[],"localhost",80,"/path","?query","#"}} = http_uri:parse("http://localhost/path?query#", [{fragment,true}]), + + + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"">>}} = + http_uri:parse(<<"http://localhost#fragment">>), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"">>}} = + http_uri:parse(<<"http://localhost/path#fragment">>), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"?query">>}} = + http_uri:parse(<<"http://localhost?query#fragment">>), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"?query">>}} = + http_uri:parse(<<"http://localhost/path?query#fragment">>), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"">>,<<"#fragment">>}} = + http_uri:parse(<<"http://localhost#fragment">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"">>,<<"#fragment">>}} = + http_uri:parse(<<"http://localhost/path#fragment">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"?query">>,<<"#fragment">>}} = + http_uri:parse(<<"http://localhost?query#fragment">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"?query">>,<<"#fragment">>}} = + http_uri:parse(<<"http://localhost/path?query#fragment">>, + [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"">>,<<"">>}} = + http_uri:parse(<<"http://localhost">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"">>,<<"">>}} = + http_uri:parse(<<"http://localhost/path">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"?query">>,<<"">>}} = + http_uri:parse(<<"http://localhost?query">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"?query">>,<<"">>}} = + http_uri:parse(<<"http://localhost/path?query">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"">>,<<"#">>}} = + http_uri:parse(<<"http://localhost#">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"">>,<<"#">>}} = + http_uri:parse(<<"http://localhost/path#">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<"?query">>,<<"#">>}} = + http_uri:parse(<<"http://localhost?query#">>, [{fragment,true}]), + {ok, {http,<<>>,<<"localhost">>,80,<<"/path">>,<<"?query">>,<<"#">>}} = + http_uri:parse(<<"http://localhost/path?query#">>, [{fragment,true}]), ok. escaped(Config) when is_list(Config) -> @@ -152,7 +220,16 @@ escaped(Config) when is_list(Config) -> {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = http_uri:parse("http://www.somedomain.com/%25abc"), {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = - http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"). + http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"), + + {ok, {http,<<>>,<<"www.somedomain.com">>,80,<<"/%2Eabc">>,<<>>}} = + http_uri:parse(<<"http://www.somedomain.com/%2Eabc">>), + {ok, {http,<<>>,<<"www.somedomain.com">>,80,<<"/%252Eabc">>,<<>>}} = + http_uri:parse(<<"http://www.somedomain.com/%252Eabc">>), + {ok, {http,<<>>,<<"www.somedomain.com">>,80,<<"/%25abc">>,<<>>}} = + http_uri:parse(<<"http://www.somedomain.com/%25abc">>), + {ok, {http,<<>>,<<"www.somedomain.com">>,80,<<"/%25abc">>, <<"?foo=bar">>}} = + http_uri:parse(<<"http://www.somedomain.com/%25abc?foo=bar">>). hexed_query(doc) -> [{doc, "Solves OTP-6191"}]; @@ -196,6 +273,17 @@ scheme_validation(Config) when is_list(Config) -> http_uri:parse("https://localhost#fragment", [{scheme_validation_fun, none}]). +encode_decode(Config) when is_list(Config) -> + ?assertEqual("foo%20bar", http_uri:encode("foo bar")), + ?assertEqual(<<"foo%20bar">>, http_uri:encode(<<"foo bar">>)), + + ?assertEqual("foo bar", http_uri:decode("foo+bar")), + ?assertEqual(<<"foo bar">>, http_uri:decode(<<"foo+bar">>)), + ?assertEqual("foo bar", http_uri:decode("foo%20bar")), + ?assertEqual(<<"foo bar">>, http_uri:decode(<<"foo%20bar">>)), + ?assertEqual("foo\r\n", http_uri:decode("foo%0D%0A")), + ?assertEqual(<<"foo\r\n">>, http_uri:decode(<<"foo%0D%0A">>)). + %%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml index aebeacee28..570d3ef9bd 100644 --- a/lib/kernel/doc/src/disk_log.xml +++ b/lib/kernel/doc/src/disk_log.xml @@ -968,6 +968,12 @@ <c>read_write</c>. </p> </item> + <tag><c>{quiet, Boolean}</c></tag> + <item> + <p>Specifies if messages will be sent to + <c>error_logger</c> on recoverable errors with + the log files. Defaults to <c>true</c>.</p> + </item> </taglist> <p><c>open/1</c> returns <c>{ok, <anno>Log</anno>}</c> if the log file is successfully opened. If the file is diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 28af155493..9fccb4c7ac 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -419,6 +419,29 @@ MaxT = TickTime + TickTime / 4</code> using this service.</p> <p>Defaults to <c>false</c>.</p> </item> + <tag><c>shell_history = enabled | disabled </c></tag> + <item> + <p>Specifies whether shell history should be logged to disk + between usages of <c>erl</c>.</p> + </item> + <tag><c>shell_history_drop = [string()]</c></tag> + <item> + <p>Specific log lines that should not be persisted. For + example <c>["q().", "init:stop()."]</c> will allow to + ignore commands that shut the node down. Defaults to + <c>[]</c>.</p> + </item> + <tag><c>shell_history_file_bytes = integer()</c></tag> + <item> + <p>how many bytes the shell should remember. By default, the + value is set to 512kb, and the minimal value is 50kb.</p> + </item> + <tag><c>shell_history_path = string()</c></tag> + <item> + <p>Specifies where the shell history files will be stored. + defaults to the user's cache directory as returned by + <c>filename:basedir(user_cache, "erlang-history")</c>.</p> + </item> <tag><c>shutdown_func = {Mod, Func}</c></tag> <item> <p>Where:</p> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 2a89faaf13..78aa6192a9 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -85,6 +85,7 @@ MODULES = \ global_group \ global_search \ group \ + group_history \ heart \ hipe_unified_loader \ inet \ diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 50a20c918c..70cbf1c87c 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -638,6 +638,8 @@ check_arg([{mode, read_only}|Tail], Res) -> check_arg(Tail, Res#arg{mode = read_only}); check_arg([{mode, read_write}|Tail], Res) -> check_arg(Tail, Res#arg{mode = read_write}); +check_arg([{quiet, Boolean}|Tail], Res) when is_boolean(Boolean) -> + check_arg(Tail, Res#arg{quiet = Boolean}); check_arg(Arg, _) -> {error, {badarg, Arg}}. @@ -1276,7 +1278,8 @@ compare_arg(_Attr, _Val, _A) -> do_open(A) -> #arg{type = Type, format = Format, name = Name, head = Head0, file = FName, repair = Repair, size = Size, mode = Mode, - version = V} = A, + quiet = Quiet, version = V} = A, + disk_log_1:set_quiet(Quiet), Head = mk_head(Head0, Format), case do_open2(Type, Format, Name, FName, Repair, Size, Mode, Head, V) of {ok, Ret, Extra, FormatType, NoItems} -> diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index c9fda8bef5..a362881f40 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -69,13 +69,14 @@ | {file, FileName :: file:filename()} | {linkto, LinkTo :: none | pid()} | {repair, Repair :: true | false | truncate} - | {type, Type :: dlog_type} + | {type, Type :: dlog_type()} | {format, Format :: dlog_format()} | {size, Size :: dlog_size()} | {distributed, Nodes :: [node()]} | {notify, boolean()} | {head, Head :: dlog_head_opt()} | {head_func, MFA :: {atom(), atom(), list()}} + | {quiet, boolean()} | {mode, Mode :: dlog_mode()}. -type dlog_options() :: [dlog_option()]. -type dlog_repair() :: 'truncate' | boolean(). @@ -102,6 +103,7 @@ head = none, mode = read_write :: dlog_mode(), notify = false :: boolean(), + quiet = false :: boolean(), options = [] :: dlog_options()}). -record(cache, %% Cache for logged terms (per file descriptor). diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index d83c30f35f..10c22e1ad6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -37,6 +37,7 @@ -export([get_wrap_size/1]). -export([is_head/1]). -export([position/3, truncate_at/3, fwrite/4, fclose/2]). +-export([set_quiet/1, is_quiet/0]). -compile({inline,[{scan_f2,7}]}). @@ -500,7 +501,10 @@ lh(H, _F) -> % cannot happen repair(In, File) -> FSz = file_size(File), - error_logger:info_msg("disk_log: repairing ~tp ...\n", [File]), + case is_quiet() of + true -> ok; + _ -> error_logger:info_msg("disk_log: repairing ~tp ...\n", [File]) + end, Tmp = add_ext(File, "TMP"), {ok, {_Alloc, Out, {0, _}, _FileSize}} = new_int_file(Tmp, none), scan_f_read(<<>>, In, Out, File, FSz, Tmp, ?MAX_CHUNK_SIZE, 0, 0). @@ -769,8 +773,11 @@ mf_int_chunk(Handle, {FileNo, Pos}, Bin, N) -> NFileNo = inc(FileNo, Handle#handle.maxF), case catch int_open(FName, true, read_only, any) of {error, _Reason} -> - error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", - [FName]), + case is_quiet() of + true -> ok; + _ -> error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", + [FName]) + end, mf_int_chunk(Handle, {NFileNo, 0}, [], N); {ok, {_Alloc, FdC, _HeadSize, _FileSize}} -> case chunk(FdC, FName, Pos, Bin, N) of @@ -797,9 +804,12 @@ mf_int_chunk_read_only(Handle, {FileNo, Pos}, Bin, N) -> NFileNo = inc(FileNo, Handle#handle.maxF), case catch int_open(FName, true, read_only, any) of {error, _Reason} -> - error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", - [FName]), - mf_int_chunk_read_only(Handle, {NFileNo, 0}, [], N); + case is_quiet() of + true -> ok; + _ -> error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", + [FName]) + end, + mf_int_chunk_read_only(Handle, {NFileNo, 0}, [], N); {ok, {_Alloc, FdC, _HeadSize, _FileSize}} -> case do_chunk_read_only(FdC, FName, Pos, Bin, N) of {NewFdC, eof} -> @@ -1549,6 +1559,12 @@ fclose(#cache{fd = Fd, c = C}, FileName) -> _ = write_cache_close(Fd, FileName, C), file:close(Fd). +set_quiet(Bool) -> + put(quiet, Bool). + +is_quiet() -> + get(quiet) =:= true. + %% -> {Reply, #cache{}}; Reply = ok | Error write_cache(Fd, _FileName, []) -> {ok, #cache{fd = Fd}}; diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index b5e73117dd..0eeaaad8d2 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -33,7 +33,7 @@ start(Drv, Shell, Options) -> server(Drv, Shell, Options) -> process_flag(trap_exit, true), edlin:init(), - put(line_buffer, proplists:get_value(line_buffer, Options, [])), + put(line_buffer, proplists:get_value(line_buffer, Options, group_history:load())), put(read_mode, list), put(user_drv, Drv), put(expand_fun, @@ -783,6 +783,7 @@ save_line_buffer("\n", Lines) -> save_line_buffer(Line, [Line|_Lines]=Lines) -> save_line_buffer(Lines); save_line_buffer(Line, Lines) -> + group_history:add(Line), save_line_buffer([Line|Lines]). save_line_buffer(Lines) -> diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl new file mode 100644 index 0000000000..5ca5e2d1dd --- /dev/null +++ b/lib/kernel/src/group_history.erl @@ -0,0 +1,341 @@ +%% +%% %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% +%% +-module(group_history). +-export([load/0, add/1]). + +%% Make a minimal size that should encompass set of lines and then make +%% a file rotation for N files of this size. +-define(DEFAULT_HISTORY_FILE, "erlang-shell-log"). +-define(MAX_HISTORY_FILES, 10). +-define(DEFAULT_SIZE, 1024*512). % 512 kb total default +-define(DEFAULT_STATUS, disabled). +-define(MIN_HISTORY_SIZE, (50*1024)). % 50 kb, in bytes +-define(DEFAULT_DROP, []). +-define(DISK_LOG_FORMAT, internal). % since we want repairs +-define(LOG_NAME, '$#group_history'). +-define(VSN, {0,1,0}). + +%%%%%%%%%%%%%% +%%% PUBLIC %%% +%%%%%%%%%%%%%% + +%% @doc Loads the shell history from memory. This function should only be +%% called from group:server/3 to inject itself in the previous commands +%% stack. +-spec load() -> [string()]. +load() -> + wait_for_kernel_safe_sup(), + case history_status() of + enabled -> + case open_log() of + {ok, ?LOG_NAME} -> + read_full_log(?LOG_NAME); + {repaired, ?LOG_NAME, {recovered, Good}, {badbytes, Bad}} -> + report_repairs(?LOG_NAME, Good, Bad), + read_full_log(?LOG_NAME); + {error, {need_repair, _FileName}} -> + repair_log(?LOG_NAME); + {error, {arg_mismatch, repair, true, false}} -> + repair_log(?LOG_NAME); + {error, {name_already_open, _}} -> + show_rename_warning(), + read_full_log(?LOG_NAME); + {error, {size_mismatch, Current, New}} -> + show_size_warning(Current, New), + resize_log(?LOG_NAME, Current, New), + load(); + {error, {invalid_header, {vsn, Version}}} -> + upgrade_version(?LOG_NAME, Version), + load(); + {error, Reason} -> + handle_open_error(Reason), + disable_history(), + [] + end; + _ -> + [] + end. + +%% @doc adds a log line to the erlang history log, if configured to do so. +-spec add(iodata()) -> ok. +add(Line) -> add(Line, history_status()). + +add(Line, enabled) -> + case lists:member(Line, to_drop()) of + false -> + case disk_log:log(?LOG_NAME, Line) of + ok -> + ok; + {error, no_such_log} -> + _ = open_log(), % a wild attempt we hope works! + disk_log:log(?LOG_NAME, Line); + {error, _Other} -> + % just ignore, we're too late + ok + end; + true -> + ok + end; +add(_Line, disabled) -> + ok. + +%%%%%%%%%%%%%%% +%%% PRIVATE %%% +%%%%%%%%%%%%%%% + +%% Because loading the shell happens really damn early, processes we depend on +%% might not be there yet. Luckily, the load function is called from the shell +%% after a new process has been spawned, so we can block in here +wait_for_kernel_safe_sup() -> + case whereis(kernel_safe_sup) of + undefined -> + timer:sleep(50), + wait_for_kernel_safe_sup(); + _ -> + ok + end. + +%% Repair the log out of band +repair_log(Name) -> + Opts = lists:keydelete(size, 1, log_options()), + case disk_log:open(Opts) of + {repaired, ?LOG_NAME, {recovered, Good}, {badbytes, Bad}} -> + report_repairs(?LOG_NAME, Good, Bad); + _ -> + ok + end, + _ = disk_log:close(Name), + load(). + +%% Return whether the shell history is enabled or not +-spec history_status() -> enabled | disabled. +history_status() -> + case is_user() orelse application:get_env(kernel, shell_history) of + true -> disabled; % don't run for user proc + {ok, enabled} -> enabled; + undefined -> ?DEFAULT_STATUS; + _ -> disabled + end. + +%% Return whether the user process is running this +-spec is_user() -> boolean(). +is_user() -> + case process_info(self(), registered_name) of + {registered_name, user} -> true; + _ -> false + end. + +%% Open a disk_log file while ensuring the required path is there. +open_log() -> + Opts = log_options(), + _ = ensure_path(Opts), + disk_log:open(Opts). + +%% Return logger options +log_options() -> + Path = find_path(), + File = filename:join([Path, ?DEFAULT_HISTORY_FILE]), + Size = find_wrap_values(), + [{name, ?LOG_NAME}, + {file, File}, + {repair, true}, + {format, internal}, + {type, wrap}, + {size, Size}, + {distributed, []}, + {notify, false}, + {head, {vsn, ?VSN}}, + {quiet, true}, + {mode, read_write}]. + +-spec ensure_path([{file, string()} | {atom(), _}, ...]) -> ok | {error, term()}. +ensure_path(Opts) -> + {file, Path} = lists:keyfind(file, 1, Opts), + filelib:ensure_dir(Path). + +%% @private read the logs from an already open file. Treat closed files +%% as wrong and returns an empty list to avoid crash loops in the shell. +-spec read_full_log(term()) -> [string()]. +read_full_log(Name) -> + case disk_log:chunk(Name, start) of + {error, no_such_log} -> + show_unexpected_close_warning(), + []; + eof -> + []; + {Cont, Logs} -> + lists:reverse(maybe_drop_header(Logs) ++ read_full_log(Name, Cont)) + end. + +read_full_log(Name, Cont) -> + case disk_log:chunk(Name, Cont) of + {error, no_such_log} -> + show_unexpected_close_warning(), + []; + eof -> + []; + {NextCont, Logs} -> + maybe_drop_header(Logs) ++ read_full_log(Name, NextCont) + end. + +maybe_drop_header([{vsn, _} | Rest]) -> Rest; +maybe_drop_header(Logs) -> Logs. + +-spec handle_open_error(_) -> ok. +handle_open_error({arg_mismatch, OptName, CurrentVal, NewVal}) -> + show('$#erlang-history-arg-mismatch', + "Log file argument ~p changed value from ~p to ~p " + "and cannot be automatically updated. Please clear the " + "history files and try again.~n", + [OptName, CurrentVal, NewVal]); +handle_open_error({not_a_log_file, FileName}) -> + show_invalid_file_warning(FileName); +handle_open_error({invalid_index_file, FileName}) -> + show_invalid_file_warning(FileName); +handle_open_error({invalid_header, Term}) -> + show('$#erlang-history-invalid-header', + "Shell history expects to be able to use the log files " + "which currently have unknown headers (~p) and may belong to " + "another mechanism. History logging will be " + "disabled.~n", + [Term]); +handle_open_error({file_error, FileName, Reason}) -> + show('$#erlang-history-file-error', + "Error handling File ~s. Reason: ~p~n" + "History logging will be disabled.~n", + [FileName, Reason]); +handle_open_error(Err) -> + show_unexpected_warning({disk_log, open, 1}, Err). + +find_wrap_values() -> + ConfSize = case application:get_env(kernel, shell_history_file_bytes) of + undefined -> ?DEFAULT_SIZE; + {ok, S} -> S + end, + SizePerFile = max(?MIN_HISTORY_SIZE, ConfSize div ?MAX_HISTORY_FILES), + FileCount = if SizePerFile > ?MIN_HISTORY_SIZE -> + ?MAX_HISTORY_FILES + ; SizePerFile =< ?MIN_HISTORY_SIZE -> + max(1, ConfSize div SizePerFile) + end, + {SizePerFile, FileCount}. + +report_repairs(_, _, 0) -> + %% just a regular close repair + ok; +report_repairs(_, Good, Bad) -> + show('$#erlang-history-report-repairs', + "The shell history log file was corrupted and was repaired. " + "~p bytes were recovered and ~p were lost.~n", [Good, Bad]). + +resize_log(Name, _OldSize, NewSize) -> + show('$#erlang-history-resize-attempt', + "Attempting to resize the log history file to ~p...", [NewSize]), + Opts = lists:keydelete(size, 1, log_options()), + _ = case disk_log:open(Opts) of + {error, {need_repair, _}} -> + _ = repair_log(Name), + disk_log:open(Opts); + _ -> + ok + end, + case disk_log:change_size(Name, NewSize) of + ok -> + show('$#erlang-history-resize-result', + "ok~n", []); + {error, {new_size_too_small, _}} -> + show('$#erlang-history-resize-result', + "failed (new size is too small)~n", []), + disable_history(); + {error, Reason} -> + show('$#erlang-history-resize-result', + "failed (~p)~n", [Reason]), + disable_history() + end. + +upgrade_version(_Name, Unsupported) -> + %% We only know of one version and can't support a newer one + show('$#erlang-history-upgrade', + "The version for the shell logs found on disk (~p) is " + "not supported by the current version (~p)~n", + [Unsupported, ?VSN]), + disable_history(). + +disable_history() -> + show('$#erlang-history-disable', "Disabling shell history logging.~n", []), + application:set_env(kernel, shell_history, force_disabled). + +find_path() -> + case application:get_env(kernel, shell_history_path) of + undefined -> filename:basedir(user_cache, "erlang-history"); + {ok, Path} -> Path + end. + +to_drop() -> + case application:get_env(kernel, shell_history_drop) of + undefined -> + application:set_env(kernel, shell_history_drop, ?DEFAULT_DROP), + ?DEFAULT_DROP; + {ok, V} when is_list(V) -> [Ln++"\n" || Ln <- V]; + {ok, _} -> ?DEFAULT_DROP + end. + +%%%%%%%%%%%%%%%%%%%%%%%% +%%% Output functions %%% +%%%%%%%%%%%%%%%%%%%%%%%% +show_rename_warning() -> + show('$#erlang-history-rename-warn', + "A history file with a different path has already " + "been started for the shell of this node. The old " + "name will keep being used for this session.~n", + []). + +show_invalid_file_warning(FileName) -> + show('$#erlang-history-invalid-file', + "Shell history expects to be able to use the file ~s " + "which currently exists and is not a file usable for " + "history logging purposes. History logging will be " + "disabled.~n", [FileName]). + +show_unexpected_warning({M,F,A}, Term) -> + show('$#erlang-history-unexpected-return', + "unexpected return value from ~p:~p/~p: ~p~n" + "shell history will be disabled for this session.~n", + [M,F,A,Term]). + +show_unexpected_close_warning() -> + show('$#erlang-history-unexpected-close', + "The shell log file has mysteriousy closed. Ignoring " + "currently unread history.~n", []). + +show_size_warning(_Current, _New) -> + show('$#erlang-history-size', + "The configured log history file size is different from " + "the size of the log file on disk.~n", []). + +show(Key, Format, Args) -> + case get(Key) of + undefined -> + io:format(standard_error, Format, Args), + put(Key, true), + ok; + true -> + ok + end. diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 25e4ddd95c..1128ee3ec5 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -44,6 +44,7 @@ global_group, global_search, group, + group_history, heart, hipe_unified_loader, inet6_tcp, diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 069df5a11d..2b11a0381f 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -2493,6 +2493,7 @@ error_repair(Conf) when is_list(Conf) -> del(File, No), ok = file:del_dir(Dir), + error_logger:add_report_handler(?MODULE, self()), %% repair a file P1 = pps(), {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, @@ -2509,6 +2510,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), true = (P1 == pps()), del(File, No), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% yet another repair P2 = pps(), @@ -2525,6 +2528,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), true = (P2 == pps()), del(File, No), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% Repair, large term Big = term_to_binary(lists:duplicate(66000,$a)), @@ -2540,6 +2545,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), Got = Big, del(File, No), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% A term a little smaller than a chunk, then big terms. BigSmall = mk_bytes(1024*64-8-12), @@ -2560,6 +2567,8 @@ error_repair(Conf) when is_list(Conf) -> {type, halt}, {format, internal}]), ok = disk_log:close(n), file:delete(File), + receive {info_msg, _, "disk_log: repairing" ++ _, _} -> ok + after 1000 -> ct:fail(failed) end, %% The header is recovered. {ok,n} = @@ -2573,12 +2582,13 @@ error_repair(Conf) when is_list(Conf) -> crash(File, 30), {repaired,n,{recovered,3},{badbytes,15}} = disk_log:open([{name, n}, {file, File}, {type, halt}, - {format, internal},{repair,true}, + {format, internal},{repair,true}, {quiet, true}, {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]), ["head",'of',terms] = get_all_terms(n), ok = disk_log:close(n), - + error_logger:delete_report_handler(?MODULE), file:delete(File), + {messages, []} = process_info(self(), messages), ok. @@ -5007,6 +5017,9 @@ init(Tester) -> handle_event({error_report, _GL, {Pid, crash_report, Report}}, Tester) -> Tester ! {crash_report, Pid, Report}, {ok, Tester}; +handle_event({info_msg, _GL, {Pid, F,A}}, Tester) -> + Tester ! {info_msg, Pid, F, A}, + {ok, Tester}; handle_event(_Event, State) -> {ok, State}. diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index 9506a2b380..ef425f0874 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -194,14 +194,17 @@ code_change(_, _, State) -> %%%%%%%%%% restart_fetcher(Node, #state{panel=Panel, wins=Wins0, time=Ti} = State) -> - SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), - Info = alloc_info(SysInfo), - Max = lists:foldl(fun calc_max/2, #{}, Info), - {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true), - erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), - wxWindow:refresh(Panel), - precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0}, - wins=Wins, samples=Samples, max=Max}). + case rpc:call(Node, observer_backend, sys_info, []) of + {badrpc, _} -> State; + SysInfo -> + Info = alloc_info(SysInfo), + Max = lists:foldl(fun calc_max/2, #{}, Info), + {Wins, Samples} = add_data(Info, {0, queue:new()}, Wins0, Ti, true), + erlang:send_after(1000 div ?DISP_FREQ, self(), {refresh, 0}), + wxWindow:refresh(Panel), + precalc(State#state{active=true, appmon=Node, time=Ti#ti{tick=0}, + wins=Wins, samples=Samples, max=Max}) + end. precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> Wins = [precalc(Ti, Data0, Paint, Win) || Win <- Wins0], diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index ffa6f6d3b4..3083297f31 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -67,12 +67,14 @@ -record(holder, {parent, info, - etop, + next=[], sort=#sort{}, accum=[], + next_accum=[], attrs, node, - backend_pid + backend_pid, + old_backend=false }). -record(state, {parent, @@ -226,7 +228,7 @@ handle_info({holder_updated, Count}, State0=#state{grid=Grid}) -> wxListCtrl:setItemCount(Grid, Count), Count > 0 andalso wxListCtrl:refreshItems(Grid, 0, Count-1), - + observer_wx:set_status(io_lib:format("Number of Processes: ~w", [Count])), {noreply, State}; handle_info(refresh_interval, #state{holder=Holder}=State) -> @@ -459,13 +461,13 @@ rm_selected(_, [], [], AccIds, AccPids) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%TABLE HOLDER%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_table_holder(Parent, Accum0, Attrs) -> - Backend = spawn_link(node(), observer_backend,etop_collect,[self()]), + process_flag(trap_exit, true), + Backend = spawn_link(node(), observer_backend, procs_info, [self()]), Accum = case Accum0 of true -> true; false -> [] end, table_holder(#holder{parent=Parent, - etop=#etop_info{}, info=array:new(), node=node(), backend_pid=Backend, @@ -474,7 +476,7 @@ init_table_holder(Parent, Accum0, Attrs) -> }). table_holder(#holder{info=Info, attrs=Attrs, - node=Node, backend_pid=Backend}=S0) -> + node=Node, backend_pid=Backend, old_backend=Old}=S0) -> receive {get_row, From, Row, Col} -> get_row(From, Row, Col, Info), @@ -482,14 +484,25 @@ table_holder(#holder{info=Info, attrs=Attrs, {get_attr, From, Row} -> get_attr(From, Row, Attrs), table_holder(S0); + {procs_info, Backend, Procs} -> + State = handle_update(Procs, S0), + table_holder(State); + {'EXIT', Backend, normal} when Old =:= false -> + S1 = update_complete(S0), + table_holder(S1#holder{backend_pid=undefined}); {Backend, EtopInfo=#etop_info{}} -> - State = handle_update(EtopInfo, S0), + State = handle_update_old(EtopInfo, S0), table_holder(State#holder{backend_pid=undefined}); refresh when is_pid(Backend)-> table_holder(S0); %% Already updating refresh -> - Pid = spawn_link(Node,observer_backend,etop_collect,[self()]), - table_holder(S0#holder{backend_pid=Pid}); + Pid = case Old of + true -> + spawn_link(Node, observer_backend, etop_collect, [self()]); + false -> + spawn_link(Node, observer_backend, procs_info, [self()]) + end, + table_holder(S0#holder{backend_pid=Pid}); {change_sort, Col} -> State = change_sort(Col, S0), table_holder(State); @@ -502,7 +515,6 @@ table_holder(#holder{info=Info, attrs=Attrs, {get_name_or_pid, From, Indices} -> get_name_or_pid(From, Indices, Info), table_holder(S0); - {get_node, From} -> From ! {self(), Node}, table_holder(S0); @@ -511,36 +523,50 @@ table_holder(#holder{info=Info, attrs=Attrs, true -> table_holder(S0); false -> - self() ! refresh, - table_holder(S0#holder{node=NewNode}) - end; + _ = rpc:call(NewNode, code, ensure_loaded, [observer_backend]), + case rpc:call(NewNode, erlang, function_exported, + [observer_backend,procs_info, 1]) of + true -> + self() ! refresh, + table_holder(S0#holder{node=NewNode, old_backend=false}); + false -> + self() ! refresh, + table_holder(S0#holder{node=NewNode, old_backend=true}); + _ -> + table_holder(S0) + end + end; {accum, Bool} -> table_holder(change_accum(Bool,S0)); {get_accum, From} -> From ! {self(), S0#holder.accum == true}, table_holder(S0); {dump, Fd} -> - EtopInfo = (S0#holder.etop)#etop_info{procinfo=array:to_list(Info)}, - %% The empty #etop_info{} below is a dummy previous info - %% value. It is used by etop to calculate the scheduler - %% utilization since last update. When dumping to file, - %% there is no previous measurement to use, so we just add - %% a dummy here, and the value shown will be since the - %% tool was started. - etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), - file:close(Fd), - table_holder(S0); + Collector = spawn_link(Node, observer_backend, etop_collect,[self()]), + receive + {Collector, EtopInfo=#etop_info{}} -> + etop_txt:do_update(Fd, EtopInfo, #etop_info{}, #opts{node=Node}), + file:close(Fd), + table_holder(S0); + {'EXIT', Collector, _} -> + table_holder(S0) + end; stop -> ok; - What -> - io:format("Table holder got ~p~n",[What]), + {'EXIT', Backend, normal} -> + table_holder(S0); + {'EXIT', Backend, _Reason} -> + %% Node crashed will be noticed soon.. + table_holder(S0#holder{backend_pid=undefined}); + _What -> + %% io:format("~p: Table holder got ~p~n",[?MODULE, _What]), table_holder(S0) end. change_sort(Col, S0=#holder{parent=Parent, info=Data, sort=Sort0}) -> {Sort, ProcInfo}=sort(Col, Sort0, Data), Parent ! {holder_updated, array:size(Data)}, - S0#holder{info=ProcInfo, sort=Sort}. + S0#holder{info=array:from_list(ProcInfo), sort=Sort}. change_accum(true, S0) -> S0#holder{accum=true}; @@ -548,23 +574,45 @@ change_accum(false, S0=#holder{info=Info}) -> self() ! refresh, S0#holder{accum=lists:sort(array:to_list(Info))}. -handle_update(EI=#etop_info{procinfo=ProcInfo0}, - S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> - {ProcInfo1, S1} = accum(ProcInfo0, S0), +handle_update_old(#etop_info{procinfo=ProcInfo0}, + S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> + {ProcInfo1, Accum} = accum(ProcInfo0, S0), {_SO, ProcInfo} = sort(KeyField, Sort#sort{sort_key=undefined}, ProcInfo1), - Parent ! {holder_updated, array:size(ProcInfo)}, - S1#holder{info=ProcInfo, etop=EI#etop_info{procinfo=[]}}. + Info = array:from_list(ProcInfo), + Parent ! {holder_updated, array:size(Info)}, + S0#holder{info=Info, accum=Accum}. + +handle_update(ProcInfo0, S0=#holder{next=Next, sort=#sort{sort_key=KeyField}}) -> + {ProcInfo1, Accum} = accum(ProcInfo0, S0), + Sort = sort_fun(KeyField, true), + Merge = merge_fun(KeyField), + Merged = Merge(Sort(ProcInfo1), Next), + case Accum of + true -> S0#holder{next=Merged}; + _List -> S0#holder{next=Merged, next_accum=Accum} + end. -accum(ProcInfo, State=#holder{accum=true}) -> - {ProcInfo, State}; -accum(ProcInfo0, State=#holder{accum=Previous}) -> +update_complete(#holder{parent=Parent, sort=#sort{sort_incr=Incr}, + next=ProcInfo, accum=Accum, next_accum=NextAccum}=S0) -> + Info = case Incr of + true -> array:from_list(ProcInfo); + false -> array:from_list(lists:reverse(ProcInfo)) + end, + Parent ! {holder_updated, array:size(Info)}, + S0#holder{info=Info, accum= Accum =:= true orelse NextAccum, + next=[], next_accum=[]}. + +accum(ProcInfo, #holder{accum=true}) -> + {ProcInfo, true}; +accum(ProcInfo0, #holder{accum=Previous, next_accum=Next}) -> + Accum = [{Pid, Reds} || #etop_proc_info{pid=Pid, reds=Reds} <- ProcInfo0], ProcInfo = lists:sort(ProcInfo0), - {accum2(ProcInfo,Previous,[]), State#holder{accum=ProcInfo}}. + {accum2(ProcInfo,Previous,[]), lists:merge(lists:sort(Accum), Next)}. -accum2([PI=#etop_proc_info{pid=Pid, reds=Reds, runtime=RT}|PIs], - [#etop_proc_info{pid=Pid, reds=OldReds, runtime=OldRT}|Old], Acc) -> - accum2(PIs, Old, [PI#etop_proc_info{reds=Reds-OldReds, runtime=RT-OldRT}|Acc]); -accum2(PIs=[#etop_proc_info{pid=Pid}|_], [#etop_proc_info{pid=OldPid}|Old], Acc) +accum2([PI=#etop_proc_info{pid=Pid, reds=Reds}|PIs], + [{Pid, OldReds}|Old], Acc) -> + accum2(PIs, Old, [PI#etop_proc_info{reds=Reds-OldReds}|Acc]); +accum2(PIs=[#etop_proc_info{pid=Pid}|_], [{OldPid,_}|Old], Acc) when Pid > OldPid -> accum2(PIs, Old, Acc); accum2([PI|PIs], Old, Acc) -> @@ -575,14 +623,52 @@ sort(Col, Opt, Table) when not is_list(Table) -> sort(Col,Opt,array:to_list(Table)); sort(Col, Opt=#sort{sort_key=Col, sort_incr=Bool}, Table) -> - {Opt#sort{sort_incr=not Bool}, - array:from_list(lists:reverse(Table))}; -sort(Col, S=#sort{sort_incr=true}, Table) -> - {S#sort{sort_key=Col}, - array:from_list(lists:keysort(col_to_element(Col), Table))}; -sort(Col, S=#sort{sort_incr=false}, Table) -> - {S#sort{sort_key=Col}, - array:from_list(lists:reverse(lists:keysort(col_to_element(Col), Table)))}. + {Opt#sort{sort_incr=not Bool},lists:reverse(Table)}; +sort(Col, S=#sort{sort_incr=Incr}, Table) -> + Sort = sort_fun(Col, Incr), + {S#sort{sort_key=Col}, Sort(Table)}. + +sort_fun(?COL_NAME, true) -> + fun(Table) -> lists:sort(fun sort_name/2, Table) end; +sort_fun(?COL_NAME, false) -> + fun(Table) -> lists:sort(fun sort_name_rev/2, Table) end; +sort_fun(Col, true) -> + N = col_to_element(Col), + fun(Table) -> lists:keysort(N, Table) end; +sort_fun(Col, false) -> + N = col_to_element(Col), + fun(Table) -> lists:reverse(lists:keysort(N, Table)) end. + +merge_fun(?COL_NAME) -> + fun(A,B) -> lists:merge(fun sort_name/2, A, B) end; +merge_fun(Col) -> + KeyField = col_to_element(Col), + fun(A,B) -> lists:keymerge(KeyField, A, B) end. + + +sort_name(#etop_proc_info{name={_,_,_}=A}, #etop_proc_info{name={_,_,_}=B}) -> + A =< B; +sort_name(#etop_proc_info{name=A}, #etop_proc_info{name=B}) + when is_atom(A), is_atom(B) -> + A =< B; +sort_name(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}}) + when is_atom(Reg) -> + Reg < M; +sort_name(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg}) + when is_atom(Reg) -> + M < Reg. + +sort_name_rev(#etop_proc_info{name={_,_,_}=A}, #etop_proc_info{name={_,_,_}=B}) -> + A >= B; +sort_name_rev(#etop_proc_info{name=A}, #etop_proc_info{name=B}) + when is_atom(A), is_atom(B) -> + A >= B; +sort_name_rev(#etop_proc_info{name=Reg}, #etop_proc_info{name={M,_F,_A}}) + when is_atom(Reg) -> + Reg >= M; +sort_name_rev(#etop_proc_info{name={M,_,_}}, #etop_proc_info{name=Reg}) + when is_atom(Reg) -> + M >= Reg. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 739761e7fd..9b9e80f479 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -143,7 +143,8 @@ setup(#state{frame = Frame} = State) -> wxFrame:setTitle(Frame, atom_to_list(node())), wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), - wxNotebook:connect(Notebook, command_notebook_page_changed, [{skip, true}]), + wxNotebook:connect(Notebook, command_notebook_page_changed, + [{skip, true}, {id, ?ID_NOTEBOOK}]), wxFrame:connect(Frame, close_window, []), wxMenu:connect(Frame, command_menu_selected), wxFrame:show(Frame), @@ -230,12 +231,13 @@ setup(#state{frame = Frame} = State) -> %%Callbacks handle_event(#wx{event=#wxNotebook{type=command_notebook_page_changed, nSel=Next}}, - #state{active_tab=Previous, node=Node, panels=Panels} = State) -> + #state{active_tab=Previous, node=Node, panels=Panels, status_bar=SB} = State) -> {_, Obj, _} = lists:nth(Next+1, Panels), case wx_object:get_pid(Obj) of Previous -> {noreply, State}; Pid -> + wxStatusBar:setStatusText(SB, ""), Previous ! not_active, Pid ! {active, Node}, {noreply, State#state{active_tab=Pid}} diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 1e0d2d642e..d36af257ce 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -23,7 +23,7 @@ -export([vsn/0]). %% observer stuff --export([sys_info/0, get_port_list/0, +-export([sys_info/0, get_port_list/0, procs_info/1, get_table/3, get_table_list/2, fetch_stats/2]). %% etop stuff @@ -293,6 +293,23 @@ fetch_stats_loop(Parent, Time) -> try erlang:memory() catch _:_ -> [] end}, fetch_stats_loop(Parent, Time) end. + +%% +%% Chunk sending process info to etop/observer +%% +procs_info(Collector) -> + All = processes(), + Send = fun Send (Pids) -> + try lists:split(10000, Pids) of + {First, Rest} -> + Collector ! {procs_info, self(), etop_collect(First, [])}, + Send(Rest) + catch _:_ -> + Collector ! {procs_info, self(), etop_collect(Pids, [])} + end + end, + Send(All). + %% %% etop backend %% diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 84b7cdd7a1..5c9ce3d5fb 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -246,10 +246,12 @@ <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> <item> <p>List of user (client) public key algorithms to try to use.</p> - <p>The default value is - <c><![CDATA[['ssh-rsa','ssh-dss','ecdsa-sha2-nistp256','ecdsa-sha2-nistp384','ecdsa-sha2-nistp521'] ]]></c> + <p>The default value is the <c>public_key</c> entry in + <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>. + </p> + <p>If there is no public key of a specified type available, the corresponding entry is ignored. + Note that the available set is dependent on the underlying cryptolib and current user's public keys. </p> - <p>If there is no public key of a specified type available, the corresponding entry is ignored.</p> </item> <tag><c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag> @@ -293,6 +295,15 @@ connection. For <c>gen_tcp</c> the time is in milli-seconds and the default value is <c>infinity</c>.</p> </item> + + <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> + <item> + <p>Comma-separated string that determines which + authentication methods that the client shall support and + in which order they are tried. Defaults to + <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> + </item> + <tag><c><![CDATA[{user, string()}]]></c></tag> <item> <p>Provides a username. If this option is not given, <c>ssh</c> @@ -300,6 +311,7 @@ <c><![CDATA[USER]]></c> on UNIX, <c><![CDATA[USERNAME]]></c> on Windows).</p> </item> + <tag><c><![CDATA[{password, string()}]]></c></tag> <item> <p>Provides a password for password authentication. @@ -307,6 +319,7 @@ password, if the password authentication method is attempted.</p> </item> + <tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag> <item> <p>Module implementing the behaviour <seealso @@ -316,6 +329,7 @@ module via the options passed to it under the key 'key_cb_private'. </p> </item> + <tag><c><![CDATA[{quiet_mode, atom() = boolean()}]]></c></tag> <item> <p>If <c>true</c>, the client does not print anything on authorization.</p> @@ -466,6 +480,7 @@ authentication methods that the server is to support and in what order they are tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> + <p>Note that the client is free to use any order and to exclude methods.</p> </item> <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]></c> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 342583306b..6a6b9896cb 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -434,11 +434,7 @@ init_ssh_record(Role, Socket, Opts) -> init_ssh_record(Role, _Socket, PeerAddr, Opts) -> KeyCb = ?GET_OPT(key_cb, Opts), - AuthMethods = - case Role of - server -> ?GET_OPT(auth_methods, Opts); - client -> undefined - end, + AuthMethods = ?GET_OPT(auth_methods, Opts), S0 = #ssh{role = Role, key_cb = KeyCb, opts = Opts, @@ -1705,15 +1701,18 @@ handle_ssh_msg_ext_info(#ssh_msg_ext_info{data=Data}, D0) -> lists:foldl(fun ext_info/2, D0, Data). -ext_info({"server-sig-algs",SigAlgs}, D0 = #data{ssh_params=#ssh{role=client}=Ssh0}) -> +ext_info({"server-sig-algs",SigAlgs}, D0 = #data{ssh_params=#ssh{role=client, + userauth_pubkeys=ClientSigAlgs}=Ssh0}) -> %% Make strings to eliminate risk of beeing bombed with odd strings that fills the atom table: SupportedAlgs = lists:map(fun erlang:atom_to_list/1, ssh_transport:supported_algorithms(public_key)), - Ssh = Ssh0#ssh{userauth_pubkeys = - [list_to_atom(SigAlg) || SigAlg <- string:tokens(SigAlgs,","), - %% length of SigAlg is implicitly checked by member: - lists:member(SigAlg, SupportedAlgs) - ]}, - D0#data{ssh_params = Ssh}; + ServerSigAlgs = [list_to_atom(SigAlg) || SigAlg <- string:tokens(SigAlgs,","), + %% length of SigAlg is implicitly checked by the comparison + %% in member/2: + lists:member(SigAlg, SupportedAlgs) + ], + CommonAlgs = [Alg || Alg <- ServerSigAlgs, + lists:member(Alg, ClientSigAlgs)], + D0#data{ssh_params = Ssh0#ssh{userauth_pubkeys = CommonAlgs} }; ext_info(_, D0) -> %% Not implemented diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 6692432fcf..33792da38f 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -75,10 +75,7 @@ host_key(Algorithm, Opts) -> Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), case decode(File, Password) of {ok,Key} -> - case ssh_transport:valid_key_sha_alg(Key,Algorithm) of - true -> {ok,Key}; - false -> {error,bad_keytype_in_file} - end; + check_key_type(Key, Algorithm); {error,DecodeError} -> {error,DecodeError} end. @@ -104,10 +101,20 @@ is_host_key(Key, PeerName, Algorithm, Opts) -> user_key(Algorithm, Opts) -> File = file_name(user, identity_key_filename(Algorithm), Opts), Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), - decode(File, Password). + case decode(File, Password) of + {ok, Key} -> + check_key_type(Key, Algorithm); + Error -> + Error + end. %% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +check_key_type(Key, Algorithm) -> + case ssh_transport:valid_key_sha_alg(Key,Algorithm) of + true -> {ok,Key}; + false -> {error,bad_keytype_in_file} + end. file_base_name('ssh-rsa' ) -> "ssh_host_rsa_key"; file_base_name('rsa-sha2-256' ) -> "ssh_host_rsa_key"; diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 0886d5b34d..12c0190082 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -293,12 +293,6 @@ default(server) -> class => user_options }, - {auth_methods, def} => - #{default => ?SUPPORTED_AUTH_METHODS, - chk => fun check_string/1, - class => user_options - }, - {auth_method_kb_interactive_data, def} => #{default => undefined, % Default value can be constructed when User is known chk => fun({S1,S2,S3,B}) -> @@ -398,6 +392,12 @@ default(server) -> class => user_options }, + {preferred_algorithms, def} => + #{default => ssh:default_algorithms(), + chk => fun check_preferred_algorithms/1, + class => user_options + }, + %%%%% Undocumented {infofun, def} => #{default => fun(_,_,_) -> void end, @@ -436,12 +436,24 @@ default(client) -> }, {pref_public_key_algs, def} => - #{default => - ssh_transport:supported_algorithms(public_key), - chk => - fun check_pref_public_key_algs/1, - class => - ssh + #{default => ssh_transport:default_algorithms(public_key) -- ['rsa-sha2-256', + 'rsa-sha2-512'], + chk => fun check_pref_public_key_algs/1, + class => user_options + }, + + {preferred_algorithms, def} => + #{default => [{K,Vs} || {K,Vs0} <- ssh:default_algorithms(), + Vs <- [case K of + public_key -> + Vs0 -- ['rsa-sha2-256', + 'rsa-sha2-512']; + _ -> + Vs0 + end] + ], + chk => fun check_preferred_algorithms/1, + class => user_options }, {dh_gex_limits, def} => @@ -509,12 +521,6 @@ default(common) -> class => user_options }, - {preferred_algorithms, def} => - #{default => ssh:default_algorithms(), - chk => fun check_preferred_algorithms/1, - class => user_options - }, - {id_string, def} => #{default => undefined, % FIXME: see ssh_transport:ssh_vsn/0 chk => fun(random) -> @@ -582,6 +588,21 @@ default(common) -> class => user_options }, + {auth_methods, def} => + #{default => ?SUPPORTED_AUTH_METHODS, + chk => fun(As) -> + try + Sup = string:tokens(?SUPPORTED_AUTH_METHODS, ","), + New = string:tokens(As, ","), + [] == [X || X <- New, + not lists:member(X,Sup)] + catch + _:_ -> false + end + end, + class => user_options + }, + %%%%% Undocumented {transport, def} => #{default => ?DEFAULT_TRANSPORT, @@ -808,16 +829,23 @@ valid_hash(X, _) -> error_in_check(X, "Expect atom or list in fingerprint spec" %%%---------------------------------------------------------------- check_preferred_algorithms(Algs) -> + [error_in_check(K,"Bad preferred_algorithms key") + || {K,_} <- Algs, + not lists:keymember(K,1,ssh:default_algorithms())], + try alg_duplicates(Algs, [], []) of [] -> {true, - [try ssh_transport:supported_algorithms(Key) - of - DefAlgs -> handle_pref_alg(Key,Vals,DefAlgs) - catch - _:_ -> error_in_check(Key,"Bad preferred_algorithms key") - end || {Key,Vals} <- Algs] + [case proplists:get_value(Key, Algs) of + undefined -> + {Key,DefAlgs}; + Vals -> + handle_pref_alg(Key,Vals,SupAlgs) + end + || {{Key,DefAlgs}, {Key,SupAlgs}} <- lists:zip(ssh:default_algorithms(), + ssh_transport:supported_algorithms()) + ] }; Dups -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 25c64a4f25..1a15798080 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -92,10 +92,7 @@ default_algorithms(cipher) -> default_algorithms(mac) -> supported_algorithms(mac, same(['AEAD_AES_128_GCM', 'AEAD_AES_256_GCM'])); -default_algorithms(public_key) -> - supported_algorithms(public_key, ['rsa-sha2-256', - 'rsa-sha2-384', - 'rsa-sha2-512']); + default_algorithms(Alg) -> supported_algorithms(Alg, []). @@ -122,10 +119,9 @@ supported_algorithms(public_key) -> {'ecdsa-sha2-nistp384', [{public_keys,ecdsa}, {hashs,sha384}, {ec_curve,secp384r1}]}, {'ecdsa-sha2-nistp521', [{public_keys,ecdsa}, {hashs,sha512}, {ec_curve,secp521r1}]}, {'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {ec_curve,secp256r1}]}, + {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, {'rsa-sha2-256', [{public_keys,rsa}, {hashs,sha256} ]}, - {'rsa-sha2-384', [{public_keys,rsa}, {hashs,sha384} ]}, {'rsa-sha2-512', [{public_keys,rsa}, {hashs,sha512} ]}, - {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, {'ssh-dss', [{public_keys,dss}, {hashs,sha} ]} % Gone in OpenSSH 7.3.p1 ]); @@ -724,14 +720,28 @@ kex_ext_info(Role, Opts) -> end. ext_info_message(#ssh{role=client, - send_ext_info=true} = Ssh0) -> - %% FIXME: no extensions implemented - {ok, "", Ssh0}; + send_ext_info=true, + opts=Opts} = Ssh0) -> + %% Since no extension sent by the client is implemented, we add a fake one + %% to be able to test the framework. + %% Remove this when there is one and update ssh_protocol_SUITE whare it is used. + case proplists:get_value(ext_info_client, ?GET_OPT(tstflg,Opts)) of + true -> + Msg = #ssh_msg_ext_info{nr_extensions = 1, + data = [{"[email protected]", "Testing,PleaseIgnore"}] + }, + {SshPacket, Ssh} = ssh_packet(Msg, Ssh0), + {ok, SshPacket, Ssh}; + _ -> + {ok, "", Ssh0} + end; ext_info_message(#ssh{role=server, - send_ext_info=true} = Ssh0) -> + send_ext_info=true, + opts = Opts} = Ssh0) -> AlgsList = lists:map(fun erlang:atom_to_list/1, - ssh_transport:default_algorithms(public_key)), + proplists:get_value(public_key, + ?GET_OPT(preferred_algorithms, Opts))), Msg = #ssh_msg_ext_info{nr_extensions = 1, data = [{"server-sig-algs", string:join(AlgsList,",")}] }, diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index 410a9ea983..0995182623 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -284,8 +284,18 @@ fix_asym(#ssh_msg_global_request{name=N} = M) -> M#ssh_msg_global_request{name = fix_asym(#ssh_msg_debug{message=D,language=L} = M) -> M#ssh_msg_debug{message = binary_to_list(D), language = binary_to_list(L)}; fix_asym(#ssh_msg_kexinit{cookie=C} = M) -> M#ssh_msg_kexinit{cookie = <<C:128>>}; + +fix_asym(#ssh_msg_kexdh_reply{public_host_key = Key} = M) -> M#ssh_msg_kexdh_reply{public_host_key = key_sigalg(Key)}; +fix_asym(#ssh_msg_kex_dh_gex_reply{public_host_key = Key} = M) -> M#ssh_msg_kex_dh_gex_reply{public_host_key = key_sigalg(Key)}; +fix_asym(#ssh_msg_kex_ecdh_reply{public_host_key = Key} = M) -> M#ssh_msg_kex_ecdh_reply{public_host_key = key_sigalg(Key)}; + fix_asym(M) -> M. +%%% Keys now contains an sig-algorithm name +key_sigalg(#'RSAPublicKey'{} = Key) -> {Key,'ssh-rsa'}; +key_sigalg({_, #'Dss-Parms'{}} = Key) -> {Key,'ssh-dss'}; +key_sigalg({#'ECPoint'{}, {namedCurve,OID}} = Key) -> {Key,"ecdsa-sha2-256"}. + %%% Message codes 30 and 31 are overloaded depending on kex family so arrange the decoder %%% input as the test object does decode_state(<<30,_/binary>>=Msg, KexFam) -> <<KexFam/binary, Msg/binary>>; diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 6e6269d3e0..736461624d 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -68,7 +68,7 @@ groups() -> TagGroupSet ++ AlgoTcSet. -tags() -> [kex,cipher,mac,compression]. +tags() -> [kex,cipher,mac,compression,public_key]. two_way_tags() -> [cipher,mac,compression]. %%-------------------------------------------------------------------- @@ -123,20 +123,35 @@ init_per_group(Group, Config) -> Tag = proplists:get_value(name, hd(proplists:get_value(tc_group_path, Config))), Alg = Group, - PA = - case split(Alg) of - [_] -> - [Alg]; - [A1,A2] -> - [{client2server,[A1]}, - {server2client,[A2]}] - end, - ct:log("Init tests for tag=~p alg=~p",[Tag,PA]), - PrefAlgs = {preferred_algorithms,[{Tag,PA}]}, - start_std_daemon([PrefAlgs], - [{pref_algs,PrefAlgs} | Config]) + init_per_group(Tag, Alg, Config) end. + +init_per_group(public_key=Tag, Alg, Config) -> + ct:log("Init tests for public_key ~p",[Alg]), + PrefAlgs = {preferred_algorithms,[{Tag,[Alg]}]}, + %% Daemon started later in init_per_testcase + [{pref_algs,PrefAlgs}, + {tag_alg,{Tag,Alg}} + | Config]; + +init_per_group(Tag, Alg, Config) -> + PA = + case split(Alg) of + [_] -> + [Alg]; + [A1,A2] -> + [{client2server,[A1]}, + {server2client,[A2]}] + end, + ct:log("Init tests for tag=~p alg=~p",[Tag,PA]), + PrefAlgs = {preferred_algorithms,[{Tag,PA}]}, + start_std_daemon([PrefAlgs], + [{pref_algs,PrefAlgs}, + {tag_alg,{Tag,Alg}} + | Config]). + + end_per_group(_Alg, Config) -> case proplists:get_value(srvr_pid,Config) of Pid when is_pid(Pid) -> @@ -148,23 +163,49 @@ end_per_group(_Alg, Config) -> -init_per_testcase(sshc_simple_exec_os_cmd, Config) -> - start_pubkey_daemon([proplists:get_value(pref_algs,Config)], Config); -init_per_testcase(_TC, Config) -> - Config. +init_per_testcase(TC, Config) -> + init_per_testcase(TC, proplists:get_value(tag_alg,Config), Config). -end_per_testcase(sshc_simple_exec_os_cmd, Config) -> - case proplists:get_value(srvr_pid,Config) of - Pid when is_pid(Pid) -> - ssh:stop_daemon(Pid), - ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]); - _ -> - ok +init_per_testcase(_, {public_key,Alg}, Config) -> + Opts = pubkey_opts(Config), + case {ssh_file:user_key(Alg,Opts), ssh_file:host_key(Alg,Opts)} of + {{ok,_}, {ok,_}} -> + start_pubkey_daemon([proplists:get_value(pref_algs,Config)], + [{extra_daemon,true}|Config]); + {{ok,_}, _} -> + {skip, "No host key"}; + + {_, {ok,_}} -> + {skip, "No user key"}; + + _ -> + {skip, "Neither host nor user key"} end; -end_per_testcase(_TC, Config) -> + +init_per_testcase(sshc_simple_exec_os_cmd, _, Config) -> + start_pubkey_daemon([proplists:get_value(pref_algs,Config)], + [{extra_daemon,true}|Config]); + +init_per_testcase(_, _, Config) -> Config. + +end_per_testcase(_TC, Config) -> + case proplists:get_value(extra_daemon, Config, false) of + true -> + case proplists:get_value(srvr_pid,Config) of + Pid when is_pid(Pid) -> + ssh:stop_daemon(Pid), + ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]), + Config; + _ -> + Config + end; + _ -> + Config + end. + %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -260,8 +301,9 @@ sshc_simple_exec_os_cmd(Config) -> %%-------------------------------------------------------------------- %% Connect to the ssh server of the OS -sshd_simple_exec(_Config) -> +sshd_simple_exec(Config) -> ConnectionRef = ssh_test_lib:connect(22, [{silently_accept_hosts, true}, + proplists:get_value(pref_algs,Config), {user_interaction, false}]), {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), success = ssh_connection:exec(ConnectionRef, ChannelId0, @@ -318,29 +360,32 @@ concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])). split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")). specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) -> - [simple_exec, simple_sftp] ++ - case supports(Tag, Alg, SshcAlgos) of - true when TypeSSH == openSSH -> - [sshc_simple_exec_os_cmd]; - _ -> - [] - end ++ - case supports(Tag, Alg, SshdAlgos) of - true -> - [sshd_simple_exec]; - _ -> - [] - end ++ - case {Tag,Alg} of - {kex,_} when Alg == 'diffie-hellman-group-exchange-sha1' ; - Alg == 'diffie-hellman-group-exchange-sha256' -> - [simple_exec_groups, - simple_exec_groups_no_match_too_large, - simple_exec_groups_no_match_too_small - ]; - _ -> - [] - end. + case Tag of + public_key -> []; + _ -> [simple_exec, simple_sftp] + end + ++ case supports(Tag, Alg, SshcAlgos) of + true when TypeSSH == openSSH -> + [sshc_simple_exec_os_cmd]; + _ -> + [] + end ++ + case supports(Tag, Alg, SshdAlgos) of + true -> + [sshd_simple_exec]; + _ -> + [] + end ++ + case {Tag,Alg} of + {kex,_} when Alg == 'diffie-hellman-group-exchange-sha1' ; + Alg == 'diffie-hellman-group-exchange-sha256' -> + [simple_exec_groups, + simple_exec_groups_no_match_too_large, + simple_exec_groups_no_match_too_small + ]; + _ -> + [] + end. supports(Tag, Alg, Algos) -> lists:all(fun(A) -> @@ -370,19 +415,30 @@ start_std_daemon(Opts, Config) -> ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. + start_pubkey_daemon(Opts0, Config) -> - Opts = [{auth_methods,"publickey"}|Opts0], - {Pid, Host, Port} = ssh_test_lib:std_daemon1(Config, Opts), - ct:log("started pubkey_daemon ~p:~p ~p",[Host,Port,Opts]), + ct:log("starting pubkey_daemon",[]), + Opts = pubkey_opts(Config) ++ Opts0, + {Pid, Host, Port} = ssh_test_lib:daemon([{failfun, fun ssh_test_lib:failfun/2} + | Opts]), + ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. +pubkey_opts(Config) -> + SystemDir = filename:join(proplists:get_value(priv_dir,Config), "system"), + [{auth_methods,"publickey"}, + {system_dir, SystemDir}]. + + setup_pubkey(Config) -> DataDir = proplists:get_value(data_dir, Config), UserDir = proplists:get_value(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, UserDir), - ssh_test_lib:setup_rsa(DataDir, UserDir), - ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + Keys = + [ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_rsa(DataDir, UserDir), + ssh_test_lib:setup_ecdsa("256", DataDir, UserDir)], + ssh_test_lib:write_auth_keys(Keys, UserDir), % 'authorized_keys' shall contain ALL pub keys Config. diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index b80c3ed5e2..62e2a585e4 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -612,7 +612,7 @@ exec_key_differs(Config, UserPKAlgs) -> {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, SystemUserDir}, {preferred_algorithms, - [{public_key,['ssh-rsa']}]}]), + [{public_key,['ssh-rsa'|UserPKAlgs]}]}]), ct:sleep(500), IO = ssh_test_lib:start_io_server(), @@ -1173,13 +1173,10 @@ login_bad_pwd_no_retry3(Config) -> login_bad_pwd_no_retry(Config, "password,publickey,keyboard-interactive"). login_bad_pwd_no_retry4(Config) -> - login_bad_pwd_no_retry(Config, "password,other,keyboard-interactive"). + login_bad_pwd_no_retry(Config, "password,keyboard-interactive"). login_bad_pwd_no_retry5(Config) -> - login_bad_pwd_no_retry(Config, "password,other,keyboard-interactive,password,password"). - - - + login_bad_pwd_no_retry(Config, "password,keyboard-interactive,password,password"). login_bad_pwd_no_retry(Config, AuthMethods) -> diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index 9b2a84d8e4..5ea60d8a8f 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -55,6 +55,9 @@ groups() -> init_per_suite(Config) -> ct_property_test:init_per_suite(Config). +end_per_suite(Config) -> + Config. + %%% One group in this suite happens to support only QuickCheck, so skip it %%% if we run proper. init_per_group(client_server, Config) -> diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 5a6e0638a7..0385e30ad1 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -59,7 +59,8 @@ all() -> {group,service_requests}, {group,authentication}, {group,packet_size_error}, - {group,field_size_error} + {group,field_size_error}, + {group,ext_info} ]. groups() -> @@ -90,7 +91,12 @@ groups() -> bad_service_name_then_correct ]}, {authentication, [], [client_handles_keyboard_interactive_0_pwds - ]} + ]}, + {ext_info, [], [no_ext_info_s1, + no_ext_info_s2, + ext_info_s, + ext_info_c + ]} ]. @@ -644,7 +650,113 @@ client_info_line(_Config) -> ok end. +%%%-------------------------------------------------------------------- +%%% The server does not send the extension because +%%% the client does not tell the server to send it +no_ext_info_s1(Config) -> + %% Start the dameon + Server = {Pid,_,_} = ssh_test_lib:daemon([{send_ext_info,true}, + {system_dir, system_dir(Config)}]), + {ok,AfterKexState} = connect_and_kex([{server,Server}|Config]), + {ok,_} = + ssh_trpt_test_lib:exec( + [{send, #ssh_msg_service_request{name = "ssh-userauth"}}, + {match, #ssh_msg_service_accept{name = "ssh-userauth"}, receive_msg} + ], AfterKexState), + ssh:stop_daemon(Pid). + +%%%-------------------------------------------------------------------- +%%% The server does not send the extension because +%%% the server is not configured to send it +no_ext_info_s2(Config) -> + %% Start the dameon + Server = {Pid,_,_} = ssh_test_lib:daemon([{send_ext_info,false}, + {system_dir, system_dir(Config)}]), + {ok,AfterKexState} = connect_and_kex([{extra_options,[{recv_ext_info,true}]}, + {server,Server} + | Config]), + {ok,_} = + ssh_trpt_test_lib:exec( + [{send, #ssh_msg_service_request{name = "ssh-userauth"}}, + {match, #ssh_msg_service_accept{name = "ssh-userauth"}, receive_msg} + ], AfterKexState), + ssh:stop_daemon(Pid). + +%%%-------------------------------------------------------------------- +%%% The server sends the extension +ext_info_s(Config) -> + %% Start the dameon + Server = {Pid,_,_} = ssh_test_lib:daemon([{send_ext_info,true}, + {system_dir, system_dir(Config)}]), + {ok,AfterKexState} = connect_and_kex([{extra_options,[{recv_ext_info,true}]}, + {server,Server} + | Config]), + {ok,_} = + ssh_trpt_test_lib:exec( + [{match, #ssh_msg_ext_info{_='_'}, receive_msg} + ], + AfterKexState), + ssh:stop_daemon(Pid). + +%%%-------------------------------------------------------------------- +%%% The client sends the extension +ext_info_c(Config) -> + {User,_Pwd} = server_user_password(Config), + + %% Create a listening socket as server socket: + {ok,InitialState} = ssh_trpt_test_lib:exec(listen), + HostPort = ssh_trpt_test_lib:server_host_port(InitialState), + + Parent = self(), + %% Start a process handling one connection on the server side: + Pid = + spawn_link( + fun() -> + Result = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_messages]}, + {accept, [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}, + {recv_ext_info, true} + ]}, + receive_hello, + {send, hello}, + + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + + {match, #ssh_msg_kexdh_init{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_reply}, + + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg}, + + {match, #ssh_msg_ext_info{_='_'}, receive_msg}, + + close_socket, + print_state + ], + InitialState), + Parent ! {result,self(),Result} + end), + + %% connect to it with a regular Erlang SSH client + %% (expect error due to the close_socket in daemon): + {error,_} = std_connect(HostPort, Config, + [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, + {cipher,?DEFAULT_CIPHERS} + ]}, + {tstflg, [{ext_info_client,true}]}, + {send_ext_info, true} + ] + ), + %% Check that the daemon got expected result: + receive + {result, Pid, {ok,_}} -> ok; + {result, Pid, Error} -> ct:fail("Error: ~p",[Error]) + end. + %%%================================================================ %%%==== Internal functions ======================================== %%%================================================================ @@ -751,10 +863,12 @@ connect_and_kex(Config, InitialState) -> [{preferred_algorithms,[{kex,[?DEFAULT_KEX]}, {cipher,?DEFAULT_CIPHERS} ]}, - {silently_accept_hosts, true}, + {silently_accept_hosts, true}, {recv_ext_info, false}, {user_dir, user_dir(Config)}, - {user_interaction, false}]}, + {user_interaction, false} + | proplists:get_value(extra_options,Config,[]) + ]}, receive_hello, {send, hello}, {send, ssh_msg_kexinit}, diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 36ae2525da..7b273fecef 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -500,8 +500,12 @@ setup_ecdsa_auth_keys(_Size, Dir, UserDir) -> setup_auth_keys(Keys, Dir) -> AuthKeys = public_key:ssh_encode(Keys, auth_keys), AuthKeysFile = filename:join(Dir, "authorized_keys"), - file:write_file(AuthKeysFile, AuthKeys). + ok = file:write_file(AuthKeysFile, AuthKeys), + AuthKeys. +write_auth_keys(Keys, Dir) -> + AuthKeysFile = filename:join(Dir, "authorized_keys"), + file:write_file(AuthKeysFile, Keys). del_dirs(Dir) -> case file:list_dir(Dir) of diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index a3d596a1c9..4d6aa93d4e 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -107,6 +107,9 @@ init_per_testcase(erlang_server_openssh_client_public_key_rsa, Config) -> chk_key(sshc, 'ssh-rsa', ".ssh/id_rsa", Config); init_per_testcase(erlang_client_openssh_server_publickey_dsa, Config) -> chk_key(sshd, 'ssh-dss', ".ssh/id_dsa", Config); +init_per_testcase(erlang_client_openssh_server_publickey_rsa, Config) -> + chk_key(sshd, 'ssh-rsa', ".ssh/id_rsa", Config); + init_per_testcase(erlang_server_openssh_client_renegotiate, Config) -> case os:type() of {unix,_} -> ssh:start(), Config; @@ -322,65 +325,44 @@ erlang_client_openssh_server_setenv(Config) when is_list(Config) -> %% setenv not meaningfull on erlang ssh daemon! %%-------------------------------------------------------------------- -erlang_client_openssh_server_publickey_rsa() -> - [{doc, "Validate using rsa publickey."}]. -erlang_client_openssh_server_publickey_rsa(Config) when is_list(Config) -> - {ok,[[Home]]} = init:get_argument(home), - KeyFile = filename:join(Home, ".ssh/id_rsa"), - case file:read_file(KeyFile) of - {ok, Pem} -> - case public_key:pem_decode(Pem) of - [{_,_, not_encrypted}] -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{pref_public_key_algs, ['ssh-rsa','ssh-dss']}, - {user_interaction, false}, - silently_accept_hosts]), - {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), - ok = ssh_connection:close(ConnectionRef, Channel), - ok = ssh:close(ConnectionRef); - _ -> - {skip, {error, "Has pass phrase can not be used by automated test case"}} - end; - _ -> - {skip, "no ~/.ssh/id_rsa"} - end. - +erlang_client_openssh_server_publickey_rsa(Config) -> + erlang_client_openssh_server_publickey_X(Config, 'ssh-rsa'). + +erlang_client_openssh_server_publickey_dsa(Config) -> + erlang_client_openssh_server_publickey_X(Config, 'ssh-dss'). -%%-------------------------------------------------------------------- -erlang_client_openssh_server_publickey_dsa() -> - [{doc, "Validate using dsa publickey."}]. -erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> + +erlang_client_openssh_server_publickey_X(Config, Alg) -> ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{pref_public_key_algs, ['ssh-dss','ssh-rsa']}, - {user_interaction, false}, - silently_accept_hosts]), + ssh_test_lib:connect(?SSH_DEFAULT_PORT, + [{pref_public_key_algs, [Alg]}, + {user_interaction, false}, + {auth_methods, "publickey"}, + silently_accept_hosts]), {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), + ssh_connection:session_channel(ConnectionRef, infinity), ok = ssh_connection:close(ConnectionRef, Channel), ok = ssh:close(ConnectionRef). %%-------------------------------------------------------------------- erlang_server_openssh_client_public_key_dsa() -> - [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, - {doc, "Validate using dsa publickey."}]. + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}]. erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> - erlang_server_openssh_client_public_key_X(Config, ssh_dsa). + erlang_server_openssh_client_public_key_X(Config, 'ssh-dss'). -erlang_server_openssh_client_public_key_rsa() -> - [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, - {doc, "Validate using rsa publickey."}]. +erlang_server_openssh_client_public_key_rsa() -> + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}]. erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> - erlang_server_openssh_client_public_key_X(Config, ssh_rsa). + erlang_server_openssh_client_public_key_X(Config, 'ssh-rsa'). -erlang_server_openssh_client_public_key_X(Config, _PubKeyAlg) -> +erlang_server_openssh_client_public_key_X(Config, Alg) -> SystemDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {preferred_algorithms,[{public_key, [Alg]}]}, + {auth_methods, "publickey"}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -401,7 +383,7 @@ erlang_server_openssh_client_renegotiate(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {failfun, fun ssh_test_lib:failfun/2}]), + {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), RenegLimitK = 3, diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 9937373e6e..f078b87bce 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -53,7 +53,7 @@ %% Data handling -export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4, - send/3, socket/5]). + send/3, socket/5, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -203,6 +203,11 @@ select_sni_extension(_) -> socket(Pid, Transport, Socket, Connection, _) -> dtls_socket:socket(Pid, Transport, Socket, Connection). +setopts(Transport, Socket, Other) -> + dtls_socket:setopts(Transport, Socket, Other). +getopts(Transport, Socket, Tag) -> + dtls_socket:getopts(Transport, Socket, Tag). + %%==================================================================== %% tls_connection_sup API %%==================================================================== @@ -688,16 +693,18 @@ next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 -> {no_record, State#state{unprocessed_handshake_events = N-1}}; next_record(#state{protocol_buffers = - #protocol_buffers{dtls_cipher_texts = [CT | Rest]} + #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]} = Buffers, - connection_states = ConnStates0} = State) -> - case dtls_record:decode_cipher_text(CT, ConnStates0) of - {Plain, ConnStates} -> - {Plain, State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_cipher_texts = Rest}, - connection_states = ConnStates}}; - #alert{} = Alert -> - {Alert, State} + connection_states = ConnectionStates} = State) -> + CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read), + case dtls_record:replay_detect(CT, CurrentRead) of + false -> + decode_cipher_text(State#state{connection_states = ConnectionStates}) ; + true -> + %% Ignore replayed record + next_record(State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnectionStates}) end; next_record(#state{role = server, socket = {Listener, {Client, _}}, @@ -770,6 +777,17 @@ next_event(StateName, Record, {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. +decode_cipher_text(#state{protocol_buffers = #protocol_buffers{dtls_cipher_texts = [ CT | Rest]} = Buffers, + connection_states = ConnStates0} = State) -> + case dtls_record:decode_cipher_text(CT, ConnStates0) of + {Plain, ConnStates} -> + {Plain, State#state{protocol_buffers = + Buffers#protocol_buffers{dtls_cipher_texts = Rest}, + connection_states = ConnStates}}; + #alert{} = Alert -> + {Alert, State} + end. + dtls_version(hello, Version, #state{role = server} = State) -> State#state{negotiated_version = Version}; %%Inital version dtls_version(_,_, State) -> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 6a418c6fb1..8a7f8c1d0a 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -46,7 +46,7 @@ is_higher/2, supported_protocol_versions/0, is_acceptable_version/2, hello_version/2]). --export([save_current_connection_state/2, next_epoch/2]). +-export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2]). -export([init_connection_state_seq/2, current_connection_state_epoch/2]). @@ -55,6 +55,8 @@ -type dtls_version() :: ssl_record:ssl_version(). -type dtls_atom_version() :: dtlsv1 | 'dtlsv1.2'. +-define(REPLAY_WINDOW_SIZE, 64). + -compile(inline). %%==================================================================== @@ -73,7 +75,7 @@ init_connection_states(Role, BeastMitigation) -> Initial = initial_connection_state(ConnectionEnd, BeastMitigation), Current = Initial#{epoch := 0}, InitialPending = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation), - Pending = InitialPending#{epoch => undefined}, + Pending = InitialPending#{epoch => undefined, replay_window => init_replay_window(?REPLAY_WINDOW_SIZE)}, #{saved_read => Current, current_read => Current, pending_read => Pending, @@ -96,11 +98,13 @@ save_current_connection_state(#{current_write := Current} = States, write) -> next_epoch(#{pending_read := Pending, current_read := #{epoch := Epoch}} = States, read) -> - States#{pending_read := Pending#{epoch := Epoch + 1}}; + States#{pending_read := Pending#{epoch := Epoch + 1, + replay_window := init_replay_window(?REPLAY_WINDOW_SIZE)}}; next_epoch(#{pending_write := Pending, current_write := #{epoch := Epoch}} = States, write) -> - States#{pending_write := Pending#{epoch := Epoch + 1}}. + States#{pending_write := Pending#{epoch := Epoch + 1, + replay_window := init_replay_window(?REPLAY_WINDOW_SIZE)}}. get_connection_state_by_epoch(Epoch, #{current_write := #{epoch := Epoch} = Current}, write) -> @@ -411,6 +415,7 @@ hello_version(Version, Versions) -> lowest_protocol_version(Versions) end. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -419,6 +424,7 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> ssl_record:initial_security_params(ConnectionEnd), epoch => undefined, sequence_number => 0, + replay_window => init_replay_window(?REPLAY_WINDOW_SIZE), beast_mitigation => BeastMitigation, compression_state => undefined, cipher_state => undefined, @@ -499,8 +505,9 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, {PlainFragment, CipherState} -> {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), - ReadState = ReadState0#{compression_state => CompressionS1, + ReadState0 = ReadState0#{compression_state => CompressionS1, cipher_state => CipherState}, + ReadState = update_replay_window(Seq, ReadState0), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; #alert{} = Alert -> @@ -523,7 +530,8 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), - ReadState = ReadState1#{compression_state => CompressionS1}, + ReadState2 = ReadState1#{compression_state => CompressionS1}, + ReadState = update_replay_window(Seq, ReadState2), ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read), {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; false -> @@ -555,3 +563,38 @@ mac_hash({Major, Minor}, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) -> <<?UINT16(Epoch), ?UINT48(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. + +init_replay_window(Size) -> + #{size => Size, + top => Size, + bottom => 0, + mask => 0 bsl 64 + }. + +replay_detect(#ssl_tls{sequence_number = SequenceNumber}, #{replay_window := Window}) -> + is_replay(SequenceNumber, Window). + + +is_replay(SequenceNumber, #{bottom := Bottom}) when SequenceNumber < Bottom -> + true; +is_replay(SequenceNumber, #{size := Size, + top := Top, + bottom := Bottom, + mask := Mask}) when (SequenceNumber >= Bottom) andalso (SequenceNumber =< Top) -> + Index = (SequenceNumber rem Size), + (Index band Mask) == 1; + +is_replay(_, _) -> + false. + +update_replay_window(SequenceNumber, #{replay_window := #{size := Size, + top := Top, + bottom := Bottom, + mask := Mask0} = Window0} = ConnectionStates) -> + NoNewBits = SequenceNumber - Top, + Index = SequenceNumber rem Size, + Mask = (Mask0 bsl NoNewBits) bor Index, + Window = Window0#{top => SequenceNumber, + bottom => Bottom + NoNewBits, + mask => Mask}, + ConnectionStates#{replay_window := Window}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d9e47c43ad..5421bdef99 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -455,7 +455,16 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> _:_ -> {error, {options, {not_a_proplist, Options0}}} end; - +setopts(#sslsocket{pid = {{udp, _}, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> + try dtls_socket:setopts(Transport, ListenSocket, Options) of + ok -> + ok; + {error, InetError} -> + {error, {options, {socket_options, Options, InetError}}} + catch + _:Error -> + {error, {options, {socket_options, Options, Error}}} + end; setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try tls_socket:setopts(Transport, ListenSocket, Options) of ok -> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e935e07b65..fb87662c7b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -905,14 +905,14 @@ handle_call({new_user, User}, From, StateName, handle_call({get_opts, OptTags}, From, _, #state{socket = Socket, transport_cb = Transport, - socket_options = SockOpts}, _) -> - OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), + socket_options = SockOpts}, Connection) -> + OptsReply = get_socket_opts(Connection, Transport, Socket, OptTags, SockOpts, []), {keep_state_and_data, [{reply, From, OptsReply}]}; handle_call({set_opts, Opts0}, From, StateName, #state{socket_options = Opts1, socket = Socket, - transport_cb = Transport} = State0, _) -> - {Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []), + transport_cb = Transport} = State0, Connection) -> + {Reply, Opts} = set_socket_opts(Connection, Transport, Socket, Opts0, Opts1, []), State = State0#state{socket_options = Opts}, handle_active_option(Opts#socket_options.active, StateName, From, Reply, State); @@ -1910,42 +1910,39 @@ call(FsmPid, Event) -> {error, closed} end. -get_socket_opts(_,_,[], _, Acc) -> +get_socket_opts(_, _,_,[], _, Acc) -> {ok, Acc}; -get_socket_opts(Transport, Socket, [mode | Tags], SockOpts, Acc) -> - get_socket_opts(Transport, Socket, Tags, SockOpts, +get_socket_opts(Connection, Transport, Socket, [mode | Tags], SockOpts, Acc) -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{mode, SockOpts#socket_options.mode} | Acc]); -get_socket_opts(Transport, Socket, [packet | Tags], SockOpts, Acc) -> +get_socket_opts(Connection, Transport, Socket, [packet | Tags], SockOpts, Acc) -> case SockOpts#socket_options.packet of {Type, headers} -> - get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]); + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]); Type -> - get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]) + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]) end; -get_socket_opts(Transport, Socket, [header | Tags], SockOpts, Acc) -> - get_socket_opts(Transport, Socket, Tags, SockOpts, +get_socket_opts(Connection, Transport, Socket, [header | Tags], SockOpts, Acc) -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{header, SockOpts#socket_options.header} | Acc]); -get_socket_opts(Transport, Socket, [active | Tags], SockOpts, Acc) -> - get_socket_opts(Transport, Socket, Tags, SockOpts, +get_socket_opts(Connection, Transport, Socket, [active | Tags], SockOpts, Acc) -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); -get_socket_opts(Transport, Socket, [Tag | Tags], SockOpts, Acc) -> - try tls_socket:getopts(Transport, Socket, [Tag]) of - {ok, [Opt]} -> - get_socket_opts(Transport, Socket, Tags, SockOpts, [Opt | Acc]); - {error, Error} -> - {error, {options, {socket_options, Tag, Error}}} - catch - %% So that inet behavior does not crash our process - _:Error -> {error, {options, {socket_options, Tag, Error}}} +get_socket_opts(Connection, Transport, Socket, [Tag | Tags], SockOpts, Acc) -> + case Connection:getopts(Transport, Socket, [Tag]) of + {ok, [Opt]} -> + get_socket_opts(Connection, Transport, Socket, Tags, SockOpts, [Opt | Acc]); + {error, Reason} -> + {error, {options, {socket_options, Tag, Reason}}} end; -get_socket_opts(_, _,Opts, _,_) -> +get_socket_opts(_,_, _,Opts, _,_) -> {error, {options, {socket_options, Opts, function_clause}}}. -set_socket_opts(_,_, [], SockOpts, []) -> +set_socket_opts(_,_,_, [], SockOpts, []) -> {ok, SockOpts}; -set_socket_opts(Transport, Socket, [], SockOpts, Other) -> +set_socket_opts(ConnectionCb, Transport, Socket, [], SockOpts, Other) -> %% Set non emulated options - try tls_socket:setopts(Transport, Socket, Other) of + try ConnectionCb:setopts(Transport, Socket, Other) of ok -> {ok, SockOpts}; {error, InetError} -> @@ -1956,13 +1953,13 @@ set_socket_opts(Transport, Socket, [], SockOpts, Other) -> {{error, {options, {socket_options, Other, Error}}}, SockOpts} end; -set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); -set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_, _, _, [{mode, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; Packet == 0; Packet == 1; @@ -1978,26 +1975,26 @@ set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) Packet == httph; Packet == http_bin; Packet == httph_bin -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); -set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_, _, _, [{packet, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); -set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_, _, _, [{header, _} = Opt| _], SockOpts, _) -> {{error,{options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) +set_socket_opts(ConnectionCb, Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; Active == true; Active == false -> - set_socket_opts(Transport, Socket, Opts, + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); -set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> +set_socket_opts(_,_, _, [{active, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}} }, SockOpts}; -set_socket_opts(Transport, Socket, [Opt | Opts], SockOpts, Other) -> - set_socket_opts(Transport, Socket, Opts, SockOpts, [Opt | Other]). +set_socket_opts(ConnectionCb, Transport, Socket, [Opt | Opts], SockOpts, Other) -> + set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts, [Opt | Other]). start_or_recv_cancel_timer(infinity, _RecvFrom) -> undefined; diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index a289ee0a65..96c3ab86e9 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -60,7 +60,7 @@ %% Data handling -export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3, - socket/5]). + socket/5, setopts/3, getopts/3]). %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states @@ -195,6 +195,10 @@ callback_mode() -> socket(Pid, Transport, Socket, Connection, Tracker) -> tls_socket:socket(Pid, Transport, Socket, Connection, Tracker). +setopts(Transport, Socket, Other) -> + tls_socket:setopts(Transport, Socket, Other). +getopts(Transport, Socket, Tag) -> + tls_socket:getopts(Transport, Socket, Tag). %%-------------------------------------------------------------------- %% State functions diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index 960ddf7808..ae2928b1c3 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -410,13 +410,19 @@ ssl_opts(connect_der) -> [{verify, verify_peer} | ssl_opts("client_der")]; ssl_opts(Role) -> CertData = cert_data(Role), - [{active, false}, - {depth, 2}, - {reuseaddr, true}, - {mode,binary}, - {nodelay, true}, - {ciphers, [{dhe_rsa,aes_256_cbc,sha}]} - |CertData]. + Opts = [{active, false}, + {depth, 2}, + {reuseaddr, true}, + {mode,binary}, + {nodelay, true}, + {ciphers, [{dhe_rsa,aes_256_cbc,sha}]} + |CertData], + case Role of + "client" ++ _ -> + [{server_name_indication, disable} | Opts]; + "server" ++ _ -> + Opts + end. cert_data(Der) when Der =:= "server_der"; Der =:= "client_der" -> [Role,_] = string:tokens(Der, "_"), diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index 09bde3e397..012737c390 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -358,7 +358,7 @@ gen_event:stop -----> Module:terminate/2 <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> <v>Options = [Option]</v> - <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {hibernate_after,HibernateAfterTimeout} | {spawn_opt,SOpts}</v> <v> Dbgs = [Dbg]</v> <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> <v> SOpts = [term()]</v> @@ -385,7 +385,7 @@ gen_event:stop -----> Module:terminate/2 <v> Name = atom()</v> <v> GlobalName = ViaName = term()</v> <v>Options = [Option]</v> - <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {hibernate_after,HibernateAfterTimeout} | {spawn_opt,SOpts}</v> <v> Dbgs = [Dbg]</v> <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> <v> SOpts = [term()]</v> @@ -419,6 +419,12 @@ gen_event:stop -----> Module:terminate/2 <seealso marker="kernel:global"><c>global</c></seealso>. Thus, <c>{via,global,GlobalName}</c> is a valid reference.</p> </item> + <item> + <p>If option <c>{hibernate_after,HibernateAfterTimeout}</c> is present, the <c>gen_event</c> + process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and + if no message is received, the process goes into hibernation automatically + (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>).</p> + </item> </list> <p>If the event manager is successfully created, the function returns <c>{ok,Pid}</c>, where <c>Pid</c> is the pid of diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index a8006bb870..7d137fc772 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -199,7 +199,7 @@ gen_server:abcast -----> Module:handle_cast/2 <type> <v>Module = atom()</v> <v>Options = [Option]</v> - <v> Option = {debug,Dbgs}</v> + <v> Option = {debug,Dbgs} | {hibernate_after,HibernateAfterTimeout}</v> <v> Dbgs = [Dbg]</v> <v> Dbg = trace | log | statistics</v> <v> | {log_to_file,FileName} | {install,{Func,FuncState}}</v> @@ -334,7 +334,7 @@ gen_server:abcast -----> Module:handle_cast/2 <v>Module = atom()</v> <v>Args = term()</v> <v>Options = [Option]</v> - <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {hibernate_after,HibernateAfterTimeout} | {spawn_opt,SOpts}</v> <v> Dbgs = [Dbg]</v> <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> <v> SOpts = [term()]</v> @@ -364,7 +364,7 @@ gen_server:abcast -----> Module:handle_cast/2 <v>Module = atom()</v> <v>Args = term()</v> <v>Options = [Option]</v> - <v> Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {hibernate_after,HibernateAfterTimeout} | {spawn_opt,SOpts}</v> <v> Dbgs = [Dbg]</v> <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> <v> SOpts = [term()]</v> @@ -417,6 +417,12 @@ gen_server:abcast -----> Module:handle_cast/2 returns <c>{error,timeout}</c>.</p> </item> <item> + <p>If option <c>{hibernate_after,HibernateAfterTimeout}</c> is present, the <c>gen_server</c> + process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and + if no message is received, the process goes into hibernation automatically + (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>).</p> + </item> + <item> <p>If option <c>{debug,Dbgs}</c> is present, the corresponding <c>sys</c> function is called for each item in <c>Dbgs</c>; see diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 17a3a3c83c..1aac88c308 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -453,6 +453,21 @@ handle_event(_, _, State, Data) -> </desc> </datatype> <datatype> + <name name="hibernate_after_opt"/> + <desc> + <p> + hibernate_after option that can be used when starting + a <c>gen_statem</c> server through, + <seealso marker="#enter_loop/4"><c>enter_loop/4-6</c></seealso>. + </p> + <p>If option<seealso marker="#type-hibernate_after_opt"><c>{hibernate_after,HibernateAfterTimeout}</c></seealso> is present, the <c>gen_statem</c> + process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and + if no message is received, the process goes into hibernation automatically + (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>). + </p> + </desc> + </datatype> + <datatype> <name name="start_opt"/> <desc> <p> @@ -1551,6 +1566,13 @@ handle_event(_, _, State, Data) -> </p> </item> <item> + <p>If option<seealso marker="#type-hibernate_after_opt"><c>{hibernate_after,HibernateAfterTimeout}</c></seealso> is present, the <c>gen_statem</c> + process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and + if no message is received, the process goes into hibernation automatically + (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>). + </p> + </item> + <item> <p> If option <seealso marker="#type-debug_opt"><c>{debug,Dbgs}</c></seealso> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 7c40058dd8..d53a31db0d 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -92,6 +92,14 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: dict:dict(ta(), line()) }). + +%% Are we outside or inside a catch or try/catch? +-type catch_scope() :: 'none' + | 'after_old_catch' + | 'after_try' + | 'wrong_part_of_try' + | 'try_catch'. + %% Define the lint state record. %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. @@ -135,7 +143,9 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> types = dict:new() %Type definitions :: dict:dict(ta(), #typeinfo{}), exp_types=gb_sets:empty() %Exported types - :: gb_sets:set(ta()) + :: gb_sets:set(ta()), + catch_scope = none %Inside/outside try or catch + :: catch_scope() }). -type lint_state() :: #lint{}. @@ -223,7 +233,15 @@ format_error({redefine_old_bif_import,{F,A}}) -> format_error({redefine_bif_import,{F,A}}) -> io_lib:format("import directive overrides auto-imported BIF ~w/~w~n" " - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]); - +format_error({get_stacktrace,wrong_part_of_try}) -> + "erlang:get_stacktrace/0 used in the wrong part of 'try' expression. " + "(Use it in the block between 'catch' and 'end'.)"; +format_error({get_stacktrace,after_old_catch}) -> + "erlang:get_stacktrace/0 used following an old-style 'catch' " + "may stop working in a future release. (Use it inside 'try'.)"; +format_error({get_stacktrace,after_try}) -> + "erlang:get_stacktrace/0 used following a 'try' expression " + "may stop working in a future release. (Use it inside 'try'.)"; format_error({deprecated, MFA, ReplacementMFA, Rel}) -> io_lib:format("~s is deprecated and will be removed in ~s; use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); @@ -568,7 +586,10 @@ start(File, Opts) -> false, Opts)}, {missing_spec_all, bool_option(warn_missing_spec_all, nowarn_missing_spec_all, - false, Opts)} + false, Opts)}, + {get_stacktrace, + bool_option(warn_get_stacktrace, nowarn_get_stacktrace, + true, Opts)} ], Enabled1 = [Category || {Category,true} <- Enabled0], Enabled = ordsets:from_list(Enabled1), @@ -1405,8 +1426,9 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St) %% function(Line, Name, Arity, Clauses, State) -> State. function(Line, Name, Arity, Cs, St0) -> - St1 = define_function(Line, Name, Arity, St0#lint{func={Name,Arity}}), - clauses(Cs, St1). + St1 = St0#lint{func={Name,Arity},catch_scope=none}, + St2 = define_function(Line, Name, Arity, St1), + clauses(Cs, St2). -spec define_function(line(), atom(), arity(), lint_state()) -> lint_state(). @@ -2338,22 +2360,24 @@ expr({call,Line,F,As}, Vt, St0) -> expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> %% Currently, we don't allow any exports because later %% passes cannot handle exports in combination with 'after'. - {Evt0,St1} = exprs(Es, Vt, St0), + {Evt0,St1} = exprs(Es, Vt, St0#lint{catch_scope=wrong_part_of_try}), TryLine = {'try',Line}, Uvt = vtunsafe(TryLine, Evt0, Vt), Evt1 = vtupdate(Uvt, Evt0), - {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1), + {Sccs,St2} = try_clauses(Scs, Ccs, TryLine, + vtupdate(Evt1, Vt), St1), Rvt0 = Sccs, Rvt1 = vtupdate(vtunsafe(TryLine, Rvt0, Vt), Rvt0), Evt2 = vtmerge(Evt1, Rvt1), {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0), Avt = vtmerge(Evt2, Avt1), - {Avt,St}; + {Avt,St#lint{catch_scope=after_try}}; expr({'catch',Line,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. {Evt,St} = expr(E, Vt, St0), - {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St}; + {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt), + St#lint{catch_scope=after_old_catch}}; expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), @@ -3173,6 +3197,17 @@ is_module_dialyzer_option(Option) -> error_handling,race_conditions,no_missing_calls, specdiffs,overspecs,underspecs,unknown]). +%% try_catch_clauses(Scs, Ccs, In, ImportVarTable, State) -> +%% {UpdVt,State}. + +try_clauses(Scs, Ccs, In, Vt, St0) -> + {Csvt0,St1} = icrt_clauses(Scs, Vt, St0), + St2 = St1#lint{catch_scope=try_catch}, + {Csvt1,St3} = icrt_clauses(Ccs, Vt, St2), + Csvt = Csvt0 ++ Csvt1, + UpdVt = icrt_export(Csvt, Vt, In, St3), + {UpdVt,St3}. + %% icrt_clauses(Clauses, In, ImportVarTable, State) -> %% {UpdVt,State}. @@ -3657,7 +3692,8 @@ has_wildcard_field([]) -> false. check_remote_function(Line, M, F, As, St0) -> St1 = deprecated_function(Line, M, F, As, St0), St2 = check_qlc_hrl(Line, M, F, As, St1), - format_function(Line, M, F, As, St2). + St3 = check_get_stacktrace(Line, M, F, As, St2), + format_function(Line, M, F, As, St3). %% check_qlc_hrl(Line, ModName, FuncName, [Arg], State) -> State %% Add warning if qlc:q/1,2 has been called but qlc.hrl has not @@ -3706,6 +3742,23 @@ deprecated_function(Line, M, F, As, St) -> St end. +check_get_stacktrace(Line, erlang, get_stacktrace, [], St) -> + case St of + #lint{catch_scope=none} -> + St; + #lint{catch_scope=try_catch} -> + St; + #lint{catch_scope=Scope} -> + case is_warn_enabled(get_stacktrace, St) of + false -> + St; + true -> + add_warning(Line, {get_stacktrace,Scope}, St) + end + end; +check_get_stacktrace(_, _, _, _, St) -> + St. + -dialyzer({no_match, deprecated_type/5}). deprecated_type(L, M, N, As, St) -> diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 6e8f780f7c..f2629a47c2 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -284,8 +284,9 @@ start(EscriptOptions) -> io:format("escript: ~s\n", [Str]), my_halt(127); _:Reason -> + Stk = erlang:get_stacktrace(), io:format("escript: Internal error: ~p\n", [Reason]), - io:format("~p\n", [erlang:get_stacktrace()]), + io:format("~p\n", [Stk]), my_halt(127) end. diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 597830cf9a..257c829801 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -26,7 +26,7 @@ %%% %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- --export([start/5, start/6, debug_options/2, +-export([start/5, start/6, debug_options/2, hibernate_after/1, name/1, unregister_name/1, get_proc_name/1, get_parent/0, call/3, call/4, reply/2, stop/1, stop/3]). @@ -408,6 +408,14 @@ spawn_opts(Options) -> [] end. +hibernate_after(Options) -> + case lists:keyfind(hibernate_after, 1, Options) of + {_,HibernateAfterTimeout} -> + HibernateAfterTimeout; + false -> + infinity + end. + debug_options(Name, Opts) -> case lists:keyfind(debug, 1, Opts) of {_,Options} -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 4c80464680..da2b0da3ca 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -37,7 +37,7 @@ stop/1, stop/3, notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, - swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). + swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/5]). -export([init_it/6, system_continue/3, @@ -186,8 +186,9 @@ init_it(Starter, Parent, Name0, _, _, Options) -> process_flag(trap_exit, true), Name = gen:name(Name0), Debug = gen:debug_options(Name, Options), + HibernateAfterTimeout = gen:hibernate_after(Options), proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, [], Debug, false). + loop(Parent, Name, [], HibernateAfterTimeout, Debug, false). -spec add_handler(emgr_ref(), handler(), term()) -> term(). add_handler(M, Handler, Args) -> rpc(M, {add_handler, Handler, Args}). @@ -264,81 +265,83 @@ send(M, Cmd) -> M ! Cmd, ok. -loop(Parent, ServerName, MSL, Debug, true) -> - proc_lib:hibernate(?MODULE, wake_hib, [Parent, ServerName, MSL, Debug]); -loop(Parent, ServerName, MSL, Debug, _) -> - fetch_msg(Parent, ServerName, MSL, Debug, false). +loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, true) -> + proc_lib:hibernate(?MODULE, wake_hib, [Parent, ServerName, MSL, HibernateAfterTimeout, Debug]); +loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, _) -> + fetch_msg(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, false). -wake_hib(Parent, ServerName, MSL, Debug) -> - fetch_msg(Parent, ServerName, MSL, Debug, true). +wake_hib(Parent, ServerName, MSL, HibernateAfterTimeout, Debug) -> + fetch_msg(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, true). -fetch_msg(Parent, ServerName, MSL, Debug, Hib) -> +fetch_msg(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, Hib) -> receive {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [ServerName, MSL, Hib],Hib); + [ServerName, MSL, HibernateAfterTimeout, Hib],Hib); {'EXIT', Parent, Reason} -> terminate_server(Reason, Parent, MSL, ServerName); Msg when Debug =:= [] -> - handle_msg(Msg, Parent, ServerName, MSL, []); + handle_msg(Msg, Parent, ServerName, MSL, HibernateAfterTimeout, []); Msg -> Debug1 = sys:handle_debug(Debug, fun print_event/3, ServerName, {in, Msg}), - handle_msg(Msg, Parent, ServerName, MSL, Debug1) + handle_msg(Msg, Parent, ServerName, MSL, HibernateAfterTimeout, Debug1) + after HibernateAfterTimeout -> + loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, true) end. -handle_msg(Msg, Parent, ServerName, MSL, Debug) -> +handle_msg(Msg, Parent, ServerName, MSL, HibernateAfterTimeout, Debug) -> case Msg of {notify, Event} -> {Hib,MSL1} = server_notify(Event, handle_event, MSL, ServerName), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {_From, Tag, {sync_notify, Event}} -> {Hib, MSL1} = server_notify(Event, handle_event, MSL, ServerName), reply(Tag, ok), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {'EXIT', From, Reason} -> MSL1 = handle_exit(From, Reason, MSL, ServerName), - loop(Parent, ServerName, MSL1, Debug, false); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, false); {_From, Tag, {call, Handler, Query}} -> {Hib, Reply, MSL1} = server_call(Handler, Query, MSL, ServerName), reply(Tag, Reply), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {_From, Tag, {add_handler, Handler, Args}} -> {Hib, Reply, MSL1} = server_add_handler(Handler, Args, MSL), reply(Tag, Reply), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {_From, Tag, {add_sup_handler, Handler, Args, SupP}} -> {Hib, Reply, MSL1} = server_add_sup_handler(Handler, Args, MSL, SupP), reply(Tag, Reply), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {_From, Tag, {delete_handler, Handler, Args}} -> {Reply, MSL1} = server_delete_handler(Handler, Args, MSL, ServerName), reply(Tag, Reply), - loop(Parent, ServerName, MSL1, Debug, false); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, false); {_From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} -> {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, ServerName), reply(Tag, Reply), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {_From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2, Sup}} -> {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, ServerName), reply(Tag, Reply), - loop(Parent, ServerName, MSL1, Debug, Hib); + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib); {_From, Tag, stop} -> catch terminate_server(normal, Parent, MSL, ServerName), reply(Tag, ok); {_From, Tag, which_handlers} -> reply(Tag, the_handlers(MSL)), - loop(Parent, ServerName, MSL, Debug, false); + loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, false); {_From, Tag, get_modules} -> reply(Tag, get_modules(MSL)), - loop(Parent, ServerName, MSL, Debug, false); + loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, false); Other -> {Hib, MSL1} = server_notify(Other, handle_info, MSL, ServerName), - loop(Parent, ServerName, MSL1, Debug, Hib) + loop(Parent, ServerName, MSL1, HibernateAfterTimeout, Debug, Hib) end. terminate_server(Reason, Parent, MSL, ServerName) -> @@ -392,18 +395,18 @@ terminate_supervised(Pid, Reason, MSL, SName) -> %%----------------------------------------------------------------- %% Callback functions for system messages handling. %%----------------------------------------------------------------- -system_continue(Parent, Debug, [ServerName, MSL, Hib]) -> - loop(Parent, ServerName, MSL, Debug, Hib). +system_continue(Parent, Debug, [ServerName, MSL, HibernateAfterTimeout, Hib]) -> + loop(Parent, ServerName, MSL, HibernateAfterTimeout, Debug, Hib). -spec system_terminate(_, _, _, [_]) -> no_return(). -system_terminate(Reason, Parent, _Debug, [ServerName, MSL, _Hib]) -> +system_terminate(Reason, Parent, _Debug, [ServerName, MSL, _HibernateAfterTimeout, _Hib]) -> terminate_server(Reason, Parent, MSL, ServerName). %%----------------------------------------------------------------- %% Module here is sent in the system msg change_code. It specifies %% which module should be changed. %%----------------------------------------------------------------- -system_code_change([ServerName, MSL, Hib], Module, OldVsn, Extra) -> +system_code_change([ServerName, MSL, HibernateAfterTimeout, Hib], Module, OldVsn, Extra) -> MSL1 = lists:zf(fun(H) when H#handler.module =:= Module -> {ok, NewState} = Module:code_change(OldVsn, @@ -412,12 +415,12 @@ system_code_change([ServerName, MSL, Hib], Module, OldVsn, Extra) -> (_) -> true end, MSL), - {ok, [ServerName, MSL1, Hib]}. + {ok, [ServerName, MSL1, HibernateAfterTimeout, Hib]}. -system_get_state([_ServerName, MSL, _Hib]) -> +system_get_state([_ServerName, MSL, _HibernateAfterTimeout, _Hib]) -> {ok, [{Mod,Id,State} || #handler{module=Mod, id=Id, state=State} <- MSL]}. -system_replace_state(StateFun, [ServerName, MSL, Hib]) -> +system_replace_state(StateFun, [ServerName, MSL, HibernateAfterTimeout, Hib]) -> {NMSL, NStates} = lists:unzip([begin Cur = {Mod,Id,State}, @@ -429,7 +432,7 @@ system_replace_state(StateFun, [ServerName, MSL, Hib]) -> {HS, Cur} end end || #handler{module=Mod, id=Id, state=State}=HS <- MSL]), - {ok, NStates, [ServerName, NMSL, Hib]}. + {ok, NStates, [ServerName, NMSL, HibernateAfterTimeout, Hib]}. %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees @@ -798,7 +801,7 @@ get_modules(MSL) -> %% Status information %%----------------------------------------------------------------- format_status(Opt, StatusData) -> - [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, + [PDict, SysState, Parent, _Debug, [ServerName, MSL, _HibernateAfterTimeout, _Hib]] = StatusData, Header = gen:format_status_header("Status for event handler", ServerName), FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index f9d4286a7c..9ef0ca818c 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -113,7 +113,7 @@ sync_send_all_state_event/2, sync_send_all_state_event/3, reply/2, start_timer/2,send_event_after/2,cancel_timer/1, - enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/6]). + enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/7]). %% Internal exports -export([init_it/6, @@ -329,7 +329,8 @@ enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> Name = gen:get_proc_name(ServerName), Parent = gen:get_parent(), Debug = gen:debug_options(Name, Options), - loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug). + HibernateAfterTimeout = gen:hibernate_after(Options), + loop(Parent, Name, StateName, StateData, Mod, Timeout, HibernateAfterTimeout, Debug). %%% --------------------------------------------------- %%% Initiate the new process. @@ -343,13 +344,14 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, Parent, Name0, Mod, Args, Options) -> Name = gen:name(Name0), Debug = gen:debug_options(Name, Options), - case catch Mod:init(Args) of + HibernateAfterTimeout = gen:hibernate_after(Options), + case catch Mod:init(Args) of {ok, StateName, StateData} -> proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, StateName, StateData, Mod, infinity, Debug); + loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, Debug); {ok, StateName, StateData, Timeout} -> proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug); + loop(Parent, Name, StateName, StateData, Mod, Timeout, HibernateAfterTimeout, Debug); {stop, Reason} -> gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), @@ -371,68 +373,77 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> %%----------------------------------------------------------------- %% The MAIN loop %%----------------------------------------------------------------- -loop(Parent, Name, StateName, StateData, Mod, hibernate, Debug) -> +loop(Parent, Name, StateName, StateData, Mod, hibernate, HibernateAfterTimeout, Debug) -> proc_lib:hibernate(?MODULE,wake_hib, - [Parent, Name, StateName, StateData, Mod, + [Parent, Name, StateName, StateData, Mod, HibernateAfterTimeout, Debug]); -loop(Parent, Name, StateName, StateData, Mod, Time, Debug) -> + +loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, Debug) -> + receive + Msg -> + decode_msg(Msg,Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, Debug, false) + after HibernateAfterTimeout -> + loop(Parent, Name, StateName, StateData, Mod, hibernate, HibernateAfterTimeout, Debug) + end; + +loop(Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug) -> Msg = receive Input -> Input after Time -> {'$gen_event', timeout} end, - decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, false). + decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug, false). -wake_hib(Parent, Name, StateName, StateData, Mod, Debug) -> +wake_hib(Parent, Name, StateName, StateData, Mod, HibernateAfterTimeout, Debug) -> Msg = receive Input -> Input end, - decode_msg(Msg, Parent, Name, StateName, StateData, Mod, hibernate, Debug, true). + decode_msg(Msg, Parent, Name, StateName, StateData, Mod, hibernate, HibernateAfterTimeout, Debug, true). -decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Hib) -> +decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug, Hib) -> case Msg of {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [Name, StateName, StateData, Mod, Time], Hib); + [Name, StateName, StateData, Mod, Time, HibernateAfterTimeout], Hib); {'EXIT', Parent, Reason} -> terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug); _Msg when Debug =:= [] -> - handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time); + handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout); _Msg -> Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, StateName}, {in, Msg}), handle_msg(Msg, Parent, Name, StateName, StateData, - Mod, Time, Debug1) + Mod, Time, HibernateAfterTimeout, Debug1) end. %%----------------------------------------------------------------- %% Callback functions for system messages handling. %%----------------------------------------------------------------- -system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time]) -> - loop(Parent, Name, StateName, StateData, Mod, Time, Debug). +system_continue(Parent, Debug, [Name, StateName, StateData, Mod, Time, HibernateAfterTimeout]) -> + loop(Parent, Name, StateName, StateData, Mod, Time, HibernateAfterTimeout, Debug). -spec system_terminate(term(), _, _, [term(),...]) -> no_return(). system_terminate(Reason, _Parent, Debug, - [Name, StateName, StateData, Mod, _Time]) -> + [Name, StateName, StateData, Mod, _Time, _HibernateAfterTimeout]) -> terminate(Reason, Name, [], Mod, StateName, StateData, Debug). -system_code_change([Name, StateName, StateData, Mod, Time], +system_code_change([Name, StateName, StateData, Mod, Time, HibernateAfterTimeout], _Module, OldVsn, Extra) -> case catch Mod:code_change(OldVsn, StateName, StateData, Extra) of {ok, NewStateName, NewStateData} -> - {ok, [Name, NewStateName, NewStateData, Mod, Time]}; + {ok, [Name, NewStateName, NewStateData, Mod, Time, HibernateAfterTimeout]}; Else -> Else end. -system_get_state([_Name, StateName, StateData, _Mod, _Time]) -> +system_get_state([_Name, StateName, StateData, _Mod, _Time, _HibernateAfterTimeout]) -> {ok, {StateName, StateData}}. -system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time]) -> +system_replace_state(StateFun, [Name, StateName, StateData, Mod, Time, HibernateAfterTimeout]) -> Result = {NStateName, NStateData} = StateFun({StateName, StateData}), - {ok, Result, [Name, NStateName, NStateData, Mod, Time]}. + {ok, Result, [Name, NStateName, NStateData, Mod, Time, HibernateAfterTimeout]}. %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees @@ -467,19 +478,19 @@ print_event(Dev, return, {Name, StateName}) -> io:format(Dev, "*DBG* ~p switched to state ~w~n", [Name, StateName]). -handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time) -> %No debug here +handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTimeout) -> %No debug here From = from(Msg), case catch dispatch(Msg, Mod, StateName, StateData) of {next_state, NStateName, NStateData} -> - loop(Parent, Name, NStateName, NStateData, Mod, infinity, []); + loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, []); {next_state, NStateName, NStateData, Time1} -> - loop(Parent, Name, NStateName, NStateData, Mod, Time1, []); + loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, []); {reply, Reply, NStateName, NStateData} when From =/= undefined -> reply(From, Reply), - loop(Parent, Name, NStateName, NStateData, Mod, infinity, []); + loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, []); {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined -> reply(From, Reply), - loop(Parent, Name, NStateName, NStateData, Mod, Time1, []); + loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, []); {stop, Reason, NStateData} -> terminate(Reason, Name, Msg, Mod, StateName, NStateData, []); {stop, Reason, Reply, NStateData} when From =/= undefined -> @@ -490,7 +501,7 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time) -> %No debug her {'EXIT', {undef, [{Mod, handle_info, [_,_,_], _}|_]}} -> error_logger:warning_msg("** Undefined handle_info in ~p~n" "** Unhandled message: ~p~n", [Mod, Msg]), - loop(Parent, Name, StateName, StateData, Mod, infinity, []); + loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []); {'EXIT', What} -> terminate(What, Name, Msg, Mod, StateName, StateData, []); Reply -> @@ -498,23 +509,23 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time) -> %No debug her Name, Msg, Mod, StateName, StateData, []) end. -handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug) -> +handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTimeout, Debug) -> From = from(Msg), case catch dispatch(Msg, Mod, StateName, StateData) of {next_state, NStateName, NStateData} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), - loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1); + loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, Debug1); {next_state, NStateName, NStateData, Time1} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), - loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1); + loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, Debug1); {reply, Reply, NStateName, NStateData} when From =/= undefined -> Debug1 = reply(Name, From, Reply, Debug, NStateName), - loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1); + loop(Parent, Name, NStateName, NStateData, Mod, infinity, HibernateAfterTimeout, Debug1); {reply, Reply, NStateName, NStateData, Time1} when From =/= undefined -> Debug1 = reply(Name, From, Reply, Debug, NStateName), - loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1); + loop(Parent, Name, NStateName, NStateData, Mod, Time1, HibernateAfterTimeout, Debug1); {stop, Reason, NStateData} -> terminate(Reason, Name, Msg, Mod, StateName, NStateData, Debug); {stop, Reason, Reply, NStateData} when From =/= undefined -> @@ -645,7 +656,7 @@ get_msg(Msg) -> Msg. %% Status information %%----------------------------------------------------------------- format_status(Opt, StatusData) -> - [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] = + [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time, _HibernateAfterTimeout]] = StatusData, Header = gen:format_status_header("Status for state machine", Name), diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index e628fec00f..ba0a7ae8e5 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -94,7 +94,7 @@ cast/2, reply/2, abcast/2, abcast/3, multi_call/2, multi_call/3, multi_call/4, - enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/5]). + enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/6]). %% System exports -export([system_continue/3, @@ -307,7 +307,8 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> Name = gen:get_proc_name(ServerName), Parent = gen:get_parent(), Debug = gen:debug_options(Name, Options), - loop(Parent, Name, State, Mod, Timeout, Debug). + HibernateAfterTimeout = gen:hibernate_after(Options), + loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug). %%%======================================================================== %%% Gen-callback functions @@ -325,13 +326,14 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, Parent, Name0, Mod, Args, Options) -> Name = gen:name(Name0), Debug = gen:debug_options(Name, Options), + HibernateAfterTimeout = gen:hibernate_after(Options), case catch Mod:init(Args) of {ok, State} -> proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, State, Mod, infinity, Debug); + loop(Parent, Name, State, Mod, infinity, HibernateAfterTimeout, Debug); {ok, State, Timeout} -> proc_lib:init_ack(Starter, {ok, self()}), - loop(Parent, Name, State, Mod, Timeout, Debug); + loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug); {stop, Reason} -> %% For consistency, we must make sure that the %% registered name (if any) is unregistered before @@ -362,37 +364,46 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> %%% --------------------------------------------------- %%% The MAIN loop. %%% --------------------------------------------------- -loop(Parent, Name, State, Mod, hibernate, Debug) -> - proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, Debug]); -loop(Parent, Name, State, Mod, Time, Debug) -> +loop(Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug) -> + proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, HibernateAfterTimeout, Debug]); + +loop(Parent, Name, State, Mod, infinity, HibernateAfterTimeout, Debug) -> + receive + Msg -> + decode_msg(Msg, Parent, Name, State, Mod, infinity, HibernateAfterTimeout, Debug, false) + after HibernateAfterTimeout -> + loop(Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug) + end; + +loop(Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug) -> Msg = receive Input -> Input after Time -> timeout end, - decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, false). + decode_msg(Msg, Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug, false). -wake_hib(Parent, Name, State, Mod, Debug) -> +wake_hib(Parent, Name, State, Mod, HibernateAfterTimeout, Debug) -> Msg = receive Input -> Input end, - decode_msg(Msg, Parent, Name, State, Mod, hibernate, Debug, true). + decode_msg(Msg, Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug, true). -decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> +decode_msg(Msg, Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug, Hib) -> case Msg of {system, From, Req} -> sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, - [Name, State, Mod, Time], Hib); + [Name, State, Mod, Time, HibernateAfterTimeout], Hib); {'EXIT', Parent, Reason} -> terminate(Reason, Name, undefined, Msg, Mod, State, Debug); _Msg when Debug =:= [] -> - handle_msg(Msg, Parent, Name, State, Mod); + handle_msg(Msg, Parent, Name, State, Mod, HibernateAfterTimeout); _Msg -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {in, Msg}), - handle_msg(Msg, Parent, Name, State, Mod, Debug1) + handle_msg(Msg, Parent, Name, State, Mod, HibernateAfterTimeout, Debug1) end. %%% --------------------------------------------------- @@ -659,65 +670,65 @@ try_terminate(Mod, Reason, State) -> %%% Message handling functions %%% --------------------------------------------------- -handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod) -> +handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, HibernateAfterTimeout) -> Result = try_handle_call(Mod, Msg, From, State), case Result of {ok, {reply, Reply, NState}} -> reply(From, Reply), - loop(Parent, Name, NState, Mod, infinity, []); + loop(Parent, Name, NState, Mod, infinity, HibernateAfterTimeout, []); {ok, {reply, Reply, NState, Time1}} -> reply(From, Reply), - loop(Parent, Name, NState, Mod, Time1, []); + loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, []); {ok, {noreply, NState}} -> - loop(Parent, Name, NState, Mod, infinity, []); + loop(Parent, Name, NState, Mod, infinity, HibernateAfterTimeout, []); {ok, {noreply, NState, Time1}} -> - loop(Parent, Name, NState, Mod, Time1, []); + loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, []); {ok, {stop, Reason, Reply, NState}} -> {'EXIT', R} = (catch terminate(Reason, Name, From, Msg, Mod, NState, [])), reply(From, Reply), exit(R); - Other -> handle_common_reply(Other, Parent, Name, From, Msg, Mod, State) + Other -> handle_common_reply(Other, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State) end; -handle_msg(Msg, Parent, Name, State, Mod) -> +handle_msg(Msg, Parent, Name, State, Mod, HibernateAfterTimeout) -> Reply = try_dispatch(Msg, Mod, State), - handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, State). + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, HibernateAfterTimeout, State). -handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> +handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, HibernateAfterTimeout, Debug) -> Result = try_handle_call(Mod, Msg, From, State), case Result of {ok, {reply, Reply, NState}} -> Debug1 = reply(Name, From, Reply, NState, Debug), - loop(Parent, Name, NState, Mod, infinity, Debug1); + loop(Parent, Name, NState, Mod, infinity, HibernateAfterTimeout, Debug1); {ok, {reply, Reply, NState, Time1}} -> Debug1 = reply(Name, From, Reply, NState, Debug), - loop(Parent, Name, NState, Mod, Time1, Debug1); + loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, Debug1); {ok, {noreply, NState}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), - loop(Parent, Name, NState, Mod, infinity, Debug1); + loop(Parent, Name, NState, Mod, infinity, HibernateAfterTimeout, Debug1); {ok, {noreply, NState, Time1}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), - loop(Parent, Name, NState, Mod, Time1, Debug1); + loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, Debug1); {ok, {stop, Reason, Reply, NState}} -> {'EXIT', R} = (catch terminate(Reason, Name, From, Msg, Mod, NState, Debug)), _ = reply(Name, From, Reply, NState, Debug), exit(R); Other -> - handle_common_reply(Other, Parent, Name, From, Msg, Mod, State, Debug) + handle_common_reply(Other, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State, Debug) end; -handle_msg(Msg, Parent, Name, State, Mod, Debug) -> +handle_msg(Msg, Parent, Name, State, Mod, HibernateAfterTimeout, Debug) -> Reply = try_dispatch(Msg, Mod, State), - handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, State, Debug). + handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, HibernateAfterTimeout, State, Debug). -handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State) -> +handle_common_reply(Reply, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State) -> case Reply of {ok, {noreply, NState}} -> - loop(Parent, Name, NState, Mod, infinity, []); + loop(Parent, Name, NState, Mod, infinity, HibernateAfterTimeout, []); {ok, {noreply, NState, Time1}} -> - loop(Parent, Name, NState, Mod, Time1, []); + loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, []); {ok, {stop, Reason, NState}} -> terminate(Reason, Name, From, Msg, Mod, NState, []); {'EXIT', ExitReason, ReportReason} -> @@ -726,16 +737,16 @@ handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State) -> terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, []) end. -handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State, Debug) -> +handle_common_reply(Reply, Parent, Name, From, Msg, Mod, HibernateAfterTimeout, State, Debug) -> case Reply of {ok, {noreply, NState}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), - loop(Parent, Name, NState, Mod, infinity, Debug1); + loop(Parent, Name, NState, Mod, infinity, HibernateAfterTimeout, Debug1); {ok, {noreply, NState, Time1}} -> Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), - loop(Parent, Name, NState, Mod, Time1, Debug1); + loop(Parent, Name, NState, Mod, Time1, HibernateAfterTimeout, Debug1); {ok, {stop, Reason, NState}} -> terminate(Reason, Name, From, Msg, Mod, NState, Debug); {'EXIT', ExitReason, ReportReason} -> @@ -753,26 +764,26 @@ reply(Name, {To, Tag}, Reply, State, Debug) -> %%----------------------------------------------------------------- %% Callback functions for system messages handling. %%----------------------------------------------------------------- -system_continue(Parent, Debug, [Name, State, Mod, Time]) -> - loop(Parent, Name, State, Mod, Time, Debug). +system_continue(Parent, Debug, [Name, State, Mod, Time, HibernateAfterTimeout]) -> + loop(Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug). -spec system_terminate(_, _, _, [_]) -> no_return(). -system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time]) -> +system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time, _HibernateAfterTimeout]) -> terminate(Reason, Name, undefined, [], Mod, State, Debug). -system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> +system_code_change([Name, State, Mod, Time, HibernateAfterTimeout], _Module, OldVsn, Extra) -> case catch Mod:code_change(OldVsn, State, Extra) of - {ok, NewState} -> {ok, [Name, NewState, Mod, Time]}; + {ok, NewState} -> {ok, [Name, NewState, Mod, Time, HibernateAfterTimeout]}; Else -> Else end. -system_get_state([_Name, State, _Mod, _Time]) -> +system_get_state([_Name, State, _Mod, _Time, _HibernateAfterTimeout]) -> {ok, State}. -system_replace_state(StateFun, [Name, State, Mod, Time]) -> +system_replace_state(StateFun, [Name, State, Mod, Time, HibernateAfterTimeout]) -> NState = StateFun(State), - {ok, NState, [Name, NState, Mod, Time]}. + {ok, NState, [Name, NState, Mod, Time, HibernateAfterTimeout]}. %%----------------------------------------------------------------- %% Format debug messages. Print them as the call-back module sees @@ -802,10 +813,10 @@ print_event(Dev, Event, Name) -> %%% Terminate the server. %%% --------------------------------------------------- + -spec terminate(_, _, _, _, _, _, _) -> no_return(). terminate(Reason, Name, From, Msg, Mod, State, Debug) -> terminate(Reason, Reason, Name, From, Msg, Mod, State, Debug). - -spec terminate(_, _, _, _, _, _, _, _) -> no_return(). terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug) -> Reply = try_terminate(Mod, ExitReason, State), @@ -851,7 +862,7 @@ error_info(Reason, Name, From, Msg, State, Debug) -> end; _ -> Reason - end, + end, {ClientFmt, ClientArgs} = client_stacktrace(From), format("** Generic server ~p terminating \n" "** Last message in was ~p~n" @@ -860,7 +871,6 @@ error_info(Reason, Name, From, Msg, State, Debug) -> [Name, Msg, State, Reason1] ++ ClientArgs), sys:print_log(Debug), ok. - client_stacktrace(undefined) -> {"", []}; client_stacktrace({From, _Tag}) -> @@ -885,7 +895,7 @@ client_stacktrace(From) when is_pid(From) -> %% Status information %%----------------------------------------------------------------- format_status(Opt, StatusData) -> - [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, + [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time, _HibernateAfterTimeout]] = StatusData, Header = gen:format_status_header("Status for generic server", Name), Log = sys:get_debug(log, Debug, []), Specfic = case format_status(Opt, Mod, PDict, State) of diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 6f566b8beb..86109f04b4 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -369,9 +369,12 @@ event_type(Type) -> Dbgs :: ['trace' | 'log' | 'statistics' | 'debug' | {'logfile', string()}]}. +-type hibernate_after_opt() :: + {'hibernate_after', HibernateAfterTimeout :: timeout()}. -type start_opt() :: debug_opt() | {'timeout', Time :: timeout()} + | hibernate_after_opt() | {'spawn_opt', [proc_lib:spawn_option()]}. -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. @@ -544,14 +547,14 @@ reply({To,Tag}, Reply) when is_pid(To) -> %% started by proc_lib into a state machine using %% the same arguments as you would have returned from init/1 -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()], State :: state(), Data :: data()) -> no_return(). enter_loop(Module, Opts, State, Data) -> enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()], State :: state(), Data :: data(), Server_or_Actions :: server_name() | pid() | [action()]) -> @@ -565,7 +568,7 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) -> end. %% -spec enter_loop( - Module :: module(), Opts :: [debug_opt()], + Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()], State :: state(), Data :: data(), Server :: server_name() | pid(), Actions :: [action()] | action()) -> @@ -605,7 +608,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - Events = [], + HibernateAfterTimeout = gen:hibernate_after(Opts), + Events = [], P = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that @@ -648,6 +652,7 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> timer_refs => TimerRefs, timer_types => TimerTypes, hibernate => Hibernate, + hibernate_after => HibernateAfterTimeout, cancel_timers => CancelTimers }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), @@ -854,7 +859,7 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, S) -> +loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> receive Msg -> case Msg of @@ -956,6 +961,9 @@ loop_receive(Parent, Debug, S) -> loop_receive_result( Parent, Debug, S, Hibernate, Event) end + after + HibernateAfterTimeout -> + loop_hibernate(Parent, Debug, S) end. loop_receive_result( diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 363705b0f4..2219467a8d 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -264,12 +264,12 @@ exit_p(Class, Reason, Stacktrace) -> case get('$initial_call') of {M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> MFA = {M,F,make_dummy_args(A, [])}, - crash_report(Class, Reason, MFA), + crash_report(Class, Reason, MFA, Stacktrace), erlang:raise(exit, exit_reason(Class, Reason, Stacktrace), Stacktrace); _ -> %% The process dictionary has been cleared or %% possibly modified. - crash_report(Class, Reason, []), + crash_report(Class, Reason, [], Stacktrace), erlang:raise(exit, exit_reason(Class, Reason, Stacktrace), Stacktrace) end. @@ -499,24 +499,25 @@ trans_init(M, F, A) when is_atom(M), is_atom(F) -> %% Generate a crash report. %% ----------------------------------------------------- -crash_report(exit, normal, _) -> ok; -crash_report(exit, shutdown, _) -> ok; -crash_report(exit, {shutdown,_}, _) -> ok; -crash_report(Class, Reason, StartF) -> - OwnReport = my_info(Class, Reason, StartF), +crash_report(exit, normal, _, _) -> ok; +crash_report(exit, shutdown, _, _) -> ok; +crash_report(exit, {shutdown,_}, _, _) -> ok; +crash_report(Class, Reason, StartF, Stacktrace) -> + OwnReport = my_info(Class, Reason, StartF, Stacktrace), LinkReport = linked_info(self()), Rep = [OwnReport,LinkReport], error_logger:error_report(crash_report, Rep). -my_info(Class, Reason, []) -> - my_info_1(Class, Reason); -my_info(Class, Reason, StartF) -> - [{initial_call, StartF}|my_info_1(Class, Reason)]. +my_info(Class, Reason, [], Stacktrace) -> + my_info_1(Class, Reason, Stacktrace); +my_info(Class, Reason, StartF, Stacktrace) -> + [{initial_call, StartF}| + my_info_1(Class, Reason, Stacktrace)]. -my_info_1(Class, Reason) -> +my_info_1(Class, Reason, Stacktrace) -> [{pid, self()}, get_process_info(self(), registered_name), - {error_info, {Class,Reason,erlang:get_stacktrace()}}, + {error_info, {Class,Reason,Stacktrace}}, get_ancestors(self()), get_process_info(self(), messages), get_process_info(self(), links), diff --git a/lib/stdlib/test/dummy_h.erl b/lib/stdlib/test/dummy_h.erl index 45ccfee240..7a9eb11f98 100644 --- a/lib/stdlib/test/dummy_h.erl +++ b/lib/stdlib/test/dummy_h.erl @@ -43,6 +43,9 @@ handle_event(hibernate, _State) -> {ok,[],hibernate}; handle_event(wakeup, _State) -> {ok,[]}; +handle_event({From, handle_event}, _State) -> + From ! handled_event, + {ok,[]}; handle_event(Event, Parent) -> Parent ! {dummy_h, Event}, {ok, Parent}. @@ -75,6 +78,9 @@ handle_info(wake, _State) -> {ok, []}; handle_info(gnurf, _State) -> {ok, []}; +handle_info({From, handle_info}, _State) -> + From ! handled_info, + {ok, []}; handle_info(Info, Parent) -> Parent ! {dummy_h, Info}, {ok, Parent}. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 03cad2c093..02524679fa 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -65,7 +65,8 @@ maps/1,maps_type/1,maps_parallel_match/1, otp_11851/1,otp_11879/1,otp_13230/1, record_errors/1, otp_11879_cont/1, - non_latin1_module/1, otp_14323/1]). + non_latin1_module/1, otp_14323/1, + get_stacktrace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -85,7 +86,8 @@ all() -> too_many_arguments, basic_errors, bin_syntax_errors, predef, maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, - record_errors, otp_11879_cont, non_latin1_module, otp_14323]. + record_errors, otp_11879_cont, non_latin1_module, otp_14323, + get_stacktrace]. groups() -> [{unused_vars_warn, [], @@ -3980,6 +3982,63 @@ otp_14323(Config) -> [] = run(Config, Ts), ok. +get_stacktrace(Config) -> + Ts = [{old_catch, + <<"t1() -> + catch error(foo), + erlang:get_stacktrace(). + ">>, + [], + {warnings,[{3,erl_lint,{get_stacktrace,after_old_catch}}]}}, + {nowarn_get_stacktrace, + <<"t1() -> + catch error(foo), + erlang:get_stacktrace(). + ">>, + [nowarn_get_stacktrace], + []}, + {try_catch, + <<"t1(X) -> + try abs(X) of + _ -> + erlang:get_stacktrace() + catch + _:_ -> ok + end. + + t2() -> + try error(foo) + catch _:_ -> ok + end, + erlang:get_stacktrace(). + + t3() -> + try error(foo) + catch _:_ -> + try error(bar) + catch _:_ -> + ok + end, + erlang:get_stacktrace() + end. + + no_warning(X) -> + try + abs(X) + catch + _:_ -> + erlang:get_stacktrace() + end. + ">>, + [], + {warnings,[{4,erl_lint,{get_stacktrace,wrong_part_of_try}}, + {13,erl_lint,{get_stacktrace,after_try}}, + {22,erl_lint,{get_stacktrace,after_try}}]}}], + + run(Config, Ts), + ok. + + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 749920f843..880b10117c 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -26,7 +26,7 @@ end_per_testcase/2]). -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, - notify/1, sync_notify/1, call/1, info/1, hibernate/1, + notify/1, sync_notify/1, call/1, info/1, hibernate/1, auto_hibernate/1, call_format_status/1, call_format_status_anon/1, error_format_status/1, get_state/1, replace_state/1, start_opt/1, @@ -37,7 +37,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start, {group, test_all}, hibernate, + [start, {group, test_all}, hibernate, auto_hibernate, call_format_status, call_format_status_anon, error_format_status, get_state, replace_state, start_opt, {group, undef_callbacks}, undef_in_terminate]. @@ -306,6 +306,48 @@ hibernate(Config) when is_list(Config) -> ok. +auto_hibernate(Config) when is_list(Config) -> + HibernateAfterTimeout = 100, + State = {auto_hibernate_state}, + {ok,Pid} = gen_event:start({local, auto_hibernate_handler}, [{hibernate_after, HibernateAfterTimeout}]), + %% After init test + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + ok = gen_event:add_handler(auto_hibernate_handler, dummy_h, [State]), + %% Get state test + [{dummy_h,false,State}] = sys:get_state(Pid), + is_in_erlang_hibernate(Pid), + %% Call test + {ok, hejhopp} = gen_event:call(auto_hibernate_handler, dummy_h, hejsan), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Event test + ok = gen_event:notify(auto_hibernate_handler, {self(), handle_event}), + receive + handled_event -> + ok + after 1000 -> + ct:fail(event) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Info test + Pid ! {self(), handle_info}, + receive + handled_info -> + ok + after 1000 -> + ct:fail(info) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + ok = gen_event:stop(auto_hibernate_handler), + ok. + is_in_erlang_hibernate(Pid) -> receive after 1 -> ok end, is_in_erlang_hibernate_1(200, Pid). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 7f98526d35..86cf58566b 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -44,7 +44,7 @@ -export([undef_in_handle_info/1, undef_in_terminate/1]). --export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). +-export([hibernate/1,auto_hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). -export([enter_loop/1]). @@ -68,7 +68,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, start}, {group, abnormal}, shutdown, - {group, sys}, hibernate, enter_loop, {group, undef_callbacks}, + {group, sys}, hibernate, auto_hibernate, enter_loop, {group, undef_callbacks}, undef_in_handle_info, undef_in_terminate]. groups() -> @@ -700,6 +700,43 @@ hibernate(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +%% Auto hibernation +auto_hibernate(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + HibernateAfterTimeout = 100, + State = {auto_hibernate_state}, + {ok, Pid} = gen_fsm:start_link({local, my_test_name_auto_hibernate}, ?MODULE, {state_data, State}, [{hibernate_after, HibernateAfterTimeout}]), + %% After init test + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Get state test + {_, State} = sys:get_state(my_test_name_auto_hibernate), + is_in_erlang_hibernate(Pid), + %% Sync send event test + 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Send event test + ok = gen_fsm:send_all_state_event(Pid,{'alive?', self()}), + wfor(yes), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Info test + Pid ! {self(), handle_info}, + wfor({Pid, handled_info}), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + stop_it(Pid), + receive + {'EXIT',Pid,normal} -> ok + end, + process_flag(trap_exit, OldFl), + ok. + is_in_erlang_hibernate(Pid) -> receive after 1 -> ok end, is_in_erlang_hibernate_1(200, Pid). @@ -1151,6 +1188,8 @@ idle(badreturn, _From, _Data) -> idle({timeout,Time}, From, _Data) -> gen_fsm:send_event_after(Time, {timeout,Time}), {next_state, timeout, From}; +idle('alive?', _From, Data) -> + {reply, 'alive!', idle, Data}; idle(_, _From, Data) -> {reply, 'eh?', idle, Data}. @@ -1226,6 +1265,9 @@ handle_info(hibernate_later, _SName, _State) -> handle_info({call_undef_fun, {Mod, Fun}}, State, Data) -> Mod:Fun(), {next_state, State, Data}; +handle_info({From, handle_info}, SName, State) -> + From ! {self(), handled_info}, + {next_state, SName, State}; handle_info(Info, _State, Data) -> {stop, {unexpected,Info}, Data}. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 6f72034b09..7e3c71715e 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -32,7 +32,7 @@ call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1, spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, - otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, + otp_5854/1, hibernate/1, auto_hibernate/1, otp_7669/1, call_format_status/1, error_format_status/1, terminate_crash_format/1, get_state/1, replace_state/1, call_with_huge_message_queue/1, undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1, @@ -65,7 +65,7 @@ all() -> call_remote3, call_remote_n1, call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, - spec_init_global_registered_parent, otp_5854, hibernate, + spec_init_global_registered_parent, otp_5854, hibernate, auto_hibernate, otp_7669, call_format_status, error_format_status, terminate_crash_format, get_state, replace_state, @@ -730,6 +730,58 @@ hibernate(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +auto_hibernate(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + HibernateAfterTimeout = 100, + State = {auto_hibernate_state}, + {ok, Pid} = + gen_server:start_link({local, my_test_name_auto_hibernate}, + gen_server_SUITE, {state,State}, [{hibernate_after, HibernateAfterTimeout}]), + %% After init test + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Get state test + State = sys:get_state(my_test_name_auto_hibernate), + is_in_erlang_hibernate(Pid), + %% Call test + ok = gen_server:call(my_test_name_auto_hibernate, started_p), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Cast test + ok = gen_server:cast(my_test_name_auto_hibernate, {self(),handle_cast}), + receive + {Pid, handled_cast} -> + ok + after 1000 -> + ct:fail(cast) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Info test + Pid ! {self(),handle_info}, + receive + {Pid, handled_info} -> + ok + after 1000 -> + ct:fail(info) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + + ok = gen_server:call(my_test_name_auto_hibernate, stop), + receive + {'EXIT', Pid, stopped} -> + ok + after 5000 -> + ct:fail(gen_server_did_not_die) + end, + process_flag(trap_exit, OldFl), + ok. + is_in_erlang_hibernate(Pid) -> receive after 1 -> ok end, is_in_erlang_hibernate_1(200, Pid). @@ -747,6 +799,23 @@ is_in_erlang_hibernate_1(N, Pid) -> is_in_erlang_hibernate_1(N-1, Pid) end. +is_not_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_not_in_erlang_hibernate_1(200, Pid). + +is_not_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ct:fail(not_in_erlang_hibernate_3); +is_not_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + receive after 10 -> ok end, + is_not_in_erlang_hibernate_1(N-1, Pid); + _ -> + ok + end. + %% -------------------------------------- %% Test gen_server:abcast and handle_cast. %% Test all different return values from diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 05934b3953..5b9daecfd3 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -40,7 +40,7 @@ all() -> shutdown, stop_and_reply, state_enter, event_order, state_timeout, event_types, generic_timers, code_change, {group, sys}, - hibernate, enter_loop, {group, undef_callbacks}, + hibernate, auto_hibernate, enter_loop, {group, undef_callbacks}, undef_in_terminate]. groups() -> @@ -1284,6 +1284,84 @@ hibernate(Config) -> end, ok = verify_empty_msgq(). +%% Auto-hibernation timeout +auto_hibernate(Config) -> + OldFl = process_flag(trap_exit, true), + HibernateAfterTimeout = 100, + + {ok,Pid} = + gen_statem:start_link( + ?MODULE, start_arg(Config, []), [{hibernate_after, HibernateAfterTimeout}]), + %% After init test + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% After info test + Pid ! {hping, self()}, + receive + {Pid, hpong} -> + ok + after 1000 -> + ct:fail(info) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% After cast test + ok = gen_statem:cast(Pid, {hping, self()}), + receive + {Pid, hpong} -> + ok + after 1000 -> + ct:fail(cast) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% After call test + hpong = gen_statem:call(Pid, hping), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Timer test 1 + TimerTimeout1 = 50, + ok = gen_statem:call(Pid, {arm_htimer, self(), TimerTimeout1}), + is_not_in_erlang_hibernate(Pid), + timer:sleep(TimerTimeout1), + is_not_in_erlang_hibernate(Pid), + receive + {Pid, htimer_armed} -> + ok + after 1000 -> + ct:fail(timer1) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + %% Timer test 2 + TimerTimeout2 = 150, + ok = gen_statem:call(Pid, {arm_htimer, self(), TimerTimeout2}), + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + receive + {Pid, htimer_armed} -> + ok + after 1000 -> + ct:fail(timer2) + end, + is_not_in_erlang_hibernate(Pid), + timer:sleep(HibernateAfterTimeout), + is_in_erlang_hibernate(Pid), + stop_it(Pid), + process_flag(trap_exit, OldFl), + receive + {'EXIT',Pid,normal} -> ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + ok = verify_empty_msgq(). + is_in_erlang_hibernate(Pid) -> receive after 1 -> ok end, is_in_erlang_hibernate_1(200, Pid). @@ -1704,6 +1782,19 @@ terminate(_Reason, _State, _Data) -> %% State functions +idle(info, {hping,Pid}, _Data) -> + Pid ! {self(), hpong}, + keep_state_and_data; +idle(cast, {hping,Pid}, Data) -> + Pid ! {self(), hpong}, + {keep_state, Data}; +idle({call, From}, hping, _Data) -> + {keep_state_and_data, [{reply, From, hpong}]}; +idle({call, From}, {arm_htimer, Pid, Timeout}, _Data) -> + {keep_state_and_data, [{reply, From, ok}, {timeout, Timeout, {arm_htimer, Pid}}]}; +idle(timeout, {arm_htimer, Pid}, _Data) -> + Pid ! {self(), htimer_armed}, + keep_state_and_data; idle(cast, {connect,Pid}, Data) -> Pid ! accept, {next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index 9c8ce148e9..6e66a957ab 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -38,7 +38,7 @@ <modulesummary>A runtime system Lock Profiling tool.</modulesummary> <description> <p>The <c>lcnt</c> module is used to profile the internal ethread locks in the - Erlang Runtime System. With <c>lcnt</c> enabled, Internal counters in the + Erlang Runtime System. With <c>lcnt</c> enabled, internal counters in the runtime system are updated each time a lock is taken. The counters stores information about the number of acquisition tries and the number of collisions that has occurred during the acquisition tries. The counters also record the @@ -47,17 +47,17 @@ <p> The data produced by the lock counters will give an estimate on how well the runtime system will behave from a parallelizable view point for the - scenarios tested. This tool was mainly developed to help erlang runtime + scenarios tested. This tool was mainly developed to help Erlang runtime developers iron out potential and generic bottlenecks. </p> <p>Locks in the emulator are named after what type of resource they protect and where in the emulator they are initialized, those are lock 'classes'. Most of those locks are also instantiated several times, and given unique identifiers, to increase locking granularity. Typically an instantiated lock protects a disjunct set of - the resource, i.e ets-tables, processes or ports. In other cases it protects a - specific range of a resource, e.g. <c>pix_lock</c> which protects index to process + the resource, for example ets tables, processes or ports. In other cases it protects a + specific range of a resource, for example <c>pix_lock</c> which protects index to process mappings, and is given a unique number within the class. A unique lock in <c>lcnt</c> - is referenced by a name (class) and an identifier, <c>{Name, Id}</c>. + is referenced by a name (class) and an identifier: <c>{Name, Id}</c>. </p> <p>Some locks in the system are static and protects global resources, for example <c>bif_timers</c> and the <c>run_queue</c> locks. Other locks are dynamic and not diff --git a/lib/tools/doc/src/lcnt_chapter.xml b/lib/tools/doc/src/lcnt_chapter.xml index 6cfdb5cf1b..1981d66117 100644 --- a/lib/tools/doc/src/lcnt_chapter.xml +++ b/lib/tools/doc/src/lcnt_chapter.xml @@ -42,42 +42,32 @@ completed its access to the resource and unlocked it. The <c>lcnt</c> tool measures these lock conflicts. </p> <p> - Locks has an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it + Locks have an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it some times necessary to use finer grained locking strategies. This will usually also increase the locking overhead and hence there is a tradeoff between lock contention and overhead. In general, lock contention increases with the number of threads running concurrently. The <c>lcnt</c> tool does not measure locking overhead. </p> <section> <title> Enabling lock-counting </title> - <p>For investigation of locks in the emulator we use an internal tool called <c>lcnt</c> (short for lock-count). The VM needs to be compiled with this option enabled. To enable this, use:</p> + <p>For investigation of locks in the emulator we use an internal tool called <c>lcnt</c> (short for lock-count). The VM needs to be compiled with this option enabled. + To compile a lock-counting VM along with a normal VM, use:</p> <pre> cd $ERL_TOP -./configure --enable-lock-counter - </pre> - - <p> - Another way to enable this alongside a normal VM is to compile it at emulator directory level, much like a debug build. To compile it this way do the following, - </p> - <pre> -cd $ERL_TOP/erts/emulator -make lcnt FLAVOR=smp - </pre> - <p> and then starting Erlang with,</p> +./configure --enable-lock-counter</pre> + <p>Start the lock-counting VM like this:</p> <pre> -$ERL_TOP/bin/cerl -lcnt - </pre> - <p>To verify that you lock-counting enabled check that <c>[lock-counting]</c> appears in the status text when the VM is started.</p> +$ERL_TOP/bin/erl -emu_type lcnt</pre> + <p>To verify that lock counting is enabled check that <c>[lock-counting]</c> appears in the status text when the VM is started.</p> <pre> -Erlang R13B03 (erts-5.7.4) [source] [64-bit] [smp:8:8] [rq:8] [async-threads:0] [hipe] - [kernel-poll:false] [lock-counting] - </pre> +Erlang/OTP 20 [erts-9.0] [64-bit] [smp:8:8] [ds:8:8:10] [async-threads:10] [hipe] + [kernel-poll:false] [lock-counting]</pre> </section> <section> <title>Getting started</title> <p>Once you have a lock counting enabled VM the module <c>lcnt</c> can be used. The module is intended to be used from the current running nodes shell. To access remote nodes use <c>lcnt:clear(Node)</c> and <c>lcnt:collect(Node)</c>. </p> <p>All locks are continuously monitored and its statistics updated. Use <c>lcnt:clear/0</c> to initially clear all counters before running any specific tests. This command will also reset the duration timer internally.</p> - <p>To retrieve lock statistics information use, <c>lcnt:collect/0,1</c>. The collect operation will start a <c>lcnt</c> server if it not already started. All collected data will be built into an erlang term and uploaded to the server and a duration time will also be uploaded. This duration is the time between <c>lcnt:clear/0,1</c> and <c>lcnt:collect/0,1</c>.</p> + <p>To retrieve lock statistics information, use <c>lcnt:collect/0,1</c>. The collect operation will start a <c>lcnt</c> server if it not already started. All collected data will be built into an Erlang term and uploaded to the server and a duration time will also be uploaded. This duration is the time between <c>lcnt:clear/0,1</c> and <c>lcnt:collect/0,1</c>.</p> <p>Once the data is collected to the server it can be filtered, sorted and printed in many different ways.</p> <p>See the <seealso marker="lcnt">reference manual</seealso> for a description of each function.</p> diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index d39a5deeab..2e48b11740 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -29,7 +29,8 @@ -export([t_load/1, t_conflicts/1, t_locations/1, - t_swap_keys/1]). + t_swap_keys/1, + smoke_lcnt/1]). init_per_testcase(_Case, Config) -> Config. @@ -43,7 +44,8 @@ suite() -> {timetrap,{minutes,4}}]. all() -> - [t_load, t_conflicts, t_locations, t_swap_keys]. + [t_load, t_conflicts, t_locations, t_swap_keys, + smoke_lcnt]. %%---------------------------------------------------------------------- %% Tests @@ -146,3 +148,82 @@ t_swap_keys_file([File|Files]) -> ok = lcnt:conflicts(), ok = lcnt:stop(), t_swap_keys_file(Files). + +%% Simple smoke test of actual lock-counting, if running on +%% a run-time with lock-counting enabled. + +smoke_lcnt(Config) -> + case erlang:system_info(build_type) of + lcnt -> + do_smoke_lcnt(Config); + _ -> + {skip,"Lock counting is not enabled"} + end. + +do_smoke_lcnt(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + SaveFile = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)), + {Time,ok} = timer:tc(fun() -> lcnt:apply(fun() -> big_bang(200) end) end), + io:format("~p ms\n", [Time]), + ok = lcnt:conflicts(), + ok = lcnt:save(SaveFile), + ok = lcnt:load(SaveFile), + ok = lcnt:conflicts(), + lcnt:stop(). + + +%%% +%%% A slightly modified version of Rickard Green's Big Bang benchmark. +%%% + +big_bang(N) when is_integer(N) -> + Procs = spawn_procs(N), + RMsgs = lists:map(fun (P) -> {done, P} end, Procs), + send_procs(Procs, {procs, Procs, self()}), + receive_msgs(RMsgs), + lists:foreach(fun (P) -> exit(P, normal) end, Procs). + +pinger([], [], true) -> + receive + {procs, Procs, ReportTo} -> + pinger(Procs, [], ReportTo) + end; +pinger([], [], false) -> + receive {ping, From} -> From ! {pong, self()} end, + pinger([],[],false); +pinger([], [], ReportTo) -> + ReportTo ! {done, self()}, + pinger([],[],false); +pinger([],[Po|Pos] = Pongers, ReportTo) -> + receive + {ping, From} -> + From ! {pong, self()}, + pinger([], Pongers, ReportTo); + {pong, Po} -> + pinger([], Pos, ReportTo) + end; +pinger([Pi|Pis], Pongers, ReportTo) -> + receive {ping, From} -> From ! {pong, self()} + after 0 -> ok + end, + Pi ! {ping, self()}, + pinger(Pis, [Pi|Pongers], ReportTo). + +spawn_procs(N) when N =< 0 -> + []; +spawn_procs(N) -> + [spawn_link(fun () -> pinger([], [], true) end) | spawn_procs(N-1)]. + +send_procs([], Msg) -> + Msg; +send_procs([P|Ps], Msg) -> + P ! Msg, + send_procs(Ps, Msg). + +receive_msgs([]) -> + ok; +receive_msgs([M|Ms]) -> + receive + M -> + receive_msgs(Ms) + end. diff --git a/lib/wx/c_src/egl_impl.h b/lib/wx/c_src/egl_impl.h index 719b4926db..7ecd484de5 100644 --- a/lib/wx/c_src/egl_impl.h +++ b/lib/wx/c_src/egl_impl.h @@ -112,7 +112,7 @@ typedef long int int32_t; typedef long long int int64_t; typedef unsigned long long int uint64_t; #elif defined(WIN32) && defined(_MSC_VER) -typedef long int int32_t; +typedef __int32 int32_t; typedef __int64 int64_t; typedef unsigned __int64 uint64_t; #elif defined(WIN32) && defined(__GNUC__) diff --git a/make/otp.mk.in b/make/otp.mk.in index cd4572d81b..83bab7065d 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -49,6 +49,7 @@ DEFAULT_TARGETS = opt debug release release_docs clean docs DEFAULT_FLAVOR=@DEFAULT_FLAVOR@ FLAVORS=@FLAVORS@ +TYPES=@TYPES@ # Slash separated list of return values from $(origin VAR) # that are untrusted - set default in this file instead. diff --git a/make/otp_subdir.mk b/make/otp_subdir.mk index fa6470ddd7..5734970298 100644 --- a/make/otp_subdir.mk +++ b/make/otp_subdir.mk @@ -19,13 +19,13 @@ # # Make include file for otp -.PHONY: debug opt release docs release_docs tests release_tests \ +.PHONY: debug opt lcnt release docs release_docs tests release_tests \ clean depend valgrind static_lib # # Targets that don't affect documentation directories # -opt debug release docs release_docs tests release_tests clean depend valgrind static_lib: +opt debug lcnt release docs release_docs tests release_tests clean depend valgrind static_lib: @set -e ; \ app_pwd=`pwd` ; \ if test -f vsn.mk; then \ diff --git a/system/doc/programming_examples/bit_syntax.xml b/system/doc/programming_examples/bit_syntax.xml index 0af295b7b7..98ad2808cf 100644 --- a/system/doc/programming_examples/bit_syntax.xml +++ b/system/doc/programming_examples/bit_syntax.xml @@ -32,6 +32,8 @@ <section> <title>Introduction</title> + <p>The complete specification for the bit syntax appears in the + <seealso marker="doc/reference_manual:expressions#bit_syntax">Reference Manual</seealso>.</p> <p>In Erlang, a Bin is used for constructing binaries and matching binary patterns. A Bin is written with the following syntax:</p> <code type="none"><![CDATA[ @@ -45,7 +47,7 @@ Bin = <<E1, E2, ... En>>]]></code> <<E1, E2, ... En>> = Bin ]]></code> <p>Here, <c>Bin</c> is bound and the elements are bound or unbound, as in any match.</p> - <p>Since Erlang R12B, a Bin does not need to consist of a whole number of bytes.</p> + <p>A Bin does not need to consist of a whole number of bytes.</p> <p>A <em>bitstring</em> is a sequence of zero or more bits, where the number of bits does not need to be divisible by 8. If the number @@ -165,8 +167,9 @@ end.]]></code> separated by hyphens.</p> <taglist> <tag>Type</tag> - <item>The type can be <c>integer</c>, <c>float</c>, or - <c>binary</c>.</item> + <item>The most commonly used types are <c>integer</c>, <c>float</c>, and <c>binary</c>. + See <seealso marker="doc/reference_manual:expressions#bit_syntax">Bit Syntax Expressions in the Reference Manual</seealso> for a complete description. +</item> <tag>Signedness</tag> <item>The signedness specification can be either <c>signed</c> or <c>unsigned</c>. Notice that signedness only matters for @@ -181,7 +184,7 @@ end.]]></code> <item>The unit size is given as <c>unit:IntegerLiteral</c>. The allowed range is 1-256. It is multiplied by the <c>Size</c> specifier to give the effective size of - the segment. Since Erlang R12B, the unit size specifies the alignment + the segment. The unit size specifies the alignment for binary segments without size.</item> </taglist> <p><em>Example:</em></p> @@ -319,21 +322,15 @@ foo(<<A:8,Rest/bitstring>>) ->]]></code> <section> <title>Appending to a Binary</title> - <p>Since Erlang R12B, the following function for creating a binary out of - a list of triples of integers is efficient:</p> + <p>Appending to a binary in an efficient way can be done as follows:</p> <code type="none"><![CDATA[ triples_to_bin(T) -> triples_to_bin(T, <<>>). triples_to_bin([{X,Y,Z} | T], Acc) -> - triples_to_bin(T, <<Acc/binary,X:32,Y:32,Z:32>>); % inefficient before R12B + triples_to_bin(T, <<Acc/binary,X:32,Y:32,Z:32>>); triples_to_bin([], Acc) -> Acc.]]></code> - <p>In previous releases, this function was highly inefficient, because - the binary constructed so far (<c>Acc</c>) was copied in each recursion step. - That is no longer the case. For more information, see - <seealso marker="doc/efficiency_guide:introduction"> - Efficiency Guide</seealso>.</p> </section> </chapter> |