diff options
172 files changed, 6072 insertions, 4650 deletions
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index e13470c83c..c499fc8081 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -632,6 +632,15 @@ <p>Sets the initial process dictionary size of processes to the size <c><![CDATA[Size]]></c>.</p> </item> + <tag><marker id="+hmqd"><c>+hmqd off_heap|on_heap|mixed</c></marker></tag> + <item><p> + Sets the default value for the process flag + <c>message_queue_data</c>. If <c>+hmqd</c> is not + passed, <c>mixed</c> will be the default. For more information, + see the documentation of + <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data, + MQD)</c></seealso>. + </p></item> <tag><c><![CDATA[+K true | false]]></c></tag> <item> <p>Enables or disables the kernel poll functionality if @@ -1361,21 +1370,6 @@ <seealso marker="kernel:error_logger#warning_map/0">error_logger(3)</seealso> for further information.</p> </item> - <tag><c><![CDATA[+xFlag Value]]></c></tag> - <item> - <p>Default process flag settings.</p> - <taglist> - <tag><marker id="+xmqd"><c>+xmqd off_heap|on_heap|mixed</c></marker></tag> - <item><p> - Sets the default value for the process flag - <c>message_queue_data</c>. If <c>+xmqd</c> is not - passed, <c>mixed</c> will be the default. For more information, - see the documentation of - <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data, - MQD)</c></seealso>. - </p></item> - </taglist> - </item> <tag><c><![CDATA[+zFlag Value]]></c></tag> <item> <p>Miscellaneous flags.</p> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 423ccdf98f..3276bc34b0 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4371,7 +4371,7 @@ os_prompt% </pre> </taglist> <p> The default <c>message_queue_data</c> process flag is determined - by the <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso> + by the <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso> <c>erl</c> command line argument. </p> <p> @@ -4702,7 +4702,7 @@ os_prompt% </pre> detailed information about garbage collection for this process. The content of <c><anno>GCInfo</anno></c> can be changed without prior notice. - See <seealso marker="#gc_start">gc_start</seealso> in + See <seealso marker="#gc_minor_start">gc_minor_start</seealso> in <seealso marker="#trace/3">erlang:trace/3</seealso> for details about what each item means. </p> @@ -4878,7 +4878,9 @@ os_prompt% </pre> <tag><c>{total_heap_size, <anno>Size</anno>}</c></tag> <item> <p><c><anno>Size</anno></c> is the total size, in words, of all heap - fragments of the process. This includes the process stack.</p> + fragments of the process. This includes the process stack and + any unreceived messages that are considered to be part of the + heap. </p> </item> <tag><c>{trace, <anno>InternalTraceFlags</anno>}</c></tag> <item> @@ -5709,7 +5711,7 @@ true</pre> flag. <c><anno>MQD</anno></c> should be either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>. The default <c>message_queue_data</c> process flag is determined by the - <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso> <c>erl</c> + <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso> <c>erl</c> command line argument. For more information, see the documentation of <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, @@ -7388,7 +7390,7 @@ ok <p>Returns the default value of the <c>message_queue_data</c> process flag which is either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>. This default is set by the <c>erl</c> command line argument - <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso>. For more information on the + <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso>. For more information on the <c>message_queue_data</c> process flag, see documentation of <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, MQD)</c></seealso>.</p> @@ -7966,7 +7968,7 @@ ok <c>stack_size</c>, <c>mbuf_size</c>, <c>old_heap_size</c>, and <c>old_heap_block_size</c>. These tuples are explained in the description of trace message - <seealso marker="#gc_start">gc_start</seealso> (see + <seealso marker="#gc_minor_start">gc_minor_start</seealso> (see <seealso marker="#trace/3">erlang:trace/3</seealso>). New tuples can be added, and the order of the tuples in the <c>Info</c> list can be changed at any time without @@ -8556,7 +8558,7 @@ timestamp() -> <tag><c>garbage_collection</c></tag> <item> <p>Traces garbage collections of processes.</p> - <p>Message tags: <c><seealso marker="#trace_3_trace_messages_gc_start">gc_start</seealso></c> and <c><seealso marker="#trace_3_trace_messages_gc_end">gc_end</seealso></c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_gc_minor_start">gc_minor_start</seealso></c> and <c><seealso marker="#trace_3_trace_messages_gc_minor_end">gc_minor_end</seealso></c>.</p> </item> <tag><c>timestamp</c></tag> <item> @@ -8637,8 +8639,8 @@ timestamp() -> <p>Specifies that a tracer module should be called instead of sending a trace message. The tracer module can then ignore or change the trace message. For more details - on how to write a tracer module see <seealso marker="erl_tracer"> - erl_tracer</seealso> + on how to write a tracer module see + <seealso marker="erts:erl_tracer"><c>erl_tracer</c></seealso> </p> </item> </taglist> @@ -8880,12 +8882,12 @@ timestamp() -> </p> </item> <tag> - <marker id="trace_3_trace_messages_gc_start"></marker> - <c>{trace, Pid, gc_start, Info}</c> + <marker id="trace_3_trace_messages_gc_minor_start"></marker> + <c>{trace, Pid, gc_minor_start, Info}</c> </tag> <item> - <marker id="gc_start"></marker> - <p>Sent when garbage collection is about to be started. + <marker id="gc_minor_start"></marker> + <p>Sent when a young garbage collection is about to be started. <c>Info</c> is a list of two-element tuples, where the first element is a key, and the second is the value. Do not depend on any order of the tuples. @@ -8925,15 +8927,32 @@ timestamp() -> <p>All sizes are in words.</p> </item> <tag> - <marker id="trace_3_trace_messages_gc_end"></marker> - <c>{trace, Pid, gc_end, Info}</c> + <marker id="trace_3_trace_messages_gc_minor_end"></marker> + <c>{trace, Pid, gc_minor_end, Info}</c> </tag> <item> - <p>Sent when garbage collection is finished. <c>Info</c> - contains the same kind of list as in message <c>gc_start</c>, + <p>Sent when young garbage collection is finished. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c>, but the sizes reflect the new sizes after garbage collection.</p> </item> + <tag> + <marker id="trace_3_trace_messages_gc_major_start"></marker> + <c>{trace, Pid, gc_major_start, Info}</c> + </tag> + <item> + <p>Sent when fullsweep garbage collection is about to be started. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c>.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_gc_major_end"></marker> + <c>{trace, Pid, gc_major_end, Info}</c> + </tag> + <item> + <p>Sent when fullsweep garbage collection is finished. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c> + but the sizes reflect the new sizes after a fullsweep garbage collection.</p> + </item> </taglist> <p>If the tracing process/port dies or the tracer module returns <c>remove</c>, the flags are silently removed.</p> @@ -8989,7 +9008,7 @@ timestamp() -> <c>erlang:trace_delivered(<anno>Tracee</anno>)</c> resides on. The special <c><anno>Tracee</anno></c> atom <c>all</c> denotes all processes that currently are traced in the node.</p> - <p>When used together with an <seealso marker="#erl_tracer"> + <p>When used together with an <seealso marker="erts:erl_tracer"> Tracer Module</seealso> any message sent in the trace callback is guaranteed to have reached it's recipient before the <c>trace_delivered</c> message is sent.</p> diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index b6f5d66166..40d44dda4c 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -38,7 +38,7 @@ #include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); -static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp); +static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls); static void delete_code(Module* modp); static void decrement_refc(BeamCodeHeader*); static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); @@ -467,7 +467,7 @@ check_old_code_1(BIF_ALIST_1) } Eterm -erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp) +erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls) { Module* modp; Eterm res; @@ -483,7 +483,7 @@ erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp) return am_false; erts_rlock_old_code(code_ix); res = (!modp->old.code_hdr ? am_false : - check_process_code(c_p, modp, flags, redsp)); + check_process_code(c_p, modp, flags, redsp, fcalls)); erts_runlock_old_code(code_ix); return res; @@ -506,7 +506,7 @@ BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) goto badarg; } - res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds); + res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds, BIF_P->fcalls); ASSERT(is_value(res)); @@ -764,7 +764,7 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) static Eterm -check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) +check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls) { BeamInstr* start; char* literals; @@ -966,7 +966,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity); + *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls); done_gc |= ERTS_ORDINARY_GC__; } if (need_gc & ERTS_LITERAL_GC__) { diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index bb171be8a6..08641b86d6 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -173,19 +173,7 @@ void erts_clear_time_trace_bif(BeamInstr *pc); BeamInstr *erts_find_local_func(Eterm mfa[3]); -ERTS_GLB_INLINE Uint erts_bp_sched2ix(void); - #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE Uint erts_bp_sched2ix(void) -{ -#ifdef ERTS_SMP - ErtsSchedulerData *esdp; - esdp = erts_get_scheduler_data(); - return esdp->no - 1; -#else - return 0; -#endif -} extern erts_smp_atomic32_t erts_active_bp_index; extern erts_smp_atomic32_t erts_staging_bp_index; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 72526bca5e..59112e1e43 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -308,7 +308,8 @@ void** beam_ops; if (E - HTOP < (needed + (HeapNeed))) { \ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), reg, (M)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), \ + reg, (M), FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -360,7 +361,7 @@ void** beam_ops; if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -381,7 +382,7 @@ void** beam_ops; if (E - HTOP < need) { \ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live));\ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -402,7 +403,7 @@ void** beam_ops; SWAPOUT; \ reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1, FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ Extra = reg[Live]; \ @@ -1196,6 +1197,25 @@ init_emulator(void) #define DTRACE_NIF_RETURN(p, m, f, a) do {} while (0) #endif /* USE_VM_PROBES */ +#ifdef DEBUG +#define ERTS_DBG_CHK_REDS(P, FC) \ + do { \ + if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \ + ASSERT(FC <= 0); \ + ASSERT(ERTS_PROC_GET_SCHDATA(c_p)->virtual_reds \ + <= 0 - (FC)); \ + } \ + else { \ + ASSERT(FC <= CONTEXT_REDS); \ + ASSERT(ERTS_PROC_GET_SCHDATA(c_p)->virtual_reds \ + <= CONTEXT_REDS - (FC)); \ + } \ +} while (0) +#else +#define ERTS_DBG_CHK_REDS(P, FC) +#endif + + /* * process_main() is called twice: * The first call performs some initialisation, including exporting @@ -1290,7 +1310,12 @@ void process_main(void) goto do_schedule1; do_schedule: - reds_used = REDS_IN(c_p) - FCALLS; + ASSERT(c_p->debug_reds_in == REDS_IN(c_p)); + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + reds_used = REDS_IN(c_p) - FCALLS; + else + reds_used = REDS_IN(c_p) - (CONTEXT_REDS + FCALLS); + ASSERT(reds_used >= 0); do_schedule1: if (start_time != 0) { @@ -1310,6 +1335,7 @@ void process_main(void) ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); + ASSERT(!(c_p->flags & F_HIPE_MODE)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); start_time = 0; #ifdef DEBUG @@ -1348,16 +1374,21 @@ void process_main(void) SET_I(c_p->i); - reds = c_p->fcalls; - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) - && (ERTS_TRACE_FLAGS(c_p) & F_SENSITIVE) == 0) { - neg_o_reds = -reds; - FCALLS = REDS_IN(c_p) = 0; + REDS_IN(c_p) = reds = c_p->fcalls; +#ifdef DEBUG + c_p->debug_reds_in = reds; +#endif + + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + neg_o_reds = -CONTEXT_REDS; + FCALLS = neg_o_reds + reds; } else { neg_o_reds = 0; - FCALLS = REDS_IN(c_p) = reds; + FCALLS = reds; } + ERTS_DBG_CHK_REDS(c_p, FCALLS); + next = (BeamInstr *) *I; SWAPIN; ASSERT(VALID_INSTR(next)); @@ -1770,7 +1801,7 @@ void process_main(void) if (E - HTOP < 3) { SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1); + FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -1865,6 +1896,7 @@ void process_main(void) c_p->flags |= F_DELAY_GC; loop_rec__: + PROCESS_MAIN_CHK_LOCKS(c_p); msgp = PEEK_MESSAGE(c_p); @@ -2007,6 +2039,8 @@ void process_main(void) ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); } + ERTS_DBG_CHK_REDS(c_p, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); NextPF(0, next); @@ -2535,6 +2569,7 @@ do { \ GetArg1(2, tmp_reg[0]); bf = (BifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2544,6 +2579,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(3, result); } @@ -2564,6 +2600,7 @@ do { \ GetArg1(1, tmp_reg[0]); bf = (BifFunction) Arg(0); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2573,6 +2610,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(2, result); } @@ -2591,6 +2629,7 @@ do { \ GetArg1(2, x(live)); bf = (GcBifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2602,6 +2641,7 @@ do { \ SWAPIN; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(4, result); } @@ -2630,6 +2670,7 @@ do { \ */ live++; bf = (GcBifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2641,6 +2682,7 @@ do { \ SWAPIN; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(5, result); } @@ -2671,6 +2713,7 @@ do { \ */ live += 2; bf = (GcBifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2682,6 +2725,7 @@ do { \ SWAPIN; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(5, result); } @@ -2708,6 +2752,7 @@ do { \ GetArg2(2, tmp_reg[0], tmp_reg[1]); bf = (BifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2717,6 +2762,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(4, result); } @@ -2775,6 +2821,7 @@ do { \ bf = GET_BIF_ADDRESS(Arg(0)); PRE_BIF_SWAPOUT(c_p); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS - 1; if (FCALLS <= 0) { save_calls(c_p, (Export *) Arg(0)); @@ -2796,6 +2843,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); /* We have to update the cache if we are enabled in order to make sure no book keeping is done after we disabled msacc. We don't always do this as it is quite expensive. */ @@ -3324,8 +3372,13 @@ do { \ * (beacuse the code for the Dispatch() macro becomes shorter that way). */ - reds_used = REDS_IN(c_p) - FCALLS + 1; - + ASSERT(c_p->debug_reds_in == REDS_IN(c_p)); + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + reds_used = REDS_IN(c_p) - FCALLS; + else + reds_used = REDS_IN(c_p) - (CONTEXT_REDS + FCALLS); + ASSERT(reds_used >= 0); + /* * Save the argument registers and everything else. */ @@ -3514,6 +3567,7 @@ do { \ DTRACE_BIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); SWAPOUT; + ERTS_DBG_CHK_REDS(c_p, FCALLS - 1); c_p->fcalls = FCALLS - 1; vbf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -3549,6 +3603,7 @@ do { \ } SWAPIN; /* There might have been a garbage collection. */ FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(nif_bif_result)) { r(0) = nif_bif_result; CHECK_TERM(r(0)); @@ -4611,9 +4666,9 @@ do { \ OpCase(i_generic_breakpoint): { BeamInstr real_I; ASSERT(I[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); - SWAPOUT; + HEAVY_SWAPOUT; real_I = erts_generic_breakpoint(c_p, I, reg); - SWAPIN; + HEAVY_SWAPIN; ASSERT(VALID_INSTR(real_I)); Goto(real_I); } @@ -4790,6 +4845,7 @@ do { \ { #define HIPE_MODE_SWITCH(Cmd) \ SWAPOUT; \ + ERTS_DBG_CHK_REDS(c_p, FCALLS); \ c_p->fcalls = FCALLS; \ c_p->def_arg_reg[4] = -neg_o_reds; \ c_p = hipe_mode_switch(c_p, Cmd, reg); \ @@ -4828,6 +4884,9 @@ do { \ #undef HIPE_MODE_SWITCH L_post_hipe_mode_switch: +#ifdef DEBUG + pid = c_p->common.id; /* may have switched process... */ +#endif reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; ERL_BITS_RELOAD_STATEP(c_p); @@ -4835,6 +4894,7 @@ do { \ neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; SWAPIN; + ERTS_DBG_CHK_REDS(c_p, FCALLS); switch( c_p->def_arg_reg[3] ) { case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); @@ -6839,7 +6899,7 @@ erts_current_reductions(Process *current, Process *p) if (current != p) { return 0; } else if (current->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(current)) { - return -current->fcalls; + return current->fcalls + CONTEXT_REDS; } else { return REDS_IN(current) - current->fcalls; } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index ed5b2983dd..9d6dfefa3c 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1569,7 +1569,32 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, scb->n = 0; } - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); +#ifdef HIPE + if (rp->flags & F_HIPE_MODE) { + ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(rp)); + scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(rp, scb); + } + else +#endif + { +#ifdef HIPE + ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(rp)); +#endif + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); + if (rp == BIF_P && ((scb && i == 0) || (!scb && i != 0))) { + /* Adjust fcalls to match save calls setting... */ + if (i == 0) + BIF_P->fcalls += CONTEXT_REDS; /* disabled it */ + else + BIF_P->fcalls -= CONTEXT_REDS; /* enabled it */ + + /* + * Make sure we reschedule immediately so the + * change take effect at once. + */ + ERTS_VBUMP_ALL_REDS(BIF_P); + } + } if (!scb) old_value = make_small(0); @@ -1578,12 +1603,7 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); } - /* Make sure the process in question is rescheduled - immediately, if it's us, so the call saving takes effect. */ - if (rp == BIF_P) - BIF_RET2(old_value, CONTEXT_REDS); - else - BIF_RET(old_value); + BIF_RET(old_value); } error: @@ -1736,7 +1756,9 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) ERTS_TRACE_FLAGS(BIF_P) &= ~F_SENSITIVE; } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); - BIF_RET(old_value); + /* make sure to bump all reds so that we get + rescheduled immediately so setting takes effect */ + BIF_RET2(old_value, CONTEXT_REDS); } else if (BIF_ARG_1 == am_monitor_nodes) { /* @@ -1775,10 +1797,18 @@ BIF_RETTYPE process_flag_3(BIF_ALIST_3) Process *rp; Eterm res; - if ((rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCK_MAIN)) == NULL) { +#ifdef ERTS_SMP + rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCK_MAIN); + if (rp == ERTS_PROC_LOCK_BUSY) + ERTS_BIF_YIELD3(bif_export[BIF_process_flag_3], BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +#else + rp = erts_proc_lookup(BIF_ARG_1); +#endif + + if (!rp) BIF_ERROR(BIF_P, BADARG); - } res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3); diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 546e3830b9..5d751dd67d 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -52,6 +52,7 @@ extern Export *erts_convert_time_unit_trap; (p)->fcalls = 0; \ else \ (p)->fcalls = -CONTEXT_REDS; \ + ASSERT(ERTS_BIF_REDS_LEFT((p)) == 0); \ } while(0) #define ERTS_VBUMP_ALL_REDS_INTERNAL(p, fcalls) \ diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 4f5e80f2e5..d02c6828f9 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -347,8 +347,11 @@ print_process_info(int to, void *to_arg, Process *p) static void print_garb_info(int to, void *to_arg, Process* p) { +#ifdef ERTS_SMP /* ERTS_SMP: A scheduler is probably concurrently doing gc... */ -#ifndef ERTS_SMP + if (!ERTS_IS_CRASH_DUMPING) + return; +#endif erts_print(to, to_arg, "New heap start: %bpX\n", p->heap); erts_print(to, to_arg, "New heap top: %bpX\n", p->htop); erts_print(to, to_arg, "Stack top: %bpX\n", p->stop); @@ -356,7 +359,6 @@ print_garb_info(int to, void *to_arg, Process* p) erts_print(to, to_arg, "Old heap start: %bpX\n", OLD_HEAP(p)); erts_print(to, to_arg, "Old heap top: %bpX\n", OLD_HTOP(p)); erts_print(to, to_arg, "Old heap end: %bpX\n", OLD_HEND(p)); -#endif } void diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 52fd57e101..277e0668a2 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1967,7 +1967,7 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (size > (Uint) INT_MAX) - erts_exit(ERTS_ABORT_EXIT, + erts_exit(ERTS_DUMP_EXIT, "Absurdly large distribution output data buffer " "(%beu bytes) passed.\n", size); @@ -2007,7 +2007,7 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (size > (Uint) INT_MAX) - erts_exit(ERTS_ABORT_EXIT, + erts_exit(ERTS_DUMP_EXIT, "Absurdly large distribution output data buffer " "(%beu bytes) passed.\n", size); diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index 4d6d699d9f..84254af0c2 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -283,10 +283,10 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) erts_thr_q_enqueue(&q->thr_q, a); #ifdef USE_LTTNG_VM_TRACEPOINTS - if (LTTNG_ENABLED(aio_pool_add)) { + if (LTTNG_ENABLED(aio_pool_put)) { lttng_decl_portbuf(port_str); lttng_portid_to_str(a->port, port_str); - LTTNG2(aio_pool_add, port_str, -1); + LTTNG2(aio_pool_put, port_str, -1); } #endif #ifdef USE_VM_PROBES diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index c9741b361f..99fe847ba2 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1359,9 +1359,10 @@ process_info_aux(Process *BIF_P, total_heap_size += rp->mbuf_sz; - for (mp = rp->msg.first; mp; mp = mp->next) - if (mp->data.attached) - total_heap_size += erts_msg_attached_data_size(mp); + if (rp->flags & F_ON_HEAP_MSGQ) + for (mp = rp->msg.first; mp; mp = mp->next) + if (mp->data.attached) + total_heap_size += erts_msg_attached_data_size(mp); (void) erts_bld_uint(NULL, &hsz, total_heap_size); hp = HAlloc(BIF_P, hsz); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index df5d0f4918..e21fba6bf1 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -116,7 +116,7 @@ static Eterm *full_sweep_heaps(Process *p, char *oh, Uint oh_size, Eterm *objv, int nobj); static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj); + int need, Eterm* objv, int nobj, int fcalls); static int major_collection(Process* p, ErlHeapFragment *live_hf_end, int need, Eterm* objv, int nobj, Uint *recl); static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, @@ -392,15 +392,15 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array; } #endif - cost = garbage_collect(p, live_hf_end, 0, regs, p->arity); + cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls); } else { - cost = garbage_collect(p, live_hf_end, 0, regs, arity); + cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls); } } else { Eterm val[1]; val[0] = result; - cost = garbage_collect(p, live_hf_end, 0, val, 1); + cost = garbage_collect(p, live_hf_end, 0, val, 1, p->fcalls); result = val[0]; } BUMP_REDS(p, cost); @@ -431,7 +431,7 @@ static ERTS_INLINE void reset_active_writer(Process *p) #define ERTS_ABANDON_HEAP_COST 10 static int -delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) +delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int fcalls) { ErlHeapFragment *hfrag; Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop; @@ -506,12 +506,16 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) /* Make sure that we do a proper GC as soon as possible... */ p->flags |= F_FORCE_GC; - reds_left = ERTS_BIF_REDS_LEFT(p); + reds_left = ERTS_REDS_LEFT(p, fcalls); + ASSERT(CONTEXT_REDS - reds_left >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + if (reds_left > ERTS_ABANDON_HEAP_COST) { int vreds = reds_left - ERTS_ABANDON_HEAP_COST; - ERTS_VBUMP_REDS(p, vreds); + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += vreds; } - return ERTS_ABANDON_HEAP_COST; + + ASSERT(CONTEXT_REDS >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + return reds_left; } static ERTS_FORCE_INLINE Uint @@ -570,7 +574,7 @@ young_gen_usage(Process *p) */ static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj) + int need, Eterm* objv, int nobj, int fcalls) { Uint reclaimed_now = 0; int reds; @@ -581,8 +585,11 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif + ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) + >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + if (p->flags & (F_DISABLE_GC|F_DELAY_GC)) - return delay_garbage_collection(p, live_hf_end, need); + return delay_garbage_collection(p, live_hf_end, need, fcalls); if (p->abandoned_heap) live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -703,16 +710,23 @@ do_major_collection: } int -erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj) +erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls) { - return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls); + int reds_left = ERTS_REDS_LEFT(p, fcalls); + if (reds > reds_left) + reds = reds_left; + ASSERT(CONTEXT_REDS - (reds_left - reds) >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + return reds; } void erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { - int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls); BUMP_REDS(p, reds); + ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p) + >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); } /* @@ -3009,10 +3023,30 @@ erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp) }; Eterm res = THE_NON_VALUE; + ErtsMessage *mp; ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags)); ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS); + if (p->abandoned_heap) { + Eterm *htop, *heap; + ERTS_GET_ORIG_HEAP(p, heap, htop); + values[3] = HIGH_WATER(p) - heap; + values[6] = htop - heap; + } + + if (p->flags & F_ON_HEAP_MSGQ) { + /* If on heap messages in the internal queue are counted + as being part of the heap, so we have to add them to the + am_mbuf_size value. process_info(total_heap_size) should + be the same as adding old_heap_block_size + heap_block_size + + mbuf_size. + */ + for (mp = p->msg.first; mp; mp = mp->next) + if (mp->data.attached) + values[2] += erts_msg_attached_data_size(mp); + } + res = erts_bld_atom_uword_2tup_list(hpp, sizep, sizeof(values)/sizeof(*values), diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 40b7c5d12c..8a6ff99990 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -139,7 +139,7 @@ Eterm erts_process_gc_info(struct process*, Uint *, Eterm **); void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); -int erts_garbage_collect_nobump(struct process*, int, Eterm*, int); +int erts_garbage_collect_nobump(struct process*, int, Eterm*, int, int); void erts_garbage_collect(struct process*, int, Eterm*, int); void erts_garbage_collect_hibernate(struct process* p); Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index dec9bdfedc..fcd2739ac3 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -206,15 +206,15 @@ int erts_no_line_info = 0; /* -L: Don't load line information */ ErtsModifiedTimings erts_modified_timings[] = { /* 0 */ {make_small(0), CONTEXT_REDS, INPUT_REDUCTIONS}, - /* 1 */ {make_small(0), 2*CONTEXT_REDS, 2*INPUT_REDUCTIONS}, + /* 1 */ {make_small(0), (3*CONTEXT_REDS)/4, 2*INPUT_REDUCTIONS}, /* 2 */ {make_small(0), CONTEXT_REDS/2, INPUT_REDUCTIONS/2}, - /* 3 */ {make_small(0), 3*CONTEXT_REDS, 3*INPUT_REDUCTIONS}, + /* 3 */ {make_small(0), (7*CONTEXT_REDS)/8, 3*INPUT_REDUCTIONS}, /* 4 */ {make_small(0), CONTEXT_REDS/3, 3*INPUT_REDUCTIONS}, - /* 5 */ {make_small(0), 4*CONTEXT_REDS, INPUT_REDUCTIONS/2}, + /* 5 */ {make_small(0), (10*CONTEXT_REDS)/11, INPUT_REDUCTIONS/2}, /* 6 */ {make_small(1), CONTEXT_REDS/4, 2*INPUT_REDUCTIONS}, - /* 7 */ {make_small(1), 5*CONTEXT_REDS, INPUT_REDUCTIONS/3}, + /* 7 */ {make_small(1), (5*CONTEXT_REDS)/7, INPUT_REDUCTIONS/3}, /* 8 */ {make_small(10), CONTEXT_REDS/5, 3*INPUT_REDUCTIONS}, - /* 9 */ {make_small(10), 6*CONTEXT_REDS, INPUT_REDUCTIONS/4} + /* 9 */ {make_small(10), (6*CONTEXT_REDS)/7, INPUT_REDUCTIONS/4} }; #define ERTS_MODIFIED_TIMING_LEVELS \ @@ -578,6 +578,8 @@ void erts_usage(void) VH_DEFAULT_SIZE); erts_fprintf(stderr, "-hpds size initial process dictionary size (default %d)\n", erts_pd_initial_size); + erts_fprintf(stderr, "-hmqd val set default message queue data flag for processes,\n"); + erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n"); /* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */ @@ -655,8 +657,6 @@ void erts_usage(void) erts_fprintf(stderr, "-W<i|w|e> set error logger warnings mapping,\n"); erts_fprintf(stderr, " see error_logger documentation for details\n"); - erts_fprintf(stderr, "-xmqd val set default message queue data flag for processes,\n"); - erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n"); erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n"); erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024); erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n"); @@ -1487,6 +1487,7 @@ erl_start(int argc, char **argv) * h|ms - min_heap_size * h|mbs - min_bin_vheap_size * h|pds - erts_pd_initial_size + * h|mqd - message_queue_data * */ if (has_prefix("mbs", sub_param)) { @@ -1512,6 +1513,23 @@ erl_start(int argc, char **argv) } VERBOSE(DEBUG_SYSTEM, ("using initial process dictionary size %d\n", erts_pd_initial_size)); + } else if (has_prefix("mqd", sub_param)) { + arg = get_arg(sub_param+3, argv[i+1], &i); + if (sys_strcmp(arg, "mixed") == 0) + erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ); + else if (sys_strcmp(arg, "on_heap") == 0) { + erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; + erts_default_spo_flags |= SPO_ON_HEAP_MSGQ; + } + else if (sys_strcmp(arg, "off_heap") == 0) { + erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ; + erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; + } + else { + erts_fprintf(stderr, + "Invalid message_queue_data flag: %s\n", arg); + erts_usage(); + } } else { /* backward compatibility */ arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -2047,32 +2065,6 @@ erl_start(int argc, char **argv) } break; - case 'x': { - char *sub_param = argv[i]+2; - if (has_prefix("mqd", sub_param)) { - arg = get_arg(sub_param+3, argv[i+1], &i); - if (sys_strcmp(arg, "mixed") == 0) - erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ); - else if (sys_strcmp(arg, "on_heap") == 0) { - erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; - erts_default_spo_flags |= SPO_ON_HEAP_MSGQ; - } - else if (sys_strcmp(arg, "off_heap") == 0) { - erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ; - erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; - } - else { - erts_fprintf(stderr, - "Invalid message_queue_data flag: %s\n", arg); - erts_usage(); - } - } else { - erts_fprintf(stderr, "bad -x option %s\n", argv[i]); - erts_usage(); - } - break; - } - case 'z': { char *sub_param = argv[i]+2; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d485affa3b..bc32f3f167 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -6688,10 +6688,8 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st) erts_aint32_t e; n = e = a; - if (a & ERTS_PSFLG_FREE) { - res = 0; + if (a & ERTS_PSFLG_FREE) goto cleanup; /* We don't want to schedule free processes... */ - } enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; @@ -9240,6 +9238,21 @@ erts_set_process_priority(Process *p, Eterm value) } } +static int +scheduler_gc_proc(Process *c_p, int reds_left) +{ + int fcalls, reds; + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + fcalls = reds_left; + else + fcalls = reds_left - CONTEXT_REDS; + reds = erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls); + ASSERT(reds_left >= reds); + return reds; +} + + + /* * schedule() is called from BEAM (process_main()) or HiPE * (hipe_mode_switch()) when the current process is to be @@ -9318,6 +9331,7 @@ Process *schedule(Process *p, int calls) #endif reds = actual_reds = calls - esdp->virtual_reds; + ASSERT(actual_reds >= 0); if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST; esdp->virtual_reds = 0; @@ -9740,7 +9754,7 @@ Process *schedule(Process *p, int calls) esdp->current_process = p; - + calls = 0; reds = context_reds; #ifdef ERTS_SMP @@ -9819,9 +9833,7 @@ Process *schedule(Process *p, int calls) /* Migrate to dirty scheduler... */ sunlock_sched_out_proc: erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - p->fcalls = reds; goto sched_out_proc; - } } else { @@ -9856,8 +9868,6 @@ Process *schedule(Process *p, int calls) #endif /* ERTS_SMP */ - p->fcalls = reds; - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); if (IS_TRACED(p)) { @@ -9890,14 +9900,15 @@ Process *schedule(Process *p, int calls) * not allowed to execute system tasks. */ if (!(p->flags & F_DELAY_GC)) { - reds -= execute_sys_tasks(p, &state, reds); + int cost = execute_sys_tasks(p, &state, reds); + calls += cost; + reds -= cost; if (reds <= 0 #ifdef ERTS_DIRTY_SCHEDULERS || ERTS_SCHEDULER_IS_DIRTY(esdp) || (state & ERTS_PSFLGS_DIRTY_WORK) #endif ) { - p->fcalls = reds; goto sched_out_proc; } } @@ -9910,8 +9921,9 @@ Process *schedule(Process *p, int calls) if (((state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) - && !(state & ERTS_PSFLG_EXITING)) + && !(state & ERTS_PSFLG_EXITING)) { goto sched_out_proc; + } n = e = state; n &= ~ERTS_PSFLG_RUNNING_SYS; @@ -9930,11 +9942,11 @@ Process *schedule(Process *p, int calls) if (ERTS_IS_GC_DESIRED(p)) { if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { - reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity); - if (reds <= 0) { - p->fcalls = reds; + int cost = scheduler_gc_proc(p, reds); + calls += cost; + reds -= cost; + if (reds <= 0) goto sched_out_proc; - } } } @@ -9942,6 +9954,8 @@ Process *schedule(Process *p, int calls) free_proxy_proc(proxy_p); proxy_p = NULL; } + + p->fcalls = reds; ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); @@ -10211,21 +10225,24 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) else { if (!garbage_collected) { FLAGS(c_p) |= F_NEED_FULLSWEEP; - reds -= erts_garbage_collect_nobump(c_p, - 0, - c_p->arg_reg, - c_p->arity); + reds -= scheduler_gc_proc(c_p, reds); garbage_collected = 1; } st_res = am_true; } break; case ERTS_PSTT_CPC: { + int fcalls; int cpc_reds = 0; + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + fcalls = reds; + else + fcalls = reds - CONTEXT_REDS; st_res = erts_check_process_code(c_p, st->arg[0], unsigned_val(st->arg[1]), - &cpc_reds); + &cpc_reds, + fcalls); reds -= cpc_reds; if (is_non_value(st_res)) { /* Needed gc, but gc was disabled */ @@ -10257,6 +10274,9 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) *statep = state; + if (in_reds < reds) + return in_reds; + return in_reds - reds; } @@ -11482,8 +11502,10 @@ delete_process(Process* p) psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); - if (psd) + if (psd) { + erts_smp_atomic_set_nob(&p->psd, (erts_aint_t) NULL); /* Reduction counting depends on this... */ erts_free(ERTS_ALC_T_PSD, psd); + } /* Clean binaries and funs */ erts_cleanup_offheap(&p->off_heap); @@ -12577,6 +12599,8 @@ erts_continue_exit_process(Process *p) dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL; scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + if (scb) + p->fcalls += CONTEXT_REDS; /* Reduction counting depends on this... */ pbt = ERTS_PROC_SET_CALL_TIME(p, NULL); nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 61acf5924b..59da9c1779 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -805,8 +805,15 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_CALL_TIME_BP 3 #define ERTS_PSD_DELAYED_GC_TASK_QS 4 #define ERTS_PSD_NIF_TRAP_EXPORT 5 +#ifdef HIPE +#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 6 +#endif +#ifdef HIPE +#define ERTS_PSD_SIZE 7 +#else #define ERTS_PSD_SIZE 6 +#endif typedef struct { void *data[ERTS_PSD_SIZE]; @@ -925,7 +932,6 @@ struct process { Eterm* stop; /* Stack top */ Eterm* heap; /* Heap start */ Eterm* hend; /* Heap end */ - Eterm* abandoned_heap; Uint heap_sz; /* Size of heap in words */ Uint min_heap_size; /* Minimum size of heap (in words). */ Uint min_vheap_size; /* Minimum size of virtual heap (in words). */ @@ -941,6 +947,16 @@ struct process { #endif /* + * Moved to after "struct hipe_process_state hipe", as a temporary fix for + * LLVM hard-coding offsetof(struct process, hipe.nstack) (sic!) + * (see void X86FrameLowering::adjustForHiPEPrologue(...) in + * lib/Target/X86/X86FrameLowering.cpp). + * + * Used to be below "Eterm* hend". + */ + Eterm* abandoned_heap; + + /* * Saved x registers. */ Uint arity; /* Number of live argument registers (only valid @@ -1071,6 +1087,10 @@ struct process { Uint space_verified; /* Avoid HAlloc forcing heap fragments when */ Eterm* space_verified_from; /* we rely on available heap space (TestHeap) */ #endif + +#ifdef DEBUG + Uint debug_reds_in; +#endif }; extern const Process erts_invalid_process; @@ -1342,6 +1362,7 @@ extern int erts_system_profile_ts_type; #define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */ #define F_SCHDLR_ONLN_WAITQ (1 << 17) /* Process enqueued waiting to change schedulers online */ #define F_HAVE_BLCKD_NMSCHED (1 << 18) /* Process has blocked normal multi-scheduling */ +#define F_HIPE_MODE (1 << 19) /* * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent @@ -1999,6 +2020,13 @@ erts_psd_set(Process *p, int ix, void *data) #define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \ erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) +#ifdef HIPE +#define ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(P) \ + ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF)) +#define ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(P, SCB) \ + ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF, (void *) (SCB))) +#endif + ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 56899f574a..436b4aca21 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -658,6 +658,7 @@ do { \ # define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0) #endif + static void write_sys_msg_to_port(Eterm unused_to, Port* trace_port, @@ -1321,16 +1322,18 @@ trace_proc_spawn(Process *p, Eterm what, Eterm pid, void save_calls(Process *p, Export *e) { - struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); - if (scb) { - Export **ct = &scb->ct[0]; - int len = scb->len; - - ct[scb->cur] = e; - if (++scb->cur >= len) - scb->cur = 0; - if (scb->n < len) - scb->n++; + if ((ERTS_TRACE_FLAGS(p) & F_SENSITIVE) == 0) { + struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (scb) { + Export **ct = &scb->ct[0]; + int len = scb->len; + + ct[scb->cur] = e; + if (++scb->cur >= len) + scb->cur = 0; + if (scb->n < len) + scb->n++; + } } } @@ -1737,41 +1740,6 @@ profile_scheduler(Eterm scheduler_id, Eterm state) { } -void -profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint Ms, Uint s, Uint us) { - Eterm *hp, msg, timestamp; - -#ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4 + 7) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; -#else - ErlHeapFragment *bp; - Uint hsz; - - hsz = 4 + 7; - - bp = new_message_buffer(hsz); - hp = bp->mem; -#endif - - erts_smp_mtx_lock(&smq_mtx); - - timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; - msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, no_schedulers, timestamp); hp += 7; -#ifndef ERTS_SMP - profile_send(NIL, msg); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#else - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); -#endif - erts_smp_mtx_unlock(&smq_mtx); - -} - /* Port profiling */ void @@ -1935,7 +1903,10 @@ trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...) } data = TUPLE2(hp, caller, data); - send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_RECEIVE, + hp += 3; + ASSERT(hp <= (local_heap + LOCAL_HEAP_SIZE) || orig_hp); + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, + TRACE_FUN_T_RECEIVE, am_receive, data, THE_NON_VALUE); if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h index 43ceeda671..12f68e477b 100644 --- a/erts/emulator/beam/erlang_lttng.h +++ b/erts/emulator/beam/erlang_lttng.h @@ -218,13 +218,13 @@ TRACEPOINT_EVENT( driver_stop, TP_ARGS( char*, pid, - char*, driver, - char*, port + char*, port, + char*, driver ), TP_FIELDS( ctf_string(pid, pid) - ctf_string(driver, driver) ctf_string(port, port) + ctf_string(driver, driver) ) ) @@ -324,7 +324,7 @@ TRACEPOINT_EVENT( TRACEPOINT_EVENT( com_ericsson_otp, - aio_pool_add, + aio_pool_put, TP_ARGS( char*, port, int, length diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index a7bc990deb..49eec44053 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -997,7 +997,7 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); #define ERTS_CPC_ALLOW_GC (1 << 0) #define ERTS_CPC_COPY_LITERALS (1 << 1) #define ERTS_CPC_ALL (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS) -Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp); +Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls); typedef struct { Eterm *ptr; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index b14ca77a04..5c2595c69d 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3861,7 +3861,7 @@ terminate_port(Port *prt) lttng_decl_procbuf(proc_str); lttng_pid_to_str(connected_id, proc_str); lttng_port_to_str(prt, port_str); - LTTNG3(driver_stop, proc_str, drv->name, port_str); + LTTNG3(driver_stop, proc_str, port_str, drv->name); } #endif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index b280995488..68006e7ef3 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -71,41 +71,6 @@ #define HAVE_MALLOPT 0 #endif -/* profile_scheduler mini message queue */ - -typedef struct { - Uint scheduler_id; - Uint no_schedulers; - Uint Ms; - Uint s; - Uint us; - Eterm state; -} profile_sched_msg; - -typedef struct { - profile_sched_msg msg[2]; - Uint n; -} profile_sched_msg_q; - -#ifdef ERTS_SMP - -#if 0 /* Unused */ -static void -dispatch_profile_msg_q(profile_sched_msg_q *psmq) -{ - int i = 0; - profile_sched_msg *msg = NULL; - ASSERT(psmq != NULL); - for (i = 0; i < psmq->n; i++) { - msg = &(psmq->msg[i]); - profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us); - } -} -#endif - -#endif - - Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra) { diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 43144e75ec..9ad44b25ac 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -218,15 +218,37 @@ static __inline__ void hipe_pop_beam_trap_frame(Process *p) Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) { unsigned result; -#if NR_ARG_REGS > 5 - /* When NR_ARG_REGS > 5, we need to protect the process' input - reduction count (which BEAM stores in def_arg_reg[5]) from - being clobbered by the arch glue code. */ Eterm reds_in = p->def_arg_reg[5]; -#endif -#if NR_ARG_REGS > 4 - Eterm o_reds = p->def_arg_reg[4]; -#endif + /* + * Process is in the normal case scheduled out when reduction + * count reach zero. When "save calls" is enabled reduction + * count is subtracted with CONTEXT_REDS, i.e. initial reduction + * count will be zero or less and process is scheduled out + * when -CONTEXT_REDS is reached. + * + * HiPE does not support the "save calls" feature, so we switch + * to using a positive reduction counter when executing in + * hipe mode, but need to restore the "save calls" when + * returning to beam. We also need to hide the save calls buffer + * from BIFs. We do that by moving the saved calls buf to + * suspended saved calls buf. + * + * Beam has initial reduction count in stored in p->def_arg_reg[5]. + * + * Beam expects -neg_o_reds to be found in p->def_arg_reg[4] + * on return to beam. + */ + + { + struct saved_calls *scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + if (scb) { + reds_in += CONTEXT_REDS; + p->fcalls += CONTEXT_REDS; + ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb); + } + } + + p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */ p->i = NULL; /* Set current_function to undefined. stdlib hibernate tests rely on it. */ @@ -481,12 +503,21 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); do_schedule: { -#if !(NR_ARG_REGS > 5) - int reds_in = p->def_arg_reg[5]; + struct saved_calls *scb; + + scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL); + if (scb) + ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb); + +#ifdef DEBUG + ASSERT(p->debug_reds_in == reds_in); #endif + p->flags &= ~F_HIPE_MODE; + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p); p = schedule(p, reds_in - p->fcalls); ERTS_SMP_REQ_PROC_MAIN_LOCK(p); + ASSERT(!(p->flags & F_HIPE_MODE)); #ifdef ERTS_SMP p->hipe_smp.have_receive_locks = 0; reg = p->scheduler_data->x_reg_array; @@ -501,28 +532,32 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) reg[i] = argp[i]; } { -#if !(NR_ARG_REGS > 5) - Eterm reds_in; -#endif -#if !(NR_ARG_REGS > 4) - Eterm o_reds; -#endif + struct saved_calls *scb; reds_in = p->fcalls; - o_reds = 0; - if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { - o_reds = reds_in; - reds_in = 0; - p->fcalls = 0; - } - p->def_arg_reg[4] = o_reds; p->def_arg_reg[5] = reds_in; +#ifdef DEBUG + p->debug_reds_in = reds_in; +#endif if (p->i == hipe_beam_pc_resume) { + p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */ + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + if (scb) + ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb); p->i = NULL; p->arity = 0; goto do_resume; } + + scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (!scb) + p->def_arg_reg[4] = 0; + else { + p->def_arg_reg[4] = CONTEXT_REDS; + p->fcalls = -CONTEXT_REDS + reds_in; + } } + HIPE_CHECK_PCB(p); result = HIPE_MODE_SWITCH_RES_CALL_BEAM; p->def_arg_reg[3] = result; @@ -562,14 +597,29 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) default: erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %#x\r\n", result); } + + { + struct saved_calls *scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL); + if (!scb) + p->def_arg_reg[4] = 0; + else { + p->def_arg_reg[4] = CONTEXT_REDS; + p->fcalls -= CONTEXT_REDS; + ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb); + } + } + HIPE_CHECK_PCB(p); p->def_arg_reg[3] = result; -#if NR_ARG_REGS > 4 - p->def_arg_reg[4] = o_reds; -#endif #if NR_ARG_REGS > 5 + /* + * When NR_ARG_REGS > 5, we need to protect the process' input + * reduction count (which BEAM stores in def_arg_reg[5]) from + * being clobbered by the arch glue code. + */ p->def_arg_reg[5] = reds_in; #endif + p->flags &= ~F_HIPE_MODE; return p; } diff --git a/erts/emulator/nifs/common/erl_tracer_nif.c b/erts/emulator/nifs/common/erl_tracer_nif.c index 1bb6b940c4..8a9a1bf16c 100644 --- a/erts/emulator/nifs/common/erl_tracer_nif.c +++ b/erts/emulator/nifs/common/erl_tracer_nif.c @@ -72,8 +72,6 @@ ERL_NIF_INIT(erl_tracer, nif_funcs, load, NULL, upgrade, unload) ATOM_DECL(trace); \ ATOM_DECL(trace_ts); \ ATOM_DECL(true); \ - ATOM_DECL(gc_start); \ - ATOM_DECL(gc_end); \ ATOM_DECL(gc_minor_start); \ ATOM_DECL(gc_minor_end); \ ATOM_DECL(gc_major_start); \ @@ -130,6 +128,9 @@ static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) if (!enif_is_port_alive(env, &to_port)) /* tracer is dead so we should remove this trace point */ return atom_remove; + } else { + /* The state was not a pid or a port */ + return atom_remove; } /* Only generate trace for when tracer != tracee */ diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl index d0f6292d5b..efc79f42ed 100644 --- a/erts/emulator/test/lttng_SUITE.erl +++ b/erts/emulator/test/lttng_SUITE.erl @@ -89,8 +89,8 @@ end_per_testcase(Case, _Config) -> %% com_ericsson_otp:carrier_pool_put %% com_ericsson_otp:carrier_destroy %% com_ericsson_otp:carrier_create -%% com_ericsson_otp:aio_pool_add -%% com_ericsson_otp:aio_pool_get +%% com_ericsson_otp:aio_pool_put +%% com_ericsson_otp:aio_pool_get %% com_ericsson_otp:driver_control %% com_ericsson_otp:driver_call %% com_ericsson_otp:driver_finish @@ -151,7 +151,7 @@ t_memory_carrier(Config) -> ok end. -%% com_ericsson_otp:aio_pool_add +%% com_ericsson_otp:aio_pool_put %% com_ericsson_otp:aio_pool_get t_async_io_pool(Config) -> case have_async_threads() of @@ -168,7 +168,7 @@ t_async_io_pool(Config) -> {ok, _} = file:list_dir(Path2), Res = lttng_stop_and_view(Config), - ok = check_tracepoint("com_ericsson_otp:aio_pool_add", Res), + ok = check_tracepoint("com_ericsson_otp:aio_pool_put", Res), ok = check_tracepoint("com_ericsson_otp:aio_pool_get", Res), ok end. @@ -416,7 +416,7 @@ txt() -> "%% com_ericsson_otp:carrier_pool_put\n" "%% com_ericsson_otp:carrier_destroy\n" "%% com_ericsson_otp:carrier_create\n" - "%% com_ericsson_otp:aio_pool_add\n" + "%% com_ericsson_otp:aio_pool_put\n" "%% com_ericsson_otp:aio_pool_get\n" "%% com_ericsson_otp:driver_control\n" "%% com_ericsson_otp:driver_call\n" diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index ea973276db..6733237b20 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -597,16 +597,15 @@ ms_trace3(Config) when is_list(Config) -> end), ok. -ms_trace_dead(doc) -> - ["Test that a dead tracer is removed using ms"]; -ms_trace_dead(suite) -> []; -ms_trace_dead(Config) when is_list(Config) -> +%% Test that a dead tracer is removed using ms +ms_trace_dead(_Config) -> Self = self(), TFun = fun F() -> receive M -> Self ! M, F() end end, {Tracer, MRef} = spawn_monitor(TFun), MetaTracer = spawn_link(TFun), erlang:trace_pattern({?MODULE, f1, '_'}, - [{'_',[],[{trace,[], + [{'_',[],[{message, false}, + {trace,[], [call,{const,{tracer,Tracer}}]}]}], [{meta, MetaTracer}]), erlang:trace_pattern({?MODULE, f2, '_'}, []), @@ -623,8 +622,6 @@ ms_trace_dead(Config) when is_list(Config) -> ?MODULE:f2(3,4), TRef = erlang:trace_delivered(all), receive {trace_delivered, _, TRef} -> ok end, - receive {trace_ts, Self, call, {?MODULE, f1, _}, _} -> ok end, - receive {trace_ts, Self, call, {?MODULE, f1, _}, _} -> ok end, receive M -> ct:fail({unexpected, M}) after 10 -> ok end. %% Test that destructive operations in test bif does not really happen diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl index 6efca5b39e..226462676c 100644 --- a/erts/emulator/test/message_queue_data_SUITE.erl +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -21,7 +21,7 @@ -module(message_queue_data_SUITE). -export([all/0, suite/0]). --export([basic/1, process_info_messages/1]). +-export([basic/1, process_info_messages/1, total_heap_size/1]). -export([basic_test/1]). @@ -32,7 +32,7 @@ suite() -> {timetrap, {minutes, 2}}]. all() -> - [basic, process_info_messages]. + [basic, process_info_messages, total_heap_size]. %% %% @@ -44,15 +44,15 @@ basic(Config) when is_list(Config) -> basic_test(erlang:system_info(message_queue_data)), - {ok, Node1} = start_node(Config, "+xmqd off_heap"), + {ok, Node1} = start_node(Config, "+hmqd off_heap"), ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]), stop_node(Node1), - {ok, Node2} = start_node(Config, "+xmqd on_heap"), + {ok, Node2} = start_node(Config, "+hmqd on_heap"), ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]), stop_node(Node2), - {ok, Node3} = start_node(Config, "+xmqd mixed"), + {ok, Node3} = start_node(Config, "+hmqd mixed"), ok = rpc:call(Node3, ?MODULE, basic_test, [mixed]), stop_node(Node3), @@ -190,6 +190,28 @@ process_info_messages(Config) when is_list(Config) -> ok. +total_heap_size(_Config) -> + + Fun = fun F() -> receive Pid when is_pid(Pid) -> Pid ! ok,F() end end, + + %% Test that on_heap messages grow the heap even if they are not received + OnPid = spawn_opt(Fun, [{message_queue_data, on_heap}]), + {total_heap_size, OnSize} = erlang:process_info(OnPid, total_heap_size), + [OnPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OnPid ! self(), receive ok -> ok end, + {total_heap_size, OnSizeAfter} = erlang:process_info(OnPid, total_heap_size), + ct:log("OnSize = ~p, OnSizeAfter = ~p",[OnSize, OnSizeAfter]), + true = OnSize < OnSizeAfter, + + %% Test that off_heap messages do not grow the heap if they are not received + OffPid = spawn_opt(Fun, [{message_queue_data, off_heap}]), + {total_heap_size, OffSize} = erlang:process_info(OffPid, total_heap_size), + [OffPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OffPid ! self(), receive ok -> ok end, + {total_heap_size, OffSizeAfter} = erlang:process_info(OffPid, total_heap_size), + ct:log("OffSize = ~p, OffSizeAfter = ~p",[OffSize, OffSizeAfter]), + true = OffSize == OffSizeAfter. + %% %% %% helpers diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl index 41e8a316c4..bfdea0761b 100644 --- a/erts/emulator/test/port_trace_SUITE.erl +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -240,19 +240,23 @@ command(Config) -> Prt ! {S, {command, <<?ECHO_DRV_NOOP:8>>}}, [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + OutputMsg = <<?ECHO_DRV_NOOP:8,0:(8*512)>>, + Prt ! {S, {command, OutputMsg}}, + [{trace, Prt, 'receive', {S, {command, OutputMsg}}}] = flush(), + close(Prt, Flags), os:putenv("OUTPUTV","true"), reload_drv(Config), Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), - Msg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], + OutputvMsg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], - erlang:port_command(Prt2, Msg), - [{trace, Prt2, 'receive', {S, {command, Msg}}}] = flush(), + erlang:port_command(Prt2, OutputvMsg), + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), - Prt2 ! {S, {command, Msg}}, - [{trace, Prt2, 'receive', {S, {command, Msg}}}] = flush(), + Prt2 ! {S, {command, OutputvMsg}}, + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), close(Prt2, Flags), @@ -274,6 +278,12 @@ control(_Config) -> [{trace, Prt, 'receive', {S, {control, {(1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + Msg = <<?ECHO_DRV_NOOP:8, 0:(8*512)>>, + Pat = lists:duplicate(512, 0), + Pat = erlang:port_control(Prt, 1, Msg), + [{trace, Prt, 'receive', {S, {control, {1, Msg}}}}, + {trace, Prt, send, {Prt, {control, <<0:(8*512)>>}}, S}] = flush(), + close(Prt, Flags), ok. @@ -331,12 +341,16 @@ call(_Config) -> Flags = [send,'receive'], {Prt, S} = trace_and_open(Flags,[binary]), - Msg = {hello, world, make_ref()}, - BinMsg = term_to_binary(Msg), + Test = fun(Msg) -> + BinMsg = term_to_binary(Msg), + + Msg = erlang:port_call(Prt, 0, Msg), + [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, + {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush() + end, - Msg = erlang:port_call(Prt, 0, Msg), - [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, - {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush(), + Test({hello, world, make_ref()}), + Test({hello, world, lists:seq(1,1000)}), close(Prt, Flags), diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c index b5728bc170..b5ae9389b4 100644 --- a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -217,6 +217,8 @@ static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) { + if ((len - 1) > rlen) + *rbuf = driver_alloc(len - 1); memcpy(*rbuf, buf+1, len-1); return len-1; } @@ -232,6 +234,8 @@ static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, char **rbuf, ErlDrvSizeT rlen, unsigned int *flags) { + if ((len - command) > rlen) + *rbuf = driver_alloc(len - command); memcpy(*rbuf, buf+command, len-command); return len-command; } diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index af1a0d35d6..aae7651f6d 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -60,7 +60,7 @@ dont_break_reductions(Config) when is_list(Config) -> RPS1 = reds_per_sched(0), RPS2 = reds_per_sched(20), Diff = abs(RPS1 - RPS2), - true = (Diff < (0.05 * RPS1)), + true = (Diff < (0.2 * RPS1)), ok. diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index b7f312635e..29e043dd5c 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -27,11 +27,12 @@ -export([all/0, suite/0, link_receive_call_correlation/0, receive_trace/1, link_receive_call_correlation/1, self_send/1, timeout_trace/1, send_trace/1, - procs_trace/1, dist_procs_trace/1, + procs_trace/1, dist_procs_trace/1, procs_new_trace/1, suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, suspend_system_limit/1, suspend_opts/1, suspend_waiting/1, new_clear/1, existing_clear/1, set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, + set_on_link/1, set_on_first_link/1, system_monitor_args/1, more_system_monitor_args/1, system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, @@ -54,7 +55,8 @@ all() -> mutual_suspend, suspend_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, new_clear, existing_clear, set_on_spawn, - set_on_first_spawn, system_monitor_args, + set_on_first_spawn, set_on_link, set_on_first_link, + system_monitor_args, more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, system_monitor_long_schedule, @@ -454,6 +456,34 @@ dist_procs_trace(Config) when is_list(Config) -> true = stop_node(OtherNode), ok. +%% Test trace(new, How, [procs]). +procs_new_trace(Config) when is_list(Config) -> + Self = self(), + process_flag(trap_exit, true), + %% + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + %% + 0 = erlang:trace(new, true, [procs]), + + MFA = {?MODULE, process, [Self]}, + %% + %% spawn, link + Proc1 ! {spawn_link_please, Self, MFA}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + io:format("Proc3 = ~p ~n", [Proc3]), + receive_nothing(), + %% + %% + %% exit (not linked to tracing process) + Reason1 = make_ref(), + Proc1 ! {exit_please, Reason1}, + receive {'EXIT', Proc1, Reason1} -> ok end, + {trace, Proc3, exit, Reason1} = receive_first_trace(), + receive_nothing(), + ok. @@ -501,6 +531,51 @@ set_on_first_spawn(Config) when is_list(Config) -> receive_nothing(), ok. +%% Tests trace(Pid, How, [set_on_link]). + +set_on_link(Config) -> + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_link flag. + %% Make sure it is traced. + Father_SOL = fun_spawn(fun process/0), + 1 = erlang:trace(Father_SOL, true, [send, set_on_link]), + true = is_send_traced(Father_SOL, Listener, sol_father), + + %% Have the process spawn of two children and test that they + %% are traced. + [Child1, Child2] = spawn_children(Father_SOL, 2), + true = is_send_traced(Child1, Listener, child1), + true = is_send_traced(Child2, Listener, child2), + + %% Second generation. + [Child11, Child12] = spawn_children(Child1, 2), + true = is_send_traced(Child11, Listener, child11), + true = is_send_traced(Child12, Listener, child12), + ok. + +%% Tests trace(Pid, How, [set_on_first_spawn]). + +set_on_first_link(Config) -> + ct:timetrap({seconds, 10}), + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_first_spawn flag. + %% Make sure it is traced. + Parent = fun_spawn(fun process/0), + 1 = erlang:trace(Parent, true, [send, set_on_first_link]), + is_send_traced(Parent, Listener, sol_father), + + %% Have the process spawn off three children and test that the + %% first is traced. + [Child1, Child2, Child3] = spawn_children(Parent, 3), + true = is_send_traced(Child1, Listener, child1), + false = is_send_traced(Child2, Listener, child2), + false = is_send_traced(Child3, Listener, child3), + receive_nothing(), + ok. + + %% Tests arguments to erlang:system_monitor/0,1,2 system_monitor_args(Config) when is_list(Config) -> diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 82a0303f86..5a5021b003 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -150,6 +150,7 @@ static char *plush_val_switches[] = { "ms", "mbs", "pds", + "mqd", "", NULL }; @@ -160,12 +161,6 @@ static char *plusr_val_switches[] = { NULL }; -/* +x arguments with values */ -static char *plusx_val_switches[] = { - "mqd", - NULL -}; - /* +z arguments with values */ static char *plusz_val_switches[] = { "dbbl", @@ -986,20 +981,6 @@ int main(int argc, char **argv) add_Eargs(argv[i+1]); i++; break; - case 'x': - if (!is_one_of_strings(&argv[i][2], plusx_val_switches)) { - goto the_default; - } else { - if (i+1 >= argc - || argv[i+1][0] == '-' - || argv[i+1][0] == '+') - usage(argv[i]); - argv[i][0] = '-'; - add_Eargs(argv[i]); - add_Eargs(argv[i+1]); - i++; - } - break; case 'z': if (!is_one_of_strings(&argv[i][2], plusz_val_switches)) { goto the_default; @@ -1200,7 +1181,7 @@ usage_aux(void) "[+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] " "[+SP PERCENTAGE_SCHEDULERS:PERCENTAGE_SCHEDULERS_ONLINE] " "[+T LEVEL] [+V] [+v] " - "[+W<i|w|e>] [+x DEFAULT_PROC_FLAGS] [+z MISC_OPTION] [args ...]\n"); + "[+W<i|w|e>] [+z MISC_OPTION] [args ...]\n"); exit(1); } diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 77685013ae..3e82b8e20e 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex b8f3f6d8c2..67d96d0f0d 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 15e4ca82a7..321e4e7e1b 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 3e95b1e42e..0c667663fd 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 53dd2897de..ed2e328f5b 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex ee32066f53..23ebd2cad9 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 51a412b7f7..b63fa24848 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 45bed5cf7e..7c8fdc82c0 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex c25bffb6a5..d4559bc9ed 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 85d74de065..5a0678632e 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 1f8fe6f03b..3d32dd8449 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 059585ec99..ced9f9c952 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index 23aeaa38ea..5231ef24a4 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -601,18 +601,21 @@ </func> <func> - <name>get_timetrap_info() -> {Time, Scale}</name> + <name>get_timetrap_info() -> {Time, {Scaling,ScaleVal}}</name> <fsummary>Reads information about the timetrap set for the current test case.</fsummary> <type> <v>Time = integer() | infinity</v> - <v>Scale = true | false</v> + <v>Scaling = true | false</v> + <v>ScaleVal = integer()</v> </type> <desc><marker id="get_timetrap_info-0"/> <p>Reads information about the timetrap set for the current test - case. <c>Scale</c> indicates if <c>Common Test</c> will attempt + case. <c>Scaling</c> indicates if <c>Common Test</c> will attempt to compensate timetraps automatically for runtime delays - introduced by, for example, tools like cover.</p> + introduced by, for example, tools like cover. <c>ScaleVal</c> is + the value of the current scaling multipler (always 1 if scaling is + disabled). Note the <c>Time</c> is not the scaled result.</p> </desc> </func> @@ -1136,7 +1139,7 @@ Opts.</fsummary> <type> <v>Opts = [OptTuples]</v> - <v>OptTuples = {dir, TestDirs} | {suite, Suites} | {group, Groups} | {testcase, Cases} | {spec, TestSpecs} | {join_specs, Bool} | {label, Label} | {config, CfgFiles} | {userconfig, UserConfig} | {allow_user_terms, Bool} | {logdir, LogDir} | {silent_connections, Conns} | {stylesheet, CSSFile} | {cover, CoverSpecFile} | {cover_stop, Bool} | {step, StepOpts} | {event_handler, EventHandlers} | {include, InclDirs} | {auto_compile, Bool} | {abort_if_missing_suites, Bool} | {create_priv_dir, CreatePrivDir} | {multiply_timetraps, M} | {scale_timetraps, Bool} | {repeat, N} | {duration, DurTime} | {until, StopTime} | {force_stop, ForceStop} | {decrypt, DecryptKeyOrFile} | {refresh_logs, LogDir} | {logopts, LogOpts} | {verbosity, VLevels} | {basic_html, Bool} | {ct_hooks, CTHs} | {enable_builtin_hooks, Bool} | {release_shell, Bool}</v> + <v>OptTuples = {dir, TestDirs} | {suite, Suites} | {group, Groups} | {testcase, Cases} | {spec, TestSpecs} | {join_specs, Bool} | {label, Label} | {config, CfgFiles} | {userconfig, UserConfig} | {allow_user_terms, Bool} | {logdir, LogDir} | {silent_connections, Conns} | {stylesheet, CSSFile} | {cover, CoverSpecFile} | {cover_stop, Bool} | {step, StepOpts} | {event_handler, EventHandlers} | {include, InclDirs} | {auto_compile, Bool} | {abort_if_missing_suites, Bool} | {create_priv_dir, CreatePrivDir} | {multiply_timetraps, M} | {scale_timetraps, Bool} | {repeat, N} | {duration, DurTime} | {until, StopTime} | {force_stop, ForceStop} | {decrypt, DecryptKeyOrFile} | {refresh_logs, LogDir} | {logopts, LogOpts} | {verbosity, VLevels} | {basic_html, Bool} | {esc_chars, Bool} | {ct_hooks, CTHs} | {enable_builtin_hooks, Bool} | {release_shell, Bool}</v> <v>TestDirs = [string()] | string()</v> <v>Suites = [string()] | [atom()] | string() | atom()</v> <v>Cases = [atom()] | atom()</v> diff --git a/lib/common_test/doc/src/ct_run.xml b/lib/common_test/doc/src/ct_run.xml index 88873ce5b2..9e6229f1dd 100644 --- a/lib/common_test/doc/src/ct_run.xml +++ b/lib/common_test/doc/src/ct_run.xml @@ -124,6 +124,7 @@ [-duration HHMMSS [-force_stop [skip_rest]]] | [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]] [-basic_html] + [-no_esc_chars] [-ct_hooks CTHModule1 CTHOpts1 and CTHModule2 CTHOpts2 and .. CTHModuleN CTHOptsN] [-exit_status ignore_config] @@ -162,6 +163,7 @@ [-duration HHMMSS [-force_stop [skip_rest]]] | [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]] [-basic_html] + [-no_esc_chars] [-ct_hooks CTHModule1 CTHOpts1 and CTHModule2 CTHOpts2 and .. CTHModuleN CTHOptsN] [-exit_status ignore_config]</pre> @@ -186,7 +188,8 @@ [-muliply_timetraps Multiplier] [-scale_timetraps] [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc] - [-basic_html]</pre> + [-basic_html] + [-no_esc_chars]</pre> </section> <section> diff --git a/lib/common_test/doc/src/ct_telnet.xml b/lib/common_test/doc/src/ct_telnet.xml index b35e511501..e2a45e894b 100644 --- a/lib/common_test/doc/src/ct_telnet.xml +++ b/lib/common_test/doc/src/ct_telnet.xml @@ -64,6 +64,8 @@ remaining string terminated) = 0</p></item> <item><p>Polling interval (sleep time between polls) = 1 second</p> </item> + <item><p>The TCP_NODELAY option for the telnet socket + is disabled (set to <c>false</c>) per default</p></item> </list> <p>These parameters can be modified by the user with the following @@ -76,7 +78,8 @@ {reconnection_interval,Millisec}, {keep_alive,Bool}, {poll_limit,N}, - {poll_interval,Millisec}]}.</pre> + {poll_interval,Millisec}, + {tcp_nodelay,Bool}]}.</pre> <p><c>Millisec = integer(), N = integer()</c></p> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index aba71b0d4a..ebba864606 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,68 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.12.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The <c>nodelay</c> option used to be enabled + (<c>true</c>) by default for sockets opened by the Common + Test telnet client. This appeared to cause communication + problems with telnet servers on some systems, and + therefore the option is no longer used. Its value may + instead be specified in the telnet connection settings. + See the man page for <c>ct_telnet</c> for details. Please + note that the interface function <c>connect</c> in + <c>unix_telnet</c> has been updated with an extra + argument and is now <c>unix_telnet:connect/7</c>.</p> + <p> + Own Id: OTP-13462 Aux Id: seq13077 </p> + </item> + <item> + <p> + Fix bug in cth_surefire: When a pre_init_per_suite hook + fails before reaching the + cth_surefire:pre_init_per_suite, cth_surefire produced + incorrect XML.</p> + <p> + Own Id: OTP-13513</p> + </item> + <item> + <p> + The <c>ct:get_timetrap_info/0</c> function has been + updated to return more information about timetrap + scaling.</p> + <p> + Own Id: OTP-13535</p> + </item> + <item> + <p> + A problem with stylesheet HTML tags getting incorrectly + escaped by Common Test has been corrected.</p> + <p> + Own Id: OTP-13536</p> + </item> + <item> + <p> + The <c>ct_run</c> start flag <c>-no_esc_chars</c> and + <c>ct:run_test/1</c> start option <c>{esc_chars,Bool}</c> + have been introduced to make it possible to disable + automatic escaping of characters. Automatic escaping of + special HTML characters printed with <c>io:format/1,2</c> + and <c>ct:pal/1,2,3,4</c> was introduced in Common Test + 1.12. The new flag/option may be used to disable this + feature for backwards compatibility reasons. (The option + is also supported in test specifications).</p> + <p> + Own Id: OTP-13537</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.12</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 5ae32ee230..43e36adfb6 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -266,6 +266,10 @@ <tag><c><![CDATA[-verbosity <levels>]]></c></tag> <item><p>Sets <seealso marker="write_test_chapter#logging">verbosity levels for printouts</seealso>.</p></item> + + <tag><c><![CDATA[-no_esc_chars]]></c></tag> + <item><p>Disables automatic escaping of special HTML characters. + See the <seealso marker="write_test_chapter#logging">Logging chapter</seealso>.</p></item> </taglist> <note><p>Directories passed to <c>Common Test</c> can have either relative or absolute paths.</p></note> @@ -802,7 +806,7 @@ program</seealso> for an overview of available start flags (as most flags have a corresponding configuration term)</item> <item><seealso marker="write_test_chapter#logging">Logging</seealso> - (for terms <c>verbosity</c>, <c>stylesheet</c> and <c>basic_html</c>)</item> + (for terms <c>verbosity</c>, <c>stylesheet</c>, <c>basic_html</c> and <c>esc_chars</c>)</item> <item><seealso marker="config_file_chapter#top">External Configuration Data</seealso> (for terms <c>config</c> and <c>userconfig</c>)</item> <item><seealso marker="event_handler_chapter#event_handling">Event @@ -887,6 +891,9 @@ {basic_html, Bool}. {basic_html, NodeRefs, Bool}. + {esc_chars, Bool}. + {esc_chars, NodeRefs, Bool}. + {release_shell, Bool}.</pre> <p><em>Test terms:</em></p> diff --git a/lib/common_test/doc/src/unix_telnet.xml b/lib/common_test/doc/src/unix_telnet.xml index 701d5ec88e..b2314a53ec 100644 --- a/lib/common_test/doc/src/unix_telnet.xml +++ b/lib/common_test/doc/src/unix_telnet.xml @@ -80,7 +80,7 @@ <funcs> <func> - <name>connect(ConnName, Ip, Port, Timeout, KeepAlive, Extra) -> {ok, Handle} | {error, Reason}</name> + <name>connect(ConnName, Ip, Port, Timeout, KeepAlive, TCPNoDelay, Extra) -> {ok, Handle} | {error, Reason}</name> <fsummary>Callback for ct_telnet.erl.</fsummary> <type> <v>ConnName = target_name()</v> @@ -88,6 +88,7 @@ <v>Port = integer()</v> <v>Timeout = integer()</v> <v>KeepAlive = bool()</v> + <v>TCPNoDelay = bool()</v> <v>Extra = target_name() | {Username, Password}</v> <v>Username = string()</v> <v>Password = string()</v> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 40e02347f2..83daf771a6 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -1047,9 +1047,15 @@ <p>Common Test will escape special HTML characters (<, > and &) in printouts to the log file made with <c>ct:pal/4</c> and <c>io:format/2</c>. In order to print - strings with HTML tags to the log, use the <c>ct:log/5</c> function. The character escaping - feature is per default disabled for <c>ct:log/5</c>, but can be enabled with the - <c>esc_chars</c> option.</p> + strings with HTML tags to the log, use the <c>ct:log/3,4,5</c> function. The character + escaping feature is per default disabled for <c>ct:log/3,4,5</c> but can be enabled with + the <c>esc_chars</c> option in the <c>Opts</c> list, see <seealso marker="ct#log-5"> + <c>ct:log/3,4,5</c></seealso>.</p> + + <p>If the character escaping feature needs to be disabled (typically for backwards + compatibility reasons), use the <c>ct_run</c> start flag <c>-no_esc_chars</c>, or the + <c>ct:run_test/1</c> start option <c>{esc_chars,Bool}</c> (this start option is also + supported in test specifications).</p> <p>For more information about log files, see section <seealso marker="run_test_chapter#log_files">Log Files</seealso> diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 7fe90b60ff..cae7bea406 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -161,9 +161,9 @@ run(TestDirs) -> %%% {repeat,N} | {duration,DurTime} | {until,StopTime} | %%% {force_stop,ForceStop} | {decrypt,DecryptKeyOrFile} | %%% {refresh_logs,LogDir} | {logopts,LogOpts} | -%%% {verbosity,VLevels} | {basic_html,Bool} | -%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool} | -%%% {release_shell,Bool} +%%% {verbosity,VLevels} | {basic_html,Bool} | +%%% {esc_chars,Bool} | {ct_hooks, CTHs} | +%%% {enable_builtin_hooks,Bool} | {release_shell,Bool} %%% TestDirs = [string()] | string() %%% Suites = [string()] | [atom()] | string() | atom() %%% Cases = [atom()] | atom() diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index 80f5c30c2a..dd04c5410a 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -325,7 +325,7 @@ modify_tc_list1(GrSpecTs, TSCs) -> true -> {[TC|TSCs1],lists:delete(TC,GrSpecTs2)}; false -> - case lists:keymember(TC, 2, GrSpecTs) of + case lists:keysearch(TC, 2, GrSpecTs) of {value,Test} -> {[Test|TSCs1], lists:keydelete(TC, 2, GrSpecTs2)}; diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index d8f583455b..5422d449fd 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -67,6 +67,8 @@ terminate(Hooks) -> %% tests. -spec init_tc(Mod :: atom(), FuncSpec :: atom() | + {ConfigFunc :: init_per_testcase | end_per_testcase, + TestCase :: atom()} | {ConfigFunc :: init_per_group | end_per_group, GroupName :: atom(), Properties :: list()}, @@ -103,7 +105,9 @@ init_tc(_Mod, TC = error_in_suite, Config) -> %% @doc Called as each test case is completed. This includes all configuration %% tests. -spec end_tc(Mod :: atom(), - FuncSpec :: atom() | + FuncSpec :: atom() | + {ConfigFunc :: init_per_testcase | end_per_testcase, + TestCase :: atom()} | {ConfigFunc :: init_per_group | end_per_group, GroupName :: atom(), Properties :: list()}, diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 77828a2186..29b38e9748 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -609,7 +609,8 @@ log_timestamp({MS,S,US}) -> ct_log_fd, tc_groupleaders, stylesheet, - async_print_jobs}). + async_print_jobs, + tc_esc_chars}). logger(Parent, Mode, Verbosity) -> register(?MODULE,self()), @@ -728,14 +729,18 @@ logger(Parent, Mode, Verbosity) -> end end || {Cat,VLvl} <- Verbosity], io:nl(CtLogFd), - + TcEscChars = case application:get_env(common_test, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, logger_loop(#logger_state{parent=Parent, log_dir=AbsDir, start_time=Time, orig_GL=group_leader(), ct_log_fd=CtLogFd, tc_groupleaders=[], - async_print_jobs=[]}). + async_print_jobs=[], + tc_esc_chars=TcEscChars}). copy_priv_files([SrcF | SrcFs], [DestF | DestFs]) -> case file:copy(SrcF, DestF) of @@ -761,20 +766,21 @@ logger_loop(State) -> end, if Importance >= (100-VLvl) -> CtLogFd = State#logger_state.ct_log_fd, + DoEscChars = State#logger_state.tc_esc_chars and EscChars, case get_groupleader(Pid, GL, State) of {tc_log,TCGL,TCGLs} -> case erlang:is_process_alive(TCGL) of true -> State1 = print_to_log(SyncOrAsync, Pid, Category, TCGL, Content, - EscChars, State), + DoEscChars, State), logger_loop(State1#logger_state{ tc_groupleaders = TCGLs}); false -> %% Group leader is dead, so write to the %% CtLog or unexpected_io log instead unexpected_io(Pid, Category, Importance, - Content, CtLogFd, EscChars), + Content, CtLogFd, DoEscChars), logger_loop(State) end; @@ -783,7 +789,7 @@ logger_loop(State) -> %% to ct_log, else write to unexpected_io %% log unexpected_io(Pid, Category, Importance, Content, - CtLogFd, EscChars), + CtLogFd, DoEscChars), logger_loop(State#logger_state{ tc_groupleaders = TCGLs}) end; @@ -794,7 +800,7 @@ logger_loop(State) -> %% make sure no IO for this test case from the %% CT logger gets rejected test_server:permit_io(GL, self()), - print_style(GL, State#logger_state.stylesheet), + print_style(GL,GL,State#logger_state.stylesheet), set_evmgr_gl(GL), TCGLs = add_tc_gl(TCPid,GL,State), if not RefreshLog -> @@ -882,7 +888,7 @@ create_io_fun(FromPid, CtLogFd, EscChars) -> {_HdOrFt,S,A} -> {false,S,A}; {S,A} -> {true,S,A} end, - try io_lib:format(Str,Args) of + try io_lib:format(Str, Args) of IoStr when Escapable, EscChars, IoList == [] -> escape_chars(IoStr); IoStr when Escapable, EscChars -> @@ -925,7 +931,12 @@ print_to_log(sync, FromPid, Category, TCGL, Content, EscChars, State) -> if FromPid /= TCGL -> IoFun = create_io_fun(FromPid, CtLogFd, EscChars), IoList = lists:foldl(IoFun, [], Content), - io:format(TCGL,["$tc_html","~ts"], [IoList]); + try io:format(TCGL,["$tc_html","~ts"], [IoList]) of + ok -> ok + catch + _:_ -> + io:format(TCGL,"~ts", [IoList]) + end; true -> unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, Content, CtLogFd, EscChars) @@ -958,7 +969,10 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) -> _:terminated -> unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, - Content, CtLogFd, EscChars) + Content, CtLogFd, EscChars); + _:_ -> + io:format(TCGL, "~ts", + [lists:foldl(IoFun,[],Content)]) end; false -> unexpected_io(FromPid, Category, @@ -1099,26 +1113,27 @@ open_ctlog(MiscIoName) -> "View I/O logged after the test run</a></li>\n</ul>\n", [MiscIoName,MiscIoName]), - print_style(Fd,undefined), + print_style(Fd,group_leader(),undefined), io:format(Fd, xhtml("<br><h2>Progress Log</h2>\n<pre>\n", "<br />\n<h4>PROGRESS LOG</h4>\n<pre>\n"), []), Fd. -print_style(Fd,undefined) -> +print_style(Fd,GL,undefined) -> case basic_html() of true -> - io:format(Fd, - "<style>\n" - "div.ct_internal { background:lightgrey; color:black; }\n" - "div.default { background:lightgreen; color:black; }\n" - "</style>\n", - []); + Style = "<style>\n + div.ct_internal { background:lightgrey; color:black; }\n + div.default { background:lightgreen; color:black; }\n + </style>\n", + if Fd == GL -> io:format(["$tc_html",Style], []); + true -> io:format(Fd, Style, []) + end; _ -> ok end; -print_style(Fd,StyleSheet) -> +print_style(Fd,GL,StyleSheet) -> case file:read_file(StyleSheet) of {ok,Bin} -> Str = b2s(Bin,encoding(StyleSheet)), @@ -1131,23 +1146,30 @@ print_style(Fd,StyleSheet) -> N1 -> N1 end, if (Pos0 == 0) and (Pos1 /= 0) -> - print_style_error(Fd,StyleSheet,missing_style_start_tag); + print_style_error(Fd,GL,StyleSheet,missing_style_start_tag); (Pos0 /= 0) and (Pos1 == 0) -> - print_style_error(Fd,StyleSheet,missing_style_end_tag); + print_style_error(Fd,GL,StyleSheet,missing_style_end_tag); Pos0 /= 0 -> Style = string:sub_string(Str,Pos0,Pos1+7), - io:format(Fd,"~ts\n",[Style]); + if Fd == GL -> io:format(Fd,["$tc_html","~ts\n"],[Style]); + true -> io:format(Fd,"~ts\n",[Style]) + end; Pos0 == 0 -> - io:format(Fd,"<style>~ts</style>\n",[Str]) + if Fd == GL -> io:format(Fd,["$tc_html","<style>\n~ts</style>\n"],[Str]); + true -> io:format(Fd,"<style>\n~ts</style>\n",[Str]) + end end; {error,Reason} -> - print_style_error(Fd,StyleSheet,Reason) + print_style_error(Fd,GL,StyleSheet,Reason) end. -print_style_error(Fd,StyleSheet,Reason) -> - io:format(Fd,"\n<!-- Failed to load stylesheet ~ts: ~p -->\n", - [StyleSheet,Reason]), - print_style(Fd,undefined). +print_style_error(Fd,GL,StyleSheet,Reason) -> + IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~p -->\n", + [StyleSheet,Reason]), + if Fd == GL -> io:format(Fd,["$tc_html",IO],[]); + true -> io:format(Fd,IO,[]) + end, + print_style(Fd,GL,undefined). close_ctlog(Fd) -> io:format(Fd, "\n</pre>\n", []), diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 32c8ab96ec..c4905b316f 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -27,7 +27,7 @@ -export([run_on_node/2,run_on_node/3]). -export([run_test/1,run_test/2]). -export([get_event_mgr_ref/0]). --export([basic_html/1]). +-export([basic_html/1,esc_chars/1]). -export([abort/0,abort/1,progress/0]). @@ -317,6 +317,16 @@ basic_html(Bool) -> ok. %%%----------------------------------------------------------------- +%%% @spec esc_chars(Bool) -> ok +%%% Bool = true | false +%%% +%%% @doc If set to false, the ct_master logs will be written without +%%% special characters being escaped in the HTML logs. +esc_chars(Bool) -> + application:set_env(common_test_master, esc_chars, Bool), + ok. + +%%%----------------------------------------------------------------- %%% MASTER, runs on central controlling node. %%%----------------------------------------------------------------- start_master(NodeOptsList) -> diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index e156c9b773..1e5f935198 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -65,6 +65,7 @@ logdir, logopts = [], basic_html, + esc_chars = true, verbosity = [], config = [], event_handlers = [], @@ -346,6 +347,15 @@ script_start1(Parent, Args) -> application:set_env(common_test, basic_html, true), true end, + %% esc_chars - used by ct_logs + EscChars = case proplists:get_value(no_esc_chars, Args) of + undefined -> + application:set_env(common_test, esc_chars, true), + undefined; + _ -> + application:set_env(common_test, esc_chars, false), + false + end, %% disable_log_cache - used by ct_logs case proplists:get_value(disable_log_cache, Args) of undefined -> @@ -359,6 +369,7 @@ script_start1(Parent, Args) -> cover = Cover, cover_stop = CoverStop, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, verbosity = Verbosity, event_handlers = EvHandlers, ct_hooks = CTHooks, @@ -587,6 +598,17 @@ combine_test_opts(TS, Specs, Opts) -> BHBool end, + EscChars = + case choose_val(Opts#opts.esc_chars, + TSOpts#opts.esc_chars) of + undefined -> + true; + ECBool -> + application:set_env(common_test, esc_chars, + ECBool), + ECBool + end, + Opts#opts{label = Label, profile = Profile, testspec_files = Specs, @@ -595,6 +617,7 @@ combine_test_opts(TS, Specs, Opts) -> logdir = which(logdir, LogDir), logopts = AllLogOpts, basic_html = BasicHtml, + esc_chars = EscChars, verbosity = AllVerbosity, silent_connections = AllSilentConns, config = TSOpts#opts.config, @@ -795,6 +818,7 @@ script_usage() -> "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" "\n\t [-basic_html]" + "\n\t [-no_esc_chars]" "\n\t [-repeat N] |" "\n\t [-duration HHMMSS [-force_stop [skip_rest]]] |" "\n\t [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]]" @@ -822,6 +846,7 @@ script_usage() -> "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" "\n\t [-basic_html]" + "\n\t [-no_esc_chars]" "\n\t [-repeat N] |" "\n\t [-duration HHMMSS [-force_stop [skip_rest]]] |" "\n\t [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]]\n\n"), @@ -847,7 +872,8 @@ script_usage() -> "\n\t [-multiply_timetraps N]" "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" - "\n\t [-basic_html]\n\n"). + "\n\t [-basic_html]" + "\n\t [-no_esc_chars]\n\n"). %%%----------------------------------------------------------------- %%% @hidden @@ -1089,7 +1115,17 @@ run_test2(StartOpts) -> application:set_env(common_test, basic_html, BasicHtmlBool), BasicHtmlBool end, - + %% esc_chars - used by ct_logs + EscChars = + case proplists:get_value(esc_chars, StartOpts) of + undefined -> + application:set_env(common_test, esc_chars, true), + undefined; + EscCharsBool -> + application:set_env(common_test, esc_chars, EscCharsBool), + EscCharsBool + end, + %% disable_log_cache - used by ct_logs case proplists:get_value(disable_log_cache, StartOpts) of undefined -> application:set_env(common_test, disable_log_cache, false); @@ -1104,6 +1140,7 @@ run_test2(StartOpts) -> cover = Cover, cover_stop = CoverStop, step = Step, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, config = CfgFiles, verbosity = Verbosity, event_handlers = EvHandlers, @@ -1445,6 +1482,7 @@ get_data_for_node(#testspec{label = Labels, logdir = LogDirs, logopts = LogOptsList, basic_html = BHs, + esc_chars = EscChs, stylesheet = SSs, verbosity = VLvls, silent_connections = SilentConnsList, @@ -1472,6 +1510,7 @@ get_data_for_node(#testspec{label = Labels, LOs -> LOs end, BasicHtml = proplists:get_value(Node, BHs), + EscChars = proplists:get_value(Node, EscChs), Stylesheet = proplists:get_value(Node, SSs), Verbosity = case proplists:get_value(Node, VLvls) of undefined -> []; @@ -1498,6 +1537,7 @@ get_data_for_node(#testspec{label = Labels, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, stylesheet = Stylesheet, verbosity = Verbosity, silent_connections = SilentConns, @@ -2182,10 +2222,18 @@ do_run_test(Tests, Skip, Opts0) -> %% test_server needs to know the include path too InclPath = case application:get_env(common_test, include) of {ok,Incls} -> Incls; - _ -> [] + _ -> [] end, application:set_env(test_server, include, InclPath), + %% copy the escape characters setting to test_server + EscChars = + case application:get_env(common_test, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, + application:set_env(test_server, esc_chars, EscChars), + test_server_ctrl:start_link(local), %% let test_server expand the test tuples and count no of cases @@ -3069,6 +3117,10 @@ opts2args(EnvStartOpts) -> [{basic_html,[]}]; ({basic_html,false}) -> []; + ({esc_chars,false}) -> + [{no_esc_chars,[]}]; + ({esc_chars,true}) -> + []; ({event_handler,EH}) when is_atom(EH) -> [{event_handler,[atom_to_list(EH)]}]; ({event_handler,EHs}) when is_list(EHs) -> diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4d3fd2d094..f5f4f648f4 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -42,7 +42,8 @@ %% {reconnection_interval,Millisec}, %% {keep_alive,Bool}, %% {poll_limit,N}, -%% {poll_interval,Millisec}]}.</pre> +%% {poll_interval,Millisec}, +%% {tcp_nodelay,Bool}]}.</pre> %% <p><code>Millisec = integer(), N = integer()</code></p> %% <p>Enter the <code>telnet_settings</code> term in a configuration %% file included in the test and ct_telnet will retrieve the information @@ -182,7 +183,8 @@ conn_to=?DEFAULT_TIMEOUT, com_to=?DEFAULT_TIMEOUT, reconns=?RECONNS, - reconn_int=?RECONN_TIMEOUT}). + reconn_int=?RECONN_TIMEOUT, + tcp_nodelay=false}). %%%----------------------------------------------------------------- %%% @spec open(Name) -> {ok,Handle} | {error,Reason} @@ -602,8 +604,18 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> Settings -> set_telnet_defaults(Settings,#state{}) end, - case catch TargetMod:connect(Name,Ip,Port,S0#state.conn_to, - KeepAlive,Extra) of + %% Handle old user versions of TargetMod + code:ensure_loaded(TargetMod), + try + case erlang:function_exported(TargetMod,connect,7) of + true -> + TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,S0#state.tcp_nodelay,Extra); + false -> + TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,Extra) + end + of {ok,TelnPid} -> put({ct_telnet_pid2name,TelnPid},Name), S1 = S0#state{host=Ip, @@ -625,15 +637,18 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> "Connection timeout: ~p\n" "Keep alive: ~w\n" "Poll limit: ~w\n" - "Poll interval: ~w", + "Poll interval: ~w\n" + "TCP nodelay: ~w", [Ip,Port,S1#state.com_to,S1#state.reconns, S1#state.reconn_int,S1#state.conn_to,KeepAlive, - S1#state.poll_limit,S1#state.poll_interval]), + S1#state.poll_limit,S1#state.poll_interval, + S1#state.tcp_nodelay]), {ok,TelnPid,S1}; - {'EXIT',Reason} -> - {error,Reason}; Error -> Error + catch + _:Reason -> + {error,Reason} end. type(telnet) -> ip; @@ -653,6 +668,8 @@ set_telnet_defaults([{poll_limit,PL}|Ss],S) -> set_telnet_defaults(Ss,S#state{poll_limit=PL}); set_telnet_defaults([{poll_interval,PI}|Ss],S) -> set_telnet_defaults(Ss,S#state{poll_interval=PI}); +set_telnet_defaults([{tcp_nodelay,NoDelay}|Ss],S) -> + set_telnet_defaults(Ss,S#state{tcp_nodelay=NoDelay}); set_telnet_defaults([Unknown|Ss],S) -> force_log(S,error, "Bad element in telnet_settings: ~p",[Unknown]), @@ -794,8 +811,17 @@ reconnect(Ip,Port,N,State=#state{name=Name, keep_alive=KeepAlive, extra=Extra, conn_to=ConnTo, - reconn_int=ReconnInt}) -> - case TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) of + reconn_int=ReconnInt, + tcp_nodelay=NoDelay}) -> + %% Handle old user versions of TargetMod + ConnResult = + case erlang:function_exported(TargetMod,connect,7) of + true -> + TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,NoDelay,Extra); + false -> + TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) + end, + case ConnResult of {ok,NewPid} -> put({ct_telnet_pid2name,NewPid},Name), {ok, NewPid, State#state{teln_pid=NewPid}}; diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index f1dee1f3bb..1f1311776f 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -35,7 +35,7 @@ %%-define(debug, true). --export([open/2, open/3, open/4, open/5, close/1]). +-export([open/2, open/3, open/4, open/5, open/6, close/1]). -export([send_data/2, send_data/3, get_data/1]). -define(TELNET_PORT, 23). @@ -70,19 +70,22 @@ -record(state,{conn_name, get_data, keep_alive=true, log_pos=1}). open(Server, ConnName) -> - open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, ConnName). + open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, false, ConnName). open(Server, Port, ConnName) -> - open(Server, Port, ?OPEN_TIMEOUT, true, ConnName). + open(Server, Port, ?OPEN_TIMEOUT, true, false, ConnName). open(Server, Port, Timeout, ConnName) -> - open(Server, Port, Timeout, true, ConnName). + open(Server, Port, Timeout, true, false, ConnName). open(Server, Port, Timeout, KeepAlive, ConnName) -> + open(Server, Port, Timeout, KeepAlive, false, ConnName). + +open(Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> Self = self(), Pid = spawn(fun() -> init(Self, Server, Port, Timeout, - KeepAlive, ConnName) + KeepAlive, NoDelay, ConnName) end), receive {open,Pid} -> @@ -114,8 +117,8 @@ get_data(Pid) -> %%%----------------------------------------------------------------- %%% Internal functions -init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> - case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,true}], Timeout) of +init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> + case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of {ok,Sock} -> dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", [ConnName,Server,Port,KeepAlive]), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index df5587b069..991abb0666 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1146,8 +1146,9 @@ should_be_added(Tag,Node,_Data,Spec) -> if %% list terms *without* possible duplicates here Tag == logdir; Tag == logopts; - Tag == basic_html; Tag == label; - Tag == auto_compile; Tag == abort_if_missing_suites; + Tag == basic_html; Tag == esc_chars; + Tag == label; Tag == auto_compile; + Tag == abort_if_missing_suites; Tag == stylesheet; Tag == verbosity; Tag == silent_connections -> lists:keymember(ref2node(Node,Spec#testspec.nodes),1, @@ -1544,6 +1545,8 @@ valid_terms() -> {logopts,3}, {basic_html,2}, {basic_html,3}, + {esc_chars,2}, + {esc_chars,3}, {verbosity,2}, {verbosity,3}, {silent_connections,2}, diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index c372763ae9..d5a8e3fbc0 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -459,6 +459,7 @@ loop(Mode,TestData,StartDir) -> error:badarg -> [] end, ct_hooks:terminate(Callbacks), + close_connections(ets:tab2list(?conn_table)), ets:delete(?conn_table), ets:delete(?board_table), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index c1cc1eafbd..d7efa26863 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -37,6 +37,7 @@ logdir=["."], logopts=[], basic_html=[], + esc_chars=[], verbosity=[], silent_connections=[], cover=[], diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index e762d5060f..33a3813a16 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -130,7 +130,14 @@ handle_event(Event, #eh_state{log_func = LogFunc} = State) -> tag_event(Event)), if is_list(SReport) -> SaslHeader = format_header(State), - ct_logs:LogFunc(sasl, ?STD_IMPORTANCE, SaslHeader, SReport, []); + case LogFunc of + tc_log -> + ct_logs:tc_log(sasl, ?STD_IMPORTANCE, + SaslHeader, SReport, [], []); + tc_log_async -> + ct_logs:tc_log_async(sasl, ?STD_IMPORTANCE, + SaslHeader, SReport, []) + end; true -> %% Report is an atom if no logging is to be done ignore end @@ -139,7 +146,14 @@ handle_event(Event, #eh_state{log_func = LogFunc} = State) -> tag_event(Event),io_lib), if is_list(EReport) -> ErrHeader = format_header(State), - ct_logs:LogFunc(error_logger, ?STD_IMPORTANCE, ErrHeader, EReport, []); + case LogFunc of + tc_log -> + ct_logs:tc_log(error_logger, ?STD_IMPORTANCE, + ErrHeader, EReport, [], []); + tc_log_async -> + ct_logs:tc_log_async(error_logger, ?STD_IMPORTANCE, + ErrHeader, EReport, []) + end; true -> %% Report is an atom if no logging is to be done ignore end, diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 74a97fe2e2..59b916851e 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -82,7 +82,8 @@ init(Path, Opts) -> url_base = proplists:get_value(url_base,Opts), timer = ?now }. -pre_init_per_suite(Suite,SkipOrFail,State) when is_tuple(SkipOrFail) -> +pre_init_per_suite(Suite,SkipOrFail,#state{ test_cases = [] } = State) + when is_tuple(SkipOrFail) -> {SkipOrFail, init_tc(State#state{curr_suite = Suite, curr_suite_ts = ?now}, SkipOrFail) }; diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 34acad6fd1..919526c5d7 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -2165,10 +2165,19 @@ get_timetrap_info(TCPid, SendToServer) -> Timers -> case [Info || {Handle,Pid,Info} <- Timers, Pid == TCPid, Handle /= infinity] of - [I|_] -> - I; + [{TVal,true}|_] -> + {TVal,{true,test_server:timetrap_scale_factor()}}; + [{TVal,false}|_] -> + {TVal,{false,1}}; [] when SendToServer == true -> - tc_supervisor_req({get_timetrap_info,TCPid}); + case tc_supervisor_req({get_timetrap_info,TCPid}) of + {TVal,true} -> + {TVal,{true,test_server:timetrap_scale_factor()}}; + {TVal,false} -> + {TVal,{false,1}}; + Error -> + Error + end; [] -> undefined end diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl index c150570604..333c8fc06e 100644 --- a/lib/common_test/src/test_server_gl.erl +++ b/lib/common_test/src/test_server_gl.erl @@ -131,6 +131,10 @@ set_props(GL, PropList) -> %%% Internal functions. init([]) -> + EscChars = case application:get_env(test_server, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, {ok,#st{tc_supervisor=none, minor=none, minor_monitor=none, @@ -139,7 +143,7 @@ init([]) -> permit_io=gb_sets:empty(), auto_nl=true, levels={1,19,10}, - escape_chars=true + escape_chars=EscChars }}. req(GL, Req) -> diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index cd493d293f..4897ddb2f8 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -27,7 +27,8 @@ %%% {port,PortNum}, % optional %%% {username,UserName}, %%% {password,Password}, -%%% {keep_alive,Bool}]}. % optional</pre> +%%% {keep_alive,Bool}, % optional +%%% {tcp_nodely,Bool}]} % optional</pre> %%% %%% <p>To communicate via telnet to the host specified by %%% <code>HostNameOrIpAddress</code>, use the interface functions in @@ -55,7 +56,7 @@ -compile(export_all). %% Callbacks for ct_telnet.erl --export([connect/6,get_prompt_regexp/0]). +-export([connect/7,get_prompt_regexp/0]). -import(ct_telnet,[start_gen_log/1,log/4,end_gen_log/0]). -define(username,"login: "). @@ -82,6 +83,7 @@ get_prompt_regexp() -> %%% Port = integer() %%% Timeout = integer() %%% KeepAlive = bool() +%%% TCPNoDelay = bool() %%% Extra = ct:target_name() | {Username,Password} %%% Username = string() %%% Password = string() @@ -91,25 +93,25 @@ get_prompt_regexp() -> %%% @doc Callback for ct_telnet.erl. %%% %%% <p>Setup telnet connection to a unix host.</p> -connect(ConnName,Ip,Port,Timeout,KeepAlive,Extra) -> +connect(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Extra) -> case Extra of {Username,Password} -> - connect1(ConnName,Ip,Port,Timeout,KeepAlive, + connect1(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay, Username,Password); KeyOrName -> case get_username_and_password(KeyOrName) of {ok,{Username,Password}} -> - connect1(ConnName,Ip,Port,Timeout,KeepAlive, + connect1(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay, Username,Password); Error -> Error end end. -connect1(Name,Ip,Port,Timeout,KeepAlive,Username,Password) -> +connect1(Name,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Username,Password) -> start_gen_log("unix_telnet connect"), Result = - case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,Name) of + case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,TCPNoDelay,Name) of {ok,Pid} -> case ct_telnet:silent_teln_expect(Name,Pid,[], [prompt],?prx,[]) of diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl index a281ddc938..20f139bcc8 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl @@ -1,8 +1,8 @@ -%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
-%%
+%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,46 +14,46 @@ %% 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(ct_update_config_SUITE).
-
--suite_defaults([{timetrap, {minutes, 10}}]).
-
-%% Note: This directive should only be used in test suites.
--compile(export_all).
-
--include("ct.hrl").
-
--define(now, os:timestamp()).
-
-%% Test server callback functions
-init_per_suite(Config) ->
- [{init_per_suite,?now}|Config].
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_testcase(_TestCase, Config) ->
- [{init_per_testcase,?now}|Config].
-
-end_per_testcase(_TestCase, _Config) ->
- ok.
-
-init_per_group(GroupName, Config) ->
- [{init_per_group,?now}|Config].
-
-end_per_group(GroupName, Config) ->
- ok.
-
-all() ->
- [{group,group1}].
-
-groups() ->
- [{group1,[],[test_case]}].
-
-%% Test cases starts here.
-test_case(Config) when is_list(Config) ->
- ok.
+%% +%% %CopyrightEnd% +%% + +-module(ct_update_config_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +-define(now, ct_test_support:unique_timestamp()). + +%% Test server callback functions +init_per_suite(Config) -> + [{init_per_suite,?now}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + [{init_per_testcase,?now}|Config]. + +end_per_testcase(_TestCase, _Config) -> + ok. + +init_per_group(GroupName, Config) -> + [{init_per_group,?now}|Config]. + +end_per_group(GroupName, Config) -> + ok. + +all() -> + [{group,group1}]. + +groups() -> + [{group1,[],[test_case]}]. + +%% Test cases starts here. +test_case(Config) when is_list(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index dc0056b61b..c00eb5cf93 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -90,7 +90,7 @@ id(Opts) -> gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, id, [Opts]}}), ct:log("~w:id called", [?MODULE]), - os:timestamp(). + ct_test_support:unique_timestamp(). %% @doc Called before init_per_suite is called. Note that this callback is %% only called if the CTH is added before init_per_suite is run (eg. in a test diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl index 02f7fa7564..d48981f667 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl @@ -25,7 +25,7 @@ -include_lib("common_test/src/ct_util.hrl"). -include_lib("common_test/include/ct_event.hrl"). --define(now, os:timestamp()). +-define(now, ct_test_support:unique_timestamp()). %% CT Hooks -compile(export_all). diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl index 72c1de4023..03fbc17bd2 100644 --- a/lib/common_test/test/ct_netconfc_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE.erl @@ -48,7 +48,12 @@ init_per_suite(Config) -> {error,Reason} when Reason=/={already_loaded,crypto} -> {skip, Reason}; _ -> - ct_test_support:init_per_suite(Config) + case application:load(ssh) of + {error,Reason} when Reason=/={already_loaded,ssh} -> + {skip, Reason}; + _ -> + ct_test_support:init_per_suite(Config) + end end. end_per_suite(Config) -> diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index e4062a7d62..065639dd36 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -123,15 +123,21 @@ init_per_testcase(_Case, Config) -> end_per_testcase(_Case, _Config) -> ok. +init_per_suite() -> + [{timetrap,2*?default_timeout}]. % making dsa files can be slow init_per_suite(Config) -> - case catch {crypto:start(), ssh:start()} of - {ok, ok} -> + case catch ssh:start() of + Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> + ct:log("ssh started",[]), {ok, _} = netconfc_test_lib:get_id_keys(Config), netconfc_test_lib:make_dsa_files(Config), + ct:log("dsa files created",[]), Server = ?NS:start(?config(data_dir,Config)), + ct:log("netconf server started",[]), [{server,Server}|Config]; - _ -> - {skip, "Crypto and/or SSH could not be started!"} + Other -> + ct:log("could not start ssh: ~p",[Other]), + {skip, "SSH could not be started!"} end. end_per_suite(Config) -> @@ -806,7 +812,7 @@ close_while_waiting_for_chunked_data(Config) -> %% Order server to expect a get - then the process above will make %% sure the rpc-reply is sent - but only a part of it - then close. ?NS:expect('get'), - {error,closed} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]},2000), + {error,closed} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]},4000), ok. connection_crash(Config) -> diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl index ae9087ce45..04bfe75187 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl @@ -26,7 +26,8 @@ -compile(export_all). suite() -> - [{ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}]. + [{timetrap,?default_timeout}, + {ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}]. all() -> case os:find_executable("ssh") of @@ -48,13 +49,10 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Case, Config) -> stop_node(Case), - Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(Case, Config) -> stop_node(Case), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. stop_node(Case) -> @@ -63,14 +61,19 @@ stop_node(Case) -> rpc:call(Node,erlang,halt,[]). +init_per_suite() -> + [{timetrap,2*?default_timeout}]. % making dsa files can be slow init_per_suite(Config) -> - case {crypto:start(),ssh:start()} of - {ok,ok} -> + case ssh:start() of + Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> + ct:log("SSH started locally",[]), {ok, _} = netconfc_test_lib:get_id_keys(Config), netconfc_test_lib:make_dsa_files(Config), + ct:log("dsa files created",[]), Config; - _ -> - {skip, "Crypto and/or SSH could not be started locally!"} + Other -> + ct:log("could not start ssh locally: ~p",[Other]), + {skip, "SSH could not be started locally!"} end. end_per_suite(Config) -> @@ -87,12 +90,15 @@ remote_crash(Config) -> Pa = filename:dirname(code:which(?NS)), true = rpc:call(Node,code,add_patha,[Pa]), - case {rpc:call(Node,crypto,start,[]),rpc:call(Node,ssh,start,[])} of - {ok,ok} -> + case rpc:call(Node,ssh,start,[]) of + Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> + ct:log("SSH started remote",[]), Server = rpc:call(Node,?NS,start,[?config(data_dir,Config)]), + ct:log("netconf server started remote",[]), remote_crash(Node,Config); - _ -> - {skip, "Crypto and/or SSH could not be started remote!"} + Other -> + ct:log("could not start ssh remote: ~p",[Other]), + {skip, "SSH could not be started remote!"} end. remote_crash(Node,Config) -> diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl index 74ef3a26ce..7ffe6f045b 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -44,13 +44,29 @@ %% instance, the tests need to be performed on a separate node (or %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,120}}]. + +all() -> + [ + pre_post_io + ]. + init_per_suite(Config) -> - DataDir = ?config(data_dir, Config), - CTH = filename:join(DataDir, "cth_ctrl.erl"), - ct:pal("Compiling ~p: ~p", - [CTH,compile:file(CTH,[{outdir,DataDir},debug_info])]), - ct_test_support:init_per_suite([{path_dirs,[DataDir]}, - {start_sasl,true} | Config]). + TTInfo = {_T,{_Scaled,ScaleVal}} = ct:get_timetrap_info(), + ct:pal("Timetrap info = ~w", [TTInfo]), + if ScaleVal > 1 -> + {skip,"Skip on systems running e.g. cover or debug!"}; + ScaleVal =< 1 -> + DataDir = ?config(data_dir, Config), + CTH = filename:join(DataDir, "cth_ctrl.erl"), + ct:pal("Compiling ~p: ~p", + [CTH,compile:file(CTH,[{outdir,DataDir}, + debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}, + {start_sasl,true} | Config]) + end. end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -61,13 +77,6 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [ - pre_post_io - ]. - %%-------------------------------------------------------------------- %% TEST CASES %%-------------------------------------------------------------------- @@ -90,31 +99,50 @@ pre_post_io(Config) -> %%!-------------------------------------------------------------------- spawn(fun() -> - ct:pal("CONTROLLER: Started!", []), + ct:pal("CONTROLLER: Starting test run #1...", []), %% --- test run 1 --- - ct:sleep(3000), - ct:pal("CONTROLLER: Handle remote events = true", []), - ok = ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - ct:pal("CONTROLLER: Proceeding with test run #1!", []), + try_loop(ct_test_support, ct_rpc, [{cth_log_redirect, + handle_remote_events, + [true]}, Config], 3000), + CTLoggerPid1 = ct_test_support:ct_rpc({erlang,whereis, + [ct_logs]}, Config), + ct:pal("CONTROLLER: Logger = ~w~nHandle remote events = true", + [CTLoggerPid1]), + ct:sleep(5000), + ct:pal("CONTROLLER: Proceeding with test run #1...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), ct:sleep(6000), - ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), + ct:pal("CONTROLLER: Proceeding with shutdown #1...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + try_loop(fun() -> + false = ct_test_support:ct_rpc({erlang, + is_process_alive, + [CTLoggerPid1]}, + Config) + end, 3000), + ct:pal("CONTROLLER: Shutdown #1 complete!", []), + ct:pal("CONTROLLER: Starting test run #2...", []), %% --- test run 2 --- - ct:sleep(3000), - ct:pal("CONTROLLER: Handle remote events = true", []), - ok = ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - ct:pal("CONTROLLER: Proceeding with test run #2!", []), + try_loop(ct_test_support, ct_rpc, [{cth_log_redirect, + handle_remote_events, + [true]}, Config], 3000), + CTLoggerPid2 = ct_test_support:ct_rpc({erlang,whereis, + [ct_logs]}, Config), + ct:pal("CONTROLLER: Logger = ~w~nHandle remote events = true", + [CTLoggerPid2]), + ct:sleep(5000), + ct:pal("CONTROLLER: Proceeding with test run #2...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), ct:sleep(6000), - ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), - ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) + ct:pal("CONTROLLER: Proceeding with shutdown #2...", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + try_loop(fun() -> + false = ct_test_support:ct_rpc({erlang, + is_process_alive, + [CTLoggerPid2]}, + Config) + end, 3000), + ct:pal("CONTROLLER: Shutdown #2 complete!", []) end), ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), @@ -157,7 +185,7 @@ pre_post_io(Config) -> Counters end, {pre,0,0,0,0}, Ts), [_|Counters] = tuple_to_list(PrePostIOEntries), - ct:log("Entries in the Pre/Post Test IO Log: ~p", [Counters]), + ct:pal("Entries in the Pre/Post Test IO Log: ~w", [Counters]), case [C || C <- Counters, C < 2] of [] -> ok; @@ -183,7 +211,7 @@ pre_post_io(Config) -> [LogN,ErrN+1]; (_, Counters) -> Counters end, [0,0], Ts), - ct:log("Entries in the Unexpected IO Log: ~p", [UnexpIOEntries]), + ct:log("Entries in the Unexpected IO Log: ~w", [UnexpIOEntries]), case [N || N <- UnexpIOEntries, N < 2] of [] -> ok; @@ -208,6 +236,38 @@ setup(Test, Config) -> reformat(Events, EH) -> ct_test_support:reformat(Events, EH). +try_loop(_Fun, 0) -> + ct:pal("WARNING! Fun never succeeded!", []), + gave_up; +try_loop(Fun, N) -> + try Fun() of + {error,_} -> + timer:sleep(10), + try_loop(Fun, N-1); + Result -> + Result + catch + _:_What -> + timer:sleep(10), + try_loop(Fun, N-1) + end. + +try_loop(M, F, _A, 0) -> + ct:pal("WARNING! ~w:~w never succeeded!", [M,F]), + gave_up; +try_loop(M, F, A, N) -> + try apply(M, F, A) of + {error,_} -> + timer:sleep(10), + try_loop(M, F, A, N-1); + Result -> + Result + catch + _:_ -> + timer:sleep(10), + try_loop(M, F, A, N-1) + end. + %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl index cb0c5ed14e..347b507c78 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl @@ -53,8 +53,7 @@ init(_Id, _Opts) -> receive {?MODULE,proceed} -> ok after - 10000 -> - ok + 10000 -> ok end, {ok,[],ct_last}. @@ -66,8 +65,7 @@ terminate(_State) -> receive {?MODULE,proceed} -> ok after - 10000 -> - ok + 10000 -> ok end, stop_external_logger(cth_logger), stop_dispatcher(), @@ -94,7 +92,7 @@ init_logger(Name) -> logger_loop(N) -> ct:log("Logger iteration: ~p", [N]), error_logger:error_report(N), - timer:sleep(250), + timer:sleep(100), logger_loop(N+1). %%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index a39a3887f7..42ec685c16 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -49,8 +49,11 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + DataDir = ?config(data_dir,Config), + Hook = "fail_pre_init_per_suite.erl", + io:format("Compiling ~p: ~p~n", + [Hook, compile:file(Hook,[{outdir,DataDir},debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}|Config]). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -69,7 +72,8 @@ all() -> absolute_path, relative_path, url, - logdir + logdir, + fail_pre_init_per_suite ]. %%-------------------------------------------------------------------- @@ -107,6 +111,14 @@ logdir(Config) when is_list(Config) -> Path = "logdir.xml", run(logdir,[{cth_surefire,[{path,Path}]}],Path,Config,[{logdir,MyLogDir}]). +fail_pre_init_per_suite(Config) when is_list(Config) -> + DataDir = ?config(data_dir,Config), + Suites = [filename:join(DataDir,"pass_SUITE"), + filename:join(DataDir,"fail_SUITE")], + Path = "fail_pre_init_per_suite.xml", + run(fail_pre_init_per_suite,[fail_pre_init_per_suite, + {cth_surefire,[{path,Path}]}],Path,Config,[],Suites). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -115,6 +127,8 @@ run(Case,CTHs,Report,Config) -> run(Case,CTHs,Report,Config,ExtraOpts) -> DataDir = ?config(data_dir, Config), Suite = filename:join(DataDir, "surefire_SUITE"), + run(Case,CTHs,Report,Config,ExtraOpts,Suite). +run(Case,CTHs,Report,Config,ExtraOpts,Suite) -> {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], Config), ok = execute(Case, Opts, ERPid, Config), @@ -142,7 +156,6 @@ setup(Test, Config) -> execute(Name, Opts, ERPid, Config) -> ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Name, reformat(Events, ?eh), ?config(priv_dir, Config), @@ -166,10 +179,30 @@ events_to_check(_, 0) -> events_to_check(Test, N) -> test_events(Test) ++ events_to_check(Test, N-1). -test_events(_) -> - [{?eh,start_logging,'_'}, - {?eh,start_info,{1,1,9}}, - {?eh,tc_start,{surefire_SUITE,init_per_suite}}, +test_suite_events(fail_SUITE, TestStat) -> + [{?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,tc_done,{ct_framework,init_per_suite, + {failed,{error,pre_init_per_suite}}}}, + {?eh,tc_auto_skip, + {fail_SUITE,test_case, + {failed,{ct_framework,init_per_suite,{failed,pre_init_per_suite}}}}}, + {?eh,test_stats,TestStat}, + {?eh,tc_auto_skip, + {ct_framework,end_per_suite, + {failed,{ct_framework,init_per_suite,{failed,pre_init_per_suite}}}}}]. + +test_suite_events(fail_SUITE) -> + test_suite_events(fail_SUITE, {0,0,{0,1}}); +test_suite_events(pass_SUITE) -> + [{?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{pass_SUITE,test_case}}, + {?eh,tc_done,{pass_SUITE,test_case,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}]; +test_suite_events(_) -> + [{?eh,tc_start,{surefire_SUITE,init_per_suite}}, {?eh,tc_done,{surefire_SUITE,init_per_suite,ok}}, {?eh,tc_start,{surefire_SUITE,tc_ok}}, {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, @@ -216,9 +249,18 @@ test_events(_) -> {surefire_SUITE,init_per_group, {'EXIT',all_cases_should_be_skipped}}}}}], {?eh,tc_start,{surefire_SUITE,end_per_suite}}, - {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}, - {?eh,stop_logging,[]}]. - + {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + +test_events(fail_pre_init_per_suite) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,start_info,{2,2,2}}] ++ + test_suite_events(pass_SUITE) ++ + test_suite_events(fail_SUITE, {1,0,{0,1}}) ++ + [{?eh,stop_logging,[]}]; +test_events(Test) -> + [{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++ + test_suite_events(Test) ++ + [{?eh,stop_logging,[]}]. %%%----------------------------------------------------------------- %%% Check generated xml log files @@ -251,9 +293,9 @@ do_check_xml(Case,[Xml|Xmls]) -> {E,_} = xmerl_scan:file(Xml), Expected = events_to_result(lists:flatten(test_events(Case))), ParseResult = testsuites(Case,E), - ct:log("Expecting: ~p~n",[[Expected]]), + ct:log("Expecting: ~p~n",[Expected]), ct:log("Actual : ~p~n",[ParseResult]), - [Expected] = ParseResult, + Expected = ParseResult, do_check_xml(Case,Xmls); do_check_xml(_,[]) -> ok. @@ -265,7 +307,8 @@ testsuites(Case,#xmlElement{name=testsuites,content=TS}) -> testsuite(Case,TS). testsuite(Case,[#xmlElement{name=testsuite,content=TC,attributes=A}|TS]) -> - {ET,EF,ES} = events_to_numbers(lists:flatten(test_events(Case))), + TestSuiteEvents = test_suite_events(get_ts_name(A)), + {ET,EF,ES} = events_to_numbers(lists:flatten(TestSuiteEvents)), {T,E,F,S} = get_numbers_from_attrs(A,false,false,false,false), ct:log("Expecting total:~p, error:~p, failure:~p, skipped:~p~n",[ET,0,EF,ES]), ct:log("Actual total:~p, error:~p, failure:~p, skipped:~p~n",[T,E,F,S]), @@ -318,14 +361,32 @@ failed_or_skipped([]) -> %% Testsuites = [Testsuite] %% Testsuite = [Testcase] %% Testcase = [] | [f] | [s], indicating ok, failed and skipped respectively -events_to_result([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> - [result(R)|events_to_result(E)]; -events_to_result([{?eh,tc_auto_skip,_}|E]) -> - [[s]|events_to_result(E)]; -events_to_result([_|E]) -> - events_to_result(E); -events_to_result([]) -> - []. +events_to_result(E) -> + events_to_result(E, []). + +events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) -> + {Suite,Rest} = events_to_result1(E), + events_to_result(Rest, [[[s]|Suite]|Result]); +events_to_result([{?eh,tc_done,{_Suite,init_per_suite,R}}|E], Result) -> + {Suite,Rest} = events_to_result1(E), + events_to_result(Rest, [[result(R)|Suite]|Result]); +events_to_result([_|E], Result) -> + events_to_result(E, Result); +events_to_result([], Result) -> + Result. + +events_to_result1([{?eh,tc_auto_skip,{_Suite, end_per_suite,_}}|E]) -> + {[[s]],E}; +events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) -> + {[result(R)],E}; +events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> + {Suite,Rest} = events_to_result1(E), + {[result(R)|Suite],Rest}; +events_to_result1([{?eh,tc_auto_skip,_}|E]) -> + {Suite,Rest} = events_to_result1(E), + {[[s]|Suite],Rest}; +events_to_result1([_|E]) -> + events_to_result1(E). result(ok) ->[]; result({skipped,_}) -> [s]; @@ -374,3 +435,7 @@ del_files(Dir,[F0|Fs] ) -> end; del_files(_,[]) -> ok. + +get_ts_name(Attributes) -> + {_,name,_,_,_,_,_,_,Name,_} = lists:keyfind(name, 2, Attributes), + list_to_atom(Name). diff --git a/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl new file mode 100644 index 0000000000..3f5f42c054 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl @@ -0,0 +1,28 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(fail_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, test_case/1]). + +all() -> + [test_case]. + +test_case(_Config) -> + ok. diff --git a/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl b/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl new file mode 100644 index 0000000000..ff278db378 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% This tests that the correct XML is produced when pre_init_per_suite +%%% fails in a hook +-module(fail_pre_init_per_suite). + +%% CT Hooks +-export([init/2, pre_init_per_suite/3]). + +-type config() :: proplists:proplist(). +-type reason() :: term(). +-type skip_or_fail() :: skip | auto_skip | fail | 'EXIT'. + +-record(state, {}). + +-spec init(Id :: term(), Opts :: proplists:proplist()) -> + {ok, proplists:proplist()}. +init(_Id, Opts) -> + {ok, Opts}. + +-spec pre_init_per_suite(Suite :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | {skip_or_fail(), reason()}, NewState :: #state{}}. +pre_init_per_suite(fail_SUITE, _Config, State) -> + {{fail, pre_init_per_suite}, State}; +pre_init_per_suite(_Suite, Config, State) -> + {Config, State}. + diff --git a/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl new file mode 100644 index 0000000000..74ed5b730e --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl @@ -0,0 +1,28 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(pass_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, test_case/1]). + +all() -> + [test_case]. + +test_case(_Config) -> + ok. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 51ca691d69..477fcb8a26 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -43,6 +43,8 @@ -export([random_error/1]). +-export([unique_timestamp/0]). + -include_lib("kernel/include/file.hrl"). %%%----------------------------------------------------------------- @@ -110,7 +112,8 @@ start_slave(NodeName, Config, Level) -> undefined -> []; Ds -> Ds end, - PathDirs = [PrivDir,TSDir | AddPathDirs], + TestSupDir = filename:dirname(code:which(?MODULE)), + PathDirs = [PrivDir,TSDir,TestSupDir | AddPathDirs], [true = rpc:call(CTNode, code, add_patha, [D]) || D <- PathDirs], test_server:format(Level, "Dirs added to code path (on ~w):~n", [CTNode]), @@ -1430,7 +1433,21 @@ rm_files([F | Fs]) -> end; rm_files([]) -> ok. - + +unique_timestamp() -> + unique_timestamp(os:timestamp(), 100000). + +unique_timestamp(TS, 0) -> + TS; +unique_timestamp(TS0, N) -> + case os:timestamp() of + TS0 -> + timer:sleep(1), + unique_timestamp(TS0, N-1); + TS1 -> + TS1 + end. + %%%----------------------------------------------------------------- %%% slave_stop(Node) -> diff --git a/lib/dialyzer/README b/lib/dialyzer/README index 82d0f5ec48..951a92469b 100644 --- a/lib/dialyzer/README +++ b/lib/dialyzer/README @@ -6,7 +6,7 @@ ## Copyright: Held by the authors; all rights reserved (2004 - 2010). ##---------------------------------------------------------------------------- -The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. +The DIALYZER, a DIscrepancy AnaLYZer for ERlang programs. ----------------------------------------------- diff --git a/lib/dialyzer/doc/about.txt b/lib/dialyzer/doc/about.txt index 7d9d819731..1318d9a65e 100644 --- a/lib/dialyzer/doc/about.txt +++ b/lib/dialyzer/doc/about.txt @@ -1,5 +1,5 @@ This is DIALYZER version 2.1.0 - DIALYZER is a DIscrepany AnaLYZer for ERlang programs. + DIALYZER is a DIscrepancy AnaLYZer for ERlang programs. Copyright (C) Tobias Lindahl <[email protected]> Kostis Sagonas <[email protected]> diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index 29c9518d84..be1fd2f8bc 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -4,7 +4,7 @@ ## Kostis Sagonas <[email protected]> ##---------------------------------------------------------------------------- -The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. +The DIALYZER, a DIscrepancy AnaLYZer for ERlang programs. ----------------------------------------------- diff --git a/lib/dialyzer/info b/lib/dialyzer/info index 9fba4b54ad..b9ea26b712 100644 --- a/lib/dialyzer/info +++ b/lib/dialyzer/info @@ -1,2 +1,2 @@ group: tools -short: The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. +short: The DIALYZER, a DIscrepancy AnaLYZer for ERlang programs. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 1895a98e96..116260778c 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -210,10 +210,10 @@ check_contract(Contract, SuccType) -> check_contract(#contract{contracts = Contracts}, SuccType, Opaques) -> try - Contracts1 = [{Contract, insert_constraints(Constraints, dict:new())} + Contracts1 = [{Contract, insert_constraints(Constraints)} || {Contract, Constraints} <- Contracts], - Contracts2 = [erl_types:t_subst(Contract, Dict) - || {Contract, Dict} <- Contracts1], + Contracts2 = [erl_types:t_subst(Contract, Map) + || {Contract, Map} <- Contracts1], GenDomains = [erl_types:t_fun_args(C) || C <- Contracts2], case check_domains(GenDomains) of error -> @@ -344,15 +344,15 @@ process_contract({Contract, Constraints}, CallTypes0) -> [erl_types:t_to_string(ContArgsFun), erl_types:t_to_string(CallTypesFun)]), case solve_constraints(ContArgsFun, CallTypesFun, Constraints) of - {ok, VarDict} -> - {ok, erl_types:t_subst(erl_types:t_fun_range(Contract), VarDict)}; + {ok, VarMap} -> + {ok, erl_types:t_subst(erl_types:t_fun_range(Contract), VarMap)}; error -> error end. solve_constraints(Contract, Call, Constraints) -> %% First make sure the call follows the constraints - CDict = insert_constraints(Constraints, dict:new()), - Contract1 = erl_types:t_subst(Contract, CDict), + CMap = insert_constraints(Constraints), + Contract1 = erl_types:t_subst(Contract, CMap), %% Just a safe over-approximation. %% TODO: Find the types for type variables properly ContrArgs = erl_types:t_fun_args(Contract1), @@ -360,7 +360,7 @@ solve_constraints(Contract, Call, Constraints) -> InfList = erl_types:t_inf_lists(ContrArgs, CallArgs), case erl_types:any_none_or_unit(InfList) of true -> error; - false -> {ok, CDict} + false -> {ok, CMap} end. %%Inf = erl_types:t_inf(Contract1, Call), %% Then unify with the constrained call type. @@ -390,23 +390,26 @@ warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> {?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}. %% This treats the "when" constraints. It will be extended, we hope. -insert_constraints([{subtype, Type1, Type2}|Left], Dict) -> +insert_constraints(Constraints) -> + insert_constraints(Constraints, maps:new()). + +insert_constraints([{subtype, Type1, Type2}|Left], Map) -> case erl_types:t_is_var(Type1) of true -> Name = erl_types:t_var_name(Type1), - Dict1 = case dict:find(Name, Dict) of - error -> - dict:store(Name, Type2, Dict); - {ok, VarType} -> - dict:store(Name, erl_types:t_inf(VarType, Type2), Dict) - end, - insert_constraints(Left, Dict1); + Map1 = case maps:find(Name, Map) of + error -> + maps:put(Name, Type2, Map); + {ok, VarType} -> + maps:put(Name, erl_types:t_inf(VarType, Type2), Map) + end, + insert_constraints(Left, Map1); false -> %% A lot of things should change to add supertypes throw({error, io_lib:format("First argument of is_subtype constraint " "must be a type variable: ~p\n", [Type1])}) end; -insert_constraints([], Dict) -> Dict. +insert_constraints([], Map) -> Map. -type types() :: erl_types:type_table(). @@ -476,7 +479,7 @@ initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, Acc) -> initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> - T1 = final_form(Type1, ExpTypes, MFA, AllRecords, dict:new()), + T1 = final_form(Type1, ExpTypes, MFA, AllRecords, maps:new()), Entry = {T1, Type2}, initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, [Entry|Acc]); {type, _, constraint, [{atom,_,Name}, List]} -> @@ -487,7 +490,7 @@ initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) - constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> VarDict = - constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, dict:new()), + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, maps:new()), constraints_fixpoint(VarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords). constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) -> @@ -499,7 +502,7 @@ constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) -> fun(Key, Value, Acc) -> [{subtype, erl_types:t_var(Key), Value}|Acc] end, - FinalConstrs = dict:fold(DictFold, [], NewVarDict), + FinalConstrs = maps:fold(DictFold, [], NewVarDict), {FinalConstrs, NewVarDict}; _Other -> constraints_fixpoint(NewVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) @@ -509,7 +512,7 @@ final_form(Form, ExpTypes, MFA, AllRecords, VarDict) -> from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict). from_form_with_check(Form, ExpTypes, MFA, AllRecords) -> - from_form_with_check(Form, ExpTypes, MFA, AllRecords, dict:new()). + from_form_with_check(Form, ExpTypes, MFA, AllRecords, maps:new()). from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) -> Site = {spec, MFA}, @@ -520,7 +523,7 @@ from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) -> constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict) -> Subtypes = constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict, []), - insert_constraints(Subtypes, dict:new()). + insert_constraints(Subtypes). constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> Acc; @@ -605,8 +608,8 @@ general_domain(List) -> general_domain(List, erl_types:t_none()). general_domain([{Sig, Constraints}|Left], AccSig) -> - Dict = insert_constraints(Constraints, dict:new()), - Sig1 = erl_types:t_subst(Sig, Dict), + Map = insert_constraints(Constraints), + Sig1 = erl_types:t_subst(Sig, Map), general_domain(Left, erl_types:t_sup(AccSig, Sig1)); general_domain([], AccSig) -> %% Get rid of all variables in the domain. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index f0fa9fbb4e..5ab0c39c04 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,7 +43,6 @@ -include("dialyzer.hrl"). -%%-import(helper, %% 'helper' could be any module doing sanity checks... -import(erl_types, [t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, t_inf_lists/3, t_is_equal/2, t_is_subtype/2, t_subtract/2, @@ -126,8 +125,8 @@ curr_fun :: curr_fun() }). --record(map, {dict = dict:new() :: type_tab(), - subst = dict:new() :: subst_tab(), +-record(map, {map = maps:new() :: type_tab(), + subst = maps:new() :: subst_tab(), modified = [] :: [Key :: term()], modified_stack = [] :: [{[Key :: term()],reference()}], ref = undefined :: reference() | undefined}). @@ -135,10 +134,10 @@ -type env_tab() :: dict:dict(label(), #map{}). -type fun_entry() :: {Args :: [type()], RetType :: type()}. -type fun_tab() :: dict:dict('top' | label(), - {'not_handled', fun_entry()} | fun_entry()). + {'not_handled', fun_entry()} | fun_entry()). -type key() :: label() | cerl:cerl(). --type type_tab() :: dict:dict(key(), type()). --type subst_tab() :: dict:dict(key(), cerl:cerl()). +-type type_tab() :: #{key() => type()}. +-type subst_tab() :: #{key() => cerl:cerl()}. %% Exported Types @@ -1766,7 +1765,7 @@ bind_opaque_pats(GenType, Type, Pat, State) -> %% bind_guard(Guard, Map, State) -> - try bind_guard(Guard, Map, dict:new(), pos, State) of + try bind_guard(Guard, Map, maps:new(), pos, State) of {Map1, _Type} -> Map1 catch throw:{fail, Warning} -> {error, Warning}; @@ -1804,7 +1803,7 @@ bind_guard(Guard, Map, Env, Eval, State) -> catch throw:HE -> {{Map2, t_none()}, HE} end, - BodyEnv = dict:store(get_label(Var), Arg, Env), + BodyEnv = maps:put(get_label(Var), Arg, Env), Wanted = case Eval of pos -> t_atom(true); neg -> t_atom(false); dont_know -> t_any() end, case t_is_none(t_inf(HandlerType, Wanted)) of @@ -1850,7 +1849,7 @@ bind_guard(Guard, Map, Env, Eval, State) -> Arg = cerl:let_arg(Guard), [Var] = cerl:let_vars(Guard), %%?debug("Storing: ~w\n", [Var]), - NewEnv = dict:store(get_label(Var), Arg, Env), + NewEnv = maps:put(get_label(Var), Arg, Env), bind_guard(cerl:let_body(Guard), Map, NewEnv, Eval, State); values -> Es = cerl:values_es(Guard), @@ -1859,7 +1858,7 @@ bind_guard(Guard, Map, Env, Eval, State) -> {Map, Type}; var -> ?debug("Looking for var(~w)...", [cerl_trees:get_label(Guard)]), - case dict:find(get_label(Guard), Env) of + case maps:find(get_label(Guard), Env) of error -> ?debug("Did not find it\n", []), Type = lookup_type(Guard, Map), @@ -2689,10 +2688,10 @@ join_maps_end(Maps, MapOut) -> #map{ref = Ref, modified_stack = [{M1,R1} | S]} = MapOut, true = lists:all(fun(M) -> M#map.ref =:= Ref end, Maps), % sanity Keys0 = lists:usort(lists:append([M#map.modified || M <- Maps])), - #map{dict = Dict, subst = Subst} = MapOut, + #map{map = Map, subst = Subst} = MapOut, Keys = [Key || Key <- Keys0, - dict:is_key(Key, Dict) orelse dict:is_key(Key, Subst)], + maps:is_key(Key, Map) orelse maps:is_key(Key, Subst)], Out = case Maps of [] -> join_maps(Maps, MapOut); _ -> join_maps(Keys, Maps, MapOut) @@ -2703,8 +2702,8 @@ join_maps_end(Maps, MapOut) -> modified_stack = S}. join_maps(Maps, MapOut) -> - #map{dict = Dict, subst = Subst} = MapOut, - Keys = ordsets:from_list(dict:fetch_keys(Dict) ++ dict:fetch_keys(Subst)), + #map{map = Map, subst = Subst} = MapOut, + Keys = ordsets:from_list(maps:keys(Map) ++ maps:keys(Subst)), join_maps(Keys, Maps, MapOut). join_maps(Keys, Maps, MapOut) -> @@ -2733,11 +2732,11 @@ join_maps_one_key([], _Key, AccType) -> -ifdef(DEBUG). debug_join_check(Maps, MapOut, Out) -> - #map{dict = Dict, subst = Subst} = Out, - #map{dict = Dict2, subst = Subst2} = join_maps(Maps, MapOut), - F = fun(D) -> lists:keysort(1, dict:to_list(D)) end, + #map{map = Map, subst = Subst} = Out, + #map{map = Map2, subst = Subst2} = join_maps(Maps, MapOut), + F = fun(D) -> lists:keysort(1, maps:to_list(D)) end, [throw({bug, join_maps}) || - F(Dict) =/= F(Dict2) orelse F(Subst) =/= F(Subst2)]. + F(Map) =/= F(Map2) orelse F(Subst) =/= F(Subst2)]. -else. debug_join_check(_Maps, _MapOut, _Out) -> ok. -endif. @@ -2768,15 +2767,15 @@ enter_type(Key, Val, MS) -> enter_type_lists(Keys, t_to_tlist(Val), MS) end; false -> - #map{dict = Dict, subst = Subst} = MS, + #map{map = Map, subst = Subst} = MS, KeyLabel = get_label(Key), - case dict:find(KeyLabel, Subst) of + case maps:find(KeyLabel, Subst) of {ok, NewKey} -> ?debug("Binding ~p to ~p\n", [KeyLabel, NewKey]), enter_type(NewKey, Val, MS); error -> ?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]), - case dict:find(KeyLabel, Dict) of + case maps:find(KeyLabel, Map) of {ok, Value} -> case erl_types:t_is_equal(Val, Value) of true -> MS; @@ -2788,10 +2787,10 @@ enter_type(Key, Val, MS) -> end end. -store_map(Key, Val, #map{dict = Dict, ref = undefined} = Map) -> - Map#map{dict = dict:store(Key, Val, Dict)}; -store_map(Key, Val, #map{dict = Dict, modified = Mod} = Map) -> - Map#map{dict = dict:store(Key, Val, Dict), modified = [Key | Mod]}. +store_map(Key, Val, #map{map = Map, ref = undefined} = MapRec) -> + MapRec#map{map = maps:put(Key, Val, Map)}; +store_map(Key, Val, #map{map = Map, modified = Mod} = MapRec) -> + MapRec#map{map = maps:put(Key, Val, Map), modified = [Key | Mod]}. enter_subst(Key, Val0, #map{subst = Subst} = MS) -> KeyLabel = get_label(Key), @@ -2804,7 +2803,7 @@ enter_subst(Key, Val0, #map{subst = Subst} = MS) -> false -> MS; true -> ValLabel = get_label(Val), - case dict:find(ValLabel, Subst) of + case maps:find(ValLabel, Subst) of {ok, NewVal} -> enter_subst(Key, NewVal, MS); error -> @@ -2818,22 +2817,22 @@ enter_subst(Key, Val0, #map{subst = Subst} = MS) -> end. store_subst(Key, Val, #map{subst = S, ref = undefined} = Map) -> - Map#map{subst = dict:store(Key, Val, S)}; + Map#map{subst = maps:put(Key, Val, S)}; store_subst(Key, Val, #map{subst = S, modified = Mod} = Map) -> - Map#map{subst = dict:store(Key, Val, S), modified = [Key | Mod]}. + Map#map{subst = maps:put(Key, Val, S), modified = [Key | Mod]}. -lookup_type(Key, #map{dict = Dict, subst = Subst}) -> - lookup(Key, Dict, Subst, t_none()). +lookup_type(Key, #map{map = Map, subst = Subst}) -> + lookup(Key, Map, Subst, t_none()). -lookup(Key, Dict, Subst, AnyNone) -> +lookup(Key, Map, Subst, AnyNone) -> case cerl:is_literal(Key) of true -> literal_type(Key); false -> Label = get_label(Key), - case dict:find(Label, Subst) of - {ok, NewKey} -> lookup(NewKey, Dict, Subst, AnyNone); + case maps:find(Label, Subst) of + {ok, NewKey} -> lookup(NewKey, Map, Subst, AnyNone); error -> - case dict:find(Label, Dict) of + case maps:find(Label, Map) of {ok, Val} -> Val; error -> AnyNone end @@ -2871,12 +2870,12 @@ mark_as_fresh([], Map) -> Map. -ifdef(DEBUG). -debug_pp_map(#map{dict = Dict}=Map) -> - Keys = dict:fetch_keys(Dict), +debug_pp_map(#map{map = Map}=MapRec) -> + Keys = maps:keys(Map), io:format("Map:\n", []), lists:foreach(fun (Key) -> io:format("\t~w :: ~s\n", - [Key, t_to_string(lookup_type(Key, Map))]) + [Key, t_to_string(lookup_type(Key, MapRec))]) end, Keys), ok. -else. diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 9f344d87ff..30d2bdeca4 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -422,7 +422,7 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, #wx{id=?menuID_HELP_ABOUT, obj=Frame, event=#wxCommand{type=command_menu_selected}} -> Message = " This is DIALYZER version " ++ ?VSN ++ " \n"++ - "DIALYZER is a DIscrepany AnaLYZer for ERlang programs.\n\n"++ + "DIALYZER is a DIscrepancy AnaLYZer for ERlang programs.\n\n"++ " Copyright (C) Tobias Lindahl <[email protected]>\n"++ " Kostis Sagonas <[email protected]>\n\n", output_sms(State, "About Dialyzer", Message, info), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 50fcbc555b..1787b66192 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -66,9 +66,11 @@ %%----------------------------------------------------------------------------- -type dep() :: integer(). %% type variable names used as constraint ids +-type deps() :: ordsets:ordset(dep()). + -type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_} --record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()], +-record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: deps(), origin :: integer() | 'undefined'}). -type constr_op() :: 'eq' | 'sub'. @@ -77,20 +79,21 @@ -record(constraint, {lhs :: erl_types:erl_type(), op :: constr_op(), rhs :: fvar_or_type(), - deps :: [dep()]}). + deps :: deps()}). -type constraint() :: #constraint{}. +-type mask() :: ordsets:ordset(non_neg_integer()). + -record(constraint_list, {type :: 'conj' | 'disj', list :: [constr()], - deps :: [dep()], - masks = [] :: [{dep(),[non_neg_integer()]}] | - {'d',dict:dict(dep(), [non_neg_integer()])}, + deps :: deps(), + masks = maps:new() :: #{dep() => mask()}, id :: {'list', dep()} | 'undefined'}). -type constraint_list() :: #constraint_list{}. --record(constraint_ref, {id :: type_var(), deps :: [dep()]}). +-record(constraint_ref, {id :: type_var(), deps :: deps()}). -type constraint_ref() :: #constraint_ref{}. @@ -99,32 +102,29 @@ -type types() :: erl_types:type_table(). -type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}]. --type typesig_funmap() :: [{type_var(), type_var()}]. %% Orddict +-type typesig_funmap() :: #{type_var() => type_var()}. -type prop_types() :: dict:dict(label(), types()). --type dict_or_ets() :: {'d', prop_types()} | {'e', ets:tid()}. - --record(state, {callgraph :: dialyzer_callgraph:callgraph() - | 'undefined', - cs = [] :: [constr()], - cmap = {'d', dict:new()} :: dict_or_ets(), - fun_map = [] :: typesig_funmap(), - fun_arities = dict:new() :: dict:dict(type_var(), arity()), - in_match = false :: boolean(), - in_guard = false :: boolean(), - module :: module(), - name_map = dict:new() :: dict:dict(mfa(), - cerl:c_fun()), - next_label = 0 :: label(), - self_rec :: 'false' | erl_types:erl_type(), - plt :: dialyzer_plt:plt() - | 'undefined', - prop_types = {'d', dict:new()} :: dict_or_ets(), - records = dict:new() :: types(), - scc = [] :: [type_var()], - mfas :: [tuple()], - solvers = [] :: [solver()] +-record(state, {callgraph :: dialyzer_callgraph:callgraph() + | 'undefined', + cs = [] :: [constr()], + cmap = maps:new() :: #{type_var() => constr()}, + fun_map = maps:new() :: typesig_funmap(), + fun_arities = maps:new() :: #{type_var() => arity()}, + in_match = false :: boolean(), + in_guard = false :: boolean(), + module :: module(), + name_map = maps:new() :: #{mfa() => cerl:c_fun()}, + next_label = 0 :: label(), + self_rec :: 'false' | erl_types:erl_type(), + plt :: dialyzer_plt:plt() + | 'undefined', + prop_types = dict:new() :: prop_types(), + records = dict:new() :: types(), + scc = [] :: ordsets:ordset(type_var()), + mfas :: [mfa()], + solvers = [] :: [solver()] }). -type state() :: #state{}. @@ -190,7 +190,8 @@ analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) -> Funs = state__scc(State3), pp_constrs_scc(Funs, State3), constraints_to_dot_scc(Funs, State3), - solve(Funs, State3). + T = solve(Funs, State3), + dict:from_list(maps:to_list(T)). assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) -> assert_format_of_scc(Left); @@ -944,11 +945,11 @@ get_safe_underapprox(Pats, Guard) -> Map1 = cerl_trees:fold(fun(X, Acc) -> case cerl:is_c_var(X) of true -> - dict:store(cerl_trees:get_label(X), t_any(), - Acc); + maps:put(cerl_trees:get_label(X), t_any(), + Acc); false -> Acc end - end, dict:new(), cerl:c_values(Pats)), + end, maps:new(), cerl:c_values(Pats)), {Type, Map2} = get_underapprox_from_guard(Guard, Map1), Map3 = case t_is_none(t_inf(t_from_term(true), Type)) of true -> throw(dont_know); @@ -956,8 +957,8 @@ get_safe_underapprox(Pats, Guard) -> case cerl:is_c_var(Guard) of false -> Map2; true -> - dict:store(cerl_trees:get_label(Guard), - t_from_term(true), Map2) + maps:put(cerl_trees:get_label(Guard), + t_from_term(true), Map2) end end, {Ts, _Map4} = get_safe_underapprox_1(Pats, [], Map3), @@ -983,7 +984,7 @@ get_underapprox_from_guard(Tree, Map) -> case t_is_none(Inf) of true -> throw(dont_know); false -> - {True, dict:store(cerl_trees:get_label(Fun), Inf, Map1)} + {True, maps:put(cerl_trees:get_label(Fun), Inf, Map1)} end end; MFA -> @@ -999,7 +1000,7 @@ get_underapprox_from_guard(Tree, Map) -> case cerl:is_literal(Arg) of true -> {True, Map1}; false -> - {True, dict:store(cerl_trees:get_label(Arg), Inf, Map1)} + {True, maps:put(cerl_trees:get_label(Arg), Inf, Map1)} end end; error -> @@ -1031,7 +1032,7 @@ get_underapprox_from_guard(Tree, Map) -> end; var -> Type = - case dict:find(cerl_trees:get_label(Tree), Map) of + case maps:find(cerl_trees:get_label(Tree), Map) of error -> throw(dont_know); {ok, T} -> T end, @@ -1135,7 +1136,7 @@ get_safe_underapprox_1([Pat0|Left], Acc, Map) -> case t_is_none(Inf) of true -> throw(dont_know); false -> - Map3 = dict:store(cerl_trees:get_label(AVar), Inf, Map2), + Map3 = maps:put(cerl_trees:get_label(AVar), Inf, Map2), get_safe_underapprox_1(Left, [Inf|Acc], Map3) end; binary -> @@ -1203,7 +1204,7 @@ get_safe_underapprox_1([Pat0|Left], Acc, Map) -> Type = t_product(Ts), get_safe_underapprox_1(Left, [Type|Acc], Map1); var -> - case dict:find(cerl_trees:get_label(Pat), Map) of + case maps:find(cerl_trees:get_label(Pat), Map) of error -> throw(dont_know); {ok, VarType} -> get_safe_underapprox_1(Left, [VarType|Acc], Map) end @@ -1802,12 +1803,16 @@ solve([Fun], State) -> solve([_|_] = SCC, State) -> ?debug("============ Analyzing SCC: ~w ===========\n", [[debug_lookup_name(F) || F <- SCC]]), - {Parallel, NewState} = - case parallel_split(SCC) of - false -> {false, State}; - SplitSCC -> {SplitSCC, minimize_state(State)} - end, - solve_scc(SCC, Parallel, map_new(), NewState, false). + Users = comp_users(SCC, State), + solve_scc(SCC, map_new(), State, Users, _ToSolve=SCC, false). + +comp_users(SCC, State) -> + Vars0 = [{Fun, state__get_rec_var(Fun, State)} || Fun <- SCC], + Vars = lists:sort([t_var_name(Var) || {_, {ok, Var}} <- Vars0]), + family([{t_var(V), F} || + F <- SCC, + V <- ordsets:intersection(get_deps(state__get_cs(F, State)), + Vars)]). solve_fun(Fun, FunMap, State) -> Cs = state__get_cs(Fun, State), @@ -1822,7 +1827,7 @@ solve_fun(Fun, FunMap, State) -> end, enter_type(Fun, NewType, NewFunMap1). -solve_scc(SCC, Parallel, Map, State, TryingUnit) -> +solve_scc(SCC, Map, State, Users, ToSolve, TryingUnit) -> Vars0 = [{Fun, state__get_rec_var(Fun, State)} || Fun <- SCC], Vars = [Var || {_, {ok, Var}} <- Vars0], Funs = [Fun || {Fun, {ok, _}} <- Vars0], @@ -1830,16 +1835,13 @@ solve_scc(SCC, Parallel, Map, State, TryingUnit) -> RecTypes = [t_limit(Type, ?TYPE_LIMIT) || Type <- Types], CleanMap = lists:foldl(fun(Fun, AccFunMap) -> erase_type(t_var_name(Fun), AccFunMap) - end, Map, SCC), + end, Map, ToSolve), Map1 = enter_type_lists(Vars, RecTypes, CleanMap), ?debug("Checking SCC: ~w\n", [[debug_lookup_name(F) || F <- SCC]]), - FunSet = ordsets:from_list([t_var_name(F) || F <- SCC]), - Map2 = - case Parallel of - false -> solve_whole_scc(SCC, Map1, State); - SplitSCC -> solve_whole_scc_parallel(SplitSCC, Map1, State) - end, - case maps_are_equal(Map2, Map, FunSet) of + SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end, + Map2 = lists:foldl(SolveFun, Map1, ToSolve), + Updated = updated_vars_only(Vars, Map, Map2), + case Updated =:= [] of true -> ?debug("SCC ~w reached fixpoint\n", [SCC]), NewTypes = unsafe_lookup_type_list(Funs, Map2), @@ -1852,130 +1854,21 @@ solve_scc(SCC, Parallel, Map, State, TryingUnit) -> true -> t_fun(t_fun_args(T), t_unit()) end || T <- NewTypes], Map3 = enter_type_lists(Funs, UnitTypes, Map2), - solve_scc(SCC, Parallel, Map3, State, true); + solve_scc(SCC, Map3, State, Users, SCC, true); false -> - case Parallel of - false -> true; - _ -> dispose_state(State) - end, Map2 end; false -> ?debug("SCC ~w did not reach fixpoint\n", [SCC]), - solve_scc(SCC, Parallel, Map2, State, TryingUnit) + ToSolve1 = affected(Updated, Users), + solve_scc(SCC, Map2, State, Users, ToSolve1, TryingUnit) end. -solve_whole_scc(SCC, Map, State) -> - SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end, - lists:foldl(SolveFun, Map, SCC). - -%%------------------------------------------------------------------------------ - --define(worth_it, 42). - -parallel_split(SCC) -> - Length = length(SCC), - case Length > 2*?worth_it of - false -> false; - true -> - case min(dialyzer_utils:parallelism(), 8) of - 1 -> false; - CPUs -> - FullShare = Length div CPUs + 1, - Unit = max(FullShare, ?worth_it), - split(SCC, Unit, []) - end - end. - -minimize_state(#state{ - cmap = {d, CMap}, - fun_map = FunMap, - fun_arities = FunArities, - self_rec = SelfRec, - prop_types = {d, PropTypes}, - solvers = Solvers - }) -> - Opts = [{read_concurrency, true}], - ETSCMap = ets:new(cmap, Opts), - ETSPropTypes = ets:new(prop_types, Opts), - true = ets:insert(ETSCMap, dict:to_list(CMap)), - true = ets:insert(ETSPropTypes, dict:to_list(PropTypes)), - #state - {cmap = {e, ETSCMap}, - fun_map = FunMap, - fun_arities = FunArities, - self_rec = SelfRec, - prop_types = {e, ETSPropTypes}, - solvers = Solvers, - callgraph = undefined, - plt = undefined, - mfas = [] - }. - -dispose_state(#state{cmap = {e, ETSCMap}, - prop_types = {e, ETSPropTypes}}) -> - true = ets:delete(ETSCMap), - true = ets:delete(ETSPropTypes). - -solve_whole_scc_parallel(SplitSCC, Map, State) -> - Workers = spawn_workers(SplitSCC, Map, State), - wait_results(Workers, Map, fold_res_fun(State)). - -spawn_workers(SplitSCC, Map, State) -> - Spawner = solve_scc_spawner(self(), Map, State), - lists:foreach(Spawner, SplitSCC), - length(SplitSCC). - -wait_results(0, Map, _FoldResFun) -> - Map; -wait_results(Pending, Map, FoldResFun) -> - Res = receive_scc_result(), - NewMap = lists:foldl(FoldResFun, Map, Res), - wait_results(Pending-1, NewMap, FoldResFun). - -solve_scc_spawner(Parent, Map, State) -> - fun(SCCPart) -> - spawn_link(fun() -> solve_scc_worker(Parent, SCCPart, Map, State) end) - end. - -split([], _Unit, Acc) -> - Acc; -split(List, Unit, Acc) -> - {Taken, Rest} = - try - lists:split(Unit, List) - catch - _:_ -> {List, []} - end, - split(Rest, Unit, [Taken|Acc]). - -solve_scc_worker(Parent, SCCPart, Map, State) -> - SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end, - FinalMap = lists:foldl(SolveFun, Map, SCCPart), - Res = - [{F, t_limit(unsafe_lookup_type(F, FinalMap), ?TYPE_LIMIT)} || - F <- SCCPart], - send_scc_result(Parent, Res). - -fold_res_fun(State) -> - fun({F, Type}, Map) -> - case state__get_rec_var(F, State) of - {ok, R} -> - enter_type(R, Type, enter_type(F, Type, Map)); - error -> - enter_type(F, Type, Map) - end - end. - -receive_scc_result() -> - receive - {scc_fun, Res} -> Res - end. - -send_scc_result(Parent, Res) -> - Parent ! {scc_fun, Res}. - -%%------------------------------------------------------------------------------ +affected(Updated, Users) -> + lists:umerge([case lists:keyfind(V, 1, Users) of + {V, Vs} -> Vs; + false -> [] + end || V <- Updated]). scc_fold_fun(F, FunMap, State) -> Deps = get_deps(state__get_cs(F, State)), @@ -2017,7 +1910,7 @@ solver(Solver, SolveFun) -> solve_fun(v1, _Fun, Cs, FunMap, State) -> fun() -> - {ok, _MapDict, NewMap} = solve_ref_or_list(Cs, FunMap, dict:new(), State), + {ok, _MapDict, NewMap} = solve_ref_or_list(Cs, FunMap, map_new(), State), {ok, NewMap} end; solve_fun(v2, Fun, _Cs, FunMap, State) -> @@ -2057,7 +1950,7 @@ sane_maps(Map1, Map2, Keys, _S1, _S2) -> %% Solver v2 --record(v2_state, {constr_data = dict:new() :: dict:dict(), +-record(v2_state, {constr_data = maps:new() :: map(), state :: state()}). v2_solve_ref(Fun, Map, State) -> @@ -2219,30 +2112,30 @@ v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) -> v2_solve_disj(Is, Cs, I+1, Map, V2State, UL, MapL, Eval, Uneval, Failed). save_local_map(#v2_state{constr_data = ConData}=V2State, Id, U, Map) -> - Part0 = [{V,dict:fetch(V, Map)} || V <- U], + Part0 = [{V,maps:get(V, Map)} || V <- U], Part1 = - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> []; % cannot happen {ok, {Part2,[]}} -> Part2 end, ?debug("save local map Id=~w:\n", [Id]), Part = lists:ukeymerge(1, lists:keysort(1, Part0), Part1), - pp_map("New Part", dict:from_list(Part0)), - pp_map("Old Part", dict:from_list(Part1)), - pp_map(" => Part", dict:from_list(Part)), - V2State#v2_state{constr_data = dict:store(Id, {Part,[]}, ConData)}. + pp_map("New Part", maps:from_list(Part0)), + pp_map("Old Part", maps:from_list(Part1)), + pp_map(" => Part", maps:from_list(Part)), + V2State#v2_state{constr_data = maps:put(Id, {Part,[]}, ConData)}. restore_local_map(#v2_state{constr_data = ConData}, Id, Map0) -> - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> Map0; {ok, failed} -> Map0; {ok, {[],_}} -> Map0; {ok, {Part0,U}} -> Part = [KV || {K,_V} = KV <- Part0, not lists:member(K, U)], ?debug("restore local map Id=~w U=~w\n", [Id, U]), - pp_map("Part", dict:from_list(Part)), + pp_map("Part", maps:from_list(Part)), pp_map("Map0", Map0), - Map = lists:foldl(fun({K,V}, D) -> dict:store(K, V, D) end, Map0, Part), + Map = lists:foldl(fun({K,V}, D) -> maps:put(K, V, D) end, Map0, Part), pp_map("Map", Map), Map end. @@ -2322,31 +2215,26 @@ report_detected_loop(_) -> add_mask_to_flags(Flags, [Im|M], I, L) when I > Im -> add_mask_to_flags(Flags, M, I, [Im|L]); add_mask_to_flags(Flags, [_|M], _I, L) -> - {lists:umerge(Flags, M), lists:reverse(L)}. + {lists:umerge(M, Flags), lists:reverse(L)}. -get_mask(V, {d, Masks}) -> - case dict:find(V, Masks) of +get_mask(V, Masks) -> + case maps:find(V, Masks) of error -> []; {ok, M} -> M - end; -get_mask(V, Masks) -> - case lists:keyfind(V, 1, Masks) of - false -> []; - {V, M} -> M end. get_flags(#v2_state{constr_data = ConData}=V2State0, C) -> #constraint_list{id = Id, list = Cs, masks = Masks} = C, - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> ?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]), - V2State = V2State0#v2_state{constr_data = dict:store(Id, {[],[]}, ConData)}, + V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)}, {V2State, lists:seq(1, length(Cs))}; {ok, failed} -> {V2State0, failed_list}; {ok, {Part,U}} when U =/= [] -> ?debug("get_flags Id=~w U=~w\n", [Id, U]), - V2State = V2State0#v2_state{constr_data = dict:store(Id, {Part,[]}, ConData)}, + V2State = V2State0#v2_state{constr_data = maps:put(Id, {Part,[]}, ConData)}, save_updated_vars_list(Cs, vars_per_child(U, Masks), V2State) end. @@ -2375,13 +2263,13 @@ save_updated_vars(#constraint_ref{id = Id}, U, V2State) -> save_updated_vars1(V2State, C, U) -> #v2_state{constr_data = ConData} = V2State, #constraint_list{id = Id} = C, - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> V2State; % error means everything is flagged {ok, failed} -> V2State; {ok, {Part,U0}} -> %% Duplicates are not so common; let masks/2 remove them. U1 = U ++ U0, - V2State#v2_state{constr_data = dict:store(Id, {Part,U1}, ConData)} + V2State#v2_state{constr_data = maps:put(Id, {Part,U1}, ConData)} end. -ifdef(DEBUG). @@ -2391,12 +2279,12 @@ pp_constr_data(_Tag, #v2_state{constr_data = D}) -> case _PartU of {_Part, _U} -> io:format("Id: ~w Vars: ~w\n", [_Id, _U]), - [pp_map("Part", dict:from_list(_Part)) || _Part =/= []]; + [pp_map("Part", maps:from_list(_Part)) || _Part =/= []]; failed -> io:format("Id: ~w failed list\n", [_Id]) end end || - {_Id, _PartU} <- lists:keysort(1, dict:to_list(D))], + {_Id, _PartU} <- lists:keysort(1, maps:to_list(D))], ok. -else. @@ -2406,17 +2294,17 @@ pp_constr_data(_Tag, _V2State) -> failed_list(#constraint_list{id = Id}, #v2_state{constr_data = D}=V2State) -> ?debug("error list ~w~n", [Id]), - V2State#v2_state{constr_data = dict:store(Id, failed, D)}. + V2State#v2_state{constr_data = maps:put(Id, failed, D)}. is_failed_list(#constraint_list{id = Id}, #v2_state{constr_data = D}) -> - dict:find(Id, D) =:= {ok, failed}. + maps:find(Id, D) =:= {ok, failed}. %% Solver v1 solve_ref_or_list(#constraint_ref{id = Id, deps = Deps}, Map, MapDict, State) -> {OldLocalMap, Check} = - case dict:find(Id, MapDict) of + case maps:find(Id, MapDict) of error -> {map_new(), false}; {ok, M} -> {M, true} end, @@ -2462,12 +2350,12 @@ solve_ref_or_list(#constraint_ref{id = Id, deps = Deps}, {ok, Var} -> enter_type(Var, FunType, NewMap1); error -> NewMap1 end, - {ok, dict:store(Id, NewMap2, NewMapDict), NewMap2} + {ok, maps:put(Id, NewMap2, NewMapDict), NewMap2} end; solve_ref_or_list(#constraint_list{type=Type, list = Cs, deps = Deps, id = Id}, Map, MapDict, State) -> {OldLocalMap, Check} = - case dict:find(Id, MapDict) of + case maps:find(Id, MapDict) of error -> {map_new(), false}; {ok, M} -> {M, true} end, @@ -2517,7 +2405,7 @@ solve_self_recursive(Cs, Map, MapDict, Id, RecType0, State) -> solve_clist(Cs, conj, Id, Deps, MapDict, Map, State) -> case solve_cs(Cs, Map, MapDict, State) of {error, NewMapDict} -> - {error, dict:store(Id, error, NewMapDict)}; + {error, maps:put(Id, error, NewMapDict)}; {ok, NewMapDict, NewMap} = Ret -> case Cs of [_] -> @@ -2525,7 +2413,7 @@ solve_clist(Cs, conj, Id, Deps, MapDict, Map, State) -> Ret; _ -> case maps_are_equal(Map, NewMap, Deps) of - true -> {ok, dict:store(Id, NewMap, NewMapDict), NewMap}; + true -> {ok, maps:put(Id, NewMap, NewMapDict), NewMap}; false -> solve_clist(Cs, conj, Id, Deps, NewMapDict, NewMap, State) end end @@ -2539,10 +2427,10 @@ solve_clist(Cs, disj, Id, _Deps, MapDict, Map, State) -> end, {Maps, NewMapDict} = lists:mapfoldl(Fun, MapDict, Cs), case [X || {ok, X} <- Maps] of - [] -> {error, dict:store(Id, error, NewMapDict)}; + [] -> {error, maps:put(Id, error, NewMapDict)}; MapList -> NewMap = join_maps(MapList), - {ok, dict:store(Id, NewMap, NewMapDict), NewMap} + {ok, maps:put(Id, NewMap, NewMapDict), NewMap} end. solve_cs([#constraint_ref{} = C|Tail], Map, MapDict, State) -> @@ -2623,7 +2511,7 @@ report_failed_constraint(_C, _Map) -> %% ============================================================================ map_new() -> - dict:new(). + maps:new(). join_maps([Map]) -> Map; @@ -2633,9 +2521,9 @@ join_maps(Maps) -> constrained_keys(Maps) -> lists:foldl(fun(TmpMap, AccKeys) -> - [Key || Key <- AccKeys, dict:is_key(Key, TmpMap)] + [Key || Key <- AccKeys, maps:is_key(Key, TmpMap)] end, - dict:fetch_keys(hd(Maps)), tl(Maps)). + maps:keys(hd(Maps)), tl(Maps)). join_maps([Key|Left], Maps = [Map|MapsLeft], AccMap) -> NewType = join_one_key(Key, MapsLeft, lookup_type(Key, Map)), @@ -2681,11 +2569,11 @@ prune_keys(Map1, Map2, Deps) -> NofDeps = length(Deps), case NofDeps > ?PRUNE_LIMIT of true -> - Keys1 = dict:fetch_keys(Map1), + Keys1 = maps:keys(Map1), case length(Keys1) > NofDeps of true -> Set1 = lists:sort(Keys1), - Set2 = lists:sort(dict:fetch_keys(Map2)), + Set2 = lists:sort(maps:keys(Map2)), ordsets:intersection(ordsets:union(Set1, Set2), Deps); false -> Deps @@ -2706,7 +2594,7 @@ enter_type(Key, Val, Map) when is_integer(Key) -> true -> ok; false -> ?debug("LimitedVal ~s\n", [format_type(LimitedVal)]) end, - case dict:find(Key, Map) of + case maps:find(Key, Map) of {ok, Value} -> case is_equal(Value, LimitedVal) of true -> Map; @@ -2740,16 +2628,16 @@ enter_type2(Key, Val, Map) -> map_store(Key, Val, Map) -> ?debug("Storing ~w :: ~s\n", [Key, format_type(Val)]), - dict:store(Key, Val, Map). + maps:put(Key, Val, Map). erase_type(Key, Map) -> - dict:erase(Key, Map). + maps:remove(Key, Map). lookup_type_list(List, Map) -> [lookup_type(X, Map) || X <- List]. unsafe_lookup_type(Key, Map) -> - case dict:find(t_var_name(Key), Map) of + case maps:find(t_var_name(Key), Map) of {ok, Type} -> Type; error -> t_none() end. @@ -2758,7 +2646,7 @@ unsafe_lookup_type_list(List, Map) -> [unsafe_lookup_type(X, Map) || X <- List]. lookup_type(Key, Map) when is_integer(Key) -> - case dict:find(Key, Map) of + case maps:find(Key, Map) of error -> t_any(); {ok, Val} -> Val end; @@ -2806,7 +2694,7 @@ is_equal(Type1, Type2) -> pp_map(_S, _Map) -> ?debug("\t~s: ~p\n", [_S, [{X, lists:flatten(format_type(Y))} || - {X, Y} <- lists:keysort(1, dict:to_list(_Map))]]). + {X, Y} <- lists:keysort(1, maps:to_list(_Map))]]). %% ============================================================================ %% @@ -2816,7 +2704,7 @@ pp_map(_S, _Map) -> new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0], - NameMap = dict:from_list(List), + NameMap = maps:from_list(List), MFAs = [MFA || {MFA, _Var} <- List], SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0], SelfRec = @@ -2830,7 +2718,7 @@ new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> _Many -> false end, #state{callgraph = CallGraph, name_map = NameMap, next_label = NextLabel, - prop_types = {d, PropTypes}, plt = Plt, scc = ordsets:from_list(SCC), + prop_types = PropTypes, plt = Plt, scc = ordsets:from_list(SCC), mfas = MFAs, self_rec = SelfRec, solvers = Solvers}. state__set_rec_dict(State, RecDict) -> @@ -2858,15 +2746,15 @@ state__get_fun_prototype(Op, Arity, State) -> end. state__lookup_rec_var_in_scope(MFA, #state{name_map = NameMap}) -> - dict:find(MFA, NameMap). + maps:find(MFA, NameMap). state__store_fun_arity(Tree, #state{fun_arities = Map} = State) -> Arity = length(cerl:fun_vars(Tree)), Id = mk_var(Tree), - State#state{fun_arities = dict:store(Id, Arity, Map)}. + State#state{fun_arities = maps:put(Id, Arity, Map)}. state__fun_arity(Id, #state{fun_arities = Map}) -> - dict:fetch(Id, Map). + maps:get(Id, Map). state__lookup_undef_var(Tree, #state{callgraph = CG, plt = Plt}) -> Label = cerl_trees:get_label(Tree), @@ -2926,21 +2814,14 @@ state__plt(#state{plt = PLT}) -> state__new_constraint_context(State) -> State#state{cs = []}. -state__prop_domain(FunLabel, #state{prop_types = {e, ETSPropTypes}}) -> - try ets:lookup_element(ETSPropTypes, FunLabel, 2) of - {_Range_Fun, Dom} -> {ok, Dom}; - FunType -> {ok, t_fun_args(FunType)} - catch - _:_ -> error - end; -state__prop_domain(FunLabel, #state{prop_types = {d, PropTypes}}) -> +state__prop_domain(FunLabel, #state{prop_types = PropTypes}) -> case dict:find(FunLabel, PropTypes) of error -> error; {ok, {_Range_Fun, Dom}} -> {ok, Dom}; {ok, FunType} -> {ok, t_fun_args(FunType)} end. -state__add_prop_constrs(Tree, #state{prop_types = {d, PropTypes}} = State) -> +state__add_prop_constrs(Tree, #state{prop_types = PropTypes} = State) -> Label = cerl_trees:get_label(Tree), case dict:find(Label, PropTypes) of error -> State; @@ -3003,14 +2884,12 @@ state__mk_vars(N, #state{next_label = NL} = State) -> Vars = [t_var(X) || X <- lists:seq(NL, NewLabel-1)], {State#state{next_label = NewLabel}, Vars}. -state__store_constrs(Id, Cs, #state{cmap = {d, Dict}} = State) -> - NewDict = dict:store(Id, Cs, Dict), - State#state{cmap = {d, NewDict}}. +state__store_constrs(Id, Cs, #state{cmap = Map} = State) -> + NewMap = maps:put(Id, Cs, Map), + State#state{cmap = NewMap}. -state__get_cs(Var, #state{cmap = {e, ETSDict}}) -> - ets:lookup_element(ETSDict, Var, 2); -state__get_cs(Var, #state{cmap = {d, Dict}}) -> - dict:fetch(Var, Dict). +state__get_cs(Var, #state{cmap = Map}) -> + maps:get(Var, Map). state__is_self_rec(Fun, #state{self_rec = SelfRec}) -> not (SelfRec =:= 'false') andalso is_equal(Fun, SelfRec). @@ -3019,15 +2898,12 @@ state__store_funs(Vars0, Funs0, #state{fun_map = Map} = State) -> debug_make_name_map(Vars0, Funs0), Vars = mk_var_list(Vars0), Funs = mk_var_list(Funs0), - NewMap = lists:foldl(fun({Var, Fun}, MP) -> orddict:store(Var, Fun, MP) end, + NewMap = lists:foldl(fun({Var, Fun}, MP) -> maps:put(Fun, Var, MP) end, Map, lists:zip(Vars, Funs)), State#state{fun_map = NewMap}. state__get_rec_var(Fun, #state{fun_map = Map}) -> - case [V || {V, FV} <- Map, FV =:= Fun] of - [Var] -> {ok, Var}; - [] -> error - end. + maps:find(Fun, Map). state__finalize(State) -> State1 = enumerate_constraints(State), @@ -3094,13 +2970,13 @@ mk_fun_var(Fun, Types) -> -endif. --spec get_deps(constr()) -> [dep()]. +-spec get_deps(constr()) -> deps(). get_deps(#constraint{deps = D}) -> D; get_deps(#constraint_list{deps = D}) -> D; get_deps(#constraint_ref{deps = D}) -> D. --spec find_constraint_deps([fvar_or_type()]) -> [dep()]. +-spec find_constraint_deps([fvar_or_type()]) -> deps(). find_constraint_deps(List) -> ordsets:from_list(find_constraint_deps(List, [])). @@ -3348,18 +3224,11 @@ order_fun_constraints([], Funs, Acc, State) -> update_masks(C, Masks) -> C#constraint_list{masks = Masks}. --define(VARS_LIMIT, 50). - calculate_masks([C|Cs], I, L0) -> calculate_masks(Cs, I+1, [{V, I} || V <- get_deps(C)] ++ L0); calculate_masks([], _I, L) -> M = family(L), - case length(M) > ?VARS_LIMIT of - true -> - {d, dict:from_list(M)}; - false -> - M - end. + maps:from_list(M). %% ============================================================================ %% @@ -3487,7 +3356,7 @@ join_chars([H|T], Sep) -> [H|[[Sep,X] || X <- T]]. debug_lookup_name(Var) -> - case dict:find(t_var_name(Var), get(dialyzer_typesig_map)) of + case maps:find(t_var_name(Var), get(dialyzer_typesig_map)) of error -> Var; {ok, Name} -> Name end. @@ -3497,7 +3366,7 @@ debug_lookup_name(Var) -> debug_make_name_map(Vars, Funs) -> Map = get(dialyzer_typesig_map), NewMap = - if Map =:= undefined -> debug_make_name_map(Vars, Funs, dict:new()); + if Map =:= undefined -> debug_make_name_map(Vars, Funs, maps:new()); true -> debug_make_name_map(Vars, Funs, Map) end, put(dialyzer_typesig_map, NewMap). @@ -3505,7 +3374,7 @@ debug_make_name_map(Vars, Funs) -> debug_make_name_map([Var|VarLeft], [Fun|FunLeft], Map) -> Name = {cerl:fname_id(Var), cerl:fname_arity(Var)}, FunLabel = cerl_trees:get_label(Fun), - debug_make_name_map(VarLeft, FunLeft, dict:store(FunLabel, Name, Map)); + debug_make_name_map(VarLeft, FunLeft, maps:put(FunLabel, Name, Map)); debug_make_name_map([], [], Map) -> Map. diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 99c474d588..721387d97d 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.2.1 +ELDAP_VSN = 1.2.2 diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 02e1625965..84addcc105 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -236,7 +236,7 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, opaques/0, type_table/0, var_table/0]). +-export_type([erl_type/0, opaques/0, type_table/0]). %%-define(DEBUG, true). @@ -380,7 +380,7 @@ -type type_table() :: dict:dict(record_key() | type_key(), record_value() | type_value()). --type var_table() :: dict:dict(atom(), erl_type()). +-type var_table() :: #{atom() => erl_type()}. %%----------------------------------------------------------------------------- %% Unions @@ -3295,87 +3295,33 @@ findfirst(N1, N2, U1, B1, U2, B2) -> %%----------------------------------------------------------------------------- %% Substitution of variables %% -%% Dialyzer versions prior to R15B used a dict data structure to map variables -%% to types. Hans Bolinder suggested the use of lists of Key-Value pairs for -%% this data structure and measurements showed a non-trivial speedup when using -%% them for operations within this module (e.g. in t_unify/2). However, there -%% is code outside erl_types that still passes a dict:dict() in the 2nd argument. -%% So, for the time being, this module provides a t_subst/2 function for these -%% external calls and a clone of it (t_subst_kv/2) which is used from all calls -%% from within this module. This code duplication needs to be eliminated at -%% some point. - --spec t_subst(erl_type(), dict:dict(atom(), erl_type())) -> erl_type(). - -t_subst(T, Dict) -> + +-type subst_table() :: #{any() => erl_type()}. + +-spec t_subst(erl_type(), subst_table()) -> erl_type(). + +t_subst(T, Map) -> case t_has_var(T) of - true -> t_subst_dict(T, Dict); + true -> t_subst_aux(T, Map); false -> T end. -t_subst_dict(?var(Id), Dict) -> - case dict:find(Id, Dict) of - error -> ?any; - {ok, Type} -> Type - end; -t_subst_dict(?list(Contents, Termination, Size), Dict) -> - case t_subst_dict(Contents, Dict) of - ?none -> ?none; - NewContents -> - %% Be careful here to make the termination collapse if necessary. - case t_subst_dict(Termination, Dict) of - ?nil -> ?list(NewContents, ?nil, Size); - ?any -> ?list(NewContents, ?any, Size); - Other -> - ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), - ?list(NewContents2, NewTermination, Size) - end - end; -t_subst_dict(?function(Domain, Range), Dict) -> - ?function(t_subst_dict(Domain, Dict), t_subst_dict(Range, Dict)); -t_subst_dict(?product(Types), Dict) -> - ?product([t_subst_dict(T, Dict) || T <- Types]); -t_subst_dict(?tuple(?any, ?any, ?any) = T, _Dict) -> - T; -t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> - t_tuple([t_subst_dict(E, Dict) || E <- Elements]); -t_subst_dict(?tuple_set(_) = TS, Dict) -> - t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); -t_subst_dict(?map(Pairs, DefK, DefV), Dict) -> - t_map([{K, MNess, t_subst_dict(V, Dict)} || {K, MNess, V} <- Pairs], - t_subst_dict(DefK, Dict), t_subst_dict(DefV, Dict)); -t_subst_dict(?opaque(Es), Dict) -> - List = [Opaque#opaque{args = [t_subst_dict(Arg, Dict) || Arg <- Args], - struct = t_subst_dict(S, Dict)} || - Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], - ?opaque(ordsets:from_list(List)); -t_subst_dict(?union(List), Dict) -> - ?union([t_subst_dict(E, Dict) || E <- List]); -t_subst_dict(T, _Dict) -> - T. - -spec subst_all_vars_to_any(erl_type()) -> erl_type(). subst_all_vars_to_any(T) -> - t_subst_kv(T, []). + t_subst(T, #{}). -t_subst_kv(T, KVMap) -> - case t_has_var(T) of - true -> t_subst_aux(T, KVMap); - false -> T - end. - -t_subst_aux(?var(Id), VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> ?any; - {Id, Type} -> Type +t_subst_aux(?var(Id), Map) -> + case maps:find(Id, Map) of + error -> ?any; + {ok, Type} -> Type end; -t_subst_aux(?list(Contents, Termination, Size), VarMap) -> - case t_subst_aux(Contents, VarMap) of +t_subst_aux(?list(Contents, Termination, Size), Map) -> + case t_subst_aux(Contents, Map) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. - case t_subst_aux(Termination, VarMap) of + case t_subst_aux(Termination, Map) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> @@ -3383,27 +3329,27 @@ t_subst_aux(?list(Contents, Termination, Size), VarMap) -> ?list(NewContents2, NewTermination, Size) end end; -t_subst_aux(?function(Domain, Range), VarMap) -> - ?function(t_subst_aux(Domain, VarMap), t_subst_aux(Range, VarMap)); -t_subst_aux(?product(Types), VarMap) -> - ?product([t_subst_aux(T, VarMap) || T <- Types]); -t_subst_aux(?tuple(?any, ?any, ?any) = T, _VarMap) -> +t_subst_aux(?function(Domain, Range), Map) -> + ?function(t_subst_aux(Domain, Map), t_subst_aux(Range, Map)); +t_subst_aux(?product(Types), Map) -> + ?product([t_subst_aux(T, Map) || T <- Types]); +t_subst_aux(?tuple(?any, ?any, ?any) = T, _Map) -> T; -t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> - t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); -t_subst_aux(?tuple_set(_) = TS, VarMap) -> - t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); -t_subst_aux(?map(Pairs, DefK, DefV), VarMap) -> - t_map([{K, MNess, t_subst_aux(V, VarMap)} || {K, MNess, V} <- Pairs], - t_subst_aux(DefK, VarMap), t_subst_aux(DefV, VarMap)); -t_subst_aux(?opaque(Es), VarMap) -> - List = [Opaque#opaque{args = [t_subst_aux(Arg, VarMap) || Arg <- Args], - struct = t_subst_aux(S, VarMap)} || - Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], - ?opaque(ordsets:from_list(List)); -t_subst_aux(?union(List), VarMap) -> - ?union([t_subst_aux(E, VarMap) || E <- List]); -t_subst_aux(T, _VarMap) -> +t_subst_aux(?tuple(Elements, _Arity, _Tag), Map) -> + t_tuple([t_subst_aux(E, Map) || E <- Elements]); +t_subst_aux(?tuple_set(_) = TS, Map) -> + t_sup([t_subst_aux(T, Map) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(?map(Pairs, DefK, DefV), Map) -> + t_map([{K, MNess, t_subst_aux(V, Map)} || {K, MNess, V} <- Pairs], + t_subst_aux(DefK, Map), t_subst_aux(DefV, Map)); +t_subst_aux(?opaque(Es), Map) -> + List = [Opaque#opaque{args = [t_subst_aux(Arg, Map) || Arg <- Args], + struct = t_subst_aux(S, Map)} || + Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], + ?opaque(ordsets:from_list(List)); +t_subst_aux(?union(List), Map) -> + ?union([t_subst_aux(E, Map) || E <- List]); +t_subst_aux(T, _Map) -> T. %%----------------------------------------------------------------------------- @@ -3415,33 +3361,33 @@ t_subst_aux(T, _VarMap) -> -spec t_unify(erl_type(), erl_type()) -> t_unify_ret(). t_unify(T1, T2) -> - {T, VarMap} = t_unify(T1, T2, []), - {t_subst_kv(T, VarMap), lists:keysort(1, VarMap)}. + {T, VarMap} = t_unify(T1, T2, #{}), + {t_subst(T, VarMap), lists:keysort(1, maps:to_list(VarMap))}. t_unify(?var(Id) = T, ?var(Id), VarMap) -> {T, VarMap}; t_unify(?var(Id1) = T, ?var(Id2), VarMap) -> - case lists:keyfind(Id1, 1, VarMap) of - false -> - case lists:keyfind(Id2, 1, VarMap) of - false -> {T, [{Id2, T} | VarMap]}; - {Id2, Type} -> t_unify(T, Type, VarMap) + case maps:find(Id1, VarMap) of + error -> + case maps:find(Id2, VarMap) of + error -> {T, VarMap#{Id2 => T}}; + {ok, Type} -> t_unify(T, Type, VarMap) end; - {Id1, Type1} -> - case lists:keyfind(Id2, 1, VarMap) of - false -> {Type1, [{Id2, T} | VarMap]}; - {Id2, Type2} -> t_unify(Type1, Type2, VarMap) + {ok, Type1} -> + case maps:find(Id2, VarMap) of + error -> {Type1, VarMap#{Id2 => T}}; + {ok, Type2} -> t_unify(Type1, Type2, VarMap) end end; t_unify(?var(Id), Type, VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap) + case maps:find(Id, VarMap) of + error -> {Type, VarMap#{Id => Type}}; + {ok, VarType} -> t_unify(VarType, Type, VarMap) end; t_unify(Type, ?var(Id), VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap) + case maps:find(Id, VarMap) of + error -> {Type, VarMap#{Id => Type}}; + {ok, VarType} -> t_unify(VarType, Type, VarMap) end; t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap) -> {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap), @@ -4472,7 +4418,7 @@ mod_name(Mod, Name) -> site(), mod_records()) -> erl_type(). t_from_form(Form, ExpTypes, Site, RecDict) -> - t_from_form(Form, ExpTypes, Site, RecDict, dict:new()). + t_from_form(Form, ExpTypes, Site, RecDict, maps:new()). -spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_records(), var_table()) -> erl_type(). @@ -4489,7 +4435,7 @@ t_from_form_without_remote(Form, Site, TypeTable) -> Module = site_module(Site), RecDict = dict:from_list([{Module, TypeTable}]), ExpTypes = replace_by_none, - {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, dict:new()), + {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, maps:new()), T. %% REC_TYPE_LIMIT is used for limiting the depth of recursive types. @@ -4545,7 +4491,7 @@ t_from_form(_, _TypeNames, _ET, _S, _MR, _V, D, L) when D =< 0 ; L =< 0 -> t_from_form({var, _L, '_'}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_any(), L}; t_from_form({var, _L, Name}, _TypeNames, _ET, _S, _MR, V, _D, L) -> - case dict:find(Name, V) of + case maps:find(Name, V) of error -> {t_var(Name), L}; {ok, Val} -> {Val, L} end; @@ -4764,7 +4710,7 @@ type_from_form(Name, Args, TypeNames, ET, Site0, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, Site0, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpV = dict:from_list(List), + TmpV = maps:from_list(List), Site = TypeName, t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1); false -> @@ -4777,7 +4723,7 @@ type_from_form(Name, Args, TypeNames, ET, Site0, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, NewTypeNames, ET, Site0, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpV = dict:from_list(List), + TmpV = maps:from_list(List), Site = TypeName, {Rep, L2} = t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1), @@ -4819,7 +4765,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, S, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, S, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), + TmpVarDict = maps:from_list(List), Site = RemType, t_from_form(Form, NewTypeNames, ET, Site, MR, TmpVarDict, D, L1); @@ -4833,7 +4779,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, S, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, NewTypeNames, ET, S, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), + TmpVarDict = maps:from_list(List), Site = RemType, {NewRep, L2} = t_from_form(Form, NewTypeNames, ET, Site, MR, @@ -4904,7 +4850,7 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, ET, S, MR, V, D, L) -> {ok, NewFields} -> {NewFields1, L2} = fields_from_form(NewFields, NewTypeNames, ET, S1, MR, - dict:new(), D, L1), + maps:new(), D, L1), Rec = t_tuple( [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields1]]), @@ -5023,7 +4969,7 @@ promote_to_mand(MKs, [E={K,_,V}|T]) -> mod_records()) -> ok. t_check_record_fields(Form, ExpTypes, Site, RecDict) -> - t_check_record_fields(Form, ExpTypes, Site, RecDict, dict:new()). + t_check_record_fields(Form, ExpTypes, Site, RecDict, maps:new()). -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), mod_records(), var_table()) -> ok. @@ -5192,8 +5138,9 @@ t_form_to_string({type, _L, Name, []} = T) -> D0 = dict:new(), MR = dict:from_list([{M, D0}]), S = {type, {M,Name,0}}, + V = #{}, {T1, _} = - t_from_form(T, [], sets:new(), S, MR, D0, _Deep=1000, _ALot=100000), + t_from_form(T, [], sets:new(), S, MR, V, _Deep=1000, _ALot=100000), t_to_string(T1) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index bd6b76a73e..5cebce18a9 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,25 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.2.2</title> + <section><title>Inets 6.2.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Put back unused module inets_regexp and remove it in OTP + 19 instead as it is an incompatibility, although it is an + undocumented module and should not affect other + applications.</p> + <p> + Own Id: OTP-13533</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.2.2</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 1d870c14e8..a294381f67 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -49,7 +49,8 @@ MODULES = \ inets_sup \ inets_trace \ inets_lib \ - inets_time_compat + inets_time_compat \ + inets_regexp INTERNAL_HRL_FILES = inets_internal.hrl EXTERNAL_HRL_FILES = ../../include/httpd.hrl \ diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 5706a335d7..abf8c0cdea 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -29,6 +29,7 @@ inets_trace, inets_lib, inets_time_compat, + inets_regexp, %% FTP ftp, diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index a603357ebd..3a31daeb20 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,16 +18,10 @@ %% %CopyrightEnd% {"%VSN%", [ - {<<"6.2.1">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}]}, - {<<"6.2">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {<<"6.2.1">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}]}, - {<<"6.2">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl new file mode 100644 index 0000000000..fc1608bc5a --- /dev/null +++ b/lib/inets/src/inets_app/inets_regexp.erl @@ -0,0 +1,414 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. 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(inets_regexp). + +-export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]). + + +%%%========================================================================= +%%% API +%%%========================================================================= + +%% parse(RegExp) -> {ok, RE} | {error, E}. +%% Parse the regexp described in the string RegExp. + +parse(S) -> + case (catch reg(S)) of + {R, []} -> + {ok, R}; + {_R, [C|_]} -> + {error, {illegal, [C]}}; + {error, E} -> + {error, E} + end. + + +%% Find the longest match of RegExp in String. + +match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok,RE} -> match(S, RE); + {error,E} -> {error,E} + end; +match(S, RE) -> + case match(RE, S, 1, 0, -1) of + {Start,Len} when Len >= 0 -> + {match, Start, Len}; + {_Start,_Len} -> + nomatch + end. + +%% Find the first match of RegExp in String. + +first_match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + first_match(S, RE); + {error, E} -> + {error, E} + end; +first_match(S, RE) -> + case first_match(RE, S, 1) of + {Start,Len} when Len >= 0 -> + {match, Start,Len}; + nomatch -> + nomatch + end. + +first_match(RE, S, St) when S =/= [] -> + case re_apply(S, St, RE) of + {match, P, _Rest} -> + {St, P-St}; + nomatch -> + first_match(RE, tl(S), St+1) + end; +first_match(_RE, [], _St) -> + nomatch. + + +match(RE, S, St, Pos, L) -> + case first_match(RE, S, St) of + {St1, L1} -> + Nst = St1 + 1, + if L1 > L -> + match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); + true -> + match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) + end; + nomatch -> + {Pos, L} + end. + + +%% Split a string into substrings where the RegExp describes the +%% field seperator. The RegExp " " is specially treated. + +split(String, " ") -> %This is really special + {ok, RE} = parse("[ \t]+"), + case split_apply(String, RE, true) of + [[]|Ss] -> + {ok,Ss}; + Ss -> + {ok,Ss} + end; +split(String, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + {ok, split_apply(String, RE, false)}; + {error, E} -> + {error,E} + end; +split(String, RE) -> + {ok, split_apply(String, RE, false)}. + + +%% Substitute the first match of the regular expression RegExp +%% with the string Replace in String. Accept pre-parsed regular +%% expressions. + +sub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + sub(String, RE, Rep); + {error, E} -> + {error, E} + end; +sub(String, RE, Rep) -> + Ss = sub_match(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%% Substitute every match of the regular expression RegExp with +%% the string New in String. Accept pre-parsed regular expressions. + +gsub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + gsub(String, RE, Rep); + {error, E} -> + {error, E} + end; +gsub(String, RE, Rep) -> + Ss = matches(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%% This is the regular expression grammar used. It is equivalent to the +%% one used in AWK, except that we allow ^ $ to be used anywhere and fail +%% in the matching. +%% +%% reg -> reg1 : '$1'. +%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. +%% reg1 -> reg2 : '$1'. +%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. +%% reg2 -> reg3 : '$1'. +%% reg3 -> reg3 "*" : {kclosure,'$1'}. +%% reg3 -> reg3 "+" : {pclosure,'$1'}. +%% reg3 -> reg3 "?" : {optional,'$1'}. +%% reg3 -> reg4 : '$1'. +%% reg4 -> "(" reg ")" : '$2'. +%% reg4 -> "\\" char : '$2'. +%% reg4 -> "^" : bos. +%% reg4 -> "$" : eos. +%% reg4 -> "." : char. +%% reg4 -> "[" class "]" : {char_class,char_class('$2')} +%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} +%% reg4 -> "\"" chars "\"" : char_string('$2') +%% reg4 -> char : '$1'. +%% reg4 -> empty : epsilon. +%% The grammar of the current regular expressions. The actual parser +%% is a recursive descent implementation of the grammar. + +reg(S) -> reg1(S). + +%% reg1 -> reg2 reg1' +%% reg1' -> "|" reg2 +%% reg1' -> empty + +reg1(S0) -> + {L,S1} = reg2(S0), + reg1p(S1, L). + +reg1p([$||S0], L) -> + {R,S1} = reg2(S0), + reg1p(S1, {'or',L,R}); +reg1p(S, L) -> {L,S}. + +%% reg2 -> reg3 reg2' +%% reg2' -> reg3 +%% reg2' -> empty + +reg2(S0) -> + {L,S1} = reg3(S0), + reg2p(S1, L). + +reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) -> + {R,S1} = reg3([C|S0]), + reg2p(S1, {concat,L,R}); +reg2p(S, L) -> {L,S}. + +%% reg3 -> reg4 reg3' +%% reg3' -> "*" reg3' +%% reg3' -> "+" reg3' +%% reg3' -> "?" reg3' +%% reg3' -> empty + +reg3(S0) -> + {L,S1} = reg4(S0), + reg3p(S1, L). + +reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); +reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); +reg3p([$?|S], L) -> reg3p(S, {optional,L}); +reg3p(S, L) -> {L,S}. + +reg4([$(|S0]) -> + case reg(S0) of + {R,[$)|S1]} -> {R,S1}; + {_R,_S} -> throw({error,{unterminated,"("}}) + end; +reg4([$\\,O1,O2,O3|S]) + when ((O1 >= $0) andalso + (O1 =< $7) andalso + (O2 >= $0) andalso + (O2 =< $7) andalso + (O3 >= $0) andalso + (O3 =< $7)) -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +reg4([$\\,C|S]) -> + {escape_char(C),S}; +reg4([$\\]) -> + throw({error, {unterminated,"\\"}}); +reg4([$^|S]) -> + {bos,S}; +reg4([$$|S]) -> + {eos,S}; +reg4([$.|S]) -> + {{comp_class,"\n"},S}; +reg4("[^" ++ S0) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; + {_Cc,_S} -> throw({error,{unterminated,"["}}) + end; +reg4([$[|S0]) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{char_class,Cc},S1}; + {_Cc,_S1} -> throw({error,{unterminated,"["}}) + end; +reg4([C|S]) + when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> + {C, S}; +reg4([C|_S]) -> + throw({error,{illegal,[C]}}); +reg4([]) -> + {epsilon,[]}. + +escape_char($n) -> $\n; %\n = LF +escape_char($r) -> $\r; %\r = CR +escape_char($t) -> $\t; %\t = TAB +escape_char($v) -> $\v; %\v = VT +escape_char($b) -> $\b; %\b = BS +escape_char($f) -> $\f; %\f = FF +escape_char($e) -> $\e; %\e = ESC +escape_char($s) -> $\s; %\s = SPACE +escape_char($d) -> $\d; %\d = DEL +escape_char(C) -> C. + +char_class([$]|S]) -> char_class(S, [$]]); +char_class(S) -> char_class(S, []). + +char($\\, [O1,O2,O3|S]) when + O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +char($\\, [C|S]) -> {escape_char(C),S}; +char(C, S) -> {C,S}. + +char_class([C1|S0], Cc) when C1 =/= $] -> + case char(C1, S0) of + {Cf,[$-,C2|S1]} when C2 =/= $] -> + case char(C2, S1) of + {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); + {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) + end; + {C,S1} -> char_class(S1, [C|Cc]) + end; +char_class(S, Cc) -> {Cc,S}. + + +%% re_apply(String, StartPos, RegExp) -> re_app_res(). +%% +%% Apply the (parse of the) regular expression RegExp to String. If +%% there is a match return the position of the remaining string and +%% the string if else return 'nomatch'. BestMatch specifies if we want +%% the longest match, or just a match. +%% +%% StartPos should be the real start position as it is used to decide +%% if we ae at the beginning of the string. +%% +%% Pass two functions to re_apply_or so it can decide, on the basis +%% of BestMatch, whether to just any take any match or try both to +%% find the longest. This is slower but saves duplicatng code. + +re_apply(S, St, RE) -> re_apply(RE, [], S, St). + +re_apply(epsilon, More, S, P) -> %This always matches + re_apply_more(More, S, P); +re_apply({'or',RE1,RE2}, More, S, P) -> + re_apply_or(re_apply(RE1, More, S, P), + re_apply(RE2, More, S, P)); +re_apply({concat,RE1,RE2}, More, S0, P) -> + re_apply(RE1, [RE2|More], S0, P); +re_apply({kclosure,CE}, More, S, P) -> + %% Be careful with the recursion, explicitly do one call before + %% looping. + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, [{kclosure,CE}|More], S, P)); +re_apply({pclosure,CE}, More, S, P) -> + re_apply(CE, [{kclosure,CE}|More], S, P); +re_apply({optional,CE}, More, S, P) -> + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, More, S, P)); +re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); +re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); +re_apply(eos, More, [], P) -> re_apply_more(More, [], P); +re_apply({char_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> re_apply_more(More, S, P+1); + false -> nomatch + end; +re_apply({comp_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> nomatch; + false -> re_apply_more(More, S, P+1) + end; +re_apply(C, More, [C|S], P) when is_integer(C) -> + re_apply_more(More, S, P+1); +re_apply(_RE, _More, _S, _P) -> nomatch. + +%% re_apply_more([RegExp], String, Length) -> re_app_res(). + +re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); +re_apply_more([], S, P) -> {match,P,S}. + +%% in_char_class(Char, Class) -> bool(). + +in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; +in_char_class(C, [C|_Cc]) -> true; +in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); +in_char_class(_C, []) -> false. + +%% re_apply_or(Match1, Match2) -> re_app_res(). +%% If we want the best match then choose the longest match, else just +%% choose one by trying sequentially. + +re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; +re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; +re_apply_or(nomatch, R2) -> R2; +re_apply_or(R1, nomatch) -> R1. + + +matches(S, RE, St) -> + case first_match(RE, S, St) of + {St1,0} -> + [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)]; + {St1,L1} -> + [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)]; + nomatch -> + [] + end. + +sub_match(S, RE, St) -> + case first_match(RE, S, St) of + {St1,L1} -> [{St1,L1}]; + nomatch -> [] + end. + +sub_repl([{St,L}|Ss], Rep, S, Pos) -> + Rs = sub_repl(Ss, Rep, S, St+L), + string:substr(S, Pos, St-Pos) ++ + sub_repl(Rep, string:substr(S, St, L), Rs); +sub_repl([], _Rep, S, Pos) -> + string:substr(S, Pos). + +sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); +sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; +sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; +sub_repl([], _M, Rest) -> Rest. + +split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). + +split_apply([], _P, _RE, true, []) -> + []; +split_apply([], _P, _RE, _T, Sub) -> + [lists:reverse(Sub)]; +split_apply(S, P, RE, T, Sub) -> + case re_apply(S, P, RE) of + {match,P,_Rest} -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); + {match,P1,Rest} -> + [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; + nomatch -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) + end. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index fc33b546d9..d52dbad555 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.2.2 +INETS_VSN = 6.2.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/pom.xml.src b/lib/jinterface/java_src/pom.xml.src index cef49b735a..98232db78c 100644 --- a/lib/jinterface/java_src/pom.xml.src +++ b/lib/jinterface/java_src/pom.xml.src @@ -7,14 +7,14 @@ <version>%VSN%</version> <name>jinterface</name> <description> - Jinterface Java package contains java classes, which help you integrate programs written in Java with Erlang. + Jinterface Java package contains java classes, which help you integrate programs written in Java with Erlang. Erlang is a programming language designed at the Ericsson Computer Science Laboratory. - </description> + </description> <url>http://erlang.org/</url> <licenses> <license> - <name>ERLANG PUBLIC LICENSE 1.1</name> - <url>http://www.erlang.org/EPLICENSE</url> + <name>Apache License 2.0</name> + <url>http://www.apache.org/licenses/LICENSE-2.0</url> <distribution>repo</distribution> </license> </licenses> @@ -37,14 +37,16 @@ <plugin> <groupId>org.apache.maven.plugins</groupId> <artifactId>maven-compiler-plugin</artifactId> + <version>3.5.1</version> <configuration> - <source>1.5</source> - <target>1.5</target> + <source>1.6</source> + <target>1.6</target> </configuration> </plugin> <plugin> <groupId>org.codehaus.mojo</groupId> <artifactId>build-helper-maven-plugin</artifactId> + <version>1.10</version> <executions> <execution> <phase>generate-sources</phase> @@ -59,6 +61,32 @@ </execution> </executions> </plugin> + <plugin> + <groupId>org.apache.maven.plugins</groupId> + <artifactId>maven-source-plugin</artifactId> + <version>3.0.0</version> + <executions> + <execution> + <id>attach-sources</id> + <goals> + <goal>jar-no-fork</goal> + </goals> + </execution> + </executions> + </plugin> + <plugin> + <groupId>org.apache.maven.plugins</groupId> + <artifactId>maven-javadoc-plugin</artifactId> + <version>2.10.3</version> + <executions> + <execution> + <id>attach-javadocs</id> + <goals> + <goal>jar</goal> + </goals> + </execution> + </executions> + </plugin> </plugins> </build> <distributionManagement> @@ -85,7 +113,7 @@ <plugin> <groupId>org.apache.maven.plugins</groupId> <artifactId>maven-gpg-plugin</artifactId> - <version>1.0-alpha-4</version> + <version>1.6</version> <executions> <execution> <id>sign-artifacts</id> diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index 580a896357..47d0c1b861 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -156,7 +156,7 @@ is_allowed(#hs_data{other_node = Node, send_status(HSData, not_allowed), error_msg("** Connection attempt from " "disallowed node ~w ** ~n", [Node]), - ?shutdown(Node); + ?shutdown2(Node, {is_allowed, not_allowed}); _ -> true end. @@ -607,10 +607,10 @@ recv_challenge_reply(#hs_data{socket = Socket, _ -> error_msg("** Connection attempt from " "disallowed node ~w ** ~n", [NodeB]), - ?shutdown(NodeB) + ?shutdown2(NodeB, {recv_challenge_reply_failed, bad_cookie}) end; - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2(no_node, {recv_challenge_reply_failed, Other}) end. recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv, diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 6f9ce17c0c..21bff02214 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -63,7 +63,7 @@ %%------------------------------------------------------------------------ --type state() :: gb_trees:tree(pid(), {pid(), reference()}). +-type state() :: map(). %%------------------------------------------------------------------------ @@ -91,7 +91,7 @@ stop(Rpc) -> init([]) -> process_flag(trap_exit, true), - {ok, gb_trees:empty()}. + {ok, maps:new()}. -spec handle_call(term(), term(), state()) -> {'noreply', state()} | @@ -130,29 +130,15 @@ handle_cast(_, S) -> -spec handle_info(term(), state()) -> {'noreply', state()}. +handle_info({'DOWN', _, process, Caller, normal}, S) -> + {noreply, maps:remove(Caller, S)}; handle_info({'DOWN', _, process, Caller, Reason}, S) -> - case gb_trees:lookup(Caller, S) of - {value, To} -> - receive - {Caller, {reply, Reply}} -> - gen_server:reply(To, Reply) - after 0 -> - gen_server:reply(To, {badrpc, {'EXIT', Reason}}) - end, - {noreply, gb_trees:delete(Caller, S)}; - none -> - {noreply, S} - end; -handle_info({Caller, {reply, Reply}}, S) -> - case gb_trees:lookup(Caller, S) of - {value, To} -> - receive - {'DOWN', _, process, Caller, _} -> - gen_server:reply(To, Reply), - {noreply, gb_trees:delete(Caller, S)} - end; - none -> - {noreply, S} + case maps:get(Caller, S, undefined) of + undefined -> + {noreply, S}; + {_, _} = To -> + gen_server:reply(To, {badrpc, {'EXIT', Reason}}), + {noreply, maps:remove(Caller, S)} end; handle_info({From, {sbcast, Name, Msg}}, S) -> _ = case catch Name ! Msg of %% use catch to get the printout @@ -190,7 +176,6 @@ code_change(_, S, _) -> %% Auxiliary function to avoid a false dialyzer warning -- do not inline %% handle_call_call(Mod, Fun, Args, Gleader, To, S) -> - RpcServer = self(), %% Spawn not to block the rpc server. {Caller,_} = erlang:spawn_monitor( @@ -205,9 +190,9 @@ handle_call_call(Mod, Fun, Args, Gleader, To, S) -> Result -> Result end, - RpcServer ! {self(), {reply, Reply}} + gen_server:reply(To, Reply) end), - {noreply, gb_trees:insert(Caller, To, S)}. + {noreply, maps:put(Caller, To, S)}. %% RPC aid functions .... diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index bf1548591a..eb58e92224 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -634,7 +634,7 @@ monitor_nodes_nodedown_reason(Config) when is_list(Config) -> stop_node(N4), true = net_kernel:disconnect(N2), TickTime = net_kernel:get_net_ticktime(), - SleepTime = TickTime + (TickTime div 4), + SleepTime = TickTime + (TickTime div 2), spawn(N3, fun () -> block_emu(SleepTime*1000), halt() @@ -911,15 +911,14 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> %% Verify that '{nodeup, Node}' comes before '{NodeMsg, 1}' (the message %% bringing up the connection). - no_msgs(500), {nodeup, Node} = receive Msg1 -> Msg1 end, - {NodeMsg, 1} = receive Msg2 -> Msg2 end, + {NodeMsg, N} = receive Msg2 -> Msg2 end, %% msg stream has begun, kill the node RemotePid ! {self(), kill_it}, %% Verify that '{nodedown, Node}' comes after the last '{NodeMsg, N}' %% message. - {nodedown, Node} = flush_node_msgs(NodeMsg, 2), + {nodedown, Node} = flush_node_msgs(NodeMsg, N+1), no_msgs(500), Mon = erlang:monitor(process, MN), @@ -932,8 +931,10 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> flush_node_msgs(NodeMsg, No) -> case receive Msg -> Msg end of - {NodeMsg, No} -> flush_node_msgs(NodeMsg, No+1); - OtherMsg -> OtherMsg + {NodeMsg, N} when N >= No -> + flush_node_msgs(NodeMsg, N+1); + OtherMsg -> + OtherMsg end. node_loop_send(Pid, Msg, No) -> diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 000994751f..be23a1933f 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -498,7 +498,13 @@ match_set_seq_token(Config) when is_list(Config) -> exit(P2, timeout), {error, "Test node hung"} end, - ok = check_match_set_seq_token_log(Lbl, Log), + + %% Sort the log on Pid, as events from different processes + %% are not guaranteed to arrive in a certain order to the + %% tracer + SortedLog = lists:keysort(2, Log), + + ok = check_match_set_seq_token_log(Lbl, SortedLog), %% stop_node(Sandbox), ok. @@ -551,13 +557,13 @@ do_match_set_seq_token(Label) -> check_match_set_seq_token_log( Label, - [{trace,C,call,{?MODULE,countdown,[B,Ref]}, {0,Label,0,C,0}}, + [{trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,2,B,1}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,4,B,3}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,6,B,5}}, + {trace,C,call,{?MODULE,countdown,[B,Ref]}, {0,Label,0,C,0}}, {trace,C,call,{?MODULE,countdown,[B,Ref,3]},{0,Label,0,C,0}}, - {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,2,B,1}}, {trace,C,call,{?MODULE,countdown,[B,Ref,2]},{0,Label,2,B,1}}, - {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,4,B,3}}, {trace,C,call,{?MODULE,countdown,[B,Ref,1]},{0,Label,4,B,3}}, - {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,6,B,5}}, {trace,C,call,{?MODULE,countdown,[B,Ref,0]},{0,Label,6,B,5}} ]) -> ok; diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index d37623d1cc..220276ac0c 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -250,7 +250,6 @@ sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> create_mem_info(Parent) -> Panel = wxPanel:new(Parent), - wxWindow:setBackgroundColour(Panel, {255,255,255}), Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES, Grid = wxListCtrl:new(Panel, [{style, Style}]), Li = wxListItem:new(), diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index f0b8a004ec..5d5ac37ce9 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -122,7 +122,7 @@ display_yes_no_dialog(Str) -> %% display_info(Parent, [{Title, [{Label, Info}]}]) -> {Panel, Sizer, InfoFieldsToUpdate} display_info(Frame, Info) -> Panel = wxPanel:new(Frame), - wxWindow:setBackgroundColour(Panel, {255,255,255}), + wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), Sizer = wxBoxSizer:new(?wxVERTICAL), wxSizer:addSpacer(Sizer, 5), Add = fun(BoxInfo) -> @@ -201,22 +201,21 @@ update_info2([Scroll = {_, _, _}|Fs], [{_, NewInfo}|Rest]) -> update_scroll_boxes(Scroll, NewInfo), update_info2(Fs, Rest); update_info2([Field|Fs], [{_Str, {click, Value}}|Rest]) -> - wxTextCtrl:setValue(Field, to_str(Value)), + wxStaticText:setLabel(Field, to_str(Value)), update_info2(Fs, Rest); update_info2([Field|Fs], [{_Str, Value}|Rest]) -> - wxTextCtrl:setValue(Field, to_str(Value)), + wxStaticText:setLabel(Field, to_str(Value)), update_info2(Fs, Rest); update_info2([Field|Fs], [undefined|Rest]) -> - wxTextCtrl:setValue(Field, ""), + wxStaticText:setLabel(Field, ""), update_info2(Fs, Rest); update_info2([], []) -> ok. update_scroll_boxes({_, _, 0}, {_, []}) -> ok; update_scroll_boxes({Win, Sizer, _}, {Type, List}) -> [wxSizerItem:deleteWindows(Child) || Child <- wxSizer:getChildren(Sizer)], - BC = wxWindow:getBackgroundColour(Win), Cursor = wxCursor:new(?wxCURSOR_HAND), - add_entries(Type, List, Win, Sizer, BC, Cursor), + add_entries(Type, List, Win, Sizer, Cursor), wxCursor:destroy(Cursor), wxSizer:recalcSizes(Sizer), wxWindow:refresh(Win), @@ -379,25 +378,22 @@ add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) -> wxScrolledWindow:setScrollbars(Scroll,1,1,0,0), ScrollSizer = wxBoxSizer:new(?wxVERTICAL), wxScrolledWindow:setSizer(Scroll, ScrollSizer), - BC = wxWindow:getBackgroundColour(Panel), - wxWindow:setBackgroundColour(Scroll,BC), - add_entries(Format, List, Scroll, ScrollSizer, BC, Cursor), + wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM), + add_entries(Format, List, Scroll, ScrollSizer, Cursor), wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]), wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]), {Scroll,ScrollSizer,length(List)}. -add_entries(click, List, Scroll, ScrollSizer, BC, Cursor) -> +add_entries(click, List, Scroll, ScrollSizer, Cursor) -> Add = fun(Link) -> TC = link_entry(Scroll, Link, Cursor), - wxWindow:setBackgroundColour(TC,BC), - wxSizer:add(ScrollSizer,TC,[{flag,?wxEXPAND}]) + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) end, [Add(Link) || Link <- List]; -add_entries(plain, List, Scroll, ScrollSizer, _, _) -> +add_entries(plain, List, Scroll, ScrollSizer, _) -> Add = fun(String) -> - TC = wxTextCtrl:new(Scroll, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,String}]), + TC = wxStaticText:new(Scroll, ?wxID_ANY, String), wxSizer:add(ScrollSizer,TC,[{flag,?wxEXPAND}]) end, [Add(String) || String <- List]. @@ -435,51 +431,44 @@ create_box(Panel, {scroll_boxes,Data}) -> wxSizer:layout(OuterBox), {OuterBox, Boxes}; -create_box(Panel, Data) -> +create_box(Parent, Data) -> {Title, Align, Info} = get_box_info(Data), - Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]), - LeftSize = get_max_size(Panel,Info), - LeftProportion = [{proportion,0}], - RightProportion = [{proportion,1}, {flag, Align bor ?wxEXPAND}], + Top = wxStaticBoxSizer:new(?wxVERTICAL, Parent, [{label, Title}]), + Panel = wxPanel:new(Parent), + Box = wxBoxSizer:new(?wxVERTICAL), + LeftSize = get_max_width(Panel,Info), + RightProportion = [{flag, Align bor ?wxEXPAND}], AddRow = fun({Desc0, Value0}) -> Desc = Desc0++":", Line = wxBoxSizer:new(?wxHORIZONTAL), - wxSizer:add(Line, - wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {size,LeftSize}, - {value,Desc}]), - LeftProportion), + Label = wxStaticText:new(Panel, ?wxID_ANY, Desc), + wxSizer:add(Line, 5, 0), + wxSizer:add(Line, Label), + wxSizer:setItemMinSize(Line, Label, LeftSize, -1), Field = case Value0 of {click,"unknown"} -> - wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,"unknown"}]); + wxStaticText:new(Panel, ?wxID_ANY,"unknown"); {click,Value} -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - TCtrl = wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,Value}]), + TCtrl = wxStaticText:new(Panel, ?wxID_ANY,Value), length(Value) > 50 andalso wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), TCtrl end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally wxSizer:add(Line, Field, RightProportion), - - {_,H,_,_} = wxTextCtrl:getTextExtent(Field,"Wj"), - wxTextCtrl:setMinSize(Field,{0,H}), - - wxSizer:add(Box, Line, [{proportion,0},{flag,?wxEXPAND}]), + wxSizer:add(Box, Line, [{proportion,1},{flag,?wxEXPAND}]), Field; (undefined) -> undefined end, InfoFields = [AddRow(Entry) || Entry <- Info], - {Box, InfoFields}. + wxWindow:setSizer(Panel, Box), + wxSizer:add(Top, Panel, [{proportion,1},{flag,?wxEXPAND}]), + {Top, InfoFields}. link_entry(Panel, Link) -> Cursor = wxCursor:new(?wxCURSOR_HAND), @@ -490,13 +479,12 @@ link_entry(Panel, Link, Cursor) -> link_entry2(Panel, to_link(Link), Cursor). link_entry2(Panel,{Target,Str},Cursor) -> - TC = wxTextCtrl:new(Panel, ?wxID_ANY, [{style, ?SINGLE_LINE_STYLE}]), - wxTextCtrl:setForegroundColour(TC,?wxBLUE), - wxTextCtrl:appendText(TC, Str), + TC = wxStaticText:new(Panel, ?wxID_ANY, Str), + wxWindow:setForegroundColour(TC,?wxBLUE), wxWindow:setCursor(TC, Cursor), - wxTextCtrl:connect(TC, left_down, [{userData,Target}]), - wxTextCtrl:connect(TC, enter_window), - wxTextCtrl:connect(TC, leave_window), + wxWindow:connect(TC, left_down, [{userData,Target}]), + wxWindow:connect(TC, enter_window), + wxWindow:connect(TC, leave_window), ToolTip = wxToolTip:new("Click to see properties for " ++ Str), wxWindow:setToolTip(TC, ToolTip), TC. @@ -521,23 +509,12 @@ html_window(Panel, Html) -> wxHtmlWindow:setPage(Win, Html), Win. -get_max_size(Panel,Info) -> - Txt = wxTextCtrl:new(Panel, ?wxID_ANY, []), - Size = get_max_size(Txt,Info,0,0), - wxTextCtrl:destroy(Txt), - Size. - -get_max_size(Txt,[{Desc,_}|Info],MaxX,MaxY) -> - {X,Y,_,_} = wxTextCtrl:getTextExtent(Txt,Desc++":"), - if X>MaxX -> - get_max_size(Txt,Info,X,Y); - true -> - get_max_size(Txt,Info,MaxX,MaxY) - end; -get_max_size(Txt,[undefined|Info],MaxX,MaxY) -> - get_max_size(Txt,Info,MaxX,MaxY); -get_max_size(_,[],X,_Y) -> - {X+2,-1}. +get_max_width(Parent,Info) -> + lists:foldl(fun({Desc,_}, Max) -> + {W, _, _, _} = wxWindow:getTextExtent(Parent, Desc), + max(W,Max); + (_, Max) -> Max + end, 0, Info). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% set_listctrl_col_size(LCtrl, Total) -> diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 017f07d2c4..45af08026a 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -100,7 +100,7 @@ setup_graph_drawing(Panels) -> IsWindows = element(1, os:type()) =:= win32, IgnoreCB = {callback, fun(_,_) -> ok end}, Do = fun(#win{panel=Panel}) -> - wxWindow:setBackgroundColour(Panel, ?wxWHITE), + wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), wxPanel:connect(Panel, paint, [callback]), IsWindows andalso wxPanel:connect(Panel, erase_background, [IgnoreCB]) diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 9d6aa84384..cff5fbb474 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -125,11 +125,11 @@ handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> {noreply, State}; handle_event(#wx{obj=Obj, event=#wxMouse{type=enter_window}}, State) -> - wxTextCtrl:setForegroundColour(Obj,{0,0,100,255}), + wxStaticText:setForegroundColour(Obj,{0,0,100,255}), {noreply, State}; handle_event(#wx{obj=Obj, event=#wxMouse{type=leave_window}}, State) -> - wxTextCtrl:setForegroundColour(Obj,?wxBLUE), + wxStaticText:setForegroundColour(Obj,?wxBLUE), {noreply, State}; handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index a795c4fe25..73ed890802 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -101,7 +101,7 @@ end_per_group(_GroupName, Config) -> init_per_suite(Config) when is_list(Config) -> delete_saved(Config), DataDir = ?config(data_dir,Config), - Rels = [R || R <- [r16b,'17'], ?t:is_release_available(R)] ++ [current], + Rels = [R || R <- ['17','18'], ?t:is_release_available(R)] ++ [current], io:format("Creating crash dumps for the following releases: ~p", [Rels]), AllDumps = create_dumps(DataDir,Rels), [{dumps,AllDumps}|Config]. @@ -606,21 +606,21 @@ dos_dump(DataDir,Rel,Dump) -> rel_opt(Rel) -> case Rel of - r16b -> [{erl,[{release,"r16b_latest"}]}]; '17' -> [{erl,[{release,"17_latest"}]}]; + '18' -> [{erl,[{release,"18_latest"}]}]; current -> [] end. dump_prefix(Rel) -> case Rel of - r16b -> "r16b_dump."; '17' -> "r17_dump."; - current -> "r18_dump." + '18' -> "r18_dump."; + current -> "r19_dump." end. compat_rel(Rel) -> case Rel of - r16b -> "+R16 "; '17' -> "+R17 "; + '18' -> "+R18 "; current -> "" end. diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml index eab1848e88..4a87133c57 100644 --- a/lib/runtime_tools/doc/src/LTTng.xml +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -240,6 +240,222 @@ $ make </code> </section> <section> + <title>BEAM Tracepoints</title> + <p>All tracepoints are in the domain of <c>com_ericsson_otp</c></p> + <p>All Erlang types are the string equivalent in LTTng.</p> + + <p><em>scheduler_poll</em></p> + <list type="bulleted"> + <item><c>scheduler : integer</c> :: Scheduler ID. Ex. <c>1</c></item> + <item><c>runnable : integer</c> :: Runnable. Ex. <c>1</c></item> + </list> + <p>Example:</p> + <p><code type="none">scheduler_poll: { cpu_id = 4 }, { scheduler = 1, runnable = 1 }</code></p> + + <p><em>driver_init</em></p> + <list type="bulleted"> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>major : integer</c> :: Major version. Ex. <c>3</c></item> + <item><c>minor : integer</c> :: Minor version. Ex. <c>1</c></item> + <item><c>flags : integer</c> :: Flags. Ex. <c>1</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_init: { cpu_id = 2 }, { driver = "caller_drv", major = 3, minor = 3, flags = 1 }</code></p> + + <p><em>driver_start</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_start: { cpu_id = 2 }, { pid = "<0.198.0>", driver = "caller_drv", port = "#Port<0.3676>" }</code></p> + + <p><em>driver_output</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_output: { cpu_id = 2 }, { pid = "<0.198.0>", port = "#Port<0.3677>", driver = "/bin/sh -s unix:cmd", bytes = 36 }</code></p> + + <p><em>driver_outputv</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_outputv: { cpu_id = 5 }, { pid = "<0.194.0>", port = "#Port<0.3663>", driver = "tcp_inet", bytes = 3 }</code></p> + + <p><em>driver_ready_input</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_ready_input: { cpu_id = 5 }, { pid = "<0.189.0>", port = "#Port<0.3637>", driver = "inet_gethost 4 " }</code></p> + + <p><em>driver_ready_output</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_ready_output: { cpu_id = 5 }, { pid = "<0.194.0>", port = "#Port<0.3663>", driver = "tcp_inet" }</code></p> + + <p><em>driver_timeout</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_timeout: { cpu_id = 5 }, { pid = "<0.196.0>", port = "#Port<0.3664>", driver = "tcp_inet" }</code></p> + + <p><em>driver_stop_select</em></p> + <list type="bulleted"> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_stop_select: { cpu_id = 5 }, { driver = "unknown" }</code></p> + + <p><em>driver_flush</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_flush: { cpu_id = 7 }, { pid = "<0.204.0>", port = "#Port<0.3686>", driver = "tcp_inet" }</code></p> + + <p><em>driver_stop</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_stop: { cpu_id = 5 }, { pid = "[]", port = "#Port<0.3673>", driver = "efile" }</code></p> + + <p><em>driver_process_exit</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + + <p><em>driver_ready_async</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_ready_async: { cpu_id = 3 }, { pid = "<0.181.0>", port = "#Port<0.3622>", driver = "efile" }</code></p> + + <p><em>driver_call</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_call: { cpu_id = 2 }, { pid = "<0.202.0>", port = "#Port<0.3676>", driver = "caller_drv", command = 0, bytes = 2 }</code></p> + + <p><em>driver_control</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_control: { cpu_id = 3 }, { pid = "<0.32767.8191>", port = "#Port<0.0>", driver = "forker", command = 83, bytes = 32 }</code></p> + + <p><em>aio_pool_get</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>length : integer</c> :: Async queue length. Ex. <c>0</c></item> + </list> + <p>Example:</p> + <p><code type="none">aio_pool_get: { cpu_id = 4 }, { port = "#Port<0.3614>", length = 0 }</code></p> + + <p><em>aio_pool_put</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>length : integer</c> :: Async queue length. Ex. <c>-1</c></item> + </list> + <p>Async queue length is not defined for <c>put</c> operations.</p> + <p>Example:</p> + <p><code type="none">aio_pool_put: { cpu_id = 3 }, { port = "#Port<0.3614>", length = -1 }</code></p> + + <p><em>carrier_create</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + <item><c>mbc_carriers : integer</c> :: Number of multiblock carriers in instance. Ex. <c>3</c></item> + <item><c>mbc_carriers_size : integer</c> :: Total size of multiblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>mbc_blocks : integer</c> :: Number of multiblock blocks in instance. Ex. <c>122</c></item> + <item><c>mbc_blocks_size : integer</c> :: Total size of all multiblock blocks in instance. Ex. <c>285296</c></item> + <item><c>sbc_carriers : integer</c> :: Number of singleblock carriers in instance. Ex. <c>1</c></item> + <item><c>sbc_carriers_size : integer</c> :: Total size of singleblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>sbc_blocks : integer</c> :: Number of singleblocks in instance. Ex. <c>1</c></item> + <item><c>sbc_blocks_size : integer</c> :: Total size of all singleblock blocks in instance. Ex. <c>285296</c></item> + + </list> + <p>Example:</p> + <p><code type="none">carrier_create: { cpu_id = 2 }, { type = "ets_alloc", instance = 7, size = 2097152, mbc_carriers = 4, mbc_carriers_size = 3440640, mbc_blocks = 526, mbc_blocks_size = 1278576, sbc_carriers = 0, sbc_carriers_size = 0, sbc_blocks = 0, sbc_blocks_size = 0 }</code></p> + + <p><em>carrier_destroy</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + <item><c>mbc_carriers : integer</c> :: Number of multiblock carriers in instance. Ex. <c>3</c></item> + <item><c>mbc_carriers_size : integer</c> :: Total size of multiblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>mbc_blocks : integer</c> :: Number of multiblock blocks in instance. Ex. <c>122</c></item> + <item><c>mbc_blocks_size : integer</c> :: Total size of all multiblock blocks in instance. Ex. <c>285296</c></item> + <item><c>sbc_carriers : integer</c> :: Number of singleblock carriers in instance. Ex. <c>1</c></item> + <item><c>sbc_carriers_size : integer</c> :: Total size of singleblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>sbc_blocks : integer</c> :: Number of singleblocks in instance. Ex. <c>1</c></item> + <item><c>sbc_blocks_size : integer</c> :: Total size of all singleblock blocks in instance. Ex. <c>285296</c></item> + + </list> + <p>Example:</p> + <p><code type="none">carrier_destroy: { cpu_id = 6 }, { type = "ets_alloc", instance = 7, size = 262144, mbc_carriers = 3, mbc_carriers_size = 3178496, mbc_blocks = 925, mbc_blocks_size = 2305336, sbc_carriers = 0, sbc_carriers_size = 0, sbc_blocks = 0, sbc_blocks_size = 0 }</code></p> + + <p><em>carrier_pool_put</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + </list> + <p>Example:</p> + <p><code type="none">carrier_pool_put: { cpu_id = 3 }, { type = "ets_alloc", instance = 5, size = 1048576 }</code></p> + + <p><em>carrier_pool_get</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + </list> + <p>Example:</p> + <p><code type="none">carrier_pool_get: { cpu_id = 7 }, { type = "ets_alloc", instance = 4, size = 3208 }</code></p> + + </section> + + + <section> <title>Examples</title> </section> </chapter> diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index ad7ee7311c..1add01612d 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -28,31 +28,25 @@ -behaviour(gen_server). %% API --export([ - report/0, +-export([report/0, from_file/1, - to_file/1 - ]). --export([ - start/0, stop/0, - load_report/0, load_report/2, - applications/0, applications/1, - application/1, application/2, - environment/0, environment/1, - module/1, module/2, - modules/1, - sanity_check/0 - ]). + to_file/1]). +-export([start/0, stop/0, + load_report/0, load_report/2, + applications/0, applications/1, + application/1, application/2, + environment/0, environment/1, + module/1, module/2, + modules/1, + sanity_check/0]). %% gen_server callbacks --export([ - init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3 - ]). +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). -define(SERVER, ?MODULE). @@ -71,13 +65,13 @@ start() -> gen_server:start({local, ?SERVER}, ?MODULE, [], []). stop() -> - gen_server:call(?SERVER, stop). + gen_server:call(?SERVER, stop, infinity). load_report() -> load_report(data, report()). load_report(file, File) -> load_report(data, from_file(File)); load_report(data, Report) -> - start(), gen_server:call(?SERVER, {load_report, Report}). + start(), gen_server:call(?SERVER, {load_report, Report}, infinity). report() -> [ {init_arguments, init:get_arguments()}, @@ -120,22 +114,22 @@ from_file(File) -> applications() -> applications([]). applications(Opts) when is_list(Opts) -> - gen_server:call(?SERVER, {applications, Opts}). + gen_server:call(?SERVER, {applications, Opts}, infinity). application(App) when is_atom(App) -> application(App, []). application(App, Opts) when is_atom(App), is_list(Opts) -> - gen_server:call(?SERVER, {application, App, Opts}). + gen_server:call(?SERVER, {application, App, Opts}, infinity). environment() -> environment([]). environment(Opts) when is_list(Opts) -> - gen_server:call(?SERVER, {environment, Opts}). + gen_server:call(?SERVER, {environment, Opts}, infinity). module(M) when is_atom(M) -> module(M, []). module(M, Opts) when is_atom(M), is_list(Opts) -> - gen_server:call(?SERVER, {module, M, Opts}). + gen_server:call(?SERVER, {module, M, Opts}, infinity). modules(Opt) when is_atom(Opt) -> - gen_server:call(?SERVER, {modules, Opt}). + gen_server:call(?SERVER, {modules, Opt}, infinity). -spec sanity_check() -> ok | {failed, Failures} when diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index 9c9d6ca352..0777503ef7 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -167,8 +167,8 @@ distributed(Config) when is_list(Config) -> {value, {matched, Node, 1}} = lists:keysearch(Node, 2, Z), dbg:cn(Node), dbg:tp(dbg,ln,[]), - ok = rpc:call(Node, dbg, ltp, []), - ok = rpc:call(Node, dbg, ln, []), + ok = rpc:block_call(Node, dbg, ltp, []), + ok = rpc:block_call(Node, dbg, ln, []), ok = dbg:ln(), S = self(), {TraceSend, TraceCall} = @@ -447,12 +447,6 @@ file_port_schedfix1(Config) when is_list(Config) -> %% {ok,[{matched,_,_}]} = dbg:p(all, [clear]), stop(), - % Some debug code to run on all platforms, for finding the fault on genny - % Dont touch please /PaN - io:format("Trace dump by PaN BEGIN~n"), - dbg:trace_client(file,{FName, wrap, ".wraplog"},{fun(end_of_trace,Pid)-> Pid ! done; (Mesg,Pid) -> io:format("~w~n",[Mesg]),Pid end,self()}), - receive done -> ok end, - io:format("Trace dump by PaN END~n"), %% %% Get the trace result %% @@ -473,14 +467,12 @@ file_port_schedfix1(Config) when is_list(Config) -> %% %% Analyze the result %% - {Min, Max} = - lists:foldl( - fun({_Pid, M}, {Mi, Ma}) -> - {if M < Mi -> M; true -> Mi end, - if M > Ma -> M; true -> Ma end} - end, - {void, 0}, - Result), + {Min, Max} = lists:foldl(fun({_Pid, M}, {Mi, Ma}) -> + {if M < Mi -> M; true -> Mi end, + if M > Ma -> M; true -> Ma end} + end, + {void, 0}, + Result), % More PaN debug io:format("Min = ~f, Max = ~f~n",[Min,Max]), %% @@ -895,6 +887,10 @@ schedstat_handler(TraceMsg, {Parent, Tag, Data} = State) -> Data end, {Parent, Tag, NewData}; + {trace_ts,_Pid,spawned,_OtherPid,_,_Ts} -> + State; + {trace_ts,_Pid,getting_linked,_OtherPid,_Ts} -> + State; {trace_ts, Pid, exit, normal, {A3, B3, C3}} -> NewData = case lists:keysearch(Pid, 1, Data) of diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 33aacb8ffe..ff2d6e082a 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -360,7 +360,8 @@ </type> <desc> <p>Starts a server listening for SSH connections on the given - port.</p> + port. If the <c>Port</c> is 0, a random free port is selected. See + <seealso marker="#daemon_info/1">daemon_info/1</seealso> about how to find the selected port number.</p> <p>Options:</p> <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> @@ -682,6 +683,18 @@ </func> <func> + <name>daemon_info(Daemon) -> {ok, [{port,Port}]} | {error,Error}</name> + <fsummary>Get info about a daemon</fsummary> + <type> + <v>Port = integer()</v> + <v>Error = bad_daemon_ref</v> + </type> + <desc> + <p>Returns a key-value list with information about the daemon. For now, only the listening port is returned. This is intended for the case the daemon is started with the port set to 0.</p> + </desc> + </func> + + <func> <name>default_algorithms() -> algs_list()</name> <fsummary>Get a list declaring the supported algorithms</fsummary> <desc> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 1d37933369..071d46ec57 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -44,24 +44,41 @@ </p> <taglist> + <tag><c>reason()</c></tag> + <item> + <p>= <c>atom()</c> A description of the reason why an operation failed.</p> + <p> + The value is formed from the sftp error codes in the protocol-level responses as defined in + <url href="https://tools.ietf.org/id/draft-ietf-secsh-filexfer-13.txt">draft-ietf-secsh-filexfer-13.txt</url> + section 9.1. + </p> + <p> + The codes are named as <c>SSH_FX_*</c> which are transformed into lowercase of the star-part. + E.g. the error code <c>SSH_FX_NO_SUCH_FILE</c> + will cause the <c>reason()</c> to be <c>no_such_file</c>. + </p> + </item> + <tag><c>ssh_connection_ref() =</c></tag> - <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item> + <item><p><c>opaque()</c> - as returned by + <seealso marker="ssh#connect-3"><c>ssh:connect/3</c></seealso></p></item> + <tag><c>timeout()</c></tag> - <item><p>= <c>infinity | integer() in milliseconds. Default infinity.</c></p></item> + <item><p>= <c>infinity | integer()</c> in milliseconds. Default infinity.</p></item> </taglist> </section> <section> <title>Time-outs</title> <p>If the request functions for the SFTP channel return <c>{error, timeout}</c>, - it does not guarantee that the request never reached the server and was - not performed. It only means that no answer was received from the - server within the expected time.</p> + no answer was received from the server within the expected time.</p> + <p>The request may have reached the server and may have been performed. + However, no answer was received from the server within the expected time.</p> </section> <funcs> <func> - <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, Reason}</name> + <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, reason()}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -69,16 +86,15 @@ <v>Position = integer()</v> <v>Len = integer()</v> <v>N = term()</v> - <v>Reason = term()</v> </type> - - <desc><p>The <c><![CDATA[apread]]></c> function reads from a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[aread]]></c> functions.</p> - <p><seealso marker="#apread-4">ssh_sftp:apread/4</seealso></p> </desc> + <desc><p>The <c><![CDATA[apread/4]]></c> function reads from a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#aread-3"><c>aread/3</c></seealso> functions.</p> + </desc> </func> <func> - <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> + <name>apwrite(ChannelPid, Handle, Position, Data) -> {async, N} | {error, reason()}</name> <fsummary>Writes asynchronously to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -87,16 +103,16 @@ <v>Len = integer()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> + <v>N = term()</v> </type> - <desc> - <p><c><![CDATA[apwrite]]></c> writes on a specified position, combining - the <c><![CDATA[position]]></c> and <c><![CDATA[awrite]]></c> operations.</p> - <p><seealso marker="#awrite-3">ssh_sftp:awrite/3</seealso> </p></desc> + <desc><p>The <c><![CDATA[apwrite/4]]></c> function writes to a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#awrite-3"><c>awrite/3</c></seealso> functions.</p> + </desc> </func> <func> - <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, Error}</name> + <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, reason()}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -104,7 +120,6 @@ <v>Position = integer()</v> <v>Len = integer()</v> <v>N = term()</v> - <v>Reason = term()</v> </type> <desc> <p>Reads from an open file, without waiting for the result. If the @@ -113,14 +128,12 @@ The actual data is sent as a message to the calling process. This message has the form <c><![CDATA[{async_reply, N, Result}]]></c>, where <c><![CDATA[Result]]></c> is the result from the read, either <c><![CDATA[{ok, Data}]]></c>, - <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> + <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, reason()}]]></c>.</p> </desc> </func> - - <func> - <name>awrite(ChannelPid, Handle, Data) -> ok | {error, Reason}</name> + <name>awrite(ChannelPid, Handle, Data) -> {async, N} | {error, reason()}</name> <fsummary>Writes asynchronously to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -129,7 +142,6 @@ <v>Len = integer()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes to an open file, without waiting for the result. If the @@ -138,19 +150,18 @@ <c><![CDATA[awrite]]></c>. The result of the <c><![CDATA[write]]></c> operation is sent as a message to the calling process. This message has the form <c><![CDATA[{async_reply, N, Result}]]></c>, where <c><![CDATA[Result]]></c> is the result - from the write, either <c><![CDATA[ok]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> + from the write, either <c><![CDATA[ok]]></c>, or <c><![CDATA[{error, reason()}]]></c>.</p> </desc> </func> <func> <name>close(ChannelPid, Handle) -></name> - <name>close(ChannelPid, Handle, Timeout) -> ok | {error, Reason}</name> + <name>close(ChannelPid, Handle, Timeout) -> ok | {error, reason()}</name> <fsummary>Closes an open handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Closes a handle to an open file or directory on the server.</p> @@ -159,29 +170,27 @@ <func> <name>delete(ChannelPid, Name) -></name> - <name>delete(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>delete(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Deletes a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Deletes the file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#delete-1">file:delete/1</seealso></p> + <p>Deletes the file specified by <c><![CDATA[Name]]></c>. + </p> </desc> </func> <func> <name>del_dir(ChannelPid, Name) -></name> - <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Deletes an empty directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Deletes a directory specified by <c><![CDATA[Name]]></c>. @@ -192,7 +201,7 @@ <func> <name>list_dir(ChannelPid, Path) -></name> - <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, Reason}</name> + <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, reason()}</name> <fsummary>Lists the directory.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -200,7 +209,6 @@ <v>Filenames = [Filename]</v> <v>Filename = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Lists the given directory on the server, returning the @@ -210,13 +218,12 @@ <func> <name>make_dir(ChannelPid, Name) -></name> - <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Creates a directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Creates a directory specified by <c><![CDATA[Name]]></c>. <c><![CDATA[Name]]></c> @@ -227,24 +234,23 @@ <func> <name>make_symlink(ChannelPid, Name, Target) -></name> - <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, Reason}</name> + <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, reason()}</name> <fsummary>Creates a symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Target = string()</v> - <v>Reason = term()</v> </type> <desc> <p>Creates a symbolic link pointing to <c><![CDATA[Target]]></c> with the - name <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#make_symlink-2">file:make_symlink/2</seealso></p> + name <c><![CDATA[Name]]></c>. + </p> </desc> </func> <func> <name>open(ChannelPid, File, Mode) -></name> - <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a file and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -253,7 +259,6 @@ <v>Modeflag = read | write | creat | trunc | append | binary</v> <v>Timeout = timeout()</v> <v>Handle = term()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a file on the server and returns a handle, which @@ -262,13 +267,12 @@ </func> <func> <name>opendir(ChannelPid, Path) -></name> - <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a directory and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Path = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a handle to a directory on the server. The handle @@ -278,7 +282,7 @@ <func> <name>open_tar(ChannelPid, Path, Mode) -></name> - <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a tar file on the server to which <c>ChannelPid</c> is connected and returns a handle.</fsummary> <type> @@ -298,7 +302,6 @@ <v>DecryptResult = {ok,PlainBin,CryptoState} | {ok,PlainBin,CryptoState,ChunkSize}</v> <v>CloseFun = (fun(PlainBin,CryptoState) -> {ok,EncryptedBin})</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a handle to a tar file on the server, associated with <c>ChannelPid</c>. @@ -333,7 +336,7 @@ <func> <name>position(ChannelPid, Handle, Location) -></name> - <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition} | {error, Reason}</name> + <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition | {error, reason()}</name> <fsummary>Sets the file position of a file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -343,12 +346,11 @@ <v>Offset = integer()</v> <v>Timeout = timeout()</v> <v>NewPosition = integer()</v> - <v>Reason = term()</v> </type> <desc> <p>Sets the file position of the file referenced by <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, NewPosition}]]></c> (as an absolute offset) if - successful, otherwise <c><![CDATA[{error, Reason}]]></c>. <c><![CDATA[Location]]></c> is + successful, otherwise <c><![CDATA[{error, reason()}]]></c>. <c><![CDATA[Location]]></c> is one of the following:</p> <taglist> <tag><c><![CDATA[Offset]]></c></tag> @@ -379,7 +381,7 @@ <func> <name>pread(ChannelPid, Handle, Position, Len) -></name> - <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, reason()}</name> <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -388,18 +390,16 @@ <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> - <v>Reason = term()</v> </type> - <desc> - <p>The <c><![CDATA[pread]]></c> function reads from a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[read]]></c> functions.</p> - <p><seealso marker="#read-4">ssh_sftp:read/4</seealso></p> - </desc> - </func> + <desc><p>The <c><![CDATA[pread/3,4]]></c> function reads from a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#read-3"><c>read/3,4</c></seealso> functions.</p> + </desc> + </func> <func> <name>pwrite(ChannelPid, Handle, Position, Data) -> ok</name> - <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, Reason}</name> + <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -407,19 +407,16 @@ <v>Position = integer()</v> <v>Data = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> - <desc> - <p>The <c><![CDATA[pread]]></c> function writes to a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[write]]></c> functions.</p> - <p><seealso marker="#write-3">ssh_sftp:write/3</seealso></p> - </desc> + <desc><p>The <c><![CDATA[pwrite/3,4]]></c> function writes to a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#write-3"><c>write/3,4</c></seealso> functions.</p> + </desc> </func> - - <func> + <func> <name>read(ChannelPid, Handle, Len) -></name> - <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, reason()}</name> <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -428,12 +425,11 @@ <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> - <v>Reason = term()</v> </type> <desc> <p>Reads <c><![CDATA[Len]]></c> bytes from the file referenced by <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, Data}]]></c>, <c><![CDATA[eof]]></c>, or - <c><![CDATA[{error, Reason}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, + <c><![CDATA[{error, reason()}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, <c><![CDATA[Data]]></c> is a binary, otherwise it is a string.</p> <p>If the file is read past <c>eof</c>, only the remaining bytes are read and returned. If no bytes are read, <c><![CDATA[eof]]></c> @@ -443,25 +439,22 @@ <func> <name>read_file(ChannelPid, File) -></name> - <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, Reason}</name> + <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, reason()}</name> <fsummary>Reads a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Reads a file from the server, and returns the data in a binary, - like - <seealso marker="kernel:file#read_file-1">file:read_file/1</seealso></p> + <p>Reads a file from the server, and returns the data in a binary.</p> </desc> </func> <func> <name>read_file_info(ChannelPid, Name) -></name> - <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> + <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, reason()}</name> <fsummary>Gets information about a file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -469,35 +462,34 @@ <v>Handle = term()</v> <v>Timeout = timeout()</v> <v>FileInfo = record()</v> - <v>Reason = term()</v> </type> <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the file specified by - <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, - like <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso></p> + <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. See + <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso> + for information about the record. + </p> </desc> </func> <func> <name>read_link(ChannelPid, Name) -></name> - <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, Reason}</name> + <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, reason()}</name> <fsummary>Reads symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Target = string()</v> - <v>Reason = term()</v> </type> <desc> - <p>Reads the link target from the symbolic link specified - by <c><![CDATA[name]]></c>, like - <seealso marker="kernel:file#read_link-1">file:read_link/1</seealso></p> + <p>Reads the link target from the symbolic link specified by <c><![CDATA[name]]></c>. + </p> </desc> </func> <func> - <name>read_link_info(ChannelPid, Name) -> {ok, FileInfo} | {error, Reason}</name> - <name>read_link_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> + <name>read_link_info(ChannelPid, Name) -> {ok, FileInfo} | {error, reason()}</name> + <name>read_link_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, reason()}</name> <fsummary>Gets information about a symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -505,30 +497,31 @@ <v>Handle = term()</v> <v>Timeout = timeout()</v> <v>FileInfo = record()</v> - <v>Reason = term()</v> </type> <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the symbolic - link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, like - <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso></p> + link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. + See + <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso> + for information about the record. + </p> </desc> </func> <func> <name>rename(ChannelPid, OldName, NewName) -> </name> - <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, Reason}</name> + <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, reason()}</name> <fsummary>Renames a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>OldName = string()</v> <v>NewName = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Renames a file named <c><![CDATA[OldName]]></c> and gives it the name - <c><![CDATA[NewName]]></c>, like - <seealso marker="kernel:file#rename-2">file:rename/2</seealso></p> + <c><![CDATA[NewName]]></c>. + </p> </desc> </func> @@ -537,14 +530,13 @@ <name>start_channel(ConnectionRef, Options) -></name> <name>start_channel(Host, Options) -></name> <name>start_channel(Host, Port, Options) -> {ok, Pid} | {ok, Pid, ConnectionRef} | - {error, Reason}</name> + {error, reason()|term()}</name> <fsummary>Starts an SFTP client.</fsummary> <type> <v>Host = string()</v> <v>ConnectionRef = ssh_connection_ref()</v> <v>Port = integer()</v> <v>Options = [{Option, Value}]</v> - <v>Reason = term()</v> </type> <desc> <p>If no connection reference is provided, a connection is set @@ -592,7 +584,7 @@ <func> <name>write(ChannelPid, Handle, Data) -></name> - <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, Reason}</name> + <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -600,61 +592,47 @@ <v>Position = integer()</v> <v>Data = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes <c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. The file is to be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> - flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, Reason}]]></c> + flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, reason()}]]></c> otherwise.</p> - <p>Typical error reasons:</p> - <taglist> - <tag><c><![CDATA[ebadf]]></c></tag> - <item> - <p>File is not opened for writing.</p> - </item> - <tag><c><![CDATA[enospc]]></c></tag> - <item> - <p>No space is left on the device.</p> - </item> - </taglist> </desc> </func> <func> <name>write_file(ChannelPid, File, Iolist) -></name> - <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> + <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> <v>Iolist = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Writes a file to the server, like <seealso - marker="kernel:file#write_file-2">file:write_file/2</seealso> The - file is created if it does not exist. The file is overwritten - if it exists.</p> + <p>Writes a file to the server. The file is created if it does not exist + but overwritten if it exists.</p> </desc> </func> <func> <name>write_file_info(ChannelPid, Name, Info) -></name> - <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, Reason}</name> + <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes information for a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Info = record()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes file information from a <c><![CDATA[file_info]]></c> record to the - file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso></p> + file specified by <c><![CDATA[Name]]></c>. See + <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso> + for information about the record. + </p> </desc> </func> </funcs> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index c67350bf72..3245ba5197 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -40,7 +40,12 @@ {applications, [kernel, stdlib, crypto, public_key]}, {env, []}, {mod, {ssh_app, []}}, - {runtime_dependencies, ["stdlib-2.3","public_key-0.22","kernel-3.0", - "erts-6.0","crypto-3.3"]}]}. + {runtime_dependencies, [ + "crypto-3.3", + "erts-6.0", + "kernel-3.0", + "public_key-1.1", + "stdlib-3.0" + ]}]}. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index d0121e73ba..09b07b7a2a 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -30,12 +30,18 @@ -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, + daemon_info/1, default_algorithms/0, stop_listener/1, stop_listener/2, stop_listener/3, stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3 ]). +%%% Type exports +-export_type([connection_ref/0, + channel_id/0 + ]). + %%-------------------------------------------------------------------- -spec start() -> ok | {error, term()}. -spec start(permanent | transient | temporary) -> ok | {error, term()}. @@ -81,7 +87,7 @@ connect(Host, Port, Options, Timeout) -> ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity), try Transport:connect(Host, Port, [ {active, false} | SocketOptions], ConnectionTimeout) of {ok, Socket} -> - Opts = [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)], + Opts = [{user_pid,self()}, {host,Host} | SshOptions], ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); {error, Reason} -> {error, Reason} @@ -153,6 +159,19 @@ daemon(HostAddr, Port, Options0) -> start_daemon(Host, Port, Options, Inet). %%-------------------------------------------------------------------- +daemon_info(Pid) -> + case catch ssh_system_sup:acceptor_supervisor(Pid) of + AsupPid when is_pid(AsupPid) -> + [Port] = + [Prt || {{ssh_acceptor_sup,any,Prt,default}, + _WorkerPid,worker,[ssh_acceptor]} <- supervisor:which_children(AsupPid)], + {ok, [{port,Port}]}; + + _ -> + {error,bad_daemon_ref} + end. + +%%-------------------------------------------------------------------- -spec stop_listener(pid()) -> ok. -spec stop_listener(inet:ip_address(), integer()) -> ok. %% @@ -223,13 +242,6 @@ default_algorithms() -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -fix_idle_time(SshOptions) -> - case proplists:get_value(idle_time, SshOptions) of - undefined -> - [{idle_time, infinity}|SshOptions]; - _ -> - SshOptions - end. start_daemon(Host, Port, Options, Inet) -> case handle_options(Options) of {error, _Reason} = Error -> @@ -243,32 +255,52 @@ start_daemon(Host, Port, Options, Inet) -> end end. -do_start_daemon(Host0, Port0, Options, SocketOptions) -> - {Host,Port} = try - case proplists:get_value(fd, SocketOptions) of - undefined -> - {Host0,Port0}; - Fd when Port0==0 -> - find_hostport(Fd); - _ -> - {Host0,Port0} - end - catch - _:_ -> throw(bad_fd) - end, - Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE), +do_start_daemon(Host0, Port0, SshOptions, SocketOptions) -> + {Host,Port1} = + try + case proplists:get_value(fd, SocketOptions) of + undefined -> + {Host0,Port0}; + Fd when Port0==0 -> + find_hostport(Fd); + _ -> + {Host0,Port0} + end + catch + _:_ -> throw(bad_fd) + end, + Profile = proplists:get_value(profile, SshOptions, ?DEFAULT_PROFILE), + {Port, WaitRequestControl, Opts} = + case Port1 of + 0 -> %% Allocate the socket here to get the port number... + {_, Callback, _} = + proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}), + {ok,LSock} = ssh_acceptor:callback_listen(Callback, 0, SocketOptions), + {ok,{_,LPort}} = inet:sockname(LSock), + {LPort, + {LSock,Callback}, + [{lsocket,LSock},{lsock_owner,self()}] + }; + _ -> + {Port1, false, []} + end, case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> %% It would proably make more sense to call the %% address option host but that is a too big change at the %% monent. The name is a legacy name! try sshd_sup:start_child([{address, Host}, - {port, Port}, {role, server}, + {port, Port}, + {role, server}, {socket_opts, SocketOptions}, - {ssh_opts, Options}]) of + {ssh_opts, SshOptions} + | Opts]) of {error, {already_started, _}} -> {error, eaddrinuse}; - Result = {Code, _} when (Code == ok) or (Code == error) -> + Result = {ok,_} -> + sync_request_control(WaitRequestControl), + Result; + Result = {error, _} -> Result catch exit:{noproc, _} -> @@ -277,18 +309,31 @@ do_start_daemon(Host0, Port0, Options, SocketOptions) -> Sup -> AccPid = ssh_system_sup:acceptor_supervisor(Sup), case ssh_acceptor_sup:start_child(AccPid, [{address, Host}, - {port, Port}, {role, server}, + {port, Port}, + {role, server}, {socket_opts, SocketOptions}, - {ssh_opts, Options}]) of + {ssh_opts, SshOptions} + | Opts]) of {error, {already_started, _}} -> {error, eaddrinuse}; {ok, _} -> + sync_request_control(WaitRequestControl), {ok, Sup}; Other -> Other end end. +sync_request_control(false) -> + ok; +sync_request_control({LSock,Callback}) -> + receive + {request_control,LSock,ReqPid} -> + ok = Callback:controlling_process(LSock, ReqPid), + ReqPid ! {its_yours,LSock}, + ok + end. + find_hostport(Fd) -> %% Using internal functions inet:open/8 and inet:close/0. %% Don't try this at home unless you know what you are doing! diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 73d6e4d2bc..868f3a9181 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -70,8 +70,6 @@ -record(ssh, { - %%state, %% what it's waiting for - role, %% client | server peer, %% string version of peer address @@ -135,8 +133,8 @@ user, service, userauth_quiet_mode, % boolean() - userauth_supported_methods, % string() eg "keyboard-interactive,password" userauth_methods, % list( string() ) eg ["keyboard-interactive", "password"] + userauth_supported_methods, % string() eg "keyboard-interactive,password" kb_tries_left = 0, % integer(), num tries left for "keyboard-interactive" userauth_preference, available_host_keys, diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index d94dedf1bf..90fd951dcd 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -26,7 +26,8 @@ %% Internal application API -export([start_link/5, - number_of_connections/1]). + number_of_connections/1, + callback_listen/3]). %% spawn export -export([acceptor_init/6, acceptor_loop/6]). @@ -46,15 +47,39 @@ start_link(Port, Address, SockOpts, Opts, AcceptTimeout) -> acceptor_init(Parent, Port, Address, SockOpts, Opts, AcceptTimeout) -> {_, Callback, _} = proplists:get_value(transport, Opts, {tcp, gen_tcp, tcp_closed}), - case (catch do_socket_listen(Callback, Port, [{active, false} | SockOpts])) of - {ok, ListenSocket} -> + + SockOwner = proplists:get_value(lsock_owner, Opts), + LSock = proplists:get_value(lsocket, Opts), + UseExistingSocket = + case catch inet:sockname(LSock) of + {ok,{_,Port}} -> is_pid(SockOwner); + _ -> false + end, + + case UseExistingSocket of + true -> proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Callback, - Port, Address, Opts, ListenSocket, AcceptTimeout); - Error -> - proc_lib:init_ack(Parent, Error), - error + request_ownership(LSock, SockOwner), + acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout); + + false -> + case (catch do_socket_listen(Callback, Port, SockOpts)) of + {ok, ListenSocket} -> + proc_lib:init_ack(Parent, {ok, self()}), + acceptor_loop(Callback, + Port, Address, Opts, ListenSocket, AcceptTimeout); + Error -> + proc_lib:init_ack(Parent, Error), + error + end end. + +request_ownership(LSock, SockOwner) -> + SockOwner ! {request_control,LSock,self()}, + receive + {its_yours,LSock} -> ok + end. + do_socket_listen(Callback, Port0, Opts) -> Port = @@ -62,6 +87,10 @@ do_socket_listen(Callback, Port0, Opts) -> undefined -> Port0; _ -> 0 end, + callback_listen(Callback, Port, Opts). + +callback_listen(Callback, Port, Opts0) -> + Opts = [{active, false}, {reuseaddr,true} | Opts0], case Callback:listen(Port, Opts) of {error, nxdomain} -> Callback:listen(Port, lists:delete(inet6, Opts)); diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index b2f489a971..4f76dbe6f0 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -85,10 +85,7 @@ child_spec(ServerOpts) -> Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), Name = id(Address, Port, Profile), SocketOpts = proplists:get_value(socket_opts, ServerOpts), - StartFunc = {ssh_acceptor, start_link, [Port, Address, - [{active, false}, - {reuseaddr, true}] ++ SocketOpts, - ServerOpts, Timeout]}, + StartFunc = {ssh_acceptor, start_link, [Port, Address, SocketOpts, ServerOpts, Timeout]}, Restart = transient, Shutdown = brutal_kill, Modules = [ssh_acceptor], diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 4b3c21ce3f..49eec8072f 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -135,9 +135,9 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> service = "ssh-connection"}); {error, no_user} -> ErrStr = "Could not determine the users name", - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, - description = ErrStr, - language = "en"}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, + description = ErrStr}) end. userauth_request_msg(#ssh{userauth_preference = []} = Ssh) -> @@ -355,10 +355,10 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, handle_userauth_info_response(#ssh_msg_userauth_info_response{}, _Auth) -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "Server does not support" - "keyboard-interactive", - language = "en"}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Server does not support keyboard-interactive" + }). %%-------------------------------------------------------------------- @@ -420,10 +420,10 @@ check_password(User, Password, Opts, Ssh) -> {false,NewState} -> {false, Ssh#ssh{pwdfun_user_state=NewState}}; disconnect -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = - "Unable to connect using the available authentication methods", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unable to connect using the available authentication methods" + }) end end. diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index de6908bb38..a8e6ebde16 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -68,7 +68,7 @@ %% Internal application API -export([cache_create/0, cache_lookup/2, cache_update/2, cache_delete/1, cache_delete/2, cache_foldl/3, - cache_find/2, + cache_info/2, cache_find/2, get_print_info/1]). -record(state, { @@ -335,6 +335,9 @@ cache_delete(Cache) -> cache_foldl(Fun, Acc, Cache) -> ets:foldl(Fun, Acc, Cache). +cache_info(num_entries, Cache) -> + proplists:get_value(size, ets:info(Cache)). + cache_find(ChannelPid, Cache) -> case ets:match_object(Cache, #channel{user = ChannelPid}) of [] -> diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 397d51de9d..4fb6bc39f3 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -22,13 +22,15 @@ %%% Description : SSH connection protocol --type channel_id() :: integer(). +-type role() :: client | server . +-type connection_ref() :: pid(). +-type channel_id() :: pos_integer(). -define(DEFAULT_PACKET_SIZE, 65536). -define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). -define(DEFAULT_TIMEOUT, 5000). --define(MAX_PROTO_VERSION, 255). +-define(MAX_PROTO_VERSION, 255). % Max length of the hello string %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -241,7 +243,7 @@ -record(channel, { - type, %% "session", "x11", "forwarded-tcpip", "direct-tcpip" + type, %% "session" sys, %% "none", "shell", "exec" "subsystem" user, %% "user" process id (default to cm user) flow_control, diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index a34478732c..d0f2d54c06 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -38,8 +38,7 @@ %% Potential API currently unsupported and not tested -export([window_change/4, window_change/6, - direct_tcpip/6, direct_tcpip/8, tcpip_forward/3, - cancel_tcpip_forward/3, signal/3, exit_status/3]). + signal/3, exit_status/3]). %% Internal application API -export([channel_data/5, handle_msg/3, channel_eof_msg/1, @@ -48,7 +47,7 @@ channel_adjust_window_msg/2, channel_data_msg/3, channel_open_msg/5, channel_open_confirmation_msg/4, channel_open_failure_msg/4, channel_request_msg/4, - global_request_msg/3, request_failure_msg/0, + request_failure_msg/0, request_success_msg/1, bind/4, unbind/3, unbind_channel/2, bound_channel/3, encode_ip/1]). @@ -232,52 +231,6 @@ exit_status(ConnectionHandler, Channel, Status) -> ssh_connection_handler:request(ConnectionHandler, Channel, "exit-status", false, [?uint32(Status)], 0). -direct_tcpip(ConnectionHandler, RemoteHost, - RemotePort, OrigIP, OrigPort, Timeout) -> - direct_tcpip(ConnectionHandler, RemoteHost, RemotePort, OrigIP, OrigPort, - ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, Timeout). - -direct_tcpip(ConnectionHandler, RemoteIP, RemotePort, OrigIP, OrigPort, - InitialWindowSize, MaxPacketSize, Timeout) -> - case {encode_ip(RemoteIP), encode_ip(OrigIP)} of - {false, _} -> - {error, einval}; - {_, false} -> - {error, einval}; - {RIP, OIP} -> - ssh_connection_handler:open_channel(ConnectionHandler, - "direct-tcpip", - [?string(RIP), - ?uint32(RemotePort), - ?string(OIP), - ?uint32(OrigPort)], - InitialWindowSize, - MaxPacketSize, - Timeout) - end. - -tcpip_forward(ConnectionHandler, BindIP, BindPort) -> - case encode_ip(BindIP) of - false -> - {error, einval}; - IPStr -> - ssh_connection_handler:global_request(ConnectionHandler, - "tcpip-forward", true, - [?string(IPStr), - ?uint32(BindPort)]) - end. - -cancel_tcpip_forward(ConnectionHandler, BindIP, Port) -> - case encode_ip(BindIP) of - false -> - {error, einval}; - IPStr -> - ssh_connection_handler:global_request(ConnectionHandler, - "cancel-tcpip-forward", true, - [?string(IPStr), - ?uint32(Port)]) - end. - %%-------------------------------------------------------------------- %%% Internal API %%-------------------------------------------------------------------- @@ -300,22 +253,11 @@ l2b([]) -> channel_data(ChannelId, DataType, Data, Connection, From) when is_list(Data)-> - channel_data(ChannelId, DataType, -%% list_to_binary(Data), Connection, From); - l2b(Data), Connection, From); - %% try list_to_binary(Data) - %% of - %% B -> B - %% catch - %% _:_ -> io:format('BAD BINARY: ~p~n',[Data]), - %% unicode:characters_to_binary(Data) - %% end, - %% Connection, From); + channel_data(ChannelId, DataType, l2b(Data), Connection, From); channel_data(ChannelId, DataType, Data, #connection{channel_cache = Cache} = Connection, From) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of #channel{remote_id = Id, sent_close = false} = Channel0 -> {SendList, Channel} = @@ -331,8 +273,7 @@ channel_data(ChannelId, DataType, Data, FlowCtrlMsgs = flow_control(Replies, Channel, Cache), {{replies, Replies ++ FlowCtrlMsgs}, Connection}; _ -> - gen_fsm:reply(From, {error, closed}), - {noreply, Connection} + {{replies,[{channel_request_reply,From,{error,closed}}]}, Connection} end. handle_msg(#ssh_msg_channel_open_confirmation{recipient_channel = ChannelId, @@ -499,7 +440,8 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type, handle_msg(#ssh_msg_channel_open{channel_type = "session", sender_channel = RemoteId}, - Connection, client) -> + Connection, + client) -> %% Client implementations SHOULD reject any session channel open %% requests to make it more difficult for a corrupt server to attack the %% client. See See RFC 4254 6.1. @@ -509,73 +451,6 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session", {{replies, [{connection_reply, FailMsg}]}, Connection}; -handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip" = Type, - sender_channel = RemoteId, - initial_window_size = RWindowSz, - maximum_packet_size = RPacketSz, - data = Data}, - #connection{channel_cache = Cache, - options = SSHopts} = Connection0, server) -> - <<?UINT32(ALen), Address:ALen/binary, ?UINT32(Port), - ?UINT32(OLen), Orig:OLen/binary, ?UINT32(OrigPort)>> = Data, - - MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0), - - if - MinAcceptedPackSz =< RPacketSz -> - case bound_channel(Address, Port, Connection0) of - undefined -> - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, - [{connection_reply, FailMsg}]}, Connection0}; - ChannelPid -> - {ChannelId, Connection1} = new_channel_id(Connection0), - LWindowSz = ?DEFAULT_WINDOW_SIZE, - LPacketSz = ?DEFAULT_PACKET_SIZE, - Channel = #channel{type = Type, - sys = "none", - user = ChannelPid, - local_id = ChannelId, - recv_window_size = LWindowSz, - recv_packet_size = LPacketSz, - send_window_size = RWindowSz, - send_packet_size = RPacketSz, - send_buf = queue:new() - }, - ssh_channel:cache_update(Cache, Channel), - OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId, - LWindowSz, LPacketSz), - {OpenMsg, Connection} = - reply_msg(Channel, Connection1, - {open, Channel, {forwarded_tcpip, - decode_ip(Address), Port, - decode_ip(Orig), OrigPort}}), - {{replies, [{connection_reply, OpenConfMsg}, - OpenMsg]}, Connection} - end; - - MinAcceptedPackSz > RPacketSz -> - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED, - lists:concat(["Maximum packet size below ",MinAcceptedPackSz, - " not supported"]), "en"), - {{replies, [{connection_reply, FailMsg}]}, Connection0} - end; - - -handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip", - sender_channel = RemoteId}, - Connection, client) -> - %% Client implementations SHOULD reject direct TCP/IP open requests for - %% security reasons. See RFC 4254 7.2. - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, [{connection_reply, FailMsg}]}, Connection}; - - handle_msg(#ssh_msg_channel_open{sender_channel = RemoteId}, Connection, _) -> FailMsg = channel_open_failure_msg(RemoteId, ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED, @@ -786,11 +661,11 @@ handle_msg(#ssh_msg_global_request{name = _Type, handle_msg(#ssh_msg_request_failure{}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> - {{replies, [{channel_requst_reply, From, {failure, <<>>}}]}, + {{replies, [{channel_request_reply, From, {failure, <<>>}}]}, Connection#connection{requests = Rest}}; handle_msg(#ssh_msg_request_success{data = Data}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> - {{replies, [{channel_requst_reply, From, {success, Data}}]}, + {{replies, [{channel_request_reply, From, {success, Data}}]}, Connection#connection{requests = Rest}}; handle_msg(#ssh_msg_disconnect{code = Code, @@ -886,10 +761,6 @@ channel_request_msg(ChannelId, Type, WantReply, Data) -> want_reply = WantReply, data = Data}. -global_request_msg(Type, WantReply, Data) -> - #ssh_msg_global_request{name = Type, - want_reply = WantReply, - data = Data}. request_failure_msg() -> #ssh_msg_request_failure{}. @@ -1059,7 +930,7 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid}, Connection, Reply) -> case lists:keysearch(ChannelId, 1, Requests) of {value, {ChannelId, From}} -> - {{channel_requst_reply, From, Reply}, + {{channel_request_reply, From, Reply}, Connection#connection{requests = lists:keydelete(ChannelId, 1, Requests)}}; false when (Reply == success) or (Reply == failure) -> @@ -1351,11 +1222,6 @@ decode_pty_opts2(<<Code, ?UINT32(Value), Tail/binary>>) -> end, [{Op, Value} | decode_pty_opts2(Tail)]. -decode_ip(Addr) when is_binary(Addr) -> - case inet_parse:address(binary_to_list(Addr)) of - {error,_} -> Addr; - {ok,A} -> A - end. backwards_compatible([], Acc) -> Acc; diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 2bef6a41cd..0327a72c12 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -28,94 +28,90 @@ -module(ssh_connection_handler). --behaviour(gen_fsm). +-behaviour(gen_statem). -include("ssh.hrl"). -include("ssh_transport.hrl"). -include("ssh_auth.hrl"). -include("ssh_connect.hrl"). --compile(export_all). --export([start_link/3]). -%% Internal application API --export([open_channel/6, reply_request/3, request/6, request/7, - global_request/4, send/5, send_eof/2, info/1, info/2, - connection_info/2, channel_info/3, - adjust_window/3, close/2, stop/1, renegotiate/1, renegotiate_data/1, - start_connection/4, - get_print_info/1]). - -%% gen_fsm callbacks --export([hello/2, kexinit/2, key_exchange/2, - key_exchange_dh_gex_init/2, key_exchange_dh_gex_reply/2, - new_keys/2, - service_request/2, connected/2, - userauth/2, - userauth_keyboard_interactive/2, - userauth_keyboard_interactive_info_response/2, - error/2]). - --export([init/1, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, format_status/2, code_change/4]). - --record(state, { - role, - client, - starter, - auth_user, - connection_state, - latest_channel_id = 0, - idle_timer_ref, - transport_protocol, % ex: tcp - transport_cb, - transport_close_tag, - ssh_params, % #ssh{} - from ssh.hrl - socket, % socket() - decoded_data_buffer, % binary() - encoded_data_buffer, % binary() - undecoded_packet_length, % integer() - key_exchange_init_msg, % #ssh_msg_kexinit{} - renegotiate = false, % boolean() - last_size_rekey = 0, - event_queue = [], - connection_queue, - address, - port, - opts, - recbuf - }). - --type state_name() :: hello | kexinit | key_exchange | key_exchange_dh_gex_init | - key_exchange_dh_gex_reply | new_keys | service_request | - userauth | userauth_keyboard_interactive | - userauth_keyboard_interactive_info_response | - connection. - --type gen_fsm_state_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {stop, term(), term()}. - --type gen_fsm_sync_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {reply, term(), state_name(), term()} | - {stop, term(), term(), term()}. +%%==================================================================== +%%% Exports +%%==================================================================== + +%%% Start and stop +-export([start_link/3, + stop/1 + ]). + +%%% Internal application API +-export([start_connection/4, + open_channel/6, + request/6, request/7, + reply_request/3, + send/5, + send_eof/2, + info/1, info/2, + connection_info/2, + channel_info/3, + adjust_window/3, close/2, + disconnect/1, disconnect/2, + get_print_info/1 + ]). + +%%% Behaviour callbacks +-export([handle_event/4, terminate/3, format_status/2, code_change/4]). + +%%% Exports not intended to be used :). They are used for spawning and tests +-export([init_connection_handler/3, % proc_lib:spawn needs this + init_ssh_record/3, % Export of this internal function + % intended for low-level protocol test suites + renegotiate/1, renegotiate_data/1 % Export intended for test cases + ]). %%==================================================================== -%% Internal application API +%% Start / stop %%==================================================================== +%%-------------------------------------------------------------------- +-spec start_link(role(), + inet:socket(), + proplists:proplist() + ) -> {ok, pid()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +start_link(Role, Socket, Options) -> + {ok, proc_lib:spawn_link(?MODULE, init_connection_handler, [Role, Socket, Options])}. + %%-------------------------------------------------------------------- --spec start_connection(client| server, port(), proplists:proplist(), - timeout()) -> {ok, pid()} | {error, term()}. +-spec stop(connection_ref() + ) -> ok | {error, term()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +stop(ConnectionHandler)-> + case call(ConnectionHandler, stop) of + {error, closed} -> + ok; + Other -> + Other + end. + +%%==================================================================== +%% Internal application API +%%==================================================================== + +-define(DefaultTransport, {tcp, gen_tcp, tcp_closed} ). + %%-------------------------------------------------------------------- +-spec start_connection(role(), + inet:socket(), + proplists:proplist(), + timeout() + ) -> {ok, connection_ref()} | {error, term()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . start_connection(client = Role, Socket, Options, Timeout) -> try {ok, Pid} = sshc_sup:start_child([Role, Socket, Options]), - {_, Callback, _} = - proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - ok = socket_control(Socket, Pid, Callback), - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) + ok = socket_control(Socket, Pid, Options), + handshake(Pid, erlang:monitor(process,Pid), Timeout) catch exit:{noproc, _} -> {error, ssh_not_started}; @@ -128,8 +124,8 @@ start_connection(server = Role, Socket, Options, Timeout) -> try case proplists:get_value(parallel_login, SSH_Opts, false) of true -> - HandshakerPid = - spawn_link(fun() -> + HandshakerPid = + spawn_link(fun() -> receive {do_handshake, Pid} -> handshake(Pid, erlang:monitor(process,Pid), Timeout) @@ -148,953 +144,1123 @@ start_connection(server = Role, Socket, Options, Timeout) -> {error, Error} end. -start_the_connection_child(UserPid, Role, Socket, Options) -> - Sups = proplists:get_value(supervisors, Options), - ConnectionSup = proplists:get_value(connection_sup, Sups), - Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), - {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - socket_control(Socket, Pid, Callback), - Pid. - +%%-------------------------------------------------------------------- +%%% Some other module has decided to disconnect. +-spec disconnect(#ssh_msg_disconnect{}) -> no_return(). +-spec disconnect(#ssh_msg_disconnect{}, iodata()) -> no_return(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +disconnect(Msg = #ssh_msg_disconnect{}) -> + throw({keep_state_and_data, + [{next_event, internal, {disconnect, Msg, Msg#ssh_msg_disconnect.description}}]}). -start_link(Role, Socket, Options) -> - {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Socket, Options]])}. +disconnect(Msg = #ssh_msg_disconnect{}, ExtraInfo) -> + throw({keep_state_and_data, + [{next_event, internal, {disconnect, Msg, {Msg#ssh_msg_disconnect.description,ExtraInfo}}}]}). -init([Role, Socket, SshOpts]) -> - process_flag(trap_exit, true), - {NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts), - {Protocol, Callback, CloseTag} = - proplists:get_value(transport, SshOpts, {tcp, gen_tcp, tcp_closed}), - Cache = ssh_channel:cache_create(), - State0 = #state{ - role = Role, - connection_state = #connection{channel_cache = Cache, - channel_id_seed = 0, - port_bindings = [], - requests = [], - options = SshOpts}, - socket = Socket, - decoded_data_buffer = <<>>, - encoded_data_buffer = <<>>, - transport_protocol = Protocol, - transport_cb = Callback, - transport_close_tag = CloseTag, - opts = SshOpts - }, - - State = init_role(State0), - - try init_ssh(Role, NumVsn, StrVsn, SshOpts, Socket) of - Ssh -> - gen_fsm:enter_loop(?MODULE, [], hello, - State#state{ssh_params = Ssh}) - catch - _:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error, State}) - end. -%% Temporary fix for the Nessus error. SYN-> <-SYNACK ACK-> RST-> ? -error(_Event, {Error,State=#state{}}) -> - case Error of - {badmatch,{error,enotconn}} -> - %% {error,enotconn} probably from inet:peername in - %% init_ssh(server,..)/5 called from init/1 - {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}, State}; - _ -> - {stop, {shutdown,{init,Error}}, State} - end; -error(Event, State) -> - %% State deliberately not checked beeing #state. This is a panic-clause... - {stop, {shutdown,{init,{spurious_error,Event}}}, State}. - -%%-------------------------------------------------------------------- --spec open_channel(pid(), string(), iodata(), integer(), integer(), - timeout()) -> {open, channel_id()} | {error, term()}. %%-------------------------------------------------------------------- -open_channel(ConnectionHandler, ChannelType, ChannelSpecificData, - InitialWindowSize, - MaxPacketSize, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {open, self(), ChannelType, - InitialWindowSize, MaxPacketSize, - ChannelSpecificData, - Timeout}). -%%-------------------------------------------------------------------- --spec request(pid(), pid(), channel_id(), string(), boolean(), iodata(), - timeout()) -> success | failure | ok | {error, term()}. +-spec open_channel(connection_ref(), + string(), + iodata(), + pos_integer(), + pos_integer(), + timeout() + ) -> {open, channel_id()} | {error, term()}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +open_channel(ConnectionHandler, + ChannelType, ChannelSpecificData, InitialWindowSize, MaxPacketSize, + Timeout) -> + call(ConnectionHandler, + {open, + self(), + ChannelType, InitialWindowSize, MaxPacketSize, ChannelSpecificData, + Timeout}). + %%-------------------------------------------------------------------- +-spec request(connection_ref(), + pid(), + channel_id(), + string(), + boolean(), + iodata(), + timeout() + ) -> success | failure | ok | {error,timeout}. + +-spec request(connection_ref(), + channel_id(), + string(), + boolean(), + iodata(), + timeout() + ) -> success | failure | ok | {error,timeout}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . request(ConnectionHandler, ChannelPid, ChannelId, Type, true, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data, - Timeout}); + call(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data, Timeout}); request(ConnectionHandler, ChannelPid, ChannelId, Type, false, Data, _) -> - send_all_state_event(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data}). + cast(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data}). -%%-------------------------------------------------------------------- --spec request(pid(), channel_id(), string(), boolean(), iodata(), - timeout()) -> success | failure | {error, timeout}. -%%-------------------------------------------------------------------- request(ConnectionHandler, ChannelId, Type, true, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {request, ChannelId, Type, Data, Timeout}); + call(ConnectionHandler, {request, ChannelId, Type, Data, Timeout}); request(ConnectionHandler, ChannelId, Type, false, Data, _) -> - send_all_state_event(ConnectionHandler, {request, ChannelId, Type, Data}). + cast(ConnectionHandler, {request, ChannelId, Type, Data}). %%-------------------------------------------------------------------- --spec reply_request(pid(), success | failure, channel_id()) -> ok. -%%-------------------------------------------------------------------- +-spec reply_request(connection_ref(), + success | failure, + channel_id() + ) -> ok. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . reply_request(ConnectionHandler, Status, ChannelId) -> - send_all_state_event(ConnectionHandler, {reply_request, Status, ChannelId}). - -%%-------------------------------------------------------------------- --spec global_request(pid(), string(), boolean(), iolist()) -> ok | error. -%%-------------------------------------------------------------------- -global_request(ConnectionHandler, Type, true = Reply, Data) -> - case sync_send_all_state_event(ConnectionHandler, - {global_request, self(), Type, Reply, Data}) of - {ssh_cm, ConnectionHandler, {success, _}} -> - ok; - {ssh_cm, ConnectionHandler, {failure, _}} -> - error - end; -global_request(ConnectionHandler, Type, false = Reply, Data) -> - send_all_state_event(ConnectionHandler, {global_request, self(), Type, Reply, Data}). + cast(ConnectionHandler, {reply_request, Status, ChannelId}). %%-------------------------------------------------------------------- --spec send(pid(), channel_id(), integer(), iodata(), timeout()) -> - ok | {error, timeout} | {error, closed}. -%%-------------------------------------------------------------------- +-spec send(connection_ref(), + channel_id(), + non_neg_integer(), + iodata(), + timeout() + ) -> ok | {error, timeout|closed}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . send(ConnectionHandler, ChannelId, Type, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {data, ChannelId, Type, Data, Timeout}). + call(ConnectionHandler, {data, ChannelId, Type, Data, Timeout}). %%-------------------------------------------------------------------- --spec send_eof(pid(), channel_id()) -> ok | {error, closed}. -%%-------------------------------------------------------------------- +-spec send_eof(connection_ref(), + channel_id() + ) -> ok | {error,closed}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . send_eof(ConnectionHandler, ChannelId) -> - sync_send_all_state_event(ConnectionHandler, {eof, ChannelId}). + call(ConnectionHandler, {eof, ChannelId}). %%-------------------------------------------------------------------- --spec connection_info(pid(), [atom()]) -> proplists:proplist(). +-spec info(connection_ref() + ) -> {ok, [#channel{}]} . + +-spec info(connection_ref(), + pid() | all + ) -> {ok, [#channel{}]} . +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +info(ConnectionHandler) -> + info(ConnectionHandler, all). + +info(ConnectionHandler, ChannelProcess) -> + call(ConnectionHandler, {info, ChannelProcess}). + %%-------------------------------------------------------------------- +-type local_sock_info() :: {inet:ip_address(), non_neg_integer()} | string(). +-type peer_sock_info() :: {inet:ip_address(), non_neg_integer()} | string(). +-type state_info() :: iolist(). + +-spec get_print_info(connection_ref() + ) -> {{local_sock_info(), peer_sock_info()}, + state_info() + }. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . get_print_info(ConnectionHandler) -> - sync_send_all_state_event(ConnectionHandler, get_print_info, 1000). + call(ConnectionHandler, get_print_info, 1000). +%%-------------------------------------------------------------------- +-spec connection_info(connection_ref(), + [atom()] + ) -> proplists:proplist(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . connection_info(ConnectionHandler, Options) -> - sync_send_all_state_event(ConnectionHandler, {connection_info, Options}). + call(ConnectionHandler, {connection_info, Options}). %%-------------------------------------------------------------------- --spec channel_info(pid(), channel_id(), [atom()]) -> proplists:proplist(). -%%-------------------------------------------------------------------- +-spec channel_info(connection_ref(), + channel_id(), + [atom()] + ) -> proplists:proplist(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . channel_info(ConnectionHandler, ChannelId, Options) -> - sync_send_all_state_event(ConnectionHandler, {channel_info, ChannelId, Options}). + call(ConnectionHandler, {channel_info, ChannelId, Options}). %%-------------------------------------------------------------------- --spec adjust_window(pid(), channel_id(), integer()) -> ok. -%%-------------------------------------------------------------------- +-spec adjust_window(connection_ref(), + channel_id(), + integer() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . adjust_window(ConnectionHandler, Channel, Bytes) -> - send_all_state_event(ConnectionHandler, {adjust_window, Channel, Bytes}). -%%-------------------------------------------------------------------- --spec renegotiate(pid()) -> ok. -%%-------------------------------------------------------------------- -renegotiate(ConnectionHandler) -> - send_all_state_event(ConnectionHandler, renegotiate). - -%%-------------------------------------------------------------------- --spec renegotiate_data(pid()) -> ok. -%%-------------------------------------------------------------------- -renegotiate_data(ConnectionHandler) -> - send_all_state_event(ConnectionHandler, data_size). + cast(ConnectionHandler, {adjust_window, Channel, Bytes}). %%-------------------------------------------------------------------- --spec close(pid(), channel_id()) -> ok. -%%-------------------------------------------------------------------- +-spec close(connection_ref(), + channel_id() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . close(ConnectionHandler, ChannelId) -> - case sync_send_all_state_event(ConnectionHandler, {close, ChannelId}) of + case call(ConnectionHandler, {close, ChannelId}) of ok -> ok; - {error, closed} -> + {error, closed} -> ok - end. - -%%-------------------------------------------------------------------- --spec stop(pid()) -> ok | {error, term()}. -%%-------------------------------------------------------------------- -stop(ConnectionHandler)-> - case sync_send_all_state_event(ConnectionHandler, stop) of - {error, closed} -> - ok; - Other -> - Other end. -info(ConnectionHandler) -> - info(ConnectionHandler, {info, all}). +%%==================================================================== +%% Test support +%%==================================================================== +%%-------------------------------------------------------------------- +-spec renegotiate(connection_ref() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +renegotiate(ConnectionHandler) -> + cast(ConnectionHandler, renegotiate). -info(ConnectionHandler, ChannelProcess) -> - sync_send_all_state_event(ConnectionHandler, {info, ChannelProcess}). +%%-------------------------------------------------------------------- +-spec renegotiate_data(connection_ref() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +renegotiate_data(ConnectionHandler) -> + cast(ConnectionHandler, data_size). %%==================================================================== -%% gen_fsm callbacks +%% Internal process state %%==================================================================== +-record(data, { + starter :: pid(), + auth_user :: string() + | undefined, + connection_state :: #connection{}, + latest_channel_id = 0 :: non_neg_integer(), + idle_timer_ref :: undefined + | infinity + | reference(), + idle_timer_value = infinity :: infinity + | pos_integer(), + transport_protocol :: atom(), % ex: tcp + transport_cb :: atom(), % ex: gen_tcp + transport_close_tag :: atom(), % ex: tcp_closed + ssh_params :: #ssh{} + | undefined, + socket :: inet:socket(), + decrypted_data_buffer = <<>> :: binary(), + encrypted_data_buffer = <<>> :: binary(), + undecrypted_packet_length :: undefined | non_neg_integer(), + key_exchange_init_msg :: #ssh_msg_kexinit{} + | undefined, + last_size_rekey = 0 :: non_neg_integer(), + event_queue = [] :: list(), + opts :: proplists:proplist(), + inet_initial_recbuf_size :: pos_integer() + | undefined + }). +%%==================================================================== +%% Intitialisation +%%==================================================================== %%-------------------------------------------------------------------- --spec hello(socket_control | {info_line, list()} | {version_exchange, list()}, - #state{}) -> gen_fsm_state_return(). +-spec init_connection_handler(role(), + inet:socket(), + proplists:proplist() + ) -> no_return(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +init_connection_handler(Role, Socket, Opts) -> + process_flag(trap_exit, true), + S0 = init_process_state(Role, Socket, Opts), + try + {Protocol, Callback, CloseTag} = + proplists:get_value(transport, Opts, ?DefaultTransport), + S0#data{ssh_params = init_ssh_record(Role, Socket, Opts), + transport_protocol = Protocol, + transport_cb = Callback, + transport_close_tag = CloseTag + } + of + S -> + gen_statem:enter_loop(?MODULE, + [], %%[{debug,[trace,log,statistics,debug]} || Role==server], + handle_event_function, + {hello,Role}, + S) + catch + _:Error -> + gen_statem:enter_loop(?MODULE, + [], + handle_event_function, + {init_error,Error}, + S0) + end. + + +init_process_state(Role, Socket, Opts) -> + D = #data{connection_state = + C = #connection{channel_cache = ssh_channel:cache_create(), + channel_id_seed = 0, + port_bindings = [], + requests = [], + options = Opts}, + starter = proplists:get_value(user_pid, Opts), + socket = Socket, + opts = Opts + }, + case Role of + client -> + %% Start the renegotiation timers + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), + cache_init_idle_timer(D); + server -> + D#data{connection_state = init_connection(Role, C, Opts)} + end. + + +init_connection(server, C = #connection{}, Opts) -> + Sups = proplists:get_value(supervisors, Opts), + SystemSup = proplists:get_value(system_sup, Sups), + SubSystemSup = proplists:get_value(subsystem_sup, Sups), + ConnectionSup = proplists:get_value(connection_sup, Sups), + Shell = proplists:get_value(shell, Opts), + Exec = proplists:get_value(exec, Opts), + CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), + C#connection{cli_spec = CliSpec, + exec = Exec, + system_supervisor = SystemSup, + sub_system_supervisor = SubSystemSup, + connection_supervisor = ConnectionSup + }. + + +init_ssh_record(Role, Socket, Opts) -> + {ok, PeerAddr} = inet:peername(Socket), + KeyCb = proplists:get_value(key_cb, Opts, ssh_file), + AuthMethods = proplists:get_value(auth_methods, Opts, ?SUPPORTED_AUTH_METHODS), + S0 = #ssh{role = Role, + key_cb = KeyCb, + opts = Opts, + userauth_supported_methods = AuthMethods, + available_host_keys = supported_host_keys(Role, KeyCb, Opts), + random_length_padding = proplists:get_value(max_random_length_padding, + Opts, + (#ssh{})#ssh.random_length_padding) + }, + + {Vsn, Version} = ssh_transport:versions(Role, Opts), + case Role of + client -> + PeerName = proplists:get_value(host, Opts), + S0#ssh{c_vsn = Vsn, + c_version = Version, + io_cb = case proplists:get_value(user_interaction, Opts, true) of + true -> ssh_io; + false -> ssh_no_io + end, + userauth_quiet_mode = proplists:get_value(quiet_mode, Opts, false), + peer = {PeerName, PeerAddr} + }; + + server -> + S0#ssh{s_vsn = Vsn, + s_version = Version, + io_cb = proplists:get_value(io_cb, Opts, ssh_io), + userauth_methods = string:tokens(AuthMethods, ","), + kb_tries_left = 3, + peer = {undefined, PeerAddr} + } + end. + + + +%%==================================================================== +%% gen_statem callbacks +%%==================================================================== %%-------------------------------------------------------------------- +-type event_content() :: any(). + +-type renegotiate_flag() :: init | renegotiate. + +-type state_name() :: + {init_error,any()} + | {hello, role()} + | {kexinit, role(), renegotiate_flag()} + | {key_exchange, role(), renegotiate_flag()} + | {key_exchange_dh_gex_init, server, renegotiate_flag()} + | {key_exchange_dh_gex_reply, client, renegotiate_flag()} + | {new_keys, role()} + | {service_request, role()} + | {userauth, role()} + | {userauth_keyboard_interactive, role()} + | {connected, role()} + . + +-type handle_event_result() :: gen_statem:handle_event_result(). + +-spec handle_event(gen_statem:event_type(), + event_content(), + state_name(), + #data{} + ) -> handle_event_result(). + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +%%% ######## Error in the initialisation #### + +handle_event(_, _Event, {init_error,Error}, _) -> + case Error of + {badmatch,{error,enotconn}} -> + %% Handles the abnormal sequence: + %% SYN-> + %% <-SYNACK + %% ACK-> + %% RST-> + {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}}; + + OtherError -> + {stop, {shutdown,{init,OtherError}}} + end; -hello(socket_control, #state{socket = Socket, ssh_params = Ssh} = State) -> - VsnMsg = ssh_transport:hello_version_msg(string_version(Ssh)), - send_msg(VsnMsg, State), - case getopt(recbuf, Socket) of - {ok, Size} -> - inet:setopts(Socket, [{packet, line}, {active, once}, {recbuf, ?MAX_PROTO_VERSION}]), - {next_state, hello, State#state{recbuf = Size}}; - {error, Reason} -> - {stop, {shutdown, Reason}, State} + +%%% ######## {hello, client|server} #### +%% The very first event that is sent when the we are set as controlling process of Socket +handle_event(_, socket_control, {hello,_}, D) -> + VsnMsg = ssh_transport:hello_version_msg(string_version(D#data.ssh_params)), + ok = send_bytes(VsnMsg, D), + case inet:getopts(Socket=D#data.socket, [recbuf]) of + {ok, [{recbuf,Size}]} -> + %% Set the socket to the hello text line handling mode: + inet:setopts(Socket, [{packet, line}, + {active, once}, + % Expecting the version string which might + % be max ?MAX_PROTO_VERSION bytes: + {recbuf, ?MAX_PROTO_VERSION}, + {nodelay,true}]), + {keep_state, D#data{inet_initial_recbuf_size=Size}}; + + Other -> + {stop, {shutdown,{unexpected_getopts_return, Other}}} end; -hello({info_line, _Line},#state{role = client, socket = Socket} = State) -> - %% The server may send info lines before the version_exchange - inet:setopts(Socket, [{active, once}]), - {next_state, hello, State}; - -hello({info_line, _Line},#state{role = server, - socket = Socket, - transport_cb = Transport } = State) -> - %% as openssh - Transport:send(Socket, "Protocol mismatch."), - {stop, {shutdown,"Protocol mismatch in version exchange."}, State}; - -hello({version_exchange, Version}, #state{ssh_params = Ssh0, - socket = Socket, - recbuf = Size} = State) -> +handle_event(_, {info_line,_Line}, {hello,Role}, D) -> + case Role of + client -> + %% The server may send info lines to the client before the version_exchange + inet:setopts(D#data.socket, [{active, once}]), + keep_state_and_data; + server -> + %% But the client may NOT send them to the server. Openssh answers with cleartext, + %% and so do we + ok = send_bytes("Protocol mismatch.", D), + {stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}} + end; + +handle_event(_, {version_exchange,Version}, {hello,Role}, D) -> {NumVsn, StrVsn} = ssh_transport:handle_hello_version(Version), - case handle_version(NumVsn, StrVsn, Ssh0) of + case handle_version(NumVsn, StrVsn, D#data.ssh_params) of {ok, Ssh1} -> - inet:setopts(Socket, [{packet,0}, {mode,binary}, {active, once}, {recbuf, Size}]), + %% Since the hello part is finnished correctly, we set the + %% socket to the packet handling mode (including recbuf size): + inet:setopts(D#data.socket, [{packet,0}, + {mode,binary}, + {active, once}, + {recbuf, D#data.inet_initial_recbuf_size}]), {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh1), - send_msg(SshPacket, State), - {next_state, kexinit, next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = - KeyInitMsg})}; + ok = send_bytes(SshPacket, D), + {next_state, {kexinit,Role,init}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}}; not_supported -> - DisconnectMsg = - #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, - description = "Protocol version " ++ StrVsn - ++ " not supported", - language = "en"}, - handle_disconnect(DisconnectMsg, State) - end. + disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, + description = ["Protocol version ",StrVsn," not supported"]}, + {next_state, {hello,Role}, D}) + end; -%%-------------------------------------------------------------------- --spec kexinit({#ssh_msg_kexinit{}, binary()}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -kexinit({#ssh_msg_kexinit{} = Kex, Payload}, - #state{ssh_params = #ssh{role = Role} = Ssh0, - key_exchange_init_msg = OwnKex} = - State) -> - Ssh1 = ssh_transport:key_init(opposite_role(Role), Ssh0, Payload), - case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of - {ok, NextKexMsg, Ssh} when Role == client -> - send_msg(NextKexMsg, State), - {next_state, key_exchange, - next_packet(State#state{ssh_params = Ssh})}; - {ok, Ssh} when Role == server -> - {next_state, key_exchange, - next_packet(State#state{ssh_params = Ssh})} - end. + +%%% ######## {kexinit, client|server, init|renegotiate} #### -%%-------------------------------------------------------------------- --spec key_exchange(#ssh_msg_kexdh_init{} | #ssh_msg_kexdh_reply{} | - #ssh_msg_kex_dh_gex_group{} | #ssh_msg_kex_dh_gex_request{} | - #ssh_msg_kex_dh_gex_request{} | #ssh_msg_kex_dh_gex_reply{}, #state{}) - -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- +handle_event(_, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg}, + D = #data{key_exchange_init_msg = OwnKex}) -> + Ssh1 = ssh_transport:key_init(peer_role(Role), D#data.ssh_params, Payload), + Ssh = case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of + {ok, NextKexMsg, Ssh2} when Role==client -> + ok = send_bytes(NextKexMsg, D), + Ssh2; + {ok, Ssh2} when Role==server -> + Ssh2 + end, + {next_state, {key_exchange,Role,ReNeg}, D#data{ssh_params=Ssh}}; -key_exchange(#ssh_msg_kexdh_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - case ssh_transport:handle_kexdh_init(Msg, Ssh0) of - {ok, KexdhReply, Ssh1} -> - send_msg(KexdhReply, State), - {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})} - end; -key_exchange(#ssh_msg_kexdh_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_request{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0), - send_msg(GexGroup, State), - {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_request_old{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0), - send_msg(GexGroup, State), - {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, Ssh0), - send_msg(KexGexInit, State), - {next_state, key_exchange_dh_gex_reply, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_ecdh_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, Ssh0), - send_msg(KexEcdhReply, State), +%%% ######## {key_exchange, client|server, init|renegotiate} #### + +%%%---- diffie-hellman +handle_event(_, #ssh_msg_kexdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, KexdhReply, Ssh1} = ssh_transport:handle_kexdh_init(Msg, D#data.ssh_params), + ok = send_bytes(KexdhReply, D), + {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; + +%%%---- diffie-hellman group exchange +handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ok = send_bytes(GexGroup, D), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ok = send_bytes(GexGroup, D), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, D#data.ssh_params), + ok = send_bytes(KexGexInit, D), + {next_state, {key_exchange_dh_gex_reply,client,ReNeg}, D#data{ssh_params=Ssh}}; + +%%%---- elliptic curve diffie-hellman +handle_event(_, #ssh_msg_kex_ecdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, D#data.ssh_params), + ok = send_bytes(KexEcdhReply, D), {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; -key_exchange(#ssh_msg_kex_ecdh_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. +handle_event(_, #ssh_msg_kex_ecdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; -%%-------------------------------------------------------------------- --spec key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, Ssh0), - send_msg(KexGexReply, State), + +%%% ######## {key_exchange_dh_gex_init, server, init|renegotiate} #### + +handle_event(_, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_init,server,ReNeg}, D) -> + {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, D#data.ssh_params), + ok = send_bytes(KexGexReply, D), {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; -%%-------------------------------------------------------------------- --spec key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh1})}. -%%-------------------------------------------------------------------- --spec new_keys(#ssh_msg_newkeys{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- +%%% ######## {key_exchange_dh_gex_reply, client, init|renegotiate} #### -new_keys(#ssh_msg_newkeys{} = Msg, #state{ssh_params = Ssh0} = State0) -> - {ok, Ssh} = ssh_transport:handle_new_keys(Msg, Ssh0), - after_new_keys(next_packet(State0#state{ssh_params = Ssh})). +handle_event(_, #ssh_msg_kex_dh_gex_reply{} = Msg, {key_exchange_dh_gex_reply,client,ReNeg}, D) -> + {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh1}}; -%%-------------------------------------------------------------------- --spec service_request(#ssh_msg_service_request{} | #ssh_msg_service_accept{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -service_request(#ssh_msg_service_request{name = "ssh-userauth"} = Msg, - #state{ssh_params = #ssh{role = server, - session_id = SessionId} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; - -service_request(#ssh_msg_service_accept{name = "ssh-userauth"}, - #state{ssh_params = #ssh{role = client, - service = "ssh-userauth"} = Ssh0} = - State) -> + +%%% ######## {new_keys, client|server} #### + +%% First key exchange round: +handle_event(_, #ssh_msg_newkeys{} = Msg, {new_keys,Role,init}, D) -> + {ok, Ssh1} = ssh_transport:handle_new_keys(Msg, D#data.ssh_params), + Ssh = case Role of + client -> + {MsgReq, Ssh2} = ssh_auth:service_request_msg(Ssh1), + ok = send_bytes(MsgReq, D), + Ssh2; + server -> + Ssh1 + end, + {next_state, {service_request,Role}, D#data{ssh_params=Ssh}}; + +%% Subsequent key exchange rounds (renegotiation): +handle_event(_, #ssh_msg_newkeys{}, {new_keys,Role,renegotiate}, D) -> + {next_state, {connected,Role}, D}; + +%%% ######## {service_request, client|server} + +handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {service_request,server}, D) -> + case ServiceName of + "ssh-userauth" -> + Ssh0 = #ssh{session_id=SessionId} = D#data.ssh_params, + {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), + ok = send_bytes(Reply, D), + {next_state, {userauth,server}, D#data{ssh_params = Ssh}}; + + _ -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unknown service"}, + StateName, D) + end; + +handle_event(_, #ssh_msg_service_accept{name = "ssh-userauth"}, {service_request,client}, + #data{ssh_params = #ssh{service="ssh-userauth"} = Ssh0} = State) -> {Msg, Ssh} = ssh_auth:init_userauth_request_msg(Ssh0), - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{auth_user = Ssh#ssh.user, ssh_params = Ssh})}. + ok = send_bytes(Msg, State), + {next_state, {userauth,client}, State#data{auth_user = Ssh#ssh.user, ssh_params = Ssh}}; -%%-------------------------------------------------------------------- --spec userauth(#ssh_msg_userauth_request{} | #ssh_msg_userauth_info_request{} | - #ssh_msg_userauth_info_response{} | #ssh_msg_userauth_success{} | - #ssh_msg_userauth_failure{} | #ssh_msg_userauth_banner{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -userauth(#ssh_msg_userauth_request{service = "ssh-connection", - method = "none"} = Msg, - #state{ssh_params = #ssh{session_id = SessionId, role = server, - service = "ssh-connection"} = Ssh0 - } = State) -> - {not_authorized, {_User, _Reason}, {Reply, Ssh}} = - ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; - -userauth(#ssh_msg_userauth_request{service = "ssh-connection", - method = Method} = Msg, - #state{ssh_params = #ssh{session_id = SessionId, role = server, - service = "ssh-connection", - peer = {_, Address}} = Ssh0, - opts = Opts, starter = Pid} = State) -> - case lists:member(Method, Ssh0#ssh.userauth_methods) of - true -> - case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of - {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, Method, Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh#ssh{authenticated = true}})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + +%%% ######## {userauth, client|server} #### + +%%---- userauth request to server +handle_event(_, + Msg = #ssh_msg_userauth_request{service = ServiceName, method = Method}, + StateName = {userauth,server}, + D = #data{ssh_params=Ssh0}) -> + + case {ServiceName, Ssh0#ssh.service, Method} of + {"ssh-connection", "ssh-connection", "none"} -> + %% Probably the very first userauth_request but we deny unauthorized login + {not_authorized, _, {Reply,Ssh}} = + ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0), + ok = send_bytes(Reply, D), + {keep_state, D#data{ssh_params = Ssh}}; + + {"ssh-connection", "ssh-connection", Method} -> + %% Userauth request with a method like "password" or so + case lists:member(Method, Ssh0#ssh.userauth_methods) of + true -> + %% Yepp! we support this method + case ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0) of + {authorized, User, {Reply, Ssh}} -> + ok = send_bytes(Reply, D), + D#data.starter ! ssh_connected, + connected_fun(User, Method, D), + {next_state, {connected,server}, + D#data{auth_user = User, + ssh_params = Ssh#ssh{authenticated = true}}}; + {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> + retry_fun(User, Reason, D), + ok = send_bytes(Reply, D), + {next_state, {userauth_keyboard_interactive,server}, D#data{ssh_params = Ssh}}; + {not_authorized, {User, Reason}, {Reply, Ssh}} -> + retry_fun(User, Reason, D), + ok = send_bytes(Reply, D), + {keep_state, D#data{ssh_params = Ssh}} + end; + false -> + %% No we do not support this method (=/= none) + %% At least one non-erlang client does like this. Retry as the next event + {keep_state_and_data, + [{next_event, internal, Msg#ssh_msg_userauth_request{method="none"}}] + } end; - false -> - userauth(Msg#ssh_msg_userauth_request{method="none"}, State) + + %% {"ssh-connection", Expected, Method} when Expected =/= ServiceName -> Do what? + %% {ServiceName, Expected, Method} when Expected =/= ServiceName -> Do what? + + {ServiceName, _, _} when ServiceName =/= "ssh-connection" -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unknown service"}, + StateName, D) end; -userauth(#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client} = Ssh, - starter = Pid} = State) -> - Pid ! ssh_connected, - {next_state, connected, next_packet(State#state{ssh_params = - Ssh#ssh{authenticated = true}})}; -userauth(#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client, - userauth_methods = []}} - = State) -> - Msg = #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, +%%---- userauth success to client +handle_event(_, #ssh_msg_userauth_success{}, {userauth,client}, D=#data{ssh_params = Ssh}) -> + D#data.starter ! ssh_connected, + {next_state, {connected,client}, D#data{ssh_params=Ssh#ssh{authenticated = true}}}; + + +%%---- userauth failure response to client +handle_event(_, #ssh_msg_userauth_failure{}, {userauth,client}=StateName, + D = #data{ssh_params = #ssh{userauth_methods = []}}) -> + Msg = #ssh_msg_disconnect{code = ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, description = "Unable to connect using the available" - " authentication methods", - language = "en"}, - handle_disconnect(Msg, State); - -%% Server tells us which authentication methods that are allowed -userauth(#ssh_msg_userauth_failure{authentications = Methodes}, - #state{ssh_params = #ssh{role = client, - userauth_methods = none} = Ssh0} = State) -> - AuthMethods = string:tokens(Methodes, ","), - Ssh1 = Ssh0#ssh{userauth_methods = AuthMethods}, + " authentication methods"}, + disconnect(Msg, StateName, D); + +handle_event(_, #ssh_msg_userauth_failure{authentications = Methods}, StateName={userauth,client}, + D = #data{ssh_params = Ssh0}) -> + %% The prefered authentication method failed try next method + Ssh1 = case Ssh0#ssh.userauth_methods of + none -> + %% Server tells us which authentication methods that are allowed + Ssh0#ssh{userauth_methods = string:tokens(Methods, ",")}; + _ -> + %% We already know... + Ssh0 + end, case ssh_auth:userauth_request_msg(Ssh1) of {disconnect, DisconnectMsg, {Msg, Ssh}} -> - send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); + send_bytes(Msg, D), + disconnect(DisconnectMsg, StateName, D#data{ssh_params = Ssh}); {"keyboard-interactive", {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; + send_bytes(Msg, D), + {next_state, {userauth_keyboard_interactive,client}, D#data{ssh_params = Ssh}}; {_Method, {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + send_bytes(Msg, D), + {keep_state, D#data{ssh_params = Ssh}} end; -%% The prefered authentication method failed try next method -userauth(#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - case ssh_auth:userauth_request_msg(Ssh0) of - {disconnect, DisconnectMsg,{Msg, Ssh}} -> - send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); - {"keyboard-interactive", {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; - {_Method, {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} - end; +%%---- banner to client +handle_event(_, #ssh_msg_userauth_banner{message = Msg}, {userauth,client}, D) -> + case D#data.ssh_params#ssh.userauth_quiet_mode of + false -> io:format("~s", [Msg]); + true -> ok + end, + keep_state_and_data; -userauth(#ssh_msg_userauth_banner{}, - #state{ssh_params = #ssh{userauth_quiet_mode = true, - role = client}} = State) -> - {next_state, userauth, next_packet(State)}; -userauth(#ssh_msg_userauth_banner{message = Msg}, - #state{ssh_params = - #ssh{userauth_quiet_mode = false, role = client}} = State) -> - io:format("~s", [Msg]), - {next_state, userauth, next_packet(State)}. - - - -userauth_keyboard_interactive(#ssh_msg_userauth_info_request{} = Msg, - #state{ssh_params = #ssh{role = client, - io_cb = IoCb} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_request(Msg, IoCb, Ssh0), - send_msg(Reply, State), - {next_state, userauth_keyboard_interactive_info_response, next_packet(State#state{ssh_params = Ssh})}; - -userauth_keyboard_interactive(#ssh_msg_userauth_info_response{} = Msg, - #state{ssh_params = #ssh{role = server, - peer = {_, Address}} = Ssh0, - opts = Opts, starter = Pid} = State) -> - case ssh_auth:handle_userauth_info_response(Msg, Ssh0) of + +%%% ######## {userauth_keyboard_interactive, client|server} + +handle_event(_, #ssh_msg_userauth_info_request{} = Msg, {userauth_keyboard_interactive, client}, + #data{ssh_params = Ssh0} = D) -> + {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_request(Msg, Ssh0#ssh.io_cb, Ssh0), + send_bytes(Reply, D), + {next_state, {userauth_keyboard_interactive_info_response,client}, D#data{ssh_params = Ssh}}; + +handle_event(_, #ssh_msg_userauth_info_response{} = Msg, {userauth_keyboard_interactive, server}, D) -> + case ssh_auth:handle_userauth_info_response(Msg, D#data.ssh_params) of {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, "keyboard-interactive", Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh#ssh{authenticated = true}})}; + send_bytes(Reply, D), + D#data.starter ! ssh_connected, + connected_fun(User, "keyboard-interactive", D), + {next_state, {connected,server}, D#data{auth_user = User, + ssh_params = Ssh#ssh{authenticated = true}}}; {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + retry_fun(User, Reason, D), + send_bytes(Reply, D), + {next_state, {userauth,server}, D#data{ssh_params = Ssh}} end; -userauth_keyboard_interactive(Msg = #ssh_msg_userauth_failure{}, - #state{ssh_params = Ssh0 = - #ssh{role = client, - userauth_preference = Prefs0}} - = State) -> - Prefs = [{Method,M,F,A} || {Method,M,F,A} <- Prefs0, + +handle_event(_, Msg = #ssh_msg_userauth_failure{}, {userauth_keyboard_interactive, client}, + #data{ssh_params = Ssh0} = D0) -> + Prefs = [{Method,M,F,A} || {Method,M,F,A} <- Ssh0#ssh.userauth_preference, Method =/= "keyboard-interactive"], - userauth(Msg, State#state{ssh_params = Ssh0#ssh{userauth_preference=Prefs}}). + D = D0#data{ssh_params = Ssh0#ssh{userauth_preference=Prefs}}, + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; +handle_event(_, Msg=#ssh_msg_userauth_failure{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; +handle_event(_, Msg=#ssh_msg_userauth_success{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State); -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_success{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State); -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_info_request{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth_keyboard_interactive(Msg, State). +handle_event(_, Msg=#ssh_msg_userauth_info_request{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth_keyboard_interactive,client}, D, [{next_event, internal, Msg}]}; -%%-------------------------------------------------------------------- --spec connected({#ssh_msg_kexinit{}, binary()}, %%| %% #ssh_msg_kexdh_init{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -connected({#ssh_msg_kexinit{}, _Payload} = Event, #state{ssh_params = Ssh0} = State0) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - State = State0#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true}, - send_msg(SshPacket, State), - kexinit(Event, State). -%%-------------------------------------------------------------------- --spec handle_event(#ssh_msg_disconnect{} | #ssh_msg_ignore{} | #ssh_msg_debug{} | - #ssh_msg_unimplemented{} | {adjust_window, integer(), integer()} | - {reply_request, success | failure, integer()} | renegotiate | - data_size | {request, pid(), integer(), integer(), iolist()} | - {request, integer(), integer(), iolist()}, state_name(), - #state{}) -> gen_fsm_state_return(). +%%% ######## {connected, client|server} #### -%%-------------------------------------------------------------------- -handle_event(#ssh_msg_disconnect{description = Desc} = DisconnectMsg, _StateName, #state{} = State) -> - handle_disconnect(peer, DisconnectMsg, State), - {stop, {shutdown, Desc}, State}; - -handle_event(#ssh_msg_ignore{}, StateName, State) -> - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_debug{always_display = Display, message = DbgMsg, language=Lang}, - StateName, #state{opts = Opts} = State) -> - F = proplists:get_value(ssh_msg_debug_fun, Opts, - fun(_ConnRef, _AlwaysDisplay, _Msg, _Language) -> ok end - ), - catch F(self(), Display, DbgMsg, Lang), - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_unimplemented{}, StateName, State) -> - {next_state, StateName, next_packet(State)}; - -handle_event(renegotiate, connected, #state{ssh_params = Ssh0} - = State) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - send_msg(SshPacket, State), - timer:apply_after(?REKEY_TIMOUT, gen_fsm, send_all_state_event, [self(), renegotiate]), - {next_state, kexinit, - next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true})}; - -handle_event(renegotiate, StateName, State) -> +handle_event(_, {#ssh_msg_kexinit{},_} = Event, {connected,Role}, D0) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D0#data.ssh_params), + D = D0#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}, + send_bytes(SshPacket, D), + {next_state, {kexinit,Role,renegotiate}, D, [{next_event, internal, Event}]}; + +handle_event(_, #ssh_msg_disconnect{description=Desc} = Msg, StateName, D0) -> + {disconnect, _, {{replies,Replies}, _}} = + ssh_connection:handle_msg(Msg, D0#data.connection_state, role(StateName)), + {Actions,D} = send_replies(Replies, D0), + disconnect_fun(Desc, D), + {stop_and_reply, {shutdown,Desc}, Actions, D}; + +handle_event(_, #ssh_msg_ignore{}, _, _) -> + keep_state_and_data; + +handle_event(_, #ssh_msg_unimplemented{}, _, _) -> + keep_state_and_data; + +handle_event(_, #ssh_msg_debug{} = Msg, _, D) -> + debug_fun(Msg, D), + keep_state_and_data; + +handle_event(internal, Msg=#ssh_msg_global_request{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_request_success{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_request_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open_confirmation{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_window_adjust{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_data{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_extended_data{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_eof{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_close{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + + +handle_event(cast, renegotiate, {connected,Role}, D) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D#data.ssh_params), + send_bytes(SshPacket, D), + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}}; + +handle_event(cast, renegotiate, _, _) -> %% Already in key-exchange so safe to ignore - {next_state, StateName, State}; + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), % FIXME: not here in original + keep_state_and_data; + %% Rekey due to sent data limit reached? -handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> - {ok, [{send_oct,Sent0}]} = inet:getstat(State#state.socket, [send_oct]), - Sent = Sent0 - State#state.last_size_rekey, - MaxSent = proplists:get_value(rekey_limit, State#state.opts, 1024000000), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, [self(), data_size]), +handle_event(cast, data_size, {connected,Role}, D) -> + {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), + Sent = Sent0 - D#data.last_size_rekey, + MaxSent = proplists:get_value(rekey_limit, D#data.opts, 1024000000), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), case Sent >= MaxSent of true -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - send_msg(SshPacket, State), - {next_state, kexinit, - next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true, - last_size_rekey = Sent0})}; + {KeyInitMsg, SshPacket, Ssh} = + ssh_transport:key_exchange_init_msg(D#data.ssh_params), + send_bytes(SshPacket, D), + {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg, + last_size_rekey = Sent0}}; _ -> - {next_state, connected, next_packet(State)} + keep_state_and_data end; -handle_event(data_size, StateName, State) -> + +handle_event(cast, data_size, _, _) -> %% Already in key-exchange so safe to ignore - {next_state, StateName, State}; - -handle_event(Event, StateName, State) when StateName /= connected -> - Events = [{event, Event} | State#state.event_queue], - {next_state, StateName, State#state{event_queue = Events}}; - -handle_event({adjust_window, ChannelId, Bytes}, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{recv_window_size = WinSize, - recv_window_pending = Pending, - recv_packet_size = PktSize} = Channel - when (WinSize-Bytes) >= 2*PktSize -> - %% The peer can send at least two more *full* packet, no hurry. - ssh_channel:cache_update(Cache, - Channel#channel{recv_window_pending = Pending + Bytes}), - State0; - - #channel{recv_window_size = WinSize, - recv_window_pending = Pending, - remote_id = Id} = Channel -> - %% Now we have to update the window - we can't receive so many more pkts - ssh_channel:cache_update(Cache, - Channel#channel{recv_window_size = - WinSize + Bytes + Pending, - recv_window_pending = 0}), - Msg = ssh_connection:channel_adjust_window_msg(Id, Bytes + Pending), - send_replies([{connection_reply, Msg}], State0); + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), % FIXME: not here in original + keep_state_and_data; + + + +handle_event(cast, _, StateName, _) when StateName /= {connected,server}, + StateName /= {connected,client} -> + {keep_state_and_data, [postpone]}; + + +handle_event(cast, {adjust_window,ChannelId,Bytes}, {connected,_}, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{recv_window_size = WinSize, + recv_window_pending = Pending, + recv_packet_size = PktSize} = Channel + when (WinSize-Bytes) >= 2*PktSize -> + %% The peer can send at least two more *full* packet, no hurry. + ssh_channel:cache_update(cache(D), + Channel#channel{recv_window_pending = Pending + Bytes}), + keep_state_and_data; + + #channel{recv_window_size = WinSize, + recv_window_pending = Pending, + remote_id = Id} = Channel -> + %% Now we have to update the window - we can't receive so many more pkts + ssh_channel:cache_update(cache(D), + Channel#channel{recv_window_size = + WinSize + Bytes + Pending, + recv_window_pending = 0}), + Msg = ssh_connection:channel_adjust_window_msg(Id, Bytes + Pending), + {keep_state, send_msg(Msg,D)}; - undefined -> - State0 - end, - {next_state, StateName, next_packet(State)}; - -handle_event({reply_request, success, ChannelId}, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = RemoteId} -> - Msg = ssh_connection:channel_success_msg(RemoteId), - send_replies([{connection_reply, Msg}], State0); - undefined -> - State0 - end, - {next_state, StateName, State}; - -handle_event({request, ChannelPid, ChannelId, Type, Data}, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelPid, ChannelId, - Type, Data, - false, none, State0), - State = send_replies(Replies, State1), - {next_state, StateName, next_packet(State)}; - -handle_event({request, ChannelId, Type, Data}, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelId, Type, Data, - false, none, State0), - State = send_replies(Replies, State1), - {next_state, StateName, next_packet(State)}; - -handle_event({unknown, Data}, StateName, State) -> + undefined -> + keep_state_and_data + end; + +handle_event(cast, {reply_request,success,ChannelId}, {connected,_}, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{remote_id = RemoteId} -> + Msg = ssh_connection:channel_success_msg(RemoteId), + {keep_state, send_msg(Msg,D)}; + + undefined -> + keep_state_and_data + end; + +handle_event(cast, {request,ChannelPid, ChannelId, Type, Data}, {connected,_}, D) -> + {keep_state, handle_request(ChannelPid, ChannelId, Type, Data, false, none, D)}; + +handle_event(cast, {request,ChannelId,Type,Data}, {connected,_}, D) -> + {keep_state, handle_request(ChannelId, Type, Data, false, none, D)}; + +handle_event(cast, {unknown,Data}, {connected,_}, D) -> Msg = #ssh_msg_unimplemented{sequence = Data}, - send_msg(Msg, State), - {next_state, StateName, next_packet(State)}. + {keep_state, send_msg(Msg,D)}; -%%-------------------------------------------------------------------- --spec handle_sync_event({request, pid(), channel_id(), integer(), binary(), timeout()} | - {request, channel_id(), integer(), binary(), timeout()} | - {global_request, pid(), integer(), boolean(), binary()} | {eof, integer()} | - {open, pid(), integer(), channel_id(), integer(), binary(), _} | - {send_window, channel_id()} | {recv_window, channel_id()} | - {connection_info, [client_version | server_version | peer | - sockname]} | {channel_info, channel_id(), [recv_window | - send_window]} | - {close, channel_id()} | stop, term(), state_name(), #state{}) - -> gen_fsm_sync_return(). -%%-------------------------------------------------------------------- -handle_sync_event(get_print_info, _From, StateName, State) -> +%%% Previously handle_sync_event began here +handle_event({call,From}, get_print_info, StateName, D) -> Reply = try - {inet:sockname(State#state.socket), - inet:peername(State#state.socket) + {inet:sockname(D#data.socket), + inet:peername(D#data.socket) } of - {{ok,Local}, {ok,Remote}} -> {{Local,Remote},io_lib:format("statename=~p",[StateName])}; - _ -> {{"-",0},"-"} + {{ok,Local}, {ok,Remote}} -> + {{Local,Remote},io_lib:format("statename=~p",[StateName])}; + _ -> + {{"-",0},"-"} catch - _:_ -> {{"?",0},"?"} + _:_ -> + {{"?",0},"?"} end, - {reply, Reply, StateName, State}; + {keep_state_and_data, [{reply,From,Reply}]}; -handle_sync_event({connection_info, Options}, _From, StateName, State) -> - Info = ssh_info(Options, State, []), - {reply, Info, StateName, State}; +handle_event({call,From}, {connection_info, Options}, _, D) -> + Info = ssh_info(Options, D, []), + {keep_state_and_data, [{reply,From,Info}]}; -handle_sync_event({channel_info, ChannelId, Options}, _From, StateName, - #state{connection_state = #connection{channel_cache = Cache}} = State) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{} = Channel -> +handle_event({call,From}, {channel_info,ChannelId,Options}, _, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{} = Channel -> Info = ssh_channel_info(Options, Channel, []), - {reply, Info, StateName, State}; + {keep_state_and_data, [{reply,From,Info}]}; undefined -> - {reply, [], StateName, State} + {keep_state_and_data, [{reply,From,[]}]} end; -handle_sync_event({info, ChannelPid}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State) -> + +handle_event({call,From}, {info, all}, _, D) -> + Result = ssh_channel:cache_foldl(fun(Channel, Acc) -> + [Channel | Acc] + end, + [], cache(D)), + {keep_state_and_data, [{reply, From, {ok,Result}}]}; + +handle_event({call,From}, {info, ChannelPid}, _, D) -> Result = ssh_channel:cache_foldl( - fun(Channel, Acc) when ChannelPid == all; - Channel#channel.user == ChannelPid -> + fun(Channel, Acc) when Channel#channel.user == ChannelPid -> [Channel | Acc]; (_, Acc) -> Acc - end, [], Cache), - {reply, {ok, Result}, StateName, State}; + end, [], cache(D)), + {keep_state_and_data, [{reply, From, {ok,Result}}]}; -handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0, - role = Role} = State0) -> +handle_event({call,From}, stop, StateName, D0) -> {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "User closed down connection", - language = "en"}, Connection0, Role), - State = send_replies(Replies, State0), - {stop, normal, ok, State#state{connection_state = Connection}}; - - -handle_sync_event(Event, From, StateName, State) when StateName /= connected -> - Events = [{sync, Event, From} | State#state.event_queue], - {next_state, StateName, State#state{event_queue = Events}}; - -handle_sync_event({request, ChannelPid, ChannelId, Type, Data, Timeout}, From, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelPid, - ChannelId, Type, Data, - true, From, State0), - %% Note reply to channel will happen later when - %% reply is recived from peer on the socket - State = send_replies(Replies, State1), - start_timeout(ChannelId, From, Timeout), - handle_idle_timeout(State), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({request, ChannelId, Type, Data, Timeout}, From, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelId, Type, Data, - true, From, State0), - %% Note reply to channel will happen later when - %% reply is recived from peer on the socket - State = send_replies(Replies, State1), - start_timeout(ChannelId, From, Timeout), - handle_idle_timeout(State), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({global_request, Pid, _, _, _} = Request, From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State1 = handle_global_request(Request, State0), - Channel = ssh_channel:cache_find(Pid, Cache), - State = add_request(true, Channel#channel.local_id, From, State1), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({data, ChannelId, Type, Data, Timeout}, From, StateName, - #state{connection_state = #connection{channel_cache = _Cache} - = Connection0} = State0) -> - - case ssh_connection:channel_data(ChannelId, Type, Data, Connection0, From) of - {{replies, Replies}, Connection} -> - State = send_replies(Replies, State0#state{connection_state = Connection}), - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(State)}; - {noreply, Connection} -> - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(State0#state{connection_state = Connection})} - end; - -handle_sync_event({eof, ChannelId}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of + description = "User closed down connection"}, + D0#data.connection_state, + role(StateName)), + {Repls,D} = send_replies(Replies, D0), + {stop_and_reply, normal, [{reply,From,ok}|Repls], D#data{connection_state=Connection}}; + +handle_event({call,_}, _, StateName, _) when StateName /= {connected,server}, + StateName /= {connected,client} -> + {keep_state_and_data, [postpone]}; + +handle_event({call,From}, {request, ChannelPid, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + D = handle_request(ChannelPid, ChannelId, Type, Data, true, From, D0), + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)}; + +handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + D = handle_request(ChannelId, Type, Data, true, From, D0), + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)}; + +handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + {{replies, Replies}, Connection} = + ssh_connection:channel_data(ChannelId, Type, Data, D0#data.connection_state, From), + {Repls,D} = send_replies(Replies, D0#data{connection_state = Connection}), + start_channel_request_timer(ChannelId, From, Timeout), % FIXME: No message exchange so why? + {keep_state, D, Repls}; + +handle_event({call,From}, {eof, ChannelId}, {connected,_}, D0) -> + case ssh_channel:cache_lookup(cache(D0), ChannelId) of #channel{remote_id = Id, sent_close = false} -> - State = send_replies([{connection_reply, - ssh_connection:channel_eof_msg(Id)}], State0), - {reply, ok, StateName, next_packet(State)}; + D = send_msg(ssh_connection:channel_eof_msg(Id), D0), + {keep_state, D, [{reply,From,ok}]}; _ -> - {reply, {error,closed}, StateName, State0} + {keep_state, D0, [{reply,From,{error,closed}}]} end; -handle_sync_event({open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, - From, StateName, #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> +handle_event({call,From}, + {open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, + {connected,_}, + D0) -> erlang:monitor(process, ChannelPid), - {ChannelId, State1} = new_channel_id(State0), - Msg = ssh_connection:channel_open_msg(Type, ChannelId, - InitialWindowSize, - MaxPacketSize, Data), - State2 = send_replies([{connection_reply, Msg}], State1), - Channel = #channel{type = Type, - sys = "none", - user = ChannelPid, - local_id = ChannelId, - recv_window_size = InitialWindowSize, - recv_packet_size = MaxPacketSize, - send_buf = queue:new() - }, - ssh_channel:cache_update(Cache, Channel), - State = add_request(true, ChannelId, From, State2), - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(remove_timer_ref(State))}; - -handle_sync_event({send_window, ChannelId}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State) -> - Reply = case ssh_channel:cache_lookup(Cache, ChannelId) of + {ChannelId, D1} = new_channel_id(D0), + D2 = send_msg(ssh_connection:channel_open_msg(Type, ChannelId, + InitialWindowSize, + MaxPacketSize, Data), + D1), + ssh_channel:cache_update(cache(D2), + #channel{type = Type, + sys = "none", + user = ChannelPid, + local_id = ChannelId, + recv_window_size = InitialWindowSize, + recv_packet_size = MaxPacketSize, + send_buf = queue:new() + }), + D = add_request(true, ChannelId, From, D2), + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_cancel_idle_timer(D)}; + +handle_event({call,From}, {send_window, ChannelId}, {connected,_}, D) -> + Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{send_window_size = WinSize, send_packet_size = Packsize} -> {ok, {WinSize, Packsize}}; undefined -> {error, einval} end, - {reply, Reply, StateName, next_packet(State)}; - -handle_sync_event({recv_window, ChannelId}, _From, StateName, - #state{connection_state = #connection{channel_cache = Cache}} - = State) -> + {keep_state_and_data, [{reply,From,Reply}]}; - Reply = case ssh_channel:cache_lookup(Cache, ChannelId) of +handle_event({call,From}, {recv_window, ChannelId}, {connected,_}, D) -> + Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{recv_window_size = WinSize, recv_packet_size = Packsize} -> {ok, {WinSize, Packsize}}; undefined -> {error, einval} end, - {reply, Reply, StateName, next_packet(State)}; - -handle_sync_event({close, ChannelId}, _, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} = Channel -> - State1 = send_replies([{connection_reply, - ssh_connection:channel_close_msg(Id)}], State0), - ssh_channel:cache_update(Cache, Channel#channel{sent_close = true}), - handle_idle_timeout(State1), - State1; - undefined -> - State0 - end, - {reply, ok, StateName, next_packet(State)}. + {keep_state_and_data, [{reply,From,Reply}]}; + +handle_event({call,From}, {close, ChannelId}, {connected,_}, D0) -> + case ssh_channel:cache_lookup(cache(D0), ChannelId) of + #channel{remote_id = Id} = Channel -> + D1 = send_msg(ssh_connection:channel_close_msg(Id), D0), + ssh_channel:cache_update(cache(D1), Channel#channel{sent_close = true}), + {keep_state, cache_request_idle_timer_check(D1), [{reply,From,ok}]}; + undefined -> + {keep_state_and_data, [{reply,From,ok}]} + end; -%%-------------------------------------------------------------------- --spec handle_info({atom(), port(), binary()} | {atom(), port()} | - term (), state_name(), #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -handle_info({Protocol, Socket, "SSH-" ++ _ = Version}, hello, - #state{socket = Socket, - transport_protocol = Protocol} = State ) -> - event({version_exchange, Version}, hello, State); - -handle_info({Protocol, Socket, Info}, hello, - #state{socket = Socket, - transport_protocol = Protocol} = State) -> - event({info_line, Info}, hello, State); - -handle_info({Protocol, Socket, Data}, StateName, - #state{socket = Socket, - transport_protocol = Protocol, - ssh_params = Ssh0, - decoded_data_buffer = DecData0, - encoded_data_buffer = EncData0, - undecoded_packet_length = RemainingSshPacketLen0} = State0) -> - Encoded = <<EncData0/binary, Data/binary>>, - try ssh_transport:handle_packet_part(DecData0, Encoded, RemainingSshPacketLen0, Ssh0) +%%===== Reception of encrypted bytes, decryption and framing +handle_event(info, {Proto, Sock, Info}, {hello,_}, #data{socket = Sock, + transport_protocol = Proto}) -> + case Info of + "SSH-" ++ _ -> + {keep_state_and_data, [{next_event, internal, {version_exchange,Info}}]}; + _ -> + {keep_state_and_data, [{next_event, internal, {info_line,Info}}]} + end; + +handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, + transport_protocol = Proto}) -> + try ssh_transport:handle_packet_part( + D0#data.decrypted_data_buffer, + <<(D0#data.encrypted_data_buffer)/binary, NewData/binary>>, + D0#data.undecrypted_packet_length, + D0#data.ssh_params) of - {get_more, DecBytes, EncDataRest, RemainingSshPacketLen, Ssh1} -> - {next_state, StateName, - next_packet(State0#state{encoded_data_buffer = EncDataRest, - decoded_data_buffer = DecBytes, - undecoded_packet_length = RemainingSshPacketLen, - ssh_params = Ssh1})}; - {decoded, MsgBytes, EncDataRest, Ssh1} -> - generate_event(MsgBytes, StateName, - State0#state{ssh_params = Ssh1, - %% Important to be set for - %% next_packet -%%% FIXME: the following three seem to always be set in generate_event! - decoded_data_buffer = <<>>, - undecoded_packet_length = undefined, - encoded_data_buffer = EncDataRest}, - EncDataRest); + {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} -> + D = D0#data{ssh_params = + Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)}, + decrypted_data_buffer = <<>>, + undecrypted_packet_length = undefined, + encrypted_data_buffer = EncryptedDataRest}, + try + ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D)) + of + Msg = #ssh_msg_kexinit{} -> + {keep_state, D, [{next_event, internal, {Msg,DecryptedBytes}}, + {next_event, internal, prepare_next_packet} + ]}; + Msg -> + {keep_state, D, [{next_event, internal, Msg}, + {next_event, internal, prepare_next_packet} + ]} + catch + _C:_E -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Encountered unexpected input"}, + StateName, D) + end; + + {get_more, DecryptedBytes, EncryptedDataRest, RemainingSshPacketLen, Ssh1} -> + %% Here we know that there are not enough bytes in + %% EncryptedDataRest to use. We must wait for more. + inet:setopts(Sock, [{active, once}]), + {keep_state, D0#data{encrypted_data_buffer = EncryptedDataRest, + decrypted_data_buffer = DecryptedBytes, + undecrypted_packet_length = RemainingSshPacketLen, + ssh_params = Ssh1}}; + {bad_mac, Ssh1} -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad mac", - language = ""}, - handle_disconnect(DisconnectMsg, State0#state{ssh_params=Ssh1}); + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad mac"}, + StateName, D0#data{ssh_params=Ssh1}); {error, {exceeds_max_size,PacketLen}} -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet length " - ++ integer_to_list(PacketLen), - language = ""}, - handle_disconnect(DisconnectMsg, State0) + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad packet length " + ++ integer_to_list(PacketLen)}, + StateName, D0) catch - _:_ -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet", - language = ""}, - handle_disconnect(DisconnectMsg, State0) + _C:_E -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad packet"}, + StateName, D0) end; - -handle_info({CloseTag, _Socket}, _StateName, - #state{transport_close_tag = CloseTag, - ssh_params = #ssh{role = _Role, opts = _Opts}} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Connection closed", - language = "en"}, - handle_disconnect(DisconnectMsg, State); - -handle_info({timeout, {_, From} = Request}, Statename, - #state{connection_state = #connection{requests = Requests} = Connection} = State) -> + + +%%%==== +handle_event(internal, prepare_next_packet, _, D) -> + Enough = erlang:max(8, D#data.ssh_params#ssh.decrypt_block_size), + case size(D#data.encrypted_data_buffer) of + Sz when Sz >= Enough -> + self() ! {D#data.transport_protocol, D#data.socket, <<>>}; + _ -> + inet:setopts(D#data.socket, [{active, once}]) + end, + keep_state_and_data; + +handle_event(info, {CloseTag,Socket}, StateName, + D = #data{socket = Socket, + transport_close_tag = CloseTag}) -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Connection closed"}, + StateName, D); + +handle_event(info, {timeout, {_, From} = Request}, _, + #data{connection_state = #connection{requests = Requests} = C0} = D) -> case lists:member(Request, Requests) of true -> - gen_fsm:reply(From, {error, timeout}), - {next_state, Statename, - State#state{connection_state = - Connection#connection{requests = - lists:delete(Request, Requests)}}}; + %% A channel request is not answered in time. Answer {error,timeout} + %% to the caller + C = C0#connection{requests = lists:delete(Request, Requests)}, + {keep_state, D#data{connection_state=C}, [{reply,From,{error,timeout}}]}; false -> - {next_state, Statename, State} + %% The request is answered - just ignore the timeout + keep_state_and_data end; %%% Handle that ssh channels user process goes down -handle_info({'DOWN', _Ref, process, ChannelPid, _Reason}, Statename, State0) -> - {{replies, Replies}, State1} = handle_channel_down(ChannelPid, State0), - State = send_replies(Replies, State1), - {next_state, Statename, next_packet(State)}; +handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) -> + {{replies, Replies}, D1} = handle_channel_down(ChannelPid, D0), + {Repls, D} = send_replies(Replies, D1), + {keep_state, D, Repls}; %%% So that terminate will be run when supervisor is shutdown -handle_info({'EXIT', _Sup, Reason}, _StateName, State) -> - {stop, {shutdown, Reason}, State}; +handle_event(info, {'EXIT', _Sup, Reason}, _, _) -> + {stop, {shutdown, Reason}}; -handle_info({check_cache, _ , _}, - StateName, #state{connection_state = - #connection{channel_cache = Cache}} = State) -> - {next_state, StateName, check_cache(State, Cache)}; +handle_event(info, check_cache, _, D) -> + {keep_state, cache_check_set_idle_timer(D)}; -handle_info(UnexpectedMessage, StateName, #state{opts = Opts, - ssh_params = SshParams} = State) -> - case unexpected_fun(UnexpectedMessage, Opts, SshParams) of +handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> + case unexpected_fun(UnexpectedMessage, D) of report -> Msg = lists:flatten( io_lib:format( "Unexpected message '~p' received in state '~p'\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [UnexpectedMessage, StateName, - SshParams#ssh.role, SshParams#ssh.peer, - proplists:get_value(address, SshParams#ssh.opts)])), - error_logger:info_report(Msg); + "Local Address: ~p\n", [UnexpectedMessage, + StateName, + Ssh#ssh.role, + Ssh#ssh.peer, + proplists:get_value(address, Ssh#ssh.opts)])), + error_logger:info_report(Msg), + keep_state_and_data; skip -> - ok; + keep_state_and_data; Other -> Msg = lists:flatten( @@ -1103,200 +1269,181 @@ handle_info(UnexpectedMessage, StateName, #state{opts = Opts, "Message: ~p\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [Other, UnexpectedMessage, - SshParams#ssh.role, - element(2,SshParams#ssh.peer), - proplists:get_value(address, SshParams#ssh.opts)] + "Local Address: ~p\n", [Other, + UnexpectedMessage, + Ssh#ssh.role, + element(2,Ssh#ssh.peer), + proplists:get_value(address, Ssh#ssh.opts)] )), + error_logger:error_report(Msg), + keep_state_and_data + end; + +handle_event(internal, {disconnect,Msg,_Reason}, StateName, D) -> + disconnect(Msg, StateName, D); + +handle_event(Type, Ev, StateName, D) -> + Descr = + case catch atom_to_list(element(1,Ev)) of + "ssh_msg_" ++_ when Type==internal -> + "Message in wrong state"; + _ -> + "Internal error" + end, + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = Descr}, + StateName, D). - error_logger:error_report(Msg) - end, - {next_state, StateName, State}. %%-------------------------------------------------------------------- --spec terminate(Reason::term(), state_name(), #state{}) -> _. -%%-------------------------------------------------------------------- -terminate(normal, _, #state{transport_cb = Transport, - connection_state = Connection, - socket = Socket}) -> - terminate_subsystem(Connection), - (catch Transport:close(Socket)), - ok; +-spec terminate(any(), + state_name(), + #data{} + ) -> finalize_termination_result() . + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +terminate(normal, StateName, State) -> + finalize_termination(StateName, State); terminate({shutdown,{init,Reason}}, StateName, State) -> error_logger:info_report(io_lib:format("Erlang ssh in connection handler init: ~p~n",[Reason])), - terminate(normal, StateName, State); - -%% Terminated by supervisor -terminate(shutdown, StateName, #state{ssh_params = Ssh0} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Application shutdown", - language = "en"}, - {SshPacket, Ssh} = ssh_transport:ssh_packet(DisconnectMsg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}); - -terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, - #state{ssh_params = Ssh0} = State) -> - {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}); - -terminate({shutdown, _}, StateName, State) -> - terminate(normal, StateName, State); - -terminate(Reason, StateName, #state{ssh_params = Ssh0, starter = _Pid, - connection_state = Connection} = State) -> - terminate_subsystem(Connection), + finalize_termination(StateName, State); + +terminate(shutdown, StateName, State0) -> + %% Terminated by supervisor + State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Application shutdown"}, + State0), +timer:sleep(400), %% FIXME!!! gen_tcp:shutdown instead + finalize_termination(StateName, State); + +%% terminate({shutdown,Msg}, StateName, State0) when is_record(Msg,ssh_msg_disconnect)-> +%% State = send_msg(Msg, State0), +%% timer:sleep(400), %% FIXME!!! gen_tcp:shutdown instead +%% finalize_termination(StateName, Msg, State); + +terminate({shutdown,_R}, StateName, State) -> + finalize_termination(StateName, State); + +terminate(Reason, StateName, State0) -> + %% Others, e.g undef, {badmatch,_} log_error(Reason), - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Internal error", - language = "en"}, - {SshPacket, Ssh} = ssh_transport:ssh_packet(DisconnectMsg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}). - - -terminate_subsystem(#connection{system_supervisor = SysSup, - sub_system_supervisor = SubSysSup}) when is_pid(SubSysSup) -> - ssh_system_sup:stop_subsystem(SysSup, SubSysSup); -terminate_subsystem(_) -> - ok. - -format_status(normal, [_, State]) -> - [{data, [{"StateData", State}]}]; -format_status(terminate, [_, State]) -> - SshParams0 = (State#state.ssh_params), - SshParams = SshParams0#ssh{c_keyinit = "***", - s_keyinit = "***", - send_mac_key = "***", - send_mac_size = "***", - recv_mac_key = "***", - recv_mac_size = "***", - encrypt_keys = "***", - encrypt_ctx = "***", - decrypt_keys = "***", - decrypt_ctx = "***", - compress_ctx = "***", - decompress_ctx = "***", - shared_secret = "***", - exchanged_hash = "***", - session_id = "***", - keyex_key = "***", - keyex_info = "***", - available_host_keys = "***"}, - [{data, [{"StateData", State#state{decoded_data_buffer = "***", - encoded_data_buffer = "***", - key_exchange_init_msg = "***", - opts = "***", - recbuf = "***", - ssh_params = SshParams - }}]}]. + State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error"}, + State0), + finalize_termination(StateName, State). %%-------------------------------------------------------------------- --spec code_change(OldVsn::term(), state_name(), Oldstate::term(), Extra::term()) -> - {ok, state_name(), #state{}}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +format_status(normal, [_, _StateName, D]) -> + [{data, [{"State", D}]}]; +format_status(terminate, [_, _StateName, D]) -> + DataPropList0 = fmt_stat_rec(record_info(fields, data), D, + [decrypted_data_buffer, + encrypted_data_buffer, + key_exchange_init_msg, + user_passwords, + opts, + inet_initial_recbuf_size]), + SshPropList = fmt_stat_rec(record_info(fields, ssh), D#data.ssh_params, + [c_keyinit, + s_keyinit, + send_mac_key, + send_mac_size, + recv_mac_key, + recv_mac_size, + encrypt_keys, + encrypt_ctx, + decrypt_keys, + decrypt_ctx, + compress_ctx, + decompress_ctx, + shared_secret, + exchanged_hash, + session_id, + keyex_key, + keyex_info, + available_host_keys]), + DataPropList = lists:keyreplace(ssh_params, 1, DataPropList0, + {ssh_params,SshPropList}), + [{data, [{"State", DataPropList}]}]. + + +fmt_stat_rec(FieldNames, Rec, Exclude) -> + Values = tl(tuple_to_list(Rec)), + [P || {K,_} = P <- lists:zip(FieldNames, Values), + not lists:member(K, Exclude)]. + %%-------------------------------------------------------------------- +-spec code_change(term() | {down,term()}, + state_name(), + #data{}, + term() + ) -> {gen_statem:callback_mode(), state_name(), #data{}}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + code_change(_OldVsn, StateName, State, _Extra) -> - {ok, StateName, State}. + {handle_event_function, StateName, State}. + + +%%==================================================================== +%% Internal functions +%%==================================================================== %%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- -init_role(#state{role = client, opts = Opts} = State0) -> - Pid = proplists:get_value(user_pid, Opts), - TimerRef = get_idle_time(Opts), - timer:apply_after(?REKEY_TIMOUT, gen_fsm, send_all_state_event, [self(), renegotiate]), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, - [self(), data_size]), - State0#state{starter = Pid, - idle_timer_ref = TimerRef}; -init_role(#state{role = server, opts = Opts, connection_state = Connection} = State) -> - Sups = proplists:get_value(supervisors, Opts), - Pid = proplists:get_value(user_pid, Opts), - SystemSup = proplists:get_value(system_sup, Sups), - SubSystemSup = proplists:get_value(subsystem_sup, Sups), +%% Starting + +start_the_connection_child(UserPid, Role, Socket, Options) -> + Sups = proplists:get_value(supervisors, Options), ConnectionSup = proplists:get_value(connection_sup, Sups), - Shell = proplists:get_value(shell, Opts), - Exec = proplists:get_value(exec, Opts), - CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), - State#state{starter = Pid, connection_state = Connection#connection{ - cli_spec = CliSpec, - exec = Exec, - system_supervisor = SystemSup, - sub_system_supervisor = SubSystemSup, - connection_supervisor = ConnectionSup - }}. - -get_idle_time(SshOptions) -> - case proplists:get_value(idle_time, SshOptions) of - infinity -> - infinity; - _IdleTime -> %% We dont want to set the timeout on first connect - undefined - end. + Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), + ok = socket_control(Socket, Pid, Options), + Pid. -init_ssh(client = Role, Vsn, Version, Options, Socket) -> - IOCb = case proplists:get_value(user_interaction, Options, true) of - true -> - ssh_io; - false -> - ssh_no_io - end, +%%-------------------------------------------------------------------- +%% Stopping +-type finalize_termination_result() :: ok . + +finalize_termination(_StateName, #data{transport_cb = Transport, + connection_state = Connection, + socket = Socket}) -> + case Connection of + #connection{system_supervisor = SysSup, + sub_system_supervisor = SubSysSup} when is_pid(SubSysSup) -> + ssh_system_sup:stop_subsystem(SysSup, SubSysSup); + _ -> + do_nothing + end, + (catch Transport:close(Socket)), + ok. - AuthMethods = proplists:get_value(auth_methods, Options, - ?SUPPORTED_AUTH_METHODS), - {ok, PeerAddr} = inet:peername(Socket), - - PeerName = proplists:get_value(host, Options), - KeyCb = proplists:get_value(key_cb, Options, ssh_file), - - #ssh{role = Role, - c_vsn = Vsn, - c_version = Version, - key_cb = KeyCb, - io_cb = IOCb, - userauth_quiet_mode = proplists:get_value(quiet_mode, Options, false), - opts = Options, - userauth_supported_methods = AuthMethods, - peer = {PeerName, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options), - random_length_padding = proplists:get_value(max_random_length_padding, - Options, - (#ssh{})#ssh.random_length_padding) - }; - -init_ssh(server = Role, Vsn, Version, Options, Socket) -> - AuthMethods = proplists:get_value(auth_methods, Options, - ?SUPPORTED_AUTH_METHODS), - AuthMethodsAsList = string:tokens(AuthMethods, ","), - {ok, PeerAddr} = inet:peername(Socket), - KeyCb = proplists:get_value(key_cb, Options, ssh_file), - - #ssh{role = Role, - s_vsn = Vsn, - s_version = Version, - key_cb = KeyCb, - io_cb = proplists:get_value(io_cb, Options, ssh_io), - opts = Options, - userauth_supported_methods = AuthMethods, - userauth_methods = AuthMethodsAsList, - kb_tries_left = 3, - peer = {undefined, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options), - random_length_padding = proplists:get_value(max_random_length_padding, - Options, - (#ssh{})#ssh.random_length_padding) - }. +%%-------------------------------------------------------------------- +%% "Invert" the Role +peer_role(client) -> server; +peer_role(server) -> client. + +%%-------------------------------------------------------------------- +%% StateName to Role +role({_,Role}) -> Role; +role({_,Role,_}) -> Role. +%%-------------------------------------------------------------------- +%% Check the StateName to see if we are in the renegotiation phase +renegotiation({_,_,ReNeg}) -> ReNeg == renegotiation; +renegotiation(_) -> false. + +%%-------------------------------------------------------------------- supported_host_keys(client, _, Options) -> try - case proplists:get_value(public_key, + case proplists:get_value(public_key, proplists:get_value(preferred_algorithms,Options,[]) ) of - undefined -> + undefined -> ssh_transport:default_algorithms(public_key); L -> L -- (L--ssh_transport:default_algorithms(public_key)) @@ -1311,7 +1458,7 @@ supported_host_keys(client, _, Options) -> {stop, {shutdown, Reason}} end; supported_host_keys(server, KeyCb, Options) -> - [atom_to_list(A) || A <- proplists:get_value(public_key, + [atom_to_list(A) || A <- proplists:get_value(public_key, proplists:get_value(preferred_algorithms,Options,[]), ssh_transport:default_algorithms(public_key) ), @@ -1322,10 +1469,16 @@ supported_host_keys(server, KeyCb, Options) -> available_host_key(KeyCb, Alg, Opts) -> element(1, catch KeyCb:host_key(Alg, Opts)) == ok. -send_msg(Msg, #state{socket = Socket, transport_cb = Transport}) -> - Transport:send(Socket, Msg). -handle_version({2, 0} = NumVsn, StrVsn, Ssh0) -> +send_msg(Msg, State=#data{ssh_params=Ssh0}) when is_tuple(Msg) -> + {Bytes, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_bytes(Bytes, State), + State#data{ssh_params=Ssh}. + +send_bytes(Bytes, #data{socket = Socket, transport_cb = Transport}) -> + Transport:send(Socket, Bytes). + +handle_version({2, 0} = NumVsn, StrVsn, Ssh0) -> Ssh = counterpart_versions(NumVsn, StrVsn, Ssh0), {ok, Ssh}; handle_version(_,_,_) -> @@ -1336,419 +1489,185 @@ string_version(#ssh{role = client, c_version = Vsn}) -> string_version(#ssh{role = server, s_version = Vsn}) -> Vsn. -send_event(FsmPid, Event) -> - gen_fsm:send_event(FsmPid, Event). -send_all_state_event(FsmPid, Event) -> - gen_fsm:send_all_state_event(FsmPid, Event). +cast(FsmPid, Event) -> + gen_statem:cast(FsmPid, Event). -sync_send_all_state_event(FsmPid, Event) -> - sync_send_all_state_event(FsmPid, Event, infinity). +call(FsmPid, Event) -> + call(FsmPid, Event, infinity). -sync_send_all_state_event(FsmPid, Event, Timeout) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) of - {closed, _Channel} -> +call(FsmPid, Event, Timeout) -> + try gen_statem:call(FsmPid, Event, Timeout) of + {closed, _R} -> + {error, closed}; + {killed, _R} -> {error, closed}; Result -> Result catch - exit:{noproc, _} -> + exit:{noproc, _R} -> {error, closed}; - exit:{normal, _} -> + exit:{normal, _R} -> {error, closed}; - exit:{{shutdown, _},_} -> + exit:{{shutdown, _R},_} -> {error, closed} end. -%% simulate send_all_state_event(self(), Event) -event(#ssh_msg_disconnect{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_ignore{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_debug{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_unimplemented{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -%% simulate send_event(self(), Event) -event(Event, StateName, State) -> - try - ?MODULE:StateName(Event, State) + +handle_connection_msg(Msg, StateName, State0 = + #data{starter = User, + connection_state = Connection0, + event_queue = Qev0}) -> + Renegotiation = renegotiation(StateName), + Role = role(StateName), + try ssh_connection:handle_msg(Msg, Connection0, Role) of + {{replies, Replies}, Connection} -> + case StateName of + {connected,_} -> + {Repls, State} = send_replies(Replies, + State0#data{connection_state=Connection}), + {keep_state, State, Repls}; + _ -> + {ConnReplies, Replies} = + lists:splitwith(fun not_connected_filter/1, Replies), + {Repls, State} = send_replies(Replies, + State0#data{event_queue = Qev0 ++ ConnReplies}), + {keep_state, State, Repls} + end; + + {noreply, Connection} -> + {keep_state, State0#data{connection_state = Connection}}; + + {disconnect, Reason0, {{replies, Replies}, Connection}} -> + {Repls,State} = send_replies(Replies, State0#data{connection_state = Connection}), + case {Reason0,Role} of + {{_, Reason}, client} when ((StateName =/= {connected,client}) and (not Renegotiation)) -> + User ! {self(), not_connected, Reason}; + _ -> + ok + end, + {stop, {shutdown,normal}, Repls, State#data{connection_state = Connection}} + catch - throw:#ssh_msg_disconnect{} = DisconnectMsg -> - handle_disconnect(DisconnectMsg, State); - throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> - handle_disconnect(DisconnectMsg, State, ErrorToDisplay); - _C:_Error -> - handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName), - description = "Invalid state", - language = "en"}, State) + _:Error -> + {disconnect, _Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error"}, + Connection0, Role), + {Repls,State} = send_replies(Replies, State0#data{connection_state = Connection}), + {stop, {shutdown,Error}, Repls, State#data{connection_state = Connection}} end. -error_code(key_exchange) -> - ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED; -error_code(new_keys) -> - ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED; -error_code(_) -> - ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE. - -generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, - #state{ - role = Role, - starter = User, - renegotiate = Renegotiation, - connection_state = Connection0} = State0, EncData) - when Byte == ?SSH_MSG_GLOBAL_REQUEST; - Byte == ?SSH_MSG_REQUEST_SUCCESS; - Byte == ?SSH_MSG_REQUEST_FAILURE; - Byte == ?SSH_MSG_CHANNEL_OPEN; - Byte == ?SSH_MSG_CHANNEL_OPEN_CONFIRMATION; - Byte == ?SSH_MSG_CHANNEL_OPEN_FAILURE; - Byte == ?SSH_MSG_CHANNEL_WINDOW_ADJUST; - Byte == ?SSH_MSG_CHANNEL_DATA; - Byte == ?SSH_MSG_CHANNEL_EXTENDED_DATA; - Byte == ?SSH_MSG_CHANNEL_EOF; - Byte == ?SSH_MSG_CHANNEL_CLOSE; - Byte == ?SSH_MSG_CHANNEL_REQUEST; - Byte == ?SSH_MSG_CHANNEL_SUCCESS; - Byte == ?SSH_MSG_CHANNEL_FAILURE -> - try - ssh_message:decode(Msg) - of - ConnectionMsg -> - State1 = generate_event_new_state(State0, EncData), - try ssh_connection:handle_msg(ConnectionMsg, Connection0, Role) of - {{replies, Replies0}, Connection} -> - if StateName == connected -> - Replies = Replies0, - State2 = State1; - true -> - {ConnReplies, Replies} = - lists:splitwith(fun not_connected_filter/1, Replies0), - Q = State1#state.event_queue ++ ConnReplies, - State2 = State1#state{ event_queue = Q } - end, - State = send_replies(Replies, State2#state{connection_state = Connection}), - {next_state, StateName, next_packet(State)}; - {noreply, Connection} -> - {next_state, StateName, next_packet(State1#state{connection_state = Connection})}; - {disconnect, {_, Reason}, {{replies, Replies}, Connection}} when - Role == client andalso ((StateName =/= connected) and (not Renegotiation)) -> - State = send_replies(Replies, State1#state{connection_state = Connection}), - User ! {self(), not_connected, Reason}, - {stop, {shutdown, normal}, - next_packet(State#state{connection_state = Connection})}; - {disconnect, _Reason, {{replies, Replies}, Connection}} -> - State = send_replies(Replies, State1#state{connection_state = Connection}), - {stop, {shutdown, normal}, State#state{connection_state = Connection}} - catch - _:Error -> - {disconnect, _Reason, {{replies, Replies}, Connection}} = - ssh_connection:handle_msg( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Internal error", - language = "en"}, Connection0, Role), - State = send_replies(Replies, State1#state{connection_state = Connection}), - {stop, {shutdown, Error}, State#state{connection_state = Connection}} - end - catch - _:_ -> - handle_disconnect( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet received", - language = ""}, State0) - end; -generate_event(Msg, StateName, State0, EncData) -> - try - Event = ssh_message:decode(set_prefix_if_trouble(Msg,State0)), - State = generate_event_new_state(State0, EncData), - case Event of - #ssh_msg_kexinit{} -> - %% We need payload for verification later. - event({Event, Msg}, StateName, State); - _ -> - event(Event, StateName, State) - end - catch - _C:_E -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Encountered unexpected input", - language = "en"}, - handle_disconnect(DisconnectMsg, State0) - end. - - -set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #state{ssh_params=SshParams}) +set_kex_overload_prefix(Msg = <<?BYTE(Op),_/binary>>, #data{ssh_params=SshParams}) when Op == 30; Op == 31 -> case catch atom_to_list(kex(SshParams)) of - "ecdh-sha2-" ++ _ -> + "ecdh-sha2-" ++ _ -> <<"ecdh",Msg/binary>>; "diffie-hellman-group-exchange-" ++ _ -> <<"dh_gex",Msg/binary>>; "diffie-hellman-group" ++ _ -> <<"dh",Msg/binary>>; - _ -> + _ -> Msg end; -set_prefix_if_trouble(Msg, _) -> +set_kex_overload_prefix(Msg, _) -> Msg. kex(#ssh{algorithms=#alg{kex=Kex}}) -> Kex; kex(_) -> undefined. +cache(#data{connection_state=C}) -> C#connection.channel_cache. + -handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of +%%%---------------------------------------------------------------- +handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{remote_id = Id} = Channel -> - update_sys(Cache, Channel, Type, ChannelPid), - Msg = ssh_connection:channel_request_msg(Id, Type, - WantReply, Data), - Replies = [{connection_reply, Msg}], - State = add_request(WantReply, ChannelId, From, State0), - {{replies, Replies}, State}; + update_sys(cache(D), Channel, Type, ChannelPid), + send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), + add_request(WantReply, ChannelId, From, D)); undefined -> - {{replies, []}, State0} + D end. -handle_request(ChannelId, Type, Data, WantReply, From, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} -> - Msg = ssh_connection:channel_request_msg(Id, Type, - WantReply, Data), - Replies = [{connection_reply, Msg}], - State = add_request(WantReply, ChannelId, From, State0), - {{replies, Replies}, State}; +handle_request(ChannelId, Type, Data, WantReply, From, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{remote_id = Id} -> + send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), + add_request(WantReply, ChannelId, From, D)); undefined -> - {{replies, []}, State0} - end. - -handle_global_request({global_request, ChannelPid, - "tcpip-forward" = Type, WantReply, - <<?UINT32(IPLen), - IP:IPLen/binary, ?UINT32(Port)>> = Data}, - #state{connection_state = - #connection{channel_cache = Cache} - = Connection0} = State) -> - ssh_channel:cache_update(Cache, #channel{user = ChannelPid, - type = "forwarded-tcpip", - sys = none}), - Connection = ssh_connection:bind(IP, Port, ChannelPid, Connection0), - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State#state{connection_state = Connection}); - -handle_global_request({global_request, _Pid, "cancel-tcpip-forward" = Type, - WantReply, <<?UINT32(IPLen), - IP:IPLen/binary, ?UINT32(Port)>> = Data}, - #state{connection_state = Connection0} = State) -> - Connection = ssh_connection:unbind(IP, Port, Connection0), - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State#state{connection_state = Connection}); - -handle_global_request({global_request, _, "cancel-tcpip-forward" = Type, - WantReply, Data}, State) -> - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State). - -handle_idle_timeout(#state{opts = Opts}) -> - case proplists:get_value(idle_time, Opts, infinity) of - infinity -> - ok; - IdleTime -> - erlang:send_after(IdleTime, self(), {check_cache, [], []}) + D end. -handle_channel_down(ChannelPid, #state{connection_state = - #connection{channel_cache = Cache}} = - State) -> +%%%---------------------------------------------------------------- +handle_channel_down(ChannelPid, D) -> ssh_channel:cache_foldl( fun(Channel, Acc) when Channel#channel.user == ChannelPid -> - ssh_channel:cache_delete(Cache, + ssh_channel:cache_delete(cache(D), Channel#channel.local_id), Acc; (_,Acc) -> Acc - end, [], Cache), - {{replies, []}, check_cache(State, Cache)}. + end, [], cache(D)), + {{replies, []}, cache_check_set_idle_timer(D)}. + update_sys(Cache, Channel, Type, ChannelPid) -> ssh_channel:cache_update(Cache, Channel#channel{sys = Type, user = ChannelPid}). + add_request(false, _ChannelId, _From, State) -> State; -add_request(true, ChannelId, From, #state{connection_state = - #connection{requests = Requests0} = - Connection} = State) -> +add_request(true, ChannelId, From, #data{connection_state = + #connection{requests = Requests0} = + Connection} = State) -> Requests = [{ChannelId, From} | Requests0], - State#state{connection_state = Connection#connection{requests = Requests}}. + State#data{connection_state = Connection#connection{requests = Requests}}. -new_channel_id(#state{connection_state = #connection{channel_id_seed = Id} = - Connection} +new_channel_id(#data{connection_state = #connection{channel_id_seed = Id} = + Connection} = State) -> - {Id, State#state{connection_state = - Connection#connection{channel_id_seed = Id + 1}}}. - -generate_event_new_state(#state{ssh_params = - #ssh{recv_sequence = SeqNum0} - = Ssh} = State, EncData) -> - SeqNum = ssh_transport:next_seqnum(SeqNum0), - State#state{ssh_params = Ssh#ssh{recv_sequence = SeqNum}, - decoded_data_buffer = <<>>, - encoded_data_buffer = EncData, - undecoded_packet_length = undefined}. - -next_packet(#state{decoded_data_buffer = <<>>, - encoded_data_buffer = Buff, - ssh_params = #ssh{decrypt_block_size = BlockSize}, - socket = Socket, - transport_protocol = Protocol} = State) when Buff =/= <<>> -> - case size(Buff) >= erlang:max(8, BlockSize) of - true -> - %% Enough data from the next packet has been received to - %% decode the length indicator, fake a socket-recive - %% message so that the data will be processed - self() ! {Protocol, Socket, <<>>}; - false -> - inet:setopts(Socket, [{active, once}]) - end, - State; - -next_packet(#state{socket = Socket} = State) -> - inet:setopts(Socket, [{active, once}]), - State. - -after_new_keys(#state{renegotiate = true} = State) -> - State1 = State#state{renegotiate = false, event_queue = []}, - lists:foldr(fun after_new_keys_events/2, {next_state, connected, State1}, State#state.event_queue); -after_new_keys(#state{renegotiate = false, - ssh_params = #ssh{role = client} = Ssh0} = State) -> - {Msg, Ssh} = ssh_auth:service_request_msg(Ssh0), - send_msg(Msg, State), - {next_state, service_request, State#state{ssh_params = Ssh}}; -after_new_keys(#state{renegotiate = false, - ssh_params = #ssh{role = server}} = State) -> - {next_state, service_request, State}. - -after_new_keys_events({sync, _Event, From}, {stop, _Reason, _StateData}=Terminator) -> - gen_fsm:reply(From, {error, closed}), - Terminator; -after_new_keys_events(_, {stop, _Reason, _StateData}=Terminator) -> - Terminator; -after_new_keys_events({sync, Event, From}, {next_state, StateName, StateData}) -> - case handle_sync_event(Event, From, StateName, StateData) of - {reply, Reply, NextStateName, NewStateData} -> - gen_fsm:reply(From, Reply), - {next_state, NextStateName, NewStateData}; - {next_state, NextStateName, NewStateData}-> - {next_state, NextStateName, NewStateData}; - {stop, Reason, Reply, NewStateData} -> - gen_fsm:reply(From, Reply), - {stop, Reason, NewStateData} - end; -after_new_keys_events({event, Event}, {next_state, StateName, StateData}) -> - case handle_event(Event, StateName, StateData) of - {next_state, NextStateName, NewStateData}-> - {next_state, NextStateName, NewStateData}; - {stop, Reason, NewStateData} -> - {stop, Reason, NewStateData} - end; -after_new_keys_events({connection_reply, _Data} = Reply, {StateName, State}) -> - NewState = send_replies([Reply], State), - {next_state, StateName, NewState}. - - -handle_disconnect(DisconnectMsg, State) -> - handle_disconnect(own, DisconnectMsg, State). - -handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> - handle_disconnect(own, DisconnectMsg, State, Error); -handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> - {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(disconnect_replies(Type, Msg, Replies), State0), - disconnect_fun(Desc, State#state.opts), - {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. - -handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, - role = Role} = State0, ErrorMsg) -> - {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(disconnect_replies(Type, Msg, Replies), State0), - disconnect_fun(Desc, State#state.opts), - {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. - -disconnect_replies(own, Msg, Replies) -> - [{connection_reply, Msg} | Replies]; -disconnect_replies(peer, _, Replies) -> - Replies. - + {Id, State#data{connection_state = + Connection#connection{channel_id_seed = Id + 1}}}. + +%%%---------------------------------------------------------------- +%% %%% This server/client has decided to disconnect via the state machine: +disconnect(Msg=#ssh_msg_disconnect{description=Description}, _StateName, State0) -> + State = send_msg(Msg, State0), + disconnect_fun(Description, State), +timer:sleep(400), + {stop, {shutdown,Description}, State}. + +%%%---------------------------------------------------------------- counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; counterpart_versions(NumVsn, StrVsn, #ssh{role = client} = Ssh) -> Ssh#ssh{s_vsn = NumVsn , s_version = StrVsn}. -opposite_role(client) -> - server; -opposite_role(server) -> - client. -connected_fun(User, PeerAddr, Method, Opts) -> - case proplists:get_value(connectfun, Opts) of - undefined -> - ok; - Fun -> - catch Fun(User, PeerAddr, Method) - end. - -retry_fun(_, _, undefined, _) -> - ok; - -retry_fun(User, PeerAddr, {error, Reason}, Opts) -> - case proplists:get_value(failfun, Opts) of - undefined -> - ok; - Fun -> - do_retry_fun(Fun, User, PeerAddr, Reason) - end; - -retry_fun(User, PeerAddr, Reason, Opts) -> - case proplists:get_value(infofun, Opts) of - undefined -> - ok; - Fun -> - do_retry_fun(Fun, User, PeerAddr, Reason) - end. - -do_retry_fun(Fun, User, PeerAddr, Reason) -> - case erlang:fun_info(Fun, arity) of - {arity, 2} -> %% Backwards compatible - catch Fun(User, Reason); - {arity, 3} -> - catch Fun(User, PeerAddr, Reason) - end. - ssh_info([], _State, Acc) -> Acc; -ssh_info([client_version | Rest], #state{ssh_params = #ssh{c_vsn = IntVsn, +ssh_info([client_version | Rest], #data{ssh_params = #ssh{c_vsn = IntVsn, c_version = StringVsn}} = State, Acc) -> ssh_info(Rest, State, [{client_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([server_version | Rest], #state{ssh_params =#ssh{s_vsn = IntVsn, +ssh_info([server_version | Rest], #data{ssh_params =#ssh{s_vsn = IntVsn, s_version = StringVsn}} = State, Acc) -> ssh_info(Rest, State, [{server_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([peer | Rest], #state{ssh_params = #ssh{peer = Peer}} = State, Acc) -> +ssh_info([peer | Rest], #data{ssh_params = #ssh{peer = Peer}} = State, Acc) -> ssh_info(Rest, State, [{peer, Peer} | Acc]); -ssh_info([sockname | Rest], #state{socket = Socket} = State, Acc) -> +ssh_info([sockname | Rest], #data{socket = Socket} = State, Acc) -> {ok, SockName} = inet:sockname(Socket), ssh_info(Rest, State, [{sockname, SockName}|Acc]); -ssh_info([user | Rest], #state{auth_user = User} = State, Acc) -> +ssh_info([user | Rest], #data{auth_user = User} = State, Acc) -> ssh_info(Rest, State, [{user, User}|Acc]); ssh_info([ _ | Rest], State, Acc) -> ssh_info(Rest, State, Acc). + ssh_channel_info([], _, Acc) -> Acc; @@ -1765,43 +1684,49 @@ ssh_channel_info([send_window | Rest], #channel{send_window_size = WinSize, ssh_channel_info([ _ | Rest], Channel, Acc) -> ssh_channel_info(Rest, Channel, Acc). + log_error(Reason) -> - Report = io_lib:format("Erlang ssh connection handler failed with reason: " - "~p ~n, Stacktrace: ~p ~n", - [Reason, erlang:get_stacktrace()]), - error_logger:error_report(Report), - "Internal error". - -not_connected_filter({connection_reply, _Data}) -> - true; -not_connected_filter(_) -> - false. - -send_replies([], State) -> - State; -send_replies([{connection_reply, Data} | Rest], #state{ssh_params = Ssh0} = State) -> - {Packet, Ssh} = ssh_transport:ssh_packet(Data, Ssh0), - send_msg(Packet, State), - send_replies(Rest, State#state{ssh_params = Ssh}); -send_replies([Msg | Rest], State) -> - catch send_reply(Msg), - send_replies(Rest, State). - -send_reply({channel_data, Pid, Data}) -> - Pid ! {ssh_cm, self(), Data}; -send_reply({channel_requst_reply, From, Data}) -> - gen_fsm:reply(From, Data); -send_reply({flow_control, Cache, Channel, From, Msg}) -> + Report = io_lib:format("Erlang ssh connection handler failed with reason:~n" + " ~p~n" + "Stacktrace:~n" + " ~p~n", + [Reason, erlang:get_stacktrace()]), + error_logger:error_report(Report). + + +%%%---------------------------------------------------------------- +not_connected_filter({connection_reply, _Data}) -> true; +not_connected_filter(_) -> false. + +%%%---------------------------------------------------------------- +send_replies(Repls, State) -> + lists:foldl(fun get_repl/2, + {[],State}, + Repls). + +get_repl({connection_reply,Msg}, {CallRepls,S}) -> + {CallRepls, send_msg(Msg,S)}; +get_repl({channel_data,undefined,_Data}, Acc) -> + Acc; +get_repl({channel_data,Pid,Data}, Acc) -> + Pid ! {ssh_cm, self(), Data}, + Acc; +get_repl({channel_request_reply,From,Data}, {CallRepls,S}) -> + {[{reply,From,Data}|CallRepls], S}; +get_repl({flow_control,Cache,Channel,From,Msg}, {CallRepls,S}) -> ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}), - gen_fsm:reply(From, Msg); -send_reply({flow_control, From, Msg}) -> - gen_fsm:reply(From, Msg). + {[{reply,From,Msg}|CallRepls], S}; +get_repl({flow_control,From,Msg}, {CallRepls,S}) -> + {[{reply,From,Msg}|CallRepls], S}; +get_repl(noreply, Acc) -> + Acc; +get_repl(X, Acc) -> + exit({get_repl,X,Acc}). -disconnect_fun({disconnect,Msg}, Opts) -> - disconnect_fun(Msg, Opts); -disconnect_fun(_, undefined) -> - ok; -disconnect_fun(Reason, Opts) -> +%%%---------------------------------------------------------------- +disconnect_fun({disconnect,Msg}, D) -> + disconnect_fun(Msg, D); +disconnect_fun(Reason, #data{opts=Opts}) -> case proplists:get_value(disconnectfun, Opts) of undefined -> ok; @@ -1809,50 +1734,137 @@ disconnect_fun(Reason, Opts) -> catch Fun(Reason) end. -unexpected_fun(UnexpectedMessage, Opts, #ssh{peer={_,Peer}}) -> +unexpected_fun(UnexpectedMessage, #data{opts = Opts, + ssh_params = #ssh{peer = {_,Peer} } + } ) -> case proplists:get_value(unexpectedfun, Opts) of undefined -> report; Fun -> - catch Fun(UnexpectedMessage, Peer) + catch Fun(UnexpectedMessage, Peer) end. -check_cache(#state{opts = Opts} = State, Cache) -> - %% Check the number of entries in Cache - case proplists:get_value(size, ets:info(Cache)) of - 0 -> - case proplists:get_value(idle_time, Opts, infinity) of - infinity -> - State; - Time -> - handle_idle_timer(Time, State) - end; +debug_fun(#ssh_msg_debug{always_display = Display, + message = DbgMsg, + language = Lang}, + #data{opts = Opts}) -> + case proplists:get_value(ssh_msg_debug_fun, Opts) of + undefined -> + ok; + Fun -> + catch Fun(self(), Display, DbgMsg, Lang) + end. + + +connected_fun(User, Method, #data{ssh_params = #ssh{peer = {_,Peer}}, + opts = Opts}) -> + case proplists:get_value(connectfun, Opts) of + undefined -> + ok; + Fun -> + catch Fun(User, Peer, Method) + end. + +retry_fun(_, undefined, _) -> + ok; +retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, + peer = {_,Peer} + }}) -> + {Tag,Info} = + case Reason of + {error, Error} -> + {failfun, Error}; + _ -> + {infofun, Reason} + end, + Fun = proplists:get_value(Tag, Opts, fun(_,_)-> ok end), + try erlang:fun_info(Fun, arity) + of + {arity, 2} -> %% Backwards compatible + catch Fun(User, Info); + {arity, 3} -> + catch Fun(User, Peer, Info); _ -> - State + ok + catch + _:_ -> + ok + end. + +%%%---------------------------------------------------------------- +%%% Cache idle timer that closes the connection if there are no +%%% channels open for a while. + +cache_init_idle_timer(D) -> + case proplists:get_value(idle_time, D#data.opts, infinity) of + infinity -> + D#data{idle_timer_value = infinity, + idle_timer_ref = infinity % A flag used later... + }; + IdleTime -> + %% We dont want to set the timeout on first connect + D#data{idle_timer_value = IdleTime} end. -handle_idle_timer(Time, #state{idle_timer_ref = undefined} = State) -> - TimerRef = erlang:send_after(Time, self(), {'EXIT', [], "Timeout"}), - State#state{idle_timer_ref=TimerRef}; -handle_idle_timer(_, State) -> - State. - -remove_timer_ref(State) -> - case State#state.idle_timer_ref of - infinity -> %% If the timer is not activated - State; - undefined -> %% If we already has cancelled the timer - State; - TimerRef -> %% Timer is active + +cache_check_set_idle_timer(D = #data{idle_timer_ref = undefined, + idle_timer_value = IdleTime}) -> + %% No timer set - shall we set one? + case ssh_channel:cache_info(num_entries, cache(D)) of + 0 when IdleTime == infinity -> + %% No. Meaningless to set a timer that fires in an infinite time... + D; + 0 -> + %% Yes, we'll set one since the cache is empty and it should not + %% be that for a specified time + D#data{idle_timer_ref = + erlang:send_after(IdleTime, self(), {'EXIT',[],"Timeout"})}; + _ -> + %% No - there are entries in the cache + D + end; +cache_check_set_idle_timer(D) -> + %% There is already a timer set or the timeout time is infinite + D. + + +cache_cancel_idle_timer(D) -> + case D#data.idle_timer_ref of + infinity -> + %% The timer is not activated + D; + undefined -> + %% The timer is already cancelled + D; + TimerRef -> + %% The timer is active erlang:cancel_timer(TimerRef), - State#state{idle_timer_ref = undefined} + D#data{idle_timer_ref = undefined} end. -socket_control(Socket, Pid, Transport) -> - case Transport:controlling_process(Socket, Pid) of + +cache_request_idle_timer_check(D = #data{idle_timer_value = infinity}) -> + D; +cache_request_idle_timer_check(D = #data{idle_timer_value = IdleTime}) -> + erlang:send_after(IdleTime, self(), check_cache), + D. + +%%%---------------------------------------------------------------- +start_channel_request_timer(_,_, infinity) -> + ok; +start_channel_request_timer(Channel, From, Time) -> + erlang:send_after(Time, self(), {timeout, {Channel, From}}). + +%%%---------------------------------------------------------------- +%%% Connection start and initalization helpers + +socket_control(Socket, Pid, Options) -> + {_, TransportCallback, _} = % For example {_,gen_tcp,_} + proplists:get_value(transport, Options, ?DefaultTransport), + case TransportCallback:controlling_process(Socket, Pid) of ok -> - send_event(Pid, socket_control); + gen_statem:cast(Pid, socket_control); {error, Reason} -> {error, Reason} end. @@ -1881,16 +1893,3 @@ handshake(Pid, Ref, Timeout) -> {error, timeout} end. -start_timeout(_,_, infinity) -> - ok; -start_timeout(Channel, From, Time) -> - erlang:send_after(Time, self(), {timeout, {Channel, From}}). - -getopt(Opt, Socket) -> - case inet:getopts(Socket, [Opt]) of - {ok, [{Opt, Value}]} -> - {ok, Value}; - Other -> - {error, {unexpected_getopts_return, Other}} - end. - diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index 67130d5eac..0c24c09887 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -37,7 +37,7 @@ print() -> io:format("~s", [string()]). print(File) when is_list(File) -> - {ok,D} = file:open(File, write), + {ok,D} = file:open(File, [write]), print(D), file:close(D); print(D) -> diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 65754956aa..db80d4c9e3 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -50,13 +50,7 @@ -define(Empint(X), (ssh_bits:mpint(X))/binary ). -define(Ebinary(X), ?STRING(X) ). -%% encode(Msg) -> -%% try encode1(Msg) -%% catch -%% C:E -> -%% io:format('***********************~n~p:~p ~p~n',[C,E,Msg]), -%% error(E) -%% end. +-define(unicode_list(B), unicode:characters_to_list(B)). encode(#ssh_msg_global_request{ name = Name, @@ -176,7 +170,7 @@ encode(#ssh_msg_userauth_pk_ok{ encode(#ssh_msg_userauth_passwd_changereq{prompt = Prompt, languge = Lang })-> - <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring(Prompt), ?Estring(Lang)>>; + <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring_utf8(Prompt), ?Estring(Lang)>>; encode(#ssh_msg_userauth_info_request{ name = Name, @@ -184,14 +178,14 @@ encode(#ssh_msg_userauth_info_request{ language_tag = Lang, num_prompts = NumPromtps, data = Data}) -> - <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring(Name), ?Estring(Inst), ?Estring(Lang), + <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring_utf8(Name), ?Estring_utf8(Inst), ?Estring(Lang), ?Euint32(NumPromtps), ?'E...'(Data)>>; encode(#ssh_msg_userauth_info_response{ num_responses = Num, data = Data}) -> lists:foldl(fun %%("", Acc) -> Acc; % commented out since it seem wrong - (Response, Acc) -> <<Acc/binary, ?Estring(Response)>> + (Response, Acc) -> <<Acc/binary, ?Estring_utf8(Response)>> end, <<?Ebyte(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?Euint32(Num)>>, Data); @@ -201,17 +195,17 @@ encode(#ssh_msg_disconnect{ description = Desc, language = Lang }) -> - <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring(Desc), ?Estring(Lang)>>; + <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring_utf8(Desc), ?Estring(Lang)>>; encode(#ssh_msg_service_request{ name = Service }) -> - <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring(Service)>>; + <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring_utf8(Service)>>; encode(#ssh_msg_service_accept{ name = Service }) -> - <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring(Service)>>; + <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring_utf8(Service)>>; encode(#ssh_msg_newkeys{}) -> <<?Ebyte(?SSH_MSG_NEWKEYS)>>; @@ -283,7 +277,7 @@ encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>; encode(#ssh_msg_ignore{data = Data}) -> - <<?Ebyte(?SSH_MSG_IGNORE), ?Estring(Data)>>; + <<?Ebyte(?SSH_MSG_IGNORE), ?Estring_utf8(Data)>>; encode(#ssh_msg_unimplemented{sequence = Seq}) -> <<?Ebyte(?SSH_MSG_UNIMPLEMENTED), ?Euint32(Seq)>>; @@ -291,7 +285,7 @@ encode(#ssh_msg_unimplemented{sequence = Seq}) -> encode(#ssh_msg_debug{always_display = Bool, message = Msg, language = Lang}) -> - <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring(Msg), ?Estring(Lang)>>. + <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring_utf8(Msg), ?Estring(Lang)>>. %% Connection Messages @@ -330,7 +324,7 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_OPEN_FAILURE), ?UINT32(Recipient), ?UINT32(Reas #ssh_msg_channel_open_failure{ recipient_channel = Recipient, reason = Reason, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), lang = Lang }; decode(<<?BYTE(?SSH_MSG_CHANNEL_WINDOW_ADJUST), ?UINT32(Recipient), ?UINT32(Bytes)>>) -> @@ -363,7 +357,7 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_REQUEST), ?UINT32(Recipient), ?DEC_BIN(RequestType,__0), ?BYTE(Bool), Data/binary>>) -> #ssh_msg_channel_request{ recipient_channel = Recipient, - request_type = unicode:characters_to_list(RequestType), + request_type = ?unicode_list(RequestType), want_reply = erl_boolean(Bool), data = Data }; @@ -381,9 +375,9 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_REQUEST), ?DEC_BIN(User,__0), ?DEC_BIN(Service,__1), ?DEC_BIN(Method,__2), Data/binary>>) -> #ssh_msg_userauth_request{ - user = unicode:characters_to_list(User), - service = unicode:characters_to_list(Service), - method = unicode:characters_to_list(Method), + user = ?unicode_list(User), + service = ?unicode_list(Service), + method = ?unicode_list(Method), data = Data }; @@ -391,7 +385,7 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_FAILURE), ?DEC_BIN(Auths,__0), ?BYTE(Bool)>>) -> #ssh_msg_userauth_failure { - authentications = unicode:characters_to_list(Auths), + authentications = ?unicode_list(Auths), partial_success = erl_boolean(Bool) }; @@ -493,18 +487,18 @@ decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_REPLY), decode(<<?SSH_MSG_SERVICE_REQUEST, ?DEC_BIN(Service,__0)>>) -> #ssh_msg_service_request{ - name = unicode:characters_to_list(Service) + name = ?unicode_list(Service) }; decode(<<?SSH_MSG_SERVICE_ACCEPT, ?DEC_BIN(Service,__0)>>) -> #ssh_msg_service_accept{ - name = unicode:characters_to_list(Service) + name = ?unicode_list(Service) }; decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0), ?DEC_BIN(Lang,__1)>>) -> #ssh_msg_disconnect{ code = Code, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), language = Lang }; @@ -512,7 +506,7 @@ decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0), ?DEC_BIN decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0)>>) -> #ssh_msg_disconnect{ code = Code, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), language = <<"en">> }; @@ -554,7 +548,7 @@ decode_kex_init(<<?BYTE(Bool)>>, Acc, 0) -> X = 0, list_to_tuple(lists:reverse([X, erl_boolean(Bool) | Acc])); decode_kex_init(<<?DEC_BIN(Data,__0), Rest/binary>>, Acc, N) -> - Names = string:tokens(unicode:characters_to_list(Data), ","), + Names = string:tokens(?unicode_list(Data), ","), decode_kex_init(Rest, [Names | Acc], N -1). diff --git a/lib/ssh/src/ssh_no_io.erl b/lib/ssh/src/ssh_no_io.erl index 8144aac66e..1da257ed99 100644 --- a/lib/ssh/src/ssh_no_io.erl +++ b/lib/ssh/src/ssh_no_io.erl @@ -27,27 +27,39 @@ -export([yes_no/2, read_password/2, read_line/2, format/2]). + +-spec yes_no(any(), any()) -> no_return(). + yes_no(_, _) -> - throw({{no_io_allowed, yes_no}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, yes_no}). + + +-spec read_password(any(), any()) -> no_return(). read_password(_, _) -> - throw({{no_io_allowed, read_password}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, read_password}). + + +-spec read_line(any(), any()) -> no_return(). read_line(_, _) -> - throw({{no_io_allowed, read_line}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}} ). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, read_line}). + + +-spec format(any(), any()) -> no_return(). format(_, _) -> - throw({{no_io_allowed, format}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, format}). diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 6314671f0d..9a9786a914 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -192,6 +192,9 @@ stop_acceptor(Sup) -> [{Name, AcceptorSup}] = [{SupName, ASup} || {SupName, ASup, _, [ssh_acceptor_sup]} <- supervisor:which_children(Sup)], - supervisor:terminate_child(AcceptorSup, Name). - - + case supervisor:terminate_child(AcceptorSup, Name) of + ok -> + supervisor:delete_child(AcceptorSup, Name); + Error -> + Error + end. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index c04bd350c7..7cb3b75ac0 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -265,7 +265,8 @@ new_keys_message(Ssh0) -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), {ok, SshPacket, Ssh}. - + + handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, #ssh{role = client} = Ssh0) -> {ok, Algoritms} = select_algorithm(client, Own, CounterPart), @@ -275,10 +276,10 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, Ssh0#ssh{algorithms = Algoritms}); _ -> %% TODO: Correct code? - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange" - " algorithm failed", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Selection of key exchange algorithm failed" + }) end; handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, @@ -288,10 +289,10 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, true -> {ok, Ssh#ssh{algorithms = Algoritms}}; _ -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange" - " algorithm failed", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Selection of key exchange algorithm failed" + }) end. @@ -371,12 +372,12 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, session_id = sid(Ssh1, H)}}; true -> - throw({{error,bad_e_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'e' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'e' out of bounds"}, + {error,bad_e_from_peer} + ) end. handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, @@ -396,21 +397,20 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> - throw({Error, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = "en"} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed"}, + Error) end; true -> - throw({{error,bad_f_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'f' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds"}, + bad_f_from_peer + ) end. @@ -435,10 +435,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, keyex_info = {Min, Max, NBits} }}; {error,_} -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group found", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group found" + }) end; handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, @@ -469,19 +470,19 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, keyex_info = {-1, -1, NBits} % flag for kex_h hash calc }}; {error,_} -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group found", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group found" + }) end; handle_kex_dh_gex_request(_, _) -> - throw({{error,bad_ssh_msg_kex_dh_gex_request}, + ssh_connection_handler:disconnect( #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request", - language = ""} - }). + description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request"}, + bad_ssh_msg_kex_dh_gex_request). adjust_gex_min_max(Min0, Max0, Opts) -> @@ -495,10 +496,11 @@ adjust_gex_min_max(Min0, Max0, Opts) -> Min2 =< Max2 -> {Min2, Max2}; Max2 < Min2 -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group possible", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group possible" + }) end end. @@ -535,20 +537,18 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, session_id = sid(Ssh, H) }}; true -> - throw({{error,bad_K}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'K' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'K' out of bounds"}, + bad_K) end; true -> - throw({{error,bad_e_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'e' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'e' out of bounds"}, + bad_e_from_peer) end. handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostKey, @@ -572,29 +572,28 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK exchanged_hash = H, session_id = sid(Ssh, H)}}; _Error -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = ""} - ) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed" + }) end; true -> - throw({{error,bad_K}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'K' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'K' out of bounds"}, + bad_K) end; true -> - throw({{error,bad_f_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'f' out of bounds", - language = ""} - }) - end. + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds"}, + bad_f_from_peer + ) + end. %%%---------------------------------------------------------------- %%% @@ -624,12 +623,11 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, session_id = sid(Ssh1, H)}} catch _:_ -> - throw({{error,invalid_peer_public_key}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Peer ECDH public key is invalid", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid"}, + invalid_peer_public_key) end. handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, @@ -650,21 +648,19 @@ handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> - throw({Error, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed"}, + Error) end catch _:_ -> - throw({{error,invalid_peer_public_key}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Peer ECDH public key is invalid", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid"}, + invalid_peer_public_key) end. @@ -675,9 +671,10 @@ handle_new_keys(#ssh_msg_newkeys{}, Ssh0) -> {ok, Ssh} catch _C:_Error -> %% TODO: Throw earlier .... - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Install alg failed", - language = "en"}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Install alg failed" + }) end. %% select session id @@ -929,9 +926,9 @@ select_all(CL, SL) when length(CL) + length(SL) < ?MAX_NUM_ALGORITHMS -> lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A)); select_all(CL, SL) -> Err = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]), - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = Err, - language = ""}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = Err}). select([], []) -> @@ -1042,7 +1039,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {bad_mac, Ssh1}; true -> {Ssh, DecompressedPayload} = decompress(Ssh1, payload(DecryptedPacket)), - {decoded, DecompressedPayload, NextPacketBytes, Ssh} + {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end; aead -> PacketLenBin = DecryptedPfx, @@ -1052,7 +1049,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {Ssh1, DecryptedSfx} -> DecryptedPacket = <<DecryptedPfx/binary, DecryptedSfx/binary>>, {Ssh, DecompressedPayload} = decompress(Ssh1, payload(DecryptedPacket)), - {decoded, DecompressedPayload, NextPacketBytes, Ssh} + {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end end. diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 5667fd2aec..71b5c2c46a 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -64,7 +64,7 @@ child_spec(_) -> Name = undefined, % As simple_one_for_one is used. StartFunc = {ssh_connection_handler, start_link, []}, Restart = temporary, - Shutdown = infinity, + Shutdown = 4000, Modules = [ssh_connection_handler], - Type = supervisor, + Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 4ecc662c13..6ce6d6f537 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -55,6 +55,7 @@ MODULES= \ ssh_relay HRL_FILES_NEEDED_IN_TEST= \ + $(ERL_TOP)/lib/ssh/test/ssh_test_lib.hrl \ $(ERL_TOP)/lib/ssh/src/ssh.hrl \ $(ERL_TOP)/lib/ssh/src/ssh_xfer.hrl diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index bdc980e65c..9910b8f1d7 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -192,7 +192,7 @@ simple_exec_groups_no_match_too_large(Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{seconds,180}}]. +simple_exec_groups() -> [{timetrap,{minutes,5}}]. simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), @@ -226,28 +226,13 @@ sshc_simple_exec(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Host,Port} = ?config(srvr_addr, Config), Cmd = lists:concat(["ssh -p ",Port, - " -C -o UserKnownHostsFile=",KnownHosts, + " -C", + " -o UserKnownHostsFile=",KnownHosts, + " -o StrictHostKeyChecking=no", " ",Host," 1+1."]), ct:log("~p",[Cmd]), - SshPort = open_port({spawn, Cmd}, [binary]), - Expect = <<"2\n">>, - rcv_expected(SshPort, Expect). - - -rcv_expected(SshPort, Expect) -> - receive - {SshPort, {data,Expect}} -> - ct:log("Got expected ~p from ~p",[Expect,SshPort]), - catch port_close(SshPort), - ok; - Other -> - ct:log("Got UNEXPECTED ~p",[Other]), - rcv_expected(SshPort, Expect) - - after ?TIMEOUT -> - catch port_close(SshPort), - ct:fail("Did not receive answer") - end. + OpenSsh = ssh_test_lib:open_port({spawn, Cmd}, [eof,exit_status]), + ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT). %%-------------------------------------------------------------------- %% Connect to the ssh server of the OS @@ -361,13 +346,15 @@ get_atoms(L) -> %%% Test case related %%% start_std_daemon(Opts, Config) -> + ct:log("starting std_daemon",[]), {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts), ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. -start_pubkey_daemon(Opts, Config) -> +start_pubkey_daemon(Opts0, Config) -> + Opts = [{auth_methods,"publickey"}|Opts0], {Pid, Host, Port} = ssh_test_lib:std_daemon1(Config, Opts), - ct:log("started1 ~p:~p ~p",[Host,Port,Opts]), + ct:log("started pubkey_daemon ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 6e1d18cc95..d9be1a32b7 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -333,52 +333,64 @@ find_time(accept_to_hello, L) -> [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> C#call.t_call end, - fun(C=#call{mfa = {ssh_connection_handler,hello,_}, - args = [socket_control|_]}) -> - C#call.t_return - end + ?LINE, + fun(C=#call{mfa = {ssh_connection_handler,handle_event,4}, + args = [_, {version_exchange,_}, {hello,_}, _]}) -> + C#call.t_call + end, + ?LINE ], L, []), {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(kex, L) -> - [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,hello,_}, - args = [socket_control|_]}) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,handle_event,4}, + args = [_, {version_exchange,_}, {hello,_}, _]}) -> C#call.t_call end, - ?send(#ssh_msg_newkeys{}) + ?LINE, + ?send(#ssh_msg_newkeys{}), + ?LINE ], L, []), {kex, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(kex_to_auth, L) -> [T0,T1] = find([?send(#ssh_msg_newkeys{}), - ?recv(#ssh_msg_userauth_request{}) + ?LINE, + ?recv(#ssh_msg_userauth_request{}), + ?LINE ], L, []), {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(auth, L) -> [T0,T1] = find([?recv(#ssh_msg_userauth_request{}), - ?send(#ssh_msg_userauth_success{}) + ?LINE, + ?send(#ssh_msg_userauth_success{}), + ?LINE ], L, []), {auth, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(to_prompt, L) -> [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> C#call.t_call end, - ?recv(#ssh_msg_channel_request{request_type="env"}) + ?LINE, + ?recv(#ssh_msg_channel_request{request_type="env"}), + ?LINE ], L, []), {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(channel_open_close, L) -> [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}), - ?send(#ssh_msg_channel_close{}) + ?LINE, + ?send(#ssh_msg_channel_close{}), + ?LINE ], L, []), {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}. -find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> +find([F,Id|Fs], [C|Cs], Acc) when is_function(F,1) -> try F(C) of T -> find(Fs, Cs, [T|Acc]) catch - _:_ -> find([F|Fs], Cs, Acc) + _:_ -> find([F,Id|Fs], Cs, Acc) end; find([], _, Acc) -> lists:reverse(Acc). @@ -444,7 +456,7 @@ erlang_trace() -> 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), [init_trace(MFA, tp(MFA)) || MFA <- [{ssh_acceptor,handle_connection,5}, - {ssh_connection_handler,hello,2}, +%% {ssh_connection_handler,hello,2}, {ssh_message,encode,1}, {ssh_message,decode,1}, {ssh_transport,select_algorithm,3}, @@ -454,6 +466,10 @@ erlang_trace() -> {ssh_message,decode,1}, {public_key,dh_gex_group,4} % To find dh_gex group size ]], + init_trace({ssh_connection_handler,handle_event,4}, + [{['_', {version_exchange,'_'}, {hello,'_'}, '_'], + [], + [return_trace]}]), {ok, TracerPid}. tp({_M,_F,Arity}) -> diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index a5f424f863..0f757a0322 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -23,6 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh_connect.hrl"). +-include("ssh_test_lib.hrl"). -compile(export_all). @@ -655,15 +656,21 @@ max_channels_option(Config) when is_list(Config) -> {user_interaction, true}, {user_dir, UserDir}]), + %% Allocate a number of ChannelId:s to play with. (This operation is not + %% counted by the max_channel option). {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId2} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId3} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId4} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId5} = ssh_connection:session_channel(ConnectionRef, infinity), - {ok, _ChannelId6} = ssh_connection:session_channel(ConnectionRef, infinity), + {ok, ChannelId6} = ssh_connection:session_channel(ConnectionRef, infinity), + {ok, _ChannelId7} = ssh_connection:session_channel(ConnectionRef, infinity), - %%%---- shell + %% Now start to open the channels (this is counted my max_channels) to check that + %% it gives a failure at right place + + %%%---- Channel 1(3): shell ok = ssh_connection:shell(ConnectionRef,ChannelId0), receive {ssh_cm,ConnectionRef, {data, ChannelId0, 0, <<"Eshell",_/binary>>}} -> @@ -672,10 +679,10 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("CLI Timeout") end, - %%%---- subsystem "echo_n" + %%%---- Channel 2(3): subsystem "echo_n" success = ssh_connection:subsystem(ConnectionRef, ChannelId1, "echo_n", infinity), - %%%---- exec #1 + %%%---- Channel 3(3): exec. This closes itself. success = ssh_connection:exec(ConnectionRef, ChannelId2, "testing1.\n", infinity), receive {ssh_cm, ConnectionRef, {data, ChannelId2, 0, <<"testing1",_/binary>>}} -> @@ -684,13 +691,13 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("Exec #1 Timeout") end, - %%%---- ptty - success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId3, []), + %%%---- Channel 3(3): subsystem "echo_n" (Note that ChannelId2 should be closed now) + ?wait_match(success, ssh_connection:subsystem(ConnectionRef, ChannelId3, "echo_n", infinity)), - %%%---- exec #2 + %%%---- Channel 4(3) !: exec This should fail failure = ssh_connection:exec(ConnectionRef, ChannelId4, "testing2.\n", infinity), - %%%---- close the shell + %%%---- close the shell (Frees one channel) ok = ssh_connection:send(ConnectionRef, ChannelId0, "exit().\n", 5000), %%%---- wait for the subsystem to terminate @@ -703,14 +710,11 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("exit Timeout",[]) end, - %%%---- exec #3 - success = ssh_connection:exec(ConnectionRef, ChannelId5, "testing3.\n", infinity), - receive - {ssh_cm, ConnectionRef, {data, ChannelId5, 0, <<"testing3",_/binary>>}} -> - ok - after 5000 -> - ct:fail("Exec #3 Timeout") - end, + %%---- Try that we can open one channel instead of the closed one + ?wait_match(success, ssh_connection:subsystem(ConnectionRef, ChannelId5, "echo_n", infinity)), + + %%---- But not a fourth one... + failure = ssh_connection:subsystem(ConnectionRef, ChannelId6, "echo_n", infinity), ssh:close(ConnectionRef), ssh:stop_daemon(Pid). diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 1d14a16065..4ca6a473fa 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -51,9 +51,7 @@ ssh_connect_arg4_timeout/1, ssh_connect_negtimeout_parallel/1, ssh_connect_negtimeout_sequential/1, - ssh_connect_nonegtimeout_connected_parallel/0, ssh_connect_nonegtimeout_connected_parallel/1, - ssh_connect_nonegtimeout_connected_sequential/0, ssh_connect_nonegtimeout_connected_sequential/1, ssh_connect_timeout/1, connect/4, ssh_daemon_minimal_remote_max_packet_size_option/1, @@ -82,7 +80,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + {timetrap,{seconds,30}}]. all() -> [connectfun_disconnectfun_server, @@ -493,7 +491,7 @@ ssh_msg_debug_fun_option_client(Config) -> {user_interaction, false}, {ssh_msg_debug_fun,DbgFun}]), %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + gen_statem:cast(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), receive {msg_dbg,X={ConnectionRef,false,<<"Hello">>,<<>>}} -> ct:log("Got expected dbg msg ~p",[X]), @@ -606,7 +604,7 @@ ssh_msg_debug_fun_option_server(Config) -> receive {connection_pid,Server} -> %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + gen_statem:cast(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), receive {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> ct:log("Got expected dbg msg ~p",[X]), @@ -982,16 +980,10 @@ ssh_connect_negtimeout(Config, Parallel) -> %%-------------------------------------------------------------------- %%% Test that ssh connection does not timeout if the connection is established (parallel) - -ssh_connect_nonegtimeout_connected_parallel() -> [{timetrap,{seconds,90}}]. - ssh_connect_nonegtimeout_connected_parallel(Config) -> ssh_connect_nonegtimeout_connected(Config, true). %%% Test that ssh connection does not timeout if the connection is established (non-parallel) - -ssh_connect_nonegtimeout_connected_sequential() -> [{timetrap,{seconds,90}}]. - ssh_connect_nonegtimeout_connected_sequential(Config) -> ssh_connect_nonegtimeout_connected(Config, false). @@ -1000,7 +992,7 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - NegTimeOut = 20000, % ms + NegTimeOut = 2000, % ms ct:log("Parallel: ~p",[Parallel]), {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, @@ -1131,21 +1123,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% This is expected %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), - receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice... - try Connect(Host,Port) - of - _ConnectionRef1 -> - %% Step 3 ok: could set up one more connection after killing one - %% Thats good. - ssh:stop_daemon(Pid), - ok - catch - error:{badmatch,{error,"Connection closed"}} -> - %% Bad indeed. Could not set up one more connection even after killing - %% one existing. Very bad. - ssh:stop_daemon(Pid), - {fail,"Does not decrease # active sessions"} - end + try_to_connect(Connect, Host, Port, Pid) end catch error:{badmatch,{error,"Connection closed"}} -> @@ -1153,6 +1131,35 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> {fail,"Too few connections accepted"} end. + +try_to_connect(Connect, Host, Port, Pid) -> + {ok,Tref} = timer:send_after(3000, timeout_no_connection), % give the supervisors some time... + try_to_connect(Connect, Host, Port, Pid, Tref, 1). % will take max 3300 ms after 11 tries + +try_to_connect(Connect, Host, Port, Pid, Tref, N) -> + try Connect(Host,Port) + of + _ConnectionRef1 -> + %% Step 3 ok: could set up one more connection after killing one + %% Thats good. + timer:cancel(Tref), + ssh:stop_daemon(Pid), + receive % flush. + timeout_no_connection -> ok + after 0 -> ok + end + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Could not set up one more connection. Try again until timeout. + receive + timeout_no_connection -> + ssh:stop_daemon(Pid), + {fail,"Does not decrease # active sessions"} + after N*50 -> % retry after this time + try_to_connect(Connect, Host, Port, Pid, Tref, N+1) + end + end. + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index 90132becbd..f1a909cbd0 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -33,7 +33,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [{group,default_algs}, {group,aes_gcm} ]. @@ -238,7 +237,7 @@ renegotiate2(Config) -> %% get_kex_init - helper function to get key_exchange_init_msg get_kex_init(Conn) -> %% First, validate the key exchange is complete (StateName == connected) - {connected,S} = sys:get_state(Conn), + {{connected,_},S} = sys:get_state(Conn), %% Next, walk through the elements of the #state record looking %% for the #ssh_msg_kexinit record. This method is robust against %% changes to either record. The KEXINIT message contains a cookie diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index cd6c5f82b9..f6d7be41d6 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -38,7 +38,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [{group, not_unicode}, {group, unicode} @@ -301,9 +300,9 @@ end_per_testcase(_, Config) -> end_per_testcase(Config) -> {Sftp, Connection} = ?config(sftp, Config), - ssh_sftp:stop_channel(Sftp), + ok = ssh_sftp:stop_channel(Sftp), catch ssh_sftp:stop_channel(?config(channel_pid2, Config)), - ssh:close(Connection). + ok = ssh:close(Connection). %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- @@ -365,7 +364,7 @@ write_file(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- @@ -378,7 +377,7 @@ write_file_iolist(Config) when is_list(Config) -> Data = list_to_binary("Hej hopp!"), lists:foreach( fun(D) -> - ssh_sftp:write_file(Sftp, FileName, [D]), + ok = ssh_sftp:write_file(Sftp, FileName, [D]), Expected = if is_binary(D) -> D; is_list(D) -> list_to_binary(D) end, @@ -397,7 +396,7 @@ write_big_file(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary(lists:duplicate(750000,"a")), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- @@ -409,7 +408,7 @@ sftp_read_big_file(Config) when is_list(Config) -> Data = list_to_binary(lists:duplicate(750000,"a")), ct:log("Data size to write is ~p bytes",[size(Data)]), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = ssh_sftp:read_file(Sftp, FileName). %%-------------------------------------------------------------------- @@ -425,7 +424,7 @@ remove_file(Config) when is_list(Config) -> ok = ssh_sftp:delete(Sftp, FileName), {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), false = lists:member(filename:basename(FileName), NewFiles), - {error, _} = ssh_sftp:delete(Sftp, FileName). + {error, no_such_file} = ssh_sftp:delete(Sftp, FileName). %%-------------------------------------------------------------------- rename_file() -> [{doc, "Test API function rename_file/2"}]. @@ -500,7 +499,7 @@ set_attributes(Config) when is_list(Config) -> io:put_chars(Fd,"foo"), ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), {error, eacces} = file:write_file(FileName, "hello again"), - ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), ok = file:write_file(FileName, "hello again"). %%-------------------------------------------------------------------- @@ -549,7 +548,7 @@ position(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("1234567890"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {ok, 3} = ssh_sftp:position(Sftp, Handle, {bof, 3}), @@ -577,7 +576,7 @@ pos_read(Config) when is_list(Config) -> FileName = ?config(testfile, Config), {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {async, Ref} = ssh_sftp:apread(Sftp, Handle, {bof, 5}, 4), @@ -607,7 +606,7 @@ pos_write(Config) when is_list(Config) -> {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), Data = list_to_binary("Bye,"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), NewData = list_to_binary(" see you tomorrow"), {async, Ref} = ssh_sftp:apwrite(Sftp, Handle, {bof, 4}, NewData), diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index fb1a9687af..9385bd127d 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -105,7 +105,6 @@ init_per_testcase(TestCase, Config) -> ClientUserDir = filename:join(PrivDir, nopubkey), SystemDir = filename:join(?config(priv_dir, Config), system), - Port = ssh_test_lib:inet_port(node()), Options = [{system_dir, SystemDir}, {user_dir, PrivDir}, {user_passwords,[{?USER, ?PASSWD}]}, @@ -113,11 +112,13 @@ init_per_testcase(TestCase, Config) -> {ok, Sftpd} = case TestCase of ver6_basic -> SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])], - ssh:daemon(Port, [{subsystems, SubSystems}|Options]); + ssh:daemon(0, [{subsystems, SubSystems}|Options]); _ -> SubSystems = [ssh_sftpd:subsystem_spec([])], - ssh:daemon(Port, [{subsystems, SubSystems}|Options]) + ssh:daemon(0, [{subsystems, SubSystems}|Options]) end, + {ok,Dinf} = ssh:daemon_info(Sftpd), + Port = proplists:get_value(port, Dinf), Cm = ssh_test_lib:connect(Port, [{user_dir, ClientUserDir}, diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 09bef87148..355ce6a8f5 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -39,7 +39,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [close_file, quit, diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index f800ea806d..f8929b30ff 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -22,21 +22,23 @@ -module(ssh_sup_SUITE). -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh.hrl"). +-include("ssh_test_lib.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). --define(WAIT_FOR_SHUTDOWN, 500). -define(USER, "Alladin"). -define(PASSWD, "Sesame"). +-define(WAIT_FOR_SHUTDOWN, 500). + %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + {timetrap,{seconds,100}}]. all() -> [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. @@ -92,8 +94,8 @@ default_tree(Config) when is_list(Config) -> lists:keysearch(sshc_sup, 1, TopSupChildren), {value, {sshd_sup, _,supervisor,[sshd_sup]}} = lists:keysearch(sshd_sup, 1, TopSupChildren), - [] = supervisor:which_children(sshc_sup), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshc_sup)), + ?wait_match([], supervisor:which_children(sshd_sup)). sshc_subtree() -> [{doc, "Make sure the sshc subtree is correct"}]. @@ -101,24 +103,27 @@ sshc_subtree(Config) when is_list(Config) -> {_Pid, Host, Port} = ?config(server, Config), UserDir = ?config(userdir, Config), - [] = supervisor:which_children(sshc_sup), + ?wait_match([], supervisor:which_children(sshc_sup)), + {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - [{_, _,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + + ?wait_match([{_, _,worker,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), + {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - [{_,_,supervisor,[ssh_connection_handler]}, - {_,_,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_,_,worker,[ssh_connection_handler]}, + {_,_,worker,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), + ssh:close(Pid1), - [{_,_,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_,_,worker,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), ssh:close(Pid2), - ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshc_sup). + ?wait_match([], supervisor:which_children(sshc_sup)). sshd_subtree() -> [{doc, "Make sure the sshd subtree is correct"}]. @@ -130,14 +135,16 @@ sshd_subtree(Config) when is_list(Config) -> {failfun, fun ssh_test_lib:failfun/2}, {user_passwords, [{?USER, ?PASSWD}]}]), - [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, - Daemon, supervisor, - [ssh_system_sup]}] = - supervisor:which_children(sshd_sup), + + ?wait_match([{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + Daemon, supervisor, + [ssh_system_sup]}], + supervisor:which_children(sshd_sup), + Daemon), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port), ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshd_sup)). sshd_subtree_profile() -> [{doc, "Make sure the sshd subtree using profile option is correct"}]. @@ -152,14 +159,15 @@ sshd_subtree_profile(Config) when is_list(Config) -> {user_passwords, [{?USER, ?PASSWD}]}, {profile, Profile}]), - [{{server,ssh_system_sup, HostIP,Port,Profile}, - Daemon, supervisor, - [ssh_system_sup]}] = - supervisor:which_children(sshd_sup), + ?wait_match([{{server,ssh_system_sup, HostIP,Port,Profile}, + Daemon, supervisor, + [ssh_system_sup]}], + supervisor:which_children(sshd_sup), + Daemon), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port, Profile), ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshd_sup)). check_sshd_system_tree(Daemon, Config) -> @@ -170,28 +178,31 @@ check_sshd_system_tree(Daemon, Config) -> {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - [{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, - {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}] - = supervisor:which_children(Daemon), + ?wait_match([{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}], + supervisor:which_children(Daemon), + [SubSysSup,AccSup]), - [{{server,ssh_connection_sup, _,_}, - ConnectionSup, supervisor, - [ssh_connection_sup]}, - {{server,ssh_channel_sup,_ ,_}, - ChannelSup,supervisor, - [ssh_channel_sup]}] = supervisor:which_children(SubSysSup), + ?wait_match([{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}], + supervisor:which_children(SubSysSup), + [ConnectionSup,ChannelSup]), - [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] = - supervisor:which_children(AccSup), + ?wait_match([{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}], + supervisor:which_children(AccSup)), - [{_, _, worker,[ssh_connection_handler]}] = - supervisor:which_children(ConnectionSup), + ?wait_match([{_, _, worker,[ssh_connection_handler]}], + supervisor:which_children(ConnectionSup)), - [] = supervisor:which_children(ChannelSup), + ?wait_match([], supervisor:which_children(ChannelSup)), ssh_sftp:start_channel(Client), - [{_, _,worker,[ssh_channel]}] = - supervisor:which_children(ChannelSup), + ?wait_match([{_, _,worker,[ssh_channel]}], + supervisor:which_children(ChannelSup)), ssh:close(Client). diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index 697ddb730d..f96b9967d2 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -75,10 +75,11 @@ terminate(_Why, _S) -> run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), - open_port({spawn_executable, Pty_bin}, - [stream, {cd, TmpDir}, {env, [{"USER", User}]}, - {args, []}, binary, - exit_status, use_stdio, stderr_to_stdout]). + ssh_test_lib:open_port({spawn_executable, Pty_bin}, + [stream, + {cd, TmpDir}, + {env, [{"USER", User}]}, + {args, []}]). get_ssh_user(Ref) -> [{user, User}] = ssh:connection_info(Ref, [user]), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 4db7d09ccd..c6541461a1 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -32,15 +32,8 @@ -define(TIMEOUT, 50000). -connect(Options) -> - connect(hostname(), inet_port(), Options). - connect(Port, Options) when is_integer(Port) -> - connect(hostname(), Port, Options); -connect(any, Options) -> - connect(hostname(), inet_port(), Options); -connect(Host, Options) -> - connect(Host, inet_port(), Options). + connect(hostname(), Port, Options). connect(any, Port, Options) -> connect(hostname(), Port, Options); @@ -49,23 +42,33 @@ connect(Host, Port, Options) -> ConnectionRef. daemon(Options) -> - daemon(any, inet_port(), Options). + daemon(any, 0, Options). daemon(Port, Options) when is_integer(Port) -> daemon(any, Port, Options); daemon(Host, Options) -> - daemon(Host, inet_port(), Options). + daemon(Host, 0, Options). + daemon(Host, Port, Options) -> + ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), case ssh:daemon(Host, Port, Options) of {ok, Pid} when Host == any -> - {Pid, hostname(), Port}; + ct:log("ssh:daemon ok (1)",[]), + {Pid, hostname(), daemon_port(Port,Pid)}; {ok, Pid} -> - {Pid, Host, Port}; + ct:log("ssh:daemon ok (2)",[]), + {Pid, Host, daemon_port(Port,Pid)}; Error -> + ct:log("ssh:daemon error ~p",[Error]), Error end. +daemon_port(0, Pid) -> {ok,Dinf} = ssh:daemon_info(Pid), + proplists:get_value(port, Dinf); +daemon_port(Port, _) -> Port. + + std_daemon(Config, ExtraOpts) -> PrivDir = ?config(priv_dir, Config), @@ -201,6 +204,35 @@ reply(TestCase, Result) -> %%ct:log("reply ~p sending ~p ! ~p",[self(), TestCase, Result]), TestCase ! Result. + + +rcv_expected(Expect, SshPort, Timeout) -> + receive + {SshPort, Expect} -> + ct:log("Got expected ~p from ~p",[Expect,SshPort]), + catch port_close(SshPort), + rcv_lingering(50); + Other -> + ct:log("Got UNEXPECTED ~p~nExpect ~p",[Other, {SshPort,Expect}]), + rcv_expected(Expect, SshPort, Timeout) + + after Timeout -> + catch port_close(SshPort), + ct:fail("Did not receive answer") + end. + +rcv_lingering(Timeout) -> + receive + Msg -> + ct:log("Got LINGERING ~p",[Msg]), + rcv_lingering(Timeout) + + after Timeout -> + ct:log("No more lingering messages",[]), + ok + end. + + receive_exec_result(Msg) -> ct:log("Expect data! ~p", [Msg]), receive @@ -470,8 +502,9 @@ openssh_supports(ClientOrServer, Tag, Alg) when ClientOrServer == sshc ; %% Check if we have a "newer" ssh client that supports these test cases ssh_client_supports_Q() -> - ErlPort = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), - 0 == check_ssh_client_support2(ErlPort). + 0 == check_ssh_client_support2( + ?MODULE:open_port({spawn, "ssh -Q cipher"}) + ). check_ssh_client_support2(P) -> receive @@ -690,3 +723,16 @@ has_inet6_address() -> catch throw:6 -> true end. + +%%%---------------------------------------------------------------- +open_port(Arg1) -> + ?MODULE:open_port(Arg1, []). + +open_port(Arg1, ExtraOpts) -> + erlang:open_port(Arg1, + [binary, + stderr_to_stdout, + exit_status, + use_stdio, + overlapped_io, hide %only affects windows + | ExtraOpts]). diff --git a/lib/ssh/test/ssh_test_lib.hrl b/lib/ssh/test/ssh_test_lib.hrl new file mode 100644 index 0000000000..7cb7edeaa8 --- /dev/null +++ b/lib/ssh/test/ssh_test_lib.hrl @@ -0,0 +1,27 @@ +%%------------------------------------------------------------------------- +%% Help macro +%%------------------------------------------------------------------------- +-define(wait_match(Pattern, FunctionCall, Bind, Timeout, Ntries), + Bind = + (fun() -> + F = fun(N, F1) -> + case FunctionCall of + Pattern -> Bind; + _ when N>0 -> + ct:pal("Must sleep ~p ms at ~p:~p",[Timeout,?MODULE,?LINE]), + timer:sleep(Timeout), + F1(N-1, F1); + Other -> + ct:fail("Unexpected ~p:~p ~p",[?MODULE,?LINE,Other]) + end + end, + F(Ntries, F) + end)() + ). + +-define(wait_match(Pattern, FunctionCall, Timeout, Ntries), ?wait_match(Pattern, FunctionCall, ok, Timeout, Ntries)). + +-define(wait_match(Pattern, FunctionCall, Bind), ?wait_match(Pattern, FunctionCall, Bind, 500, 10) ). + +-define(wait_match(Pattern, FunctionCall), ?wait_match(Pattern, FunctionCall, ok) ). + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 5b65edc32f..2be75fd7f3 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -34,7 +34,7 @@ %%-------------------------------------------------------------------- suite() -> - [{timetrap,{seconds,40}}]. + [{timetrap,{seconds,20}}]. all() -> case os:find_executable("ssh") of @@ -50,13 +50,15 @@ groups() -> [{erlang_client, [], [erlang_shell_client_openssh_server, erlang_client_openssh_server_exec_compressed, erlang_client_openssh_server_setenv, - erlang_client_openssh_server_publickey_rsa, erlang_client_openssh_server_publickey_dsa, + erlang_client_openssh_server_publickey_rsa, erlang_client_openssh_server_password, erlang_client_openssh_server_kexs, erlang_client_openssh_server_nonexistent_subsystem ]}, - {erlang_server, [], [erlang_server_openssh_client_public_key_dsa]} + {erlang_server, [], [erlang_server_openssh_client_public_key_dsa, + erlang_server_openssh_client_public_key_rsa + ]} ]. init_per_suite(Config) -> @@ -74,6 +76,7 @@ init_per_group(erlang_server, Config) -> DataDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), + ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), Config; init_per_group(erlang_client, Config) -> CommonAlgs = ssh_test_lib:algo_intersection( @@ -86,6 +89,7 @@ init_per_group(_, Config) -> end_per_group(erlang_server, Config) -> UserDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(UserDir), + ssh_test_lib:clean_rsa(UserDir), Config; end_per_group(_, Config) -> Config. @@ -93,6 +97,8 @@ end_per_group(_, Config) -> init_per_testcase(erlang_server_openssh_client_public_key_dsa, Config) -> chk_key(sshc, 'ssh-dss', ".ssh/id_dsa", Config); +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(_TestCase, Config) -> @@ -347,14 +353,24 @@ erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> %%-------------------------------------------------------------------- erlang_server_openssh_client_public_key_dsa() -> - [{doc, "Validate using dsa publickey."}]. + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, + {doc, "Validate using dsa publickey."}]. 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_rsa() -> + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, + {doc, "Validate using rsa publickey."}]. +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, PubKeyAlg) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, ssh_dsa}, + {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -362,18 +378,8 @@ erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> Cmd = "ssh -p " ++ integer_to_list(Port) ++ " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " 1+1.", - SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), - - receive - {SshPort,{data, <<"2\n">>}} -> - ok - after ?TIMEOUT -> - receive - X -> ct:fail("Received: ~p",[X]) - after 0 -> - ct:fail("Did not receive answer") - end - end, + OpenSsh = ssh_test_lib:open_port({spawn, Cmd}), + ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT), ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index 4269529ae8..e34071af99 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -294,12 +294,11 @@ instantiate(X, _S) -> %%%================================================================ %%% init_ssh(Role, Socket, Options0) -> - Options = [{user_interaction,false} + Options = [{user_interaction, false}, + {vsn, {2,0}}, + {id_string, "ErlangTestLib"} | Options0], - ssh_connection_handler:init_ssh(Role, - {2,0}, - lists:concat(["SSH-2.0-ErlangTestLib ",Role]), - Options, Socket). + ssh_connection_handler:init_ssh_record(Role, Socket, Options). mangle_opts(Options) -> SysOpts = [{reuseaddr, true}, diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index 5c7ec17dac..06bef2455e 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -146,7 +146,8 @@ setup_server_client(#state{config=Config} = State) -> SFTP = ssh_sftpd:subsystem_spec([{root,FtpRootDir},{cwd,FtpRootDir}]), - {Server,Host,Port} = ssh_test_lib:daemon([{system_dir,DataDir}, + {Server,Host,Port} = ssh_test_lib:daemon(ssh_test_lib:inet_port(), % when lower rel is 18.x + [{system_dir,DataDir}, {user_passwords,[{"hej","hopp"}]}, {subsystems,[SFTP]}]), diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 41b42d454b..b165928877 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.2.2 +SSH_VSN = 4.3 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 00419b63db..e9b523d9e1 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -28,6 +28,23 @@ <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 7.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct cipher suites conversion and gaurd expression. + Caused problems with GCM cipher suites and client side + option to set signature_algorithms extention values.</p> + <p> + Own Id: OTP-13525</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 7.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index e490de7eeb..82d6faee42 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -21,7 +21,7 @@ %% Internal application API --behaviour(gen_fsm). +-behaviour(gen_statem). -include("dtls_connection.hrl"). -include("dtls_handshake.hrl"). @@ -36,37 +36,38 @@ %% Internal application API %% Setup --export([start_fsm/8]). +-export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_state/4%, - %%next_state_connection/2 - ]). +-export([next_record/1, next_event/3]). %% Handshake handling --export([%%renegotiate/1, +-export([%%renegotiate/2, send_handshake/2, send_change_cipher/2]). + %% Alert and close handling --export([send_alert/2, handle_own_alert/4, %%handle_close_alert/3, - handle_normal_shutdown/3 - %%handle_unexpected_message/3, - %%alert_user/5, alert_user/8 +-export([%%send_alert/2, handle_own_alert/4, handle_close_alert/3, + handle_normal_shutdown/3 %%, close/5 + %%alert_user/6, alert_user/9 ]). %% Data handling -export([%%write_application_data/3, - read_application_data/2%%, -%% passive_receive/2, next_record_if_active/1 + read_application_data/2, + %%passive_receive/2, + next_record_if_active/1 %%, + %%handle_common_event/4 ]). -%% Called by tls_connection_sup --export([start_link/7]). +%% gen_statem state functions +-export([init/3, error/3, downgrade/3, %% Initiation and take down states + hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states + connection/3]). +%% gen_statem callbacks +-export([terminate/3, code_change/4, format_status/2]). -%% gen_fsm callbacks --export([init/1, hello/2, certify/2, cipher/2, - abbreviated/2, connection/2, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). +-define(GEN_STATEM_CB_MODE, state_functions). %%==================================================================== %% Internal application API @@ -141,75 +142,74 @@ send_change_cipher(Msg, #state{connection_states = ConnectionStates0, start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. -init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> +init([Role, Host, Port, Socket, Options, User, CbInfo]) -> process_flag(trap_exit, true), State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - Handshake = ssl_handshake:init_handshake_history(), - TimeStamp = erlang:monotonic_time(), - try ssl_config:init(SSLOpts0, Role) of - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} -> - Session = State0#state.session, - State = State0#state{ - tls_handshake_history = Handshake, - session = Session#session{own_certificate = OwnCert, - time_stamp = TimeStamp}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbInfo, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams}, - gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)) + try + State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, init, State) catch throw:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error,State0}, get_timeout(State0)) + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, error, {Error,State0}) end. %%-------------------------------------------------------------------- -%% Description:There should be one instance of this function for each -%% possible state name. Whenever a gen_fsm receives an event sent -%% using gen_fsm:send_event/2, the instance of this function with the -%% same name as the current state name StateName is called to handle -%% the event. It is also called if a timeout occurs. -%% -hello(start, #state{host = Host, port = Port, role = client, - ssl_options = SslOpts, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - transport_cb = Transport, socket = Socket, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> +%% State functionsconnection/2 +%%-------------------------------------------------------------------- + +init({call, From}, {start, Timeout}, + #state{host = Host, port = Port, role = client, + ssl_options = SslOpts, + session = #session{own_certificate = Cert} = Session0, + transport_cb = Transport, socket = Socket, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb + } = State0) -> + Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, - Cache, CacheCb, Renegotiation, Cert), + Cache, CacheCb, Renegotiation, Cert), Version = Hello#client_hello.client_version, + HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), Handshake0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates, Handshake} = - encode_handshake(Hello, Version, ConnectionStates0, Handshake0), + encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), State1 = State0#state{connection_states = ConnectionStates, negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, - tls_handshake_history = Handshake}, + tls_handshake_history = Handshake, + start_or_recv_from = From, + timer = Timer}, {Record, State} = next_record(State1), - next_state(hello, hello, Record, State); - -hello(Hello = #client_hello{client_version = ClientVersion}, - State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, - session_cache = Cache, - session_cache_cb = CacheCb, - ssl_options = SslOpts}) -> + next_event(hello, Record, State); +init(Type, Event, State) -> + ssl_connection:init(Type, Event, State, ?MODULE). + +error({call, From}, {start, _Timeout}, {Error, State}) -> + {stop_and_reply, normal, {reply, From, {error, Error}}, State}; +error({call, From}, Msg, State) -> + handle_call(Msg, From, error, State); +error(_, _, _) -> + {keep_state_and_data, [postpone]}. + +hello(internal, #client_hello{client_version = ClientVersion} = Hello, + #state{connection_states = ConnectionStates0, + port = Port, session = #session{own_certificate = Cert} = Session0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb, + ssl_options = SslOpts} = State) -> case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, Session}, ConnectionStates, #hello_extensions{ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves} = ServerHelloExt, HashSign} -> - ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, + ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session, @@ -217,7 +217,7 @@ hello(Hello = #client_hello{client_version = ClientVersion}, #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State) end; -hello(Hello, +hello(internal, Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, role = client, @@ -230,20 +230,30 @@ hello(Hello, ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; - -hello(Msg, State) -> - ssl_connection:hello(Msg, State, ?MODULE). - -abbreviated(Msg, State) -> - ssl_connection:abbreviated(Msg, State, ?MODULE). - -certify(Msg, State) -> - ssl_connection:certify(Msg, State, ?MODULE). - -cipher(Msg, State) -> - ssl_connection:cipher(Msg, State, ?MODULE). - -connection(#hello_request{}, #state{host = Host, port = Port, +hello(info, Event, State) -> + handle_info(Event, hello, State); + +hello(Type, Event, State) -> + ssl_connection:hello(Type, Event, State, ?MODULE). + +abbreviated(info, Event, State) -> + handle_info(Event, abbreviated, State); +abbreviated(Type, Event, State) -> + ssl_connection:abbreviated(Type, Event, State, ?MODULE). + +certify(info, Event, State) -> + handle_info(Event, certify, State); +certify(Type, Event, State) -> + ssl_connection:certify(Type, Event, State, ?MODULE). + +cipher(info, Event, State) -> + handle_info(Event, cipher, State); +cipher(Type, Event, State) -> + ssl_connection:cipher(Type, Event, State, ?MODULE). + +connection(info, Event, State) -> + handle_info(Event, connection, State); +connection(internal, #hello_request{}, #state{host = Host, port = Port, session = #session{own_certificate = Cert} = Session0, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts, @@ -257,40 +267,30 @@ connection(#hello_request{}, #state{host = Host, port = Port, next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_state(connection, hello, Record, State); + next_event(hello, Record, State); -connection(#client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> +connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - hello(Hello, State#state{allow_renegotiate = false}); + {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; + -connection(#client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> +connection(internal, #client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), - State = send_alert(Alert, State0), - next_state_connection(connection, State); + State1 = send_alert(Alert, State0), + {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), + next_event(connection, Record, State); -connection(Msg, State) -> - ssl_connection:connection(Msg, State, tls_connection). +connection(Type, Event, State) -> + ssl_connection:connection(Type, Event, State, ?MODULE). -%%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:send_all_state_event/2, this function is called to handle -%% the event. Not currently used! -%%-------------------------------------------------------------------- -handle_event(_Event, StateName, State) -> - {next_state, StateName, State, get_timeout(State)}. +downgrade(Type, Event, State) -> + ssl_connection:downgrade(Type, Event, State, ?MODULE). -%%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle -%% the event. -%%-------------------------------------------------------------------- -handle_sync_event(Event, From, StateName, State) -> - ssl_connection:handle_sync_event(Event, From, StateName, State). %%-------------------------------------------------------------------- %% Description: This function is called by a gen_fsm when it receives any @@ -301,26 +301,25 @@ handle_sync_event(Event, From, StateName, State) -> %% raw data from socket, unpack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - %% Simplify for now to avoid dialzer warnings before implementation is compleate - %% case next_tls_record(Data, State0) of - %% {Record, State} -> - %% next_state(StateName, StateName, Record, State); - %% #alert{} = Alert -> - %% handle_normal_shutdown(Alert, StateName, State0), - %% {stop, {shutdown, own_alert}, State0} - %% end; - {Record, State} = next_tls_record(Data, State0), - next_state(StateName, StateName, Record, State); - + case next_tls_record(Data, State0) of + {Record, State} -> + next_event(StateName, Record, State); + #alert{} = Alert -> + handle_normal_shutdown(Alert, StateName, State0), + {stop, {shutdown, own_alert}} + end; handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, negotiated_version = _Version} = State) -> handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}, State}; + {stop, {shutdown, transport_closed}}; handle_info(Msg, StateName, State) -> ssl_connection:handle_info(Msg, StateName, State). +handle_call(Event, From, StateName, State) -> + ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). + %%-------------------------------------------------------------------- %% Description:This function is called by a gen_fsm when it is about %% to terminate. It should be the opposite of Module:init/1 and do any @@ -335,7 +334,10 @@ terminate(Reason, StateName, State) -> %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- code_change(_OldVsn, StateName, State, _Extra) -> - {ok, StateName, State}. + {?GEN_STATEM_CB_MODE, StateName, State}. + +format_status(Type, Data) -> + ssl_connection:format_status(Type, Data). %%-------------------------------------------------------------------- %%% Internal functions @@ -372,96 +374,28 @@ next_record(#state{socket = Socket, next_record(State) -> {no_record, State}. -next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> - handle_own_alert(Alert, Version, Current, State); - -next_state(_,Next, no_record, State) -> - {next_state, Next, State, get_timeout(State)}; - -%% next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> -%% Alerts = decode_alerts(EncAlerts), -%% handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); - -next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, - State0 = #state{protocol_buffers = - #protocol_buffers{dtls_handshake_buffer = Buf0} = Buffers, - negotiated_version = Version}) -> - Handle = - fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_handshake_history(), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0, - renegotiation = {true, peer}}); - ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Already in negotiation so it will be ignored! - ?MODULE:SName(Packet, State); - ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> - Version = Packet#client_hello.client_version, - Hs0 = ssl_handshake:init_handshake_history(), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1, - renegotiation = {true, peer}}); - ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_history=Hs0}}) -> - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1}); - (_, StopState) -> StopState - end, - try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), - State = State0#state{protocol_buffers = - Buffers#protocol_buffers{dtls_packets = Packets, - dtls_handshake_buffer = Buf}}, - handle_dtls_handshake(Handle, Next, State) - catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, Current, State0) - end; -next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> - %% Simplify for now to avoid dialzer warnings before implementation is compleate - %% case read_application_data(Data, State0) of - %% Stop = {stop,_,_} -> - %% Stop; - %% {Record, State} -> - %% next_state(StateName, StateName, Record, State) - %% end; - {Record, State} = read_application_data(Data, State0), - next_state(StateName, StateName, Record, State); - -next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, - #state{connection_states = ConnectionStates0} = State0) -> - ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), - {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), - next_state(Current, Next, Record, State); -next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> - %% Ignore unknown type - {Record, State} = next_record(State0), - next_state(Current, Next, Record, State). - -handle_dtls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{dtls_packets = [Packet]} = Buffers} = State) -> - FsmReturn = {next_state, StateName, State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_packets = []}}}, - Handle(Packet, FsmReturn); - -handle_dtls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{dtls_packets = [Packet | Packets]} = Buffers} = - State0) -> - FsmReturn = {next_state, StateName, State0#state{protocol_buffers = - Buffers#protocol_buffers{dtls_packets = - Packets}}}, - case Handle(Packet, FsmReturn) of - {next_state, NextStateName, State, _Timeout} -> - handle_dtls_handshake(Handle, NextStateName, State); - {stop, _,_} = Stop -> - Stop - end. +next_event(StateName, Record, State) -> + next_event(StateName, Record, State, []). +next_event(connection = StateName, no_record, State0, Actions) -> + case next_record_if_active(State0) of + {no_record, State} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {#ssl_tls{} = Record, State} -> + {next_state, StateName, State, [{next_event, internal, {dtls_record, Record}} | Actions]}; + {#alert{} = Alert, State} -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end; +next_event(StateName, Record, State, Actions) -> + case Record of + no_record -> + {next_state, StateName, State, Actions}; + #ssl_tls{} = Record -> + {next_state, StateName, State, [{next_event, internal, {dtls_record, Record}} | Actions]}; + #alert{} = Alert -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end. send_flight(Fragments, #state{transport_cb = Transport, socket = Socket, protocol_buffers = _PBuffers} = State) -> @@ -514,21 +448,23 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, - send_queue = queue:new(), protocol_cb = ?MODULE }. read_application_data(_,State) -> {#ssl_tls{fragment = <<"place holder">>}, State}. - + +next_tls_record(<<>>, _State) -> + #alert{}; %% Place holder next_tls_record(_, State) -> {#ssl_tls{fragment = <<"place holder">>}, State}. -get_timeout(_) -> %% Place holder - infinity. - -next_state_connection(_, State) -> %% Place holder - {next_state, connection, State, get_timeout(State)}. - sequence(_) -> %%TODO real imp 1. +next_record_if_active(State = + #state{socket_options = + #socket_options{active = false}}) -> + {no_record ,State}; + +next_record_if_active(State) -> + next_record(State). diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 2530d66052..e79e1cede0 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -39,7 +39,7 @@ -export([encode_plain_text/4, encode_handshake/3, encode_change_cipher_spec/2]). %% Protocol version handling --export([protocol_version/1, lowest_protocol_version/2, +-export([protocol_version/1, lowest_protocol_version/2, lowest_protocol_version/1, highest_protocol_version/1, supported_protocol_versions/0, is_acceptable_version/2]). @@ -254,6 +254,18 @@ lowest_protocol_version(Version = {M,_}, {N, _}) when M > N -> Version; lowest_protocol_version(_,Version) -> Version. + +%%-------------------------------------------------------------------- +-spec lowest_protocol_version([dtls_version()]) -> dtls_version(). +%% +%% Description: Lowest protocol version present in a list +%%-------------------------------------------------------------------- +lowest_protocol_version([]) -> + lowest_protocol_version(); +lowest_protocol_version(Versions) -> + [Ver | Vers] = Versions, + lowest_list_protocol_version(Ver, Vers). + %%-------------------------------------------------------------------- -spec highest_protocol_version([dtls_version()]) -> dtls_version(). %% @@ -302,6 +314,12 @@ supported_protocol_versions([]) -> supported_protocol_versions([_|_] = Vsns) -> Vsns. +%% highest_protocol_version() -> +%% highest_protocol_version(supported_protocol_versions()). + +lowest_protocol_version() -> + lowest_protocol_version(supported_protocol_versions()). + supported_connection_protocol_versions([]) -> ?ALL_DATAGRAM_SUPPORTED_VERSIONS. @@ -421,3 +439,8 @@ mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) -> NewSeq = (Epoch bsl 48) + SeqNo, <<NewSeq:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. + +lowest_list_protocol_version(Ver, []) -> + Ver; +lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> + lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest). diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 025e8cea61..dbbb25025c 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -696,7 +696,7 @@ handle_options(Opts0, Role) -> default_option_role(server, true, Role), server, Role), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), - hibernate_after = handle_option(hibernate_after, Opts, undefined), + hibernate_after = handle_option(hibernate_after, Opts, infinity), erl_dist = handle_option(erl_dist, Opts, false), alpn_advertised_protocols = handle_option(alpn_advertised_protocols, Opts, undefined), @@ -885,10 +885,13 @@ validate_option(client_renegotiation, Value) when is_boolean(Value) -> validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); -validate_option(hibernate_after, undefined) -> - undefined; +validate_option(hibernate_after, undefined) -> %% Backwards compatibility + infinity; +validate_option(hibernate_after, infinity) -> + infinity; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; + validate_option(erl_dist,Value) when is_boolean(Value) -> Value; validate_option(Opt, Value) diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 544d9b41cd..dc0a0c2cc4 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -992,21 +992,21 @@ suite({ecdh_rsa, aes_256_cbc, sha384, sha384}) -> %% RFC 5288 AES-GCM Cipher Suites suite({rsa, aes_128_gcm, null, sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite({rsa, aes_256_gcm, null}) -> +suite({rsa, aes_256_gcm, null, sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_rsa, aes_128_gcm, null, sha384}) -> +suite({dhe_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite({dhe_rsa, aes_256_gcm, null, sha256}) -> +suite({dhe_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite({dh_rsa, aes_128_gcm, null, sha384}) -> +suite({dh_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite({dh_rsa, aes_256_gcm, null, sha256}) -> +suite({dh_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_dss, aes_128_gcm, null, sha384}) -> +suite({dhe_dss, aes_128_gcm, null, sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite({dhe_dss, aes_256_gcm, null, sha256}) -> +suite({dhe_dss, aes_256_gcm, null, sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_dss, aes_128_gcm, null, sha384}) -> +suite({dh_dss, aes_128_gcm, null, sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; suite({dh_dss, aes_256_gcm, null, sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 0073e86e26..57fa1b904e 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -38,7 +38,7 @@ %% Setup -export([connect/8, ssl_accept/7, handshake/2, handshake/3, - socket_control/4, socket_control/5]). + socket_control/4, socket_control/5, start_or_recv_cancel_timer/2]). %% User Events -export([send/2, recv/3, close/2, shutdown/2, @@ -47,12 +47,16 @@ connection_information/1 ]). --export([handle_session/7]). +%% General gen_statem state functions with extra callback argument +%% to determine if it is an SSL/TLS or DTLS gen_statem machine +-export([init/4, hello/4, abbreviated/4, certify/4, cipher/4, connection/4, downgrade/4]). -%% SSL FSM state functions --export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]). -%% SSL all state functions --export([handle_sync_event/4, handle_info/3, terminate/3, format_status/2]). +%% gen_statem callbacks +-export([terminate/3, format_status/2]). + +%% +-export([handle_info/3, handle_call/5, handle_session/7, ssl_config/3, + prepare_connection/2, hibernate_after/3]). %%==================================================================== @@ -100,7 +104,7 @@ ssl_accept(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> %% Description: Starts ssl handshake. %%-------------------------------------------------------------------- handshake(#sslsocket{pid = Pid}, Timeout) -> - case sync_send_all_state_event(Pid, {start, Timeout}) of + case call(Pid, {start, Timeout}) of connected -> ok; Error -> @@ -114,7 +118,7 @@ handshake(#sslsocket{pid = Pid}, Timeout) -> %% Description: Starts ssl handshake with some new options %%-------------------------------------------------------------------- handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) -> - case sync_send_all_state_event(Pid, {start, SslOptions, Timeout}) of + case call(Pid, {start, SslOptions, Timeout}) of connected -> ok; Error -> @@ -148,7 +152,7 @@ socket_control(Connection, Socket, Pid, Transport, ListenTracker) -> %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> - sync_send_all_state_event(Pid, {application_data, + call(Pid, {application_data, %% iolist_to_binary should really %% be called iodata_to_binary() erlang:iolist_to_binary(Data)}). @@ -160,7 +164,7 @@ send(Pid, Data) -> %% Description: Receives data when active = false %%-------------------------------------------------------------------- recv(Pid, Length, Timeout) -> - sync_send_all_state_event(Pid, {recv, Length, Timeout}). + call(Pid, {recv, Length, Timeout}). %%-------------------------------------------------------------------- -spec connection_information(pid()) -> {ok, list()} | {error, reason()}. @@ -168,7 +172,7 @@ recv(Pid, Length, Timeout) -> %% Description: Get the SNI hostname %%-------------------------------------------------------------------- connection_information(Pid) when is_pid(Pid) -> - sync_send_all_state_event(Pid, connection_information). + call(Pid, connection_information). %%-------------------------------------------------------------------- -spec close(pid(), {close, Timeout::integer() | @@ -178,7 +182,7 @@ connection_information(Pid) when is_pid(Pid) -> %% Description: Close an ssl connection %%-------------------------------------------------------------------- close(ConnectionPid, How) -> - case sync_send_all_state_event(ConnectionPid, How) of + case call(ConnectionPid, How) of {error, closed} -> ok; Other -> @@ -190,7 +194,7 @@ close(ConnectionPid, How) -> %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- shutdown(ConnectionPid, How) -> - sync_send_all_state_event(ConnectionPid, {shutdown, How}). + call(ConnectionPid, {shutdown, How}). %%-------------------------------------------------------------------- -spec new_user(pid(), pid()) -> ok | {error, reason()}. @@ -199,7 +203,7 @@ shutdown(ConnectionPid, How) -> %% or once. %%-------------------------------------------------------------------- new_user(ConnectionPid, User) -> - sync_send_all_state_event(ConnectionPid, {new_user, User}). + call(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- -spec negotiated_protocol(pid()) -> {ok, binary()} | {error, reason()}. @@ -207,7 +211,7 @@ new_user(ConnectionPid, User) -> %% Description: Returns the negotiated protocol %%-------------------------------------------------------------------- negotiated_protocol(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, negotiated_protocol). + call(ConnectionPid, negotiated_protocol). %%-------------------------------------------------------------------- -spec get_opts(pid(), list()) -> {ok, list()} | {error, reason()}. @@ -215,14 +219,14 @@ negotiated_protocol(ConnectionPid) -> %% Description: Same as inet:getopts/2 %%-------------------------------------------------------------------- get_opts(ConnectionPid, OptTags) -> - sync_send_all_state_event(ConnectionPid, {get_opts, OptTags}). + call(ConnectionPid, {get_opts, OptTags}). %%-------------------------------------------------------------------- -spec set_opts(pid(), list()) -> ok | {error, reason()}. %% %% Description: Same as inet:setopts/2 %%-------------------------------------------------------------------- set_opts(ConnectionPid, Options) -> - sync_send_all_state_event(ConnectionPid, {set_opts, Options}). + call(ConnectionPid, {set_opts, Options}). %%-------------------------------------------------------------------- -spec session_info(pid()) -> {ok, list()} | {error, reason()}. @@ -230,7 +234,7 @@ set_opts(ConnectionPid, Options) -> %% Description: Returns info about the ssl session %%-------------------------------------------------------------------- session_info(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, session_info). + call(ConnectionPid, session_info). %%-------------------------------------------------------------------- -spec peer_certificate(pid()) -> {ok, binary()| undefined} | {error, reason()}. @@ -238,7 +242,7 @@ session_info(ConnectionPid) -> %% Description: Returns the peer cert %%-------------------------------------------------------------------- peer_certificate(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, peer_certificate). + call(ConnectionPid, peer_certificate). %%-------------------------------------------------------------------- -spec renegotiation(pid()) -> ok | {error, reason()}. @@ -246,7 +250,7 @@ peer_certificate(ConnectionPid) -> %% Description: Starts a renegotiation of the ssl session. %%-------------------------------------------------------------------- renegotiation(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, renegotiate). + call(ConnectionPid, renegotiate). %%-------------------------------------------------------------------- -spec prf(pid(), binary() | 'master_secret', binary(), @@ -256,9 +260,13 @@ renegotiation(ConnectionPid) -> %% Description: use a ssl sessions TLS PRF to generate key material %%-------------------------------------------------------------------- prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> - sync_send_all_state_event(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}). - + call(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}). +%%-------------------------------------------------------------------- +-spec handle_session(#server_hello{}, ssl_record:ssl_version(), + binary(), #connection_states{}, _,_, #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- handle_session(#server_hello{cipher_suite = CipherSuite, compression_method = Compression}, Version, NewId, ConnectionStates, ProtoExt, Protocol0, @@ -290,61 +298,104 @@ handle_session(#server_hello{cipher_suite = CipherSuite, handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) end. - + %%-------------------------------------------------------------------- --spec hello(start | #hello_request{} | #server_hello{} | term(), - #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). +-spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}. %%-------------------------------------------------------------------- -hello(start, #state{role = server} = State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(hello, hello, Record, State); +ssl_config(Opts, Role, State) -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, + OwnCert, Key, DHParams} = + ssl_config:init(Opts, Role), + Handshake = ssl_handshake:init_handshake_history(), + TimeStamp = erlang:monotonic_time(), + Session = State#state.session, + State#state{tls_handshake_history = Handshake, + session = Session#session{own_certificate = OwnCert, + time_stamp = TimeStamp}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + crl_db = CRLDbInfo, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams, + ssl_options = Opts}. -hello(#hello_request{}, #state{role = client} = State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(hello, hello, Record, State); +%%==================================================================== +%% gen_statem state functions +%%==================================================================== +%%-------------------------------------------------------------------- +-spec init(gen_statem:event_type(), + {start, timeout()} | {start, {list(), list()}, timeout()}| term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- -hello({common_client_hello, Type, ServerHelloExt}, - State, Connection) -> +init({call, From}, {start, Timeout}, State0, Connection) -> + Timer = start_or_recv_cancel_timer(Timeout, From), + {Record, State} = Connection:next_record(State0#state{start_or_recv_from = From, + timer = Timer}), + Connection:next_event(hello, Record, State); +init({call, From}, {start, {Opts, EmOpts}, Timeout}, + #state{role = Role} = State0, Connection) -> + try + State = ssl_config(Opts, Role, State0), + init({call, From}, {start, Timeout}, + State#state{ssl_options = Opts, socket_options = EmOpts}, Connection) + catch throw:Error -> + {stop_and_reply, normal, {reply, From, {error, Error}}} + end; +init({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, init, State, Connection); +init(_Type, _Event, _State, _Connection) -> + {keep_state_and_data, [postpone]}. + +%%-------------------------------------------------------------------- +-spec hello(gen_statem:event_type(), + #hello_request{} | #server_hello{} | term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +hello({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, hello, State, Connection); +hello(internal, {common_client_hello, Type, ServerHelloExt}, State, Connection) -> do_server_hello(Type, ServerHelloExt, State, Connection); -hello(timeout, State, _) -> - {next_state, hello, State, hibernate}; - -hello(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, hello, State). +hello(info, Msg, State, _) -> + handle_info(Msg, hello, State); +hello(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, hello, State, Connection). %%-------------------------------------------------------------------- --spec abbreviated(#hello_request{} | #finished{} | term(), +-spec abbreviated(gen_statem:event_type(), + #hello_request{} | #finished{} | term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -abbreviated(#hello_request{}, State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(abbreviated, hello, Record, State); +abbreviated({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, abbreviated, State, Connection); -abbreviated(#finished{verify_data = Data} = Finished, +abbreviated(internal, #finished{verify_data = Data} = Finished, #state{role = server, negotiated_version = Version, expecting_finished = true, tls_handshake_history = Handshake, session = #session{master_secret = MasterSecret}, connection_states = ConnectionStates0} = - State, Connection) -> + State0, Connection) -> case ssl_handshake:verify_connection(Version, Finished, client, get_current_prf(ConnectionStates0, write), MasterSecret, Handshake) of verified -> ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0), - Connection:next_state_connection(abbreviated, - ack_connection( - State#state{connection_states = ConnectionStates, - expecting_finished = false})); + {Record, State} = prepare_connection(State0#state{connection_states = ConnectionStates, + expecting_finished = false}, Connection), + Connection:next_event(connection, Record, State); #alert{} = Alert -> - Connection:handle_own_alert(Alert, Version, abbreviated, State) + Connection:handle_own_alert(Alert, Version, abbreviated, State0) end; -abbreviated(#finished{verify_data = Data} = Finished, +abbreviated(internal, #finished{verify_data = Data} = Finished, #state{role = client, tls_handshake_history = Handshake0, session = #session{master_secret = MasterSecret}, negotiated_version = Version, @@ -355,40 +406,49 @@ abbreviated(#finished{verify_data = Data} = Finished, verified -> ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), - State = + State1 = finalize_handshake(State0#state{connection_states = ConnectionStates1}, abbreviated, Connection), - Connection:next_state_connection(abbreviated, - ack_connection(State#state{expecting_finished = false})); - #alert{} = Alert -> + {Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection), + Connection:next_event(connection, Record, State); + #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, abbreviated, State0) end; %% only allowed to send next_protocol message after change cipher spec %% & before finished message and it is not allowed during renegotiation -abbreviated(#next_protocol{selected_protocol = SelectedProtocol}, +abbreviated(internal, #next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), - Connection:next_state(abbreviated, abbreviated, Record, State#state{expecting_next_protocol_negotiation = false}); - -abbreviated(timeout, State, _) -> - {next_state, abbreviated, State, hibernate }; - -abbreviated(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, abbreviated, State). - + {Record, State} = + Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), + Connection:next_event(abbreviated, Record, + State#state{expecting_next_protocol_negotiation = false}); +abbreviated(internal, + #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = + State0, Connection) -> + ConnectionStates1 = + ssl_record:activate_pending_connection_state(ConnectionStates0, read), + {Record, State} = Connection:next_record(State0#state{connection_states = + ConnectionStates1}), + Connection:next_event(abbreviated, Record, State#state{expecting_finished = true}); +abbreviated(info, Msg, State, _) -> + handle_info(Msg, abbreviated, State); +abbreviated(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, abbreviated, State, Connection). + %%-------------------------------------------------------------------- --spec certify(#hello_request{} | #certificate{} | #server_key_exchange{} | +-spec certify(gen_statem:event_type(), + #hello_request{} | #certificate{} | #server_key_exchange{} | #certificate_request{} | #server_hello_done{} | #client_key_exchange{} | term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -certify(#hello_request{}, State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(certify, hello, Record, State); - -certify(#certificate{asn1_certificates = []}, +certify({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, certify, State, Connection); +certify(info, Msg, State, _) -> + handle_info(Msg, certify, State); +certify(internal, #certificate{asn1_certificates = []}, #state{role = server, negotiated_version = Version, ssl_options = #ssl_options{verify = verify_peer, fail_if_no_peer_cert = true}} = @@ -396,15 +456,16 @@ certify(#certificate{asn1_certificates = []}, Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE), Connection:handle_own_alert(Alert, Version, certify, State); -certify(#certificate{asn1_certificates = []}, +certify(internal, #certificate{asn1_certificates = []}, #state{role = server, ssl_options = #ssl_options{verify = verify_peer, fail_if_no_peer_cert = false}} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{client_certificate_requested = false}), - Connection:next_state(certify, certify, Record, State); + {Record, State} = + Connection:next_record(State0#state{client_certificate_requested = false}), + Connection:next_event(certify, Record, State); -certify(#certificate{} = Cert, +certify(internal, #certificate{} = Cert, #state{negotiated_version = Version, role = Role, cert_db = CertDbHandle, @@ -426,7 +487,7 @@ certify(#certificate{} = Cert, Connection:handle_own_alert(Alert, Version, certify, State) end; -certify(#server_key_exchange{exchange_keys = Keys}, +certify(internal, #server_key_exchange{exchange_keys = Keys}, #state{role = client, negotiated_version = Version, key_algorithm = Alg, public_key_info = PubKeyInfo, @@ -438,28 +499,28 @@ certify(#server_key_exchange{exchange_keys = Keys}, Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> Params = ssl_handshake:decode_server_key(Keys, Alg, Version), + %% Use negotiated value if TLS-1.2 otherwhise return default HashSign = negotiated_hashsign(Params#server_key_params.hashsign, Alg, PubKeyInfo, Version), + case is_anonymous(Alg) of true -> calculate_secret(Params#server_key_params.params, State#state{hashsign_algorithm = HashSign}, Connection); false -> - case ssl_handshake:verify_server_key(Params, HashSign, ConnectionStates, Version, PubKeyInfo) of + case ssl_handshake:verify_server_key(Params, HashSign, + ConnectionStates, Version, PubKeyInfo) of true -> calculate_secret(Params#server_key_params.params, - State#state{hashsign_algorithm = HashSign}, Connection); + State#state{hashsign_algorithm = HashSign}, + Connection); false -> Connection:handle_own_alert(?ALERT_REC(?FATAL, ?DECRYPT_ERROR), Version, certify, State) end end; -certify(#server_key_exchange{} = Msg, - #state{role = client, key_algorithm = rsa} = State, Connection) -> - Connection:handle_unexpected_message(Msg, certify_server_keyexchange, State); - -certify(#certificate_request{hashsign_algorithms = HashSigns}, +certify(internal, #certificate_request{hashsign_algorithms = HashSigns}, #state{session = #session{own_certificate = Cert}, key_algorithm = KeyExAlg, ssl_options = #ssl_options{signature_algs = SupportedHashSigns}, @@ -470,12 +531,12 @@ certify(#certificate_request{hashsign_algorithms = HashSigns}, Connection:handle_own_alert(Alert, Version, certify, State0); NegotiatedHashSign -> {Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}), - Connection:next_state(certify, certify, Record, + Connection:next_event(certify, Record, State#state{cert_hashsign_algorithm = NegotiatedHashSign}) end; %% PSK and RSA_PSK might bypass the Server-Key-Exchange -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = #session{master_secret = undefined}, negotiated_version = Version, psk_identity = PSKIdentity, @@ -493,10 +554,10 @@ certify(#server_hello_done{}, client_certify_and_key_exchange(State, Connection) end; -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = #session{master_secret = undefined}, ssl_options = #ssl_options{user_lookup_fun = PSKLookup}, - negotiated_version = {Major, Minor}, + negotiated_version = {Major, Minor} = Version, psk_identity = PSKIdentity, premaster_secret = undefined, role = client, @@ -504,16 +565,18 @@ certify(#server_hello_done{}, when Alg == rsa_psk -> Rand = ssl_cipher:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), RSAPremasterSecret = <<?BYTE(Major), ?BYTE(Minor), Rand/binary>>, - case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup, RSAPremasterSecret) of + case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup, + RSAPremasterSecret) of #alert{} = Alert -> - Alert; + Connection:handle_own_alert(Alert, Version, certify, State0); PremasterSecret -> - State = master_secret(PremasterSecret, State0#state{premaster_secret = RSAPremasterSecret}), + State = master_secret(PremasterSecret, + State0#state{premaster_secret = RSAPremasterSecret}), client_certify_and_key_exchange(State, Connection) end; %% Master secret was determined with help of server-key exchange msg -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = #session{master_secret = MasterSecret} = Session, connection_states = ConnectionStates0, negotiated_version = Version, @@ -529,7 +592,7 @@ certify(#server_hello_done{}, end; %% Master secret is calculated from premaster_secret -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = Session0, connection_states = ConnectionStates0, negotiated_version = Version, @@ -546,14 +609,15 @@ certify(#server_hello_done{}, Connection:handle_own_alert(Alert, Version, certify, State0) end; -certify(#client_key_exchange{} = Msg, +certify(internal = Type, #client_key_exchange{} = Msg, #state{role = server, client_certificate_requested = true, - ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State, Connection) -> + ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State, + Connection) -> %% We expect a certificate here - Connection:handle_unexpected_message(Msg, certify_client_key_exchange, State); + handle_common_event(Type, Msg, certify, State, Connection); -certify(#client_key_exchange{exchange_keys = Keys}, +certify(internal, #client_key_exchange{exchange_keys = Keys}, State = #state{key_algorithm = KeyAlg, negotiated_version = Version}, Connection) -> try certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), @@ -563,22 +627,23 @@ certify(#client_key_exchange{exchange_keys = Keys}, Connection:handle_own_alert(Alert, Version, certify, State) end; -certify(timeout, State, _) -> - {next_state, certify, State, hibernate}; - -certify(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, certify, State). - +certify(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, certify, State, Connection). + %%-------------------------------------------------------------------- --spec cipher(#hello_request{} | #certificate_verify{} | #finished{} | term(), +-spec cipher(gen_statem:event_type(), + #hello_request{} | #certificate_verify{} | #finished{} | term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -cipher(#hello_request{}, State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(cipher, hello, Record, State); +cipher({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, cipher, State, Connection); -cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashSign}, +cipher(info, Msg, State, _) -> + handle_info(Msg, cipher, State); + +cipher(internal, #certificate_verify{signature = Signature, + hashsign_algorithm = CertHashSign}, #state{role = server, key_algorithm = KexAlg, public_key_info = PublicKeyInfo, @@ -593,19 +658,20 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS Version, HashSign, MasterSecret, Handshake) of valid -> {Record, State} = Connection:next_record(State0), - Connection:next_state(cipher, cipher, Record, + Connection:next_event(cipher, Record, State#state{cert_hashsign_algorithm = HashSign}); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, cipher, State0) end; %% client must send a next protocol message if we are expecting it -cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true, - negotiated_protocol = undefined, negotiated_version = Version} = State0, +cipher(internal, #finished{}, + #state{role = server, expecting_next_protocol_negotiation = true, + negotiated_protocol = undefined, negotiated_version = Version} = State0, Connection) -> Connection:handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0); -cipher(#finished{verify_data = Data} = Finished, +cipher(internal, #finished{verify_data = Data} = Finished, #state{negotiated_version = Version, host = Host, port = Port, @@ -621,109 +687,154 @@ cipher(#finished{verify_data = Data} = Finished, MasterSecret, Handshake0) of verified -> Session = register_session(Role, Host, Port, Session0), - cipher_role(Role, Data, Session, State#state{expecting_finished = false}, Connection); + cipher_role(Role, Data, Session, + State#state{expecting_finished = false}, Connection); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, cipher, State) end; %% only allowed to send next_protocol message after change cipher spec %% & before finished message and it is not allowed during renegotiation -cipher(#next_protocol{selected_protocol = SelectedProtocol}, +cipher(internal, #next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true, expecting_finished = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), - Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false}); - -cipher(timeout, State, _) -> - {next_state, cipher, State, hibernate}; - -cipher(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, cipher, State). + {Record, State} = + Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), + Connection:next_event(cipher, Record, + State#state{expecting_next_protocol_negotiation = false}); +cipher(internal, #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = + State0, Connection) -> + ConnectionStates1 = + ssl_record:activate_pending_connection_state(ConnectionStates0, read), + {Record, State} = Connection:next_record(State0#state{connection_states = + ConnectionStates1}), + Connection:next_event(cipher, Record, State#state{expecting_finished = true}); +cipher(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, cipher, State, Connection). %%-------------------------------------------------------------------- --spec connection(term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). +-spec connection(gen_statem:event_type(), term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -connection(timeout, State, _) -> - {next_state, connection, State, hibernate}; +connection({call, From}, {application_data, Data}, + #state{protocol_cb = Connection} = State, Connection) -> + %% We should look into having a worker process to do this to + %% parallize send and receive decoding and not block the receiver + %% if sending is overloading the socket. + try + Connection:write_application_data(Data, From, State) + catch throw:Error -> + hibernate_after(connection, State, [{reply, From, Error}]) + end; +connection({call, RecvFrom}, {recv, N, Timeout}, + #state{protocol_cb = Connection, socket_options = + #socket_options{active = false}} = State0, Connection) -> + Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), + Connection:passive_receive(State0#state{bytes_to_read = N, + start_or_recv_from = RecvFrom, + timer = Timer}, connection); +connection({call, From}, renegotiate, #state{protocol_cb = Connection} = State, + Connection) -> + Connection:renegotiate(State#state{renegotiation = {true, From}}, []); +connection({call, From}, peer_certificate, + #state{session = #session{peer_certificate = Cert}} = State, _) -> + hibernate_after(connection, State, [{reply, From, {ok, Cert}}]); +connection({call, From}, connection_information, State, _) -> + Info = connection_info(State), + hibernate_after(connection, State, [{reply, From, {ok, Info}}]); +connection({call, From}, session_info, #state{session = #session{session_id = Id, + cipher_suite = Suite}} = State, _) -> + SessionInfo = [{session_id, Id}, + {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}], + hibernate_after(connection, State, [{reply, From, SessionInfo}]); +connection({call, From}, negotiated_protocol, + #state{negotiated_protocol = undefined} = State, _) -> + hibernate_after(connection, State, [{reply, From, {error, protocol_not_negotiated}}]); +connection({call, From}, negotiated_protocol, + #state{negotiated_protocol = SelectedProtocol} = State, _) -> + hibernate_after(connection, State, + [{reply, From, {ok, SelectedProtocol}}]); +connection({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, connection, State, Connection); +connection(info, Msg, State, _) -> + handle_info(Msg, connection, State); +connection(internal, {recv, _}, State, Connection) -> + Connection:passive_receive(State, connection); +connection(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, connection, State, Connection). -connection(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, connection, State). +%%-------------------------------------------------------------------- +-spec downgrade(gen_statem:event_type(), term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +downgrade(internal, #alert{description = ?CLOSE_NOTIFY}, + #state{transport_cb = Transport, socket = Socket, + downgrade = {Pid, From}} = State, _) -> + ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), + Transport:controlling_process(Socket, Pid), + gen_statem:reply(From, {ok, Socket}), + {stop, normal, State}; +downgrade(timeout, downgrade, #state{downgrade = {_, From}} = State, _) -> + gen_statem:reply(From, {error, timeout}), + {stop, normal, State}; +downgrade(Type, Event, State, Connection) -> + handle_common_event(Type, Event, downgrade, State, Connection). %%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle -%% the event. +%% Event handling functions called by state functions to handle +%% common or unexpected events for the state. %%-------------------------------------------------------------------- -handle_sync_event({application_data, Data}, From, connection, - #state{protocol_cb = Connection} = State) -> - %% We should look into having a worker process to do this to - %% parallize send and receive decoding and not block the receiver - %% if sending is overloading the socket. - try - Connection:write_application_data(Data, From, State) - catch throw:Error -> - {reply, Error, connection, State, get_timeout(State)} +handle_common_event(internal, {tls_record, TLSRecord}, StateName, State, Connection) -> + Connection:handle_common_event(internal, TLSRecord, StateName, State); +handle_common_event(internal, #hello_request{}, StateName, #state{role = client} = State0, Connection) + when StateName =:= connection -> + {Record, State} = Connection:next_record(State0), + Connection:next_event(StateName, Record, State); +handle_common_event(timeout, hibernate, _, _, _) -> + {keep_state_and_data, [hibernate]}; +handle_common_event(internal, {application_data, Data}, StateName, State0, Connection) -> + case Connection:read_application_data(Data, State0) of + {stop, Reason, State} -> + {stop, Reason, State}; + {Record, State} -> + Connection:next_event(StateName, Record, State) end; -handle_sync_event({application_data, Data}, From, StateName, - #state{send_queue = Queue} = State) -> +handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, + #state{negotiated_version = Version} = State, Connection) -> + Connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version, + StateName, State); +handle_common_event(internal, _, _, _, _) -> + {keep_state_and_data, [postpone]}; +handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State, + Connection) -> + Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), + Connection:handle_own_alert(Alert, Version, {StateName, Msg}, State). + +handle_call({application_data, _Data}, _, _, _, _) -> %% In renegotiation priorities handshake, send data when handshake is finished - {next_state, StateName, - State#state{send_queue = queue:in({From, Data}, Queue)}, - get_timeout(State)}; - -handle_sync_event({start, Timeout}, StartFrom, hello, #state{role = Role, - protocol_cb = Connection, - ssl_options = SSLOpts} = State0) -> - try - State = ssl_config(SSLOpts, Role, State0), - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - Connection:hello(start, State#state{start_or_recv_from = StartFrom, - timer = Timer}) - catch throw:Error -> - {stop, normal, {error, Error}, State0} - end; - -handle_sync_event({start, {Opts, EmOpts}, Timeout}, From, StateName, State) -> - try - handle_sync_event({start, Timeout}, From, StateName, State#state{socket_options = EmOpts, - ssl_options = Opts}) - catch throw:Error -> - {stop, normal, {error, Error}, State} - end; - -%% These two clauses below could happen if a server upgrades a socket in -%% active mode. Note that in this case we are lucky that -%% controlling_process has been evalueated before receiving handshake -%% messages from client. The server should put the socket in passive -%% mode before telling the client that it is willing to upgrade -%% and before calling ssl:ssl_accept/2. These clauses are -%% here to make sure it is the users problem and not owers if -%% they upgrade an active socket. -handle_sync_event({start,_}, _, connection, State) -> - {reply, connected, connection, State, get_timeout(State)}; - -handle_sync_event({start, Timeout}, StartFrom, StateName, #state{role = Role, ssl_options = SslOpts} = State0) -> - try - State = ssl_config(SslOpts, Role, State0), - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - {next_state, StateName, State#state{start_or_recv_from = StartFrom, - timer = Timer}, get_timeout(State)} - catch throw:Error -> - {stop, normal, {error, Error}, State0} - end; - -handle_sync_event({close, _} = Close, _, StateName, #state{protocol_cb = Connection} = State) -> + {keep_state_and_data, [postpone]}; +handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when is_pid(Pid) -> + %% terminate will send close alert to peer + State = State0#state{downgrade = {Pid, From}}, + Connection:terminate(downgrade, StateName, State), + %% User downgrades connection + %% When downgrading an TLS connection to a transport connection + %% we must recive the close alert from the peer before releasing the + %% transport socket. + {next_state, downgrade, State, [{timeout, Timeout, downgrade}]}; +handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr - %% inet-option and possible downgrade will work as intended. + %% inet-option Result = Connection:terminate(Close, StateName, State), - {stop, normal, Result, State#state{terminated = true}}; - -handle_sync_event({shutdown, How0}, _, StateName, - #state{transport_cb = Transport, - negotiated_version = Version, - connection_states = ConnectionStates, - socket = Socket} = State) -> + {stop_and_reply, {shutdown, normal}, + {reply, From, Result}, State}; +handle_call({shutdown, How0}, From, _, + #state{transport_cb = Transport, + negotiated_version = Version, + connection_states = ConnectionStates, + socket = Socket}, _) -> case How0 of How when How == write; How == both -> Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), @@ -733,89 +844,84 @@ handle_sync_event({shutdown, How0}, _, StateName, _ -> ok end, - + case Transport:shutdown(Socket, How0) of ok -> - {reply, ok, StateName, State, get_timeout(State)}; + {keep_state_and_data, [{reply, From, ok}]}; Error -> - {stop, normal, Error, State} + gen_statem:reply(From, {error, Error}), + {stop, normal} end; -handle_sync_event({recv, _N, _Timeout}, _RecvFrom, StateName, - #state{socket_options = #socket_options{active = Active}} = State) when Active =/= false -> - {reply, {error, einval}, StateName, State, get_timeout(State)}; -handle_sync_event({recv, N, Timeout}, RecvFrom, connection = StateName, - #state{protocol_cb = Connection} = State0) -> - Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), - Connection:passive_receive(State0#state{bytes_to_read = N, - start_or_recv_from = RecvFrom, timer = Timer}, StateName); -%% Doing renegotiate wait with handling request until renegotiate is -%% finished. Will be handled by next_state_is_connection/2. -handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) -> +handle_call({recv, _N, _Timeout}, From, _, + #state{socket_options = + #socket_options{active = Active}}, _) when Active =/= false -> + {keep_state_and_data, [{reply, From, {error, einval}}]}; +handle_call({recv, N, Timeout}, RecvFrom, StateName, State, _) -> + %% Doing renegotiate wait with handling request until renegotiate is + %% finished. Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom, - timer = Timer}, - get_timeout(State)}; -handle_sync_event({new_user, User}, _From, StateName, - State =#state{user_application = {OldMon, _}}) -> + timer = Timer}, + [{next_event, internal, {recv, RecvFrom}}]}; +handle_call({new_user, User}, From, StateName, + State =#state{user_application = {OldMon, _}}, _) -> NewMon = erlang:monitor(process, User), erlang:demonitor(OldMon, [flush]), - {reply, ok, StateName, State#state{user_application = {NewMon,User}}, - get_timeout(State)}; -handle_sync_event({get_opts, OptTags}, _From, StateName, + {next_state, StateName, State#state{user_application = {NewMon,User}}, + [{reply, From, ok}]}; +handle_call({get_opts, OptTags}, From, _, #state{socket = Socket, transport_cb = Transport, - socket_options = SockOpts} = State) -> + socket_options = SockOpts}, _) -> OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), - {reply, OptsReply, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = undefined} = State) -> - {reply, {error, protocol_not_negotiated}, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = SelectedProtocol} = State) -> - {reply, {ok, SelectedProtocol}, StateName, State, get_timeout(State)}; -handle_sync_event({set_opts, Opts0}, _From, StateName0, - #state{socket_options = Opts1, + {keep_state_and_data, [{reply, From, OptsReply}]}; +handle_call({set_opts, Opts0}, From, connection = StateName0, + #state{socket_options = Opts1, protocol_cb = Connection, socket = Socket, transport_cb = Transport, - user_data_buffer = Buffer} = State0) -> + user_data_buffer = Buffer} = State0, _) -> {Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []), State1 = State0#state{socket_options = Opts}, if Opts#socket_options.active =:= false -> - {reply, Reply, StateName0, State1, get_timeout(State1)}; + hibernate_after(StateName0, State1, [{reply, From, Reply}]); Buffer =:= <<>>, Opts1#socket_options.active =:= false -> %% Need data, set active once {Record, State2} = Connection:next_record_if_active(State1), %% Note: Renogotiation may cause StateName0 =/= StateName - case Connection:next_state(StateName0, StateName0, Record, State2) of - {next_state, StateName, State, Timeout} -> - {reply, Reply, StateName, State, Timeout}; + case Connection:next_event(StateName0, Record, State2) of + {next_state, StateName, State} -> + hibernate_after(StateName, State, [{reply, From, Reply}]); + {next_state, StateName, State, Actions} -> + hibernate_after(StateName, State, [{reply, From, Reply} | Actions]); {stop, Reason, State} -> {stop, Reason, State} end; Buffer =:= <<>> -> %% Active once already set - {reply, Reply, StateName0, State1, get_timeout(State1)}; + hibernate_after(StateName0, State1, [{reply, From, Reply}]); true -> case Connection:read_application_data(<<>>, State1) of - Stop = {stop,_,_} -> - Stop; + {stop, Reason, State} -> + {stop, Reason, State}; {Record, State2} -> %% Note: Renogotiation may cause StateName0 =/= StateName - case Connection:next_state(StateName0, StateName0, Record, State2) of - {next_state, StateName, State, Timeout} -> - {reply, Reply, StateName, State, Timeout}; - {stop, Reason, State} -> - {stop, Reason, State} + case Connection:next_event(StateName0, Record, State2) of + {next_state, StateName, State} -> + hibernate_after(StateName, State, [{reply, From, Reply}]); + {next_state, StateName, State, Actions} -> + hibernate_after(StateName, State, [{reply, From, Reply} | Actions]); + {stop, _, _} = Stop -> + Stop end end end; -handle_sync_event(renegotiate, From, connection, #state{protocol_cb = Connection} = State) -> - Connection:renegotiate(State#state{renegotiation = {true, From}}); -handle_sync_event(renegotiate, _, StateName, State) -> - {reply, {error, already_renegotiating}, StateName, State, get_timeout(State)}; -handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, - #state{connection_states = ConnectionStates, - negotiated_version = Version} = State) -> +handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection -> + {keep_state_and_data, [{reply, From, {error, already_renegotiating}}]}; +handle_call({prf, Secret, Label, Seed, WantedLength}, From, _, + #state{connection_states = ConnectionStates, + negotiated_version = Version}, _) -> ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, @@ -837,27 +943,9 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, exit:_ -> {error, badarg}; error:Reason -> {error, Reason} end, - {reply, Reply, StateName, State, get_timeout(State)}; -handle_sync_event(session_info, _, StateName, - #state{session = #session{session_id = Id, - cipher_suite = Suite}} = State) -> - {reply, [{session_id, Id}, - {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}], - StateName, State, get_timeout(State)}; -handle_sync_event(peer_certificate, _, StateName, - #state{session = #session{peer_certificate = Cert}} - = State) -> - {reply, {ok, Cert}, StateName, State, get_timeout(State)}; -handle_sync_event(connection_information, _, StateName, State) -> - Info = connection_info(State), - {reply, {ok, Info}, StateName, State, get_timeout(State)}. - -connection_info(#state{sni_hostname = SNIHostname, - session = #session{cipher_suite = CipherSuite}, - negotiated_version = Version, ssl_options = Opts}) -> - [{protocol, tls_record:protocol_version(Version)}, - {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, - {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). + {keep_state_and_data, [{reply, From, Reply}]}; +handle_call(_,_,_,_,_) -> + {keep_state_and_data, [postpone]}. handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, @@ -865,7 +953,8 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, protocol_cb = Connection, error_tag = ErrorTag, tracker = Tracker} = State) when StateName =/= connection -> - Connection:alert_user(Transport, Tracker,Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), + Connection:alert_user(Transport, Tracker,Socket, + StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -888,47 +977,46 @@ handle_info({'EXIT', Socket, normal}, _StateName, #state{socket = Socket} = Stat {stop, {shutdown, transport_closed}, State}; handle_info(allow_renegotiate, StateName, State) -> - {next_state, StateName, State#state{allow_renegotiate = true}, get_timeout(State)}; + {next_state, StateName, State#state{allow_renegotiate = true}}; handle_info({cancel_start_or_recv, StartFrom}, StateName, #state{renegotiation = {false, first}} = State) when StateName =/= connection -> - gen_fsm:reply(StartFrom, {error, timeout}), - {stop, {shutdown, user_timeout}, State#state{timer = undefined}}; + {stop_and_reply, {shutdown, user_timeout}, + {reply, StartFrom, {error, timeout}}, State#state{timer = undefined}}; -handle_info({cancel_start_or_recv, RecvFrom}, StateName, #state{start_or_recv_from = RecvFrom} = State) -> - gen_fsm:reply(RecvFrom, {error, timeout}), +handle_info({cancel_start_or_recv, RecvFrom}, StateName, + #state{start_or_recv_from = RecvFrom} = State) when RecvFrom =/= undefined -> {next_state, StateName, State#state{start_or_recv_from = undefined, bytes_to_read = undefined, - timer = undefined}, get_timeout(State)}; + timer = undefined}, [{reply, RecvFrom, {error, timeout}}]}; handle_info({cancel_start_or_recv, _RecvFrom}, StateName, State) -> - {next_state, StateName, State#state{timer = undefined}, get_timeout(State)}; + {next_state, StateName, State#state{timer = undefined}}; handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> Report = io_lib:format("SSL: Got unexpected info: ~p ~n", [{Msg, Tag, Socket}]), error_logger:info_report(Report), - {next_state, StateName, State, get_timeout(State)}. - + {next_state, StateName, State}. +%%-------------------------------------------------------------------- +%% gen_statem callbacks +%%-------------------------------------------------------------------- terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called %% when ssl:close/1 returns. ok; + terminate({shutdown, transport_closed} = Reason, - _StateName, #state{send_queue = SendQueue, protocol_cb = Connection, - socket = Socket, transport_cb = Transport, - renegotiation = Renegotiate} = State) -> + _StateName, #state{protocol_cb = Connection, + socket = Socket, transport_cb = Transport} = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), Connection:close(Reason, Socket, Transport, undefined, undefined); -terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue, protocol_cb = Connection, - socket = Socket, transport_cb = Transport, - renegotiation = Renegotiate} = State) -> +terminate({shutdown, own_alert}, _StateName, #state{%%send_queue = SendQueue, + protocol_cb = Connection, + socket = Socket, + transport_cb = Transport} = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), case application:get_env(ssl, alert_timeout) of {ok, Timeout} when is_integer(Timeout) -> Connection:close({timeout, Timeout}, Socket, Transport, undefined, undefined); @@ -939,26 +1027,22 @@ terminate(Reason, connection, #state{negotiated_version = Version, protocol_cb = Connection, connection_states = ConnectionStates0, ssl_options = #ssl_options{padding_check = Check}, - transport_cb = Transport, socket = Socket, - send_queue = SendQueue, renegotiation = Renegotiate} = State) -> + transport_cb = Transport, socket = Socket + } = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0), Transport:send(Socket, BinAlert), Connection:close(Reason, Socket, Transport, ConnectionStates, Check); terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection, - socket = Socket, send_queue = SendQueue, - renegotiation = Renegotiate} = State) -> + socket = Socket + } = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), Connection:close(Reason, Socket, Transport, undefined, undefined). -format_status(normal, [_, State]) -> - [{data, [{"StateData", State}]}]; -format_status(terminate, [_, State]) -> +format_status(normal, [_, StateName, State]) -> + [{data, [{"State", {StateName, State}}]}]; +format_status(terminate, [_, StateName, State]) -> SslOptions = (State#state.ssl_options), NewOptions = SslOptions#ssl_options{password = ?SECRET_PRINTOUT, cert = ?SECRET_PRINTOUT, @@ -967,39 +1051,29 @@ format_status(terminate, [_, State]) -> dh = ?SECRET_PRINTOUT, psk_identity = ?SECRET_PRINTOUT, srp_identity = ?SECRET_PRINTOUT}, - [{data, [{"StateData", State#state{connection_states = ?SECRET_PRINTOUT, - protocol_buffers = ?SECRET_PRINTOUT, - user_data_buffer = ?SECRET_PRINTOUT, - tls_handshake_history = ?SECRET_PRINTOUT, - session = ?SECRET_PRINTOUT, - private_key = ?SECRET_PRINTOUT, - diffie_hellman_params = ?SECRET_PRINTOUT, - diffie_hellman_keys = ?SECRET_PRINTOUT, - srp_params = ?SECRET_PRINTOUT, - srp_keys = ?SECRET_PRINTOUT, - premaster_secret = ?SECRET_PRINTOUT, - ssl_options = NewOptions - }}]}]. + [{data, [{"State", {StateName, State#state{connection_states = ?SECRET_PRINTOUT, + protocol_buffers = ?SECRET_PRINTOUT, + user_data_buffer = ?SECRET_PRINTOUT, + tls_handshake_history = ?SECRET_PRINTOUT, + session = ?SECRET_PRINTOUT, + private_key = ?SECRET_PRINTOUT, + diffie_hellman_params = ?SECRET_PRINTOUT, + diffie_hellman_keys = ?SECRET_PRINTOUT, + srp_params = ?SECRET_PRINTOUT, + srp_keys = ?SECRET_PRINTOUT, + premaster_secret = ?SECRET_PRINTOUT, + ssl_options = NewOptions} + }}]}]. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -ssl_config(Opts, Role, State) -> - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} = - ssl_config:init(Opts, Role), - Handshake = ssl_handshake:init_handshake_history(), - TimeStamp = erlang:monotonic_time(), - Session = State#state.session, - State#state{tls_handshake_history = Handshake, - session = Session#session{own_certificate = OwnCert, - time_stamp = TimeStamp}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbInfo, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams, - ssl_options = Opts}. +connection_info(#state{sni_hostname = SNIHostname, + session = #session{cipher_suite = CipherSuite}, + negotiated_version = Version, ssl_options = Opts}) -> + [{protocol, tls_record:protocol_version(Version)}, + {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, + {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} = ServerHelloExt, @@ -1033,7 +1107,7 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = Connection:next_record(State2#state{session = Session}), - Connection:next_state(hello, certify, Record, State) + Connection:next_event(certify, Record, State) catch #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, hello, State0) @@ -1051,7 +1125,7 @@ resumed_server_hello(#state{session = Session, State2 = finalize_handshake(State1, abbreviated, Connection), {Record, State} = Connection:next_record(State2), - Connection:next_state(hello, abbreviated, Record, State); + Connection:next_event(abbreviated, Record, State); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, hello, State0) end. @@ -1076,7 +1150,7 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, State2 = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlg, State1), {Record, State} = Connection:next_record(State2), - Connection:next_state(certify, certify, Record, State). + Connection:next_event(certify, Record, State). handle_peer_cert_key(client, _, {?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey, @@ -1139,7 +1213,7 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} = %% Reinitialize client_certificate_requested = false}, {Record, State} = Connection:next_record(State3), - Connection:next_state(certify, cipher, Record, State) + Connection:next_event(cipher, Record, State) catch throw:#alert{} = Alert -> Connection:handle_own_alert(Alert, Version, certify, State0) @@ -1173,20 +1247,25 @@ certify_client_key_exchange(#client_ec_diffie_hellman_public{dh_public = ClientP calculate_master_secret(PremasterSecret, State, Connection, certify, cipher); certify_client_key_exchange(#client_psk_identity{} = ClientKey, - #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> + #state{ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State0, + Connection) -> PremasterSecret = ssl_handshake:premaster_secret(ClientKey, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey, #state{diffie_hellman_params = #'DHParameter'{} = Params, diffie_hellman_keys = {_, ServerDhPrivateKey}, - ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, + ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> - PremasterSecret = ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup), + PremasterSecret = + ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey, #state{private_key = Key, - ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, + ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); @@ -1198,8 +1277,11 @@ certify_client_key_exchange(#client_srp_public{} = ClientKey, PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, Params), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher). -certify_server(#state{key_algorithm = Algo} = State, _) - when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; Algo == srp_anon -> +certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon; + Algo == ecdh_anon; + Algo == psk; + Algo == dhe_psk; + Algo == srp_anon -> State; certify_server(#state{cert_db = CertDbHandle, @@ -1297,10 +1379,11 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, - HashSignAlgo, ClientRandom, - ServerRandom, - PrivateKey}), + Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, + PskIdentityHint, DHKeys, Params, + HashSignAlgo, ClientRandom, + ServerRandom, + PrivateKey}), State = Connection:send_handshake(Msg, State0), State#state{diffie_hellman_keys = DHKeys}; @@ -1389,7 +1472,8 @@ key_exchange(#state{role = client, ssl_options = SslOpts, key_algorithm = psk, negotiated_version = Version} = State0, Connection) -> - Msg = ssl_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}), + Msg = ssl_handshake:key_exchange(client, Version, + {psk, SslOpts#ssl_options.psk_identity}), Connection:send_handshake(Msg, State0); key_exchange(#state{role = client, @@ -1398,7 +1482,8 @@ key_exchange(#state{role = client, negotiated_version = Version, diffie_hellman_keys = {DhPubKey, _}} = State0, Connection) -> Msg = ssl_handshake:key_exchange(client, Version, - {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), + {dhe_psk, + SslOpts#ssl_options.psk_identity, DhPubKey}), Connection:send_handshake(Msg, State0); key_exchange(#state{role = client, ssl_options = SslOpts, @@ -1438,7 +1523,8 @@ rsa_key_exchange(Version, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) rsa_key_exchange(_, _, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). -rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) +rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, + PublicKeyInfo = {Algorithm, _, _}) when Algorithm == ?rsaEncryption; Algorithm == ?md2WithRSAEncryption; Algorithm == ?md5WithRSAEncryption; @@ -1473,10 +1559,11 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_none}} = State, _) -> State. -calculate_master_secret(PremasterSecret, #state{negotiated_version = Version, - connection_states = ConnectionStates0, - session = Session0} = State0, Connection, - Current, Next) -> +calculate_master_secret(PremasterSecret, + #state{negotiated_version = Version, + connection_states = ConnectionStates0, + session = Session0} = State0, Connection, + _Current, Next) -> case ssl_handshake:master_secret(record_cb(Connection), Version, PremasterSecret, ConnectionStates0, server) of {MasterSecret, ConnectionStates} -> @@ -1484,7 +1571,7 @@ calculate_master_secret(PremasterSecret, #state{negotiated_version = Version, State1 = State0#state{connection_states = ConnectionStates, session = Session}, {Record, State} = Connection:next_record(State1), - Connection:next_state(Current, Next, Record, State); + Connection:next_event(Next, Record, State); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, certify, State0) end. @@ -1535,31 +1622,36 @@ save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbrev save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> ssl_record:set_server_verify_data(current_write, Data, ConnectionStates). -calculate_secret(#server_dh_params{dh_p = Prime, dh_g = Base, dh_y = ServerPublicDhKey} = Params, - State, Connection) -> +calculate_secret(#server_dh_params{dh_p = Prime, dh_g = Base, + dh_y = ServerPublicDhKey} = Params, + State, Connection) -> Keys = {_, PrivateDhKey} = crypto:generate_key(dh, [Prime, Base]), PremasterSecret = ssl_handshake:premaster_secret(ServerPublicDhKey, PrivateDhKey, Params), calculate_master_secret(PremasterSecret, - State#state{diffie_hellman_keys = Keys}, Connection, certify, certify); + State#state{diffie_hellman_keys = Keys}, + Connection, certify, certify); calculate_secret(#server_ecdh_params{curve = ECCurve, public = ECServerPubKey}, State, Connection) -> ECDHKeys = public_key:generate_key(ECCurve), - PremasterSecret = ssl_handshake:premaster_secret(#'ECPoint'{point = ECServerPubKey}, ECDHKeys), + PremasterSecret = + ssl_handshake:premaster_secret(#'ECPoint'{point = ECServerPubKey}, ECDHKeys), calculate_master_secret(PremasterSecret, - State#state{diffie_hellman_keys = ECDHKeys}, Connection, certify, certify); + State#state{diffie_hellman_keys = ECDHKeys}, + Connection, certify, certify); calculate_secret(#server_psk_params{ - hint = IdentityHint}, + hint = IdentityHint}, State0, Connection) -> %% store for later use {Record, State} = Connection:next_record(State0#state{psk_identity = IdentityHint}), - Connection:next_state(certify, certify, Record, State); + Connection:next_event(certify, Record, State); calculate_secret(#server_dhe_psk_params{ dh_params = #server_dh_params{dh_p = Prime, dh_g = Base}} = ServerKey, - #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State, Connection) -> + #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = + State, Connection) -> Keys = {_, PrivateDhKey} = crypto:generate_key(dh, [Prime, Base]), PremasterSecret = ssl_handshake:premaster_secret(ServerKey, PrivateDhKey, PSKLookup), @@ -1567,10 +1659,12 @@ calculate_secret(#server_dhe_psk_params{ Connection, certify, certify); calculate_secret(#server_srp_params{srp_n = Prime, srp_g = Generator} = ServerKey, - #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State, Connection) -> + #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State, + Connection) -> Keys = generate_srp_client_keys(Generator, Prime, 0), PremasterSecret = ssl_handshake:premaster_secret(ServerKey, Keys, SRPId), - calculate_master_secret(PremasterSecret, State#state{srp_keys = Keys}, Connection, certify, certify). + calculate_master_secret(PremasterSecret, State#state{srp_keys = Keys}, Connection, + certify, certify). master_secret(#alert{} = Alert, _) -> Alert; @@ -1626,21 +1720,23 @@ handle_srp_identity(Username, {Fun, UserState}) -> end. -cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State, +cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State0, Connection) -> - ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0), - Connection:next_state_connection(cipher, - ack_connection( - State#state{session = Session, - connection_states = ConnectionStates})); - + ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, + ConnectionStates0), + {Record, State} = prepare_connection(State0#state{session = Session, + connection_states = ConnectionStates}, + Connection), + Connection:next_event(connection, Record, State); cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0} = State0, Connection) -> - ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), - State = + ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, + ConnectionStates0), + State1 = finalize_handshake(State0#state{connection_states = ConnectionStates1, session = Session}, cipher, Connection), - Connection:next_state_connection(cipher, ack_connection(State#state{session = Session})). + {Record, State} = prepare_connection(State1, Connection), + Connection:next_event(connection, Record, State). select_curve(#state{client_ecc = {[Curve|_], _}}) -> {namedCurve, Curve}; @@ -1674,8 +1770,8 @@ record_cb(tls_connection) -> record_cb(dtls_connection) -> dtls_record. -sync_send_all_state_event(FsmPid, Event) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, infinity) +call(FsmPid, Event) -> + try gen_statem:call(FsmPid, Event) catch exit:{noproc, _} -> {error, closed}; @@ -1731,38 +1827,42 @@ 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) when Mode == list; Mode == binary -> +set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) + when Mode == list; Mode == binary -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; - Packet == 0; - Packet == 1; - Packet == 2; - Packet == 4; - Packet == asn1; - Packet == cdr; - Packet == sunrm; - Packet == fcgi; - Packet == tpkt; - Packet == line; - Packet == http; - Packet == httph; - Packet == http_bin; - Packet == httph_bin -> +set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) + when Packet == raw; + Packet == 0; + Packet == 1; + Packet == 2; + Packet == 4; + Packet == asn1; + Packet == cdr; + Packet == sunrm; + Packet == fcgi; + Packet == tpkt; + Packet == line; + Packet == http; + Packet == httph; + Packet == http_bin; + Packet == httph_bin -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> +set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) + when is_integer(Header) -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> {{error,{options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; - Active == true; - Active == false -> +set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) + when Active == once; + Active == true; + Active == false -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> @@ -1775,11 +1875,10 @@ start_or_recv_cancel_timer(infinity, _RecvFrom) -> start_or_recv_cancel_timer(Timeout, RecvFrom) -> erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = undefined}}) -> - infinity; -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}}) -> - HibernateAfter. - +hibernate_after(StateName, #state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}} = State, + Actions) -> + {next_state, StateName, State, [{timeout, HibernateAfter, hibernate} | Actions]}. + terminate_alert(normal, Version, ConnectionStates) -> ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Version, ConnectionStates); @@ -1789,10 +1888,12 @@ terminate_alert({Reason, _}, Version, ConnectionStates) when Reason == close; Version, ConnectionStates); terminate_alert(_, Version, ConnectionStates) -> - ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), - Version, ConnectionStates). + {BinAlert, _} = ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), + Version, ConnectionStates), + BinAlert. -handle_trusted_certs_db(#state{ssl_options = #ssl_options{cacertfile = <<>>, cacerts = []}}) -> +handle_trusted_certs_db(#state{ssl_options = + #ssl_options{cacertfile = <<>>, cacerts = []}}) -> %% No trusted certs specified ok; handle_trusted_certs_db(#state{cert_db_ref = Ref, @@ -1802,7 +1903,8 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, %% with other connections and it is safe to delete them when the connection ends. ssl_pkix_db:remove_trusted_certs(Ref, CertDb); handle_trusted_certs_db(#state{file_ref_db = undefined}) -> - %% Something went wrong early (typically cacertfile does not exist) so there is nothing to handle + %% Something went wrong early (typically cacertfile does not + %% exist) so there is nothing to handle ok; handle_trusted_certs_db(#state{cert_db_ref = Ref, file_ref_db = RefDb, @@ -1814,29 +1916,29 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, ok end. -notify_senders(SendQueue) -> - lists:foreach(fun({From, _}) -> - gen_fsm:reply(From, {error, closed}) - end, queue:to_list(SendQueue)). - -notify_renegotiater({true, From}) when not is_atom(From) -> - gen_fsm:reply(From, {error, closed}); -notify_renegotiater(_) -> - ok. +prepare_connection(#state{renegotiation = Renegotiate, + start_or_recv_from = RecvFrom} = State0, Connection) + when Renegotiate =/= {false, first}, + RecvFrom =/= undefined -> + {Record, State} = Connection:next_record(State0), + {Record, ack_connection(State)}; +prepare_connection(State, _) -> + {no_record, ack_connection(State)}. ack_connection(#state{renegotiation = {true, Initiater}} = State) when Initiater == internal; Initiater == peer -> State#state{renegotiation = undefined}; ack_connection(#state{renegotiation = {true, From}} = State) -> - gen_fsm:reply(From, ok), + gen_statem:reply(From, ok), State#state{renegotiation = undefined}; ack_connection(#state{renegotiation = {false, first}, start_or_recv_from = StartFrom, timer = Timer} = State) when StartFrom =/= undefined -> - gen_fsm:reply(StartFrom, connected), + gen_statem:reply(StartFrom, connected), cancel_timer(Timer), - State#state{renegotiation = undefined, start_or_recv_from = undefined, timer = undefined}; + State#state{renegotiation = undefined, + start_or_recv_from = undefined, timer = undefined}; ack_connection(State) -> State. @@ -1857,13 +1959,14 @@ register_session(server, _, Port, #session{is_resumable = new} = Session0) -> register_session(_, _, _, Session) -> Session. %% Already registered -handle_new_session(NewId, CipherSuite, Compression, #state{session = Session0, - protocol_cb = Connection} = State0) -> +handle_new_session(NewId, CipherSuite, Compression, + #state{session = Session0, + protocol_cb = Connection} = State0) -> Session = Session0#session{session_id = NewId, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = Connection:next_record(State0#state{session = Session}), - Connection:next_state(hello, certify, Record, State). + Connection:next_event(certify, Record, State). handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, negotiated_version = Version, @@ -1879,7 +1982,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, Connection:next_record(State0#state{ connection_states = ConnectionStates, session = Session}), - Connection:next_state(hello, abbreviated, Record, State); + Connection:next_event(abbreviated, Record, State); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, hello, State0) end. diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index bb41ef2b62..7682cb86ea 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -75,7 +75,7 @@ renegotiation :: undefined | {boolean(), From::term() | internal | peer}, start_or_recv_from :: term(), timer :: undefined | reference(), % start_or_recive_timer - send_queue :: queue:queue(), + %%send_queue :: queue:queue(), terminated = false ::boolean(), allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), @@ -83,7 +83,8 @@ negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} tracker :: pid() | 'undefined', %% Tracker process for listen socket - sni_hostname = undefined + sni_hostname = undefined, + downgrade }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 9c52f5a315..076e663cd4 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -118,7 +118,7 @@ %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: boolean() | 'undefined', + hibernate_after :: timeout(), %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), alpn_advertised_protocols = undefined :: [binary()] | undefined , diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 2349158b11..60b4fbe995 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -610,8 +610,8 @@ server_register_session(Port, Session, #state{session_cache_server_max = Max, do_register_session(Key, Session, Max, Pid, Cache, CacheCb) -> try CacheCb:size(Cache) of - N when N > Max -> - invalidate_session_cache(Pid, CacheCb, Cache); + Max -> + invalidate_session_cache(Pid, CacheCb, Cache); _ -> CacheCb:update(Cache, Key, Session), Pid diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index a1d13d1850..2193fc18c2 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -28,7 +28,7 @@ -module(tls_connection). --behaviour(gen_fsm). +-behaviour(gen_statem). -include("tls_connection.hrl"). -include("tls_handshake.hrl"). @@ -43,31 +43,32 @@ %% Internal application API %% Setup --export([start_fsm/8]). +-export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_state/4, next_state_connection/2]). +-export([next_record/1, next_event/3]). %% Handshake handling --export([renegotiate/1, send_handshake/2, send_change_cipher/2]). +-export([renegotiate/2, send_handshake/2, send_change_cipher/2]). %% Alert and close handling -export([send_alert/2, handle_own_alert/4, handle_close_alert/3, - handle_normal_shutdown/3, handle_unexpected_message/3, + handle_normal_shutdown/3, close/5, alert_user/6, alert_user/9 ]). %% Data handling -export([write_application_data/3, read_application_data/2, - passive_receive/2, next_record_if_active/1]). + passive_receive/2, next_record_if_active/1, handle_common_event/4]). -%% Called by tls_connection_sup --export([start_link/7]). - -%% gen_fsm callbacks --export([init/1, hello/2, certify/2, cipher/2, - abbreviated/2, connection/2, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4, format_status/2]). +%% gen_statem state functions +-export([init/3, error/3, downgrade/3, %% Initiation and take down states + hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states + connection/3]). +%% gen_statem callbacks +-export([terminate/3, code_change/4, format_status/2]). + +-define(GEN_STATEM_CB_MODE, state_functions). %%==================================================================== %% Internal application API @@ -147,23 +148,34 @@ start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> init([Role, Host, Port, Socket, Options, User, CbInfo]) -> process_flag(trap_exit, true), - State = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)). + State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + try + State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, init, State) + catch throw:Error -> + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, error, {Error, State0}) + end. %%-------------------------------------------------------------------- -%% Description:There should be one instance of this function for each -%% possible state name. Whenever a gen_fsm receives an event sent -%% using gen_fsm:send_event/2, the instance of this function with the -%% same name as the current state name StateName is called to handle -%% the event. It is also called if a timeout occurs. -%% -hello(start, #state{host = Host, port = Port, role = client, - ssl_options = SslOpts, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - transport_cb = Transport, socket = Socket, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> +%% State functions +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +-spec init(gen_statem:event_type(), + {start, timeout()} | term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- + +init({call, From}, {start, Timeout}, + #state{host = Host, port = Port, role = client, + ssl_options = SslOpts, + session = #session{own_certificate = Cert} = Session0, + transport_cb = Transport, socket = Socket, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb + } = State0) -> + Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), @@ -177,13 +189,36 @@ hello(start, #state{host = Host, port = Port, role = client, negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, - tls_handshake_history = Handshake}, + tls_handshake_history = Handshake, + start_or_recv_from = From, + timer = Timer}, {Record, State} = next_record(State1), - next_state(hello, hello, Record, State); + next_event(hello, Record, State); +init(Type, Event, State) -> + ssl_connection:init(Type, Event, State, ?MODULE). + +%%-------------------------------------------------------------------- +-spec error(gen_statem:event_type(), + {start, timeout()} | term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- -hello(Hello = #client_hello{client_version = ClientVersion, - extensions = #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves}}, +error({call, From}, {start, _Timeout}, {Error, State}) -> + {stop_and_reply, normal, {reply, From, {error, Error}}, State}; +error({call, From}, Msg, State) -> + handle_call(Msg, From, error, State); +error(_, _, _) -> + {keep_state_and_data, [postpone]}. + +%%-------------------------------------------------------------------- +-spec hello(gen_statem:event_type(), + #hello_request{} | #client_hello{} | #server_hello{} | term(), + #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +hello(internal, #client_hello{client_version = ClientVersion, + extensions = #hello_extensions{ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves}} = Hello, State = #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, @@ -203,7 +238,8 @@ hello(Hello = #client_hello{client_version = ClientVersion, undefined -> CurrentProtocol; _ -> Protocol0 end, - ssl_connection:hello({common_client_hello, Type, ServerHelloExt}, + + ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt}, State#state{connection_states = ConnectionStates, negotiated_version = Version, hashsign_algorithm = HashSign, @@ -211,8 +247,7 @@ hello(Hello = #client_hello{client_version = ClientVersion, client_ecc = {EllipticCurves, EcPointFormats}, negotiated_protocol = Protocol}, ?MODULE) end; - -hello(Hello = #server_hello{}, +hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, role = client, @@ -225,25 +260,52 @@ hello(Hello = #server_hello{}, ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; +hello(info, Event, State) -> + handle_info(Event, hello, State); +hello(Type, Event, State) -> + ssl_connection:hello(Type, Event, State, ?MODULE). -hello(Msg, State) -> - ssl_connection:hello(Msg, State, ?MODULE). - -abbreviated(Msg, State) -> - ssl_connection:abbreviated(Msg, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec abbreviated(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +abbreviated(info, Event, State) -> + handle_info(Event, abbreviated, State); +abbreviated(Type, Event, State) -> + ssl_connection:abbreviated(Type, Event, State, ?MODULE). -certify(Msg, State) -> - ssl_connection:certify(Msg, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec certify(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +certify(info, Event, State) -> + handle_info(Event, certify, State); +certify(Type, Event, State) -> + ssl_connection:certify(Type, Event, State, ?MODULE). -cipher(Msg, State) -> - ssl_connection:cipher(Msg, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec cipher(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +cipher(info, Event, State) -> + handle_info(Event, cipher, State); +cipher(Type, Event, State) -> + ssl_connection:cipher(Type, Event, State, ?MODULE). -connection(#hello_request{}, #state{host = Host, port = Port, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - ssl_options = SslOpts, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> +%%-------------------------------------------------------------------- +-spec connection(gen_statem:event_type(), + #hello_request{} | #client_hello{}| term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +connection(info, Event, State) -> + handle_info(Event, connection, State); +connection(internal, #hello_request{}, + #state{host = Host, port = Port, + session = #session{own_certificate = Cert} = Session0, + session_cache = Cache, session_cache_cb = CacheCb, + ssl_options = SslOpts, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) -> Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), State1 = send_handshake(Hello, State0), @@ -251,58 +313,49 @@ connection(#hello_request{}, #state{host = Host, port = Port, next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_state(connection, hello, Record, State); - -connection(#client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> + next_event(hello, Record, State); +connection(internal, #client_hello{} = Hello, + #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - hello(Hello, State#state{allow_renegotiate = false}); - -connection(#client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> + {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; +connection(internal, #client_hello{}, + #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), - State = send_alert(Alert, State0), - next_state_connection(connection, State); - -connection(Msg, State) -> - ssl_connection:connection(Msg, State, tls_connection). + State1 = send_alert(Alert, State0), + {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), + next_event(connection, Record, State); +connection(Type, Event, State) -> + ssl_connection:connection(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:send_all_state_event/2, this function is called to handle -%% the event. Not currently used! +-spec downgrade(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -handle_event(_Event, StateName, State) -> - {next_state, StateName, State, get_timeout(State)}. +downgrade(Type, Event, State) -> + ssl_connection:downgrade(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle -%% the event. +%% Event handling functions called by state functions to handle +%% common or unexpected events for the state. %%-------------------------------------------------------------------- -handle_sync_event(Event, From, StateName, State) -> - ssl_connection:handle_sync_event(Event, From, StateName, State). - -%%-------------------------------------------------------------------- -%% Description: This function is called by a gen_fsm when it receives any -%% other message than a synchronous or asynchronous event -%% (or a system message). -%%-------------------------------------------------------------------- - +handle_call(Event, From, StateName, State) -> + ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). + %% raw data from socket, unpack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> case next_tls_record(Data, State0) of {Record, State} -> - next_state(StateName, StateName, Record, State); + next_event(StateName, Record, State); #alert{} = Alert -> handle_normal_shutdown(Alert, StateName, State0), - {stop, {shutdown, own_alert}, State0} + {stop, {shutdown, own_alert}} end; - handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, negotiated_version = Version} = State) -> @@ -321,32 +374,98 @@ handle_info({CloseTag, Socket}, StateName, ok end, handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}, State}; - + {stop, {shutdown, transport_closed}}; handle_info(Msg, StateName, State) -> ssl_connection:handle_info(Msg, StateName, State). +handle_common_event(internal, #alert{} = Alert, StateName, + #state{negotiated_version = Version} = State) -> + handle_own_alert(Alert, Version, StateName, State); + +%%% TLS record protocol level handshake messages +handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, + StateName, #state{protocol_buffers = + #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, + negotiated_version = Version} = State0) -> + + Handle = + fun({#hello_request{} = Packet, _}, {connection, HState}) -> + %% This message should not be included in handshake + %% message hashes. Starts new handshake (renegotiation) + Hs0 = ssl_handshake:init_handshake_history(), + {HState#state{tls_handshake_history = Hs0, + renegotiation = {true, peer}}, + {next_event, internal, Packet}}; + ({#hello_request{}, _}, {next_state, _SName, HState}) -> + %% This message should not be included in handshake + %% message hashes. Already in negotiation so it will be ignored! + {HState, []}; + ({#client_hello{} = Packet, Raw}, {connection, HState0}) -> + HState = handle_sni_extension(Packet, HState0), + Version = Packet#client_hello.client_version, + Hs0 = ssl_handshake:init_handshake_history(), + Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + {HState#state{tls_handshake_history = Hs1, + renegotiation = {true, peer}}, + {next_event, internal, Packet}}; + + ({Packet, Raw}, {_SName, HState0 = #state{tls_handshake_history=Hs0}}) -> + HState = handle_sni_extension(Packet, HState0), + Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + {HState#state{tls_handshake_history=Hs1}, {next_event, internal, Packet}} + end, + try + {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), + State1 = State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_packets = Packets, + tls_handshake_buffer = Buf}}, + {State, Events} = tls_handshake_events(Handle, StateName, State1, []), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State, Events); + _ -> + {next_state, StateName, State, Events} + end + catch throw:#alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State0) + end; +%%% TLS record protocol level application data messages +handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]}; +%%% TLS record protocol level change cipher messages +handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]}; +%%% TLS record protocol level Alert messages +handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, + #state{negotiated_version = Version} = State) -> + case decode_alerts(EncAlerts) of + Alerts = [_|_] -> + handle_alerts(Alerts, {next_state, StateName, State}); + #alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State) + end; +%% Ignore unknown TLS record level protocol messages +handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> + {next_state, StateName, State}. + %%-------------------------------------------------------------------- -%% Description:This function is called by a gen_fsm when it is about -%% to terminate. It should be the opposite of Module:init/1 and do any -%% necessary cleaning up. When it returns, the gen_fsm terminates with -%% Reason. The return value is ignored. +%% gen_statem callbacks %%-------------------------------------------------------------------- terminate(Reason, StateName, State) -> catch ssl_connection:terminate(Reason, StateName, State). +format_status(Type, Data) -> + ssl_connection:format_status(Type, Data). + %%-------------------------------------------------------------------- %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- code_change(_OldVsn, StateName, State0, {Direction, From, To}) -> State = convert_state(State0, Direction, From, To), - {ok, StateName, State}; + {?GEN_STATEM_CB_MODE, StateName, State}; code_change(_OldVsn, StateName, State, _) -> - {ok, StateName, State}. - -format_status(Type, Data) -> - ssl_connection:format_status(Type, Data). + {?GEN_STATEM_CB_MODE, StateName, State}. %%-------------------------------------------------------------------- %%% Internal functions @@ -396,7 +515,6 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, - send_queue = queue:new(), protocol_cb = ?MODULE, tracker = Tracker }. @@ -418,80 +536,6 @@ update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) -> ssl:handle_options(SSLOption, OrigSSLOptions) end. -next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> - handle_own_alert(Alert, Version, Current, State); - -next_state(_,Next, no_record, State) -> - {next_state, Next, State, get_timeout(State)}; - -next_state(Current, Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, #state{negotiated_version = Version} = State) -> - case decode_alerts(EncAlerts) of - Alerts = [_|_] -> - handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); - #alert{} = Alert -> - handle_own_alert(Alert, Version, Current, State) - end; -next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, - State0 = #state{protocol_buffers = - #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, - negotiated_version = Version}) -> - Handle = - fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_handshake_history(), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0, - renegotiation = {true, peer}}); - ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Already in negotiation so it will be ignored! - ?MODULE:SName(Packet, State); - ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, HState0}) -> - HState = handle_sni_extension(Packet, HState0), - Version = Packet#client_hello.client_version, - Hs0 = ssl_handshake:init_handshake_history(), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, HState#state{tls_handshake_history=Hs1, - renegotiation = {true, peer}}); - ({Packet, Raw}, {next_state, SName, HState0 = #state{tls_handshake_history=Hs0}}) -> - HState = handle_sni_extension(Packet, HState0), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, HState#state{tls_handshake_history=Hs1}); - (_, StopState) -> StopState - end, - try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), - State = State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = Packets, - tls_handshake_buffer = Buf}}, - handle_tls_handshake(Handle, Next, State) - catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, Current, State0) - end; - -next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> - case read_application_data(Data, State0) of - Stop = {stop,_,_} -> - Stop; - {Record, State} -> - next_state(StateName, StateName, Record, State) - end; -next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, - #state{connection_states = ConnectionStates0} = State0) - when Next == cipher; Next == abbreviated -> - ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), - {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), - next_state(Current, Next, Record, State#state{expecting_finished = true}); -next_state(Current, _Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, #state{negotiated_version = Version} = State) -> - handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version, Current, State); -next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> - %% Ignore unknown type - {Record, State} = next_record(State0), - next_state(Current, Next, Record, State). - next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buffer = Buf0, tls_cipher_texts = CT0} = Buffers} = State0) -> case tls_record:get_tls_records(Data, Buf0) of @@ -504,11 +548,6 @@ next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buf Alert end. -next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, - socket = Socket, - transport_cb = Transport} = State) -> - ssl_socket:setopts(Transport, Socket, [{active,once}]), - {no_record, State}; next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, @@ -522,6 +561,11 @@ next_record(#state{protocol_buffers = #alert{} = Alert -> {Alert, State} end; +next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, + socket = Socket, + transport_cb = Transport} = State) -> + ssl_socket:setopts(Transport, Socket, [{active,once}]), + {no_record, State}; next_record(State) -> {no_record, State}. @@ -533,55 +577,36 @@ next_record_if_active(State = next_record_if_active(State) -> next_record(State). -next_state_connection(StateName, #state{send_queue = Queue0, - negotiated_version = Version, - socket = Socket, - transport_cb = Transport, - connection_states = ConnectionStates0 - } = State) -> - %% Send queued up data that was queued while renegotiating - case queue:out(Queue0) of - {{value, {From, Data}}, Queue} -> - {Msgs, ConnectionStates} = - ssl_record:encode_data(Data, Version, ConnectionStates0), - Result = Transport:send(Socket, Msgs), - gen_fsm:reply(From, Result), - next_state_connection(StateName, - State#state{connection_states = ConnectionStates, - send_queue = Queue}); - {empty, Queue0} -> - next_state_is_connection(StateName, State) - end. - -%% In next_state_is_connection/1: clear tls_handshake, -%% premaster_secret and public_key_info (only needed during handshake) -%% to reduce memory foot print of a connection. -next_state_is_connection(_, State = - #state{start_or_recv_from = RecvFrom, - socket_options = - #socket_options{active = false}}) when RecvFrom =/= undefined -> - passive_receive(State#state{premaster_secret = undefined, - public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}, connection); - -next_state_is_connection(StateName, State0) -> - {Record, State} = next_record_if_active(State0), - next_state(StateName, connection, Record, State#state{premaster_secret = undefined, - public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}). - passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> case Buffer of <<>> -> {Record, State} = next_record(State0), - next_state(StateName, StateName, Record, State); + next_event(StateName, Record, State); _ -> - case read_application_data(<<>>, State0) of - Stop = {stop, _, _} -> - Stop; - {Record, State} -> - next_state(StateName, StateName, Record, State) - end + {Record, State} = read_application_data(<<>>, State0), + next_event(StateName, Record, State) + end. + +next_event(StateName, Record, State) -> + next_event(StateName, Record, State, []). + +next_event(connection = StateName, no_record, State0, Actions) -> + case next_record_if_active(State0) of + {no_record, State} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {#ssl_tls{} = Record, State} -> + {next_state, StateName, State, [{next_event, internal, {tls_record, Record}} | Actions]}; + {#alert{} = Alert, State} -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end; +next_event(StateName, Record, State, Actions) -> + case Record of + no_record -> + {next_state, StateName, State, Actions}; + #ssl_tls{} = Record -> + {next_state, StateName, State, [{next_event, internal, {tls_record, Record}} | Actions]}; + #alert{} = Alert -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. read_application_data(Data, #state{user_application = {_Mon, Pid}, @@ -625,11 +650,6 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {stop, normal, State0} end. -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = undefined}}) -> - infinity; -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}}) -> - HibernateAfter. - %% Picks ClientData get_data(_, _, <<>>) -> {more, <<>>}; @@ -736,7 +756,7 @@ header(N, Binary) -> [ByteN | header(N-1, NewBinary)]. send_or_reply(false, _Pid, From, Data) when From =/= undefined -> - gen_fsm:reply(From, Data); + gen_statem:reply(From, Data); %% Can happen when handling own alert or tcp error/close and there is %% no outstanding gen_fsm sync events send_or_reply(false, no_pid, _, _) -> @@ -747,51 +767,43 @@ send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Msg) -> Pid ! Msg. -handle_tls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{tls_packets = [Packet]} = Buffers} = State) -> - FsmReturn = {next_state, StateName, State#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = []}}}, - Handle(Packet, FsmReturn); - -handle_tls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{tls_packets = [Packet | Packets]} = Buffers} = - State0) -> - FsmReturn = {next_state, StateName, State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = - Packets}}}, - case Handle(Packet, FsmReturn) of - {next_state, NextStateName, State, _Timeout} -> - handle_tls_handshake(Handle, NextStateName, State); - {next_state, NextStateName, State} -> - handle_tls_handshake(Handle, NextStateName, State); - {stop, _,_} = Stop -> - Stop - end; - -handle_tls_handshake(_Handle, _StateName, #state{}) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +tls_handshake_events(Handle, StateName, + #state{protocol_buffers = + #protocol_buffers{tls_packets = [Packet]} = Buffers} = State0, Acc) -> + {State, Event} = Handle(Packet, {StateName, + State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_packets = []}}}), + {State, lists:reverse([Event |Acc])}; +tls_handshake_events(Handle, StateName, + #state{protocol_buffers = + #protocol_buffers{tls_packets = + [Packet | Packets]} = Buffers} = State0, Acc) -> + {State, Event} = Handle(Packet, {StateName, State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_packets = + Packets}}}), + tls_handshake_events(Handle, StateName, State, [Event | Acc]); + +tls_handshake_events(_Handle, _, #state{}, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). write_application_data(Data0, From, #state{socket = Socket, negotiated_version = Version, transport_cb = Transport, connection_states = ConnectionStates0, - send_queue = SendQueue, socket_options = SockOpts, ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) -> Data = encode_packet(Data0, SockOpts), case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of true -> - renegotiate(State#state{send_queue = queue:in_r({From, Data}, SendQueue), - renegotiation = {true, internal}}); + renegotiate(State#state{renegotiation = {true, internal}}, + [{next_event, {call, From}, {application_data, Data0}}]); false -> {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0), Result = Transport:send(Socket, Msgs), - {reply, Result, - connection, State#state{connection_states = ConnectionStates}, get_timeout(State)} + ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates}, + [{reply, From, Result}]) end. encode_packet(Data, #socket_options{packet=Packet}) -> @@ -823,69 +835,73 @@ is_time_to_renegotiate(N, M) when N < M-> false; is_time_to_renegotiate(_,_) -> true. -renegotiate(#state{role = client} = State) -> +renegotiate(#state{role = client} = State, Actions) -> %% Handle same way as if server requested %% the renegotiation Hs0 = ssl_handshake:init_handshake_history(), - connection(#hello_request{}, State#state{tls_handshake_history = Hs0}); + {next_state, connection, State#state{tls_handshake_history = Hs0}, + [{next_event, internal, #hello_request{}} | Actions]}; + renegotiate(#state{role = server, socket = Socket, transport_cb = Transport, negotiated_version = Version, - connection_states = ConnectionStates0} = State0) -> + connection_states = ConnectionStates0} = State0, Actions) -> HelloRequest = ssl_handshake:hello_request(), Frag = tls_handshake:encode_handshake(HelloRequest, Version), Hs0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates} = ssl_record:encode_handshake(Frag, Version, ConnectionStates0), Transport:send(Socket, BinMsg), - {Record, State} = next_record(State0#state{connection_states = - ConnectionStates, - tls_handshake_history = Hs0}), - next_state(connection, hello, Record, State#state{allow_renegotiate = true}). + State1 = State0#state{connection_states = + ConnectionStates, + tls_handshake_history = Hs0}, + {Record, State} = next_record(State1), + next_event(hello, Record, State, Actions). handle_alerts([], Result) -> Result; -handle_alerts(_, {stop, _, _} = Stop) -> - %% If it is a fatal alert immediately close +handle_alerts(_, {stop,_} = Stop) -> Stop; -handle_alerts([Alert | Alerts], {next_state, StateName, State, _Timeout}) -> - handle_alerts(Alerts, handle_alert(Alert, StateName, State)). - +handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> + handle_alerts(Alerts, handle_alert(Alert, StateName, State)); +handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> + handle_alerts(Alerts, handle_alert(Alert, StateName, State)). handle_alert(#alert{level = ?FATAL} = Alert, StateName, #state{socket = Socket, transport_cb = Transport, ssl_options = SslOpts, start_or_recv_from = From, host = Host, port = Port, session = Session, user_application = {_Mon, Pid}, - role = Role, socket_options = Opts, tracker = Tracker} = State) -> + role = Role, socket_options = Opts, tracker = Tracker}) -> invalidate_session(Role, Host, Port, Session), log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role), - {stop, normal, State}; + {stop, normal}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, StateName, State) -> handle_normal_shutdown(Alert, StateName, State), - {stop, {shutdown, peer_close}, State}; + {stop, {shutdown, peer_close}}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{ssl_options = SslOpts, renegotiation = {true, internal}} = State) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), handle_normal_shutdown(Alert, StateName, State), - {stop, {shutdown, peer_close}, State}; + {stop, {shutdown, peer_close}}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{ssl_options = SslOpts, renegotiation = {true, From}} = State0) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), - gen_fsm:reply(From, {error, renegotiation_rejected}), + gen_statem:reply(From, {error, renegotiation_rejected}), {Record, State} = next_record(State0), - next_state(StateName, connection, Record, State); + %% Go back to connection! + next_event(connection, Record, State); %% Gracefully log and ignore all other warning alerts handle_alert(#alert{level = ?WARNING} = Alert, StateName, #state{ssl_options = SslOpts} = State0) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), {Record, State} = next_record(State0), - next_state(StateName, StateName, Record, State). + next_event(StateName, Record, State). alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role) -> alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role); @@ -937,7 +953,7 @@ handle_own_alert(Alert, Version, StateName, catch _:_ -> ok end, - {stop, {shutdown, own_alert}, State}. + {stop, {shutdown, own_alert}}. handle_normal_shutdown(Alert, _, #state{socket = Socket, transport_cb = Transport, @@ -954,11 +970,6 @@ handle_normal_shutdown(Alert, StateName, #state{socket = Socket, start_or_recv_from = RecvFrom, role = Role}) -> alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). -handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> - Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, {Info, Msg}, State). - - handle_close_alert(Data, StateName, State0) -> case next_tls_record(Data, State0) of {#ssl_tls{type = ?ALERT, fragment = EncAlerts}, State} -> @@ -979,27 +990,6 @@ invalidate_session(client, Host, Port, Session) -> invalidate_session(server, _, Port, Session) -> ssl_manager:invalidate_session(Port, Session). -%% User downgrades connection -%% When downgrading an TLS connection to a transport connection -%% we must recive the close message before releasing the -%% transport socket. -close({close, {Pid, Timeout}}, Socket, Transport, ConnectionStates, Check) when is_pid(Pid) -> - ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, ssl_tls}]), - case Transport:recv(Socket, 0, Timeout) of - {ok, {ssl_tls, Socket, ?ALERT, Version, Fragment}} -> - case tls_record:decode_cipher_text(#ssl_tls{type = ?ALERT, - version = Version, - fragment = Fragment - }, ConnectionStates, Check) of - {#ssl_tls{fragment = Plain}, _} -> - [Alert| _] = decode_alerts(Plain), - downgrade(Alert, Transport, Socket, Pid) - end; - {error, timeout} -> - {error, timeout}; - _ -> - {error, no_tls_close} - end; %% User closes or recursive call! close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> ssl_socket:setopts(Transport, Socket, [{active, false}]), @@ -1020,15 +1010,11 @@ close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Chec %% with the network but we want to maximise the odds that %% peer application gets all data sent on the tcp connection. close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check); +close(downgrade, _,_,_,_) -> + ok; %% Other close(_, Socket, Transport, _,_) -> Transport:close(Socket). -downgrade(#alert{description = ?CLOSE_NOTIFY}, Transport, Socket, Pid) -> - ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), - Transport:controlling_process(Socket, Pid), - {ok, Socket}; -downgrade(_, _,_,_) -> - {error, no_tls_close}. convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") -> State#state{ssl_options = convert_options_partial_chain(Options, up)}; @@ -1069,4 +1055,3 @@ handle_sni_extension(#client_hello{extensions = HelloExtensions}, State0) -> end; handle_sni_extension(_, State0) -> State0. - diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index ef718c13df..102dbba198 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -278,10 +278,11 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. -available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when (Major < 3) andalso (Minor < 3) -> +available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when + (Major >= 3) andalso (Minor >= 3) -> SupportedHashSigns; available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns, - _, {Major, Minor}) when (Major < 3) andalso (Minor < 3) -> + _, {Major, Minor}) when (Major >= 3) andalso (Minor >= 3) -> ordsets:intersection(ClientHashSigns, SupportedHashSigns); available_signature_algs(_, _, _, _) -> undefined. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 0c3c7aa39b..78a13f703a 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -88,7 +88,8 @@ basic_tests() -> connect_dist, clear_pem_cache, defaults, - fallback + fallback, + cipher_format ]. options_tests() -> @@ -719,21 +720,27 @@ clear_pem_cache(Config) when is_list(Config) -> State = ssl_test_lib:state(Prop), [_,FilRefDb |_] = element(6, State), {Server, Client} = basic_verify_test_no_close(Config), - 2 = ets:info(FilRefDb, size), + CountReferencedFiles = fun({_,-1}, Acc) -> + Acc; + ({_, N}, Acc) -> + N + Acc + end, + + 2 = ets:foldl(CountReferencedFiles, 0, FilRefDb), ssl:clear_pem_cache(), _ = sys:get_status(whereis(ssl_manager)), {Server1, Client1} = basic_verify_test_no_close(Config), - 4 = ets:info(FilRefDb, size), + 4 = ets:foldl(CountReferencedFiles, 0, FilRefDb), ssl_test_lib:close(Server), ssl_test_lib:close(Client), - ct:sleep(5000), + ct:sleep(2000), _ = sys:get_status(whereis(ssl_manager)), - 2 = ets:info(FilRefDb, size), + 2 = ets:foldl(CountReferencedFiles, 0, FilRefDb), ssl_test_lib:close(Server1), ssl_test_lib:close(Client1), - ct:sleep(5000), + ct:sleep(2000), _ = sys:get_status(whereis(ssl_manager)), - 0 = ets:info(FilRefDb, size). + 0 = ets:foldl(CountReferencedFiles, 0, FilRefDb). %%-------------------------------------------------------------------- @@ -764,6 +771,14 @@ fallback(Config) when is_list(Config) -> Client, {error,{tls_alert,"inappropriate fallback"}}). %%-------------------------------------------------------------------- +cipher_format() -> + [{doc, "Test that cipher conversion from tuples to binarys works"}]. +cipher_format(Config) when is_list(Config) -> + {ok, Socket} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), + ssl:close(Socket). + +%%-------------------------------------------------------------------- + peername() -> [{doc,"Test API function peername/1"}]. @@ -2556,6 +2571,13 @@ der_input(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), DHParamFile = filename:join(DataDir, "dHParam.pem"), + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + [CADb | _] = element(6, State), + + Size = ets:info(CADb, size), + SeverVerifyOpts = ?config(server_verification_opts, Config), {ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | SeverVerifyOpts]), @@ -2583,13 +2605,8 @@ der_input(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client), + Size = ets:info(CADb, size). - {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), - [_, _,_, _, Prop] = StatusInfo, - State = ssl_test_lib:state(Prop), - [CADb | _] = element(6, State), - [] = ets:tab2list(CADb). - %%-------------------------------------------------------------------- der_input_opts(Opts) -> Certfile = proplists:get_value(certfile, Opts), @@ -3051,6 +3068,7 @@ hibernate(Config) -> {current_function, _} = process_info(Pid, current_function), + ssl_test_lib:check_result(Server, ok, Client, ok), timer:sleep(1100), {current_function, {erlang, hibernate, 3}} = @@ -3084,15 +3102,29 @@ hibernate_right_away(Config) -> Server1 = ssl_test_lib:start_server(StartServerOpts), Port1 = ssl_test_lib:inet_port(Server1), - {Client1, #sslsocket{}} = ssl_test_lib:start_client(StartClientOpts ++ + {Client1, #sslsocket{pid = Pid1}} = ssl_test_lib:start_client(StartClientOpts ++ [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), + + ssl_test_lib:check_result(Server1, ok, Client1, ok), + + {current_function, {erlang, hibernate, 3}} = + process_info(Pid1, current_function), + ssl_test_lib:close(Server1), ssl_test_lib:close(Client1), Server2 = ssl_test_lib:start_server(StartServerOpts), Port2 = ssl_test_lib:inet_port(Server2), - {Client2, #sslsocket{}} = ssl_test_lib:start_client(StartClientOpts ++ + {Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++ [{port, Port2}, {options, [{hibernate_after, 1}|ClientOpts]}]), + + ssl_test_lib:check_result(Server2, ok, Client2, ok), + + ct:sleep(100), %% Schedule out + + {current_function, {erlang, hibernate, 3}} = + process_info(Pid2, current_function), + ssl_test_lib:close(Server2), ssl_test_lib:close(Client2). diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 66ccbb1da4..49c0b9c5a1 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -52,8 +52,8 @@ groups() -> {error_handling, [],error_handling_tests()}]. tests() -> - [server_verify_peer, - server_verify_none, + [verify_peer, + verify_none, server_require_peer_cert_ok, server_require_peer_cert_fail, server_require_peer_cert_partial_chain, @@ -110,6 +110,17 @@ init_per_group(_, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(TestCase, Config) when TestCase == cert_expired; + TestCase == invalid_signature_client; + TestCase == invalid_signature_server; + TestCase == extended_key_usage_verify_none; + TestCase == extended_key_usage_verify_peer; + TestCase == critical_extension_verify_none; + TestCase == critical_extension_verify_peer; + TestCase == no_authority_key_identifier; + TestCase == no_authority_key_identifier_and_nonstandard_encoding-> + ssl:clear_pem_cache(), + init_per_testcase(common, Config); init_per_testcase(_TestCase, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 5}), @@ -122,9 +133,9 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -server_verify_peer() -> - [{doc,"Test server option verify_peer"}]. -server_verify_peer(Config) when is_list(Config) -> +verify_peer() -> + [{doc,"Test option verify_peer"}]. +verify_peer(Config) when is_list(Config) -> ClientOpts = ?config(client_verification_opts, Config), ServerOpts = ?config(server_verification_opts, Config), Active = ?config(active, Config), @@ -147,10 +158,10 @@ server_verify_peer(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- -server_verify_none() -> - [{doc,"Test server option verify_none"}]. +verify_none() -> + [{doc,"Test option verify_none"}]. -server_verify_none(Config) when is_list(Config) -> +verify_none(Config) when is_list(Config) -> ClientOpts = ?config(client_verification_opts, Config), ServerOpts = ?config(server_verification_opts, Config), Active = ?config(active, Config), @@ -220,18 +231,21 @@ server_require_peer_cert_ok(Config) when is_list(Config) -> ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} | ?config(server_verification_opts, Config)], ClientOpts = ?config(client_verification_opts, Config), + Active = ?config(active, Config), + ReceiveFunction = ?config(receive_function, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {ssl_test_lib,send_recv_result, []}}, - {options, [{active, false} | ServerOpts]}]), + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result, []}}, - {options, [{active, false} | ClientOpts]}]), + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), @@ -313,6 +327,8 @@ server_require_peer_cert_allow_partial_chain(Config) when is_list(Config) -> | ?config(server_verification_opts, Config)], ClientOpts = ?config(client_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Active = ?config(active, Config), + ReceiveFunction = ?config(receive_function, Config), {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), [{_,_,_}, {_, IntermidiateCA, _}] = public_key:pem_decode(ServerCAs), @@ -328,16 +344,17 @@ server_require_peer_cert_allow_partial_chain(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{cacerts, [IntermidiateCA]}, + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active}, + {cacerts, [IntermidiateCA]}, {partial_chain, PartialChain} | proplists:delete(cacertfile, ServerOpts)]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, ClientOpts}]), + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). @@ -522,32 +539,6 @@ verify_fun_always_run_server(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -client_verify_none_passive() -> - [{doc,"Test client option verify_none"}]. - -client_verify_none_passive(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, send_recv_result, []}}, - {options, [{active, false} - | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, send_recv_result, []}}, - {options, [{active, false}, - {verify, verify_none} - | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). -%%-------------------------------------------------------------------- cert_expired() -> [{doc,"Test server with expired certificate"}]. @@ -616,64 +607,6 @@ two_digits_str(N) -> lists:flatten(io_lib:format("~p", [N])). %%-------------------------------------------------------------------- - -client_verify_none_active() -> - [{doc,"Test client option verify_none"}]. - -client_verify_none_active(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active, []}}, - {options, [{active, true} - | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active, []}}, - {options, [{active, true}, - {verify, verify_none} - | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -%%-------------------------------------------------------------------- -client_verify_none_active_once() -> - [{doc,"Test client option verify_none"}]. - -client_verify_none_active_once(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{active, once} | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active_once, - []}}, - {options, [{active, once}, - {verify, verify_none} - | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -%%-------------------------------------------------------------------- extended_key_usage_verify_peer() -> [{doc,"Test cert that has a critical extended_key_usage extension in verify_peer mode"}]. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index db9e1c3d38..38cc3532d8 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1041,10 +1041,13 @@ receive_rizzo_duong_beast() -> end end. -state([{data,[{"State", State}]} | _]) -> - State; -state([{data,[{"StateData", State}]} | _]) -> + +state([{data,[{"State", {_StateName, StateData}}]} | _]) -> %% gen_statem + StateData; +state([{data,[{"State", State}]} | _]) -> %% gen_server State; +state([{data,[{"StateData", State}]} | _]) -> %% gen_fsm + State; state([_ | Rest]) -> state(Rest). diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 8c732002de..8f4f384497 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.3.1 +SSL_VSN = 7.3.2 diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index ec7f267c64..d83e17b177 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -396,17 +396,17 @@ handle_event(_, _, State, Data) -> <tag><c>pid()</c><br /> <c>LocalName</c></tag> <item>The <c>gen_statem</c> is locally registered.</item> - <tag><c>Name, Node</c></tag> + <tag><c>{Name,Node}</c></tag> <item> The <c>gen_statem</c> is locally registered on another node. </item> - <tag><c>GlobalName</c></tag> + <tag><c>{global,GlobalName}</c></tag> <item> The <c>gen_statem</c> is globally registered in <seealso marker="kernel:global"><c>global</c></seealso>. </item> - <tag><c>RegMod, ViaName</c></tag> + <tag><c>{via,RegMod,ViaName}</c></tag> <item> The <c>gen_statem</c> is registered through an alternative process registry. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index b14102ac38..2508f96b91 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1502,7 +1502,7 @@ pattern({op,_Line,'++',{string,_Li,_S},R}, Vt, Old, Bvt, St) -> pattern({match,_Line,Pat1,Pat2}, Vt, Old, Bvt, St0) -> {Lvt,Bvt1,St1} = pattern(Pat1, Vt, Old, Bvt, St0), {Rvt,Bvt2,St2} = pattern(Pat2, Vt, Old, Bvt, St1), - St3 = reject_bin_alias(Pat1, Pat2, St2), + St3 = reject_invalid_alias(Pat1, Pat2, Vt, St2), {vtmerge_pat(Lvt, Rvt),vtmerge_pat(Bvt1,Bvt2),St3}; %% Catch legal constant expressions, including unary +,-. pattern(Pat, _Vt, _Old, _Bvt, St) -> @@ -1517,56 +1517,77 @@ pattern_list(Ps, Vt, Old, Bvt0, St) -> {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt,Bvt1),St1} end, {[],[],St}, Ps). -%% reject_bin_alias(Pat, Expr, St) -> St' + + +%% reject_invalid_alias(Pat, Expr, Vt, St) -> St' %% Reject aliases for binary patterns at the top level. +%% Reject aliases for maps patterns at the top level. +%% The variables table (Vt) are for maps checkking. + +reject_invalid_alias_expr({bin,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({map,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({match,_,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr(_, _, _, St) -> St. -reject_bin_alias_expr({bin,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr({match,_,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr(_, _, St) -> St. -%% reject_bin_alias(Pat1, Pat2, St) -> St' +%% reject_invalid_alias(Pat1, Pat2, St) -> St' %% Aliases of binary patterns, such as <<A:8>> = <<B:4,C:4>> or even %% <<A:8>> = <<A:8>>, are not allowed. Traverse the patterns in parallel %% and generate an error if any binary aliases are found. %% We generate an error even if is obvious that the overall pattern can't %% possibly match, for instance, {a,<<A:8>>,c}={x,<<A:8>>} WILL generate an %% error. +%% Maps should reject unbound variables here. -reject_bin_alias({bin,Line,_}, {bin,_,_}, St) -> +reject_invalid_alias({bin,Line,_}, {bin,_,_}, _, St) -> add_error(Line, illegal_bin_pattern, St); -reject_bin_alias({cons,_,H1,T1}, {cons,_,H2,T2}, St0) -> - St = reject_bin_alias(H1, H2, St0), - reject_bin_alias(T1, T2, St); -reject_bin_alias({tuple,_,Es1}, {tuple,_,Es2}, St) -> - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, +reject_invalid_alias({map,_Line,Ps1}, {map,_,Ps2}, Vt, St0) -> + Fun = fun ({map_field_exact,L,{var,_,K},_V}, Sti) -> + case is_var_bound(K,Vt) of + true -> + Sti; + false -> + add_error(L, {unbound_var,K}, Sti) + end; + ({map_field_exact,_L,_K,_V}, Sti) -> + Sti + end, + foldl(Fun, foldl(Fun, St0, Ps1), Ps2); +reject_invalid_alias({cons,_,H1,T1}, {cons,_,H2,T2}, Vt, St0) -> + St = reject_invalid_alias(H1, H2, Vt, St0), + reject_invalid_alias(T1, T2, Vt, St); +reject_invalid_alias({tuple,_,Es1}, {tuple,_,Es2}, Vt, St) -> + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, Vt, #lint{records=Recs}=St) -> case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of {{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} -> - reject_bin_alias_rec(Pfs1, Pfs2, Fields1, Fields2, St); + reject_invalid_alias_rec(Pfs1, Pfs2, Fields1, Fields2, Vt, St); {_,_} -> %% One or more non-existing records. (An error messages has %% already been generated, so we are done here.) St end; -reject_bin_alias({match,_,P1,P2}, P, St0) -> - St = reject_bin_alias(P1, P, St0), - reject_bin_alias(P2, P, St); -reject_bin_alias(P, {match,_,_,_}=M, St) -> - reject_bin_alias(M, P, St); -reject_bin_alias(_P1, _P2, St) -> St. - -reject_bin_alias_list([E1|Es1], [E2|Es2], St0) -> - St = reject_bin_alias(E1, E2, St0), - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias_list(_, _, St) -> St. - -reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> +reject_invalid_alias({match,_,P1,P2}, P, Vt, St0) -> + St = reject_invalid_alias(P1, P, Vt, St0), + reject_invalid_alias(P2, P, Vt, St); +reject_invalid_alias(P, {match,_,_,_}=M, Vt, St) -> + reject_invalid_alias(M, P, Vt, St); +reject_invalid_alias(_P1, _P2, _Vt, St) -> St. + +reject_invalid_alias_list([E1|Es1], [E2|Es2], Vt, St0) -> + St = reject_invalid_alias(E1, E2, Vt, St0), + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias_list(_, _, _, St) -> St. + +reject_invalid_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, Vt, St) -> %% We treat records as if they have been converted to tuples. PfsA1 = rbia_field_vars(PfsA0), PfsB1 = rbia_field_vars(PfsB0), @@ -1582,7 +1603,7 @@ reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> D = sofs:projection({external,fun({_,_,P1,_,P2}) -> {P1,P2} end}, C), E = sofs:to_external(D), {Ps1,Ps2} = lists:unzip(E), - reject_bin_alias_list(Ps1, Ps2, St). + reject_invalid_alias_list(Ps1, Ps2, Vt, St). rbia_field_vars(Fs) -> [{Name,Pat} || {record_field,_,{atom,_,Name},Pat} <- Fs]. @@ -2284,7 +2305,7 @@ expr({'catch',Line,E}, Vt, St0) -> expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), - St = reject_bin_alias_expr(P, E, St2), + St = reject_invalid_alias_expr(P, E, Vt, St2), {vtupdate(Bvt, vtmerge(Evt, Pvt)),St}; %% No comparison or boolean operators yet. expr({op,_Line,_Op,A}, Vt, St) -> @@ -2381,7 +2402,7 @@ is_valid_call(Call) -> _ -> true end. -%% is_valid_map_key(K,St) -> true | false +%% is_valid_map_key(K) -> true | false %% variables are allowed for patterns only at the top of the tree is_valid_map_key({var,_,_}) -> true; @@ -3413,6 +3434,14 @@ warn_unused_vars(U, Vt, St0) -> UVt = map(fun ({V,{State,_,Ls}}) -> {V,{State,used,Ls}} end, U), {vtmerge(Vt, UVt), St1}. + +is_var_bound(V, Vt) -> + case orddict:find(V, Vt) of + {ok,{bound,_Usage,_}} -> true; + _ -> false + end. + + %% vtupdate(UpdVarTable, VarTable) -> VarTable. %% Add the variables in the updated vartable to VarTable. The variables %% will be updated with their property in UpdVarTable. The state of diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index f9e2e5f7d2..23bddafeed 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -97,7 +97,7 @@ %% * Postponing the current event is performed %% iff 'postpone' is 'true'. %% * A state timer is started iff 'timeout' is set. - %% * Pending events are processed or if there are + %% * Pending events are handled or if there are %% no pending events the server goes into receive %% or hibernate (iff 'hibernate' is 'true') %% @@ -282,16 +282,6 @@ event_type(Type) -> STACKTRACE(), try throw(ok) catch _ -> erlang:get_stacktrace() end). --define( - TERMINATE(Class, Reason, Debug, S, Q), - terminate( - begin Class end, - begin Reason end, - ?STACKTRACE(), - begin Debug end, - begin S end, - begin Q end)). - %%%========================================================================== %%% API @@ -300,11 +290,11 @@ event_type(Type) -> | {'via', RegMod :: module(), Name :: term()} | {'local', atom()}. -type server_ref() :: - {'global', GlobalName :: term()} - | {'via', RegMod :: module(), ViaName :: term()} + pid() | (LocalName :: atom()) | {Name :: atom(), Node :: atom()} - | pid(). + | {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()}. -type debug_opt() :: {'debug', Dbgs :: @@ -523,12 +513,15 @@ send(Proc, Msg) -> ok end. -%% Here init_it/6 and enter_loop/5,6,7 functions converge +%% Here the init_it/6 and enter_loop/5,6,7 functions converge enter(Module, Opts, CallbackMode, 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), - PrevState = make_ref(), % Will be discarded by loop_event_actions/9 + P = Events = [], + Event = {internal,initial_state}, + %% We enforce {postpone,false} to ensure that + %% our fake Event gets discarded, thought it might get logged NewActions = if is_list(Actions) -> @@ -540,15 +533,17 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> callback_mode => CallbackMode, module => Module, name => Name, - state => PrevState, + %% All fields below will be replaced according to the arguments to + %% loop_event_actions/10 when it finally loops back to loop/3 + state => State, data => Data, - timer => undefined, - postponed => [], - hibernate => false}, + postponed => P, + hibernate => false, + timer => undefined}, + NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), loop_event_actions( - Parent, Debug, S, [], - {event,undefined}, % Will be discarded thanks to {postpone,false} - PrevState, State, Data, NewActions). + Parent, NewDebug, S, Events, + State, Data, P, Event, State, NewActions). %%%========================================================================== %%% gen callbacks @@ -617,8 +612,12 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). -system_terminate(Reason, _Parent, Debug, S) -> - ?TERMINATE(exit, Reason, Debug, S, []). +system_terminate( + Reason, _Parent, Debug, + #{state := State, data := Data, postponed := P} = S) -> + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [], State, Data, P). system_code_change( #{module := Module, @@ -634,7 +633,10 @@ system_code_change( {NewCallbackMode,NewState,NewData} -> callback_mode(NewCallbackMode) orelse error({callback_mode,NewCallbackMode}), - {ok,S#{state := NewState, data := NewData}}; + {ok, + S#{callback_mode := NewCallbackMode, + state := NewState, + data := NewData}}; {ok,_} = Error -> error({case_clause,Error}); Error -> @@ -654,7 +656,7 @@ system_replace_state( format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P} = S]) -> + #{name := Name, postponed := P, state := State, data := Data} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -663,7 +665,7 @@ format_status( {"Parent",Parent}, {"Logged Events",Log}, {"Postponed",P}]} | - case format_status(Opt, PDict, S) of + case format_status(Opt, PDict, S, State, Data) of L when is_list(L) -> L; T -> [T] end]. @@ -673,21 +675,21 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- -print_event(Dev, {in,Event}, #{name := Name}) -> +print_event(Dev, {in,Event}, {Name,_}) -> io:format( Dev, "*DBG* ~p received ~s~n", [Name,event_string(Event)]); -print_event(Dev, {out,Reply,{To,_Tag}}, #{name := Name}) -> +print_event(Dev, {out,Reply,{To,_Tag}}, {Name,_}) -> io:format( Dev, "*DBG* ~p sent ~p to ~p~n", [Name,Reply,To]); -print_event(Dev, {Tag,Event,NewState}, #{name := Name, state := State}) -> +print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = - case NewState of + case NextState of State -> io_lib:format("~p", [State]); _ -> - io_lib:format("~p => ~p", [State,NewState]) + io_lib:format("~p => ~p", [State,NextState]) end, io:format( Dev, "*DBG* ~p ~w ~s in state ~s~n", @@ -697,16 +699,17 @@ event_string(Event) -> case Event of {{call,{Pid,_Tag}},Request} -> io_lib:format("call ~p from ~w", [Request,Pid]); - {Tag,Content} -> - io_lib:format("~w ~p", [Tag,Content]) + {EventType,EventContent} -> + io_lib:format("~w ~p", [EventType,EventContent]) end. -sys_debug(Debug, S, Entry) -> +sys_debug(Debug, #{name := Name}, State, Entry) -> case Debug of [] -> Debug; _ -> - sys:handle_debug(Debug, fun print_event/3, S, Entry) + sys:handle_debug( + Debug, fun print_event/3, {Name,State}, Entry) end. %%%========================================================================== @@ -720,7 +723,7 @@ wakeup_from_hibernate(Parent, Debug, S) -> %%% State Machine engine implementation of proc_lib/gen server %% Server loop, consists of all loop* functions -%% and some detours through sys and proc_lib +%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 loop(Parent, Debug, #{hibernate := Hibernate} = S) -> @@ -749,12 +752,16 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> + #{state := State, data := Data, postponed := P} = S, %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... - ?TERMINATE(exit, Reason, Debug, S, [EXIT]); + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [EXIT], State, Data, P); {timeout,Timer,Content} when Timer =/= undefined -> - loop_event(Parent, Debug, S, {timeout,Content}); + loop_receive_result( + Parent, Debug, S, {timeout,Content}); _ -> %% Cancel Timer if running case Timer of @@ -782,30 +789,81 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_event(Parent, Debug, S, Event) + loop_receive_result(Parent, Debug, S, Event) end end. -loop_event(Parent, Debug, S, Event) -> - %% The timer field and the hibernate flag in S - %% are now invalid and ignored until we get back to loop/3 - NewDebug = sys_debug(Debug, S, {in,Event}), - %% Here the queue of not yet processed events is created - loop_events(Parent, NewDebug, S, [Event], false). - -%% Process first the event queue, or if it is empty -%% loop back to receive a new event -loop_events(Parent, Debug, S, [], _Hibernate) -> - loop(Parent, Debug, S); +loop_receive_result( + Parent, Debug, + #{state := State, + data := Data, + postponed := P} = S, + Event) -> + %% The engine state map S is now dismantled + %% and will not be restored until we return to loop/3. + %% + %% The fields 'callback_mode', 'module', and 'name' are still valid. + %% The fields 'state', 'data', and 'postponed' are held in arguments. + %% The fields 'timer' and 'hibernate' will be recalculated. + %% + NewDebug = sys_debug(Debug, S, State, {in,Event}), + %% Here the queue of not yet handled events is created + Events = [], + Hibernate = false, + loop_event( + Parent, NewDebug, S, Events, State, Data, P, Event, Hibernate). + +%% Process the event queue, or if it is empty +%% loop back to loop/3 to receive a new event +loop_events( + Parent, Debug, S, [Event|Events], + State, Data, P, Hibernate, _Timeout) -> + %% + %% If there was a state timer requested we just ignore that + %% since we have events to handle which cancels the timer + loop_event( + Parent, Debug, S, Events, State, Data, P, Event, Hibernate); loop_events( + Parent, Debug, S, [], + State, Data, P, Hibernate, Timeout) -> + case Timeout of + {timeout,0,EventContent} -> + %% Immediate timeout - simulate it + %% so we do not get the timeout message + %% after any received event + loop_event( + Parent, Debug, S, [], + State, Data, P, {timeout,EventContent}, Hibernate); + {timeout,Time,EventContent} -> + %% Actually start a timer + Timer = erlang:start_timer(Time, self(), EventContent), + loop_events_done( + Parent, Debug, S, Timer, State, Data, P, Hibernate); + undefined -> + %% No state timeout has been requested + Timer = undefined, + loop_events_done( + Parent, Debug, S, Timer, State, Data, P, Hibernate) + end. +%% +loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> + NewS = + S#{ + state := State, + data := Data, + postponed := P, + hibernate := Hibernate, + timer := Timer}, + loop(Parent, Debug, NewS). + +loop_event( Parent, Debug, #{callback_mode := CallbackMode, - module := Module, - state := State, - data := Data} = S, - [{Type,Content} = Event|Events] = Q, - Hibernate) -> - %% If the Hibernate flag is true here it can only be + module := Module} = S, + Events, + State, Data, P, {Type,Content} = Event, Hibernate) -> + %% + %% If Hibernate is true here it can only be %% because it was set from an event action %% and we did not go into hibernation since there %% were events in queue, so we do what the user @@ -813,6 +871,7 @@ loop_events( %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), + %% try case CallbackMode of state_functions -> @@ -822,11 +881,11 @@ loop_events( end of Result -> loop_event_result( - Parent, Debug, S, Events, Event, Result) + Parent, Debug, S, Events, State, Data, P, Event, Result) catch Result -> loop_event_result( - Parent, Debug, S, Events, Event, Result); + Parent, Debug, S, Events, State, Data, P, Event, Result); error:badarg when CallbackMode =:= state_functions -> case erlang:get_stacktrace() of [{erlang,apply,[Module,State,_],_}|Stacktrace] -> @@ -835,9 +894,11 @@ loop_events( error, {undef_state_function,{Module,State,Args}}, Stacktrace, - Debug, S, Q); + Debug, S, [Event|Events], State, Data, P); Stacktrace -> - terminate(error, badarg, Stacktrace, Debug, S, Q) + terminate( + error, badarg, Stacktrace, + Debug, S, [Event|Events], State, Data, P) end; error:undef -> %% Process an undef to check for the simple mistake @@ -852,7 +913,7 @@ loop_events( error, {undef_state_function,{Module,State,Args}}, Stacktrace, - Debug, S, Q); + Debug, S, [Event|Events], State, Data, P); [{Module,handle_event, [Type,Content,State,Data]=Args, _} @@ -860,86 +921,85 @@ loop_events( when CallbackMode =:= handle_event_function -> terminate( error, - {undef_state_function, - {Module,handle_event,Args}}, + {undef_state_function,{Module,handle_event,Args}}, Stacktrace, - Debug, S, Q); + Debug, S, [Event|Events], State, Data, P); Stacktrace -> - terminate(error, undef, Stacktrace, Debug, S, Q) + terminate( + error, undef, Stacktrace, + Debug, S, [Event|Events], State, Data, P) end; Class:Reason -> Stacktrace = erlang:get_stacktrace(), - terminate(Class, Reason, Stacktrace, Debug, S, Q) + terminate( + Class, Reason, Stacktrace, + Debug, S, [Event|Events], State, Data, P) end. %% Interpret all callback return variants loop_event_result( - Parent, Debug, - #{state := State, data := Data} = S, - Events, Event, Result) -> - %% From now until we loop back to the loop_events/4 - %% the state and data fields in S are old + Parent, Debug, S, Events, State, Data, P, Event, Result) -> case Result of stop -> - ?TERMINATE(exit, normal, Debug, S, [Event|Events]); + terminate( + exit, normal, ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P); {stop,Reason} -> - ?TERMINATE(exit, Reason, Debug, S, [Event|Events]); + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P); {stop,Reason,NewData} -> - NewS = S#{data := NewData}, - Q = [Event|Events], - ?TERMINATE(exit, Reason, Debug, NewS, Q); + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); {stop_and_reply,Reason,Replies} -> Q = [Event|Events], - [Class,NewReason,Stacktrace,NewDebug] = - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, S, Q, Replies), - %% Since we got back here Replies was bad - terminate(Class, NewReason, Stacktrace, NewDebug, S, Q); + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, Q, State, Data, P, Replies); {stop_and_reply,Reason,Replies,NewData} -> - NewS = S#{data := NewData}, Q = [Event|Events], - [Class,NewReason,Stacktrace,NewDebug] = - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), - %% Since we got back here Replies was bad - terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, Q, State, NewData, P, Replies); {next_state,NextState,NewData} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, []); + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, []); {next_state,NextState,NewData,Actions} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions); + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions); {keep_state,NewData} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, NewData, []); + Parent, Debug, S, Events, + State, NewData, P, Event, State, []); {keep_state,NewData,Actions} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, NewData, Actions); + Parent, Debug, S, Events, + State, NewData, P, Event, State, Actions); keep_state_and_data -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, Data, []); + Parent, Debug, S, Events, + State, Data, P, Event, State, []); {keep_state_and_data,Actions} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, Data, Actions); + Parent, Debug, S, Events, + State, Data, P, Event, State, Actions); _ -> - ?TERMINATE( - error, {bad_return_value,Result}, Debug, S, [Event|Events]) + terminate( + error, {bad_return_value,Result}, ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P) end. loop_event_actions( - Parent, Debug, S, Events, Event, State, NextState, NewData, Actions) -> - Postpone = false, % Shall we postpone this event, true or false + Parent, Debug, S, Events, State, NewData, P, Event, NextState, Actions) -> + Postpone = false, % Shall we postpone this event; boolean() Hibernate = false, Timeout = undefined, NextEvents = [], loop_event_actions( - Parent, Debug, S, Events, Event, State, NextState, NewData, + Parent, Debug, S, Events, State, NewData, P, Event, NextState, if is_list(Actions) -> Actions; @@ -948,97 +1008,103 @@ loop_event_actions( end, Postpone, Hibernate, Timeout, NextEvents). %% -%% Process all action()s +%% Process all actions loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, [Action|Actions], + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, [Action|Actions], Postpone, Hibernate, Timeout, NextEvents) -> case Action of %% Actual actions {reply,From,Reply} -> case from(From) of true -> - NewDebug = do_reply(Debug, S, From, Reply), + NewDebug = do_reply(Debug, S, State, From, Reply), loop_event_actions( - Parent, NewDebug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, NewDebug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, Timeout, NextEvents); false -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P) end; {next_event,Type,Content} -> case event_type(Type) of true -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, Timeout, [{Type,Content}|NextEvents]); false -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P) end; %% Actions that set options {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, NewPostpone, Hibernate, Timeout, NextEvents); {postpone,_} -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); postpone -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, true, Hibernate, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, NewHibernate, Timeout, NextEvents); {hibernate,_} -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); hibernate -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, true, Timeout, NextEvents); {timeout,infinity,_} -> % Clear timer - it will never trigger loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, undefined, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, NewTimeout, NextEvents); {timeout,_,_} -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); infinity -> % Clear timer - it will never trigger loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, undefined, NextEvents); Time when is_integer(Time), Time >= 0 -> NewTimeout = {timeout,Time,Time}, loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, NewTimeout, NextEvents); _ -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P) end; %% %% End of actions list loop_event_actions( - Parent, Debug, #{postponed := P0} = S, Events, Event, - State, NextState, NewData, [], + Parent, Debug, S, Events, + State, NewData, P0, Event, NextState, [], Postpone, Hibernate, Timeout, NextEvents) -> %% %% All options have been collected and next_events are buffered. @@ -1059,89 +1125,62 @@ loop_event_actions( {lists:reverse(P1, Events),[]} end, %% Place next events first in queue - Q3 = lists:reverse(NextEvents, Q2), + Q = lists:reverse(NextEvents, Q2), %% NewDebug = sys_debug( - Debug, S, + Debug, S, State, case Postpone of true -> {postpone,Event,NextState}; false -> {consume,Event,NextState} end), - %% Have a peek on the event queue so we can avoid starting - %% the state timer unless we have to - {Q,Timer} = - case Timeout of - undefined -> - %% No state timeout has been requested - {Q3,undefined}; - {timeout,Time,EventContent} -> - %% A state timeout has been requested - case Q3 of - [] when Time =:= 0 -> - %% Immediate timeout - simulate it - %% so we do not get the timeout message - %% after any received event - {[{timeout,EventContent}],undefined}; - [] -> - %% Actually start a timer - {Q3,erlang:start_timer(Time, self(), EventContent)}; - _ -> - %% Do not start a timer since any queued - %% event cancels the state timer so we pretend - %% that the timer has been started and cancelled - {Q3,undefined} - end - end, - %% Loop to top of event queue loop; process next event loop_events( - Parent, NewDebug, - S#{ - state := NextState, - data := NewData, - timer := Timer, - postponed := P, - hibernate := Hibernate}, - Q, Hibernate). + Parent, NewDebug, S, Q, NextState, NewData, P, Hibernate, Timeout). %%--------------------------------------------------------------------------- %% Server helpers -reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> +reply_then_terminate( + Class, Reason, Stacktrace, + Debug, S, Q, State, Data, P, Replies) -> if is_list(Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, Replies); + Class, Reason, Stacktrace, + Debug, S, Q, State, Data, P, Replies); true -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [Replies]) + Class, Reason, Stacktrace, + Debug, S, Q, State, Data, P, [Replies]) end. %% -do_reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> - terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> + Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, []) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q, State, Data, P); +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, [R|Rs]) -> case R of {reply,{_To,_Tag}=From,Reply} -> - NewDebug = do_reply(Debug, S, From, Reply), + NewDebug = do_reply(Debug, S, State, From, Reply), do_reply_then_terminate( - Class, Reason, Stacktrace, NewDebug, S, Q, Rs); + Class, Reason, Stacktrace, + NewDebug, S, Q, State, Data, P, Rs); _ -> - [error,{bad_action,R},?STACKTRACE(),Debug] + terminate( + error, {bad_action,R}, ?STACKTRACE(), + Debug, S, Q, State, Data, P) end. -do_reply(Debug, S, From, Reply) -> +do_reply(Debug, S, State, From, Reply) -> reply(From, Reply), - sys_debug(Debug, S, {out,Reply,From}). + sys_debug(Debug, S, State, {out,Reply,From}). terminate( - Class, Reason, Stacktrace, Debug, - #{module := Module, - state := State, data := Data} = S, - Q) -> + Class, Reason, Stacktrace, + Debug, #{module := Module} = S, Q, State, Data, P) -> try Module:terminate(Reason, State, Data) of _ -> ok catch @@ -1149,8 +1188,8 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, Debug, S, Q, - format_status(terminate, get(), S)), + C, R, ST, Debug, S, Q, P, + format_status(terminate, get(), S, State, Data)), erlang:raise(C, R, ST) end, case Reason of @@ -1159,8 +1198,8 @@ terminate( {shutdown,_} -> ok; _ -> error_info( - Class, Reason, Stacktrace, Debug, S, Q, - format_status(terminate, get(), S)) + Class, Reason, Stacktrace, Debug, S, Q, P, + format_status(terminate, get(), S, State, Data)) end, case Stacktrace of [] -> @@ -1171,9 +1210,8 @@ terminate( error_info( Class, Reason, Stacktrace, Debug, - #{name := Name, callback_mode := CallbackMode, - state := State, postponed := P}, - Q, FmtData) -> + #{name := Name, callback_mode := CallbackMode}, + Q, P, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1202,46 +1240,49 @@ error_info( error_logger:format( "** State machine ~p terminating~n" ++ case Q of - [] -> - ""; - _ -> - "** Last event = ~p~n" + [] -> ""; + _ -> "** Last event = ~p~n" end ++ - "** When Server state = ~p~n" ++ + "** When server state = ~p~n" ++ "** Reason for termination = ~w:~p~n" ++ - "** State = ~p~n" ++ "** Callback mode = ~p~n" ++ - "** Queued/Postponed = ~w/~w~n" ++ + case Q of + [_,_|_] -> "** Queued = ~p~n"; + _ -> "" + end ++ + case P of + [] -> ""; + _ -> "** Postponed = ~p~n" + end ++ case FixedStacktrace of - [] -> - ""; - _ -> - "** Stacktrace =~n" - "** ~p~n" + [] -> ""; + _ -> "** Stacktrace =~n** ~p~n" end, [Name | case Q of - [] -> - []; - [Event|_] -> - [Event] + [] -> []; + [Event|_] -> [Event] end] ++ [FmtData,Class,FixedReason, - State,CallbackMode,length(Q),length(P)] ++ + CallbackMode] ++ + case Q of + [_|[_|_] = Events] -> [Events]; + _ -> [] + end ++ + case P of + [] -> []; + _ -> [P] + end ++ case FixedStacktrace of - [] -> - []; - _ -> - [FixedStacktrace] + [] -> []; + _ -> [FixedStacktrace] end), sys:print_log(Debug), ok. %% Call Module:format_status/2 or return a default value -format_status( - Opt, PDict, - #{module := Module, state := State, data := Data}) -> +format_status(Opt, PDict, #{module := Module}, State, Data) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 3f79ed0f87..fdc2ae4070 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -48,7 +48,9 @@ | {'priority', priority_level()} | {'min_heap_size', non_neg_integer()} | {'min_bin_vheap_size', non_neg_integer()} - | {'fullsweep_after', non_neg_integer()}. + | {'fullsweep_after', non_neg_integer()} + | {'message_queue_data', + 'off_heap' | 'on_heap' | 'mixed' }. -type dict_or_pid() :: pid() | (ProcInfo :: [_]) diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 6fea198af3..b0214e5238 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -33,47 +33,38 @@ -define(privdir, proplists:get_value(priv_dir, Conf)). -endif. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). - --export([ - unused_vars_warn_basic/1, - unused_vars_warn_lc/1, - unused_vars_warn_rec/1, - unused_vars_warn_fun/1, - unused_vars_OTP_4858/1, - unused_unsafe_vars_warn/1, - export_vars_warn/1, - shadow_vars/1, - unused_import/1, - unused_function/1, - unsafe_vars/1,unsafe_vars2/1, - unsafe_vars_try/1, - unsized_binary_in_bin_gen_pattern/1, - guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, - otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, - otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1, - otp_11772/1, otp_11771/1, otp_11872/1, - export_all/1, - bif_clash/1, - behaviour_basic/1, behaviour_multiple/1, otp_11861/1, - otp_7550/1, - otp_8051/1, - format_warn/1, - on_load_successful/1, on_load_failing/1, - too_many_arguments/1, - basic_errors/1,bin_syntax_errors/1, - predef/1, - maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1, - record_errors/1 - ]). - -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. +-export([all/0, suite/0, groups/0]). + +-export([unused_vars_warn_basic/1, + unused_vars_warn_lc/1, + unused_vars_warn_rec/1, + unused_vars_warn_fun/1, + unused_vars_OTP_4858/1, + unused_unsafe_vars_warn/1, + export_vars_warn/1, + shadow_vars/1, + unused_import/1, + unused_function/1, + unsafe_vars/1,unsafe_vars2/1, + unsafe_vars_try/1, + unsized_binary_in_bin_gen_pattern/1, + guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, + otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, + otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1, + otp_11772/1, otp_11771/1, otp_11872/1, + export_all/1, + bif_clash/1, + behaviour_basic/1, behaviour_multiple/1, otp_11861/1, + otp_7550/1, + otp_8051/1, + format_warn/1, + on_load_successful/1, on_load_failing/1, + too_many_arguments/1, + basic_errors/1,bin_syntax_errors/1, + predef/1, + maps/1,maps_type/1,maps_parallel_match/1, + otp_11851/1,otp_11879/1,otp_13230/1, + record_errors/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -91,7 +82,8 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_11879, otp_13230, + maps, maps_type, maps_parallel_match, + otp_11851, otp_11879, otp_13230, record_errors]. groups() -> @@ -101,19 +93,6 @@ groups() -> unused_vars_OTP_4858, unused_unsafe_vars_warn]}, {on_load, [], [on_load_successful, on_load_failing]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% Warnings for unused variables in some simple cases. unused_vars_warn_basic(Config) when is_list(Config) -> @@ -3583,8 +3562,6 @@ predef(Config) when is_list(Config) -> ok. maps(Config) -> - %% TODO: test key patterns, not done because map patterns are going to be - %% changed a lot. Ts = [{illegal_map_construction, <<"t() -> #{ a := b, @@ -3626,6 +3603,26 @@ maps(Config) -> {errors,[{1,erl_lint,illegal_map_construction}, {1,erl_lint,{unbound_var,'X'}}], []}}, + {legal_map_pattern, + <<" + -record(mapkey, {a=1,b=2}). + t(M,K1) -> + #{ a := 1, + $a := 1, $z := 99, + #{a=>val} := 2, + K1 := 1337, + #mapkey{a = 10} := wat, + #{{a,val}=>val} := 2, + #{ \"hi\" => wazzup, hi => ho } := yep, + ok := 1.0, + [3+3] := nope, + 1.0 := yep, + {3.0+3} := nope, + {yep} := yep + } = M. + ">>, + [], + []}, {legal_map_construction, <<"t(V) -> #{ a => 1, #{a=>V} => 2, @@ -3692,6 +3689,51 @@ maps_type(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +maps_parallel_match(Config) when is_list(Config) -> + Ts = [{parallel_map_patterns_unbound1, + <<" + t(#{} = M) -> + #{K := V} = #{k := K} = M, + V. + ">>, + [], + {errors,[{3,erl_lint,{unbound_var,'K'}}],[]}}, + {parallel_map_patterns_unbound2, + <<" + t(#{} = M) -> + #{K1 := V1} = + #{K2 := V2} = + #{k1 := K1,k2 := K2} = M, + [V1,V2]. + ">>, + [], + {errors,[{3,erl_lint,{unbound_var,'K1'}}, + {3,erl_lint,{unbound_var,'K1'}}, + {4,erl_lint,{unbound_var,'K2'}}, + {4,erl_lint,{unbound_var,'K2'}}],[]}}, + {parallel_map_patterns_bound, + <<" + t(#{} = M,K1,K2) -> + #{K1 := V1} = + #{K2 := V2} = + #{k1 := K1,k2 := K2} = M, + [V1,V2]. + ">>, + [], + []}, + {parallel_map_patterns_literal, + <<" + t(#{} = M) -> + #{k1 := V1} = + #{k2 := V2} = + #{k1 := V1,k2 := V2} = M, + [V1,V2]. + ">>, + [], + []}], + [] = run(Config, Ts), + ok. + %% OTP-11851: More atoms can be used as type names + bug fixes. otp_11851(Config) when is_list(Config) -> Ts = [ diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 3deb5fd986..364314f91b 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -634,12 +634,14 @@ sys1(Config) -> stop_it(Pid). code_change(Config) -> + Mode = handle_event_function, {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), {idle,data} = sys:get_state(Pid), sys:suspend(Pid), - sys:change_code(Pid, ?MODULE, old_vsn, state_functions), + sys:change_code(Pid, ?MODULE, old_vsn, Mode), sys:resume(Pid), - {idle,{old_vsn,data,state_functions}} = sys:get_state(Pid), + {idle,{old_vsn,data,Mode}} = sys:get_state(Pid), + Mode = gen_statem:call(Pid, get_callback_mode), stop_it(Pid). call_format_status(Config) -> @@ -1478,6 +1480,8 @@ next_events(Type, Content, Data) -> end. +handle_common_events({call,From}, get_callback_mode, _, _) -> + {keep_state_and_data,{reply,From,state_functions}}; handle_common_events({call,From}, get, State, Data) -> {keep_state,Data, [{reply,From,{state,State,Data}}]}; @@ -1501,6 +1505,8 @@ handle_common_events(cast, {'alive?',Pid}, _, Data) -> handle_common_events(_, _, _, _) -> undefined. +handle_event({call,From}, get_callback_mode, _, _) -> + {keep_state_and_data,{reply,From,handle_event_function}}; %% Wrapper state machine that uses a map state machine spec handle_event( Type, Event, State, [Data|Machine]) diff --git a/otp_versions.table b/otp_versions.table index 79e1c14c49..f68986d831 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.3.3 : common_test-1.12.1 inets-6.2.3 ssl-7.3.2 # asn1-4.0.2 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.2 : inets-6.2.2 ssl-7.3.1 # asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.1 : erts-7.3.1 inets-6.2.1 mnesia-4.13.4 # asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 ssl-7.3 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3 : asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosNotification-1.2.1 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3 eunit-2.2.13 hipe-3.15 inets-6.2 kernel-4.2 mnesia-4.13.3 observer-2.1.2 orber-3.8.1 public_key-1.1.1 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 ssl-7.3 stdlib-2.8 test_server-3.10 tools-2.8.3 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosProperty-1.2 et-1.5.1 gs-1.6 ic-4.4 jinterface-1.6.1 megaco-3.18 odbc-2.11.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 typer-0.9.10 : diff --git a/system/doc/design_principles/code_lock.dia b/system/doc/design_principles/code_lock.dia Binary files differindex bed6d8ee86..8e6ff8a898 100644 --- a/system/doc/design_principles/code_lock.dia +++ b/system/doc/design_principles/code_lock.dia diff --git a/system/doc/design_principles/code_lock.png b/system/doc/design_principles/code_lock.png Binary files differindex e40f0320aa..745fd91920 100644 --- a/system/doc/design_principles/code_lock.png +++ b/system/doc/design_principles/code_lock.png diff --git a/system/doc/design_principles/code_lock_2.dia b/system/doc/design_principles/code_lock_2.dia Binary files differindex 4e82a9e1d6..142909a2f5 100644 --- a/system/doc/design_principles/code_lock_2.dia +++ b/system/doc/design_principles/code_lock_2.dia diff --git a/system/doc/design_principles/code_lock_2.png b/system/doc/design_principles/code_lock_2.png Binary files differindex 138fbdef6c..ecf7b0d799 100644 --- a/system/doc/design_principles/code_lock_2.png +++ b/system/doc/design_principles/code_lock_2.png diff --git a/system/doc/design_principles/fsm.xml b/system/doc/design_principles/fsm.xml index 3468f93ae0..4f2b75e6e8 100644 --- a/system/doc/design_principles/fsm.xml +++ b/system/doc/design_principles/fsm.xml @@ -33,7 +33,7 @@ <note> <p> There is a new behaviour - <seealso marker="gen_statem"><c>gen_statem</c></seealso> + <seealso marker="statem"><c>gen_statem</c></seealso> that is intended to replace <c>gen_fsm</c> for new code. It has the same features and add some really useful. This module will not be removed for the foreseeable future |
