diff options
129 files changed, 4340 insertions, 2062 deletions
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 9724a1345a..f8f4d14436 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -495,7 +495,7 @@ <c><![CDATA[werl]]></c>, not <c><![CDATA[erl]]></c> (<c><![CDATA[oldshell]]></c>). Note also that <c><![CDATA[Ctrl-Break]]></c> is used instead of <c><![CDATA[Ctrl-C]]></c> on Windows.</p> </item> - <tag><c><![CDATA[+c]]></c></tag> + <tag><marker id="+c"><c><![CDATA[+c]]></c></marker></tag> <item> <p>Disable compensation for sudden changes of system time.</p> <p>Normally, <c><![CDATA[erlang:now/0]]></c> will not immediately reflect @@ -510,6 +510,9 @@ reflect the current system time. Note that timers are based on <c><![CDATA[erlang:now/0]]></c>. If the system time jumps, timers then time out at the wrong time.</p> + <p><em>NOTE</em>: You can check whether the adjustment is enabled or + disabled by calling + <seealso marker="erlang#system_info_tolerant_timeofday">erlang:system_info(tolerant_timeofday)</seealso>.</p> </item> <tag><c><![CDATA[+d]]></c></tag> <item> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 0f4dfc0f98..9ad42374bf 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -6295,6 +6295,13 @@ ok (<seealso marker="erts:erl_driver#driver_async">driver_async()</seealso>) as an integer.</p> </item> + <tag><marker id="system_info_tolerant_timeofday"><c>tolerant_timeofday</c></marker></tag> + <item> + <p>Returns whether compensation for sudden changes of system + time is <c>enabled</c> or <c>disabled</c>.</p> + <p>See also <seealso marker="erts:erl#+c">+c</seealso> + command line flag.</p> + </item> <tag><c>trace_control_word</c></tag> <item> <p>Returns the value of the node's trace control word. diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index d28e519ae1..5d06a32941 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -116,6 +116,7 @@ atom binary_longest_prefix_trap atom binary_longest_suffix_trap atom binary_match_trap atom binary_matches_trap +atom binary_to_list_continue atom binary_to_term_trap atom block atom blocked @@ -315,6 +316,7 @@ atom line_length atom linked_in_driver atom links atom list +atom list_to_binary_continue atom little atom loaded atom load_cancelled diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 06a1230ca0..fcbeb6cf5c 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1886,8 +1886,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { Eterm id = erts_whereis_name_to_id(p, to); rp = erts_proc_lookup(id); - if (rp) + if (rp) { + if (IS_TRACED(p)) + trace_send(p, to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); goto send_message; + } pt = erts_port_lookup(id, (erts_port_synchronous_ops diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 51b77a95ed..72c55ccb55 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -124,12 +124,85 @@ do { \ return THE_NON_VALUE; \ } while(0) +#define ERTS_BIF_ERROR_TRAPPED0(Proc, Reason, Bif) \ +do { \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + return THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_ERROR_TRAPPED1(Proc, Reason, Bif, A0) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + reg[0] = (Eterm) (A0); \ + return THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_ERROR_TRAPPED2(Proc, Reason, Bif, A0, A1) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + return THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_ERROR_TRAPPED3(Proc, Reason, Bif, A0, A1, A2) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + return THE_NON_VALUE; \ +} while (0) + #define ERTS_BIF_PREP_ERROR(Ret, Proc, Reason) \ do { \ (Proc)->freason = (Reason); \ (Ret) = THE_NON_VALUE; \ } while (0) +#define ERTS_BIF_PREP_ERROR_TRAPPED0(Ret, Proc, Reason, Bif) \ +do { \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_ERROR_TRAPPED1(Ret, Proc, Reason, Bif, A0) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + reg[0] = (Eterm) (A0); \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_ERROR_TRAPPED2(Ret, Proc, Reason, Bif, A0, A1) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_ERROR_TRAPPED3(Ret, Proc, Reason, Bif, A0, A1, A2) \ +do { \ + Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \ + (Proc)->freason = (Reason); \ + (Proc)->current = (Bif)->code; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + (Ret) = THE_NON_VALUE; \ +} while (0) #define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \ do { \ @@ -392,6 +465,51 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Eterm args[], int nargs); +#ifndef HIPE + +#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) + +#else + +#include "erl_fun.h" +#include "hipe_mode_switch.h" + +/* + * Hipe wrappers used by native code for BIFs that disable GC while trapping. + * Also add usage of the wrapper in ../hipe/hipe_bif_list.m4 + * + * Problem: + * When native code calls a BIF that traps, hipe_mode_switch will push a + * "trap frame" on the Erlang stack in order to find its way back from beam_emu + * back to native caller when finally done. If GC is disabled and stack/heap + * is full there is no place to push the "trap frame". + * + * Solution: + * We reserve space on stack for the "trap frame" here before the BIF is called. + * If the BIF does not trap, the space is reclaimed here before returning. + * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame" + * already is reserved and use it. + */ + + +#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) \ +BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ + Eterm* args); \ +BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ + Eterm* args) \ +{ \ + BIF_RETTYPE res; \ + hipe_reserve_beam_trap_frame(c_p, args, ARITY); \ + res = BIF_NAME ## _ ## ARITY (c_p, args); \ + if (is_value(res) || c_p->freason != TRAP) { \ + hipe_unreserve_beam_trap_frame(c_p); \ + } \ + return res; \ +} + +#endif + + #include "erl_bif_table.h" #endif diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index fbdddf09db..011e49f1fe 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -45,6 +45,7 @@ bif erlang:apply/3 bif erlang:atom_to_list/1 bif erlang:binary_to_list/1 bif erlang:binary_to_list/3 +bif erlang:binary_to_term/1 bif erlang:crc32/1 bif erlang:crc32/2 bif erlang:crc32_combine/3 @@ -151,8 +152,6 @@ bif erts_internal:port_command/3 bif erts_internal:port_control/3 bif erts_internal:port_close/1 bif erts_internal:port_connect/2 -bif erts_internal:binary_to_term/1 -bif erts_internal:binary_to_term/2 bif erts_internal:request_system_task/3 bif erts_internal:check_process_code/2 @@ -481,6 +480,11 @@ bif erlang:call_on_load_function/1 bif erlang:finish_after_on_load/2 # +# New Bifs in R13B04 +# +bif erlang:binary_to_term/2 + +# # The binary match bifs (New in R14A - EEP9) # diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index c7926f18af..f50d484576 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -31,12 +31,11 @@ #include "erl_binary.h" #include "erl_bits.h" -#ifdef DEBUG -static int list_to_bitstr_buf(Eterm obj, char* buf, Uint len); -#else -static int list_to_bitstr_buf(Eterm obj, char* buf); -#endif -static int bitstr_list_len(Eterm obj, Uint* num_bytes); +static Export binary_to_list_continue_export; +static Export list_to_binary_continue_export; + +static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1); +static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1); void erts_init_binary(void) @@ -49,6 +48,15 @@ erts_init_binary(void) "Internal error: Address of orig_bytes[0] of a Binary" " is *not* 8-byte aligned\n"); } + + erts_init_trap_export(&binary_to_list_continue_export, + am_erts_internal, am_binary_to_list_continue, 1, + &binary_to_list_continue); + + erts_init_trap_export(&list_to_binary_continue_export, + am_erts_internal, am_list_to_binary_continue, 1, + &list_to_binary_continue); + } /* @@ -333,6 +341,132 @@ BIF_RETTYPE integer_to_binary_1(BIF_ALIST_1) BIF_RET(res); } +#define ERTS_B2L_BYTES_PER_REDUCTION 256 + +typedef struct { + Eterm res; + Eterm *hp; +#ifdef DEBUG + Eterm *hp_end; +#endif + byte *bytes; + Uint size; + Uint bitoffs; +} ErtsB2LState; + +static void b2l_state_destructor(Binary *mbp) +{ + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor); +} + +static BIF_RETTYPE +binary_to_list_chunk(Process *c_p, + Eterm mb_eterm, + ErtsB2LState* sp, + int reds_left, + int gc_disabled) +{ + BIF_RETTYPE ret; + int bump_reds; + Uint size; + byte *bytes; + + size = (reds_left + 1)*ERTS_B2L_BYTES_PER_REDUCTION; + if (size > sp->size) + size = sp->size; + bytes = sp->bytes + (sp->size - size); + + bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1; + BUMP_REDS(c_p, bump_reds); + + ASSERT(is_list(sp->res) || is_nil(sp->res)); + + sp->res = erts_bin_bytes_to_list(sp->res, + sp->hp, + bytes, + size, + sp->bitoffs); + sp->size -= size; + sp->hp += 2*size; + + if (sp->size > 0) { + + if (!gc_disabled) + erts_set_gc_state(c_p, 0); + + ASSERT(c_p->flags & F_DISABLE_GC); + ASSERT(is_value(mb_eterm)); + ERTS_BIF_PREP_TRAP1(ret, + &binary_to_list_continue_export, + c_p, + mb_eterm); + } + else { + + ASSERT(sp->hp == sp->hp_end); + ASSERT(sp->size == 0); + + if (!gc_disabled || !erts_set_gc_state(c_p, 1)) + ERTS_BIF_PREP_RET(ret, sp->res); + else + ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, sp->res); + ASSERT(!(c_p->flags & F_DISABLE_GC)); + } + + return ret; +} + +static ERTS_INLINE BIF_RETTYPE +binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, Uint size, Uint bitoffs) +{ + int reds_left = ERTS_BIF_REDS_LEFT(c_p); + if (size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION) { + Eterm res; + BIF_RETTYPE ret; + int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1; + BUMP_REDS(c_p, bump_reds); + res = erts_bin_bytes_to_list(tail, hp, bytes, size, bitoffs); + ERTS_BIF_PREP_RET(ret, res); + return ret; + } + else { + Binary *mbp = erts_create_magic_binary(sizeof(ErtsB2LState), + b2l_state_destructor); + ErtsB2LState *sp = ERTS_MAGIC_BIN_DATA(mbp); + Eterm mb; + + sp->res = tail; + sp->hp = hp; +#ifdef DEBUG + sp->hp_end = sp->hp + 2*size; +#endif + sp->bytes = bytes; + sp->size = size; + sp->bitoffs = bitoffs; + + hp = HAlloc(c_p, PROC_BIN_SIZE); + mb = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + return binary_to_list_chunk(c_p, mb, sp, reds_left, 0); + } +} + +static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1) +{ + Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val; + + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == b2l_state_destructor); + + ASSERT(BIF_P->flags & F_DISABLE_GC); + + return binary_to_list_chunk(BIF_P, + BIF_ARG_1, + (ErtsB2LState*) ERTS_MAGIC_BIN_DATA(mbp), + ERTS_BIF_REDS_LEFT(BIF_P), + 1); +} + +HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_list, 1) + BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) { Eterm real_bin; @@ -354,14 +488,15 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) } else { Eterm* hp = HAlloc(BIF_P, 2 * size); byte* bytes = binary_bytes(real_bin)+offset; - - BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes, size, bitoffs)); + return binary_to_list(BIF_P, hp, NIL, bytes, size, bitoffs); } error: BIF_ERROR(BIF_P, BADARG); } +HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_list, 3) + BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) { byte* bytes; @@ -387,12 +522,13 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) } i = stop-start+1; hp = HAlloc(BIF_P, 2*i); - BIF_RET(erts_bin_bytes_to_list(NIL, hp, bytes+start-1, i, bitoffs)); - + return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, bitoffs); error: BIF_ERROR(BIF_P, BADARG); } +HIPE_WRAPPER_BIF_DISABLE_GC(bitstring_to_list, 1) + BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) { Eterm real_bin; @@ -431,124 +567,441 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) previous = CONS(hp, make_binary(last), previous); hp += 2; } - BIF_RET(erts_bin_bytes_to_list(previous, hp, bytes, size, bitoffs)); + + return binary_to_list(BIF_P, hp, previous, bytes, size, bitoffs); } /* Turn a possibly deep list of ints (and binaries) into */ /* One large binary object */ -/* - * This bif also exists in the binary module, under the name - * binary:list_to_bin/1, why it's divided into interface and - * implementation. Also the backend for iolist_to_binary_1. - */ +typedef enum { + ERTS_L2B_OK, + ERTS_L2B_YIELD, + ERTS_L2B_TYPE_ERROR, + ERTS_L2B_OVERFLOW_ERROR +} ErtsL2BResult; -BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) -{ +#define ERTS_L2B_STATE_INITER(C_P, ARG, BIF, SZFunc, TBufFunc) \ + {ERTS_IOLIST2BUF_STATE_INITER((C_P), (ARG)), \ + (ARG), THE_NON_VALUE, (BIF), (SZFunc), (TBufFunc)} + +#define ERTS_L2B_STATE_MOVE(TO, FROM) \ + sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsL2BState)) + +typedef struct ErtsL2BState_ ErtsL2BState; + +struct ErtsL2BState_ { + ErtsIOList2BufState buf; + Eterm arg; Eterm bin; - Eterm h,t; - ErlDrvSizeT size; - byte* bytes; -#ifdef DEBUG - ErlDrvSizeT offset; -#endif + Export *bif; + int (*iolist_to_buf_size)(ErtsIOListState *); + ErlDrvSizeT (*iolist_to_buf)(ErtsIOList2BufState *); +}; + +static ERTS_INLINE ErtsL2BResult +list_to_binary_engine(ErtsL2BState *sp) +{ + ErlDrvSizeT res; + Process *c_p = sp->buf.iolist.c_p; + + /* + * have_size == 0 while sp->iolist_to_buf_size() + * has not finished the calculation. + */ + + if (!sp->buf.iolist.have_size) { + switch (sp->iolist_to_buf_size(&sp->buf.iolist)) { + case ERTS_IOLIST_YIELD: + return ERTS_L2B_YIELD; + case ERTS_IOLIST_OVERFLOW: + return ERTS_L2B_OVERFLOW_ERROR; + case ERTS_IOLIST_TYPE: + return ERTS_L2B_TYPE_ERROR; + case ERTS_IOLIST_OK: + break; + default: + ASSERT(0); + break; + } + + ASSERT(sp->buf.iolist.have_size); + + /* + * Size calculated... Setup state for + * sp->iolist_to_buf_*() + */ + + sp->bin = new_binary(c_p, + (byte *) NULL, + sp->buf.iolist.size); + + if (sp->buf.iolist.size == 0) + return ERTS_L2B_OK; + + sp->buf.buf = (char *) binary_bytes(sp->bin); + sp->buf.len = sp->buf.iolist.size; + sp->buf.iolist.obj = sp->arg; - if (is_nil(arg)) { - BIF_RET(new_binary(p,(byte*)"",0)); + if (sp->buf.iolist.reds_left <= 0) { + BUMP_ALL_REDS(c_p); + return ERTS_L2B_YIELD; + } } - if (is_not_list(arg)) { - goto error; + + ASSERT(sp->buf.iolist.size != 0); + ASSERT(is_value(sp->bin)); + ASSERT(sp->buf.buf); + + res = sp->iolist_to_buf(&sp->buf); + + if (!ERTS_IOLIST_TO_BUF_FAILED(res)) { + ASSERT(res == 0); + return ERTS_L2B_OK; } - /* check for [binary()] case */ - h = CAR(list_val(arg)); - t = CDR(list_val(arg)); - if (is_binary(h) && is_nil(t) && !( - HEADER_SUB_BIN == *(binary_val(h)) && ( - ((ErlSubBin *)binary_val(h))->bitoffs != 0 || - ((ErlSubBin *)binary_val(h))->bitsize != 0 - ))) { - return h; - } - switch (erts_iolist_size(arg, &size)) { - case ERTS_IOLIST_OVERFLOW: BIF_ERROR(p, SYSTEM_LIMIT); - case ERTS_IOLIST_TYPE: goto error; - default: ; - } - bin = new_binary(p, (byte *)NULL, size); - bytes = binary_bytes(bin); -#ifdef DEBUG - offset = -#endif - erts_iolist_to_buf(arg, (char*) bytes, size); - ASSERT(offset == 0); - BIF_RET(bin); + switch (res) { + case ERTS_IOLIST_TO_BUF_YIELD: + return ERTS_L2B_YIELD; + case ERTS_IOLIST_TO_BUF_OVERFLOW: + return ERTS_L2B_OVERFLOW_ERROR; + case ERTS_IOLIST_TO_BUF_TYPE_ERROR: + return ERTS_L2B_TYPE_ERROR; + default: + ERTS_INTERNAL_ERROR("Invalid return value from iolist_to_buf_yielding()"); + return ERTS_L2B_TYPE_ERROR; + } +} + +static void +l2b_state_destructor(Binary *mbp) +{ + ErtsL2BState *sp = ERTS_MAGIC_BIN_DATA(mbp); + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor); + DESTROY_SAVED_ESTACK(&sp->buf.iolist.estack); +} + +static ERTS_INLINE Eterm +l2b_final_touch(Process *c_p, ErtsL2BState *sp) +{ + Eterm *hp; + ErlSubBin* sbin; + if (sp->buf.offset == 0) + return sp->bin; + + hp = HAlloc(c_p, ERL_SUB_BIN_SIZE); + ASSERT(sp->buf.offset > 0); + sbin = (ErlSubBin *) hp; + sbin->thing_word = HEADER_SUB_BIN; + sbin->size = sp->buf.iolist.size-1; + sbin->offs = 0; + sbin->orig = sp->bin; + sbin->bitoffs = 0; + sbin->bitsize = sp->buf.offset; + sbin->is_writable = 0; + return make_binary(sbin); +} + +static BIF_RETTYPE +list_to_binary_chunk(Eterm mb_eterm, + ErtsL2BState* sp, + int reds_left, + int gc_disabled) +{ + Eterm err = BADARG; + BIF_RETTYPE ret; + Process *c_p = sp->buf.iolist.c_p; + + sp->buf.iolist.reds_left = reds_left; - error: - BIF_ERROR(p, BADARG); + switch (list_to_binary_engine(sp)) { + + case ERTS_L2B_OK: { + Eterm result = l2b_final_touch(c_p, sp); + if (!gc_disabled || !erts_set_gc_state(c_p, 1)) + ERTS_BIF_PREP_RET(ret, result); + else + ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, result); + ASSERT(!(c_p->flags & F_DISABLE_GC)); + break; + } + case ERTS_L2B_YIELD: + if (!gc_disabled) { + /* first yield... */ + Eterm *hp; + Binary *mbp = erts_create_magic_binary(sizeof(ErtsL2BState), + l2b_state_destructor); + ErtsL2BState *new_sp = ERTS_MAGIC_BIN_DATA(mbp); + + ERTS_L2B_STATE_MOVE(new_sp, sp); + sp = new_sp; + + hp = HAlloc(c_p, PROC_BIN_SIZE); + mb_eterm = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp); + + ASSERT(is_value(mb_eterm)); + + erts_set_gc_state(c_p, 0); + } + + ASSERT(c_p->flags & F_DISABLE_GC); + + ERTS_BIF_PREP_TRAP1(ret, + &list_to_binary_continue_export, + c_p, + mb_eterm); + break; + + case ERTS_L2B_OVERFLOW_ERROR: + err = SYSTEM_LIMIT; + /* fall through */ + + case ERTS_L2B_TYPE_ERROR: + if (!gc_disabled) + ERTS_BIF_PREP_ERROR(ret, c_p, err); + else { + if (erts_set_gc_state(c_p, 1)) + ERTS_VBUMP_ALL_REDS(c_p); + + ERTS_BIF_PREP_ERROR_TRAPPED1(ret, + c_p, + err, + sp->bif, + sp->arg); + } + + ASSERT(!(c_p->flags & F_DISABLE_GC)); + break; + + default: + ERTS_INTERNAL_ERROR("Invalid return value from list_to_binary_engine()"); + ERTS_BIF_PREP_ERROR(ret,c_p, EXC_INTERNAL_ERROR); + break; + } + return ret; } +static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1) +{ + Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val; + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor); + + ASSERT(BIF_P->flags & F_DISABLE_GC); + + return list_to_binary_chunk(BIF_ARG_1, + ERTS_MAGIC_BIN_DATA(mbp), + ERTS_BIF_REDS_LEFT(BIF_P), + 1); +} + +BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif) +{ + BIF_RETTYPE ret; + + if (is_nil(arg)) + ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0)); + else if (is_not_list(arg)) + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + else { + /* check for [binary()] case */ + Eterm h = CAR(list_val(arg)); + Eterm t = CDR(list_val(arg)); + if (is_binary(h) + && is_nil(t) + && !(HEADER_SUB_BIN == *(binary_val(h)) + && (((ErlSubBin *)binary_val(h))->bitoffs != 0 + || ((ErlSubBin *)binary_val(h))->bitsize != 0))) { + ERTS_BIF_PREP_RET(ret, h); + } + else { + ErtsL2BState state = ERTS_L2B_STATE_INITER(c_p, + arg, + bif, + erts_iolist_size_yielding, + erts_iolist_to_buf_yielding); + int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p); + + /* + * First try to do it all at once without having to use + * yielding iolist_to_buf(). + */ + state.buf.iolist.reds_left = orig_reds_left; + switch (erts_iolist_size_yielding(&state.buf.iolist)) { + case ERTS_IOLIST_OK: { + ErlDrvSizeT size = state.buf.iolist.size; + Eterm bin; + char *buf; + + if (size == 0) { + ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) NULL, 0)); + break; /* done */ + } + + bin = new_binary(c_p, (byte *) NULL, size); + buf = (char *) binary_bytes(bin); + + if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) { + /* An (over) estimation of reductions needed */ + int reds_left = state.buf.iolist.reds_left; + int to_buf_reds = orig_reds_left - reds_left; + to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED; + if (to_buf_reds <= reds_left) { + ErlDrvSizeT res; + + res = erts_iolist_to_buf(arg, buf, size); + if (res == 0) { + BUMP_REDS(c_p, to_buf_reds); + ERTS_BIF_PREP_RET(ret, bin); + break; /* done */ + } + if (!ERTS_IOLIST_TO_BUF_FAILED(res)) + ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch"); + if (res == ERTS_IOLIST_TO_BUF_OVERFLOW) + goto overflow; + goto type_error; + } + } + /* + * Since size has been computed list_to_binary_chunk() expects + * state prepared for iolist_to_buf. + */ + state.bin = bin; + state.buf.buf = buf; + state.buf.len = size; + state.buf.iolist.obj = arg; + /* Fall through... */ + } + case ERTS_IOLIST_YIELD: + ret = list_to_binary_chunk(THE_NON_VALUE, + &state, + state.buf.iolist.reds_left, + 0); + break; + case ERTS_IOLIST_OVERFLOW: + overflow: + ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT); + break; + case ERTS_IOLIST_TYPE: + type_error: + default: + ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); + break; + } + } + } + return ret; +} + +HIPE_WRAPPER_BIF_DISABLE_GC(list_to_binary, 1) + BIF_RETTYPE list_to_binary_1(BIF_ALIST_1) { - return erts_list_to_binary_bif(BIF_P, BIF_ARG_1); + return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_list_to_binary_1]); } -/* Turn a possibly deep list of ints (and binaries) into */ -/* One large binary object */ +HIPE_WRAPPER_BIF_DISABLE_GC(iolist_to_binary, 1) BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1) { if (is_binary(BIF_ARG_1)) { BIF_RET(BIF_ARG_1); } - return erts_list_to_binary_bif(BIF_P, BIF_ARG_1); + return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_iolist_to_binary_1]); } +static int bitstr_list_len(ErtsIOListState *); +static ErlDrvSizeT list_to_bitstr_buf_yielding(ErtsIOList2BufState *); +static ErlDrvSizeT list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *); + +HIPE_WRAPPER_BIF_DISABLE_GC(list_to_bitstring, 1) + BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1) { - Eterm bin; - Uint sz; - int offset; - byte* bytes; - ErlSubBin* sb1; - Eterm* hp; - - if (is_nil(BIF_ARG_1)) { - BIF_RET(new_binary(BIF_P,(byte*)"",0)); - } - if (is_not_list(BIF_ARG_1)) { - error: - BIF_ERROR(BIF_P, BADARG); - } - switch (bitstr_list_len(BIF_ARG_1, &sz)) { - case ERTS_IOLIST_TYPE: - goto error; - case ERTS_IOLIST_OVERFLOW: - BIF_ERROR(BIF_P, SYSTEM_LIMIT); - } - bin = new_binary(BIF_P, (byte *)NULL, sz); - bytes = binary_bytes(bin); -#ifdef DEBUG - offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes, sz); -#else - offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes); -#endif - ASSERT(offset >= 0); - if (offset > 0) { - hp = HAlloc(BIF_P, ERL_SUB_BIN_SIZE); - sb1 = (ErlSubBin *) hp; - sb1->thing_word = HEADER_SUB_BIN; - sb1->size = sz-1; - sb1->offs = 0; - sb1->orig = bin; - sb1->bitoffs = 0; - sb1->bitsize = offset; - sb1->is_writable = 0; - bin = make_binary(sb1); + BIF_RETTYPE ret; + + if (is_nil(BIF_ARG_1)) + ERTS_BIF_PREP_RET(ret, new_binary(BIF_P, (byte *) "", 0)); + else if (is_not_list(BIF_ARG_1)) + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + else { + /* check for [bitstring()] case */ + Eterm h = CAR(list_val(BIF_ARG_1)); + Eterm t = CDR(list_val(BIF_ARG_1)); + if (is_binary(h) && is_nil(t)) { + ERTS_BIF_PREP_RET(ret, h); + } + else { + ErtsL2BState state = ERTS_L2B_STATE_INITER(BIF_P, + BIF_ARG_1, + bif_export[BIF_list_to_bitstring_1], + bitstr_list_len, + list_to_bitstr_buf_yielding); + int orig_reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + + /* + * First try to do it all at once without having to use + * yielding list_to_bitstr_buf(). + */ + state.buf.iolist.reds_left = orig_reds_left; + switch (bitstr_list_len(&state.buf.iolist)) { + case ERTS_IOLIST_OK: { + ErlDrvSizeT size = state.buf.iolist.size; + + state.bin = new_binary(BIF_P, (byte *) NULL, size); + state.buf.buf = (char *) binary_bytes(state.bin); + state.buf.len = size; + state.buf.iolist.obj = BIF_ARG_1; + + if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) { + /* An (over) estimation of reductions needed */ + int reds_left = state.buf.iolist.reds_left; + int to_buf_reds = orig_reds_left - reds_left; + to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED; + if (to_buf_reds <= reds_left) { + ErlDrvSizeT res; + + res = list_to_bitstr_buf_not_yielding(&state.buf); + if (res == 0) { + Eterm res_bin = l2b_final_touch(BIF_P, &state); + BUMP_REDS(BIF_P, to_buf_reds); + ERTS_BIF_PREP_RET(ret, res_bin); + break; /* done */ + } + if (!ERTS_IOLIST_TO_BUF_FAILED(res)) + ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch"); + if (res == ERTS_IOLIST_TO_BUF_OVERFLOW) + goto overflow; + goto type_error; + } + } + /* + * Since size has been computed list_to_binary_chunk() expects + * the state prepared for list_to_bitstr_buf. + */ + + /* Fall through... */ + } + case ERTS_IOLIST_YIELD: + ret = list_to_binary_chunk(THE_NON_VALUE, + &state, + state.buf.iolist.reds_left, + 0); + break; + case ERTS_IOLIST_OVERFLOW: + overflow: + ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT); + break; + case ERTS_IOLIST_TYPE: + type_error: + default: + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + break; + } + } } - - BIF_RET(bin); + + return ret; } BIF_RETTYPE split_binary_2(BIF_ALIST_2) @@ -605,123 +1058,353 @@ BIF_RETTYPE split_binary_2(BIF_ALIST_2) * Local functions. */ +static int +list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp); + /* * The input list is assumed to be type-correct and the buffer is * assumed to be of sufficient size. Those assumptions are verified in * the DEBUG-built emulator. */ -static int +static ErlDrvSizeT +list_to_bitstr_buf(int yield_support, ErtsIOList2BufState *state) +{ + +#undef LIST_TO_BITSTR_BUF_BCOPY_DBG +#undef LIST_TO_BITSTR_BUF_BCOPY #ifdef DEBUG -list_to_bitstr_buf(Eterm obj, char* buf, Uint len) +#define LIST_TO_BITSTR_BUF_BCOPY_DBG \ + len -= size + (offset>7); #else -list_to_bitstr_buf(Eterm obj, char* buf) +#define LIST_TO_BITSTR_BUF_BCOPY_DBG #endif -{ - Eterm* objp; - int offset = 0; +#define LIST_TO_BITSTR_BUF_BCOPY(CONSP) \ + do { \ + byte* bptr; \ + Uint bitsize; \ + Uint bitoffs; \ + Uint num_bits; \ + size_t size = binary_size(obj); \ + if (yield_support) { \ + size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \ + if (yield_count > 0) \ + max_size *= yield_count+1; \ + if (size > max_size) { \ + state->objp = CONSP; \ + goto L_bcopy_yield; \ + } \ + if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \ + int cost = (int) size; \ + cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \ + yield_count -= cost; \ + } \ + } \ + ASSERT(size <= len); \ + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \ + num_bits = 8*size+bitsize; \ + copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); \ + offset += bitsize; \ + buf += size + (offset>7); \ + LIST_TO_BITSTR_BUF_BCOPY_DBG; \ + offset = offset & 7; \ + } while(0) + +#ifdef DEBUG + ErlDrvSizeT len; +#endif + Eterm obj; + char *buf; + Eterm *objp = NULL; + int offset; + int init_yield_count = 0, yield_count; DECLARE_ESTACK(s); - goto L_again; - - while (!ESTACK_ISEMPTY(s)) { - obj = ESTACK_POP(s); - L_again: - if (is_list(obj)) { - L_iter_list: - objp = list_val(obj); - obj = CAR(objp); - if (is_byte(obj)) { - ASSERT(len > 0); - if (offset == 0) { - *buf++ = unsigned_val(obj); - } else { - *buf = (char)((unsigned_val(obj) >> offset) | - ((*buf >> (8-offset)) << (8-offset))); - buf++; - *buf = (unsigned_val(obj) << (8-offset)); - } + + obj = state->iolist.obj; + buf = state->buf; + offset = state->offset; #ifdef DEBUG - len--; + len = state->len; #endif - } else if (is_binary(obj)) { - byte* bptr; - size_t size = binary_size(obj); - Uint bitsize; - Uint bitoffs; - Uint num_bits; - - ASSERT(size <= len); - ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); - num_bits = 8*size+bitsize; - copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); - offset += bitsize; - buf += size + (offset>7); + + if (!yield_support) { + yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */ + goto L_again; + } + else { + + if (state->iolist.reds_left <= 0) + return ERTS_IOLIST_TO_BUF_YIELD; + + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED + * state->iolist.reds_left); + yield_count = init_yield_count; + + if (!state->iolist.estack.start) + goto L_again; + else { + int chk_stack; + /* Restart; restore state... */ + ESTACK_RESTORE(s, &state->iolist.estack); + + if (!state->bcopy.bptr) + chk_stack = 0; + else { + chk_stack = 1; + if (list_to_bitstr_buf_bcopy(state, THE_NON_VALUE, &yield_count)) { + /* Yield again... */ + BUMP_ALL_REDS(state->iolist.c_p); + state->iolist.reds_left = 0; + ESTACK_SAVE(s, &state->iolist.estack); + return ERTS_IOLIST_TO_BUF_YIELD; + } + buf = state->buf; + offset = state->offset; #ifdef DEBUG - len -= size + (offset>7); + len = state->len; #endif - offset = offset & 7; - } else if (is_list(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto L_iter_list; /* on head */ - } else { - ASSERT(is_nil(obj)); } - obj = CDR(objp); - if (is_list(obj)) { - goto L_iter_list; /* on tail */ - } else if (is_binary(obj)) { - byte* bptr; - size_t size = binary_size(obj); - Uint bitsize; - Uint bitoffs; - Uint num_bits; - - ASSERT(size <= len); - ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); - num_bits = 8*size+bitsize; - copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); - offset += bitsize; - buf += size+(offset>7); + objp = state->objp; + state->objp = NULL; + + if (objp) + goto L_tail; + if (!chk_stack) + goto L_again; + /* check stack */ + } + } + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_again: + if (is_list(obj)) { + while (1) { /* Tail loop */ + while (1) { /* Head loop */ + if (yield_support && --yield_count <= 0) + goto L_yield; + objp = list_val(obj); + obj = CAR(objp); + if (is_byte(obj)) { + ASSERT(len > 0); + if (offset == 0) { + *buf++ = unsigned_val(obj); + } else { + *buf = (char)((unsigned_val(obj) >> offset) | + ((*buf >> (8-offset)) << (8-offset))); + buf++; + *buf = (unsigned_val(obj) << (8-offset)); + } #ifdef DEBUG - len -= size+(offset>7); + len--; #endif - offset = offset & 7; - } else { - ASSERT(is_nil(obj)); + } else if (is_binary(obj)) { + LIST_TO_BITSTR_BUF_BCOPY(objp); + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + continue; /* Head loop */ + } else { + ASSERT(is_nil(obj)); + } + break; + } + + L_tail: + + obj = CDR(objp); + if (is_list(obj)) { + continue; /* Tail loop */ + } else if (is_binary(obj)) { + LIST_TO_BITSTR_BUF_BCOPY(NULL); + } else { + ASSERT(is_nil(obj)); + } + break; } } else if (is_binary(obj)) { - byte* bptr; - size_t size = binary_size(obj); - Uint bitsize; - Uint bitoffs; - Uint num_bits; - - ASSERT(size <= len); - ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); - num_bits = 8*size+bitsize; - copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); - offset += bitsize; - buf += size + (offset>7); -#ifdef DEBUG - len -= size + (offset>7); -#endif - offset = offset & 7; + LIST_TO_BITSTR_BUF_BCOPY(NULL); } else { + if (yield_support && --yield_count <= 0) + goto L_yield; ASSERT(is_nil(obj)); } } DESTROY_ESTACK(s); - return offset; + + if (yield_support) { + int reds; + CLEAR_SAVED_ESTACK(&state->iolist.estack); + reds = ((init_yield_count - yield_count - 1) + / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1; + BUMP_REDS(state->iolist.c_p, reds); + state->iolist.reds_left -= reds; + if (state->iolist.reds_left < 0) + state->iolist.reds_left = 0; + } + state->buf = buf; + state->offset = offset; + return 0; + +L_bcopy_yield: + + state->buf = buf; + state->offset = offset; +#ifdef DEBUG + state->len = len; +#endif + + if (list_to_bitstr_buf_bcopy(state, obj, &yield_count) == 0) + ERTS_INTERNAL_ERROR("Missing yield"); + + BUMP_ALL_REDS(state->iolist.c_p); + state->iolist.reds_left = 0; + ESTACK_SAVE(s, &state->iolist.estack); + return ERTS_IOLIST_TO_BUF_YIELD; + +L_yield: + + BUMP_ALL_REDS(state->iolist.c_p); + state->iolist.reds_left = 0; + state->iolist.obj = obj; + state->buf = buf; + state->offset = offset; + ESTACK_SAVE(s, &state->iolist.estack); +#ifdef DEBUG + state->len = len; +#endif + return ERTS_IOLIST_TO_BUF_YIELD; + + +#undef LIST_TO_BITSTR_BUF_BCOPY_DBG +#undef LIST_TO_BITSTR_BUF_BCOPY + +} + +static ErlDrvSizeT +list_to_bitstr_buf_yielding(ErtsIOList2BufState *state) +{ + return list_to_bitstr_buf(1, state); +} + +static ErlDrvSizeT +list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *state) +{ + return list_to_bitstr_buf(0, state); } static int -bitstr_list_len(Eterm obj, Uint* num_bytes) +list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp) +{ + int res; + char *buf = state->buf; + char *next_buf; + int offset = state->offset; + int next_offset; +#ifdef DEBUG + ErlDrvSizeT len = state->len; + ErlDrvSizeT next_len; +#endif + byte* bptr; + size_t size; + size_t max_size; + Uint bitoffs; + Uint num_bits; + Uint bitsize; + int yield_count = *yield_countp; + + if (state->bcopy.bptr) { + bptr = state->bcopy.bptr; + size = state->bcopy.size; + bitoffs = state->bcopy.bitoffs; + bitsize = state->bcopy.bitsize; + state->bcopy.bptr = NULL; + } + else { + + ASSERT(is_binary(obj)); + + size = binary_size(obj); + + ASSERT(size <= len); + + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + } + + max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; + if (yield_count > 0) + max_size *= (size_t) (yield_count+1); + + if (size <= max_size) { + if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { + int cost = (int) size; + cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; + yield_count -= cost; + } + next_offset = offset + bitsize; + next_buf = buf + size+(next_offset>7); +#ifdef DEBUG + next_len = len - size+(next_offset>7); +#endif + next_offset &= 7; + num_bits = 8*size+bitsize; + res = 0; + } + else { + ASSERT(0 < max_size && max_size < size); + yield_count = 0; + state->bcopy.bptr = bptr + max_size; + state->bcopy.bitoffs = bitoffs; + state->bcopy.bitsize = bitsize; + state->bcopy.size = size - max_size; + next_buf = buf + max_size; +#ifdef DEBUG + next_len = len - max_size; +#endif + next_offset = offset; + num_bits = 8*max_size; + size = max_size; + res = 1; + } + + copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); + + state->offset = next_offset; + state->buf = next_buf; +#ifdef DEBUG + state->len = next_len; +#endif + *yield_countp = yield_count; + + return res; +} + +static int +bitstr_list_len(ErtsIOListState *state) { Eterm* objp; - Uint len = 0; - Uint offs = 0; + Eterm obj; + Uint len, offs; + int res, init_yield_count, yield_count; DECLARE_ESTACK(s); + + if (state->reds_left <= 0) + return ERTS_IOLIST_YIELD; + + len = (Uint) state->size; + offs = state->offs; + obj = state->obj; + + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED; + init_yield_count *= state->reds_left; + yield_count = init_yield_count; + if (state->estack.start) { + /* Restart; restore estack... */ + ESTACK_RESTORE(s, &state->estack); + } + goto L_again; #define SAFE_ADD(Var, Val) \ @@ -748,46 +1431,55 @@ bitstr_list_len(Eterm obj, Uint* num_bytes) obj = ESTACK_POP(s); L_again: if (is_list(obj)) { - L_iter_list: - objp = list_val(obj); - /* Head */ - obj = CAR(objp); - if (is_byte(obj)) { - len++; - if (len == 0) { - goto L_overflow_error; + while (1) { /* Tail loop */ + while (1) { /* Head loop */ + if (--yield_count <= 0) + goto L_yield; + objp = list_val(obj); + /* Head */ + obj = CAR(objp); + if (is_byte(obj)) { + len++; + if (len == 0) { + goto L_overflow_error; + } + } else if (is_binary(obj)) { + SAFE_ADD(len, binary_size(obj)); + SAFE_ADD_BITSIZE(offs, obj); + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + continue; /* Head loop */ + } else if (is_not_nil(obj)) { + goto L_type_error; + } + break; } - } else if (is_binary(obj)) { - SAFE_ADD(len, binary_size(obj)); - SAFE_ADD_BITSIZE(offs, obj); - } else if (is_list(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto L_iter_list; /* on head */ - } else if (is_not_nil(obj)) { - goto L_type_error; + /* Tail */ + obj = CDR(objp); + if (is_list(obj)) + continue; /* Tail loop */ + else if (is_binary(obj)) { + SAFE_ADD(len, binary_size(obj)); + SAFE_ADD_BITSIZE(offs, obj); + } else if (is_not_nil(obj)) { + goto L_type_error; + } + break; } - /* Tail */ - obj = CDR(objp); - if (is_list(obj)) - goto L_iter_list; /* on tail */ - else if (is_binary(obj)) { + } else { + if (--yield_count <= 0) + goto L_yield; + if (is_binary(obj)) { SAFE_ADD(len, binary_size(obj)); SAFE_ADD_BITSIZE(offs, obj); } else if (is_not_nil(obj)) { goto L_type_error; } - } else if (is_binary(obj)) { - SAFE_ADD(len, binary_size(obj)); - SAFE_ADD_BITSIZE(offs, obj); - } else if (is_not_nil(obj)) { - goto L_type_error; } } #undef SAFE_ADD #undef SAFE_ADD_BITSIZE - DESTROY_ESTACK(s); - /* * Make sure that the number of bits in the bitstring will fit * in an Uint to ensure that the binary can be matched using @@ -800,15 +1492,42 @@ bitstr_list_len(Eterm obj, Uint* num_bytes) if (len << 3 < len) { goto L_overflow_error; } - *num_bytes = len; - return ERTS_IOLIST_OK; + state->size = len; - L_type_error: - DESTROY_ESTACK(s); - return ERTS_IOLIST_TYPE; + res = ERTS_IOLIST_OK; + + L_return: { + int yc = init_yield_count - yield_count; + int reds; + + DESTROY_ESTACK(s); + CLEAR_SAVED_ESTACK(&state->estack); + + reds = (yc - 1)/ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED + 1; + BUMP_REDS(state->c_p, reds); + state->reds_left -= reds; + state->size = (ErlDrvSizeT) len; + state->have_size = 1; + return res; + } L_overflow_error: - DESTROY_ESTACK(s); - return ERTS_IOLIST_OVERFLOW; + res = ERTS_IOLIST_OVERFLOW; + len = 0; + goto L_return; + + L_type_error: + res = ERTS_IOLIST_TYPE; + len = 0; + goto L_return; + + L_yield: + BUMP_ALL_REDS(state->c_p); + state->reds_left = 0; + state->size = len; + state->offs = offs; + state->obj = obj; + ESTACK_SAVE(s, &state->estack); + return ERTS_IOLIST_YIELD; } diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index ff775691b3..7e0e825a0d 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -2294,18 +2294,11 @@ BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1) BIF_ERROR(BIF_P,BADARG); } -/* - * Ok, erlang:list_to_binary does not interrupt, and we really don't want - * an alternative implementation for the exact same thing, why we - * have descided to use the old non-restarting implementation for now. - * In reality, there are seldom many iterations involved in doing this, so the - * problem of long-running bifs is not really that big in this case. - * So, for now we use the old implementation also in the module binary. - */ +HIPE_WRAPPER_BIF_DISABLE_GC(binary_list_to_bin, 1) BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1) { - return erts_list_to_binary_bif(BIF_P, BIF_ARG_1); + return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_binary_list_to_bin_1]); } typedef struct { diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 2adba9b240..4d5e55aaf5 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2691,6 +2691,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("ets_limit",BIF_ARG_1)) { BIF_RET(make_small(erts_db_get_max_tabs())); } + else if (ERTS_IS_ATOM_STR("tolerant_timeofday",BIF_ARG_1)) { + BIF_RET(erts_disable_tolerant_timeofday + ? am_disabled + : am_enabled); + } BIF_ERROR(BIF_P, BADARG); } diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 819b19e566..6c9f53ce87 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -166,7 +166,7 @@ Eterm erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size, * Common implementation for erlang:list_to_binary/1 and binary:list_to_bin/1 */ -BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg); +BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg, Export *bif); BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple); BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen); diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 3ecb379326..5ced8c5ca0 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -198,7 +198,7 @@ typedef long long ErlDrvSInt64; #error No 64-bit integer type #endif -#if defined(__WIN32__) +#if defined(__WIN32__) || defined(_WIN32) typedef ErlDrvUInt ErlDrvSizeT; typedef ErlDrvSInt ErlDrvSSizeT; #else diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index d54658f1ea..5e6d812242 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -324,7 +324,6 @@ erl_init(int ncpu, BIN_VH_MIN_SIZE = erts_next_heap_size(BIN_VH_MIN_SIZE, 0); erts_init_trace(); - erts_init_binary(); erts_init_bits(); erts_code_ix_init(); erts_init_fun_table(); @@ -337,6 +336,7 @@ erl_init(int ncpu, erts_ddll_init(); init_emulator(); erts_ptab_init(); /* Must be after init_emulator() */ + erts_init_binary(); /* Must be after init_emulator() */ erts_bp_init(); init_db(); /* Must be after init_emulator */ erts_bif_timer_init(); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 0eb8117980..59a677a12c 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1032,7 +1032,6 @@ erts_send_message(Process* sender, } BM_SWAP_TIMER(send,system); } else { -#ifdef ERTS_SMP ErlOffHeap *ohp; Eterm *hp; erts_aint32_t state; @@ -1064,42 +1063,6 @@ erts_send_message(Process* sender, #endif ); BM_SWAP_TIMER(send,system); -#else - ErlMessage* mp = message_alloc(); - Eterm *hp; - BM_SWAP_TIMER(send,size); - msize = size_object(message); - BM_SWAP_TIMER(size,send); - - if (receiver->stop - receiver->htop <= msize) { - BM_SWAP_TIMER(send,system); - erts_garbage_collect(receiver, msize, receiver->arg_reg, receiver->arity); - BM_SWAP_TIMER(system,send); - } - hp = receiver->htop; - receiver->htop = hp + msize; - BM_SWAP_TIMER(send,copy); - message = copy_struct(message, msize, &hp, &receiver->off_heap); - BM_MESSAGE_COPIED(msize); - BM_SWAP_TIMER(copy,send); - DTRACE6(message_send, sender_name, receiver_name, - (uint32_t)msize, tok_label, tok_lastcnt, tok_serial); - ERL_MESSAGE_TERM(mp) = message; - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; -#endif - mp->next = NULL; - mp->data.attached = NULL; - LINK_MESSAGE(receiver, mp); - res = receiver->msg.len; - erts_proc_notify_new_message(receiver); - - if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { - trace_receive(receiver, message); - } - BM_SWAP_TIMER(send,system); -#endif /* #ifndef ERTS_SMP */ } return res; } diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 3a968594f3..f8e1431a53 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -2126,6 +2126,8 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes) mac = 1; case ERL_FILENAME_UTF8: size = strlen((char *) bytes); + if (size == 0) + return NIL; if (erts_analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != ERTS_UTF8_OK) { goto noconvert; } diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 656de7c49a..8d240355b0 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -44,9 +44,6 @@ #include "erl_zlib.h" #include "erl_map.h" -#ifdef HIPE -#include "hipe_mode_switch.h" -#endif #define in_area(ptr,start,nbytes) ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) #define MAX_STRING_LEN 0xffff @@ -111,26 +108,17 @@ static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acm static Export binary_to_term_trap_export; static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1); -static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b); +static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b, + Export *bif, Eterm arg0, Eterm arg1); void erts_init_external(void) { -#if 1 /* In R16 */ erts_init_trap_export(&term_to_binary_trap_export, - am_erlang, am_term_to_binary_trap, 1, + am_erts_internal, am_term_to_binary_trap, 1, &term_to_binary_trap_1); erts_init_trap_export(&binary_to_term_trap_export, - am_erlang, am_binary_to_term_trap, 1, + am_erts_internal, am_binary_to_term_trap, 1, &binary_to_term_trap_1); -#else - sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export)); - term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3]; - term_to_binary_trap_export.code[0] = am_erlang; - term_to_binary_trap_export.code[1] = am_term_to_binary_trap; - term_to_binary_trap_export.code[2] = 1; - term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif; - term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1; -#endif return; } @@ -1069,6 +1057,8 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) } } +HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 1) + BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL); @@ -1081,6 +1071,8 @@ BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) } } +HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 2) + BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) { Process* p = BIF_P; @@ -1185,6 +1177,8 @@ typedef struct B2TContext_t { Uint32 flags; SWord reds; Eterm trap_bin; + Export *bif; + Eterm arg[2]; enum B2TState state; union { B2TSizeContext sc; @@ -1356,7 +1350,8 @@ static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1) Binary *context_bin = ((ProcBin *) binary_val(BIF_ARG_1))->val; ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor); - return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin); + return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL, + THE_NON_VALUE, THE_NON_VALUE); } @@ -1391,8 +1386,10 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src) return ctx; } -static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b) +static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b, + Export *bif_init, Eterm arg0, Eterm arg1) { + BIF_RETTYPE ret_val; #ifdef EXTREME_B2T_TRAPPING SWord initial_reds = 1 + b2t_rand() % 4; #else @@ -1409,6 +1406,9 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con ctx->state = B2TPrepare; ctx->aligned_alloc = NULL; ctx->flags = flags; + ctx->bif = bif_init; + ctx->arg[0] = arg0; + ctx->arg[1] = arg1; IF_DEBUG(ctx->trap_bin = THE_NON_VALUE;) } else { is_first_call = 0; @@ -1504,12 +1504,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con HRelease(p, ctx->u.dc.hp_end, ctx->u.dc.hp_start); /*fall through*/ case B2TBadArg: - b2t_destroy_context(ctx); - if (!is_first_call) { - erts_set_gc_state(p, 1); - } BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION); - BIF_ERROR(p, BADARG & ~EXF_SAVETRACE); + + ASSERT(ctx->bif == bif_export[BIF_binary_to_term_1] + || ctx->bif == bif_export[BIF_binary_to_term_2]); + + if (is_first_call) + ERTS_BIF_PREP_ERROR(ret_val, p, BADARG); + else { + erts_set_gc_state(p, 1); + if (is_non_value(ctx->arg[1])) + ERTS_BIF_PREP_ERROR_TRAPPED1(ret_val, p, BADARG, ctx->bif, + ctx->arg[0]); + else + ERTS_BIF_PREP_ERROR_TRAPPED2(ret_val, p, BADARG, ctx->bif, + ctx->arg[0], ctx->arg[1]); + } + b2t_destroy_context(ctx); + return ret_val; case B2TDone: b2t_destroy_context(ctx); @@ -1524,7 +1536,8 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con erts_set_gc_state(p, 1); } BUMP_REDS(p, (initial_reds - ctx->reds) / B2T_BYTES_PER_REDUCTION); - return ctx->u.dc.res; + ERTS_BIF_PREP_RET(ret_val, ctx->u.dc.res); + return ret_val; default: ASSERT(!"Unknown state in binary_to_term"); @@ -1541,15 +1554,24 @@ static Eterm binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* con erts_set_gc_state(p, 0); } BUMP_ALL_REDS(p); - BIF_TRAP1(&binary_to_term_trap_export, p, ctx->trap_bin); + + ERTS_BIF_PREP_TRAP1(ret_val, &binary_to_term_trap_export, + p, ctx->trap_bin); + + return ret_val; } -BIF_RETTYPE erts_internal_binary_to_term_1(BIF_ALIST_1) +HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 1) + +BIF_RETTYPE binary_to_term_1(BIF_ALIST_1) { - return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL); + return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_1], + BIF_ARG_1, THE_NON_VALUE); } -BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2) +HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 2) + +BIF_RETTYPE binary_to_term_2(BIF_ALIST_2) { Eterm opts; Eterm opt; @@ -1570,7 +1592,8 @@ BIF_RETTYPE erts_internal_binary_to_term_2(BIF_ALIST_2) if (is_not_nil(opts)) goto error; - return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL); + return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_2], + BIF_ARG_1, BIF_ARG_2); error: BIF_ERROR(BIF_P, BADARG); @@ -4440,66 +4463,3 @@ error: #undef SKIP2 #undef CHKSIZE } - - -#ifdef HIPE -BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1); -BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2); -BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1); -BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2); - -/* Hipe wrappers used by native code for BIFs that disable GC while trapping. - * - * Problem: - * When native code calls a BIF that traps, hipe_mode_switch will push a - * "trap frame" on the Erlang stack in order to find its way back from beam_emu - * back to native caller when finally done. If GC is disabled and stack/heap - * is full there is no place to push the "trap frame". - * - * Solution: - * We reserve space on stack for the "trap frame" here before the BIF is called. - * If the BIF does not trap, the space is reclaimed here before returning. - * If the BIF traps, hipe_push_beam_trap_frame() will detect that a "trap frame" - * already is reserved and use it. - */ -BIF_RETTYPE hipe_wrapper_term_to_binary_1(BIF_ALIST_1) -{ - Eterm res; - hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1); - res = term_to_binary_1(BIF_P, BIF__ARGS); - if (is_value(res) || BIF_P->freason != TRAP) { - hipe_unreserve_beam_trap_frame(BIF_P); - } - return res; -} -BIF_RETTYPE hipe_wrapper_term_to_binary_2(BIF_ALIST_2) -{ - Eterm res; - hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2); - res = term_to_binary_2(BIF_P, BIF__ARGS); - if (is_value(res) || BIF_P->freason != TRAP) { - hipe_unreserve_beam_trap_frame(BIF_P); - } - return res; -} -BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_1(BIF_ALIST_1) -{ - Eterm res; - hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 1); - res = erts_internal_binary_to_term_1(BIF_P, BIF__ARGS); - if (is_value(res) || BIF_P->freason != TRAP) { - hipe_unreserve_beam_trap_frame(BIF_P); - } - return res; -} -BIF_RETTYPE hipe_wrapper_erts_internal_binary_to_term_2(BIF_ALIST_2) -{ - Eterm res; - hipe_reserve_beam_trap_frame(BIF_P, BIF__ARGS, 2); - res = erts_internal_binary_to_term_2(BIF_P, BIF__ARGS); - if (is_value(res) || BIF_P->freason != TRAP) { - hipe_unreserve_beam_trap_frame(BIF_P); - } - return res; -} -#endif /*HIPE*/ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 8fcb95d0e2..891046a8b5 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -435,6 +435,8 @@ do {\ }\ } while(0) +#define CLEAR_SAVED_ESTACK(estack) ((void) ((estack)->start = NULL)) + /* * Use on empty stack, only the allocator can be changed before this. * The src stack is reset to NULL. @@ -551,6 +553,8 @@ do {\ }\ } while(0) +#define CLEAR_SAVED_WSTACK(wstack) ((void) ((wstack)->wstart = NULL)) + /* * Use on empty stack, only the allocator can be changed before this. * The src stack is reset to NULL. @@ -951,20 +955,67 @@ struct Sint_buf { }; char* Sint_to_buf(Sint, struct Sint_buf*); +#define ERTS_IOLIST_STATE_INITER(C_P, OBJ) \ + {(C_P), 0, 0, (OBJ), {NULL, NULL, NULL, ERTS_ALC_T_INVALID}, 0, 0} + +#define ERTS_IOLIST_STATE_MOVE(TO, FROM) \ + sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOListState)) + +#define ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED 8 + +typedef struct { + Process *c_p; + ErlDrvSizeT size; + Uint offs; + Eterm obj; + ErtsEStack estack; + int reds_left; + int have_size; +} ErtsIOListState; + +#define ERTS_IOLIST2BUF_STATE_INITER(C_P, OBJ) \ + {ERTS_IOLIST_STATE_INITER((C_P), (OBJ)), {NULL, 0, 0, 0}, NULL, 0, NULL, 0} + +#define ERTS_IOLIST2BUF_STATE_MOVE(TO, FROM) \ + sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOList2BufState)) + +#define ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT 32 +#define ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED 8 +#define ERTS_IOLIST_TO_BUF_BYTES_PER_RED \ + (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED*ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) + +typedef struct { + ErtsIOListState iolist; + struct { + byte *bptr; + size_t size; + Uint bitoffs; + Uint bitsize; + } bcopy; + char *buf; + ErlDrvSizeT len; + Eterm *objp; + int offset; +} ErtsIOList2BufState; + #define ERTS_IOLIST_OK 0 #define ERTS_IOLIST_OVERFLOW 1 #define ERTS_IOLIST_TYPE 2 +#define ERTS_IOLIST_YIELD 3 Eterm buf_to_intlist(Eterm**, const char*, size_t, Eterm); /* most callers pass plain char*'s */ #define ERTS_IOLIST_TO_BUF_OVERFLOW (~((ErlDrvSizeT) 0)) #define ERTS_IOLIST_TO_BUF_TYPE_ERROR (~((ErlDrvSizeT) 1)) +#define ERTS_IOLIST_TO_BUF_YIELD (~((ErlDrvSizeT) 2)) #define ERTS_IOLIST_TO_BUF_FAILED(R) \ - (((R) & (~((ErlDrvSizeT) 1))) == (~((ErlDrvSizeT) 1))) + (((R) & (~((ErlDrvSizeT) 3))) == (~((ErlDrvSizeT) 3))) #define ERTS_IOLIST_TO_BUF_SUCCEEDED(R) \ (!ERTS_IOLIST_TO_BUF_FAILED((R))) ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT); +ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *); +int erts_iolist_size_yielding(ErtsIOListState *state); int erts_iolist_size(Eterm, ErlDrvSizeT *); int is_string(Eterm); void erl_at_exit(void (*) (void*), void*); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 738f793020..72092ec7b0 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -3197,106 +3197,303 @@ buf_to_intlist(Eterm** hpp, const char *buf, size_t len, Eterm tail) ** */ -ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len) +typedef enum { + ERTS_IL2B_BCOPY_OK, + ERTS_IL2B_BCOPY_YIELD, + ERTS_IL2B_BCOPY_OVERFLOW, + ERTS_IL2B_BCOPY_TYPE_ERROR +} ErtsIL2BBCopyRes; + +static ErtsIL2BBCopyRes +iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp); + +static ERTS_INLINE ErlDrvSizeT +iolist_to_buf(const int yield_support, + ErtsIOList2BufState *state, + Eterm obj, + char* buf, + ErlDrvSizeT alloced_len) { - ErlDrvSizeT len = (ErlDrvSizeT) alloced_len; - Eterm* objp; +#undef IOLIST_TO_BUF_BCOPY +#define IOLIST_TO_BUF_BCOPY(CONSP) \ +do { \ + size_t size = binary_size(obj); \ + if (size > 0) { \ + Uint bitsize; \ + byte* bptr; \ + Uint bitoffs; \ + Uint num_bits; \ + if (yield_support) { \ + size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \ + if (yield_count > 0) \ + max_size *= yield_count+1; \ + if (size > max_size) { \ + state->objp = CONSP; \ + goto L_bcopy_yield; \ + } \ + if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \ + int cost = (int) size; \ + cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \ + yield_count -= cost; \ + } \ + } \ + if (len < size) \ + goto L_overflow; \ + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \ + if (bitsize != 0) \ + goto L_type_error; \ + num_bits = 8*size; \ + copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); \ + buf += size; \ + len -= size; \ + } \ +} while (0) + + ErlDrvSizeT res, len; + Eterm* objp = NULL; + int init_yield_count; + int yield_count; DECLARE_ESTACK(s); - goto L_again; - - while (!ESTACK_ISEMPTY(s)) { - obj = ESTACK_POP(s); - L_again: - if (is_list(obj)) { - L_iter_list: - objp = list_val(obj); - obj = CAR(objp); - if (is_byte(obj)) { - if (len == 0) { - goto L_overflow; - } - *buf++ = unsigned_val(obj); - len--; - } else if (is_binary(obj)) { - byte* bptr; - size_t size = binary_size(obj); - Uint bitsize; - Uint bitoffs; - Uint num_bits; - - if (len < size) { + + len = (ErlDrvSizeT) alloced_len; + + if (!yield_support) { + yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */ + goto L_again; + } + else { + + if (state->iolist.reds_left <= 0) + return ERTS_IOLIST_TO_BUF_YIELD; + + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED + * state->iolist.reds_left); + yield_count = init_yield_count; + + if (!state->iolist.estack.start) + goto L_again; + else { + int chk_stack; + /* Restart; restore state... */ + ESTACK_RESTORE(s, &state->iolist.estack); + + if (!state->bcopy.bptr) + chk_stack = 0; + else { + chk_stack = 1; + switch (iolist_to_buf_bcopy(state, THE_NON_VALUE, &yield_count)) { + case ERTS_IL2B_BCOPY_OK: + break; + case ERTS_IL2B_BCOPY_YIELD: + BUMP_ALL_REDS(state->iolist.c_p); + state->iolist.reds_left = 0; + ESTACK_SAVE(s, &state->iolist.estack); + return ERTS_IOLIST_TO_BUF_YIELD; + case ERTS_IL2B_BCOPY_OVERFLOW: goto L_overflow; - } - ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); - if (bitsize != 0) { + case ERTS_IL2B_BCOPY_TYPE_ERROR: goto L_type_error; } - num_bits = 8*size; - copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); - buf += size; - len -= size; - } else if (is_list(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto L_iter_list; /* on head */ - } else if (is_not_nil(obj)) { - goto L_type_error; } - obj = CDR(objp); - if (is_list(obj)) { - goto L_iter_list; /* on tail */ - } else if (is_binary(obj)) { - byte* bptr; - size_t size = binary_size(obj); - Uint bitsize; - Uint bitoffs; - Uint num_bits; - if (len < size) { - goto L_overflow; + obj = state->iolist.obj; + buf = state->buf; + len = state->len; + objp = state->objp; + state->objp = NULL; + if (objp) + goto L_tail; + if (!chk_stack) + goto L_again; + /* check stack */ + } + } + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_again: + if (is_list(obj)) { + while (1) { /* Tail loop */ + while (1) { /* Head loop */ + if (yield_support && --yield_count <= 0) + goto L_yield; + objp = list_val(obj); + obj = CAR(objp); + if (is_byte(obj)) { + if (len == 0) { + goto L_overflow; + } + *buf++ = unsigned_val(obj); + len--; + } else if (is_binary(obj)) { + IOLIST_TO_BUF_BCOPY(objp); + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + continue; /* Head loop */ + } else if (is_not_nil(obj)) { + goto L_type_error; + } + break; } - ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); - if (bitsize != 0) { + + L_tail: + + obj = CDR(objp); + + if (is_list(obj)) { + continue; /* Tail loop */ + } else if (is_binary(obj)) { + IOLIST_TO_BUF_BCOPY(NULL); + } else if (is_not_nil(obj)) { goto L_type_error; } - num_bits = 8*size; - copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); - buf += size; - len -= size; - } else if (is_not_nil(obj)) { - goto L_type_error; + break; } } else if (is_binary(obj)) { - byte* bptr; - size_t size = binary_size(obj); - Uint bitsize; - Uint bitoffs; - Uint num_bits; - if (len < size) { - goto L_overflow; - } - ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); - if (bitsize != 0) { - goto L_type_error; - } - num_bits = 8*size; - copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); - buf += size; - len -= size; + IOLIST_TO_BUF_BCOPY(NULL); } else if (is_not_nil(obj)) { goto L_type_error; - } + } else if (yield_support && --yield_count <= 0) + goto L_yield; } + res = len; + + L_return: + DESTROY_ESTACK(s); - return len; + + if (yield_support) { + int reds; + CLEAR_SAVED_ESTACK(&state->iolist.estack); + reds = ((init_yield_count - yield_count - 1) + / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1; + BUMP_REDS(state->iolist.c_p, reds); + state->iolist.reds_left -= reds; + if (state->iolist.reds_left < 0) + state->iolist.reds_left = 0; + } + + + return res; L_type_error: - DESTROY_ESTACK(s); - return ERTS_IOLIST_TO_BUF_TYPE_ERROR; + res = ERTS_IOLIST_TO_BUF_TYPE_ERROR; + goto L_return; L_overflow: - DESTROY_ESTACK(s); - return ERTS_IOLIST_TO_BUF_OVERFLOW; + res = ERTS_IOLIST_TO_BUF_OVERFLOW; + goto L_return; + + L_bcopy_yield: + + state->buf = buf; + state->len = len; + + switch (iolist_to_buf_bcopy(state, obj, &yield_count)) { + case ERTS_IL2B_BCOPY_OK: + ERTS_INTERNAL_ERROR("Missing yield"); + case ERTS_IL2B_BCOPY_YIELD: + BUMP_ALL_REDS(state->iolist.c_p); + state->iolist.reds_left = 0; + ESTACK_SAVE(s, &state->iolist.estack); + return ERTS_IOLIST_TO_BUF_YIELD; + case ERTS_IL2B_BCOPY_OVERFLOW: + goto L_overflow; + case ERTS_IL2B_BCOPY_TYPE_ERROR: + goto L_type_error; + } + + L_yield: + + BUMP_ALL_REDS(state->iolist.c_p); + state->iolist.reds_left = 0; + state->iolist.obj = obj; + state->buf = buf; + state->len = len; + ESTACK_SAVE(s, &state->iolist.estack); + return ERTS_IOLIST_TO_BUF_YIELD; + +#undef IOLIST_TO_BUF_BCOPY +} + +static ErtsIL2BBCopyRes +iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp) +{ + ErtsIL2BBCopyRes res; + char *buf = state->buf; + ErlDrvSizeT len = state->len; + byte* bptr; + size_t size; + size_t max_size; + Uint bitoffs; + Uint num_bits; + int yield_count = *yield_countp; + + if (state->bcopy.bptr) { + bptr = state->bcopy.bptr; + size = state->bcopy.size; + bitoffs = state->bcopy.bitoffs; + state->bcopy.bptr = NULL; + } + else { + Uint bitsize; + + ASSERT(is_binary(obj)); + + size = binary_size(obj); + if (size <= 0) + return ERTS_IL2B_BCOPY_OK; + + if (len < size) + return ERTS_IL2B_BCOPY_OVERFLOW; + + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + if (bitsize != 0) + return ERTS_IL2B_BCOPY_TYPE_ERROR; + } + + ASSERT(size > 0); + max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; + if (yield_count > 0) + max_size *= (size_t) (yield_count+1); + + if (size <= max_size) { + if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { + int cost = (int) size; + cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; + yield_count -= cost; + } + res = ERTS_IL2B_BCOPY_OK; + } + else { + ASSERT(0 < max_size && max_size < size); + yield_count = 0; + state->bcopy.bptr = bptr + max_size; + state->bcopy.bitoffs = bitoffs; + state->bcopy.size = size - max_size; + size = max_size; + res = ERTS_IL2B_BCOPY_YIELD; + } + + num_bits = 8*size; + copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); + state->buf += size; + state->len -= size; + *yield_countp = yield_count; + + return res; +} + +ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *state) +{ + return iolist_to_buf(1, state, state->iolist.obj, state->buf, state->len); +} + +ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len) +{ + return iolist_to_buf(0, NULL, obj, buf, alloced_len); } /* @@ -3307,11 +3504,32 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len) * Any input term error detected in erts_iolist_to_buf should also * be detected in this function! */ -int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep) + +static ERTS_INLINE int +iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSizeT* sizep) { + int res, init_yield_count, yield_count; Eterm* objp; - Uint size = 0; /* Intentionally Uint due to halfword heap */ + Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */ DECLARE_ESTACK(s); + + if (!yield_support) + yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */ + else { + if (state->reds_left <= 0) + return ERTS_IOLIST_YIELD; + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED; + init_yield_count *= state->reds_left; + yield_count = init_yield_count; + if (state->estack.start) { + /* Restart; restore state... */ + ESTACK_RESTORE(s, &state->estack); + size = (Uint) state->size; + obj = state->obj; + } + } + goto L_again; #define SAFE_ADD(Var, Val) \ @@ -3327,51 +3545,101 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep) obj = ESTACK_POP(s); L_again: if (is_list(obj)) { - L_iter_list: - objp = list_val(obj); - /* Head */ - obj = CAR(objp); - if (is_byte(obj)) { - size++; - if (size == 0) { - goto L_overflow_error; + while (1) { /* Tail loop */ + while (1) { /* Head loop */ + if (yield_support && --yield_count <= 0) + goto L_yield; + objp = list_val(obj); + /* Head */ + obj = CAR(objp); + if (is_byte(obj)) { + size++; + if (size == 0) { + goto L_overflow_error; + } + } else if (is_binary(obj) && binary_bitsize(obj) == 0) { + SAFE_ADD(size, binary_size(obj)); + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + continue; /* Head loop */ + } else if (is_not_nil(obj)) { + goto L_type_error; + } + break; } - } else if (is_binary(obj) && binary_bitsize(obj) == 0) { - SAFE_ADD(size, binary_size(obj)); - } else if (is_list(obj)) { - ESTACK_PUSH(s, CDR(objp)); - goto L_iter_list; /* on head */ - } else if (is_not_nil(obj)) { - goto L_type_error; + /* Tail */ + obj = CDR(objp); + if (is_list(obj)) + continue; /* Tail loop */ + else if (is_binary(obj) && binary_bitsize(obj) == 0) { + SAFE_ADD(size, binary_size(obj)); + } else if (is_not_nil(obj)) { + goto L_type_error; + } + break; } - /* Tail */ - obj = CDR(objp); - if (is_list(obj)) - goto L_iter_list; /* on tail */ - else if (is_binary(obj) && binary_bitsize(obj) == 0) { + } else { + if (yield_support && --yield_count <= 0) + goto L_yield; + if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */ SAFE_ADD(size, binary_size(obj)); } else if (is_not_nil(obj)) { goto L_type_error; } - } else if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */ - SAFE_ADD(size, binary_size(obj)); - } else if (is_not_nil(obj)) { - goto L_type_error; } } #undef SAFE_ADD - DESTROY_ESTACK(s); *sizep = (ErlDrvSizeT) size; - return ERTS_IOLIST_OK; - L_overflow_error: + res = ERTS_IOLIST_OK; + + L_return: + DESTROY_ESTACK(s); - return ERTS_IOLIST_OVERFLOW; + + if (yield_support) { + int yc, reds; + CLEAR_SAVED_ESTACK(&state->estack); + yc = init_yield_count - yield_count; + reds = ((yc - 1) / ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED) + 1; + BUMP_REDS(state->c_p, reds); + state->reds_left -= reds; + state->size = (ErlDrvSizeT) size; + state->have_size = 1; + } + + return res; + + L_overflow_error: + res = ERTS_IOLIST_OVERFLOW; + size = 0; + goto L_return; L_type_error: - DESTROY_ESTACK(s); - return ERTS_IOLIST_TYPE; + res = ERTS_IOLIST_TYPE; + size = 0; + goto L_return; + + L_yield: + BUMP_ALL_REDS(state->c_p); + state->reds_left = 0; + state->size = size; + state->obj = obj; + ESTACK_SAVE(s, &state->estack); + return ERTS_IOLIST_YIELD; +} + +int erts_iolist_size_yielding(ErtsIOListState *state) +{ + ErlDrvSizeT size = state->size; + return iolist_size(1, state, state->obj, &size); +} + +int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep) +{ + *sizep = 0; + return iolist_size(0, NULL, obj, sizep); } /* return 0 if item is not a non-empty flat list of bytes */ diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 42f41c5f3d..878beb055b 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -360,7 +360,12 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ int fd; int mode; /* Open mode. */ - if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) { + if (stat(name, &statbuf) < 0) { + /* statbuf is undefined: if the caller depends on it, + i.e. invoke_read_file(), fail the call immediately */ + if (pSize && flags == EFILE_MODE_READ) + return check_error(-1, errInfo); + } else if (!ISREG(statbuf)) { /* * For UNIX only, here is some ugly code to allow * /dev/null to be opened as a file. diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 0997d81b2f..5f92b6bac4 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -268,9 +268,16 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc) */ define(CFUN,`ifelse($1,term_to_binary_1,hipe_wrapper_term_to_binary_1, ifelse($1,term_to_binary_2,hipe_wrapper_term_to_binary_2, -ifelse($1,erts_internal_binary_to_term_1,hipe_wrapper_erts_internal_binary_to_term_1, -ifelse($1,erts_internal_binary_to_term_2,hipe_wrapper_erts_internal_binary_to_term_2, -$1))))') +ifelse($1,binary_to_term_1,hipe_wrapper_binary_to_term_1, +ifelse($1,binary_to_term_2,hipe_wrapper_binary_to_term_2, +ifelse($1,binary_to_list_1,hipe_wrapper_binary_to_list_1, +ifelse($1,binary_to_list_3,hipe_wrapper_binary_to_list_3, +ifelse($1,bitstring_to_list_1,hipe_wrapper_bitstring_to_list_1, +ifelse($1,list_to_binary_1,hipe_wrapper_list_to_binary_1, +ifelse($1,iolist_to_binary_1,hipe_wrapper_iolist_to_binary_1, +ifelse($1,binary_list_to_bin_1,hipe_wrapper_binary_list_to_bin_1, +ifelse($1,list_to_bitstring_1,hipe_wrapper_list_to_bitstring_1, +$1)))))))))))') define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))') include(TARGET/`erl_bif_list.h') diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 7aba367e33..44e9e4f243 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -58,7 +58,8 @@ ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, - otp_8180/1, trapping/1]). + otp_8180/1, trapping/1, large/1, + error_after_yield/1, cmp_old_impl/1]). %% Internal exports. -export([sleeper/0,trapping_loop/4]). @@ -76,7 +77,8 @@ all() -> bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180, trapping]. + obsolete_funs, robustness, otp_8180, trapping, large, + error_after_yield, cmp_old_impl]. groups() -> []. @@ -1351,7 +1353,16 @@ trapping(Config) when is_list(Config)-> do_trapping(5, term_to_binary, fun() -> [lists:duplicate(2000000,2000000)] end), do_trapping(5, binary_to_term, - fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end). + fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end), + do_trapping(5, binary_to_list, + fun() -> [list_to_binary(lists:duplicate(2000000,$x))] end), + do_trapping(5, list_to_binary, + fun() -> [lists:duplicate(2000000,$x)] end), + do_trapping(5, bitstring_to_list, + fun() -> [list_to_bitstring([lists:duplicate(2000000,$x),<<7:4>>])] end), + do_trapping(5, list_to_bitstring, + fun() -> [[lists:duplicate(2000000,$x),<<7:4>>]] end) + . do_trapping(0, _, _) -> ok; @@ -1384,9 +1395,189 @@ trapping_loop2(Bif,Args,N) -> apply(erlang,Bif,Args), trapping_loop2(Bif, Args, N-1). +large(Config) when is_list(Config) -> + List = lists:flatten(lists:map(fun (_) -> + [0,1,2,3,4,5,6,7,8] + end, + lists:seq(1, 131072))), + Bin = list_to_binary(List), + List = binary_to_list(Bin), + PartList = lists:reverse(tl(tl(lists:reverse(tl(tl(List)))))), + PartList = binary_to_list(Bin, 3, length(List)-2), + ListBS = List ++ [<<7:4>>], + ListBS = bitstring_to_list(list_to_bitstring(ListBS)), + BitStr1 = list_to_bitstring(lists:duplicate(1024*1024, [<<1,5:3>>])), + BitStr1 = list_to_bitstring(bitstring_to_list(BitStr1)), + BitStr2 = list_to_bitstring([lists:duplicate(512*1024, [<<1,5:3>>]), + Bin]), + BitStr2 = list_to_bitstring(bitstring_to_list(BitStr2)), + ok. + +error_after_yield(Config) when is_list(Config) -> + L2BTrap = {erts_internal, list_to_binary_continue, 1}, + error_after_yield(badarg, erlang, list_to_binary, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap), + error_after_yield(badarg, erlang, iolist_to_binary, 1, fun () -> [[list2iolist(mk_list(1000000)), oops]] end, L2BTrap), + error_after_yield(badarg, erlang, list_to_bitstring, 1, fun () -> [[list2bitstrlist(mk_list(1000000)), oops]] end, L2BTrap), + error_after_yield(badarg, binary, list_to_bin, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap), + + B2TTrap = {erts_internal, binary_to_term_trap, 1}, + + error_after_yield(badarg, erlang, binary_to_term, 1, fun () -> [error_after_yield_bad_ext_term()] end, B2TTrap), + error_after_yield(badarg, erlang, binary_to_term, 2, fun () -> [error_after_yield_bad_ext_term(), [safe]] end, B2TTrap), + + case erlang:system_info(wordsize) of + 4 -> + SysLimitSz = 1 bsl 32, + error_after_yield(system_limit, erlang, list_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap), + error_after_yield(system_limit, erlang, iolist_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap), + error_after_yield(system_limit, erlang, list_to_bitstring, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap), + error_after_yield(system_limit, binary, list_to_bin, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap); + 8 -> + % Takes waaaay to long time to test system_limit on 64-bit archs... + ok + end, + ok. + +error_after_yield(Type, M, F, AN, AFun, TrapFunc) -> + io:format("Testing ~p for ~p:~p/~p~n", [Type, M, F, AN]), + Tracer = self(), + {Pid, Mon} = spawn_monitor(fun () -> + A = AFun(), + try + erlang:yield(), + erlang:trace(self(),true,[running,{tracer,Tracer}]), + apply(M, F, A), + exit({unexpected_success, {M, F, A}}) + catch + error:Type -> + erlang:trace(self(),false,[running,{tracer,Tracer}]), + %% We threw the exception from the native + %% function we trapped to, but we want + %% the BIF that originally was called + %% to appear in the stack trace. + [{M, F, A, _} | _] = erlang:get_stacktrace() + end + end), + receive + {'DOWN', Mon, process, Pid, Reason} -> + normal = Reason + end, + TD = erlang:trace_delivered(Pid), + receive + {trace_delivered, Pid, TD} -> + NoYields = error_after_yield_sched(Pid, TrapFunc, 0), + io:format("No of yields: ~p~n", [NoYields]), + true = NoYields > 2 + end, + ok. + +error_after_yield_sched(P, TrapFunc, N) -> + receive + {trace, P, out, TrapFunc} -> + receive + {trace, P, in, TrapFunc} -> + error_after_yield_sched(P, TrapFunc, N+1) + after 0 -> + exit(trap_sched_mismatch) + end; + {trace, P, out, Func} -> + receive + {trace, P, in, Func} -> + error_after_yield_sched(P, TrapFunc, N) + after 0 -> + exit(other_sched_mismatch) + end + after 0 -> + N + end. + +error_after_yield_bad_ext_term() -> + TupleSz = 2000000, + <<131, % Version magic + AtomExt/binary>> = term_to_binary(an_atom_we_use_for_this), + BadAtomExt = [100, %% ATOM_EXT + 255, 255, % Invalid size of 65535 bytes + "oops"], + + %% Produce a large tuple where the last element is invalid + list_to_binary([131, %% Version magic + 105, %% LARGE_TUPLE_EXT + <<TupleSz:32/big>>, %% Tuple size + lists:duplicate(TupleSz-1, AtomExt), %% Valid atoms + BadAtomExt]). %% Invalid atom at the end + +cmp_old_impl(Config) when is_list(Config) -> + %% Compare results from new yielding implementations with + %% old non yielding implementations + Cookie = atom_to_list(erlang:get_cookie()), + Rel = "r16b_latest", + case test_server:is_release_available(Rel) of + false -> + {skipped, "No "++Rel++" available"}; + true -> + {ok, Node} = ?t:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel), + peer, + [{args, " -setcookie "++Cookie}, + {erl, [{release, Rel}]}]), + + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(100000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(1000000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list(10000000))]}), + cmp_node(Node, {erlang, list_to_binary, [list2iolist(mk_list_lb(10000000))]}), + + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(100000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(1000000))]}), + cmp_node(Node, {erlang, binary_to_list, [list_to_binary(mk_list(10000000))]}), + + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(100000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(1000000))]}), + cmp_node(Node, {erlang, list_to_bitstring, [list2bitstrlist(mk_list(10000000))]}), + + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(100000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000000)))]}), + cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000000)))]}), + + ?t:stop_node(Node), + + ok + end. %% Utilities. +huge_iolist(Lim) -> + Sz = 1024, + huge_iolist(list_to_binary(mk_list(Sz)), Sz, Lim). + +huge_iolist(X, Sz, Lim) when Sz >= Lim -> + X; +huge_iolist(X, Sz, Lim) -> + huge_iolist([X, X], Sz*2, Lim). + +cmp_node(Node, {M, F, A}) -> + Res = rpc:call(Node, M, F, A), + Res = apply(M, F, A), + ok. + make_sub_binary(Bin) when is_binary(Bin) -> {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), B; @@ -1467,3 +1658,78 @@ get_reds() -> erts_debug:set_internal_state(available_internal_state, true), get_reds() end. + +-define(LARGE_BIN, (512*1024+10)). +-define(LARGE_BIN_LIM, (1024*1024)). + +mk_list(0, Acc) -> + Acc; +mk_list(Sz, Acc) -> + mk_list(Sz-1, [$A+(Sz band 63) | Acc]). + +mk_list(Sz) when Sz >= ?LARGE_BIN_LIM -> + SzLeft = Sz - ?LARGE_BIN, + SzHd = SzLeft div 2, + SzTl = SzLeft - SzHd, + [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])]; +mk_list(Sz) -> + mk_list(Sz, []). + +mk_list_lb(Sz) when Sz >= ?LARGE_BIN_LIM -> + SzLeft = Sz - ?LARGE_BIN, + SzHd = SzLeft div 2, + SzTl = SzLeft - SzHd, + [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])]; +mk_list_lb(Sz) -> + mk_list(Sz, []). + + +list2iolist(List) -> + list2iolist(List, []). + +list2iolist([], Acc) -> + Acc; +list2iolist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256, + is_integer(X1), 0 =< X1, X1 < 256, + is_integer(X2), 0 =< X2, X2 < 256, + is_integer(X3), 0 =< X3, X3 < 256, + is_integer(X4), 0 =< X4, X4 < 256, + is_integer(X5), 0 =< X5, X5 < 256 -> + NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of + 0 -> + [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]]; + 1 -> + [Acc, [], erlang:list_to_binary([X0, X1, X2, X3, X4, X5])]; + 2 -> + [Acc, [[[[X0|erlang:list_to_binary([X1])],[X2|erlang:list_to_binary([X3])],[X4|erlang:list_to_binary([X5])]]]|<<"">>]]; + 3 -> + [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])] + end, + list2iolist(Xs, NewAcc); +list2iolist([X | Xs], Acc) -> + list2iolist(Xs, [Acc,X]). + +list2bitstrlist(List) -> + [list2bitstrlist(List, []), <<4:7>>]. + +list2bitstrlist([], Acc) -> + Acc; +list2bitstrlist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256, + is_integer(X1), 0 =< X1, X1 < 256, + is_integer(X2), 0 =< X2, X2 < 256, + is_integer(X3), 0 =< X3, X3 < 256, + is_integer(X4), 0 =< X4, X4 < 256, + is_integer(X5), 0 =< X5, X5 < 256 -> + NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of + 0 -> + [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]]; + 1 -> + [Acc, [], <<X0:X1>>, <<X2:X3>>, <<X4:X5>>]; + 2 -> + [Acc, [[[[X0|<<X1:X2>>],X3]],[X4|erlang:list_to_binary([X5])]|<<"">>]]; + 3 -> + [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])] + end, + list2bitstrlist(Xs, NewAcc); +list2bitstrlist([X | Xs], Acc) -> + list2bitstrlist(Xs, [Acc,X]). diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index ceb4afb5cf..f959714be7 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -155,6 +155,7 @@ misc_smoke_tests(Config) when is_list(Config) -> ?line true = is_binary(erlang:system_info(loaded)), ?line true = is_binary(erlang:system_info(dist)), ?line ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end, + true = lists:member(erlang:system_info(tolerant_timeofday), [enabled, disabled]), ?line ok. diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 2251575e5a..4d7598cf1f 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -181,6 +181,13 @@ send_trace(Config) when is_list(Config) -> ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(), ?line receive_nothing(), + %% Check that a message sent to another registered process is traced. + register(?MODULE,Receiver), + Sender ! {send_please, ?MODULE, to_receiver}, + {trace, Sender, send, to_receiver, ?MODULE} = receive_first(), + receive_nothing(), + unregister(?MODULE), + %% Check that a message sent to this process is traced. ?line Sender ! {send_please, self(), to_myself}, ?line receive to_myself -> ok end, @@ -188,6 +195,21 @@ send_trace(Config) when is_list(Config) -> ?line {trace, Sender, send, to_myself, Self} = receive_first(), ?line receive_nothing(), + %% Check that a message sent to dead process is traced. + {Pid,Ref} = spawn_monitor(fun() -> ok end), + receive {'DOWN',Ref,_,_,_} -> ok end, + Sender ! {send_please, Pid, to_dead}, + {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first(), + receive_nothing(), + + %% Check that a message sent to unknown registrated process is traced. + BadargSender = fun_spawn(fun sender/0), + 1 = erlang:trace(BadargSender, true, [send]), + unlink(BadargSender), + BadargSender ! {send_please, not_registered, to_unknown}, + {trace, BadargSender, send, to_unknown, not_registered} = receive_first(), + receive_nothing(), + %% Another process should not be able to trace Sender. ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), diff --git a/erts/emulator/utils/gen_git_version b/erts/emulator/utils/gen_git_version index ef06a4b8e2..9faf015b62 100755 --- a/erts/emulator/utils/gen_git_version +++ b/erts/emulator/utils/gen_git_version @@ -5,9 +5,9 @@ OUTPUT_FILE=$1 if command -v git 2>&1 >/dev/null && test -d $ERL_TOP/.git -o -f $ERL_TOP/.git then - VSN=`git describe --match "OTP_R[0-9][0-9][A-B]*" HEAD` + VSN=`git describe --match "OTP-[0-9]*" HEAD` case "$VSN" in - OTP_R*-g*) + OTP-*-g*) VSN=`echo $VSN | sed -e 's/.*-g\\(.*\\)/\\1/g'` ;; *) VSN="na" ;; esac @@ -36,4 +36,4 @@ then fi exit 0 fi -exit 1
\ No newline at end of file +exit 1 diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index ed90e26024..19c92681d0 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1065,7 +1065,9 @@ define etp-cp-1 set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 end if $etp_cp_p - set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8) + # 12 = MI_FUNCTIONS + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12) + # 0 = MI_NUM_FUNCTIONS set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] set $etp_cp_p = 0 while $etp_cp_low < $etp_cp_high @@ -3277,7 +3279,7 @@ define etp-block-size-1 else set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9) end - set $etp_MBC_ABLK_SZ_MASK = ~(~0 << $etp_MBC_ABLK_OFFSET_SHIFT) & ~7 + set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7 end set $etp_blk_sz = ($arg0)->bhdr & $etp_MBC_ABLK_SZ_MASK end @@ -3300,7 +3302,7 @@ define etp-block2mbc-1 set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9) end end - set $etp_mbc = (Carrier_t*) ((((UWord)($arg0)) & (~0 << 18)) - ((($arg0)->bhdr >> $etp_MBC_ABLK_OFFSET_SHIFT) << 18)) + set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> 18) - (($arg0)->bhdr >> $etp_MBC_ABLK_OFFSET_SHIFT)) << 18) end end diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 54acd1295a..70e9c937e9 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -51,16 +51,36 @@ # endif #endif +#if !defined(__GNUC__) +# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0 +#elif !defined(__GNUC_MINOR__) +# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ + ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) +#elif !defined(__GNUC_PATCHLEVEL__) +# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ + (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) +#else +# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ + (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) +#endif + #undef ETHR_INLINE #if defined(__GNUC__) # define ETHR_INLINE __inline__ +# if ETHR_AT_LEAST_GCC_VSN__(3, 1, 1) +# define ETHR_FORCE_INLINE __inline__ __attribute__((__always_inline__)) +# else +# define ETHR_FORCE_INLINE __inline__ +# endif #elif defined(__WIN32__) # define ETHR_INLINE __forceinline +# define ETHR_FORCE_INLINE __forceinline #endif #if defined(ETHR_DEBUG) || !defined(ETHR_INLINE) || ETHR_XCHK \ || (defined(__GNUC__) && defined(ERTS_MIXED_CYGWIN_VC)) # undef ETHR_INLINE # define ETHR_INLINE +# define ETHR_FORCE_INLINE # undef ETHR_TRY_INLINE_FUNCS #endif @@ -285,19 +305,6 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file, const char *func, int err); -#if !defined(__GNUC__) -# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0 -#elif !defined(__GNUC_MINOR__) -# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ - ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) -#elif !defined(__GNUC_PATCHLEVEL__) -# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ - (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) -#else -# define ETHR_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ - (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) -#endif - #if !ETHR_AT_LEAST_GCC_VSN__(2, 96, 0) #define __builtin_expect(X, Y) (X) #endif diff --git a/erts/include/internal/win/ethr_membar.h b/erts/include/internal/win/ethr_membar.h index 8237660b2c..a17f2459fc 100644 --- a/erts/include/internal/win/ethr_membar.h +++ b/erts/include/internal/win/ethr_membar.h @@ -63,13 +63,13 @@ do { \ #pragma intrinsic(_mm_sfence) #pragma intrinsic(_mm_lfence) -static __forceinline void +static ETHR_FORCE_INLINE void ethr_cfence__(void) { _ReadWriteBarrier(); } -static __forceinline void +static ETHR_FORCE_INLINE void ethr_mfence__(void) { #if ETHR_SIZEOF_PTR == 4 @@ -80,7 +80,7 @@ ethr_mfence__(void) _mm_mfence(); } -static __forceinline void +static ETHR_FORCE_INLINE void ethr_sfence__(void) { #if ETHR_SIZEOF_PTR == 4 @@ -91,7 +91,7 @@ ethr_sfence__(void) _mm_sfence(); } -static __forceinline void +static ETHR_FORCE_INLINE void ethr_lfence__(void) { #if ETHR_SIZEOF_PTR == 4 diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c index 5a271c5268..8bf7656bb0 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -25,6 +25,7 @@ # include <windows.h> #endif +#include "ethread.h" #include "erl_misc_utils.h" #if defined(__WIN32__) @@ -191,7 +192,7 @@ struct erts_cpu_info_t_ { #if defined(__WIN32__) -static __forceinline int +static ETHR_FORCE_INLINE int get_proc_affinity(erts_cpu_info_t *cpuinfo, cpu_set_t *cpuset) { DWORD_PTR pamask; @@ -206,7 +207,7 @@ get_proc_affinity(erts_cpu_info_t *cpuinfo, cpu_set_t *cpuset) } } -static __forceinline int +static ETHR_FORCE_INLINE int set_thr_affinity(cpu_set_t *set) { if (*set == (cpu_set_t) 0) @@ -1157,7 +1158,7 @@ read_topology(erts_cpu_info_t *cpuinfo) #define ERTS_MU_RELATION_CACHE 2 /* RelationCache */ #define ERTS_MU_RELATION_PROCESSOR_PACKAGE 3 /* RelationProcessorPackage */ -static __forceinline int +static ETHR_FORCE_INLINE int rel_cmp_val(int r) { switch (r) { diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c index 72b44033ad..4e56efaf8b 100644 --- a/erts/lib_src/common/ethr_mutex.c +++ b/erts/lib_src/common/ethr_mutex.c @@ -1433,7 +1433,7 @@ void LeaveCriticalSection(CRITICAL_SECTION *cs) #define ETHR_CND_WAIT__ ((ethr_sint32_t) 0x11dead11) #define ETHR_CND_WAKEUP__ ((ethr_sint32_t) 0x11beef11) -static __forceinline void +static ETHR_FORCE_INLINE void cond_wakeup(ethr_ts_event *tse) { ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) == ETHR_CND_WAIT__); @@ -1574,7 +1574,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) return 0; } -static __forceinline void +static ETHR_FORCE_INLINE void posix_compliant_mtx_enqueue(ethr_mutex *mtx, ethr_ts_event *tse_start, ethr_ts_event *tse_end) @@ -1614,7 +1614,7 @@ posix_compliant_mtx_enqueue(ethr_mutex *mtx, } } -static __forceinline void +static ETHR_FORCE_INLINE void enqueue_cond_wakeups(ethr_ts_event *queue, int posix_compliant) { if (queue) { diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex e19bb370bc..fdc7401475 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 3d650aff74..ba45e4e011 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 1508eed9ee..4ff0513321 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -79,7 +79,7 @@ -export([binary_to_integer/1,binary_to_integer/2]). -export([binary_to_list/1]). -export([binary_to_list/3, binary_to_term/1, binary_to_term/2]). --export([bit_size/1, bitsize/1, bitstr_to_list/1, bitstring_to_list/1]). +-export([bit_size/1, bitsize/1, bitstring_to_list/1]). -export([bump_reductions/1, byte_size/1, call_on_load_function/1]). -export([cancel_timer/1, check_old_code/1, check_process_code/2, check_process_code/3, crc32/1]). @@ -100,7 +100,7 @@ -export([integer_to_binary/1, integer_to_list/1]). -export([iolist_size/1, iolist_to_binary/1]). -export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]). --export([list_to_atom/1, list_to_binary/1, list_to_bitstr/1]). +-export([list_to_atom/1, list_to_binary/1]). -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). -export([list_to_integer/1, list_to_integer/2]). -export([list_to_pid/1, list_to_tuple/1, loaded/0]). @@ -361,25 +361,15 @@ binary_to_list(_Binary, _Start, _Stop) -> %% binary_to_term/1 -spec binary_to_term(Binary) -> term() when Binary :: ext_binary(). -binary_to_term(Binary) -> - %% This BIF may throw badarg while trapping - try - erts_internal:binary_to_term(Binary) - catch - error:Reason -> erlang:error(Reason,[Binary]) - end. +binary_to_term(_Binary) -> + erlang:nif_error(undefined). %% binary_to_term/2 -spec binary_to_term(Binary, Opts) -> term() when Binary :: ext_binary(), Opts :: [safe]. -binary_to_term(Binary, Opts) -> - %% This BIF may throw badarg while trapping - try - erts_internal:binary_to_term(Binary,Opts) - catch - error:Reason -> erlang:error(Reason,[Binary,Opts]) - end. +binary_to_term(_Binary, _Opts) -> + erlang:nif_error(undefined). %% bit_size/1 %% Shadowed by erl_bif_types: erlang:bit_size/1 @@ -394,12 +384,6 @@ bit_size(_Bitstring) -> bitsize(_P1) -> erlang:nif_error(undefined). -%% bitstr_to_list/1 --spec erlang:bitstr_to_list(P1) -> [byte() | bitstring()] when - P1 :: bitstring(). -bitstr_to_list(_P1) -> - erlang:nif_error(undefined). - %% bitstring_to_list/1 -spec bitstring_to_list(Bitstring) -> [byte() | bitstring()] when Bitstring :: bitstring(). @@ -1082,12 +1066,6 @@ list_to_atom(_String) -> list_to_binary(_IoList) -> erlang:nif_error(undefined). -%% list_to_bitstr/1 --spec erlang:list_to_bitstr(P1) -> bitstring() when - P1 :: bitstring_list(). -list_to_bitstr(_P1) -> - erlang:nif_error(undefined). - %% list_to_bitstring/1 -spec list_to_bitstring(BitstringList) -> bitstring() when BitstringList :: bitstring_list(). @@ -2286,6 +2264,7 @@ tuple_to_list(_Tuple) -> (system_architecture) -> string(); (threads) -> boolean(); (thread_pool_size) -> non_neg_integer(); + (tolerant_timeofday) -> enabled | disabled; (trace_control_word) -> non_neg_integer(); (update_cpu_info) -> changed | unchanged; (version) -> string(); diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 764d7730aa..2c5bd82cf0 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -29,7 +29,6 @@ -module(erts_internal). -export([await_port_send_result/3]). --export([binary_to_term/1, binary_to_term/2]). -export([cmp_term/2]). -export([map_to_tuple_keys/1]). -export([port_command/3, port_connect/2, port_close/1, @@ -162,17 +161,6 @@ request_system_task(_Pid, _Prio, _Request) -> check_process_code(_Module, _OptionList) -> erlang:nif_error(undefined). --spec binary_to_term(Binary) -> term() when - Binary :: binary(). -binary_to_term(_Binary) -> - erlang:nif_error(undefined). - --spec binary_to_term(Binary, Opts) -> term() when - Binary :: binary(), - Opts :: [safe]. -binary_to_term(_Binary, _Opts) -> - erlang:nif_error(undefined). - %% term compare where integer() < float() = true -spec cmp_term(A,B) -> Result when diff --git a/erts/vsn.mk b/erts/vsn.mk index 2e773079f3..fff334c89f 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,7 +17,7 @@ # %CopyrightEnd% # -VSN = 6.1 +VSN = 6.0.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 54eac20ac4..9d6768b157 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -126,9 +126,11 @@ map_es/1, map_arg/1, update_c_map/3, + c_map/1, is_c_map_empty/1, ann_c_map/2, ann_c_map/3, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, + c_map_pair/2, ann_c_map_pair/4 ]). @@ -1582,9 +1584,20 @@ map_es(#c_map{es = Es}) -> -spec map_arg(c_map()) -> c_map() | c_literal(). -map_arg(#c_map{arg = M}) -> +map_arg(#c_map{arg=M}) -> M. +-spec c_map([c_map_pair()]) -> c_map(). + +c_map(Pairs) -> + #c_map{es=Pairs}. + +-spec is_c_map_empty(c_map() | c_literal()) -> boolean(). + +is_c_map_empty(#c_map{ es=[] }) -> true; +is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; +is_c_map_empty(_) -> false. + -spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). ann_c_map(As,Es) -> @@ -1644,6 +1657,11 @@ map_pair_key(#c_map_pair{key=K}) -> K. map_pair_val(#c_map_pair{val=V}) -> V. map_pair_op(#c_map_pair{op=Op}) -> Op. +-spec c_map_pair(cerl(), cerl()) -> c_map_pair(). + +c_map_pair(Key,Val) -> + #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. + -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). @@ -4245,6 +4263,9 @@ ann_make_tree(As, bitstr, [[V],[S],[U],[T],[Fs]]) -> ann_c_bitstr(As, V, S, U, T, Fs); ann_make_tree(As, cons, [[H], [T]]) -> ann_c_cons(As, H, T); ann_make_tree(As, tuple, [Es]) -> ann_c_tuple(As, Es); +ann_make_tree(As, map, [Es]) -> ann_c_map(As, Es); +ann_make_tree(As, map, [[A], Es]) -> ann_c_map(As, A, Es); +ann_make_tree(As, map_pair, [[Op], [K], [V]]) -> ann_c_map_pair(As, Op, K, V); ann_make_tree(As, 'let', [Vs, [A], [B]]) -> ann_c_let(As, Vs, A, B); ann_make_tree(As, seq, [[A], [B]]) -> ann_c_seq(As, A, B); ann_make_tree(As, apply, [[Op], Es]) -> ann_c_apply(As, Op, Es); diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index a2868850d7..6642183cb8 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1384,6 +1384,7 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary key; struct hmac_context* obj; const EVP_MD *md; + ERL_NIF_TERM ret; CHECK_OSE_CRYPTO(); @@ -1415,7 +1416,9 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ HMAC_CTX_init(&obj->ctx); HMAC_Init(&obj->ctx, key.data, key.size, md); - return enif_make_resource(env, obj); + ret = enif_make_resource(env, obj); + enif_release_resource(obj); + return ret; } static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -2506,6 +2509,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return enif_make_binary(env, &ret_bin); } else { + enif_release_binary(&ret_bin); return atom_error; } } @@ -2768,6 +2772,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ret = enif_make_binary(env, &ret_bin); } else { + enif_release_binary(&ret_bin); ret = atom_error; } } diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index a92b890a80..3de60b2f7a 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -50,33 +50,31 @@ <p>Dialyzer also has a command line version for automated use. Below is a brief description of the list of its options. The same information can be obtained by writing</p> - <code type="none"><![CDATA[ - dialyzer --help - ]]></code> + <code type="none"> + dialyzer --help</code> <p>in a shell. Please refer to the GUI description for more details on the operation of Dialyzer.</p> <p>The exit status of the command line version is:</p> - <code type="none"><![CDATA[ + <code type="none"> 0 - No problems were encountered during the analysis and no warnings were emitted. 1 - Problems were encountered during the analysis. - 2 - No problems were encountered, but warnings were emitted. - ]]></code> + 2 - No problems were encountered, but warnings were emitted.</code> <p>Usage:</p> - <code type="none"><![CDATA[ + <code type="none"> dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [-pa dir]* [--plt plt] [--plts plt*] [-Ddefine]* - [-I include_dir]* [--output_plt file] [-Wwarn]* + [-I include_dir]* [--output_plt file] [-Wwarn]* [--raw] [--src] [--gui] [files_or_dirs] [-r dirs] [--apps applications] [-o outfile] [--build_plt] [--add_to_plt] [--remove_from_plt] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] - [--no_native] [--fullpath] - ]]></code> + [--dump_callgraph file] [--no_native] [--fullpath] + [--statistics]</code> <p>Options:</p> <taglist> <tag><c><![CDATA[files_or_dirs]]></c> (for backwards compatibility also - as: <c><![CDATA[-c files_or_dirs]]></c></tag> + as: <c><![CDATA[-c files_or_dirs]]></c>)</tag> <item>Use Dialyzer from the command line to detect defects in the specified files or directories containing <c><![CDATA[.erl]]></c> or <c><![CDATA[.beam]]></c> files, depending on the type of the @@ -88,16 +86,14 @@ analysis.</item> <tag><c><![CDATA[--apps applications]]></c></tag> <item>Option typically used when building or modifying a plt as in: - <code type="none"><![CDATA[ - dialyzer --build_plt --apps erts kernel stdlib mnesia ... - ]]></code> + <code type="none"> + dialyzer --build_plt --apps erts kernel stdlib mnesia ...</code> to conveniently refer to library applications corresponding to the Erlang/OTP installation. However, the option is general and can also be used during analysis in order to refer to Erlang/OTP applications. In addition, file or directory names can also be included, as in: - <code type="none"><![CDATA[ - dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam - ]]></code></item> + <code type="none"> + dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam</code></item> <tag><c><![CDATA[-o outfile]]></c> (or <c><![CDATA[--output outfile]]></c>)</tag> <item>When using Dialyzer from the command line, send the analysis @@ -129,24 +125,26 @@ that the plts are disjoint (i.e., do not have any module appearing in more than one plt). The plts are created in the usual way: - <code type="none"><![CDATA[ + <code type="none"> dialyzer --build_plt --output_plt plt_1 files_to_include ... - dialyzer --build_plt --output_plt plt_n files_to_include - ]]></code> + dialyzer --build_plt --output_plt plt_n files_to_include</code> and then can be used in either of the following ways: - <code type="none"><![CDATA[ - dialyzer files_to_analyze --plts plt_1 ... plt_n - ]]></code> + <code type="none"> + dialyzer files_to_analyze --plts plt_1 ... plt_n</code> or: - <code type="none"><![CDATA[ - dialyzer --plts plt_1 ... plt_n -- files_to_analyze - ]]></code> + <code type="none"> + dialyzer --plts plt_1 ... plt_n -- files_to_analyze</code> (Note the -- delimiter in the second case)</item> <tag><c><![CDATA[-Wwarn]]></c></tag> <item>A family of options which selectively turn on/off warnings (for help on the names of warnings use - <c><![CDATA[dialyzer -Whelp]]></c>).</item> + <c><![CDATA[dialyzer -Whelp]]></c>). + Note that the options can also be given in the file with a + <c>-dialyzer({nowarn_tag, WarningTags})</c> attribute. + See <seealso + marker="doc/reference_manual:typespec#suppression">Erlang Reference + Manual</seealso> for details.</item> <tag><c><![CDATA[--shell]]></c></tag> <item>Do not disable the Erlang shell while running the GUI.</item> <tag><c><![CDATA[--version]]></c> (or <c><![CDATA[-v]]></c>)</tag> @@ -220,8 +218,6 @@ <item>Suppress warnings for unused functions.</item> <tag><c><![CDATA[-Wno_improper_lists]]></c></tag> <item>Suppress warnings for construction of improper lists.</item> - <tag><c><![CDATA[-Wno_tuple_as_fun]]></c></tag> - <item>Suppress warnings for using tuples instead of funs.</item> <tag><c><![CDATA[-Wno_fun_app]]></c></tag> <item>Suppress warnings for fun applications that will fail.</item> <tag><c><![CDATA[-Wno_match]]></c></tag> @@ -229,9 +225,16 @@ match.</item> <tag><c><![CDATA[-Wno_opaque]]></c></tag> <item>Suppress warnings for violations of opaqueness of data types.</item> + <tag><c><![CDATA[-Wno_fail_call]]></c></tag> + <item>Suppress warnings for failing calls.</item> + <tag><c><![CDATA[-Wno_contracts]]></c></tag> + <item>Suppress warnings about invalid contracts.</item> <tag><c><![CDATA[-Wno_behaviours]]></c></tag> <item>Suppress warnings about behaviour callbacks which drift from the published recommended interfaces.</item> + <tag><c><![CDATA[-Wno_undefined_callbacks]]></c></tag> + <item>Suppress warnings about behaviours that have no + <c>-callback</c> attributes for their callbacks.</item> <tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag> <item>Include warnings for function calls which ignore a structured return value or do not match against one of many possible return @@ -278,13 +281,13 @@ </type> <desc> <p>Dialyzer GUI version.</p> - <code type="none"><![CDATA[ + <code type="none"> OptList :: [Option] Option :: {files, [Filename :: string()]} | {files_rec, [DirName :: string()]} | {defines, [{Macro: atom(), Value : term()}]} - | {from, src_code | byte_code} %% Defaults to byte_code - | {init_plt, FileName :: string()} %% If changed from default + | {from, src_code | byte_code} %% Defaults to byte_code + | {init_plt, FileName :: string()} %% If changed from default | {plts, [FileName :: string()]} %% If changed from default | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} @@ -304,14 +307,15 @@ WarnOpts :: no_return | no_match | no_opaque | no_fail_call + | no_contracts + | no_behaviours + | no_undefined_callbacks + | unmatched_returns | error_handling | race_conditions - | behaviours - | unmatched_returns | overspecs | underspecs - | specdiffs - ]]></code> + | specdiffs</code> </desc> </func> <func> @@ -323,17 +327,30 @@ WarnOpts :: no_return </type> <desc> <p>Dialyzer command line version.</p> - <code type="none"><![CDATA[ + <code type="none"> Warnings :: [{Tag, Id, Msg}] -Tag :: 'warn_return_no_exit' | 'warn_return_only_exit' - | 'warn_not_called' | 'warn_non_proper_list' - | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' - | 'warn_contract_subtype' | 'warn_contract_supertype' +Tag :: 'warn_behaviour' + | 'warn_bin_construction' + | 'warn_callgraph' + | 'warn_contract_not_equal' + | 'warn_contract_range' + | 'warn_contract_subtype' + | 'warn_contract_supertype' + | 'warn_contract_syntax' + | 'warn_contract_types' + | 'warn_failing_call' + | 'warn_fun_app' + | 'warn_matching' + | 'warn_non_proper_list' + | 'warn_not_called' + | 'warn_opaque' + | 'warn_race_condition' + | 'warn_return_no_exit' + | 'warn_return_only_exit' + | 'warn_umatched_return' + | 'warn_undefined_callbacks' Id = {File :: string(), Line :: integer()} -Msg = msg() -- Undefined -]]></code> +Msg = msg() -- Undefined</code> </desc> </func> <func> diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index db27b2037d..04ce0e8bc3 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -357,12 +357,13 @@ help_warnings() -> help_message() -> S = "Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [-pa dir]* [--plt plt] [--plts plt*] [-Ddefine]* - [-I include_dir]* [--output_plt file] [-Wwarn]* + [-I include_dir]* [--output_plt file] [-Wwarn]* [--raw] [--src] [--gui] [files_or_dirs] [-r dirs] [--apps applications] [-o outfile] [--build_plt] [--add_to_plt] [--remove_from_plt] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] - [--no_native] [--fullpath] [--statistics] + [--dump_callgraph file] [--no_native] [--fullpath] + [--statistics] Options: files_or_dirs (for backwards compatibility also as: -c files_or_dirs) Use Dialyzer from the command line to detect defects in the @@ -495,14 +496,16 @@ warning_options_msg() -> Suppress warnings for unused functions. -Wno_improper_lists Suppress warnings for construction of improper lists. - -Wno_tuple_as_fun - Suppress warnings for using tuples instead of funs. -Wno_fun_app Suppress warnings for fun applications that will fail. -Wno_match Suppress warnings for patterns that are unused or cannot match. -Wno_opaque Suppress warnings for violations of opaqueness of data types. + -Wno_fail_call + Suppress warnings for failing calls. + -Wno_contracts + Suppress warnings about invalid contracts. -Wno_behaviours Suppress warnings about behaviour callbacks which drift from the published recommended interfaces. diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype new file mode 100644 index 0000000000..8980321135 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype @@ -0,0 +1,3 @@ + +maps_difftype.erl:10: Function empty_mismatch/1 has no local return +maps_difftype.erl:11: The pattern ~{}~ can never match the type tuple() diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl new file mode 100644 index 0000000000..19e61a7944 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl @@ -0,0 +1,11 @@ +%% +%% File: maps_difftype.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2014-04-29 +%% +-module(maps_difftype). + +-export([empty_mismatch/1]). + +empty_mismatch(Tuple) when is_tuple(Tuple) -> + case Tuple of #{} -> ok end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl new file mode 100644 index 0000000000..35687e22ec --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl @@ -0,0 +1,17 @@ +-module(remote_field2). + +-export([handle_cast/2]). + +-record(state, {tcp_socket :: inet:socket()}). + +-spec handle_cast(_,_) -> + {noreply,_} | + {stop,{shutdown,connection_closed}, + #state{tcp_socket :: port()}}. +handle_cast({send, Message}, #state{tcp_socket = TCPSocket} = State) -> + case gen_tcp:send(TCPSocket, Message) of + ok -> + {noreply, State}; + {error, closed} -> + {stop, {shutdown, connection_closed}, State} + end. diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 7d6a28e51c..ab9ad25a3a 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -227,7 +227,7 @@ question is as if a callback had taken place and returned <c>{error, failure}</c>.</p> <p> -Defaults to <c>report</c> if unspecified.</p> +Defaults to <c>discard</c> if unspecified.</p> </item> <tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag> diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 675ffcfd18..68e69dbfeb 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -238,7 +238,7 @@ first.</p> <section><title>diameter 1.4.4</title> - <section><title>Known Bugs and Problems</title> + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> <p> diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl index bfe71b0e56..46eb4a55db 100644 --- a/lib/diameter/examples/code/client.erl +++ b/lib/diameter/examples/code/client.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/diameter/examples/code/client_cb.erl b/lib/diameter/examples/code/client_cb.erl index ee3dcb2fec..843cdd9262 100644 --- a/lib/diameter/examples/code/client_cb.erl +++ b/lib/diameter/examples/code/client_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -77,23 +77,11 @@ prepare_retransmit(Packet, SvcName, Peer) -> %% handle_answer/4 -%% Since client.erl has detached the call when using the list -%% encoding and not otherwise, output to the terminal in the -%% the former case, return in the latter. - -handle_answer(#diameter_packet{msg = Msg}, Request, _SvcName, _Peer) - when is_list(Request) -> - io:format("answer: ~p~n", [Msg]); - handle_answer(#diameter_packet{msg = Msg}, _Request, _SvcName, _Peer) -> {ok, Msg}. %% handle_error/4 -handle_error(Reason, Request, _SvcName, _Peer) - when is_list(Request) -> - io:format("error: ~p~n", [Reason]); - handle_error(Reason, _Request, _SvcName, _Peer) -> {error, Reason}. diff --git a/lib/diameter/examples/code/redirect_cb.erl b/lib/diameter/examples/code/redirect_cb.erl index 69836774a1..8d98b0d2df 100644 --- a/lib/diameter/examples/code/redirect_cb.erl +++ b/lib/diameter/examples/code/redirect_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,12 +34,10 @@ -define(UNEXPECTED, erlang:error({unexpected, ?MODULE, ?LINE})). -peer_up(_SvcName, {PeerRef, _}, State) -> - io:format("up: ~p~n", [PeerRef]), +peer_up(_SvcName, _Peer, State) -> State. -peer_down(_SvcName, {PeerRef, _}, State) -> - io:format("down: ~p~n", [PeerRef]), +peer_down(_SvcName, _Peer, State) -> State. pick_peer(_, _, _SvcName, _State) -> diff --git a/lib/diameter/examples/code/relay_cb.erl b/lib/diameter/examples/code/relay_cb.erl index 9f9cd8d5ae..68798014e6 100644 --- a/lib/diameter/examples/code/relay_cb.erl +++ b/lib/diameter/examples/code/relay_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,12 +32,10 @@ handle_error/5, handle_request/3]). -peer_up(_SvcName, {PeerRef, _}, State) -> - io:format("up: ~p~n", [PeerRef]), +peer_up(_SvcName, _Peer, State) -> State. -peer_down(_SvcName, {PeerRef, _}, State) -> - io:format("down: ~p~n", [PeerRef]), +peer_down(_SvcName, _Peer, State) -> State. %% Returning 'relay' from handle_request causes diameter to resend the diff --git a/lib/diameter/examples/code/server_cb.erl b/lib/diameter/examples/code/server_cb.erl index 0f6eb32ed6..9d8d395d06 100644 --- a/lib/diameter/examples/code/server_cb.erl +++ b/lib/diameter/examples/code/server_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,12 +38,10 @@ -define(UNEXPECTED, erlang:error({unexpected, ?MODULE, ?LINE})). -peer_up(_SvcName, {PeerRef, _}, State) -> - io:format("up: ~p~n", [PeerRef]), +peer_up(_SvcName, _Peer, State) -> State. -peer_down(_SvcName, {PeerRef, _}, State) -> - io:format("down: ~p~n", [PeerRef]), +peer_down(_SvcName, _Peer, State) -> State. pick_peer(_, _, _SvcName, _State) -> @@ -68,10 +66,13 @@ handle_request(#diameter_packet{msg = Req, errors = []}, _SvcName, {_, Caps}) origin_realm = {OR,_}} = Caps, #diameter_base_RAR{'Session-Id' = Id, - 'Re-Auth-Request-Type' = RT} + 'Re-Auth-Request-Type' = Type} = Req, - {reply, answer(RT, Id, OH, OR)}; + {reply, #diameter_base_RAA{'Result-Code' = rc(Type), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Session-Id' = Id}}; %% ... or one that wasn't. 3xxx errors are answered by diameter itself %% but these are 5xxx errors for which we must contruct a reply. @@ -84,32 +85,18 @@ handle_request(#diameter_packet{msg = Req}, _SvcName, {_, Caps}) #diameter_base_RAR{'Session-Id' = Id} = Req, - Ans = #diameter_base_RAA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Session-Id' = Id}, + {reply, #diameter_base_RAA{'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Session-Id' = Id}}; - {reply, Ans}; +%% Answer that any other message is unsupported. +handle_request(#diameter_packet{}, _SvcName, _) -> + {answer_message, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED -%% Should really reply to other base messages that we don't support -%% but simply discard them instead. -handle_request(#diameter_packet{}, _SvcName, {_,_}) -> - discard. +%% Map Re-Auth-Request-Type to Result-Code just for the purpose of +%% generating different answers. -%% --------------------------------------------------------------------------- - -%% Answer using the record or list encoding depending on -%% Re-Auth-Request-Type. This is just as an example. You would -%% typically just choose one, and this has nothing to do with the how -%% client.erl sends. - -answer(0, Id, OH, OR) -> - #diameter_base_RAA{'Result-Code' = 2001, %% DIAMETER_SUCCESS - 'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Session-Id' = Id}; - -answer(_, Id, OH, OR) -> - ['RAA', {'Result-Code', 5012}, %% DIAMETER_UNABLE_TO_COMPLY - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Session-Id', Id}]. +rc(0) -> + 2001; %% DIAMETER_SUCCESS +rc(_) -> + 5012. %% DIAMETER_UNABLE_TO_COMPLY diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index 5a40e42300..c2c271a9a3 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -126,7 +126,7 @@ default, extra = []}). -%% The diameter service and diameter_apps records are only passed +%% The diameter service and diameter_app records are only passed %% through the transport interface when starting a transport process, %% although typically a transport implementation will (and probably %% should) only be interested host_ip_address. @@ -143,6 +143,7 @@ init_state, %% option 'state', initial callback state id, %% 32-bit unsigned application identifier = Dict:id() mutable = false, %% boolean(), do traffic callbacks modify state? - options = [{answer_errors, report}, %% | callback | discard + options = [{answer_errors, discard}, %% | callback | report {request_errors, answer_3xxx}]}). %% | callback | answer + -endif. %% -ifdef(diameter_hrl). diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index c8f706dc3e..7e91ce375f 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -30,6 +30,10 @@ %% error or not. See is_strict/0. -define(STRICT_KEY, strict). +%% Key that says whether or not we should do a best-effort decode +%% within Failed-AVP. +-define(FAILED_KEY, failed). + -type parent_name() :: atom(). %% parent = Message or AVP -type parent_record() :: tuple(). %% -type avp_name() :: atom(). @@ -286,15 +290,7 @@ decode(Name, 'AVP', Avp, Acc) -> %% d/3 -%% Don't try to decode the value of a Failed-AVP component since it -%% probably won't. Note that matching on 'Failed-AVP' assumes that -%% this is the RFC AVP, with code 279. Strictly, this doesn't need to -%% be the case, so we're assuming no one defines another Failed-AVP. -d('Failed-AVP' = Name, Avp, Acc) -> - decode_AVP(Name, Avp, Acc); - -%% Or try to decode. -d(Name, Avp, {Avps, Acc}) -> +d(Name, Avp, Acc) -> #diameter_avp{name = AvpName, data = Data, type = Type, @@ -307,51 +303,81 @@ d(Name, Avp, {Avps, Acc}) -> %% value around through the entire decode. The solution here is %% simple in comparison, both to implement and to understand. - Reset = relax(Type, M), + Strict = relax(Type, M), + %% Use the process dictionary again to keep track of whether we're + %% decoding within Failed-AVP and should ignore decode errors + %% altogether. + + Failed = relax(Name), %% Not AvpName or else a failed Failed-AVP + %% decode is packed into 'AVP'. try avp(decode, Data, AvpName) of V -> + {Avps, T} = Acc, {H, A} = ungroup(V, Avp), - {[H | Avps], pack_avp(Name, A, Acc)} + {[H | Avps], pack_avp(Name, A, T)} catch error: Reason -> - %% Failures here won't be visible since they're a "normal" - %% occurrence if the peer sends a faulty AVP that we need to - %% respond sensibly to. Log the occurence for traceability, - %% but the peer will also receive info in the resulting - %% answer-message. - diameter_lib:log({decode, failure}, - ?MODULE, - ?LINE, - {Reason, Avp, erlang:get_stacktrace()}), - {Rec, Failed} = Acc, - {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}} + d(undefined == Failed orelse is_failed(), Reason, Name, Avp, Acc) after - relax(Reset) + reset(?STRICT_KEY, Strict), + reset(?FAILED_KEY, Failed) end. +%% Ignore a decode error within Failed-AVP ... +d(true, _, Name, Avp, Acc) -> + decode_AVP(Name, Avp, Acc); + +%% ... or not. Failures here won't be visible since they're a "normal" +%% occurrence if the peer sends a faulty AVP that we need to respond +%% sensibly to. Log the occurence for traceability, but the peer will +%% also receive info in the resulting answer message. +d(false, Reason, Name, Avp, {Avps, Acc}) -> + Stack = diameter_lib:get_stacktrace(), + diameter_lib:log(decode_error, + ?MODULE, + ?LINE, + {Reason, Name, Avp#diameter_avp.name, Stack}), + {Rec, Failed} = Acc, + {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}. + %% Set false in the process dictionary as soon as we see a Grouped AVP %% that doesn't set the M-bit, so that is_strict() can say whether or %% not to ignore the M-bit on an encapsulated AVP. relax('Grouped', M) -> - V = getr(?STRICT_KEY), - if V == undefined andalso not M -> + case getr(?STRICT_KEY) of + undefined when not M -> putr(?STRICT_KEY, M); - true -> + _ -> false end; relax(_, _) -> false. -%% Reset strictness. -relax(undefined) -> - eraser(?STRICT_KEY); -relax(false) -> - ok. - is_strict() -> false /= getr(?STRICT_KEY). +%% Set true in the process dictionary as soon as we see Failed-AVP. +%% Matching on 'Failed-AVP' assumes that this is the RFC AVP. +%% Strictly, this doesn't need to be the case. +relax('Failed-AVP') -> + case getr(?FAILED_KEY) of + undefined -> + putr(?FAILED_KEY, true); + true = Yes -> + Yes + end; +relax(_) -> + is_failed(). + +is_failed() -> + true == getr(?FAILED_KEY). + +reset(Key, undefined) -> + eraser(Key); +reset(_, _) -> + ok. + %% decode_AVP/3 %% %% Don't know this AVP: see if it can be packed in an 'AVP' field @@ -410,6 +436,23 @@ pack_avp(_, Arity, Avp, Acc) -> %% pack_AVP/3 +%% Length failure was induced because of a header/payload length +%% mismatch. The AVP Length is reset to match the received data if +%% this AVP is encoded in an answer message, since the length is +%% computed. +%% +%% Data is a truncated header if command_code = undefined, otherwise +%% payload bytes. The former is padded to the length of a header if +%% the AVP reaches an outgoing encode in diameter_codec. +%% +%% RFC 6733 says that an AVP returned with 5014 can contain a minimal +%% payload for the AVP's type, but in this case we don't know the +%% type. + +pack_AVP(_, #diameter_avp{data = <<0:1, Data/binary>>} = Avp, Acc) -> + {Rec, Failed} = Acc, + {Rec, [{5014, Avp#diameter_avp{data = Data}} | Failed]}; + pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> case pack_arity(Name, M) of 0 -> @@ -422,7 +465,15 @@ pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> %% Give Failed-AVP special treatment since it'll contain any %% unrecognized mandatory AVP's. pack_arity(Name, M) -> - case Name /= 'Failed-AVP' andalso M andalso is_strict() of + NF = Name /= 'Failed-AVP' andalso not is_failed(), + %% Not testing just Name /= 'Failed-AVP' means we're changing the + %% packing of AVPs nested within Failed-AVP, but the point of + %% ignoring errors within Failed-AVP is to decode as much as + %% possible, and failing because a mandatory AVP couldn't be + %% packed into a dedicated field defeats that point. Note that we + %% can't just test not is_failed() since this will be 'true' when + %% packing an unknown AVP directly within Failed-AVP. + case NF andalso M andalso is_strict() of true -> 0; false -> diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 0de4d53973..06a4f5de64 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -70,12 +70,15 @@ encode(Mod, #diameter_packet{} = Pkt) -> try e(Mod, Pkt) catch + exit: {Reason, Stack, #diameter_header{} = H} = T -> + %% Exit with a header in the reason to let the caller + %% count encode errors. + ?LOG(encode_error, {Reason, Stack, H}), + exit({?MODULE, encode, T}); error: Reason -> - %% Be verbose since a crash report may be truncated and - %% encode errors are self-inflicted. - X = {?MODULE, encode, {Reason, ?STACK}}, - diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), - exit(X) + T = {Reason, diameter_lib:get_stacktrace()}, + ?LOG(encode_error, T), + exit({?MODULE, encode, T}) end; encode(Mod, Msg) -> @@ -87,53 +90,62 @@ encode(Mod, Msg) -> msg = Msg}). e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - Avps = encode_avps(As), - Length = size(Avps) + 20, - - #diameter_header{version = Vsn, - cmd_code = Code, - application_id = Aid, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - Flags = make_flags(0, Hdr), - - Pkt#diameter_packet{header = Hdr, - bin = <<Vsn:8, Length:24, - Flags:8, Code:24, - Aid:32, - Hid:32, - Eid:32, - Avps/binary>>}; + try encode_avps(As) of + Avps -> + Length = size(Avps) + 20, + + #diameter_header{version = Vsn, + cmd_code = Code, + application_id = Aid, + hop_by_hop_id = Hid, + end_to_end_id = Eid} + = Hdr, + + Flags = make_flags(0, Hdr), + + Pkt#diameter_packet{header = Hdr, + bin = <<Vsn:8, Length:24, + Flags:8, Code:24, + Aid:32, + Hid:32, + Eid:32, + Avps/binary>>} + catch + error: Reason -> + exit({Reason, diameter_lib:get_stacktrace(), Hdr}) + end; -e(Mod, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> +e(Mod, #diameter_packet{header = Hdr0, msg = Msg} = Pkt) -> #diameter_header{version = Vsn, hop_by_hop_id = Hid, end_to_end_id = Eid} - = Hdr, + = Hdr0, MsgName = rec2msg(Mod, Msg), - {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), - Flags = make_flags(Flags0, Hdr), - - Avps = encode_avps(Mod, MsgName, values(Msg)), - Length = size(Avps) + 20, - - Pkt#diameter_packet{header = Hdr#diameter_header - {length = Length, - cmd_code = Code, - application_id = Aid, - is_request = 0 /= ?MASK(7, Flags), - is_proxiable = 0 /= ?MASK(6, Flags), - is_error = 0 /= ?MASK(5, Flags), - is_retransmitted = 0 /= ?MASK(4, Flags)}, - bin = <<Vsn:8, Length:24, - Flags:8, Code:24, - Aid:32, - Hid:32, - Eid:32, - Avps/binary>>}. + {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr0), + Flags = make_flags(Flags0, Hdr0), + Hdr = Hdr0#diameter_header{cmd_code = Code, + application_id = Aid, + is_request = 0 /= ?MASK(7, Flags), + is_proxiable = 0 /= ?MASK(6, Flags), + is_error = 0 /= ?MASK(5, Flags), + is_retransmitted = 0 /= ?MASK(4, Flags)}, + Values = values(Msg), + + try encode_avps(Mod, MsgName, Values) of + Avps -> + Length = size(Avps) + 20, + Pkt#diameter_packet{header = Hdr#diameter_header{length = Length}, + bin = <<Vsn:8, Length:24, + Flags:8, Code:24, + Aid:32, + Hid:32, + Eid:32, + Avps/binary>>} + catch + error: Reason -> + exit({Reason, diameter_lib:get_stacktrace(), Hdr}) + end. %% make_flags/2 @@ -225,7 +237,7 @@ rec2msg(Mod, Rec) -> %% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. --spec decode(module(), #diameter_packet{} | bitstring()) +-spec decode(module(), #diameter_packet{} | binary()) -> #diameter_packet{}. decode(Mod, Pkt) -> @@ -259,34 +271,34 @@ decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) -> decode_avps(MsgName, Mod, Pkt, collect_avps(Pkt)); decode(Id, Mod, Bin) - when is_bitstring(Bin) -> + when is_binary(Bin) -> decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). decode_avps(MsgName, Mod, Pkt, {E, Avps}) -> - ?LOG(invalid, Pkt#diameter_packet.bin), + ?LOG(invalid_avp_length, Pkt#diameter_packet.header), #diameter_packet{errors = Failed} = P = decode_avps(MsgName, Mod, Pkt, Avps), P#diameter_packet{errors = [E | Failed]}; -decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... - ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), +decode_avps('', _, Pkt, Avps) -> %% unknown message ... + ?LOG(unknown_message, Pkt#diameter_packet.header), Pkt#diameter_packet{avps = lists:reverse(Avps), errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED %% msg = undefined identifies this case. decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not - {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), - ?LOGC([] /= Failed, failed, {Mod, Failed}), + {Rec, As, Errors} = Mod:decode_avps(MsgName, Avps), + ?LOGC([] /= Errors, decode_errors, Pkt#diameter_packet.header), Pkt#diameter_packet{msg = Rec, - errors = Failed, + errors = Errors, avps = As}. %%% --------------------------------------------------------------------------- %%% # decode_header/1 %%% --------------------------------------------------------------------------- --spec decode_header(bitstring()) +-spec decode_header(binary()) -> #diameter_header{} | false. @@ -297,7 +309,7 @@ decode_header(<<Version:8, ApplicationId:32, HopByHopId:32, EndToEndId:32, - _/bitstring>>) -> + _/binary>>) -> <<R:1, P:1, E:1, T:1, _:4>> = CmdFlags, %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored @@ -410,7 +422,7 @@ msg_id(#diameter_header{application_id = A, is_request = R}) -> {A, C, if R -> 1; true -> 0 end}; -msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> +msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) -> {ApplId, CmdCode, Rbit}. %%% --------------------------------------------------------------------------- @@ -421,17 +433,18 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> %% order in the binary. Note also that grouped avp's aren't unraveled, %% only those at the top level. --spec collect_avps(#diameter_packet{} | bitstring()) +-spec collect_avps(#diameter_packet{} | binary()) -> [Avp] | {Error, [Avp]} when Avp :: #diameter_avp{}, Error :: {5014, #diameter_avp{}}. collect_avps(#diameter_packet{bin = Bin}) -> - <<_:20/binary, Avps/bitstring>> = Bin, + <<_:20/binary, Avps/binary>> = Bin, collect_avps(Avps); -collect_avps(Bin) -> +collect_avps(Bin) + when is_binary(Bin) -> collect_avps(Bin, 0, []). collect_avps(<<>>, _, Acc) -> @@ -461,7 +474,9 @@ collect_avps(Bin, N, Acc) -> split_avp(Bin) -> {Code, V, M, P, Len, HdrLen} = split_head(Bin), - {Data, B} = split_data(Bin, HdrLen, Len - HdrLen), + + <<_:HdrLen/binary, Rest/binary>> = Bin, + {Data, B} = split_data(Rest, Len - HdrLen), {B, #diameter_avp{code = Code, vendor_id = V, @@ -471,17 +486,15 @@ split_avp(Bin) -> %% split_head/1 -split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/bitstring>>) -> +split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/binary>>) -> {Code, V, M, P, Len, 12}; -split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/bitstring>>) -> +split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/binary>>) -> {Code, undefined, M, P, Len, 8}; -%% Header is truncated: pack_avp/1 will pad to the minimum header -%% length. -split_head(B) - when is_bitstring(B) -> - ?THROW({5014, #diameter_avp{data = B}}). +%% Header is truncated. +split_head(Bin) -> + ?THROW({5014, #diameter_avp{data = Bin}}). %% 3588: %% @@ -516,34 +529,27 @@ split_head(B) %% split_data/3 -split_data(Bin, HdrLen, Len) - when 0 =< Len -> - split_data(Bin, HdrLen, Len, (4 - (Len rem 4)) rem 4); +split_data(Bin, Len) -> + Pad = (4 - (Len rem 4)) rem 4, -split_data(_, _, _) -> - invalid_avp_length(). + %% Len might be negative here, but that ensures the failure of the + %% binary match. -%% split_data/4 - -split_data(Bin, HdrLen, Len, Pad) -> case Bin of - <<_:HdrLen/binary, Data:Len/binary, _:Pad/binary, Rest/bitstring>> -> + <<Data:Len/binary, _:Pad/binary, Rest/binary>> -> {Data, Rest}; _ -> - invalid_avp_length() + %% Header length points past the end of the message. As + %% stated in the 6733 text above, it's sufficient to + %% return a zero-filled minimal payload if this is a + %% request. Do this (in cases that we know the type) by + %% inducing a decode failure and letting the dictionary's + %% decode (in diameter_gen) deal with it. Here we don't + %% know type. If the type isn't known, then the decode + %% just strips the extra bit. + {<<0:1, Bin/binary>>, <<>>} end. -%% invalid_avp_length/0 -%% -%% AVP Length doesn't mesh with payload. Induce a decode error by -%% returning a payload that no valid Diameter type can have. This is -%% so that a known AVP will result in 5014 error with a zero'd -%% payload. Here we simply don't know how to construct this payload. -%% (Yes, this solution is an afterthought.) - -invalid_avp_length() -> - {<<0:1>>, <<>>}. - %%% --------------------------------------------------------------------------- %%% # pack_avp/1 %%% --------------------------------------------------------------------------- @@ -575,17 +581,23 @@ pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> {Name, Type} = Dict:avp_name(Code, Vid), pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); +%% ... with a truncated header ... pack_avp(#diameter_avp{code = undefined, data = B}) - when is_bitstring(B) -> + when is_binary(B) -> %% Reset the AVP Length of an AVP Header resulting from a 5014 %% error. The RFC doesn't explicitly say to do this but the %% receiver can't correctly extract this and following AVP's %% without a correct length. On the downside, the header doesn't %% reveal if the received header has been padded. Pad = 8*header_length(B) - bit_size(B), - Len = size(<<H:5/binary, _:24, T/binary>> = <<B/bitstring, 0:Pad>>), + Len = size(<<H:5/binary, _:24, T/binary>> = <<B/binary, 0:Pad>>), <<H/binary, Len:24, T/binary>>; +%% ... from a dictionary compiled against old code in diameter_gen ... +%% ... when ignoring errors in Failed-AVP ... +pack_avp(#diameter_avp{data = <<0:1, B/binary>>} = A) -> + pack_avp(A#diameter_avp{data = B}); + %% ... or as an iolist. pack_avp(#diameter_avp{code = Code, vendor_id = V, diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index f5ea459fd0..dd1c9b73bb 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -753,7 +753,7 @@ app_acc({application, Opts} = T, Acc) -> Alias = get_opt(alias, Opts, Dict), ModS = get_opt(state, Opts, Alias), M = get_opt(call_mutates_state, Opts, false, [true]), - A = get_opt(answer_errors, Opts, report, [callback, discard]), + A = get_opt(answer_errors, Opts, discard, [callback, report]), P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]), [#diameter_app{alias = Alias, dictionary = Dict, diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl index 44d81e2778..5b3a2063f8 100644 --- a/lib/diameter/src/base/diameter_lib.erl +++ b/lib/diameter/src/base/diameter_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,6 +25,8 @@ now_diff/1, time/1, eval/1, + eval_name/1, + get_stacktrace/0, ipaddr/1, spawn_opts/2, wait/1, @@ -32,6 +34,22 @@ log/4]). %% --------------------------------------------------------------------------- +%% # get_stacktrace/0 +%% --------------------------------------------------------------------------- + +%% Return a stacktrace with a leading, potentially large, argument +%% list replaced by an arity. Trace on stacktrace/0 to see the +%% original. + +get_stacktrace() -> + stacktrace(erlang:get_stacktrace()). + +stacktrace([{M,F,A,L} | T]) when is_list(A) -> + [{M, F, length(A), L} | T]; +stacktrace(L) -> + L. + +%% --------------------------------------------------------------------------- %% # info_report/2 %% --------------------------------------------------------------------------- @@ -60,9 +78,17 @@ warning_report(Reason, T) -> report(fun error_logger:warning_report/1, Reason, T). report(Fun, Reason, T) -> - Fun([{why, Reason}, {who, self()}, {what, T}]), + Fun(io_lib:format("diameter: ~" ++ fmt(Reason) ++ "~n ~p~n", + [Reason, T])), false. +fmt(T) -> + if is_list(T) -> + "s"; + true -> + "p" + end. + %% --------------------------------------------------------------------------- %% # now_diff/1 %% --------------------------------------------------------------------------- @@ -129,8 +155,8 @@ eval({M,F,A}) -> eval([{M,F,A} | X]) -> apply(M, F, X ++ A); -eval([[F|A] | X]) -> - eval([F | X ++ A]); +eval([[F|X] | A]) -> + eval([F | A ++ X]); eval([F|A]) -> apply(F,A); @@ -142,6 +168,28 @@ eval(F) -> F(). %% --------------------------------------------------------------------------- +%% eval_name/1 +%% --------------------------------------------------------------------------- + +eval_name({M,F,A}) -> + {M, F, length(A)}; + +eval_name([{M,F,A} | X]) -> + {M, F, length(A) + length(X)}; + +eval_name([[F|A] | X]) -> + eval_name([F | X ++ A]); + +eval_name([F|_]) -> + F; + +eval_name({F}) -> + eval_name(F); + +eval_name(F) -> + F. + +%% --------------------------------------------------------------------------- %% # ipaddr/1 %% %% Parse an IP address. diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index f76bd96c3c..31e570ae20 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -283,7 +283,7 @@ handle_info(T, #state{} = State) -> ok -> {noreply, State}; #state{state = X} = S -> - ?LOGC(X =/= State#state.state, transition, X), + ?LOGC(X /= State#state.state, transition, X), {noreply, S}; {stop, Reason} -> ?LOG(stop, Reason), @@ -292,15 +292,12 @@ handle_info(T, #state{} = State) -> ?LOG(stop, T), {stop, {shutdown, T}, State} catch - exit: {diameter_codec, encode, _} = Reason -> + exit: {diameter_codec, encode, T} = Reason -> + incr_error(send, T, State#state.dictionary), ?LOG(stop, Reason), - %% diameter_codec:encode/2 emits an error report. Only - %% indicate the probable reason here. - diameter_lib:info_report(probable_configuration_error, - insufficient_capabilities), {stop, {shutdown, Reason}, State}; {?MODULE, Tag, Reason} -> - ?LOG(Tag, {Reason, T}), + ?LOG(stop, Tag), {stop, {shutdown, Reason}, State} end. %% The form of the throw caught here is historical. It's @@ -476,12 +473,12 @@ send_CER(#state{state = {'Wait-Conn-Ack', Tmo}, orelse close({already_connected, Remote, LCaps}), CER = build_CER(S), - ?LOG(send, 'CER'), #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid}} = Pkt = encode(CER, Dict), send(TPid, Pkt), + ?LOG(send, 'CER'), start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}). %% Register ourselves as connecting to the remote endpoint in @@ -526,7 +523,6 @@ recv(#diameter_packet{header = #diameter_header{} = Hdr} = S) -> Name = diameter_codec:msg_name(Dict0, Hdr), Pid ! {recv, self(), Name, Pkt}, - diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received rcv(Name, Pkt, S); recv(#diameter_packet{header = undefined, @@ -553,42 +549,30 @@ recv(#diameter_header{length = Len} recv(#diameter_header{} = H, #diameter_packet{bin = Bin}, - #state{length_errors = E} - = S) -> - invalid(E, - invalid_message_length, - recv, - [size(Bin), bit_size(Bin) rem 8, H, S]); + #state{length_errors = E}) -> + T = {size(Bin), bit_size(Bin) rem 8, H}, + invalid(E, message_length_mismatch, T); -recv(false, Pkt, #state{length_errors = E} = S) -> - invalid(E, truncated_header, recv, [Pkt, S]). +recv(false, #diameter_packet{bin = Bin}, #state{length_errors = E}) -> + invalid(E, truncated_header, Bin). %% Note that counters here only count discarded messages. -invalid(E, Reason, F, A) -> +invalid(E, Reason, T) -> diameter_stats:incr(Reason), - abort(E, Reason, F, A). - -abort(exit, Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}); - -abort(_, _, _, _) -> + E == exit andalso close({Reason, T}), + ?LOG(Reason, T), ok. -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - {_,_,_} = diameter_codec:msg_id(Hdr). - %% rcv/3 %% Incoming CEA. -rcv('CEA', +rcv('CEA' = N, #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid}} = Pkt, #state{state = {'Wait-CEA', Hid, Eid}} = S) -> + ?LOG(recv, N), handle_CEA(Pkt, S); %% Incoming CER @@ -609,34 +593,71 @@ rcv('DPR' = N, Pkt, S) -> %% DPA in response to DPR and with the expected identifiers. rcv('DPA' = N, #diameter_packet{header = #diameter_header{end_to_end_id = Eid, - hop_by_hop_id = Hid}}, - #state{transport = TPid, + hop_by_hop_id = Hid} + = H} + = Pkt, + #state{dictionary = Dict0, + transport = TPid, dpr = {Hid, Eid}}) -> + ?LOG(recv, N), + incr(recv, H, Dict0), + incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0), diameter_peer:close(TPid), {stop, N}; %% Ignore anything else, an unsolicited DPA in particular. +rcv(N, #diameter_packet{header = H}, _) + when N == 'CER'; + N == 'CEA'; + N == 'DPR'; + N == 'DPA' -> + ?LOG(ignored, N), + %% Note that these aren't counted in the normal recv counter. + diameter_stats:incr({diameter_codec:msg_id(H), recv, ignored}), + ok; + rcv(_, _, _) -> ok. +%% incr/3 + +incr(Dir, Hdr, Dict0) -> + diameter_traffic:incr(Dir, Hdr, self(), Dict0). + +%% incr_rc/3 + +incr_rc(Dir, Pkt, Dict0) -> + diameter_traffic:incr_rc(Dir, Pkt, self(), Dict0). + +%% incr_error/3 + +incr_error(Dir, Pkt, Dict0) -> + diameter_traffic:incr_error(Dir, Pkt, self(), Dict0). + %% send/2 %% Msg here could be a #diameter_packet or a binary depending on who's %% sending. In particular, the watchdog will send DWR as a binary %% while messages coming from clients will be in a #diameter_packet. send(Pid, Msg) -> - diameter_stats:incr({diameter_codec:msg_id(Msg), send}), diameter_peer:send(Pid, Msg). %% handle_request/3 +%% +%% Incoming CER or DPR. -handle_request(Type, #diameter_packet{} = Pkt, #state{dictionary = D} = S) -> - ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(D, Pkt), S). +handle_request(Name, + #diameter_packet{header = H} = Pkt, + #state{dictionary = Dict0} = S) -> + ?LOG(recv, Name), + incr(recv, H, Dict0), + send_answer(Name, diameter_codec:decode(Dict0, Pkt), S). %% send_answer/3 send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) -> + incr_error(recv, ReqPkt, Dict), + #diameter_packet{header = H, transport_data = TD} = ReqPkt, @@ -653,13 +674,19 @@ send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) -> msg = Msg, transport_data = TD}, - send(TPid, diameter_codec:encode(Dict, Pkt)), + AnsPkt = diameter_codec:encode(Dict, Pkt), + + incr(send, AnsPkt, Dict), + incr_rc(send, AnsPkt, Dict), + send(TPid, AnsPkt), + ?LOG(send, ans(Type)), eval(PostF, S). +ans('CER') -> 'CEA'; +ans('DPR') -> 'DPA'. + eval([F|A], S) -> apply(F, A ++ [S]); -eval(ok, S) -> - S; eval(T, _) -> close(T). @@ -723,8 +750,8 @@ cea(CEA, RC, Dict0) -> post('CER' = T, RC, Pkt, S) -> {T, caps(S), {RC, Pkt}}; -post('DPR', _, _, _) -> - ok. +post('DPR' = T, _, _, #state{parent = Pid}) -> + [fun(S) -> Pid ! {T, self()}, S end]. rejected({capabilities_cb, _F, Reason}, T, S) -> rejected(Reason, T, S); @@ -734,7 +761,7 @@ rejected(discard, T, _) -> rejected({N, Es}, T, S) -> {answer('CER', N, failed_avp(N, Es), S), T}; rejected(N, T, S) -> - rejected({N, []}, T, S). + {answer('CER', N, [], S), T}. failed_avp(RC, [{RC, Avp} | _]) -> [{'Failed-AVP', [[{'AVP', [Avp]}]]}]; @@ -848,28 +875,27 @@ recv_CER(CER, #state{service = Svc, dictionary = Dict}) -> close({'CER', CER, Svc, Dict, Reason}) end. -%% handle_CEA/1 +%% handle_CEA/2 -handle_CEA(#diameter_packet{bin = Bin} +handle_CEA(#diameter_packet{header = H} = Pkt, #state{dictionary = Dict0, service = #diameter_service{capabilities = LCaps}} - = S) - when is_binary(Bin) -> - ?LOG(recv, 'CEA'), + = S) -> + incr(recv, H, Dict0), - #diameter_packet{msg = CEA} + #diameter_packet{} = DPkt = diameter_codec:decode(Dict0, Pkt), + RC = result_code(incr_rc(recv, DPkt, Dict0)), + {SApps, IS, RCaps} = recv_CEA(DPkt, S), #diameter_caps{origin_host = {OH, DH}} = Caps = capz(LCaps, RCaps), - RC = Dict0:'#get-'('Result-Code', CEA), - %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the %% sense that, since we don't know who we're talking to until we @@ -877,7 +903,7 @@ handle_CEA(#diameter_packet{bin = Bin} %% connection with the peer. try - ?IS_SUCCESS(RC) + is_integer(RC) andalso ?IS_SUCCESS(RC) orelse ?THROW(RC), [] == SApps andalso ?THROW(no_common_application), @@ -897,6 +923,11 @@ handle_CEA(#diameter_packet{bin = Bin} %% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002, %% even if this isn't required by RFC 3588. +result_code({'Result-Code', N}) -> + N; +result_code(_) -> + undefined. + %% recv_CEA/2 recv_CEA(#diameter_packet{header = #diameter_header{version @@ -988,19 +1019,13 @@ capz(#diameter_caps{} = L, #diameter_caps{} = R) -> tl(tuple_to_list(R)))]). %% close/1 +%% +%% A good function to trace on in case of problems with capabilities +%% exchange. close(Reason) -> - report(Reason), throw({?MODULE, close, Reason}). -%% Could possibly log more here. -report({M, _, _, _, _} = T) - when M == 'CER'; - M == 'CEA' -> - diameter_lib:error_report(failure, T); -report(_) -> - ok. - %% dpr/2 %% %% The RFC isn't clear on whether DPR should be send in a non-Open @@ -1034,7 +1059,7 @@ dpr(_Reason, _S) -> %% process and contact it. (eg. diameter:service_info/2) dpr([CB|Rest], [Reason | _] = Args, S) -> - try diameter_lib:eval([CB | Args]) of + case diameter_lib:eval([CB | Args]) of {dpr, Opts} when is_list(Opts) -> send_dpr(Reason, Opts, S); dpr -> @@ -1044,14 +1069,7 @@ dpr([CB|Rest], [Reason | _] = Args, S) -> ignore -> dpr(Rest, Args, S); T -> - No = {disconnect_cb, T}, - diameter_lib:error_report(invalid, No), - {stop, No} - catch - E:R -> - No = {disconnect_cb, E, R, ?STACK}, - diameter_lib:error_report(failure, No), - {stop, No} + ?ERROR({disconnect_cb, CB, Args, T}) end; dpr([], [Reason | _], S) -> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 8914992f17..b7cd311e02 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -499,9 +499,21 @@ transition(Req, S) -> %% # terminate/2 %% --------------------------------------------------------------------------- -terminate(Reason, #state{service_name = Name} = S) -> +terminate(Reason, #state{service_name = Name, peerT = PeerT} = S) -> send_event(Name, stop), ets:delete(?STATE_TABLE, Name), + + %% Communicate pending loss of any peers that connection_down/3 + %% won't. This is needed when stopping a service since we don't + %% wait for watchdog state changes to take care of if. That this + %% takes place after deleting the state entry ensures that the + %% resulting failover by request processes accomplishes nothing. + ets:foldl(fun(#peer{pid = TPid}, _) -> + diameter_traffic:peer_down(TPid) + end, + ok, + PeerT), + shutdown == Reason %% application shutdown andalso shutdown(application, S). @@ -719,14 +731,27 @@ remotes(F) -> L when is_list(L) -> L; T -> - diameter_lib:error_report({invalid_return, T}, F), + ?LOG(invalid_return, {F,T}), + error_report(invalid_return, share_peers, F), [] catch E:R -> - diameter_lib:error_report({failure, {E, R, ?STACK}}, F), + ?LOG(failure, {E, R, F, diameter_lib:get_stacktrace()}), + error_report(failure, share_peers, F), [] end. +%% error_report/3 + +error_report(T, What, F) -> + Reason = io_lib:format("~s from ~p callback", [reason(T), What]), + diameter_lib:error_report(Reason, diameter_lib:eval_name(F)). + +reason(invalid_return) -> + "invalid return"; +reason(failure) -> + "failure". + %% --------------------------------------------------------------------------- %% # start/3 %% --------------------------------------------------------------------------- @@ -869,7 +894,7 @@ watchdog(TPid, [], ?WD_OKAY, ?WD_SUSPECT = To, Wd, State) -> %% Watchdog has lost its connection. watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{peerT = PeerT} = S) -> - close(Wd, S), + close(Wd), watchdog_down(Wd, To, S), ets:delete(PeerT, TPid); @@ -1026,8 +1051,11 @@ peer_cb(App, F, A) -> true catch E:R -> - diameter_lib:error_report({failure, {E, R, ?STACK}}, - {App, F, A}), + %% Don't include arguments since a #diameter_caps{} strings + %% from the peer, which could be anything (especially, large). + [Mod|X] = App#diameter_app.module, + ?LOG(failure, {E, R, Mod, F, diameter_lib:get_stacktrace()}), + error_report(failure, F, {Mod, F, A ++ X}), false end. @@ -1187,26 +1215,16 @@ tc(false = No, _, _) -> %% removed %% another watchdog to be able to detect that it should transition %% from initial into reopen rather than okay. That someone is either %% the accepting watchdog upon reception of a CER from the previously -%% connected peer, or us after connect_timer timeout. +%% connected peer, or us after connect_timer timeout or immediately. -close(#watchdog{type = connect}, _) -> +close(#watchdog{type = connect}) -> ok; + close(#watchdog{type = accept, pid = Pid, - ref = Ref, - options = Opts}, - #state{service_name = SvcName}) -> - c(Pid, diameter_config:have_transport(SvcName, Ref), Opts). - -%% Tell watchdog to (maybe) die later ... -c(Pid, true, Opts) -> + options = Opts}) -> Tc = connect_timer(Opts, 2*?DEFAULT_TC), - erlang:send_after(Tc, Pid, close); - -%% ... or now. -c(Pid, false, _Opts) -> - Pid ! close. - + erlang:send_after(Tc, Pid, close). %% The RFC's only document the behaviour of Tc, our connect_timer, %% for the establishment of connections but we also give %% connect_timer semantics for a listener, being the time within @@ -1260,13 +1278,14 @@ cm([#diameter_app{alias = Alias} = App], Req, From, Svc) -> mod_state(Alias, ModS), {T, RC}; T -> - diameter_lib:error_report({invalid, T}, - {App, handle_call, Args}), + ModX = App#diameter_app.module, + ?LOG(invalid_return, {ModX, handle_call, Args, T}), invalid catch E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, - {App, handle_call, Args}), + ModX = App#diameter_app.module, + Stack = diameter_lib:get_stacktrace(), + ?LOG(failure, {E, Reason, ModX, handle_call, Stack}), failure end; @@ -1424,13 +1443,16 @@ pick_peer(Local, T; %% Accept returned state in the immutable {false = No, S} -> %% case as long it isn't changed. No; - T -> - diameter_lib:error_report({invalid, T, App}, - {App, pick_peer, Args}) + T when M -> + ModX = App#diameter_app.module, + ?LOG(invalid_return, {ModX, pick_peer, T}), + false catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, - {App, pick_peer, Args}) + E: Reason when M -> + ModX = App#diameter_app.module, + Stack = diameter_lib:get_stacktrace(), + ?LOG(failure, {E, Reason, ModX, pick_peer, Stack}), + false end. %% peers/4 diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 7fbb306b02..5fac61f416 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -31,6 +31,11 @@ %% towards diameter_watchdog -export([receive_message/4]). +%% towards diameter_peer_fsm and diameter_watchdog +-export([incr/4, + incr_error/4, + incr_rc/4]). + %% towards diameter_service -export([make_recvdata/1, peer_up/1, @@ -44,6 +49,8 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). +-define(LOGX(Reason, T), begin ?LOG(Reason, T), x({Reason, T}) end). + -define(RELAY, ?DIAMETER_DICT_RELAY). -define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary @@ -109,6 +116,67 @@ peer_down(TPid) -> failover(TPid). %% --------------------------------------------------------------------------- +%% incr/4 +%% --------------------------------------------------------------------------- + +incr(Dir, #diameter_packet{header = H}, TPid, Dict) -> + incr(Dir, H, TPid, Dict); + +incr(Dir, #diameter_header{} = H, TPid, Dict) -> + incr(TPid, {msg_id(H, Dict), Dir}). + +%% --------------------------------------------------------------------------- +%% incr_error/4 +%% --------------------------------------------------------------------------- + +%% Decoded message without errors. +incr_error(recv, #diameter_packet{errors = []}, _, _) -> + ok; + +incr_error(recv = D, #diameter_packet{header = H}, TPid, Dict) -> + incr_error(D, H, TPid, Dict); + +%% Encoded message with errors and an identifiable header ... +incr_error(send = D, {_, _, #diameter_header{} = H}, TPid, Dict) -> + incr_error(D, H, TPid, Dict); + +%% ... or not. +incr_error(send = D, {_,_}, TPid, _) -> + incr_error(D, unknown, TPid); + +incr_error(Dir, #diameter_header{} = H, TPid, Dict) -> + incr_error(Dir, msg_id(H, Dict), TPid); + +incr_error(Dir, Id, TPid, _) -> + incr_error(Dir, Id, TPid). + +incr_error(Dir, Id, TPid) -> + incr(TPid, {Id, Dir, error}). + +%% --------------------------------------------------------------------------- +%% incr_rc/4 +%% --------------------------------------------------------------------------- + +-spec incr_rc(send|recv, Pkt, TPid, Dict0) + -> {Counter, non_neg_integer()} + | Reason + when Pkt :: #diameter_packet{}, + TPid :: pid(), + Dict0 :: module(), + Counter :: {'Result-Code', integer()} + | {'Experimental-Result', integer(), integer()}, + Reason :: atom(). + +incr_rc(Dir, Pkt, TPid, Dict0) -> + try + incr_rc(Dir, Pkt, Dict0, TPid, Dict0) + catch + exit: {E,_} when E == no_result_code; + E == invalid_error_bit -> + E + end. + +%% --------------------------------------------------------------------------- %% pending/1 %% --------------------------------------------------------------------------- @@ -182,7 +250,7 @@ spawn_request(TPid, Pkt, Dict0, Opts, RecvData) -> spawn_opt(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end, Opts) catch error: system_limit = E -> %% discard - ?LOG({error, E}, now()) + ?LOG(error, E) end. %% --------------------------------------------------------------------------- @@ -211,7 +279,9 @@ recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, Pkt0, Dict0, RecvData) -> + incr(recv, Pkt0, TPid, Dict), Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), + incr_error(recv, Pkt, TPid, Dict), {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; %% Note that the decode is different depending on whether or not Id is %% ?APP_ID_RELAY. @@ -283,23 +353,25 @@ rc(N) -> %% This error is returned when a request is received with an invalid %% message length. -errors(_, #diameter_packet{header = #diameter_header{length = Len}, +errors(_, #diameter_packet{header = #diameter_header{length = Len} = H, bin = Bin, errors = Es} = Pkt) when Len < 20; 0 /= Len rem 4; 8*Len /= bit_size(Bin) -> + ?LOG(invalid_message_length, {H, bit_size(Bin)}), Pkt#diameter_packet{errors = [5015 | Es]}; %% DIAMETER_UNSUPPORTED_VERSION 5011 %% This error is returned when a request was received, whose version %% number is unsupported. -errors(_, #diameter_packet{header = #diameter_header{version = V}, +errors(_, #diameter_packet{header = #diameter_header{version = V} = H, errors = Es} = Pkt) when V /= ?DIAMETER_VERSION -> + ?LOG(unsupported_version, H), Pkt#diameter_packet{errors = [5011 | Es]}; %% DIAMETER_COMMAND_UNSUPPORTED 3001 @@ -307,12 +379,13 @@ errors(_, #diameter_packet{header = #diameter_header{version = V}, %% recognize or support. This MUST be used when a Diameter node %% receives an experimental command that it does not understand. -errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, +errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P} = H, msg = M, errors = Es} = Pkt) when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command ?APP_ID_RELAY == Id, not P -> %% command isn't proxiable + ?LOG(command_unsupported, H), Pkt#diameter_packet{errors = [3001 | Es]}; %% DIAMETER_INVALID_HDR_BITS 3008 @@ -321,9 +394,11 @@ errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, %% inconsistent with the command code's definition. errors(_, #diameter_packet{header = #diameter_header{is_request = true, - is_error = true}, + is_error = true} + = H, errors = Es} = Pkt) -> + ?LOG(invalid_hdr_bits, H), Pkt#diameter_packet{errors = [3008 | Es]}; %% Green. @@ -479,7 +554,6 @@ answer_message(RC, origin_realm = {OR,_}}, Dict0, Pkt) -> - ?LOG({error, RC}, Pkt), {Dict0, answer_message(OH, OR, RC, Dict0, Pkt)}. %% resend/7 @@ -595,9 +669,11 @@ reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> Pkt = encode(Dict, + TPid, reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0), Fs), - incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes + incr(send, Pkt, TPid, Dict), + incr_rc(send, Pkt, Dict, TPid, Dict0), %% count outgoing send(TPid, Pkt). %% reset/3 @@ -962,35 +1038,48 @@ find(Pred, [H|T]) -> %% code, the missing vendor id, and a zero filled payload of the minimum %% required length for the omitted AVP will be added. -%% incr/4 +%% incr_rc/5 %% %% Increment a stats counter for result codes in incoming and outgoing %% answers. %% Outgoing message as binary: don't count. (Sending binaries is only %% partially supported.) -incr(_, #diameter_packet{msg = undefined}, _, _, _) -> - ok; - -%% Incoming with decode errors. -incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) -> - incr(TPid, {diameter_codec:msg_id(H), D, error}); +incr_rc(_, #diameter_packet{msg = undefined = No}, _, _, _) -> + No; -%% Incoming without errors or outgoing. Outgoing with encode errors -%% never gets here since encode fails. -incr(Dir, Pkt, Dict, TPid, Dict0) -> +%% Incoming or outgoing. Outgoing with encode errors never gets here +%% since encode fails. +incr_rc(Dir, Pkt, Dict, TPid, Dict0) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, - msg = Rec} + msg = Msg, + errors = Es} = Pkt, - RC = int(get_avp_value(Dict, 'Result-Code', Rec)), + Id = msg_id(Hdr, Dict), + + %% Count incoming decode errors. + recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, Dict), - %% Exit on an improper Result-Code. + %% Exit on a missing result code. + T = rc_counter(Dict, Msg), + T == false andalso ?LOGX(no_result_code, {Dict, Dir, Hdr}), + {Ctr, RC} = T, + + %% Or on an inappropriate value. is_result(RC, E, Dict0) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), + orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, RC}), + + incr(TPid, {Id, Dir, Ctr}), + Ctr. - irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). +%% Only count on known keeps so as not to be vulnerable to attack: +%% there are 2^32 (application ids) * 2^24 (command codes) * 2 (R-bits) +%% = 2^57 Ids for an attacker to choose from. +msg_id(Hdr, Dict) -> + {_ApplId, Code, R} = Id = diameter_codec:msg_id(Hdr), + choose('' == Dict:msg_name(Code, 0 == R), unknown, Id). %% No E-bit: can't be 3xxx. is_result(RC, false, _Dict0) -> @@ -1006,12 +1095,6 @@ is_result(RC, true, _) -> orelse 5000 =< RC andalso RC < 6000. -irc(_, _, _, undefined) -> - false; - -irc(TPid, Hdr, Dir, Ctr) -> - incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - %% incr/2 incr(TPid, Counter) -> @@ -1024,14 +1107,16 @@ incr(TPid, Counter) -> %% All Diameter answer messages defined in vendor-specific %% applications MUST include either one Result-Code AVP or one %% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. -rc_counter(Dict, Rec, undefined) -> - rcc(get_avp_value(Dict, 'Experimental-Result', Rec)); -rc_counter(_, _, RC) -> - {'Result-Code', RC}. +rc_counter(Dict, Msg) -> + rcc(Dict, Msg, int(get_avp_value(Dict, 'Result-Code', Msg))). + +rcc(Dict, Msg, undefined) -> + rcc(get_avp_value(Dict, 'Experimental-Result', Msg)); + +rcc(_, _, N) + when is_integer(N) -> + {{'Result-Code', N}, N}. %% Outgoing answers may be in any of the forms messages can be sent %% in. Incoming messages will be records. We're assuming here that the @@ -1039,12 +1124,12 @@ rc_counter(_, _, RC) -> rcc([{_,_,N} = T | _]) when is_integer(N) -> - T; + {T,N}; rcc({_,_,N} = T) when is_integer(N) -> - T; + {T,N}; rcc(_) -> - undefined. + false. %% Extract the first good looking integer. There's no guarantee %% that what we're looking for has arity 1. @@ -1057,13 +1142,6 @@ int(N) int(_) -> undefined. --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - x(T) -> exit(T). @@ -1305,7 +1383,7 @@ send_R(Pkt0, {Pid, Ref}, SvcName, Fs) -> - Pkt = encode(Dict, Pkt0, Fs), + Pkt = encode(Dict, TPid, Pkt0, Fs), #options{timeout = Timeout} = Opts, @@ -1370,11 +1448,19 @@ handle_answer(SvcName, %% want to examine the answer? handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> + incr(recv, Pkt, TPid, Dict), + try - incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes + incr_rc(recv, Pkt, Dict, TPid, Dict0) %% count incoming of _ -> answer(Pkt, SvcName, App, Req) catch + exit: {no_result_code, _} -> + %% RFC 6733 requires one of Result-Code or + %% Experimental-Result, but the decode will have detected + %% a missing AVP. If both are optional in the dictionary + %% then this isn't a decode error: just continue on. + answer(Pkt, SvcName, App, Req); exit: {invalid_error_bit, RC} -> #diameter_packet{errors = Es} = Pkt, @@ -1401,11 +1487,16 @@ a(#diameter_packet{errors = Es} callback == AE -> cb(ModX, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]); -a(Pkt, SvcName, _, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); +a(Pkt, SvcName, _, AE, _) -> + a(Pkt#diameter_packet.header, SvcName, AE). + +a(Hdr, SvcName, report) -> + MFA = {?MODULE, handle_answer, [SvcName, Hdr]}, + diameter_lib:warning_report(errors, MFA), + a(Hdr, SvcName, discard); -a(Pkt, SvcName, _, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). +a(Hdr, SvcName, discard) -> + x({answer_errors, {SvcName, Hdr}}). %% Note that we don't check that the application id in the answer's %% header is what we expect. (TODO: Does the rfc says anything about @@ -1463,10 +1554,10 @@ msg(#diameter_packet{msg = undefined, bin = Bin}) -> msg(#diameter_packet{msg = Msg}) -> Msg. -%% encode/3 +%% encode/4 -encode(Dict, Pkt, Fs) -> - P = encode(Dict, Pkt), +encode(Dict, TPid, Pkt, Fs) -> + P = encode(Dict, TPid, Pkt), eval_packet(P, Fs), P. @@ -1478,11 +1569,17 @@ encode(Dict, Pkt, Fs) -> %% support retransmission but is useful for test. %% A message to be encoded. -encode(Dict, #diameter_packet{bin = undefined} = Pkt) -> - diameter_codec:encode(Dict, Pkt); +encode(Dict, TPid, #diameter_packet{bin = undefined} = Pkt) -> + try + diameter_codec:encode(Dict, Pkt) + catch + exit: {diameter_codec, encode, T} = Reason -> + incr_error(send, T, TPid, Dict), + exit(Reason) + end; %% An encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> +encode(_, _, #diameter_packet{} = Pkt) -> Pkt. %% send_request/5 @@ -1579,13 +1676,13 @@ resend_request(Pkt0, SvcName, Tmo, Fs) -> - Pkt = encode(Dict, Pkt0, Fs), + Pkt = encode(Dict, TPid, Pkt0, Fs), Req = Req0#request{transport = TPid, packet = Pkt0, caps = Caps}, - ?LOG(retransmission, Req), + ?LOG(retransmission, Pkt#diameter_packet.header), TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), {TRef, Req}. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 53e659e3f6..eff5096745 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -49,8 +49,6 @@ -define(IS_NATURAL(N), (is_integer(N) andalso 0 =< N)). --define(CHOOSE(B,T,F), if (B) -> T; true -> F end). - -record(config, {suspect = 1 :: non_neg_integer(), %% OKAY -> SUSPECT okay = 3 :: non_neg_integer()}). %% REOPEN -> OKAY @@ -221,7 +219,6 @@ dict0(_, _, Acc) -> Acc. config_error(T) -> - diameter_lib:error_report(configuration_error, T), exit({shutdown, {configuration_error, T}}). %% handle_call/3 @@ -270,7 +267,7 @@ event(Msg, TPid = tpid(F,T), E = {[TPid | data(Msg, TPid, From, To)], From, To}, send(Pid, {watchdog, self(), E}), - ?LOG(transition, {self(), E}). + ?LOG(transition, {From, To}). data(Msg, TPid, reopen, okay) -> {recv, TPid, 'DWA', _Pkt} = Msg, %% assert @@ -313,14 +310,13 @@ code_change(_, State, _) -> %% The state transitions documented here are extracted from RFC 3539, %% the commentary is ours. -%% Service or watchdog is telling the watchdog of an accepting -%% transport to die after connect_timer expiry or reestablished -%% connection (in another transport process) respectively. -transition(close, #watchdog{status = down}) -> +%% Service is telling the watchdog of an accepting transport to die +%% following transport death in state INITIAL, or after connect_timer +%% expiry; or another watchdog is saying the same after reestablishing +%% a connection previously had by this one. +transition(close, #watchdog{}) -> {{accept, _}, _, _} = getr(restart), %% assert stop; -transition(close, #watchdog{}) -> - ok; %% Service is asking for the peer to be taken down gracefully. transition({shutdown, Pid, _}, #watchdog{parent = Pid, @@ -332,6 +328,11 @@ transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid, send(TPid, {T, self(), Reason}), S#watchdog{shutdown = true}; +%% Transport is telling us that DPA has been sent in response to DPR: +%% its death should lead to ours. +transition({'DPR', TPid}, #watchdog{transport = TPid} = S) -> + S#watchdog{shutdown = true}; + %% Parent process has died, transition({'DOWN', _, process, Pid, _Reason}, #watchdog{parent = Pid}) -> @@ -403,18 +404,39 @@ transition({open = Key, TPid, _Hosts, T}, %% REOPEN Connection down CloseConnection() %% SetWatchdog() DOWN +%% Transport has died after DPA or service requested termination ... transition({'DOWN', _, process, TPid, _Reason}, #watchdog{transport = TPid, shutdown = true}) -> stop; +%% ... or not. transition({'DOWN', _, process, TPid, _Reason}, #watchdog{transport = TPid, - status = T} - = S) -> - set_watchdog(S#watchdog{status = ?CHOOSE(initial == T, T, down), - pending = false, - transport = undefined}); + status = T, + restrict = {_,R}} + = S0) -> + S = S0#watchdog{pending = false, + transport = undefined}, + {{M,_}, _, _} = getr(restart), + + %% Close an accepting watchdog immediately if there's no + %% restriction on the number of connections to the same peer: the + %% state machine never enters state REOPEN in this case. The + %% 'close' message (instead of stop) is so as not to bypass the + %% sending of messages to the service process in handle_info/2. + + if T /= initial, M == accept, not R -> + send(self(), close), + S#watchdog{status = down}; + T /= initial -> + set_watchdog(S#watchdog{status = down}); + M == connect -> + set_watchdog(S); + M == accept -> + send(self(), close), + S + end; %% Incoming message. transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> @@ -454,9 +476,7 @@ encode(dwr = M, Dict0, Mask) -> hop_by_hop_id = Seq}, Pkt = #diameter_packet{header = Hdr, msg = Msg}, - #diameter_packet{bin = Bin} = diameter_codec:encode(Dict0, Pkt), - Bin; - + diameter_codec:encode(Dict0, Pkt); encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD} = ReqPkt) -> @@ -525,10 +545,14 @@ send_watchdog(#watchdog{pending = false, dictionary = Dict0, sequence = Mask} = S) -> - send(TPid, {send, encode(dwr, Dict0, Mask)}), + #diameter_packet{bin = Bin} = EPkt = encode(dwr, Dict0, Mask), + diameter_traffic:incr(send, EPkt, TPid, Dict0), + send(TPid, {send, Bin}), ?LOG(send, 'DWR'), S#watchdog{pending = true}. +%% Dont' count encode errors since we don't expect any on DWR/DWA. + %% recv/3 recv(Name, Pkt, S) -> @@ -545,13 +569,29 @@ recv(Name, Pkt, S) -> rcv('DWR', Pkt, #watchdog{transport = TPid, dictionary = Dict0}) -> - send(TPid, {send, encode(dwa, Dict0, Pkt)}), + ?LOG(recv, 'DWR'), + DPkt = diameter_codec:decode(Dict0, Pkt), + diameter_traffic:incr(recv, DPkt, TPid, Dict0), + diameter_traffic:incr_error(recv, DPkt, TPid, Dict0), + EPkt = encode(dwa, Dict0, Pkt), + diameter_traffic:incr(send, EPkt, TPid, Dict0), + diameter_traffic:incr_rc(send, EPkt, TPid, Dict0), + + send(TPid, {send, EPkt}), ?LOG(send, 'DWA'); +rcv('DWA', Pkt, #watchdog{transport = TPid, + dictionary = Dict0}) -> + ?LOG(recv, 'DWA'), + diameter_traffic:incr(recv, Pkt, TPid, Dict0), + diameter_traffic:incr_rc(recv, + diameter_codec:decode(Dict0, Pkt), + TPid, + Dict0); + rcv(N, _, _) when N == 'CER'; N == 'CEA'; - N == 'DWA'; N == 'DPR'; N == 'DPA' -> false; @@ -740,7 +780,7 @@ timeout(#watchdog{status = T} = S) restart(#watchdog{transport = undefined} = S) -> restart(getr(restart), S); -restart(S) -> +restart(S) -> %% reconnect has won race with timeout S. %% restart/2 @@ -770,9 +810,10 @@ restart({{connect, _} = T, Opts, Svc}, %% die. Note that a state machine never enters state REOPEN in this %% case. restart({{accept, _}, _, _}, #watchdog{restrict = {_, false}}) -> - stop; + stop; %% 'DOWN' was in old code: 'close' was not sent -%% Otherwise hang around until told to die. +%% Otherwise hang around until told to die, either by the service or +%% by another watchdog. restart({{accept, _}, _, _}, S) -> S. diff --git a/lib/diameter/src/compiler/diameter_dict_util.erl b/lib/diameter/src/compiler/diameter_dict_util.erl index 136bba16cb..cf4741e563 100644 --- a/lib/diameter/src/compiler/diameter_dict_util.erl +++ b/lib/diameter/src/compiler/diameter_dict_util.erl @@ -731,8 +731,8 @@ no_messages_without_id(Dict) -> %% explode/4 %% -%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()] -%% {custom_types|codecs|inherits, AvpName} -> [Lineno, Mod::string()] +%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()] +%% {custom|inherits, AvpName} -> [Lineno, Mod::string()] explode({_, Line, AvpName}, Dict, {_, _, X} = T, K) -> true = K /= avp_vendor_id orelse is_uint32(T, [K]), @@ -1094,7 +1094,7 @@ explode_avps([{_, Line, Name} | Toks], Dict) -> Vid = avp_vendor_id(Flags, Name, Line, Dict), %% An AVP is uniquely defined by its AVP code and vendor id (if any). - %% Ensure there are no duplicate. + %% Ensure there are no duplicates. store_new({avp_types, {Code, Vid}}, [Line, Name], Dict, @@ -1302,8 +1302,7 @@ x({K, {Name, AvpName}}, [Line | _], Dict) %% Ditto. x({K, AvpName}, [Line | _], Dict) when K == avp_vendor_id; - K == custom_types; - K == codecs -> + K == custom -> true = avp_is_defined(AvpName, Dict, Line); %% Ensure that all local AVP's of type Grouped are also present in @grouped. diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 0d421c229e..b7b9662383 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -34,7 +34,19 @@ {"1.4.2", [{restart_application, diameter}]}, %% R16B01 {"1.4.3", [{restart_application, diameter}]}, %% R16B02 {"1.4.4", [{restart_application, diameter}]}, - {"1.5", [{restart_application, diameter}]} %% R16B03 + {"1.5", [{restart_application, diameter}]}, %% R16B03 + {"1.6", [{load_module, diameter_lib}, %% 17.0 + {load_module, diameter_traffic}, + {load_module, diameter_watchdog}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_service}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_accounting}, + {load_module, diameter_gen_relay}, + {load_module, diameter_codec}, + {load_module, diameter_sctp}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -51,6 +63,18 @@ {"1.4.2", [{restart_application, diameter}]}, {"1.4.3", [{restart_application, diameter}]}, {"1.4.4", [{restart_application, diameter}]}, - {"1.5", [{restart_application, diameter}]} + {"1.5", [{restart_application, diameter}]}, + {"1.6", [{load_module, diameter_sctp}, + {load_module, diameter_codec}, + {load_module, diameter_gen_relay}, + {load_module, diameter_gen_accounting}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_service}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_watchdog}, + {load_module, diameter_traffic}, + {load_module, diameter_lib}]} ] }. diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index d0a01351f3..32e7aaca39 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -616,6 +616,8 @@ send(#diameter_packet{bin = Bin, transport_data = {outstream, SId}}, S; %% ... or not: rotate through all streams. +send(#diameter_packet{bin = Bin}, S) -> + send(Bin, S); send(Bin, #transport{streams = {_, OS}, os = N} = S) diff --git a/lib/diameter/test/diameter_compiler_SUITE.erl b/lib/diameter/test/diameter_compiler_SUITE.erl index 08ffe5981d..20c9275808 100644 --- a/lib/diameter/test/diameter_compiler_SUITE.erl +++ b/lib/diameter/test/diameter_compiler_SUITE.erl @@ -317,6 +317,21 @@ {avp_not_defined, "CEA ::=", "<XXX> &"}, + {ok, + "@avp_types", + "@codecs tmod Session-Id &"}, + {ok, + "@avp_types", + "@custom_types tmod Session-Id &"}, + {avp_not_defined, + "@avp_types", + "@codecs tmod OctetString &"}, + {avp_not_defined, + "@avp_types", + "@custom_types tmod OctetString &"}, + {avp_already_defined, + "@avp_types", + "@codecs tmod Session-Id @custom_types tmod Session-Id &"}, {not_loaded, [{"@avp_types", "@inherits nomod XXX &"}, {"CEA ::=", "<XXX> &"}]}, diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl index 9252650bf7..f3f16b06e0 100644 --- a/lib/diameter/test/diameter_dpr_SUITE.erl +++ b/lib/diameter/test/diameter_dpr_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -73,7 +73,7 @@ %% Valid values for Disconnect-Cause. -define(CAUSES, [0, rebooting, 1, busy, 2, goaway]). -%% Establish one client connection for element of this list, +%% Establish one client connection for each element of this list, %% configured with disconnect/5 as disconnect_cb and returning the %% specified value. -define(RETURNS, @@ -129,8 +129,8 @@ stop_service(Config) -> service == group(Config) andalso (ok = diameter:stop_service(?CLIENT)). -%% Check for callbacks and stop the service. (Not the other way around -%% for the timing reason explained below.) +%% Check for callbacks before diameter:stop/0, not the other way around +%% for the timing reason explained below. check(Config) -> Grp = group(Config), [Pid | Refs] = ?util:read_priv(Config, config), diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl index 02c8d34361..aef4bc35ef 100644 --- a/lib/diameter/test/diameter_examples_SUITE.erl +++ b/lib/diameter/test/diameter_examples_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,10 @@ -module(diameter_examples_SUITE). -export([suite/0, - all/0]). + all/0, + groups/0, + init_per_group/2, + end_per_group/2]). %% testcases -export([dict/1, dict/0, @@ -46,7 +49,7 @@ %% The order here is significant and causes the server to listen %% before the clients connect. --define(NODES, [compile, server, client]). +-define(NODES, [server, client]). %% Options to ct_slave:start/2. -define(TIMEOUTS, [{T, 15000} || T <- [boot_timeout, @@ -63,6 +66,9 @@ %% Common dictionaries to inherit from examples. -define(DICT0, [rfc3588_base, rfc6733_base]). +%% Transport protocols over which the example Diameter nodes are run. +-define(PROTS, [tcp, sctp]). + %% =========================================================================== suite() -> @@ -71,7 +77,34 @@ suite() -> all() -> [dict, code, - slave, + {group, all}]. + +groups() -> + Tc = tc(), + [{all, [parallel], [{group, P} || P <- ?PROTS]} + | [{P, [], Tc} || P <- ?PROTS]]. + +init_per_group(all, Config) -> + Config; + +init_per_group(tcp = N, Config) -> + [{group, N} | Config]; + +init_per_group(sctp = N, Config) -> + case gen_sctp:open() of + {ok, Sock} -> + gen_sctp:close(Sock), + [{group, N} | Config]; + {error, E} when E == eprotonosupport; + E == esocktnosupport -> %% fail on any other reason + {skip, no_sctp} + end. + +end_per_group(_, _) -> + ok. + +tc() -> + [slave, enslave, start, traffic, @@ -88,7 +121,7 @@ dict() -> dict(_Config) -> Dirs = [filename:join(H ++ ["examples", "dict"]) || H <- [[code:lib_dir(diameter)], [here(), ".."]]], - [] = [{F,D,RC} || {_,F} <- sort(find_files(Dirs, ".*\\.dia")), + [] = [{F,D,RC} || {_,F} <- sort(find_files(Dirs, ".*\\.dia$")), D <- ?DICT0, RC <- [make(F,D)], RC /= ok]. @@ -184,17 +217,18 @@ make_name(Dict) -> %% Compile example code under examples/code. code(Config) -> - Node = slave(hd(?NODES), here()), + Node = slave(compile, here()), [] = rpc:call(Node, ?MODULE, install, - [proplists:get_value(priv_dir, Config)]). + [proplists:get_value(priv_dir, Config)]), + {ok, Node} = ct_slave:stop(compile). %% Compile on another node since the code path may be modified. install(PrivDir) -> Top = install(here(), PrivDir), Src = filename:join([Top, "examples", "code"]), - Files = find_files([Src], ".*\\.erl"), + Files = find_files([Src], ".*\\.erl$"), [] = [{F,E} || {_,F} <- Files, {error, _, _} = E <- [compile:file(F, [warnings_as_errors, return_errors])]]. @@ -226,7 +260,7 @@ install(Dir, PrivDir) -> Inc = filename:join([Top, "include"]), Gen = filename:join([Top, "src", "gen"]), - Files = find_files([Inc, Gen], ".*\\.hrl"), + Files = find_files([Inc, Gen], ".*\\.hrl$"), [] = [{F,E} || {_,F} <- Files, B <- [filename:basename(F)], D <- [filename:join([TmpInc, B])], @@ -280,9 +314,10 @@ now_diff(_) -> %% Start two nodes: one for the server, one for the client. enslave(Config) -> + Prot = proplists:get_value(group, Config), Dir = here(), - Nodes = [{N, slave(N, Dir)} || N <- tl(?NODES)], - ?util:write_priv(Config, nodes, Nodes). + Nodes = [{S, slave(N, Dir)} || S <- ?NODES, N <- [concat(Prot, S)]], + ?util:write_priv(Config, Prot, Nodes). slave(Name, Dir) -> {ok, Node} = ct_slave:start(Name, ?TIMEOUTS), @@ -292,6 +327,9 @@ slave(Name, Dir) -> [[Dir, filename:join([Dir, "..", "ebin"])]]), Node. +concat(Prot, Svc) -> + list_to_atom(atom_to_list(Prot) ++ atom_to_list(Svc)). + here() -> filename:dirname(code:which(?MODULE)). @@ -304,24 +342,25 @@ top(Dir, LibDir) -> %% start/1 -start(server) -> +start({server, Prot}) -> ok = diameter:start(), ok = server:start(), - {ok, Ref} = server:listen(tcp), - [_] = ?util:lport(tcp, Ref), + {ok, Ref} = server:listen(Prot), + [_] = ?util:lport(Prot, Ref), ok; -start(client) -> +start({client = Svc, Prot}) -> ok = diameter:start(), - true = diameter:subscribe(client), + true = diameter:subscribe(Svc), ok = client:start(), - {ok, Ref} = client:connect(tcp), + {ok, Ref} = client:connect(Prot), receive #diameter_event{info = {up, Ref, _, _, _}} -> ok end; start(Config) -> - Nodes = ?util:read_priv(Config, nodes), + Prot = proplists:get_value(group, Config), + Nodes = ?util:read_priv(Config, Prot), [] = [RC || {T,N} <- Nodes, - RC <- [rpc:call(N, ?MODULE, start, [T])], + RC <- [rpc:call(N, ?MODULE, start, [{T, Prot}])], RC /= ok]. %% traffic/1 @@ -336,7 +375,8 @@ traffic(client) -> receive {'DOWN', MRef, process, _, Reason} -> Reason end; traffic(Config) -> - Nodes = ?util:read_priv(Config, nodes), + Prot = proplists:get_value(group, Config), + Nodes = ?util:read_priv(Config, Prot), [] = [RC || {T,N} <- Nodes, RC <- [rpc:call(N, ?MODULE, traffic, [T])], RC /= ok]. @@ -355,5 +395,6 @@ stop(Name) {ok, _Node} = ct_slave:stop(Name), ok; -stop(_Config) -> - [] = [RC || N <- ?NODES, RC <- [stop(N)], RC /= ok]. +stop(Config) -> + Prot = proplists:get_value(group, Config), + [] = [RC || N <- ?NODES, RC <- [stop(concat(Prot, N))], RC /= ok]. diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index dfd3253827..c1494dcdb1 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -47,6 +47,7 @@ send_discard_1/1, send_discard_2/1, stop_services/1, + empty/1, stop/1]). %% diameter callbacks @@ -121,6 +122,7 @@ all() -> send_discard_1, send_discard_2, stop_services, + empty, stop]. %% =========================================================================== @@ -147,6 +149,10 @@ stop_services(_Config) -> T <- [diameter:stop_service(H)], T /= ok]. +%% Ensure transports have been removed from request table. +empty(_Config) -> + [] = ets:tab2list(diameter_request). + stop(_Config) -> ok = diameter:stop(). diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index a97c54fc04..4b67372016 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -43,7 +43,9 @@ send_protocol_error/1, send_arbitrary/1, send_unknown/1, + send_unknown_short/1, send_unknown_mandatory/1, + send_unknown_short_mandatory/1, send_noreply/1, send_unsupported/1, send_unsupported_app/1, @@ -54,7 +56,8 @@ send_zero_avp_length/1, send_invalid_avp_length/1, send_invalid_reject/1, - send_unrecognized_mandatory/1, + send_unexpected_mandatory_decode/1, + send_unexpected_mandatory/1, send_long/1, send_nopeer/1, send_noapp/1, @@ -266,7 +269,9 @@ tc() -> send_protocol_error, send_arbitrary, send_unknown, + send_unknown_short, send_unknown_mandatory, + send_unknown_short_mandatory, send_noreply, send_unsupported, send_unsupported_app, @@ -277,7 +282,8 @@ tc() -> send_zero_avp_length, send_invalid_avp_length, send_invalid_reject, - send_unrecognized_mandatory, + send_unexpected_mandatory_decode, + send_unexpected_mandatory, send_long, send_nopeer, send_noapp, @@ -447,6 +453,24 @@ send_unknown(Config) -> data = <<17>>}]} = lists:last(Avps). +%% Ditto, and point the AVP length past the end of the message. Expect +%% 5014. +send_unknown_short(Config) -> + send_unknown_short(Config, false, ?INVALID_AVP_LENGTH). + +send_unknown_short(Config, M, RC) -> + Req = ['ASR', {'AVP', [#diameter_avp{code = 999, + is_mandatory = M, + data = <<17>>}]}], + ['ASA', _SessionId, {'Result-Code', RC} | Avps] + = call(Config, Req), + [#'diameter_base_Failed-AVP'{'AVP' = As}] + = proplists:get_value('Failed-AVP', Avps), + [#diameter_avp{code = 999, + is_mandatory = M, + data = <<17, _/binary>>}] %% extra bits from padding + = As. + %% Ditto but set the M flag. send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, @@ -461,6 +485,27 @@ send_unknown_mandatory(Config) -> data = <<17>>}] = As. +%% Ditto, and point the AVP length past the end of the message. Expect +%% 5014 instead of 5001. +send_unknown_short_mandatory(Config) -> + send_unknown_short(Config, true, ?INVALID_AVP_LENGTH). + +%% Send an ACR containing an unexpected mandatory Session-Timeout. +%% Expect 5001, and check that the value in Failed-AVP was decoded. +send_unexpected_mandatory_decode(Config) -> + Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout + is_mandatory = true, + data = <<12:32>>}]}], + ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + = call(Config, Req), + [#'diameter_base_Failed-AVP'{'AVP' = As}] + = proplists:get_value('Failed-AVP', Avps), + [#diameter_avp{code = 27, + is_mandatory = true, + value = 12, + data = <<12:32>>}] + = As. + %% Send an STR that the server ignores. send_noreply(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], @@ -527,9 +572,9 @@ send_invalid_reject(Config) -> ?answer_message(?TOO_BUSY) = call(Config, Req). -%% Send an STR containing a known AVP, but one that's not allowed and -%% sets the M-bit. -send_unrecognized_mandatory(Config) -> +%% Send an STR containing a known AVP, but one that's not expected and +%% that sets the M-bit. +send_unexpected_mandatory(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], ['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _] @@ -836,6 +881,26 @@ log(#diameter_packet{bin = Bin} = P, T) %% prepare/4 prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) + when N == send_unknown_short_mandatory; + N == send_unknown_short -> + Req = prepare(Pkt, Caps, Group), + + #diameter_packet{header = #diameter_header{length = L}, + bin = Bin} + = E + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), + + %% Find the unknown AVP data at the end of the message and alter + %% its length header. + + {Padding, [17|_]} = lists:splitwith(fun(C) -> C == 0 end, + lists:reverse(binary_to_list(Bin))), + + Offset = L - length(Padding) - 4, + <<H:Offset/binary, Len:24, T/binary>> = Bin, + E#diameter_packet{bin = <<H/binary, (Len+9):24, T/binary>>}; + +prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) when N == send_long_avp_length; N == send_short_avp_length; N == send_zero_avp_length -> @@ -876,8 +941,8 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) <<V, L:24, H/binary>> = H0, %% assert E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>}; -prepare(Pkt, Caps, send_unrecognized_mandatory, #group{client_dict0 = Dict0} - = Group) -> +prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0} + = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<V, Len:24, T/binary>>} = E @@ -997,7 +1062,9 @@ answer(Rec, [_|_], N) N == send_short_avp_length; N == send_zero_avp_length; N == send_invalid_avp_length; - N == send_invalid_reject -> + N == send_invalid_reject; + N == send_unknown_short_mandatory; + N == send_unexpected_mandatory_decode -> Rec; answer(Rec, [], _) -> Rec. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 54019fa46c..560c2aed50 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.6 +DIAMETER_VSN = 1.7 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index a3eb437f88..3f3435977d 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -39,7 +39,7 @@ #include <stdio.h> /* Need type FILE */ #include <errno.h> /* Need EHOSTUNREACH, ENOMEM, ... */ -#if !defined(__WIN32__) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS)) +#if !(defined(__WIN32__) || defined(_WIN32)) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS)) # include <netdb.h> #endif diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 22f5b8945a..9a3873f46d 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -63,7 +63,8 @@ seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, type/1, values_es/1, var_name/1, - map_es/1, map_pair_key/1, map_pair_val/1, map_pair_op/1 + c_map/1, map_arg/1, map_es/1, is_c_map_empty/1, + c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1 ]). -define(PAPER, 76). @@ -489,7 +490,13 @@ lay_literal(Node, Ctxt) -> %% `lay_cons' will check for strings. lay_cons(Node, Ctxt); V when is_tuple(V) -> - lay_tuple(Node, Ctxt) + lay_tuple(Node, Ctxt); + M when is_map(M), map_size(M) =:= 0 -> + text("~{}~"); + M when is_map(M) -> + lay_map(c_map([c_map_pair(abstract(K),abstract(V)) + || {K,V} <- maps:to_list(M)]), + Ctxt) end. lay_var(Node, Ctxt) -> @@ -596,10 +603,17 @@ lay_tuple(Node, Ctxt) -> floating(text("}")))). lay_map(Node, Ctxt) -> + Arg = map_arg(Node), + After = case is_c_map_empty(Arg) of + true -> floating(text("}~")); + false -> + beside(floating(text(" | ")), + beside(lay(Arg,Ctxt), + floating(text("}~")))) + end, beside(floating(text("~{")), - beside(par(seq(map_es(Node), floating(text(",")), - Ctxt, fun lay/2)), - floating(text("}~")))). + beside(par(seq(map_es(Node), floating(text(",")), Ctxt, fun lay/2)), + After)). lay_map_pair(Node, Ctxt) -> K = map_pair_key(Node), diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 06c0d10296..67661130a5 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -4487,7 +4487,9 @@ get_mod_record([{FieldName, DeclType}|Left1], [{FieldName, ModType}|Left2], Acc) -> ModTypeNoVars = subst_all_vars_to_any(ModType), case - contains_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType) + contains_remote(ModTypeNoVars) + orelse contains_remote(DeclType) + orelse t_is_subtype(ModTypeNoVars, DeclType) of false -> {error, FieldName}; true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index e29144f014..596c0d77f4 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2013</year> + <year>2002</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -32,7 +32,37 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10</title> + <section><title>Inets 5.10.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct distirbing mode for httpd:reload_config/2</p> + <p> + Own Id: OTP-11914</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improved handling of invalid strings in the HTTP request + line.</p> + <p> + Impact: May improve memory consumption</p> + <p> + Own Id: OTP-11925 Aux Id: Sequence 12601 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 88e08be789..5ae6760f08 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1116,8 +1116,16 @@ handle_http_body(Body, #state{headers = Headers, {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), - handle_response(State#state{headers = NewHeaders, - body = NewBody}) + case Body of + <<>> -> + handle_response(State#state{headers = NewHeaders, + body = NewBody}); + _ -> + {NewBody2, NewRequest} = + stream(NewBody, Request, Code), + handle_response(State#state{headers = NewHeaders, + body = NewBody2}) + end end; Enc when Enc =:= "identity"; Enc =:= undefined -> ?hcrt("handle_http_body - identity", []), @@ -1218,6 +1226,7 @@ handle_response(#state{request = Request, handle_queue(State#state{request = undefined}, Data); {ok, Msg, Data} -> ?hcrd("handle response - ok", []), + stream_remaining_body(Body, Request, StatusLine), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), handle_queue(NewState, Data); @@ -1648,6 +1657,10 @@ start_stream(_StatusLine, _Headers, Request) -> ?hcrt("start stream - no op", []), {ok, Request}. +stream_remaining_body(<<>>, _, _) -> + ok; +stream_remaining_body(Body, Request, {_, Code, _}) -> + stream(Body, Request, Code). %% Note the end stream message is handled by httpc_response and will %% be sent by answer_request diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 97cf474ab9..53b776c4e7 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -26,6 +26,8 @@ -define(HTTP_MAX_BODY_SIZE, nolimit). -define(HTTP_MAX_HEADER_SIZE, 10240). -define(HTTP_MAX_URI_SIZE, nolimit). +-define(HTTP_MAX_VERSION_STRING, 8). +-define(HTTP_MAX_METHOD_STRING, 20). -ifndef(HTTP_DEFAULT_SSL_KIND). -define(HTTP_DEFAULT_SSL_KIND, essl). diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 5ba79b2706..712c73599f 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -44,26 +44,26 @@ %%%========================================================================= parse([Bin, MaxSizes]) -> ?hdrt("parse", [{bin, Bin}, {max_sizes, MaxSizes}]), - parse_method(Bin, [], MaxSizes, []); + parse_method(Bin, [], 0, proplists:get_value(max_method, MaxSizes), MaxSizes, []); parse(Unknown) -> ?hdrt("parse", [{unknown, Unknown}]), exit({bad_args, Unknown}). %% Functions that may be returned during the decoding process %% if the input data is incompleate. -parse_method([Bin, Method, MaxSizes, Result]) -> - parse_method(Bin, Method, MaxSizes, Result). +parse_method([Bin, Method, Current, Max, MaxSizes, Result]) -> + parse_method(Bin, Method, Current, Max, MaxSizes, Result). -parse_uri([Bin, URI, CurrSize, MaxSizes, Result]) -> - parse_uri(Bin, URI, CurrSize, MaxSizes, Result). +parse_uri([Bin, URI, Current, Max, MaxSizes, Result]) -> + parse_uri(Bin, URI, Current, Max, MaxSizes, Result). -parse_version([Bin, Rest, Version, MaxSizes, Result]) -> - parse_version(<<Rest/binary, Bin/binary>>, Version, MaxSizes, +parse_version([Bin, Rest, Version, Current, Max, MaxSizes, Result]) -> + parse_version(<<Rest/binary, Bin/binary>>, Version, Current, Max, MaxSizes, Result). -parse_headers([Bin, Rest, Header, Headers, CurrSize, MaxSizes, Result]) -> +parse_headers([Bin, Rest, Header, Headers, Current, Max, MaxSizes, Result]) -> parse_headers(<<Rest/binary, Bin/binary>>, - Header, Headers, CurrSize, MaxSizes, Result). + Header, Headers, Current, Max, MaxSizes, Result). whole_body([Bin, Body, Length]) -> whole_body(<<Body/binary, Bin/binary>>, Length). @@ -107,8 +107,12 @@ validate("POST", Uri, "HTTP/1." ++ _N) -> validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 -> validate_uri(Uri); validate(Method, Uri, Version) -> - {error, {not_supported, {Method, Uri, Version}}}. - + case validate_version(Version) of + true -> + {error, {not_supported, {Method, Uri, Version}}}; + false -> + {error, {bad_version, Version}} + end. %%---------------------------------------------------------------------- %% The request is passed through the server as a record of type mod %% create it. @@ -131,104 +135,75 @@ update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)-> %%%======================================================================== %%% Internal functions %%%======================================================================== -parse_method(<<>>, Method, MaxSizes, Result) -> - ?hdrt("parse_method - empty bin", - [{method, Method}, {max_sizes, MaxSizes}, {result, Result}]), - {?MODULE, parse_method, [Method, MaxSizes, Result]}; -parse_method(<<?SP, Rest/binary>>, Method, MaxSizes, Result) -> - ?hdrt("parse_method - SP begin", - [{rest, Rest}, - {method, Method}, - {max_sizes, MaxSizes}, - {result, Result}]), - parse_uri(Rest, [], 0, MaxSizes, +parse_method(<<>>, Method, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_method, [Method, Current, Max, MaxSizes, Result]}; +parse_method(<<?SP, Rest/binary>>, Method, _Current, _Max, MaxSizes, Result) -> + parse_uri(Rest, [], 0, proplists:get_value(max_uri, MaxSizes), MaxSizes, [string:strip(lists:reverse(Method)) | Result]); -parse_method(<<Octet, Rest/binary>>, Method, MaxSizes, Result) -> - ?hdrt("parse_method", - [{octet, Octet}, - {rest, Rest}, - {method, Method}, - {max_sizes, MaxSizes}, - {result, Result}]), - parse_method(Rest, [Octet | Method], MaxSizes, Result). - -parse_uri(_, _, CurrSize, {MaxURI, _}, _) - when (CurrSize > MaxURI) andalso (MaxURI =/= nolimit) -> - ?hdrt("parse_uri", - [{current_size, CurrSize}, - {max_uri, MaxURI}]), +parse_method(<<Octet, Rest/binary>>, Method, Current, Max, MaxSizes, Result) when Current =< Max -> + parse_method(Rest, [Octet | Method], Current + 1, Max, MaxSizes, Result); +parse_method(_, _, _, Max, _, _) -> + %% We do not know the version of the client as it comes after the + %% method send the lowest version in the response so that the client + %% will be able to handle it. + {error, {too_long, Max, 413, "Method unreasonably long"}, lowest_version()}. + +parse_uri(_, _, Current, MaxURI, _, _) + when (Current > MaxURI) andalso (MaxURI =/= nolimit) -> %% We do not know the version of the client as it comes after the %% uri send the lowest version in the response so that the client %% will be able to handle it. - HttpVersion = "HTTP/0.9", - {error, {uri_too_long, MaxURI}, HttpVersion}; -parse_uri(<<>>, URI, CurrSize, MaxSizes, Result) -> - ?hdrt("parse_uri - empty bin", - [{uri, URI}, - {current_size, CurrSize}, - {max_sz, MaxSizes}, - {result, Result}]), - {?MODULE, parse_uri, [URI, CurrSize, MaxSizes, Result]}; -parse_uri(<<?SP, Rest/binary>>, URI, _, MaxSizes, Result) -> - ?hdrt("parse_uri - SP begin", - [{uri, URI}, - {max_sz, MaxSizes}, - {result, Result}]), - parse_version(Rest, [], MaxSizes, + {error, {too_long, MaxURI, 414, "URI unreasonably long"},lowest_version()}; +parse_uri(<<>>, URI, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_uri, [URI, Current, Max, MaxSizes, Result]}; +parse_uri(<<?SP, Rest/binary>>, URI, _, _, MaxSizes, Result) -> + parse_version(Rest, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes, [string:strip(lists:reverse(URI)) | Result]); %% Can happen if it is a simple HTTP/0.9 request e.i "GET /\r\n\r\n" -parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, MaxSizes, Result) -> - ?hdrt("parse_uri - CR begin", - [{uri, URI}, - {max_sz, MaxSizes}, - {result, Result}]), - parse_version(Data, [], MaxSizes, +parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, _, MaxSizes, Result) -> + parse_version(Data, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes, [string:strip(lists:reverse(URI)) | Result]); -parse_uri(<<Octet, Rest/binary>>, URI, CurrSize, MaxSizes, Result) -> - ?hdrt("parse_uri", - [{octet, Octet}, - {uri, URI}, - {curr_sz, CurrSize}, - {max_sz, MaxSizes}, - {result, Result}]), - parse_uri(Rest, [Octet | URI], CurrSize + 1, MaxSizes, Result). - -parse_version(<<>>, Version, MaxSizes, Result) -> - {?MODULE, parse_version, [<<>>, Version, MaxSizes, Result]}; -parse_version(<<?LF, Rest/binary>>, Version, MaxSizes, Result) -> +parse_uri(<<Octet, Rest/binary>>, URI, Current, Max, MaxSizes, Result) -> + parse_uri(Rest, [Octet | URI], Current + 1, Max, MaxSizes, Result). + +parse_version(<<>>, Version, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_version, [<<>>, Version, Current, Max, MaxSizes, Result]}; +parse_version(<<?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result); -parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result) -> - parse_headers(Rest, [], [], 0, MaxSizes, + parse_version(<<?CR, ?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result); +parse_version(<<?CR, ?LF, Rest/binary>>, Version, _, _, MaxSizes, Result) -> + parse_headers(Rest, [], [], 0, proplists:get_value(max_header, MaxSizes), MaxSizes, [string:strip(lists:reverse(Version)) | Result]); -parse_version(<<?CR>> = Data, Version, MaxSizes, Result) -> - {?MODULE, parse_version, [Data, Version, MaxSizes, Result]}; -parse_version(<<Octet, Rest/binary>>, Version, MaxSizes, Result) -> - parse_version(Rest, [Octet | Version], MaxSizes, Result). - -parse_headers(_, _, _, CurrSize, {_, MaxHeaderSize}, Result) - when CurrSize > MaxHeaderSize, MaxHeaderSize =/= nolimit -> +parse_version(<<?CR>> = Data, Version, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_version, [Data, Version, Current, Max, MaxSizes, Result]}; +parse_version(<<Octet, Rest/binary>>, Version, Current, Max, MaxSizes, Result) when Current =< Max -> + parse_version(Rest, [Octet | Version], Current + 1, Max, MaxSizes, Result); +parse_version(_, _, _, Max,_,_) -> + {error, {too_long, Max, 413, "Version string unreasonably long"}, lowest_version()}. + +parse_headers(_, _, _, Current, Max, _, Result) + when Max =/= nolimit andalso Current > Max -> HttpVersion = lists:nth(3, lists:reverse(Result)), - {error, {header_too_long, MaxHeaderSize}, HttpVersion}; + {error, {too_long, Max, 413, "Headers unreasonably long"}, HttpVersion}; -parse_headers(<<>>, Header, Headers, CurrSize, MaxSizes, Result) -> - {?MODULE, parse_headers, [<<>>, Header, Headers, CurrSize, +parse_headers(<<>>, Header, Headers, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_headers, [<<>>, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) -> +parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize, + parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result); -parse_headers(<<?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) -> +parse_headers(<<?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize, + parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result); -parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, Result) -> +parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, _, Result) -> NewResult = list_to_tuple(lists:reverse([Body, {#http_request_h{}, []} | Result])), {ok, NewResult}; -parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, +parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _, _, Result) -> HTTPHeaders = [lists:reverse(Header) | Headers], RequestHeaderRcord = @@ -238,52 +213,51 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, HTTPHeaders} | Result])), {ok, NewResult}; -parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, CurrSize, +parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_headers, [Data, Header, Headers, CurrSize, + {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?LF>>, [], [], CurrSize, MaxSizes, Result) -> +parse_headers(<<?LF>>, [], [], Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF>>, [], [], CurrSize, MaxSizes, Result); + parse_headers(<<?CR,?LF>>, [], [], Current, Max, MaxSizes, Result); %% There where no headers, which is unlikely to happen. -parse_headers(<<?CR,?LF>>, [], [], _, _, Result) -> +parse_headers(<<?CR,?LF>>, [], [], _, _, _, Result) -> NewResult = list_to_tuple(lists:reverse([<<>>, {#http_request_h{}, []} | Result])), {ok, NewResult}; -parse_headers(<<?LF>>, Header, Headers, CurrSize, +parse_headers(<<?LF>>, Header, Headers, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF>>, Header, Headers, CurrSize, MaxSizes, Result); + parse_headers(<<?CR,?LF>>, Header, Headers, Current, Max, MaxSizes, Result); -parse_headers(<<?CR,?LF>> = Data, Header, Headers, CurrSize, +parse_headers(<<?CR,?LF>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_headers, [Data, Header, Headers, CurrSize, + {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, CurrSize, +parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize, + parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, MaxSizes, Result); -parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize, +parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max, MaxSizes, Result) -> parse_headers(Rest, [Octet], [lists:reverse(Header) | Headers], - CurrSize + 1, MaxSizes, Result); - -parse_headers(<<?CR>> = Data, Header, Headers, CurrSize, + 0, Max, MaxSizes, Result); +parse_headers(<<?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_headers, [Data, Header, Headers, CurrSize, + {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?LF>>, Header, Headers, CurrSize, +parse_headers(<<?LF>>, Header, Headers, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR, ?LF>>, Header, Headers, CurrSize, + parse_headers(<<?CR, ?LF>>, Header, Headers, Current, Max, MaxSizes, Result); -parse_headers(<<Octet, Rest/binary>>, Header, Headers, - CurrSize, MaxSizes, Result) -> - parse_headers(Rest, [Octet | Header], Headers, CurrSize + 1, +parse_headers(<<Octet, Rest/binary>>, Header, Headers, Current, + Max, MaxSizes, Result) -> + parse_headers(Rest, [Octet | Header], Headers, Current + 1, Max, MaxSizes, Result). whole_body(Body, Length) -> @@ -326,6 +300,14 @@ validate_path([".." | Rest], N, RequestURI) -> validate_path([_ | Rest], N, RequestURI) -> validate_path(Rest, N + 1, RequestURI). +validate_version("HTTP/1.1") -> + true; +validate_version("HTTP/1.0") -> + true; +validate_version("HTTP/0.9") -> + true; +validate_version(_) -> + false. %%---------------------------------------------------------------------- %% There are 3 possible forms of the reuqest URI %% @@ -430,3 +412,5 @@ tag([$:|Rest], Tag) -> tag([Chr|Rest], Tag) -> tag(Rest, [Chr|Tag]). +lowest_version()-> + "HTTP/0.9". diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index bd37066ff6..b3c9cbc46a 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -123,7 +123,8 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> {_, Status} = httpd_manager:new_connection(Manager), - MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]}, + MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, + {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, State = #state{mod = Mod, manager = Manager, @@ -207,23 +208,15 @@ handle_info({Proto, Socket, Data}, set_new_data_size(cancel_request_timeout(State), NewDataSize) end, handle_http_msg(Result, NewState); - - {error, {uri_too_long, MaxSize}, Version} -> - NewModData = ModData#mod{http_version = Version}, - httpd_response:send_status(NewModData, 414, "URI too long"), - Reason = io_lib:format("Uri too long, max size is ~p~n", - [MaxSize]), - error_log(Reason, NewModData), - {stop, normal, State#state{response_sent = true, - mod = NewModData}}; - {error, {header_too_long, MaxSize}, Version} -> + {error, {too_long, MaxSize, ErrCode, ErrStr}, Version} -> NewModData = ModData#mod{http_version = Version}, - httpd_response:send_status(NewModData, 413, "Header too long"), - Reason = io_lib:format("Header too long, max size is ~p~n", - [MaxSize]), + httpd_response:send_status(NewModData, ErrCode, ErrStr), + Reason = io_lib:format("~p: ~p max size is ~p~n", + [ErrCode, ErrStr, MaxSize]), error_log(Reason, NewModData), {stop, normal, State#state{response_sent = true, mod = NewModData}}; + NewMFA -> http_transport:setopts(SockType, Socket, [{active, once}]), case NewDataSize of @@ -382,6 +375,11 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, 400, URI), Reason = io_lib:format("Malformed syntax in URI: ~p~n", [URI]), error_log(Reason, ModData), + {stop, normal, State#state{response_sent = true}}; + {error, {bad_version, Ver}} -> + httpd_response:send_status(ModData#mod{http_version = "HTTP/0.9"}, 400, Ver), + Reason = io_lib:format("Malformed syntax version: ~p~n", [Ver]), + error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}} end; handle_http_msg({ChunkedHeaders, Body}, @@ -549,7 +547,8 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, MaxHeaderSize = max_header_size(ModData#mod.config_db), MaxURISize = max_uri_size(ModData#mod.config_db), - MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]}, + MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, + {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, TmpState = State#state{mod = NewModData, mfa = MFA, max_keep_alive_request = decrease(Max), diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index dd081962cc..5499596bbd 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -17,11 +17,20 @@ %% %CopyrightEnd% {"%VSN%", [ - {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]}, + {"5.10", + [{load_module, httpd, soft_purge, soft_purge, []}, + {load_module, httpd_manager, soft_purge, soft_purge, []}, + {load_module, httpd_request, soft_purge, soft_purge, []}, + {load_module, httpd_request_handler, soft_purge, soft_purge, + []}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]}, + {"5.10", + [{load_module, httpd, soft_purge, soft_purge, []}, + {load_module, httpd_manager, soft_purge, soft_purge, []}, + {load_module, httpd_request, soft_purge, soft_purge, []}, + {load_module, httpd_request_handler, soft_purge, soft_purge, []}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] }. diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index c5920a3968..d4a3f28f38 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -356,7 +356,10 @@ http_request(Config) when is_list(Config) -> "HTTP/1.1", {#http_request_h{host = "www.erlang.org", te = []}, ["te: ","host:www.erlang.org"]}, <<>>} = - parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead), + parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], + HttpHead), HttpHead1 = ["GET http://www.erlang.org HTTP/1.1" ++ [?CR], [?LF, ?CR, ?LF]], @@ -364,7 +367,9 @@ http_request(Config) when is_list(Config) -> "http://www.erlang.org", "HTTP/1.1", {#http_request_h{}, []}, <<>>} = - parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead1), + parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead1), HttpHead2 = ["GET http://www.erlang.org HTTP/1.1" ++ @@ -373,7 +378,9 @@ http_request(Config) when is_list(Config) -> "http://www.erlang.org", "HTTP/1.1", {#http_request_h{}, []}, <<>>} = - parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead2), + parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead2), %% Note the following body is not related to the headers above HttpBody = ["<HTML>\n<HEAD>\n<TITLE> dummy </TITLE>\n</HEAD>\n<BODY>\n", diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index b1b799c953..c535d59b9f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -27,15 +27,14 @@ -include_lib("kernel/include/file.hrl"). -include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). - +-include("http_internal.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). -define(URL_START, "http://"). -define(TLS_URL_START, "https://"). -define(NOT_IN_USE_PORT, 8997). --define(LF, $\n). --define(HTTP_MAX_HEADER_SIZE, 10240). + -record(sslsocket, {fd = nil, pid = nil}). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -94,6 +93,8 @@ only_simulated() -> empty_set_cookie, trace, stream_once, + stream_single_chunk, + stream_no_length, no_content_204, tolerate_missing_CR, userinfo, @@ -387,6 +388,22 @@ stream_once(Config) when is_list(Config) -> Request2 = {url(group_name(Config), "/once_chunked.html", Config), []}, stream_test(Request2, {stream, {self, once}}). +%%------------------------------------------------------------------------- +stream_single_chunk() -> + [{doc, "Test the option stream for asynchrony requests"}]. +stream_single_chunk(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/single_chunk.html", Config), []}, + stream_test(Request, {stream, self}). +%%------------------------------------------------------------------------- +stream_no_length() -> + [{doc, "Test the option stream for asynchrony requests with HTTP 1.0 " + "body end on closed connection" }]. +stream_no_length(Config) when is_list(Config) -> + Request1 = {url(group_name(Config), "/http_1_0_no_length_single.html", Config), []}, + stream_test(Request1, {stream, self}), + Request2 = {url(group_name(Config), "/http_1_0_no_length_multiple.html", Config), []}, + stream_test(Request2, {stream, self}). + %%------------------------------------------------------------------------- redirect_multiple_choises() -> @@ -1047,7 +1064,7 @@ stream_test(Request, To) -> ct:fail(Msg) end, - Body == binary_to_list(StreamedBody). + Body = binary_to_list(StreamedBody). url(http, End, Config) -> Port = ?config(port, Config), @@ -1226,7 +1243,10 @@ dummy_server_init(Caller, ip_comm, Inet, _) -> {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), Caller ! {port, Port}, - dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]]}, [], ListenSocket); dummy_server_init(Caller, ssl, Inet, SSLOptions) -> @@ -1238,7 +1258,10 @@ dummy_ssl_server_init(Caller, BaseOpts, Inet) -> {ok, ListenSocket} = ssl:listen(0, [Inet | BaseOpts]), {ok, {_, Port}} = ssl:sockname(ListenSocket), Caller ! {port, Port}, - dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + dummy_ssl_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]]}, [], ListenSocket). dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> @@ -1268,6 +1291,7 @@ dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> From ! {stopped, self()} after 0 -> {ok, Socket} = ssl:transport_accept(ListenSocket), + ok = ssl:ssl_accept(Socket, infinity), HandlerPid = dummy_request_handler(MFA, Socket), ssl:controlling_process(Socket, HandlerPid), HandlerPid ! ssl_controller, @@ -1314,10 +1338,16 @@ handle_request(Module, Function, Args, Socket) -> stop -> stop; <<>> -> - {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; + {httpd_request, parse, [[<<>>, [{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]]]}; Data -> handle_request(httpd_request, parse, - [Data |[?HTTP_MAX_HEADER_SIZE]], Socket) + [Data, [{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], Socket) end; NewMFA -> NewMFA @@ -1675,6 +1705,30 @@ handle_uri(_,"/once_chunked.html",_,_,Socket,_) -> http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); +handle_uri(_,"/single_chunk.html",_,_,Socket,_) -> + Chunk = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n" ++ + http_chunk:encode("<HTML><BODY>fo") ++ + http_chunk:encode("obar</BODY></HTML>") ++ + http_chunk:encode_last(), + send(Socket, Chunk); + +handle_uri(_,"/http_1_0_no_length_single.html",_,_,Socket,_) -> + Body = "HTTP/1.0 200 ok\r\n" + "Content-type:text/plain\r\n\r\n" + "single packet", + send(Socket, Body), + close(Socket); + +handle_uri(_,"/http_1_0_no_length_multiple.html",_,_,Socket,_) -> + Head = "HTTP/1.0 200 ok\r\n" + "Content-type:text/plain\r\n\r\n" + "multiple packets, ", + send(Socket, Head), + %% long body to make sure it will be sent in multiple tcp packets + send(Socket, string:copies("other multiple packets ", 200)), + close(Socket); + handle_uri(_,"/once.html",_,_,Socket,_) -> Head = "HTTP/1.1 200 ok\r\n" ++ "Content-Length:32\r\n\r\n", diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index fbe65145dc..1fcc5f257e 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -32,9 +32,9 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [ - uri_too_long_414, + [uri_too_long_414, header_too_long_413, + entity_too_long, erl_script_nocache_opt, script_nocache, escaped_url_in_error_body, @@ -63,15 +63,13 @@ end_per_group(_GroupName, Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_suite(Config) -> - tsp("init_per_suite -> entry with" - "~n Config: ~p", [Config]), inets_test_lib:stop_apps([inets]), inets_test_lib:start_apps([inets]), PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), - + Dummy = -"<HTML> + "<HTML> <HEAD> <TITLE>/index.html</TITLE> </HEAD> @@ -79,7 +77,7 @@ init_per_suite(Config) -> DUMMY </BODY> </HTML>", - + DummyFile = filename:join([PrivDir,"dummy.html"]), CgiDir = filename:join(PrivDir, "cgi-bin"), ok = file:make_dir(CgiDir), @@ -116,8 +114,6 @@ DUMMY %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- end_per_suite(_Config) -> - tsp("end_per_suite -> entry with" - "~n Config: ~p", [_Config]), inets:stop(), ok. @@ -134,8 +130,6 @@ end_per_suite(_Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_testcase(Case, Config) -> - tsp("init_per_testcase(~w) -> entry with" - "~n Config: ~p", [Case, Config]), Config. @@ -147,22 +141,18 @@ init_per_testcase(Case, Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after each test case %%-------------------------------------------------------------------- -end_per_testcase(Case, Config) -> - tsp("end_per_testcase(~w) -> entry with" - "~n Config: ~p", [Case, Config]), +end_per_testcase(_Case, Config) -> Config. %%------------------------------------------------------------------------- %% Test cases starts here. %%------------------------------------------------------------------------- -uri_too_long_414(doc) -> - ["Test that too long uri's get 414 HTTP code"]; -uri_too_long_414(suite) -> - []; +uri_too_long_414() -> + [{doc, "Test that too long uri's get 414 HTTP code"}]. uri_too_long_414(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), - {ok, Pid} = inets:start(httpd, [{port, 0}, {max_uri_size, 10} + {ok, Pid} = inets:start(httpd, [{max_uri_size, 10} | HttpdConf]), Info = httpd:info(Pid), Port = proplists:get_value(port, Info), @@ -178,17 +168,12 @@ uri_too_long_414(Config) when is_list(Config) -> {version, "HTTP/0.9"}]), inets:stop(httpd, Pid). - -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- - -header_too_long_413(doc) -> - ["Test that too long headers's get 413 HTTP code"]; -header_too_long_413(suite) -> - []; +header_too_long_413() -> + [{doc,"Test that too long headers's get 413 HTTP code"}]. header_too_long_413(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), - {ok, Pid} = inets:start(httpd, [{port, 0}, {max_header_size, 10} + {ok, Pid} = inets:start(httpd, [{max_header_size, 10} | HttpdConf]), Info = httpd:info(Pid), Port = proplists:get_value(port, Info), @@ -202,8 +187,72 @@ header_too_long_413(Config) when is_list(Config) -> inets:stop(httpd, Pid). %%------------------------------------------------------------------------- + +entity_too_long() -> + [{doc, "Test that too long versions and method strings are rejected"}]. +entity_too_long(Config) when is_list(Config) -> + HttpdConf = ?config(httpd_conf, Config), + {ok, Pid} = inets:start(httpd, HttpdConf), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + + %% Not so long but wrong + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET / " ++ + lists:duplicate(5, $A) ++ "\r\n\r\n", + [{statuscode, 400}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/0.9"}]), + + %% Too long + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET / " ++ + lists:duplicate(100, $A) ++ "\r\n\r\n", + [{statuscode, 413}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/0.9"}]), + %% Not so long but wrong + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + lists:duplicate(5, $A) ++ " / " + "HTTP/1.1\r\n\r\n", + [{statuscode, 501}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/1.1"}]), + %% Too long + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + lists:duplicate(100, $A) ++ " / " + "HTTP/1.1\r\n\r\n", + [{statuscode, 413}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/0.9"}]), + inets:stop(httpd, Pid). + %%------------------------------------------------------------------------- +script_nocache() -> + [{doc,"Test nocache option for mod_cgi and mod_esi"}]. +script_nocache(Config) when is_list(Config) -> + Normal = {no_header, "cache-control"}, + NoCache = {header, "cache-control", "no-cache"}, + verify_script_nocache(Config, false, false, Normal, Normal), + verify_script_nocache(Config, true, false, NoCache, Normal), + verify_script_nocache(Config, false, true, Normal, NoCache), + verify_script_nocache(Config, true, true, NoCache, NoCache). + +%%------------------------------------------------------------------------- erl_script_nocache_opt(doc) -> ["Test that too long headers's get 413 HTTP code"]; erl_script_nocache_opt(suite) -> @@ -225,155 +274,49 @@ erl_script_nocache_opt(Config) when is_list(Config) -> inets:stop(httpd, Pid). %%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- -script_nocache(doc) -> - ["Test nocache option for mod_cgi and mod_esi"]; -script_nocache(suite) -> - []; -script_nocache(Config) when is_list(Config) -> - Normal = {no_header, "cache-control"}, - NoCache = {header, "cache-control", "no-cache"}, - verify_script_nocache(Config, false, false, Normal, Normal), - verify_script_nocache(Config, true, false, NoCache, Normal), - verify_script_nocache(Config, false, true, Normal, NoCache), - verify_script_nocache(Config, true, true, NoCache, NoCache), - ok. -verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> - HttpdConf = ?config(httpd_conf, Config), - CgiScript = ?config(cgi_printenv, Config), - CgiDir = ?config(cgi_dir, Config), - {ok, Pid} = inets:start(httpd, [{port, 0}, - {script_alias, - {"/cgi-bin/", CgiDir ++ "/"}}, - {script_nocache, CgiNoCache}, - {erl_script_alias, - {"/cgi-bin/erl", [httpd_example,io]}}, - {erl_script_nocache, EsiNoCache} - | HttpdConf]), - Info = httpd:info(Pid), - Port = proplists:get_value(port, Info), - Address = proplists:get_value(bind_address, Info), - ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), - "GET /cgi-bin/" ++ CgiScript ++ - " HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - CgiOption, - {version, "HTTP/1.0"}]), - ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), - "GET /cgi-bin/erl/httpd_example:get " - "HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - EsiOption, - {version, "HTTP/1.0"}]), - inets:stop(httpd, Pid). - - -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- -escaped_url_in_error_body(doc) -> - ["Test Url-encoding see OTP-8940"]; -escaped_url_in_error_body(suite) -> - []; -escaped_url_in_error_body(Config) when is_list(Config) -> - %% <CONDITIONAL-SKIP> - %% This skip is due to a problem on windows with long path's - %% If a path is too long file:open fails with, for example, eio. - %% Until that problem is fixed, we skip this case... - Skippable = [win32], - Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - tsp("escaped_url_in_error_body -> entry"), +escaped_url_in_error_body() -> + [{doc, "Test Url-encoding see OTP-8940"}]. +escaped_url_in_error_body(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), {ok, Pid} = inets:start(httpd, [{port, 0} | HttpdConf]), Info = httpd:info(Pid), Port = proplists:get_value(port, Info), - _Address = proplists:get_value(bind_address, Info), - - %% Request 1 - tss(1000), - tsp("escaped_url_in_error_body -> request 1"), URL1 = ?URL_START ++ integer_to_list(Port), - %% Make sure the server is ok, by making a request for a valid page - case httpc:request(get, {URL1 ++ "/dummy.html", []}, - [{url_encode, false}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {200, _}} -> - %% Don't care about the the body, just that we get a ok response - ok; - {ok, {StatusCode1, Body1}} -> - tsf({unexpected_ok_1, StatusCode1, Body1}) - end, - - %% Request 2 - tss(1000), - tsp("escaped_url_in_error_body -> request 2"), - %% Make sure the server is ok, by making a request for a valid page - case httpc:request(get, {URL1 ++ "/dummy.html", []}, - [{url_encode, true}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {200, _}} -> - %% Don't care about the the body, just that we get a ok response - ok; - {ok, {StatusCode2, Body2}} -> - tsf({unexpected_ok_2, StatusCode2, Body2}) - end, - - %% Request 3 - tss(1000), - tsp("escaped_url_in_error_body -> request 3"), + + %% Sanity check + {ok, {200, _}} = httpc:request(get, {URL1 ++ "/dummy.html", []}, + [{url_encode, false}, + {version, "HTTP/1.0"}], + [{full_result, false}]), + {ok, {200, _}} = httpc:request(get, {URL1 ++ "/dummy.html", []}, + [{url_encode, true}, + {version, "HTTP/1.0"}], + [{full_result, false}]), + %% Ask for a non-existing page(1) Path = "/<b>this_is_bold<b>", HTMLEncodedPath = http_util:html_encode(Path), URL2 = URL1 ++ Path, - case httpc:request(get, {URL2, []}, - [{url_encode, true}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {404, Body3}} -> - case find_URL_path(string:tokens(Body3, " ")) of - HTMLEncodedPath -> - ok; - BadPath3 -> - tsf({unexpected_path_3, HTMLEncodedPath, BadPath3}) - end; - {ok, UnexpectedOK3} -> - tsf({unexpected_ok_3, UnexpectedOK3}) - end, + {ok, {404, Body3}} = httpc:request(get, {URL2, []}, + [{url_encode, true}, + {version, "HTTP/1.0"}], + [{full_result, false}]), - %% Request 4 - tss(1000), - tsp("escaped_url_in_error_body -> request 4"), - %% Ask for a non-existing page(2) - case httpc:request(get, {URL2, []}, - [{url_encode, false}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {404, Body4}} -> - case find_URL_path(string:tokens(Body4, " ")) of - HTMLEncodedPath -> - ok; - BadPath4 -> - tsf({unexpected_path_4, HTMLEncodedPath, BadPath4}) - end; - {ok, UnexpectedOK4} -> - tsf({unexpected_ok_4, UnexpectedOK4}) - end, - tss(1000), - tsp("escaped_url_in_error_body -> stop inets"), - inets:stop(httpd, Pid), - tsp("escaped_url_in_error_body -> done"), - ok. + HTMLEncodedPath = find_URL_path(string:tokens(Body3, " ")), + {ok, {404, Body4}} = httpc:request(get, {URL2, []}, + [{url_encode, false}, + {version, "HTTP/1.0"}], + [{full_result, false}]), + + HTMLEncodedPath = find_URL_path(string:tokens(Body4, " ")), + inets:stop(httpd, Pid). %%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- keep_alive_timeout(doc) -> ["Test the keep_alive_timeout option"]; @@ -393,7 +336,6 @@ keep_alive_timeout(Config) when is_list(Config) -> inets:stop(httpd, Pid). %%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- script_timeout(doc) -> ["Test the httpd script_timeout option"]; @@ -423,12 +365,10 @@ verify_script_timeout(Config, ScriptTimeout, StatusCode) -> {version, "HTTP/1.0"}]), inets:stop(httpd, Pid). - -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- -slowdose(doc) -> - ["Testing minimum bytes per second option"]; +slowdose() -> + [{doc, "Testing minimum bytes per second option"}]. slowdose(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), {ok, Pid} = inets:start(httpd, [{port, 0}, {minimum_bytes_per_second, 200}|HttpdConf]), @@ -439,6 +379,40 @@ slowdose(Config) when is_list(Config) -> after 6000 -> {error, closed} = gen_tcp:send(Socket, "Hey") end. + +%%------------------------------------------------------------------------- +%% Internal functions +%%------------------------------------------------------------------------- + +verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> + HttpdConf = ?config(httpd_conf, Config), + CgiScript = ?config(cgi_printenv, Config), + CgiDir = ?config(cgi_dir, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, + {script_alias, + {"/cgi-bin/", CgiDir ++ "/"}}, + {script_nocache, CgiNoCache}, + {erl_script_alias, + {"/cgi-bin/erl", [httpd_example,io]}}, + {erl_script_nocache, EsiNoCache} + | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/" ++ CgiScript ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + CgiOption, + {version, "HTTP/1.0"}]), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/erl/httpd_example:get " + "HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + EsiOption, + {version, "HTTP/1.0"}]), + inets:stop(httpd, Pid). + find_URL_path([]) -> ""; find_URL_path(["URL", URL | _]) -> @@ -446,21 +420,6 @@ find_URL_path(["URL", URL | _]) -> find_URL_path([_ | Rest]) -> find_URL_path(Rest). - -tsp(F) -> - inets_test_lib:tsp(F). -tsp(F, A) -> - inets_test_lib:tsp(F, A). - -tsf(Reason) -> - inets_test_lib:tsf(Reason). - -tss(Time) -> - inets_test_lib:tss(Time). - - - - skip(Reason) -> {skip, Reason}. diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index ed466fd727..36a5bb9e71 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -103,7 +103,7 @@ verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, T try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> - SendRes = inets_test_lib:send(SocketType, Socket, RequestStr), + ok = inets_test_lib:send(SocketType, Socket, RequestStr), State = case inets_regexp:match(RequestStr, "printenv") of nomatch -> #state{}; diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index cbcf0362c9..bbd86c3eb3 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10 +INETS_VSN = 5.10.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index fc7ac08699..dd06affd70 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -63,7 +63,10 @@ init(Ref, Parent, [Root,Mode0]) -> process_flag(trap_exit, true), Db = ets:new(code, [private]), - foreach(fun (M) -> ets:insert(Db, {M,preloaded}) end, erlang:pre_loaded()), + foreach(fun (M) -> + %% Pre-loaded modules are always sticky. + ets:insert(Db, [{M,preloaded},{{sticky,M},true}]) + end, erlang:pre_loaded()), ets:insert(Db, init:fetch_loaded()), Mode = @@ -988,7 +991,7 @@ try_archive_subdirs(_Archive, Base, []) -> %% the complete directory name. %% del_path(Name0,Path,NameDb) -> - case catch to_list(Name0)of + case catch filename:join([to_list(Name0)]) of {'EXIT',_} -> {{error,bad_name},Path}; Name -> @@ -1165,7 +1168,7 @@ stick_dir(Dir, Stick, St) -> true -> foreach(fun (M) -> ets:insert(Db, {{sticky,M},true}) end, Mods); false -> - foreach(fun (M) -> ets:delete(Db, {sticky,M}) end, Mods) + foreach(fun (M) -> do_unstick_mod(Db, M) end, Mods) end; Error -> Error @@ -1177,6 +1180,15 @@ stick_mod(M, Stick, St) -> true -> ets:insert(Db, {{sticky,M},true}); false -> + do_unstick_mod(Db, M) + end. + +do_unstick_mod(Db, M) -> + case ets:lookup(Db, M) of + [{M,preloaded}] -> + %% Never unstick pre-loaded modules. + true; + _ -> ets:delete(Db, {sticky,M}) end. diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 036e238c85..4901206c8e 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -1076,10 +1076,13 @@ otp_1586(Conf) when is_list(Conf) -> {ok, Fd} = file:open(filename:join(Dir, "app5.app"), [write]), w_app5(Fd), file:close(Fd), - code:add_patha(Dir), - ok = application:load(app4()), - ok = application:unload(app4), - ok. + try + true = code:add_patha(Dir), + ok = application:load(app4()), + ok = application:unload(app4) + after + _ = code:del_path(Dir) + end. %%----------------------------------------------------------------- %% Ticket: OTP-2078 diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 42b81d16b3..afedc17e57 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -37,8 +37,7 @@ native_early_modules/1, get_mode/1]). -export([init_per_testcase/2, end_per_testcase/2, - init_per_suite/1, end_per_suite/1, - sticky_compiler/1]). + init_per_suite/1, end_per_suite/1]). %% error_logger -export([init/1, @@ -55,7 +54,7 @@ all() -> delete, purge, purge_many_exits, soft_purge, is_loaded, all_loaded, load_binary, dir_req, object_code, set_path_file, upgrade, - pa_pz_option, add_del_path, dir_disappeared, + sticky_dir, pa_pz_option, add_del_path, dir_disappeared, ext_mod_dep, clash, load_cached, start_node_with_cache, add_and_rehash, where_is_file_no_cache, where_is_file_cached, purge_stacktrace, mult_lib_roots, @@ -219,6 +218,13 @@ del_path(suite) -> []; del_path(doc) -> []; del_path(Config) when is_list(Config) -> P = code:get_path(), + try + del_path_1(P) + after + code:set_path(P) + end. + +del_path_1(P) -> test_server:format("Initial code:get_path()=~p~n",[P]), {'EXIT',_} = (catch code:del_path(3)), false = code:del_path(my_dummy_name), @@ -226,19 +232,22 @@ del_path(Config) when is_list(Config) -> Dir = filename:join([code:lib_dir(kernel),"ebin"]), test_server:format("kernel dir: ~p~n",[Dir]), - true = code:del_path(kernel), NewP = code:get_path(), test_server:format("Path after removing 'kernel':~p~n",[NewP]), ReferenceP = lists:delete(Dir,P), test_server:format("Reference path:~p~n",[ReferenceP]), NewP = ReferenceP, % check that dir is deleted + code:set_path(P), + %% An superfluous "/" should also work. + true = code:del_path("kernel/"), + NewP = ReferenceP, % check that dir is deleted code:set_path(P), + true = code:del_path(Dir), NewP1 = code:get_path(), NewP1 = lists:delete(Dir,P), % check that dir is deleted - code:set_path(P), ok. replace_path(suite) -> []; @@ -577,35 +586,42 @@ sticky_dir(suite) -> []; sticky_dir(doc) -> ["Test that a module with the same name as a module in ", "a sticky directory cannot be loaded."]; sticky_dir(Config) when is_list(Config) -> - MyDir=filename:dirname(code:which(?MODULE)), - {ok, Node}=?t:start_node(sticky_dir, slave,[{args, "-pa \""++MyDir++"\""}]), - File=filename:join([?config(data_dir, Config), "calendar"]), - Ret=rpc:call(Node, ?MODULE, sticky_compiler, [File]), + Pa = filename:dirname(code:which(?MODULE)), + {ok,Node} = ?t:start_node(sticky_dir, slave, [{args,"-pa "++Pa}]), + Mods = [code,lists,erlang,init], + OutDir = filename:join(?config(priv_dir, Config), sticky_dir), + _ = file:make_dir(OutDir), + Ret = rpc:call(Node, erlang, apply, + [fun sticky_compiler/2,[Mods,OutDir]]), case Ret of - fail -> - ?t:fail("c:c allowed a sticky module to be compiled and loaded."); - ok -> + [] -> ok; Other -> - test_server:format("Other: ~p",[Other]) + io:format("~p\n", [Other]), + ?t:fail() end, - ?t:stop_node(Node). + ?t:stop_node(Node), + ok. -sticky_compiler(File) -> - Compiled=File++code:objfile_extension(), - Dir=filename:dirname(File), - code:add_patha(Dir), - file:delete(Compiled), - case c:c(File, [{outdir, Dir}]) of - {ok, Module} -> - case catch Module:test(apa) of - {error, _} -> - fail; - {'EXIT', _} -> - ok - end; - Other -> - test_server:format("c:c(~p) returned: ~p",[File, Other]), +sticky_compiler(Files, PrivDir) -> + code:add_patha(PrivDir), + Rets = [do_sticky_compile(F, PrivDir) || F <- Files], + [R || R <- Rets, R =/= ok]. + +do_sticky_compile(Mod, Dir) -> + %% Make sure that the module is loaded. A module being sticky + %% only prevents it from begin reloaded, not from being loaded + %% from the wrong place to begin with. + Mod = Mod:module_info(module), + File = filename:append(Dir, atom_to_list(Mod)), + Src = io_lib:format("-module(~s).\n" + "-export([test/1]).\n" + "test(me) -> fail.\n", [Mod]), + ok = file:write_file(File++".erl", Src), + case c:c(File, [{outdir,Dir}]) of + {ok,Module} -> + Module:test(me); + {error,sticky_directory} -> ok end. diff --git a/lib/kernel/test/code_SUITE_data/calendar.erl b/lib/kernel/test/code_SUITE_data/calendar.erl deleted file mode 100644 index c1a4a1c12a..0000000000 --- a/lib/kernel/test/code_SUITE_data/calendar.erl +++ /dev/null @@ -1,23 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(calendar). --export([test/1]). - -test(apa) -> - {error, this_function_should_not_be_called}. diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index a83e55ac62..fe2fd67d71 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -1208,7 +1208,14 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) -> {value,{_,Worker}} = lists:keysearch(WPid,1,get_loaders(State0)), add_loader(Tab,Worker,State1); _ -> - State1 + DelState = State1#state{late_loader_queue=gb_trees:delete_any(Tab, LateQueue0)}, + case ?catch_val({Tab, storage_type}) of + ram_copies -> + cast({disc_load, Tab, ram_only}), + DelState; + _ -> + DelState + end end end, State3 = opt_start_worker(State2), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 81b435c6dc..c3846b00c0 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -131,9 +131,14 @@ send_release_tid(Nodes, Tid) -> receive_release_tid_acc([Node | Nodes], Tid) -> receive {?MODULE, Node, {tid_released, Tid}} -> - receive_release_tid_acc(Nodes, Tid); - {mnesia_down, Node} -> receive_release_tid_acc(Nodes, Tid) + after 0 -> + receive + {?MODULE, Node, {tid_released, Tid}} -> + receive_release_tid_acc(Nodes, Tid); + {mnesia_down, Node} -> + receive_release_tid_acc(Nodes, Tid) + end end; receive_release_tid_acc([], _Tid) -> ok. diff --git a/lib/mnesia/test/mnesia_qlc_test.erl b/lib/mnesia/test/mnesia_qlc_test.erl index 5f46840ae9..9886754710 100644 --- a/lib/mnesia/test/mnesia_qlc_test.erl +++ b/lib/mnesia/test/mnesia_qlc_test.erl @@ -264,7 +264,7 @@ atomic_eval(Config) -> ?match({1,[{a,{a,9},91}]}, ok(Restart,[Pid3, Cursor])), QC1 = ok(fun() -> qlc:cursor(Q1) end, []), - ?match({'EXIT', _}, qlc:next_answers(QC1)), + ?match({'EXIT', _}, (catch qlc:next_answers(QC1))), ?match({aborted,_}, ok(fun()->qlc:next_answers(QC1)end,[])), ?verify_mnesia(Ns, []). diff --git a/lib/mnesia/test/mnesia_test_lib.hrl b/lib/mnesia/test/mnesia_test_lib.hrl index 281634c239..94a195f01f 100644 --- a/lib/mnesia/test/mnesia_test_lib.hrl +++ b/lib/mnesia/test/mnesia_test_lib.hrl @@ -46,15 +46,32 @@ -define(match(ExpectedRes,Expr), fun() -> - AcTuAlReS = (catch (Expr)), - case AcTuAlReS of - ExpectedRes -> - ?verbose("ok, ~n Result as expected:~p~n",[AcTuAlReS]), - {success,AcTuAlReS}; - _ -> - ?error("Not Matching Actual result was:~n ~p~n", - [AcTuAlReS]), - {fail,AcTuAlReS} + try Expr of + _AR_0 = ExpectedRes -> + ?verbose("ok, ~n Result as expected:~p~n",[_AR_0]), + {success,_AR_0}; + _AR_0 -> + ?error("Not Matching Actual result was:~n ~p~n",[_AR_0]), + {fail,_AR_0} + catch + exit:{aborted, _ER_1} when + element(1, _ER_1) =:= node_not_running; + element(1, _ER_1) =:= bad_commit; + element(1, _ER_1) =:= cyclic -> + %% Need to re-raise these to restart transaction + erlang:raise(exit, {aborted, _ER_1}, erlang:get_stacktrace()); + exit:_AR_1 -> + case fun(_AR_EXIT_) -> {'EXIT', _AR_EXIT_} end(_AR_1) of + _AR_2 = ExpectedRes -> + ?verbose("ok, ~n Result as expected:~p~n",[_AR_2]), + {success,_AR_2}; + _AR_2 -> + ?error("Not Matching Actual result was:~n ~p~n", [_AR_2]), + {fail,_AR_2} + end; + _:_AR_1 -> + ?error("Not Matching Actual result was:~n ~p~n", [_AR_1]), + {fail,_AR_1} end end()). diff --git a/lib/mnesia/test/mnesia_trans_access_test.erl b/lib/mnesia/test/mnesia_trans_access_test.erl index 157e441b27..237984978e 100644 --- a/lib/mnesia/test/mnesia_trans_access_test.erl +++ b/lib/mnesia/test/mnesia_trans_access_test.erl @@ -677,7 +677,7 @@ check_res(sync_dirty, Res) when is_list(Res) -> check_res(ets, Res) when is_list(Res) -> Res; check_res(Type,Res) -> - ?match(bug,{Type,Res}). + ?match({bug, bug},{Type,Res}). read_op(Oid) -> case lists:reverse(mnesia:read(Oid)) of @@ -1118,10 +1118,7 @@ create_live_table_index(Config, Storage) -> ValPos = 3, mnesia:dirty_write({Tab, 1, 2}), - Fun = fun() -> - ?match(ok, mnesia:write({Tab, 2, 2})), - ok - end, + Fun = fun() -> mnesia:write({Tab, 2, 2}) end, ?match({atomic, ok}, mnesia:transaction(Fun)), ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), IRead = fun() -> lists:sort(mnesia:index_read(Tab, 2, ValPos)) end, diff --git a/lib/observer/src/cdv_timer_cb.erl b/lib/observer/src/cdv_timer_cb.erl index 9cdbfa05a9..d44592cf18 100644 --- a/lib/observer/src/cdv_timer_cb.erl +++ b/lib/observer/src/cdv_timer_cb.erl @@ -27,18 +27,21 @@ %% Defines -define(COL_OWNER, 0). --define(COL_MSG, ?COL_OWNER+1). +-define(COL_NAME, ?COL_OWNER+1). +-define(COL_MSG, ?COL_NAME+1). -define(COL_TIME, ?COL_MSG+1). %% Callbacks for cdv_virtual_list_wx col_to_elem(id) -> col_to_elem(?COL_OWNER); col_to_elem(?COL_OWNER) -> #timer.pid; +col_to_elem(?COL_NAME) -> #timer.name; col_to_elem(?COL_MSG) -> #timer.msg; col_to_elem(?COL_TIME) -> #timer.time. col_spec() -> [{"Owner", ?wxLIST_FORMAT_LEFT, 110}, - {"Message", ?wxLIST_FORMAT_LEFT, 400}, + {"Owner name", ?wxLIST_FORMAT_LEFT, 150}, + {"Message", ?wxLIST_FORMAT_LEFT, 300}, {"Time left (ms)", ?wxLIST_FORMAT_RIGHT, 80}]. get_info(Owner) -> diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl index c5a7d9a2e5..bfe115a42e 100644 --- a/lib/observer/src/cdv_virtual_list_wx.erl +++ b/lib/observer/src/cdv_virtual_list_wx.erl @@ -269,7 +269,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, MenuId = ?ID_DETAILS + Col, ColText = call(Holder, {get_row, self(), Row, Col}), case ColText of - "[]" -> []; + Empty when Empty=="[]"; Empty=="" -> []; _ -> What = case catch list_to_integer(ColText) of @@ -284,8 +284,13 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, end end, MenuCols), - wxWindow:popupMenu(Panel, Menu), - wxMenu:destroy(Menu), + case MenuItems of + [] -> + wxMenu:destroy(Menu); + _ -> + wxWindow:popupMenu(Panel, Menu), + wxMenu:destroy(Menu) + end, {noreply,State#state{menu_items=MenuItems}}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index a08d27d070..99329b94e2 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -298,6 +298,7 @@ expand_binary(Pos) -> %%-------------------------------------------------------------------- init([]) -> ets:new(cdv_dump_index_table,[ordered_set,named_table,public]), + ets:new(cdv_reg_proc_table,[ordered_set,named_table,public]), {ok, #state{}}. %%-------------------------------------------------------------------- @@ -978,9 +979,20 @@ count() -> %%----------------------------------------------------------------- %% Page with all processes procs_summary(File,WS) -> - ParseFun = fun(Fd,Pid) -> + ParseFun = fun(Fd,Pid0) -> + Pid = list_to_pid(Pid0), Proc = get_procinfo(Fd,fun main_procinfo/5, - #proc{pid=list_to_pid(Pid)},WS), + #proc{pid=Pid},WS), + case Proc#proc.name of + undefined -> + true; + Name -> + %% Registered process - store to allow + %% lookup for timers connected to + %% registered name instead of pid. + ets:insert(cdv_reg_proc_table,{Name,Pid}), + ets:insert(cdv_reg_proc_table,{Pid0,Name}) + end, case Proc#proc.memory of undefined -> Proc#proc{memory=Proc#proc.stack_heap}; _ -> Proc @@ -1495,8 +1507,28 @@ get_internal_ets_tables(File,WS) -> %%----------------------------------------------------------------- %% Page with list of all timers get_timers(File,Pid) -> - ParseFun = fun(Fd,Id) -> get_timerinfo_1(Fd,#timer{pid=list_to_pid(Id)}) end, - lookup_and_parse_index(File,{?timer,Pid},ParseFun,"timers"). + ParseFun = fun(Fd,Id) -> get_timerinfo(Fd,Id) end, + T1 = lookup_and_parse_index(File,{?timer,Pid},ParseFun,"timers"), + T2 = case ets:lookup(cdv_reg_proc_table,Pid) of + [{_,Name}] -> + lookup_and_parse_index(File,{?timer,Name},ParseFun,"timers"); + _ -> + [] + end, + T1 ++ T2. + +get_timerinfo(Fd,Id) -> + case catch list_to_pid(Id) of + Pid when is_pid(Pid) -> + get_timerinfo_1(Fd,#timer{pid=Pid}); + _ -> + case ets:lookup(cdv_reg_proc_table,Id) of + [{_,Pid}] when is_pid(Pid) -> + get_timerinfo_1(Fd,#timer{pid=Pid,name=Id}); + [] -> + get_timerinfo_1(Fd,#timer{name=Id}) + end + end. get_timerinfo_1(Fd,Timer) -> case line_head(Fd) of diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl index ae288ed573..0e2eba6dee 100644 --- a/lib/observer/src/crashdump_viewer.hrl +++ b/lib/observer/src/crashdump_viewer.hrl @@ -108,6 +108,7 @@ -record(timer, {pid, + name, msg, time}). diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 59fe5b5670..7757dfea53 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -409,7 +409,7 @@ handle_info({refresh, Min, Min}, State = #state{grid=Grid}) -> wxListCtrl:refreshItem(Grid, Min), %% Avoid assert in wx below if Max is 0 {noreply, State}; handle_info({refresh, Min, Max}, State = #state{grid=Grid}) -> - wxListCtrl:refreshItems(Grid, Min, Max), + Max > 0 andalso wxListCtrl:refreshItems(Grid, Min, Max), {noreply, State}; handle_info(refresh_interval, State = #state{pid=Pid}) -> diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index ced26f7119..03ca1bf9c1 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -112,7 +112,8 @@ setup(#state{frame = Frame} = State) -> observer_lib:create_menus(DefMenus, MenuBar, default), wxFrame:setMenuBar(Frame, MenuBar), - StatusBar = wxFrame:createStatusBar(Frame, []), + StatusBar = wxStatusBar:new(Frame), + wxFrame:setStatusBar(Frame, StatusBar), wxFrame:setTitle(Frame, atom_to_list(node())), wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), @@ -388,6 +389,7 @@ handle_info(_Info, State) -> terminate(_Reason, #state{frame = Frame}) -> wxFrame:destroy(Frame), + wx:destroy(), ok. code_change(_, _, State) -> diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index 40dbe28d46..0eb4a92c53 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -35,7 +35,9 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> register(aaaaaaaa,self()), process_flag(save_calls,3), ets:new(cdv_test_ordset_table,[ordered_set]), - erlang:send_after(1000000,self(),cdv_test_timer_message), + erlang:send_after(1000000,self(),cdv_test_timer_message1), + erlang:send_after(1000000,aaaaaaaa,cdv_test_timer_message2), + erlang:send_after(1000000,noexistproc,cdv_test_timer_message3), Port = hd(erlang:ports()), Fun = fun() -> ok end, Ref = make_ref(), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index e9567c82cb..03ab0c20e1 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -385,8 +385,14 @@ special(File,Procs) -> {ok,[_Ets=#ets_table{}],[]} = crashdump_viewer:ets_tables(Pid), io:format(" ets tables ok",[]), - {ok,[_Timer=#timer{}],[]} = crashdump_viewer:timers(Pid), - io:format(" timers ok",[]), + + {ok,[#timer{pid=Pid0,name=undefined}, + #timer{pid=Pid0,name="aaaaaaaa"}],[]} = + crashdump_viewer:timers(Pid), + {ok,AllTimers,_TimersTW} = crashdump_viewer:timers(all), + #timer{name="noexistproc"} = + lists:keyfind(undefined,#timer.pid,AllTimers), + io:format(" timers ok:",[]), {ok,Mod1=#loaded_mod{},[]} = crashdump_viewer:loaded_mod_details(atom_to_list(?helper_mod)), diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index af07165456..5cf719acb1 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -45,7 +45,7 @@ all() -> groups() -> [{gui, [], [basic - %% , process_win, table_win + , process_win, table_win ] }]. @@ -107,6 +107,10 @@ appup_file(Config) when is_list(Config) -> basic(suite) -> []; basic(doc) -> [""]; basic(Config) when is_list(Config) -> + timer:send_after(100, "foobar"), %% Otherwise the timer sever gets added to procs + ProcsBefore = processes(), + NumProcsBefore = length(ProcsBefore), + ok = observer:start(), Notebook = setup_whitebox_testing(), @@ -116,11 +120,11 @@ basic(Config) when is_list(Config) -> 0 = wxNotebook:getSelection(Notebook), timer:sleep(500), Check = fun(N, TestMore) -> - ok = wxNotebook:advanceSelection(Notebook), TestMore andalso test_page(wxNotebook:getPageText(Notebook, N), wxNotebook:getCurrentPage(Notebook)), - timer:sleep(200) + timer:sleep(200), + ok = wxNotebook:advanceSelection(Notebook) end, %% Just verify that we can toogle trough all pages [_|_] = [Check(N, false) || N <- lists:seq(1, Count)], @@ -128,9 +132,22 @@ basic(Config) when is_list(Config) -> Frame = get_top_level_parent(Notebook), {W,H} = wxWindow:getSize(Frame), wxWindow:setSize(Frame, W+10, H+10), - [_|_] = [Check(N, true) || N <- lists:seq(1, Count)], - - ok = observer:stop(). + [_|_] = [Check(N, true) || N <- lists:seq(0, Count-1)], + + ok = observer:stop(), + timer:sleep(2000), %% stop is async + ProcsAfter = processes(), + NumProcsAfter = length(ProcsAfter), + if NumProcsAfter=/=NumProcsBefore -> + ct:log("Before but not after:~n~p~n", + [[{P,process_info(P)} || P <- ProcsBefore -- ProcsAfter]]), + ct:log("After but not before:~n~p~n", + [[{P,process_info(P)} || P <- ProcsAfter -- ProcsBefore]]), + ct:fail("leaking processes"); + true -> + ok + end, + ok. test_page("Load Charts" ++ _, _Window) -> %% Just let it display some info and hopefully it doesn't crash @@ -163,8 +180,11 @@ test_page("Processes" ++ _, _Window) -> timer:sleep(1000), %% Give it time to refresh ok; -test_page("Table" ++ _, _Window) -> +test_page(_Title = "Table" ++ _, _Window) -> Tables = [ets:new(list_to_atom("Test-" ++ [C]), [public]) || C <- lists:seq($A, $Z)], + Table = lists:nth(3, Tables), + ets:insert(Table, [{N,100-N} || N <- lists:seq(1,100)]), + Active = get_active(), Active ! refresh_interval, ChangeSort = fun(N) -> @@ -174,8 +194,6 @@ test_page("Table" ++ _, _Window) -> end, [ChangeSort(N) || N <- lists:seq(1,5) ++ [0]], timer:sleep(1000), - Table = lists:nth(3, Tables), - ets:insert(Table, [{N,100-N} || N <- lists:seq(1,100)]), Focus = #wx{event=#wxList{type=command_list_item_selected, itemIndex=2}}, Active ! Focus, Activate = #wx{event=#wxList{type=command_list_item_activated, itemIndex=2}}, @@ -226,14 +244,12 @@ table_win(Config) when is_list(Config) -> %% Modal can not test edit.. %% TPid = wx_object:get_pid(TObj), %% TPid ! #wx{event=#wxList{type=command_list_item_activated, itemIndex=12}}, - timer:sleep(2000), + timer:sleep(3000), wx_object:get_pid(TObj) ! #wx{event=#wxClose{type=close_window}}, observer:stop(), ok. - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% get_top_level_parent(Window) -> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index bce02966ae..84d5e5c86e 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -29,6 +29,36 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed timeout bug in ssh:connect.</p> + <p> + Own Id: OTP-11908</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Option <c>max_sessions</c> added to + <c>ssh:daemon/{2,3}</c>. This option, if set, limits the + number of simultaneous connections accepted by the + daemon.</p> + <p> + Own Id: OTP-11885</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 1917c95f5a..42eb2167e0 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,9 +19,13 @@ {"%VSN%", [ + {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_acceptor, soft_purge, soft_purge, []}]}, {<<".*">>, [{restart_application, ssh}]} ], [ + {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_acceptor, soft_purge, soft_purge, []}]}, {<<".*">>, [{restart_application, ssh}]} ] }. diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl index 832b144db9..35336bce8b 100644 --- a/lib/ssh/src/ssh_io.erl +++ b/lib/ssh/src/ssh_io.erl @@ -81,6 +81,8 @@ format(Fmt, Args) -> trim(Line) when is_list(Line) -> lists:reverse(trim1(lists:reverse(trim1(Line)))); +trim(Line) when is_binary(Line) -> + trim(unicode:characters_to_list(Line)); trim(Other) -> Other. trim1([$\s|Cs]) -> trim(Cs); diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 37a307d783..ba38c1da40 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -49,6 +49,7 @@ all() -> server_userpassword_option, double_close, ssh_connect_timeout, + ssh_connect_arg4_timeout, {group, hardening_tests} ]. diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index c8cac3e852..40ed27d8f5 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.1 +SSH_VSN = 3.0.2 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index b0ef292c4e..b713f86c1e 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,33 +1,13 @@ %% -*- erlang -*- {"%VSN%", [ - {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]}, + {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]}, {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]}, + {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]}, {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 234db21443..be1041ca13 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -99,7 +99,7 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), - try handle_options(SslOptions0 ++ SocketValues, client) of + try handle_options(SslOptions0 ++ SocketValues) of {ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}} -> @@ -107,7 +107,7 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> case ssl_socket:peername(Transport, Socket) of {ok, {Address, Port}} -> ssl_connection:connect(ConnectionCb, Address, Port, Socket, - {SslOptions, emulated_socket_options(EmOpts, #socket_options{})}, + {SslOptions, emulated_socket_options(EmOpts, #socket_options{}), undefined}, self(), CbInfo, Timeout); {error, Error} -> {error, Error} @@ -121,7 +121,7 @@ connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). connect(Host, Port, Options, Timeout) -> - try handle_options(Options, client) of + try handle_options(Options) of {ok, Config} -> do_connect(Host,Port,Config,Timeout) catch @@ -139,7 +139,7 @@ listen(_Port, []) -> {error, nooptions}; listen(Port, Options0) -> try - {ok, Config} = handle_options(Options0, server), + {ok, Config} = handle_options(Options0), ConnectionCb = connection_cb(Options0), #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb, ssl = SslOpts, emulated = EmOpts} = Config, @@ -176,11 +176,11 @@ transport_accept(#sslsocket{pid = {ListenSocket, {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker), {ok, Port} = ssl_socket:port(Transport, Socket), ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, self(), CbInfo], + {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), Tracker}, self(), CbInfo], ConnectionSup = connection_sup(ConnectionCb), case ConnectionSup:start_child(ConnArgs) of {ok, Pid} -> - ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport); + ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport, Tracker); {error, Reason} -> {error, Reason} end; @@ -211,10 +211,11 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(#sslsocket{} = Socket, [], Timeout) -> ssl_accept(#sslsocket{} = Socket, Timeout); -ssl_accept(#sslsocket{} = Socket, SslOptions, Timeout) -> +ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) -> try - {ok, #config{ssl = SSL}} = handle_options(SslOptions, server), - ssl_connection:handshake(Socket, SSL, Timeout) + {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), + SslOpts = handle_options(SslOpts0, InheritedSslOpts), + ssl_connection:handshake(Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; @@ -224,12 +225,12 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), - try handle_options(SslOptions ++ SocketValues, server) of + try handle_options(SslOptions ++ SocketValues) of {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), {ok, Port} = ssl_socket:port(Transport, Socket), ssl_connection:ssl_accept(ConnetionCb, Port, Socket, - {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, + {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined}, self(), CbInfo, Timeout) catch Error = {error, _Reason} -> Error @@ -299,7 +300,7 @@ connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> ssl_socket:peername(Transport, Socket); peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} @@ -345,17 +346,22 @@ negotiated_next_protocol(#sslsocket{pid = Pid}) -> %%-------------------------------------------------------------------- cipher_suites() -> cipher_suites(erlang). - + cipher_suites(erlang) -> Version = tls_record:highest_protocol_version([]), - [suite_definition(S) || S <- ssl_cipher:suites(Version)]; - + ssl_cipher:filter_suites([suite_definition(S) + || S <- ssl_cipher:suites(Version)]); cipher_suites(openssl) -> Version = tls_record:highest_protocol_version([]), - [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]; + [ssl_cipher:openssl_suite_name(S) + || S <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]; cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), - [suite_definition(S) || S <- ssl_cipher:all_suites(Version)]. + Supported = ssl_cipher:all_suites(Version) + ++ ssl_cipher:anonymous_suites(Version) + ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:srp_suites(), + ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]). %%-------------------------------------------------------------------- -spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> @@ -423,10 +429,10 @@ shutdown(#sslsocket{pid = Pid}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}) when is_port(Listen) -> +sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}) when is_port(Listen) -> ssl_socket:sockname(Transport, Listen); -sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> ssl_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- @@ -546,7 +552,7 @@ do_connect(Address, Port, try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> ssl_connection:connect(ConnetionCb, Address, Port, Socket, - {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, + {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined}, self(), CbInfo, Timeout); {error, Reason} -> {error, Reason} @@ -559,53 +565,47 @@ do_connect(Address, Port, {error, {options, {socket_options, UserOpts}}} end. -handle_options(Opts0, _Role) -> +%% Handle extra ssl options given to ssl_accept +handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, + cacertfile = CaCertFile0} = InheritedSslOpts) -> + RecordCB = record_cb(Protocol), + CaCerts = handle_option(cacerts, Opts0, CaCerts0), + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts0, CaCerts), + CaCertFile = case proplists:get_value(cacertfile, Opts0, CaCertFile0) of + undefined -> + CaCertDefault; + CAFile -> + CAFile + end, + NewVerifyOpts = InheritedSslOpts#ssl_options{cacerts = CaCerts, + cacertfile = CaCertFile, + verify = Verify, + verify_fun = VerifyFun, + fail_if_no_peer_cert = FailIfNoPeerCert}, + SslOpts1 = lists:foldl(fun(Key, PropList) -> + proplists:delete(Key, PropList) + end, Opts0, [cacerts, cacertfile, verify, verify_fun, fail_if_no_peer_cert]), + case handle_option(versions, SslOpts1, []) of + [] -> + new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB); + Value -> + Versions = [RecordCB:protocol_version(Vsn) || Vsn <- Value], + new_ssl_options(proplists:delete(versions, SslOpts1), + NewVerifyOpts#ssl_options{versions = Versions}, record_cb(Protocol)) + end. + +%% Handle all options in listen and connect +handle_options(Opts0) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), assert_proplist(Opts), RecordCb = record_cb(Opts), ReuseSessionFun = fun(_, _, _, _) -> true end, - - DefaultVerifyNoneFun = - {fun(_,{bad_cert, _}, UserState) -> - {valid, UserState}; - (_,{extension, _}, UserState) -> - {unknown, UserState}; - (_, valid, UserState) -> - {valid, UserState}; - (_, valid_peer, UserState) -> - {valid, UserState} - end, []}, - - VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), - - UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), - UserVerifyFun = handle_option(verify_fun, Opts, undefined), CaCerts = handle_option(cacerts, Opts, undefined), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = - %% Handle 0, 1, 2 for backwards compatibility - case proplists:get_value(verify, Opts, verify_none) of - 0 -> - {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; - 1 -> - {verify_peer, false, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - 2 -> - {verify_peer, true, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - verify_none -> - {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; - verify_peer -> - {verify_peer, UserFailIfNoPeerCert, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - Value -> - throw({error, {options, {verify, Value}}}) - end, - + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts, CaCerts), + CertFile = handle_option(certfile, Opts, <<>>), RecordCb = record_cb(Opts), @@ -652,7 +652,8 @@ handle_options(Opts0, _Role) -> handle_option(client_preferred_next_protocols, Opts, undefined)), log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), - honor_cipher_order = handle_option(honor_cipher_order, Opts, false) + honor_cipher_order = handle_option(honor_cipher_order, Opts, false), + protocol = proplists:get_value(protocol, Opts, tls) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -671,10 +672,10 @@ handle_options(Opts0, _Role) -> proplists:delete(Key, PropList) end, Opts, SslOptions), - {SSLsock, Emulated} = emulated_options(SockOpts), + {Sock, Emulated} = emulated_options(SockOpts), ConnetionCb = connection_cb(Opts), - {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = SSLsock, + {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = Sock, inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb }}. @@ -933,8 +934,11 @@ handle_cipher_option(Value, Version) when is_list(Value) -> error:_-> throw({error, {options, {ciphers, Value}}}) end. -binary_cipher_suites(Version, []) -> % Defaults to all supported suites - ssl_cipher:suites(Version); + +binary_cipher_suites(Version, []) -> + %% Defaults to all supported suites that does + %% not require explicit configuration + ssl_cipher:filter_suites(ssl_cipher:suites(Version)); binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], binary_cipher_suites(Version, Ciphers); @@ -943,14 +947,15 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - Supported0 = ssl_cipher:suites(Version) + All = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites() ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), - Supported = ssl_cipher:filter_suites(Supported0), - case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of + case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> - Supported; %% Defaults to all supported suits + %% Defaults to all supported suites that does + %% not require explicit configuration + ssl_cipher:filter_suites(ssl_cipher:suites(Version)); Ciphers -> Ciphers end; @@ -1034,7 +1039,7 @@ record_cb(tls) -> record_cb(dtls) -> dtls_record; record_cb(Opts) -> - record_cb(proplists:get_value(protocol, Opts, tls)). + record_cb(proplists:get_value(protocol, Opts, tls)). connection_sup(tls_connection) -> tls_connection_sup; @@ -1070,3 +1075,98 @@ emulated_socket_options(InetValues, #socket_options{ packet = proplists:get_value(packet, InetValues, Packet), packet_size = proplists:get_value(packet_size, InetValues, Size) }. + +new_ssl_options([], #ssl_options{} = Opts, _) -> + Opts; +new_ssl_options([{verify_client_once, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{verify_client_once = validate_option(verify_client_once, Value)}, RecordCB); +new_ssl_options([{depth, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{depth = validate_option(depth, Value)}, RecordCB); +new_ssl_options([{cert, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{cert = validate_option(cert, Value)}, RecordCB); +new_ssl_options([{certfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{certfile = validate_option(certfile, Value)}, RecordCB); +new_ssl_options([{key, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{key = validate_option(key, Value)}, RecordCB); +new_ssl_options([{keyfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{keyfile = validate_option(keyfile, Value)}, RecordCB); +new_ssl_options([{password, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{password = validate_option(password, Value)}, RecordCB); +new_ssl_options([{dh, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{dh = validate_option(dh, Value)}, RecordCB); +new_ssl_options([{dhfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{dhfile = validate_option(dhfile, Value)}, RecordCB); +new_ssl_options([{user_lookup_fun, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{user_lookup_fun = validate_option(user_lookup_fun, Value)}, RecordCB); +new_ssl_options([{psk_identity, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{psk_identity = validate_option(psk_identity, Value)}, RecordCB); +new_ssl_options([{srp_identity, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{srp_identity = validate_option(srp_identity, Value)}, RecordCB); +new_ssl_options([{ciphers, Value} | Rest], #ssl_options{versions = Versions} = Opts, RecordCB) -> + Ciphers = handle_cipher_option(Value, RecordCB:highest_protocol_version(Versions)), + new_ssl_options(Rest, + Opts#ssl_options{ciphers = Ciphers}, RecordCB); +new_ssl_options([{reuse_session, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{reuse_session = validate_option(reuse_session, Value)}, RecordCB); +new_ssl_options([{reuse_sessions, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{reuse_sessions = validate_option(reuse_sessions, Value)}, RecordCB); +new_ssl_options([{ssl_imp, _Value} | Rest], #ssl_options{} = Opts, RecordCB) -> %% Not used backwards compatibility + new_ssl_options(Rest, Opts, RecordCB); +new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB); +new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); +new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); +new_ssl_options([{next_protocols_advertised, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{next_protocols_advertised = validate_option(next_protocols_advertised, Value)}, RecordCB); +new_ssl_options([{client_preferred_next_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{next_protocol_selector = + make_next_protocol_selector(validate_option(client_preferred_next_protocols, Value))}, RecordCB); +new_ssl_options([{log_alert, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{log_alert = validate_option(log_alert, Value)}, RecordCB); +new_ssl_options([{server_name_indication, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{server_name_indication = validate_option(server_name_indication, Value)}, RecordCB); +new_ssl_options([{honor_cipher_order, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{honor_cipher_order = validate_option(honor_cipher_order, Value)}, RecordCB); +new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) -> + throw({error, {options, {Key, Value}}}). + + +handle_verify_options(Opts, CaCerts) -> + DefaultVerifyNoneFun = + {fun(_,{bad_cert, _}, UserState) -> + {valid, UserState}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> + {valid, UserState} + end, []}, + VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), + + UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), + UserVerifyFun = handle_option(verify_fun, Opts, undefined), + + + %% Handle 0, 1, 2 for backwards compatibility + case proplists:get_value(verify, Opts, verify_none) of + 0 -> + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + 1 -> + {verify_peer, false, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + 2 -> + {verify_peer, true, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + verify_none -> + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + verify_peer -> + {verify_peer, UserFailIfNoPeerCert, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + Value -> + throw({error, {options, {verify, Value}}}) + end. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index a3ec419c2a..72467ea2a0 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1019,7 +1019,8 @@ openssl_suite_name(Cipher) -> %%-------------------------------------------------------------------- -spec filter(undefined | binary(), [cipher_suite()]) -> [cipher_suite()]. %% -%% Description: . +%% Description: Select the cipher suites that can be used together with the +%% supplied certificate. (Server side functionality) %%------------------------------------------------------------------- filter(undefined, Ciphers) -> Ciphers; @@ -1053,7 +1054,7 @@ filter(DerCert, Ciphers) -> %%-------------------------------------------------------------------- -spec filter_suites([cipher_suite()]) -> [cipher_suite()]. %% -%% Description: filter suites for algorithms +%% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- filter_suites(Suites = [{_,_,_}|_]) -> Algos = crypto:supports(), diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 1eda926bcb..34006612a2 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -37,7 +37,7 @@ %% Setup -export([connect/8, ssl_accept/7, handshake/2, handshake/3, - socket_control/4]). + socket_control/4, socket_control/5]). %% User Events -export([send/2, recv/3, close/1, shutdown/2, @@ -50,7 +50,7 @@ %% 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]). +-export([handle_sync_event/4, handle_info/3, terminate/3, format_status/2]). %%==================================================================== @@ -121,9 +121,16 @@ handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) -> %% Description: Set the ssl process to own the accept socket %%-------------------------------------------------------------------- socket_control(Connection, Socket, Pid, Transport) -> + socket_control(Connection, Socket, Pid, Transport, undefined). + +%-------------------------------------------------------------------- +-spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) -> + {ok, #sslsocket{}} | {error, reason()}. +%%-------------------------------------------------------------------- +socket_control(Connection, Socket, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, ssl_socket:socket(Pid, Transport, Socket, Connection)}; + {ok, ssl_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end. @@ -602,7 +609,7 @@ cipher(#finished{verify_data = Data} = Finished, cipher(#next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}), - Connection:next_state(cipher, cipher, Record, State); + Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false}); cipher(timeout, State, _) -> {next_state, cipher, State, hibernate}; @@ -642,12 +649,27 @@ handle_sync_event({application_data, Data}, From, StateName, State#state{send_queue = queue:in({From, Data}, Queue)}, get_timeout(State)}; -handle_sync_event({start, Timeout}, StartFrom, hello, #state{protocol_cb = Connection} = State) -> - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - Connection:hello(start, State#state{start_or_recv_from = StartFrom, - timer = Timer}); +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; -%% The two clauses below could happen if a server upgrades a socket in +%% 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 @@ -657,17 +679,16 @@ handle_sync_event({start, Timeout}, StartFrom, hello, #state{protocol_cb = Conne %% they upgrade an active socket. handle_sync_event({start,_}, _, connection, State) -> {reply, connected, connection, State, get_timeout(State)}; -handle_sync_event({start,_}, _From, error, {Error, State = #state{}}) -> - {stop, {shutdown, Error}, {error, Error}, State}; -handle_sync_event({start, Timeout}, StartFrom, StateName, State) -> - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - {next_state, StateName, State#state{start_or_recv_from = StartFrom, - timer = Timer}, get_timeout(State)}; - -handle_sync_event({start, Opts, Timeout}, From, StateName, #state{ssl_options = SslOpts} = State) -> - NewOpts = new_ssl_options(Opts, SslOpts), - handle_sync_event({start, Timeout}, From, StateName, State#state{ssl_options = NewOpts}); +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, _, StateName, #state{protocol_cb = Connection} = State) -> %% Run terminate before returning @@ -675,7 +696,6 @@ handle_sync_event(close, _, StateName, #state{protocol_cb = Connection} = State) %% as intended. (catch Connection:terminate(user_close, StateName, State)), {stop, normal, ok, State#state{terminated = true}}; - handle_sync_event({shutdown, How0}, _, StateName, #state{transport_cb = Transport, negotiated_version = Version, @@ -697,17 +717,14 @@ handle_sync_event({shutdown, How0}, _, StateName, Error -> {stop, normal, Error, State} 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) -> @@ -715,26 +732,22 @@ handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) -> {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, _}}) -> 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, #state{socket = Socket, transport_cb = Transport, socket_options = SockOpts} = State) -> OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; - handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)}; handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) -> {reply, {ok, NextProtocol}, StateName, State, get_timeout(State)}; - handle_sync_event({set_opts, Opts0}, _From, StateName0, #state{socket_options = Opts1, protocol_cb = Connection, @@ -773,13 +786,10 @@ handle_sync_event({set_opts, Opts0}, _From, StateName0, 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) -> @@ -805,7 +815,6 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, error:Reason -> {error, Reason} end, {reply, Reply, StateName, State, get_timeout(State)}; - handle_sync_event(info, _, StateName, #state{negotiated_version = Version, session = #session{cipher_suite = Suite}} = State) -> @@ -813,14 +822,12 @@ handle_sync_event(info, _, StateName, AtomVersion = tls_record:protocol_version(Version), {reply, {ok, {AtomVersion, ssl:suite_definition(Suite)}}, 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:suite_definition(Suite)}], StateName, State, get_timeout(State)}; - handle_sync_event(peer_certificate, _, StateName, #state{session = #session{peer_certificate = Cert}} = State) -> @@ -830,8 +837,9 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, start_or_recv_from = StartFrom, role = Role, protocol_cb = Connection, - error_tag = ErrorTag} = State) when StateName =/= connection -> - Connection:alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), + error_tag = ErrorTag, + tracker = Tracker} = State) when StateName =/= connection -> + 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, @@ -881,7 +889,6 @@ terminate(_, _, #state{terminated = true}) -> %% we want to guarantee that Transport:close has been called %% when ssl:close/1 returns. ok; - terminate({shutdown, transport_closed}, StateName, #state{send_queue = SendQueue, renegotiation = Renegotiate} = State) -> handle_unrecv_data(StateName, State), @@ -894,7 +901,6 @@ terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue, handle_trusted_certs_db(State), notify_senders(SendQueue), notify_renegotiater(Renegotiate); - terminate(Reason, connection, #state{negotiated_version = Version, protocol_cb = Connection, connection_states = ConnectionStates, @@ -911,7 +917,6 @@ terminate(Reason, connection, #state{negotiated_version = Version, _ -> ok end; - terminate(_Reason, _StateName, #state{transport_cb = Transport, socket = Socket, send_queue = SendQueue, renegotiation = Renegotiate} = State) -> @@ -920,9 +925,50 @@ terminate(_Reason, _StateName, #state{transport_cb = Transport, notify_renegotiater(Renegotiate), Transport:close(Socket). +format_status(normal, [_, State]) -> + [{data, [{"StateData", State}]}]; +format_status(terminate, [_, State]) -> + SslOptions = (State#state.ssl_options), + NewOptions = SslOptions#ssl_options{password = "***", + cert = "***", + cacerts = "***", + key = "***", + dh = "***", + psk_identity = "***", + srp_identity = "***"}, + [{data, [{"StateData", State#state{connection_states = "***", + protocol_buffers = "***", + user_data_buffer = "***", + tls_handshake_history = "***", + session = "***", + private_key = "***", + diffie_hellman_params = "***", + diffie_hellman_keys = "***", + srp_params = "***", + srp_keys = "***", + premaster_secret = "***", + ssl_options = NewOptions + }}]}]. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +ssl_config(Opts, Role, State) -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} = + ssl_config:init(Opts, Role), + Handshake = ssl_handshake:init_handshake_history(), + TimeStamp = calendar:datetime_to_gregorian_seconds({date(), 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, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams, + ssl_options = Opts}. + do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} = ServerHelloExt, #state{negotiated_version = Version, @@ -1825,17 +1871,6 @@ make_premaster_secret({MajVer, MinVer}, rsa) -> make_premaster_secret(_, _) -> undefined. -%% One day this can be maps instead, but we have to be backwards compatible for now -new_ssl_options(New, Old) -> - new_ssl_options(tuple_to_list(New), tuple_to_list(Old), []). - -new_ssl_options([], [], Acc) -> - list_to_tuple(lists:reverse(Acc)); -new_ssl_options([undefined | Rest0], [Head1| Rest1], Acc) -> - new_ssl_options(Rest0, Rest1, [Head1 | Acc]); -new_ssl_options([Head0 | Rest0], [_| Rest1], Acc) -> - new_ssl_options(Rest0, Rest1, [Head0 | Acc]). - negotiated_hashsign(undefined, Alg, Version) -> %% Not negotiated choose default case is_anonymous(Alg) of diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index b01c6cb1b3..592889b177 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -78,7 +78,8 @@ allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), next_protocol = undefined :: undefined | binary(), - client_ecc % {Curves, PointFmt} + client_ecc, % {Curves, PointFmt} + tracker :: pid() %% Tracker process for listen socket }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index fbc73e0e42..2bc5a90f68 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -282,8 +282,13 @@ handle_cast({register_session, Host, Port, Session}, session_cache_cb = CacheCb} = State) -> TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), NewSession = Session#session{time_stamp = TimeStamp}, - CacheCb:update(Cache, {{Host, Port}, - NewSession#session.session_id}, NewSession), + case CacheCb:select_session(Cache, {Host, Port}) of + no_session -> + CacheCb:update(Cache, {{Host, Port}, + NewSession#session.session_id}, NewSession); + Sessions -> + register_unique_session(Sessions, NewSession, CacheCb, Cache, {Host, Port}) + end, {noreply, State}; handle_cast({register_session, Port, Session}, @@ -494,3 +499,34 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> _ -> ok end. + +%% Do not let dumb clients create a gigantic session table +register_unique_session(Sessions, Session, CacheCb, Cache, PartialKey) -> + case exists_equivalent(Session , Sessions) of + true -> + ok; + false -> + CacheCb:update(Cache, {PartialKey, + Session#session.session_id}, Session) + end. + +exists_equivalent(_, []) -> + false; +exists_equivalent(#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} , + [#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} | _]) -> + true; +exists_equivalent(Session, [ _ | Rest]) -> + exists_equivalent(Session, Rest). + diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 87ed233c0a..6aab35d6da 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -70,7 +70,7 @@ -define(INITIAL_BYTES, 5). --define(MAX_SEQENCE_NUMBER, 18446744073709552000). %% math:pow(2, 64) - 1 = 1.8446744073709552e19 +-define(MAX_SEQENCE_NUMBER, 18446744073709551615). %% (1 bsl 64) - 1 = 18446744073709551615 %% Sequence numbers can not wrap so when max is about to be reached we should renegotiate. %% We will renegotiate a little before so that there will be sequence numbers left %% for the rehandshake and a little data. Currently we decided to renegotiate a little more diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl index e42d637301..55eb569b20 100644 --- a/lib/ssl/src/ssl_socket.erl +++ b/lib/ssl/src/ssl_socket.erl @@ -23,24 +23,25 @@ -include("ssl_internal.hrl"). -include("ssl_api.hrl"). --export([socket/4, setopts/3, getopts/3, peername/2, sockname/2, port/2]). +-export([socket/5, setopts/3, getopts/3, peername/2, sockname/2, port/2]). -export([emulated_options/0, internal_inet_values/0, default_inet_values/0, - init/1, start_link/2, terminate/2, inherit_tracker/3, get_emulated_opts/1, - set_emulated_opts/2, handle_call/3, handle_cast/2, + init/1, start_link/3, terminate/2, inherit_tracker/3, get_emulated_opts/1, + set_emulated_opts/2, get_all_opts/1, handle_call/3, handle_cast/2, handle_info/2, code_change/3]). -record(state, { emulated_opts, - port + port, + ssl_opts }). %%-------------------------------------------------------------------- %%% Internal API %%-------------------------------------------------------------------- -socket(Pid, Transport, Socket, ConnectionCb) -> +socket(Pid, Transport, Socket, ConnectionCb, Tracker) -> #sslsocket{pid = Pid, %% "The name "fd" is keept for backwards compatibility - fd = {Transport, Socket, ConnectionCb}}. + fd = {Transport, Socket, ConnectionCb, Tracker}}. setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> {SockOpts, EmulatedOpts} = split_options(Options), ok = set_emulated_opts(Tracker, EmulatedOpts), @@ -96,28 +97,24 @@ internal_inet_values() -> default_inet_values() -> [{packet_size, 0}, {packet,0}, {header, 0}, {active, true}, {mode, list}]. -inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = false}) -> - ssl_listen_tracker_sup:start_child([ListenSocket, EmOpts]); -inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = true}) -> - ssl_listen_tracker_sup:start_child_dist([ListenSocket, EmOpts]). - -get_emulated_opts(TrackerPid, EmOptNames) -> - {ok, EmOpts} = get_emulated_opts(TrackerPid), - lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), - Value end, - EmOptNames). +inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = false} = SslOpts) -> + ssl_listen_tracker_sup:start_child([ListenSocket, EmOpts, SslOpts]); +inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = true} = SslOpts) -> + ssl_listen_tracker_sup:start_child_dist([ListenSocket, EmOpts, SslOpts]). get_emulated_opts(TrackerPid) -> call(TrackerPid, get_emulated_opts). set_emulated_opts(TrackerPid, InetValues) -> call(TrackerPid, {set_emulated_opts, InetValues}). +get_all_opts(TrackerPid) -> + call(TrackerPid, get_all_opts). %%==================================================================== %% ssl_listen_tracker_sup API %%==================================================================== -start_link(Port, SockOpts) -> - gen_server:start_link(?MODULE, [Port, SockOpts], []). +start_link(Port, SockOpts, SslOpts) -> + gen_server:start_link(?MODULE, [Port, SockOpts, SslOpts], []). %%-------------------------------------------------------------------- -spec init(list()) -> {ok, #state{}}. @@ -126,10 +123,10 @@ start_link(Port, SockOpts) -> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Port, Opts]) -> +init([Port, Opts, SslOpts]) -> process_flag(trap_exit, true), true = link(Port), - {ok, #state{emulated_opts = Opts, port = Port}}. + {ok, #state{emulated_opts = Opts, port = Port, ssl_opts = SslOpts}}. %%-------------------------------------------------------------------- -spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. @@ -148,7 +145,11 @@ handle_call({set_emulated_opts, Opts0}, _From, {reply, ok, State#state{emulated_opts = Opts}}; handle_call(get_emulated_opts, _From, #state{emulated_opts = Opts} = State) -> - {reply, {ok, Opts}, State}. + {reply, {ok, Opts}, State}; +handle_call(get_all_opts, _From, + #state{emulated_opts = EmOpts, + ssl_opts = SslOpts} = State) -> + {reply, {ok, EmOpts, SslOpts}, State}. %%-------------------------------------------------------------------- -spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. @@ -162,10 +163,11 @@ handle_cast(_, State)-> {noreply, State}. %%-------------------------------------------------------------------- --spec handle_info(msg(), #state{}) -> {noreply, #state{}}. +-spec handle_info(msg(), #state{}) -> {stop, reason(), #state{}}. %% Possible return values not used now. +%% {noreply, #state{}}. %% |{noreply, #state{}, timeout()} | -%% {stop, reason(), #state{}}. +%% %% %% Description: Handling all non call/cast messages %%------------------------------------------------------------------- @@ -227,3 +229,9 @@ get_socket_opts(_, [], _) -> get_socket_opts(ListenSocket, SockOptNames, Cb) -> {ok, Opts} = Cb:getopts(ListenSocket, SockOptNames), Opts. + +get_emulated_opts(TrackerPid, EmOptNames) -> + {ok, EmOpts} = get_emulated_opts(TrackerPid), + lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), + Value end, + EmOptNames). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 32086ff6ce..2ab085321a 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -53,7 +53,7 @@ %% Alert and close handling -export([send_alert/2, handle_own_alert/4, handle_close_alert/3, handle_normal_shutdown/3, handle_unexpected_message/3, - workaround_transport_delivery_problems/2, alert_user/5, alert_user/8 + workaround_transport_delivery_problems/2, alert_user/6, alert_user/9 ]). %% Data handling @@ -66,18 +66,18 @@ %% 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]). + handle_sync_event/4, handle_info/3, terminate/3, code_change/4, format_status/2]). %%==================================================================== %% Internal application API %%==================================================================== -start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = tls_connection_sup:start_child([Role, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), ok = ssl_connection:handshake(SslSocket, Timeout), {ok, SslSocket} catch @@ -85,13 +85,13 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, Error end; -start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts, User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = tls_connection_sup:start_child_dist([Role, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), ok = ssl_connection:handshake(SslSocket, Timeout), {ok, SslSocket} catch @@ -144,29 +144,10 @@ 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 = calendar:datetime_to_gregorian_seconds({date(), time()}), - try ssl_config:init(SSLOpts0, Role) of - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, 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, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams}, - gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)) - catch - throw:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error,State0}, get_timeout(State0)) - end. + State = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)). %%-------------------------------------------------------------------- %% Description:There should be one instance of this function for each @@ -342,8 +323,7 @@ handle_info(Msg, StateName, State) -> %% Reason. The return value is ignored. %%-------------------------------------------------------------------- terminate(Reason, StateName, State) -> - ssl_connection:terminate(Reason, StateName, State). - + catch ssl_connection:terminate(Reason, StateName, State). %%-------------------------------------------------------------------- %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} @@ -352,6 +332,9 @@ terminate(Reason, StateName, State) -> code_change(_OldVsn, StateName, State, _Extra) -> {ok, StateName, State}. +format_status(Type, Data) -> + ssl_connection:format_status(Type, Data). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -368,7 +351,7 @@ encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> decode_alerts(Bin) -> ssl_alert:decode(Bin). -initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, +initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> ConnectionStates = ssl_record:init_connection_states(Role), @@ -382,9 +365,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, Monitor = erlang:monitor(process, User), #state{socket_options = SocketOptions, - %% We do not want to save the password in the state so that - %% could be written in the clear into error logs. - ssl_options = SSLOptions#ssl_options{password = undefined}, + ssl_options = SSLOptions, session = #session{is_resumable = new}, transport_cb = CbModule, data_tag = DataTag, @@ -402,7 +383,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, renegotiation = {false, first}, start_or_recv_from = undefined, send_queue = queue:new(), - protocol_cb = ?MODULE + protocol_cb = ?MODULE, + tracker = Tracker }. next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> @@ -507,7 +489,7 @@ next_record(State) -> next_record_if_active(State = #state{socket_options = - #socket_options{active = false}}) -> + #socket_options{active = false}}) -> {no_record ,State}; next_record_if_active(State) -> @@ -571,7 +553,8 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, bytes_to_read = BytesToRead, start_or_recv_from = RecvFrom, timer = Timer, - user_data_buffer = Buffer0} = State0) -> + user_data_buffer = Buffer0, + tracker = Tracker} = State0) -> Buffer1 = if Buffer0 =:= <<>> -> Data; Data =:= <<>> -> Buffer0; @@ -579,7 +562,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data - SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom), + SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom, Tracker), cancel_timer(Timer), State = State0#state{user_data_buffer = Buffer, start_or_recv_from = undefined, @@ -600,7 +583,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {passive, Buffer} -> next_record_if_active(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom), + deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker), {stop, normal, State0} end. @@ -655,8 +638,8 @@ decode_packet(Type, Buffer, PacketOpts) -> %% HTTP headers using the {packet, httph} option, we don't do any automatic %% switching of states. deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packet=Type}, - Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data)), + Data, Pid, From, Tracker) -> + send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data, Tracker)), SO = case Data of {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), ((Type =:= http) or (Type =:= http_bin)) -> @@ -676,20 +659,20 @@ deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packe end. format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, - header = Header}, Data) -> + header = Header}, Data, _) -> {ok, do_format_reply(Mode, Packet, Header, Data)}; format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, - header = Header}, Data) -> - {ssl, ssl_socket:socket(self(), Transport, Socket, ?MODULE), + header = Header}, Data, Tracker) -> + {ssl, ssl_socket:socket(self(), Transport, Socket, ?MODULE, Tracker), do_format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data)). +deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker) -> + send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data, Tracker)). -format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data) -> +format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; -format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data) -> - {ssl_error, ssl_socket:socket(self(), Transport, Socket, ?MODULE), +format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker) -> + {ssl_error, ssl_socket:socket(self(), Transport, Socket, ?MODULE, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -833,10 +816,10 @@ 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} = State) -> + role = Role, socket_options = Opts, tracker = Tracker} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), - alert_user(Transport, Socket, StateName, Opts, Pid, From, Alert, Role), + alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -864,30 +847,30 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName, {Record, State} = next_record(State0), next_state(StateName, StateName, Record, State). -alert_user(Transport, Socket, connection, Opts, Pid, From, Alert, Role) -> - alert_user(Transport,Socket, Opts#socket_options.active, Pid, From, Alert, Role); -alert_user(Transport, Socket,_, _, _, From, Alert, Role) -> - alert_user(Transport, Socket, From, Alert, Role). +alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role) -> + alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(Transport, Tracker, Socket,_, _, _, From, Alert, Role) -> + alert_user(Transport, Tracker, Socket, From, Alert, Role). -alert_user(Transport, Socket, From, Alert, Role) -> - alert_user(Transport, Socket, false, no_pid, From, Alert, Role). +alert_user(Transport, Tracker, Socket, From, Alert, Role) -> + alert_user(Transport, Tracker, Socket, false, no_pid, From, Alert, Role). -alert_user(_,_, false = Active, Pid, From, Alert, Role) -> +alert_user(_, _, _, false = Active, Pid, From, Alert, Role) -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Transport, Socket, Active, Pid, From, Alert, Role) -> +alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role) -> case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, {ssl_closed, ssl_socket:socket(self(), - Transport, Socket, ?MODULE)}); + Transport, Socket, ?MODULE, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, {ssl_error, ssl_socket:socket(self(), - Transport, Socket, ?MODULE), ReasonCode}) + Transport, Socket, ?MODULE, Tracker), ReasonCode}) end. log_alert(true, Info, Alert) -> @@ -920,15 +903,17 @@ handle_own_alert(Alert, Version, StateName, handle_normal_shutdown(Alert, _, #state{socket = Socket, transport_cb = Transport, start_or_recv_from = StartFrom, + tracker = Tracker, role = Role, renegotiation = {false, first}}) -> - alert_user(Transport, Socket, StartFrom, Alert, Role); + alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role); handle_normal_shutdown(Alert, StateName, #state{socket = Socket, socket_options = Opts, transport_cb = Transport, user_application = {_Mon, Pid}, + tracker = Tracker, start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(Transport, Socket, StateName, Opts, Pid, RecvFrom, Alert, 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), diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 067417d163..7a5f9c1b38 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -183,23 +183,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, -spec suites(1|2|3) -> [ssl_cipher:cipher_suite()]. -suites(Minor) when Minor == 1; Minor == 2-> - case sufficent_ec_support() of - true -> - all_suites(Minor); - false -> - no_ec_suites(Minor) - end; - -suites(Minor) when Minor == 3 -> - case sufficent_ec_support() of - true -> - all_suites(3) ++ all_suites(2); - false -> - no_ec_suites(3) ++ no_ec_suites(2) - end. - -all_suites(Minor) when Minor == 1; Minor == 2-> +suites(Minor) when Minor == 1; Minor == 2 -> [ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, @@ -235,7 +219,7 @@ all_suites(Minor) when Minor == 1; Minor == 2-> ?TLS_RSA_WITH_DES_CBC_SHA ]; -all_suites(3) -> +suites(3) -> [ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, @@ -254,33 +238,7 @@ all_suites(3) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 - ]. - -no_ec_suites(Minor) when Minor == 1; Minor == 2-> - [ - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, - ?TLS_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA - ]; -no_ec_suites(3) -> - [ - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, - ?TLS_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_WITH_AES_128_CBC_SHA256 - ]. + ] ++ suites(2). %%-------------------------------------------------------------------- %%% Internal functions @@ -442,7 +400,3 @@ enum_to_oid(27) -> ?brainpoolP384r1; enum_to_oid(28) -> ?brainpoolP512r1; enum_to_oid(_) -> undefined. - -sufficent_ec_support() -> - CryptoSupport = crypto:supports(), - proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)). diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index a1b766e05f..2f440f1f3c 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -122,8 +122,7 @@ options_tests() -> ]. api_tests() -> - [new_options_in_accept, - connection_info, + [connection_info, peername, peercert, peercert_with_client_cert, @@ -142,7 +141,8 @@ api_tests() -> ssl_recv_timeout, versions_option, server_name_indication_option, - accept_pool + accept_pool, + new_options_in_accept ]. session_tests() -> @@ -194,6 +194,7 @@ error_handling_tests()-> close_transport_accept, recv_active, recv_active_once, + recv_error_handling, dont_crash_on_handshake_garbage ]. @@ -345,14 +346,15 @@ new_options_in_accept() -> [{doc,"Test that you can set ssl options in ssl_accept/3 and not tcp upgrade"}]. new_options_in_accept(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts0 = ?config(server_dsa_opts, Config), + [_ , _ | ServerSslOpts] = ?config(server_opts, Config), %% Remove non ssl opts {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {ssl_opts, [{versions, [sslv3]}, - {ciphers,[{rsa,rc4_128,sha}]}]}, %% To be set in ssl_accept/3 + {ssl_extra_opts, [{versions, [sslv3]}, + {ciphers,[{rsa,rc4_128,sha}]} | ServerSslOpts]}, %% To be set in ssl_accept/3 {mfa, {?MODULE, connection_info_result, []}}, - {options, ServerOpts}]), + {options, proplists:delete(cacertfile, ServerOpts0)}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, @@ -1244,7 +1246,7 @@ dh_params(Config) when is_list(Config) -> {from, self()}, {mfa, {ssl_test_lib, send_recv_result_active, []}}, {options, - [{ciphers,[{dhe_rsa,aes_256_cbc,sha,ignore}]} | + [{ciphers,[{dhe_rsa,aes_256_cbc,sha}]} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1343,7 +1345,7 @@ tcp_connect() -> tcp_connect(Config) when is_list(Config) -> ServerOpts = ?config(server_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - TcpOpts = [binary, {reuseaddr, true}], + TcpOpts = [binary, {reuseaddr, true}, {active, false}], Server = ssl_test_lib:start_upgrade_server_error([{node, ServerNode}, {port, 0}, {from, self()}, @@ -3694,7 +3696,7 @@ run_suites(Ciphers, Version, Config, Type) -> Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, - Ciphers), + ssl_test_lib:filter_suites(Ciphers)), case lists:flatten(Result) of [] -> ok; diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 69b222fc43..150b5037d7 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -115,7 +115,7 @@ connect(#sslsocket{} = ListenSocket, Opts) -> Node = proplists:get_value(node, Opts), ReconnectTimes = proplists:get_value(reconnect_times, Opts, 0), Timeout = proplists:get_value(timeout, Opts, infinity), - SslOpts = proplists:get_value(ssl_opts, Opts, []), + SslOpts = proplists:get_value(ssl_extra_opts, Opts, []), AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts), case ReconnectTimes of 0 -> @@ -186,10 +186,7 @@ run_client(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), - ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]), -ct:log("~p:~p~nnet_adm:ping(~p)=~p",[?MODULE,?LINE, Node,net_adm:ping(Node)]), -%%ct:log("~p:~p~n~p:connect(~p, ~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Options, Node]), -ct:log("~p:~p~n~p:connect(~p, ~p, ...)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), + ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), case rpc:call(Node, Transport, connect, [Host, Port, Options]) of {ok, Socket} -> Pid ! {connected, Socket}, @@ -875,25 +872,34 @@ psk_suites() -> {psk, '3des_ede_cbc', sha}, {psk, aes_128_cbc, sha}, {psk, aes_256_cbc, sha}, + {psk, aes_128_cbc, sha256}, + {psk, aes_256_cbc, sha384}, {dhe_psk, rc4_128, sha}, {dhe_psk, '3des_ede_cbc', sha}, {dhe_psk, aes_128_cbc, sha}, {dhe_psk, aes_256_cbc, sha}, + {dhe_psk, aes_128_cbc, sha256}, + {dhe_psk, aes_256_cbc, sha384}, {rsa_psk, rc4_128, sha}, {rsa_psk, '3des_ede_cbc', sha}, {rsa_psk, aes_128_cbc, sha}, - {rsa_psk, aes_256_cbc, sha}], + {rsa_psk, aes_256_cbc, sha}, + {rsa_psk, aes_128_cbc, sha256}, + {rsa_psk, aes_256_cbc, sha384} +], ssl_cipher:filter_suites(Suites). psk_anon_suites() -> - [{psk, rc4_128, sha}, - {psk, '3des_ede_cbc', sha}, - {psk, aes_128_cbc, sha}, - {psk, aes_256_cbc, sha}, - {dhe_psk, rc4_128, sha}, - {dhe_psk, '3des_ede_cbc', sha}, - {dhe_psk, aes_128_cbc, sha}, - {dhe_psk, aes_256_cbc, sha}]. + Suites = + [{psk, rc4_128, sha}, + {psk, '3des_ede_cbc', sha}, + {psk, aes_128_cbc, sha}, + {psk, aes_256_cbc, sha}, + {dhe_psk, rc4_128, sha}, + {dhe_psk, '3des_ede_cbc', sha}, + {dhe_psk, aes_128_cbc, sha}, + {dhe_psk, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). srp_suites() -> Suites = @@ -906,9 +912,11 @@ srp_suites() -> ssl_cipher:filter_suites(Suites). srp_anon_suites() -> - [{srp_anon, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}]. + Suites = + [{srp_anon, '3des_ede_cbc', sha}, + {srp_anon, aes_128_cbc, sha}, + {srp_anon, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). srp_dss_suites() -> Suites = @@ -1118,3 +1126,13 @@ version_flag('tlsv1.2') -> " -tls1_2 "; version_flag(sslv3) -> " -ssl3 ". + +filter_suites(Ciphers0) -> + Version = tls_record:highest_protocol_version([]), + Supported0 = ssl_cipher:suites(Version) + ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:srp_suites(), + Supported1 = ssl_cipher:filter_suites(Supported0), + Supported2 = [ssl:suite_definition(S) || S <- Supported1], + [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index a7361755e5..d36e441c7a 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1341,7 +1341,7 @@ check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1'; {skip, "Known renegotiation bug in OpenSSL"}; "OpenSSL 1.0.1a" ++ _ -> {skip, "Known renegotiation bug in OpenSSL"}; - "OpenSSL 1.0.1" ++ _ -> + "OpenSSL 1.0.1 " ++ _ -> {skip, "Known renegotiation bug in OpenSSL"}; _ -> check_sane_openssl_renegotaite(Config) diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index e08f5dff78..004cacf7fc 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3.4 +SSL_VSN = 5.3.5 diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index 76137e3dee..b37f7fd7fd 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -108,6 +108,26 @@ </func> <func> + <name name="get" arity="3"/> + <fsummary></fsummary> + <desc> + <p> + Returns the value <c><anno>Value</anno></c> associated with <c><anno>Key</anno></c> if + <c><anno>Map</anno></c> contains <c><anno>Key</anno></c>. + If no value is associated with <c><anno>Key</anno></c> then returns <c><anno>Default</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{ key1 => val1, key2 => val2 }. +#{key1 => val1,key2 => val2} +> maps:get(key1, Map, "Default value"). +val1 +> maps:get(key3, Map, "Default value"). +"Default value"</code> + </desc> + </func> + + <func> <name name="is_key" arity="2"/> <fsummary></fsummary> <desc> diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index fd6d56fa47..4ef1638e6d 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -23,7 +23,8 @@ fold/3, map/2, size/1, - without/2 + without/2, + get/3 ]). @@ -142,6 +143,21 @@ values(_) -> erlang:nif_error(undef). %%% End of BIFs +-spec get(Key, Map, Default) -> Value | Default when + Key :: term(), + Map :: map(), + Value :: term(), + Default :: term(). + +get(Key, Map, Default) -> + case maps:find(Key, Map) of + {ok, Value} -> + Value; + error -> + Default + end. + + -spec fold(Fun,Init,Map) -> Acc when Fun :: fun((K, V, AccIn) -> AccOut), Init :: term(), diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 39f6ce423a..a271229c59 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -85,7 +85,8 @@ MODULES= \ zip_SUITE \ random_unicode_list \ random_iolist \ - error_logger_forwarder + error_logger_forwarder \ + maps_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl new file mode 100644 index 0000000000..c826ee731a --- /dev/null +++ b/lib/stdlib/test/maps_SUITE.erl @@ -0,0 +1,69 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%%---------------------------------------------------------------- +%%% Purpose: Test suite for the 'maps' module. +%%%----------------------------------------------------------------- + +-module(maps_SUITE). + +-include_lib("test_server/include/test_server.hrl"). + +% Default timetrap timeout (set in init_per_testcase). +% This should be set relatively high (10-15 times the expected +% max testcasetime). +-define(default_timeout, ?t:minutes(4)). + +% Test server specific exports +-export([all/0]). +-export([suite/0]). +-export([init_per_suite/1]). +-export([end_per_suite/1]). +-export([init_per_testcase/2]). +-export([end_per_testcase/2]). + +-export([get3/1]). + +suite() -> + [{ct_hooks, [ts_install_cth]}]. + +all() -> + [get3]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +get3(Config) when is_list(Config) -> + Map = #{ key1 => value1, key2 => value2 }, + DefaultValue = "Default value", + ?line value1 = maps:get(key1, Map, DefaultValue), + ?line value2 = maps:get(key2, Map, DefaultValue), + ?line DefaultValue = maps:get(key3, Map, DefaultValue), + ok. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index c9996c954e..46a5ca48df 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -2071,7 +2071,7 @@ map_field_assoc_value(Node) -> {map_field_assoc, _, _, Value} -> Value; _ -> - (data(Node))#map_field_assoc.name + (data(Node))#map_field_assoc.value end. @@ -2129,7 +2129,7 @@ map_field_exact_value(Node) -> {map_field_exact, _, _, Value} -> Value; _ -> - (data(Node))#map_field_exact.name + (data(Node))#map_field_exact.value end. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index d4c54a72aa..6fb3e5ccfb 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -24,12 +24,12 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([app_test/1,appup_test/1,smoke_test/1,revert/1]). +-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test,appup_test,smoke_test,revert]. + [app_test,appup_test,smoke_test,revert,revert_map]. groups() -> []. @@ -109,6 +109,16 @@ revert_file(File, Path) -> ok end. +%% Testing bug fix for reverting map_field_assoc +revert_map(Config) -> + Dog = ?t:timetrap(?t:minutes(1)), + ?line [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] = + erl_syntax:revert_forms([{tree,map_field_assoc, + {attr,16,[],none}, + {map_field_assoc, + {atom,17,name},{var,18,'Value'}}}]), + ?line ?t:timetrap_cancel(Dog). + p_run(Test, List) -> N = erlang:system_info(schedulers), p_run_loop(Test, List, N, [], 0). diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index ec5a1f4bc5..4e3c49c717 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -853,7 +853,6 @@ resulting regexp is surrounded by \\_< and \\_>." "append_element" "await_proc_exit" "await_sched_wall_time_modifications" - "bitstr_to_list" "bump_reductions" "call_on_load_function" "cancel_timer" @@ -899,7 +898,6 @@ resulting regexp is surrounded by \\_< and \\_>." "hibernate" "insert_element" "is_builtin" - "list_to_bitstr" "load_nif" "loaded" "localtime" diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 353275ae3b..6870aefe5c 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1098,7 +1098,6 @@ read_expected(Version) -> {POS1+1,{FF,{mod17,fun17,0}}}, {POS1+2,{FF,{erlang,spawn,1}}}, {POS1+2,{FF,{read,local,0}}}, - {POS1+3,{FF,{erlang,binary_to_term,1}}}, {POS1+3,{FF,{erlang,spawn,1}}}, {POS1+4,{FF,{dist,func,0}}}, {POS1+4,{FF,{erlang,spawn,1}}}, @@ -1207,6 +1206,7 @@ read_expected(Version) -> OKB1 = [{POS13+1,{FF,{erts_debug,apply,4}}}, {POS13+2,{FF,{erts_debug,apply,4}}}, {POS13+3,{FF,{erts_debug,apply,4}}}, + {POS1+3, {FF,{erlang,binary_to_term,1}}}, {POS3+1, {FF,{erlang,spawn,3}}}, {POS3+2, {FF,{erlang,spawn,3}}}, {POS3+3, {FF,{erlang,spawn_link,3}}}, diff --git a/otp_versions.table b/otp_versions.table index a8a40df85a..1120add531 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,2 +1,3 @@ +OTP-17.0.2 : inets-5.10.1 ssh-3.0.2 # asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 erts-6.0.1 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 typer-0.9.7 webtool-0.8.10 wx-1.2 xmerl-1.3.7 : OTP-17.0.1 : erts-6.0.1 typer-0.9.7 # asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 inets-5.10 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 webtool-0.8.10 wx-1.2 xmerl-1.3.7 : OTP-17.0 : asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 erts-6.0 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 inets-5.10 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 typer-0.9.6 webtool-0.8.10 wx-1.2 xmerl-1.3.7 # : diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 37208710fe..0ca425da86 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -792,6 +792,244 @@ Expr1 -- Expr2</pre> </section> <section> + <title>Map Expressions</title> + <section> + <title>Creating Maps</title> + <p> + Constructing a new map is done by letting an expression <c>K</c> be associated with + another expression <c>V</c>: + </p> + <code>#{ K => V }</code> + <p> + New maps may include multiple associations at construction by listing every + association: + </p> + <code>#{ K1 => V1, .., Kn => Vn }</code> + <p> + An empty map is constructed by not associating any terms with each other: + </p> + <code>#{}</code> + <p> + All keys and values in the map are terms. Any expression is first evaluated and + then the resulting terms are used as <em>key</em> and <em>value</em> respectively. + </p> + <p> + Keys and values are separated by the <c>=></c> arrow and associations are + separated by <c>,</c>. + </p> + + <p> + Examples: + </p> + <code> +M0 = #{}, % empty map +M1 = #{a => <<"hello">>}, % single association with literals +M2 = #{1 => 2, b => b}, % multiple associations with literals +M3 = #{k => {A,B}}, % single association with variables +M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code> + <p> + where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c> + are the resulting map terms. + </p> + <p> + If two matching keys are declared, the latter key will take precedence. + </p> + <p> + Example: + </p> + +<pre> +1> <input>#{1 => a, 1 => b}.</input> +#{1 => b } +2> <input>#{1.0 => a, 1 => b}.</input> +#{1 => b, 1.0 => a} +</pre> + <p> + The order in which the expressions constructing the keys and their + associated values are evaluated is not defined. The syntactic order of + the key-value pairs in the construction is of no relevance, except in + the above mentioned case of two matching keys. + </p> + </section> + + <section> + <title>Updating Maps</title> + <p> + Updating a map has similar syntax as constructing it. + </p> + <p> + An expression defining the map to be updated is put in front of the expression + defining the keys to be updated and their respective values. + </p> + <code>M#{ K => V }</code> + <p> + where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression. + </p> + <p> + If key <c>K</c> does not match any existing key in the map, a new association + will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches + an existing key in map <c>M</c> its associated value will be replaced by the + new value <c>V</c>. In both cases the evaluated map expression will return a new map. + </p> + <p> + If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. + </p> + <p> + To only update an existing value, the following syntax is used, + </p> + <code>M#{ K := V } </code> + <p> + where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c> + is an expression which evaluates to an existing key in <c>M</c>. + </p> + <p> + If key <c>K</c> does not match any existing keys in map <c>M</c> an exception + of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c> + is present in map <c>M</c> its associated value will be replaced by the new + value <c>V</c> and the evaluated map expression returns a new map. + </p> + <p> + If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. + </p> + <p> + Examples: + </p> + <code> +M0 = #{}, +M1 = M0#{a => 0}, +M2 = M1#{a => 1, b => 2}, +M3 = M2#{"function" => fun() -> f() end}, +M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code> + <p> + where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well. + </p> + <p> + More Examples: + </p> +<pre> +1> <input>M = #{1 => a}.</input> +#{1 => a } +2> <input>M#{1.0 => b}.</input> +#{1 => a, 1.0 => b}. +3> <input>M#{1 := b}.</input> +#{1 => b} +4> <input>M#{1.0 := b}.</input> +** exception error: bad argument +</pre> + <p> + As in construction, the order in which the key and value expressions + are evaluated is not defined. The + syntactic order of the key-value pairs in the update is of no + relevance, except in the case where two keys match, in which + case the latter value is used. + </p> + </section> + + <section> + <title>Maps in Patterns</title> + <p> + Matching of key-value associations from maps is done in the following way: + </p> + + <code>#{ K := V } = M</code> + <p> + where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound + variables or a literals, and <c>V</c> can be any pattern with either bound or + unbound variables. + </p> + <p> + If the variable <c>V</c> is unbound, it will be bound to the value associated + with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable + <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>. + </p> + <p> Example: </p> +<code> +1> <input>M = #{"tuple" => {1,2}}.</input> +#{"tuple" => {1,2}} +2> <input>#{"tuple" := {1,B}} = M.</input> +#{"tuple" => {1,2}} +3> <input>B.</input> +2.</code> + <p> + This will bind variable <c>B</c> to integer <c>2</c>. + </p> + <p> + Similarly, multiple values from the map may be matched: + </p> + <code>#{ K1 := V1, .., Kn := Vn } = M</code> + <p> + where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all + keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the + associated values of their respective keys. + </p> + <p> + If the matching conditions are not met, the match will fail, either with + </p> + <list> + <item> + a <c>badmatch</c> exception, if used in the context of the matching operator + as in the example, + </item> + <item> + or resulting in the next clause being tested in function heads and + case expressions. + </item> + </list> + <p> + Matching in maps only allows for <c>:=</c> as delimiters of associations. + The order in which keys are declared in matching has no relevance. + </p> + <p> + Duplicate keys are allowed in matching and will match each pattern associated + to the keys. + </p> + <code>#{ K := V1, K := V2 } = M</code> + <p> + Matching an expression against an empty map literal will match its type but + no variables will be bound: + </p> + <code>#{} = Expr</code> + <p> + This expression will match if the expression <c>Expr</c> is of type map, otherwise + it will fail with an exception <c>badmatch</c>. + </p> + <section> + <title>Matching syntax: Example with literals in function heads</title> + <p> + Matching of literals as keys are allowed in function heads. + </p> + <code> +%% only start if not_started +handle_call(start, From, #{ state := not_started } = S) -> +... + {reply, ok, S#{ state := start }}; + +%% only change if started +handle_call(change, From, #{ state := start } = S) -> +... + {reply, ok, S#{ state := changed }};</code> + </section> + </section> + <section> + <title>Maps in Guards</title> + <p> + Maps are allowed in guards as long as all sub-expressions are valid guard expressions. + </p> + <p> + Two guard BIFs handles maps: + </p> + <list> + <item> + <seealso marker="erts:erlang#is_map/1">is_map/1</seealso> + </item> + <item> + <seealso marker="erts:erlang#map_size/1">map_size/1</seealso> + </item> + </list> + </section> + </section> + + <section> <marker id="bit_syntax"></marker> <title>Bit Syntax Expressions</title> <code type="none"><![CDATA[<<>> diff --git a/system/doc/reference_manual/maps.xml b/system/doc/reference_manual/maps.xml deleted file mode 100644 index 78808ce4a2..0000000000 --- a/system/doc/reference_manual/maps.xml +++ /dev/null @@ -1,274 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2014</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. - </legalnotice> - - <title>Maps</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>maps.xml</file> - </header> - - <note> - <p>Maps are considered experimental during OTP 17 and may be subject to change.</p> - <p>The documentation below describes it being possible to use arbitrary - expressions or variables as keys, this is <em>NOT</em> implemented in the current - version of Erlang/OTP.</p> - <p>Exceptions returns <c>badarg</c> instead of <c>badmap</c>, this will change in - the future releases.</p> - </note> - - <section> - <title>Creating Maps</title> - <p> - Constructing a new map is done by letting an expression <c>K</c> be associated with - another expression <c>V</c>: - </p> - <code>#{ K => V }</code> - <p> - New maps may include multiple associations at construction by listing every - association: - </p> - <code>#{ K1 => V1, .., Kn => Vn }</code> - <p> - An empty map is constructed by not associating any terms with each other: - </p> - <code>#{}</code> - <p> - All keys and values in the map are terms. Any expression is first evaluated and - then the resulting terms are used as <em>key</em> and <em>value</em> respectively. - </p> - <p> - Keys and values are separated by the <c>=></c> arrow and associations are - separated by <c>,</c>. - </p> - - <p> - Examples: - </p> - <code> -M0 = #{}, % empty map -M1 = #{a => <<"hello">>}, % single association with literals -M2 = #{1 => 2, b => b}, % multiple associations with literals -M3 = #{k => {A,B}}, % single association with variables -M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code> - <p> - where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c> - are the resulting map terms. - </p> - <p> - If two matching keys are declared, the latter key will take precedence. - </p> - <p> - Example: - </p> - -<pre> -1> <input>#{1 => a, 1 => b}.</input> -#{1 => b } -2> <input>#{1.0 => a, 1 => b}.</input> -#{1 => b, 1.0 => a} -</pre> - <p> - The order in which the expressions constructing the keys and their - associated values are evaluated is not defined. The syntactic order of - the key-value pairs in the construction is of no relevance, except in - the above mentioned case of two matching keys. - </p> - </section> - - <section> - <title>Updating Maps</title> - <p> - Updating a map has similar syntax as constructing it. - </p> - <p> - An expression defining the map to be updated is put in front of the expression - defining the keys to be updated and their respective values. - </p> - <code>M#{ K => V }</code> - <p> - where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression. - </p> - <p> - If key <c>K</c> does not match any existing key in the map, a new association - will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches - an existing key in map <c>M</c> its associated value will be replaced by the - new value <c>V</c>. In both cases the evaluated map expression will return a new map. - </p> - <p> - If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. - </p> - <p> - To only update an existing value, the following syntax is used, - </p> - <code>M#{ K := V } </code> - <p> - where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c> - is an expression which evaluates to an existing key in <c>M</c>. - </p> - <p> - If key <c>K</c> does not match any existing keys in map <c>M</c> an exception - of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c> - is present in map <c>M</c> its associated value will be replaced by the new - value <c>V</c> and the evaluated map expression returns a new map. - </p> - <p> - If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. - </p> - <p> - Examples: - </p> - <code> -M0 = #{}, -M1 = M0#{a => 0}, -M2 = M1#{a => 1, b => 2}, -M3 = M2#{"function" => fun() -> f() end}, -M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code> - <p> - where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well. - </p> - <p> - More Examples: - </p> -<pre> -1> <input>M = #{1 => a}.</input> -#{1 => a } -2> <input>M#{1.0 => b}.</input> -#{1 => a, 1.0 => b}. -3> <input>M#{1 := b}.</input> -#{1 => b} -4> <input>M#{1.0 := b}.</input> -** exception error: bad argument -</pre> - <p> - As in construction, the order in which the key and value expressions - are evaluated is not defined. The - syntactic order of the key-value pairs in the update is of no - relevance, except in the case where two keys match, in which - case the latter value is used. - </p> - </section> - - <section> - <title>Maps in Patterns</title> - <p> - Matching of key-value associations from maps is done in the following way: - </p> - - <code>#{ K := V } = M</code> - <p> - where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound - variables or a literals, and <c>V</c> can be any pattern with either bound or - unbound variables. - </p> - <p> - If the variable <c>V</c> is unbound, it will be bound to the value associated - with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable - <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>. - </p> - <p> Example: </p> -<code> -1> <input>M = #{"tuple" => {1,2}}.</input> -#{"tuple" => {1,2}} -2> <input>#{"tuple" := {1,B}} = M.</input> -#{"tuple" => {1,2}} -3> <input>B.</input> -2.</code> - <p> - This will bind variable <c>B</c> to integer <c>2</c>. - </p> - <p> - Similarly, multiple values from the map may be matched: - </p> - <code>#{ K1 := V1, .., Kn := Vn } = M</code> - <p> - where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all - keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the - associated values of their respective keys. - </p> - <p> - If the matching conditions are not met, the match will fail, either with - </p> - <list> - <item> - a <c>badmatch</c> exception, if used in the context of the matching operator - as in the example, - </item> - <item> - or resulting in the next clause being tested in function heads and - case expressions. - </item> - </list> - <p> - Matching in maps only allows for <c>:=</c> as delimiters of associations. - The order in which keys are declared in matching has no relevance. - </p> - <p> - Duplicate keys are allowed in matching and will match each pattern associated - to the keys. - </p> - <code>#{ K := V1, K := V2 } = M</code> - <p> - Matching an expression against an empty map literal will match its type but - no variables will be bound: - </p> - <code>#{} = Expr</code> - <p> - This expression will match if the expression <c>Expr</c> is of type map, otherwise - it will fail with an exception <c>badmatch</c>. - </p> - <section> - <title>Matching syntax: Example with literals in function heads</title> - <p> - Matching of literals as keys are allowed in function heads. - </p> - <code> -%% only start if not_started -handle_call(start, From, #{ state := not_started } = S) -> -... - {reply, ok, S#{ state := start }}; - -%% only change if started -handle_call(change, From, #{ state := start } = S) -> -... - {reply, ok, S#{ state := changed }};</code> - </section> - </section> - <section> - <title>Maps in Guards</title> - <p> - Maps are allowed in guards as long as all sub-expressions are valid guard expressions. - </p> - <p> - Two guard BIFs handles maps: - </p> - <list> - <item> - <seealso marker="erts:erlang#is_map/1">is_map/1</seealso> - </item> - <item> - <seealso marker="erts:erlang#map_size/1">map_size/1</seealso> - </item> - </list> - </section> -</chapter> diff --git a/system/doc/reference_manual/part.xml b/system/doc/reference_manual/part.xml index 36fb888748..ee8f3dd7eb 100644 --- a/system/doc/reference_manual/part.xml +++ b/system/doc/reference_manual/part.xml @@ -36,7 +36,6 @@ <xi:include href="typespec.xml"/> <xi:include href="expressions.xml"/> <xi:include href="macros.xml"/> - <xi:include href="maps.xml"/> <xi:include href="records.xml"/> <xi:include href="errors.xml"/> <xi:include href="processes.xml"/> diff --git a/system/doc/reference_manual/xmlfiles.mk b/system/doc/reference_manual/xmlfiles.mk index 181e6f8042..6886c8c7cf 100644 --- a/system/doc/reference_manual/xmlfiles.mk +++ b/system/doc/reference_manual/xmlfiles.mk @@ -24,7 +24,6 @@ REF_MAN_CHAPTER_FILES = \ functions.xml \ expressions.xml \ macros.xml \ - maps.xml \ records.xml \ errors.xml \ processes.xml \ |