diff options
96 files changed, 4111 insertions, 2666 deletions
diff --git a/erts/doc/src/alt_dist.xml b/erts/doc/src/alt_dist.xml index e6245130fc..7c997cae20 100644 --- a/erts/doc/src/alt_dist.xml +++ b/erts/doc/src/alt_dist.xml @@ -60,7 +60,7 @@ parts of the logic in Erlang code, and you perhaps do not even need a new driver for the protocol. One example could be Erlang distribution over UDP using <c>gen_udp</c> (your - Erlang code will of course have to take care of retranspissions, + Erlang code will of course have to take care of retransmissions, etc in this example). That is, depending on what you want to do you perhaps do not need to implement a driver at all and can then skip the driver related sections below. diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 7faba35e1c..c102ddbee6 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -5165,6 +5165,12 @@ erts_schedule_bif(Process *proc, pc = i; mfa = &exp->info.mfa; } + else if (BeamIsOpCode(*i, op_call_bif_only_e)) { + /* Pointer to bif export in i+1 */ + exp = (Export *) i[1]; + pc = i; + mfa = &exp->info.mfa; + } else if (BeamIsOpCode(*i, op_apply_bif)) { /* Pointer to bif in i+1, and mfa in i-3 */ pc = c_p->cp; diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab index 8499f61114..8e0caa38a3 100644 --- a/erts/emulator/beam/bif_instrs.tab +++ b/erts/emulator/beam/bif_instrs.tab @@ -209,8 +209,8 @@ i_length.execute(Fail, Live, Dst) { } // -// The most general BIF call. The BIF may build any amount of data -// on the heap. The result is always returned in r(0). +// Call a BIF, store the result in x(0) and transfer control to the +// next instruction. // call_bif(Exp) { ErtsBifFunc bf; @@ -219,8 +219,10 @@ call_bif(Exp) { Export *export = (Export*) $Exp; if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ + /* + * If we have run out of reductions, do a context + * switch before calling the BIF. + */ c_p->arity = GET_BIF_ARITY(export); c_p->current = &export->info.mfa; goto context_switch3; @@ -257,9 +259,12 @@ call_bif(Exp) { HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; ERTS_DBG_CHK_REDS(c_p, FCALLS); - /* We have to update the cache if we are enabled in order - to make sure no book keeping is done after we disabled - msacc. We don't always do this as it is quite expensive. */ + + /* + * We have to update the cache if we are enabled in order + * to make sure no bookkeeping is done after we disabled + * msacc. We don't always do this as it is quite expensive. + */ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { ERTS_MSACC_UPDATE_CACHE_X(); } @@ -269,6 +274,12 @@ call_bif(Exp) { CHECK_TERM(r(0)); $NEXT0(); } else if (c_p->freason == TRAP) { + /* + * Set the continuation pointer to return to next + * instruction after the trap (either by a return from + * erlang code or by nif_bif.epilogue() when the BIF + * is done). + */ SET_CP(c_p, $NEXT_INSTRUCTION); SET_I(c_p->i); SWAPIN; @@ -281,6 +292,95 @@ call_bif(Exp) { ASSERT(c_p->stop == E); I = handle_error(c_p, I, reg, &export->info.mfa); goto post_error_handling; + //| -no_next +} + +// +// Call a BIF tail-recursively, storing the result in x(0) and doing +// a return to the continuation poiner (c_p->cp). +// + +call_bif_only(Exp) { + ErtsBifFunc bf; + Eterm result; + ErlHeapFragment *live_hf_end; + Export *export = (Export*) $Exp; + + if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) { + /* + * If we have run out of reductions, do a context + * switch before calling the BIF. + */ + c_p->arity = GET_BIF_ARITY(export); + c_p->current = &export->info.mfa; + goto context_switch3; + } + + ERTS_MSACC_SET_BIF_STATE_CACHED_X(GET_BIF_MODULE(export), + GET_BIF_ADDRESS(export)); + + bf = GET_BIF_ADDRESS(export); + + PRE_BIF_SWAPOUT(c_p); + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, export); + } + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + result = (*bf)(c_p, reg, I); + ERTS_CHK_MBUF_SZ(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_HOLE_CHECK(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + if (ERTS_IS_GC_DESIRED(c_p)) { + Uint arity = GET_BIF_ARITY(export); + result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, + reg, arity); + E = c_p->stop; + } + PROCESS_MAIN_CHK_LOCKS(c_p); + HTOP = HEAP_TOP(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + + /* + * We have to update the cache if we are enabled in order + * to make sure no bookkeeping is done after we disabled + * msacc. We don't always do this as it is quite expensive. + */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + ERTS_MSACC_UPDATE_CACHE_X(); + } + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + if (ERTS_LIKELY(is_value(result))) { + /* + * Success. Store the result and return to the caller. + */ + r(0) = result; + CHECK_TERM(r(0)); + $return(); + } else if (c_p->freason == TRAP) { + /* + * Dispatch to a trap. When the trap is done, a jump + * to the continuation pointer (c_p->cp) will be done. + */ + SET_I(c_p->i); + SWAPIN; + Dispatch(); + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + I = handle_error(c_p, I, reg, &export->info.mfa); + goto post_error_handling; + //| -no_next } // diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 4132a54934..0a50af4d1a 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -81,14 +81,6 @@ static BIF_RETTYPE db_bif_fail(Process* p, Uint freason, /* Get a key from any table structure and a tagged object */ #define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj)) - -/* How safe are we from double-hits or missed objects -** when iterating without fixation? */ -enum DbIterSafety { - ITER_UNSAFE, /* Must fixate to be safe */ - ITER_SAFE_LOCKED, /* Safe while table is locked, not between trap calls */ - ITER_SAFE /* No need to fixate at all */ -}; # define ITERATION_SAFETY(Proc,Tab) \ ((IS_TREE_TABLE((Tab)->common.status) || IS_CATREE_TABLE((Tab)->common.status) \ || ONLY_WRITER(Proc,Tab)) ? ITER_SAFE \ @@ -195,9 +187,6 @@ static int fixed_tabs_find(DbFixation* first, DbFixation* fix) #define ERTS_RBT_WANT_DELETE #define ERTS_RBT_WANT_FOREACH #define ERTS_RBT_WANT_FOREACH_DESTROY -#ifdef DEBUG -# define ERTS_RBT_WANT_LOOKUP -#endif #define ERTS_RBT_UNDEF #include "erl_rbtree.h" @@ -2287,6 +2276,7 @@ static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1) Eterm ret; Eterm *tptr; db_lock_kind_t kind = LCK_WRITE_REC; + enum DbIterSafety safety = ITER_SAFE; CHECK_TABLES(); ASSERT(is_tuple(a1)); @@ -2296,10 +2286,11 @@ static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1) DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind, &ets_select_delete_continue_exp); - cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret); + cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret,&safety); - if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { - unfix_table_locked(p, tb, &kind); + if(!DID_TRAP(p,ret) && safety != ITER_SAFE) { + ASSERT(erts_refc_read(&tb->common.fix_count,1)); + unfix_table_locked(p, tb, &kind); } db_unlock(tb, kind); @@ -2337,7 +2328,8 @@ BIF_RETTYPE ets_internal_select_delete_2(BIF_ALIST_2) if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret); + cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, + &ret, safety); if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { fix_table_locked(BIF_P,tb); @@ -2729,7 +2721,7 @@ ets_select3(Process* p, DbTable* tb, Eterm tid, Eterm ms, Sint chunk_size) cret = tb->common.meth->db_select_chunk(p, tb, tid, ms, chunk_size, 0 /* not reversed */, - &ret); + &ret, safety); if (DID_TRAP(p,ret) && safety != ITER_SAFE) { fix_table_locked(p, tb); } @@ -2756,7 +2748,8 @@ ets_select3(Process* p, DbTable* tb, Eterm tid, Eterm ms, Sint chunk_size) } -/* We get here instead of in the real BIF when trapping */ +/* Trap here from: ets_select_1/2/3 + */ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) { Process *p = BIF_P; @@ -2767,6 +2760,7 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) Eterm ret; Eterm *tptr; db_lock_kind_t kind = LCK_READ; + enum DbIterSafety safety = ITER_SAFE; CHECK_TABLES(); @@ -2776,11 +2770,13 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind, &ets_select_continue_exp); - cret = tb->common.meth->db_select_continue(p, tb, a1, - &ret); + cret = tb->common.meth->db_select_continue(p, tb, a1, &ret, &safety); - if (!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { - unfix_table_locked(p, tb, &kind); + if (!DID_TRAP(p,ret)) { + if (safety != ITER_SAFE) { + ASSERT(erts_refc_read(&tb->common.fix_count,1)); + unfix_table_locked(p, tb, &kind); + } } db_unlock(tb, kind); @@ -2805,8 +2801,12 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) BIF_RETTYPE ets_select_1(BIF_ALIST_1) { return ets_select1(BIF_P, BIF_ets_select_1, BIF_ARG_1); + /* TRAP: ets_select_trap_1 */ } +/* + * Common impl for select/1, select_reverse/1, match/1 and match_object/1 + */ static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1) { BIF_RETTYPE result; @@ -2814,7 +2814,7 @@ static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1) int cret; Eterm ret; Eterm *tptr; - enum DbIterSafety safety; + enum DbIterSafety safety, safety_copy; CHECK_TABLES(); @@ -2839,7 +2839,8 @@ static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1) local_fix_table(tb); } - cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret); + safety_copy = safety; + cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret, &safety_copy); if (DID_TRAP(p,ret) && safety != ITER_SAFE) { fix_table_locked(p, tb); @@ -2871,6 +2872,7 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2) DbTable* tb; DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_2); return ets_select2(BIF_P, tb, BIF_ARG_1, BIF_ARG_2); + /* TRAP: ets_select_trap_1 */ } static BIF_RETTYPE @@ -2888,7 +2890,7 @@ ets_select2(Process* p, DbTable* tb, Eterm tid, Eterm ms) local_fix_table(tb); } - cret = tb->common.meth->db_select(p, tb, tid, ms, 0, &ret); + cret = tb->common.meth->db_select(p, tb, tid, ms, 0, &ret, safety); if (DID_TRAP(p,ret) && safety != ITER_SAFE) { fix_table_locked(p, tb); @@ -2926,6 +2928,7 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1) Eterm ret; Eterm *tptr; db_lock_kind_t kind = LCK_READ; + enum DbIterSafety safety = ITER_SAFE; CHECK_TABLES(); @@ -2935,9 +2938,10 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1) DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind, &ets_select_count_continue_exp); - cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret); + cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret, &safety); - if (!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { + if (!DID_TRAP(p,ret) && safety != ITER_SAFE) { + ASSERT(erts_refc_read(&tb->common.fix_count,1)); unfix_table_locked(p, tb, &kind); } db_unlock(tb, kind); @@ -2975,7 +2979,8 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2) if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_count(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, &ret); + cret = tb->common.meth->db_select_count(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, + &ret, safety); if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { fix_table_locked(BIF_P, tb); @@ -3014,6 +3019,7 @@ static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1) Eterm ret; Eterm *tptr; db_lock_kind_t kind = LCK_WRITE_REC; + enum DbIterSafety safety = ITER_SAFE; CHECK_TABLES(); ASSERT(is_tuple(a1)); @@ -3023,9 +3029,10 @@ static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1) DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind, &ets_select_replace_continue_exp); - cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret); + cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret,&safety); - if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { + if(!DID_TRAP(p,ret) && safety != ITER_SAFE) { + ASSERT(erts_refc_read(&tb->common.fix_count,1)); unfix_table_locked(p, tb, &kind); } @@ -3068,7 +3075,8 @@ BIF_RETTYPE ets_select_replace_2(BIF_ALIST_2) if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_replace(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret); + cret = tb->common.meth->db_select_replace(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, + &ret, safety); if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { fix_table_locked(BIF_P,tb); @@ -3120,7 +3128,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) } cret = tb->common.meth->db_select_chunk(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, chunk_size, - 1 /* reversed */, &ret); + 1 /* reversed */, &ret, safety); if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { fix_table_locked(BIF_P, tb); } @@ -3165,7 +3173,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) local_fix_table(tb); } cret = tb->common.meth->db_select(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, - 1 /*reversed*/, &ret); + 1 /*reversed*/, &ret, safety); if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { fix_table_locked(BIF_P, tb); diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c index 75ac1c4a93..0402c6b7b4 100644 --- a/erts/emulator/beam/erl_db_catree.c +++ b/erts/emulator/beam/erl_db_catree.c @@ -116,24 +116,31 @@ static int db_erase_object_catree(DbTable *tbl, Eterm object,Eterm *ret); static int db_slot_catree(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret); static int db_select_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, int reversed, Eterm *ret); + Eterm pattern, int reversed, Eterm *ret, + enum DbIterSafety); static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, enum DbIterSafety); static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, - int reversed, Eterm *ret); + int reversed, Eterm *ret, enum DbIterSafety); static int db_select_continue_catree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_count_continue_catree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, + enum DbIterSafety); static int db_select_delete_continue_catree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, + enum DbIterSafety); static int db_select_replace_continue_catree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_take_catree(Process *, DbTable *, Eterm, Eterm *); static void db_print_catree(fmtfn_t to, void *to_arg, int show, DbTable *tbl); @@ -1843,7 +1850,8 @@ static int db_slot_catree(Process *p, DbTable *tbl, static int db_select_continue_catree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { int result; CATreeRootIterator iter; @@ -1856,7 +1864,8 @@ static int db_select_continue_catree(Process *p, } static int db_select_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, int reverse, Eterm *ret) + Eterm pattern, int reverse, Eterm *ret, + enum DbIterSafety safety) { int result; CATreeRootIterator iter; @@ -1871,7 +1880,8 @@ static int db_select_catree(Process *p, DbTable *tbl, Eterm tid, static int db_select_count_continue_catree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { int result; CATreeRootIterator iter; @@ -1885,7 +1895,8 @@ static int db_select_count_continue_catree(Process *p, } static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { int result; CATreeRootIterator iter; @@ -1899,7 +1910,8 @@ static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid, static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, - int reversed, Eterm *ret) + int reversed, Eterm *ret, + enum DbIterSafety safety) { int result; CATreeRootIterator iter; @@ -1915,7 +1927,8 @@ static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid, static int db_select_delete_continue_catree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { DbTreeStack stack; TreeDbTerm * stack_array[STACK_NEED]; @@ -1931,7 +1944,8 @@ static int db_select_delete_continue_catree(Process *p, } static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { DbTreeStack stack; TreeDbTerm * stack_array[STACK_NEED]; @@ -1948,7 +1962,8 @@ static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid, } static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety_p) { int result; CATreeRootIterator iter; @@ -1961,7 +1976,8 @@ static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid, } static int db_select_replace_continue_catree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret) + Eterm continuation, Eterm *ret, + enum DbIterSafety* safety_p) { int result; CATreeRootIterator iter; diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 426c7d2d48..f225730029 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -404,26 +404,31 @@ static int db_slot_hash(Process *p, DbTable *tbl, static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, - int reverse, Eterm *ret); + int reverse, Eterm *ret, enum DbIterSafety); static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, int reverse, Eterm *ret); + Eterm pattern, int reverse, Eterm *ret, + enum DbIterSafety); static int db_select_continue_hash(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, enum DbIterSafety); static int db_select_count_continue_hash(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); - + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, + enum DbIterSafety); static int db_select_delete_continue_hash(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, enum DbIterSafety); static int db_select_replace_continue_hash(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_take_hash(Process *, DbTable *, Eterm, Eterm *); static void db_print_hash(fmtfn_t to, @@ -535,7 +540,7 @@ DbTableMethod db_hash = db_select_chunk_hash, db_select_hash, db_select_delete_hash, - db_select_continue_hash, /* hmm continue_hash? */ + db_select_continue_hash, db_select_delete_continue_hash, db_select_count_hash, db_select_count_continue_hash, @@ -1154,8 +1159,9 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret) * Match traversal callbacks */ -typedef struct match_callbacks_t_ match_callbacks_t; -struct match_callbacks_t_ + +typedef struct traverse_context_t_ traverse_context_t; +struct traverse_context_t_ { /* Called when no match is possible. * context_ptr: Pointer to context @@ -1163,7 +1169,7 @@ struct match_callbacks_t_ * * Both the direct return value and 'ret' are used as the traversal function return values. */ - int (*on_nothing_can_match)(match_callbacks_t* ctx, Eterm* ret); + int (*on_nothing_can_match)(traverse_context_t* ctx, Eterm* ret); /* Called for each match result. * context_ptr: Pointer to context @@ -1174,7 +1180,7 @@ struct match_callbacks_t_ * * Should return 1 for successful match, 0 otherwise. */ - int (*on_match_res)(match_callbacks_t* ctx, Sint slot_ix, + int (*on_match_res)(traverse_context_t* ctx, Sint slot_ix, HashDbTerm*** current_ptr_ptr, Eterm match_res); /* Called when either we've matched enough elements in this cycle or EOT was reached. @@ -1188,7 +1194,7 @@ struct match_callbacks_t_ * Both the direct return value and 'ret' are used as the traversal function return values. * If *mpp is set to NULL, it won't be deallocated (useful for trapping.) */ - int (*on_loop_ended)(match_callbacks_t* ctx, Sint slot_ix, Sint got, + int (*on_loop_ended)(traverse_context_t* ctx, Sint slot_ix, Sint got, Sint iterations_left, Binary** mpp, Eterm* ret); /* Called when it's time to trap @@ -1201,16 +1207,21 @@ struct match_callbacks_t_ * Both the direct return value and 'ret' are used as the traversal function return values. * If *mpp is set to NULL, it won't be deallocated (useful for trapping.) */ - int (*on_trap)(match_callbacks_t* ctx, Sint slot_ix, Sint got, Binary** mpp, + int (*on_trap)(traverse_context_t* ctx, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret); + Process* p; + DbTableHash* tb; + Eterm tid; + Eterm* prev_continuation_tptr; + enum DbIterSafety safety; }; /* * Begin hash table match traversal */ -static int match_traverse(Process* p, DbTableHash* tb, +static int match_traverse(traverse_context_t* ctx, Eterm pattern, extra_match_validator_t extra_match_validator, /* Optional */ Sint chunk_size, /* If 0, no chunking */ @@ -1218,9 +1229,9 @@ static int match_traverse(Process* p, DbTableHash* tb, Eterm** hpp, /* Heap */ int lock_for_write, /* Set to 1 if we're going to delete or modify existing terms */ - match_callbacks_t* ctx, Eterm* ret) { + DbTableHash* tb = ctx->tb; Sint slot_ix; /* Slot index */ HashDbTerm** current_ptr; /* Refers to either the bucket pointer or * the 'next' pointer in the previous term @@ -1287,7 +1298,7 @@ static int match_traverse(Process* p, DbTableHash* tb, for(;;) { if (*current_ptr != NULL) { if (!is_pseudo_deleted(*current_ptr)) { - match_res = db_match_dbterm(&tb->common, p, mpi.mp, + match_res = db_match_dbterm(&tb->common, ctx->p, mpi.mp, &(*current_ptr)->dbterm, hpp, 2); saved_current = *current_ptr; if (ctx->on_match_res(ctx, slot_ix, ¤t_ptr, match_res)) { @@ -1352,7 +1363,7 @@ done: /* * Continue hash table match traversal */ -static int match_traverse_continue(Process* p, DbTableHash* tb, +static int match_traverse_continue(traverse_context_t* ctx, Sint chunk_size, /* If 0, no chunking */ Sint iterations_left, /* Nr. of iterations left */ Eterm** hpp, /* Heap */ @@ -1361,9 +1372,9 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, Binary** mpp, /* Existing match program */ int lock_for_write, /* Set to 1 if we're going to delete or modify existing terms */ - match_callbacks_t* ctx, Eterm* ret) { + DbTableHash* tb = ctx->tb; HashDbTerm** current_ptr; /* Refers to either the bucket pointer or * the 'next' pointer in the previous term */ @@ -1406,7 +1417,7 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, for(;;) { if (*current_ptr != NULL) { if (!is_pseudo_deleted(*current_ptr)) { - match_res = db_match_dbterm(&tb->common, p, *mpp, + match_res = db_match_dbterm(&tb->common, ctx->p, *mpp, &(*current_ptr)->dbterm, hpp, 2); saved_current = *current_ptr; if (ctx->on_match_res(ctx, slot_ix, ¤t_ptr, match_res)) { @@ -1456,52 +1467,50 @@ done: */ static ERTS_INLINE int on_simple_trap(Export* trap_function, - Process* p, - DbTableHash* tb, - Eterm tid, - Eterm* prev_continuation_tptr, - Sint slot_ix, - Sint got, - Binary** mpp, - Eterm* ret) + traverse_context_t* ctx, + Sint slot_ix, + Sint got, + Binary** mpp, + Eterm* ret) { Eterm* hp; Eterm egot; Eterm mpb; Eterm continuation; - int is_first_trap = (prev_continuation_tptr == NULL); + int is_first_trap = (ctx->prev_continuation_tptr == NULL); size_t base_halloc_sz = (is_first_trap ? ERTS_MAGIC_REF_THING_SIZE : 0); - BUMP_ALL_REDS(p); + BUMP_ALL_REDS(ctx->p); if (IS_USMALL(0, got)) { - hp = HAllocX(p, base_halloc_sz + 5, ERTS_MAGIC_REF_THING_SIZE); + hp = HAllocX(ctx->p, base_halloc_sz + 6, ERTS_MAGIC_REF_THING_SIZE); egot = make_small(got); } else { - hp = HAllocX(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5, + hp = HAllocX(ctx->p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 6, ERTS_MAGIC_REF_THING_SIZE); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } if (is_first_trap) { - if (is_atom(tid)) - tid = erts_db_make_tid(p, &tb->common); - mpb = erts_db_make_match_prog_ref(p, *mpp, &hp); + if (is_atom(ctx->tid)) + ctx->tid = erts_db_make_tid(ctx->p, &ctx->tb->common); + mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &hp); *mpp = NULL; /* otherwise the caller will destroy it */ } else { - ASSERT(!is_atom(tid)); - mpb = prev_continuation_tptr[3]; + ASSERT(!is_atom(ctx->tid)); + mpb = ctx->prev_continuation_tptr[3]; } - continuation = TUPLE4( + continuation = TUPLE5( hp, - tid, + ctx->tid, make_small(slot_ix), mpb, - egot); - ERTS_BIF_PREP_TRAP1(*ret, trap_function, p, continuation); + egot, + make_small(ctx->safety)); + ERTS_BIF_PREP_TRAP1(*ret, trap_function, ctx->p, continuation); return DB_ERROR_NONE; } @@ -1510,17 +1519,18 @@ static ERTS_INLINE int unpack_simple_continuation(Eterm continuation, Eterm* tid_ptr, Sint* slot_ix_p, Binary** mpp, - Sint* got_p) + Sint* got_p, + enum DbIterSafety* safety_p) { Eterm* tptr; ASSERT(is_tuple(continuation)); tptr = tuple_val(continuation); - if (arityval(*tptr) != 4) + if (*tptr != make_arityval(5)) return 1; - if (! is_small(tptr[2]) || !(is_big(tptr[4]) || is_small(tptr[4]))) { + if (!is_small(tptr[2]) || !(is_big(tptr[4]) || is_small(tptr[4])) + || !is_small(tptr[5])) return 1; - } *tptr_ptr = tptr; *tid_ptr = tptr[1]; @@ -1532,6 +1542,7 @@ static ERTS_INLINE int unpack_simple_continuation(Eterm continuation, else { *got_p = unsigned_val(tptr[4]); } + *safety_p = signed_val(tptr[5]); return 0; } @@ -1545,24 +1556,20 @@ static ERTS_INLINE int unpack_simple_continuation(Eterm continuation, #define MAX_SELECT_CHUNK_ITERATIONS 1000 typedef struct { - match_callbacks_t base; - Process* p; - DbTableHash* tb; - Eterm tid; + traverse_context_t base; Eterm* hp; Sint chunk_size; Eterm match_list; - Eterm* prev_continuation_tptr; } select_chunk_context_t; -static int select_chunk_on_nothing_can_match(match_callbacks_t* ctx_base, Eterm* ret) +static int select_chunk_on_nothing_can_match(traverse_context_t* ctx_base, Eterm* ret) { select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base; *ret = (ctx->chunk_size > 0 ? am_EOT : NIL); return DB_ERROR_NONE; } -static int select_chunk_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, +static int select_chunk_on_match_res(traverse_context_t* ctx_base, Sint slot_ix, HashDbTerm*** current_ptr_ptr, Eterm match_res) { @@ -1574,7 +1581,7 @@ static int select_chunk_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, return 0; } -static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base, +static int select_chunk_on_loop_ended(traverse_context_t* ctx_base, Sint slot_ix, Sint got, Sint iterations_left, Binary** mpp, Eterm* ret) @@ -1590,7 +1597,7 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base, } else { ASSERT(iterations_left < MAX_SELECT_CHUNK_ITERATIONS); - BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); + BUMP_REDS(ctx->base.p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); if (ctx->chunk_size) { Eterm continuation; Eterm rest = NIL; @@ -1609,14 +1616,14 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base, been in 'user space' */ } if (rest != NIL || slot_ix >= 0) { /* Need more calls */ - Eterm tid = ctx->tid; - ctx->hp = HAllocX(ctx->p, + Eterm tid = ctx->base.tid; + ctx->hp = HAllocX(ctx->base.p, 3 + 7 + ERTS_MAGIC_REF_THING_SIZE, ERTS_MAGIC_REF_THING_SIZE); - mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &ctx->hp); + mpb = erts_db_make_match_prog_ref(ctx->base.p, *mpp, &ctx->hp); if (is_atom(tid)) - tid = erts_db_make_tid(ctx->p, - &ctx->tb->common); + tid = erts_db_make_tid(ctx->base.p, + &ctx->base.tb->common); continuation = TUPLE6( ctx->hp, tid, @@ -1631,7 +1638,7 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base, } else { /* All data is exhausted */ if (ctx->match_list != NIL) { /* No more data to search but still a result to return to the caller */ - ctx->hp = HAlloc(ctx->p, 3); + ctx->hp = HAlloc(ctx->base.p, 3); *ret = TUPLE2(ctx->hp, ctx->match_list, am_EOT); return DB_ERROR_NONE; } else { /* Reached the end of the ttable with no data to return */ @@ -1645,7 +1652,7 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base, } } -static int select_chunk_on_trap(match_callbacks_t* ctx_base, +static int select_chunk_on_trap(traverse_context_t* ctx_base, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret) { @@ -1654,74 +1661,77 @@ static int select_chunk_on_trap(match_callbacks_t* ctx_base, Eterm continuation; Eterm* hp; - BUMP_ALL_REDS(ctx->p); + BUMP_ALL_REDS(ctx->base.p); - if (ctx->prev_continuation_tptr == NULL) { - Eterm tid = ctx->tid; + if (ctx->base.prev_continuation_tptr == NULL) { + Eterm tid = ctx->base.tid; /* First time we're trapping */ - hp = HAllocX(ctx->p, 7 + ERTS_MAGIC_REF_THING_SIZE, + hp = HAllocX(ctx->base.p, 8 + ERTS_MAGIC_REF_THING_SIZE, ERTS_MAGIC_REF_THING_SIZE); if (is_atom(tid)) - tid = erts_db_make_tid(ctx->p, &ctx->tb->common); - mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &hp); - continuation = TUPLE6( + tid = erts_db_make_tid(ctx->base.p, &ctx->base.tb->common); + mpb = erts_db_make_match_prog_ref(ctx->base.p, *mpp, &hp); + continuation = TUPLE7( hp, tid, make_small(slot_ix), make_small(ctx->chunk_size), mpb, ctx->match_list, - make_small(got)); + make_small(got), + make_small(ctx->base.safety)); *mpp = NULL; /* otherwise the caller will destroy it */ } else { /* Not the first time we're trapping; reuse continuation terms */ - hp = HAlloc(ctx->p, 7); - continuation = TUPLE6( + hp = HAlloc(ctx->base.p, 8); + continuation = TUPLE7( hp, - ctx->prev_continuation_tptr[1], + ctx->base.prev_continuation_tptr[1], make_small(slot_ix), - ctx->prev_continuation_tptr[3], - ctx->prev_continuation_tptr[4], + ctx->base.prev_continuation_tptr[3], + ctx->base.prev_continuation_tptr[4], ctx->match_list, - make_small(got)); + make_small(got), + make_small(ctx->base.safety)); } - ERTS_BIF_PREP_TRAP1(*ret, &ets_select_continue_exp, ctx->p, + ERTS_BIF_PREP_TRAP1(*ret, &ets_select_continue_exp, ctx->base.p, continuation); return DB_ERROR_NONE; } static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, - int reverse, Eterm *ret) + int reverse, Eterm *ret, enum DbIterSafety safety) { - return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret); + return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret, safety); } static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, - int reverse, Eterm *ret) + int reverse, Eterm *ret, enum DbIterSafety safety) { select_chunk_context_t ctx; ctx.base.on_nothing_can_match = select_chunk_on_nothing_can_match; ctx.base.on_match_res = select_chunk_on_match_res; ctx.base.on_loop_ended = select_chunk_on_loop_ended; - ctx.base.on_trap = select_chunk_on_trap, - ctx.p = p; - ctx.tb = &tbl->hash; - ctx.tid = tid; + ctx.base.on_trap = select_chunk_on_trap; + ctx.base.p = p; + ctx.base.tb = &tbl->hash; + ctx.base.tid = tid; + ctx.base.prev_continuation_tptr = NULL; + ctx.base.safety = safety; ctx.hp = NULL; ctx.chunk_size = chunk_size; ctx.match_list = NIL; - ctx.prev_continuation_tptr = NULL; return match_traverse( - ctx.p, ctx.tb, + &ctx.base, pattern, NULL, ctx.chunk_size, MAX_SELECT_CHUNK_ITERATIONS, &ctx.hp, 0, - &ctx.base, ret); + ret); } /* @@ -1731,7 +1741,7 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, */ static -int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base, +int select_chunk_continue_on_loop_ended(traverse_context_t* ctx_base, Sint slot_ix, Sint got, Sint iterations_left, Binary** mpp, Eterm* ret) @@ -1742,14 +1752,14 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base, Eterm* hp; ASSERT(iterations_left <= MAX_SELECT_CHUNK_ITERATIONS); - BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); + BUMP_REDS(ctx->base.p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); if (ctx->chunk_size) { Sint rest_size = 0; if (got > ctx->chunk_size) { /* Cannot write destructively here, the list may have been in user space */ - hp = HAlloc(ctx->p, (got - ctx->chunk_size) * 2); + hp = HAlloc(ctx->base.p, (got - ctx->chunk_size) * 2); while (got-- > ctx->chunk_size) { rest = CONS(hp, CAR(list_val(ctx->match_list)), rest); hp += 2; @@ -1758,13 +1768,13 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base, } } if (rest != NIL || slot_ix >= 0) { - hp = HAlloc(ctx->p, 3 + 7); + hp = HAlloc(ctx->base.p, 3 + 7); continuation = TUPLE6( hp, - ctx->prev_continuation_tptr[1], + ctx->base.prev_continuation_tptr[1], make_small(slot_ix), - ctx->prev_continuation_tptr[3], - ctx->prev_continuation_tptr[4], + ctx->base.prev_continuation_tptr[3], + ctx->base.prev_continuation_tptr[4], rest, make_small(rest_size)); hp += 7; @@ -1772,7 +1782,7 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base, return DB_ERROR_NONE; } else { if (ctx->match_list != NIL) { - hp = HAlloc(ctx->p, 3); + hp = HAlloc(ctx->base.p, 3); *ret = TUPLE2(hp, ctx->match_list, am_EOT); return DB_ERROR_NONE; } else { @@ -1786,10 +1796,11 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base, } /* - * This is called when select traps + * This is called when ets:select/1/2/3 traps + * and for ets:select/1 with user continuation term. */ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, - Eterm* ret) + Eterm* ret, enum DbIterSafety* safety_p) { select_chunk_context_t ctx; Eterm* tptr; @@ -1805,7 +1816,13 @@ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, ASSERT(is_tuple(continuation)); tptr = tuple_val(continuation); - if (arityval(*tptr) != 6) + /* + * 6-tuple is select/1 user continuation term + * 7-tuple is select trap continuation + */ + if (*tptr == make_arityval(7) && is_small(tptr[7])) + *safety_p = signed_val(tptr[7]); + else if (*tptr != make_arityval(6)) goto badparam; if (!is_small(tptr[2]) || !is_small(tptr[3]) || @@ -1829,18 +1846,19 @@ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, ctx.base.on_match_res = select_chunk_on_match_res; ctx.base.on_loop_ended = select_chunk_continue_on_loop_ended; ctx.base.on_trap = select_chunk_on_trap; - ctx.p = p; - ctx.tb = &tbl->hash; - ctx.tid = tid; + ctx.base.p = p; + ctx.base.tb = &tbl->hash; + ctx.base.tid = tid; + ctx.base.prev_continuation_tptr = tptr; + ctx.base.safety = *safety_p; ctx.hp = NULL; ctx.chunk_size = chunk_size; ctx.match_list = match_list; - ctx.prev_continuation_tptr = tptr; return match_traverse_continue( - ctx.p, ctx.tb, ctx.chunk_size, - iterations_left, &ctx.hp, slot_ix, got, &mp, 0, - &ctx.base, ret); + &ctx.base, ctx.chunk_size, + iterations_left, &ctx.hp, slot_ix, got, &mp, 0, + ret); badparam: *ret = NIL; @@ -1858,84 +1876,73 @@ badparam: #define MAX_SELECT_COUNT_ITERATIONS 1000 -typedef struct { - match_callbacks_t base; - Process* p; - DbTableHash* tb; - Eterm tid; - Eterm* prev_continuation_tptr; -} select_count_context_t; - -static int select_count_on_nothing_can_match(match_callbacks_t* ctx_base, +static int select_count_on_nothing_can_match(traverse_context_t* ctx_base, Eterm* ret) { *ret = make_small(0); return DB_ERROR_NONE; } -static int select_count_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, +static int select_count_on_match_res(traverse_context_t* ctx_base, Sint slot_ix, HashDbTerm*** current_ptr_ptr, Eterm match_res) { return (match_res == am_true); } -static int select_count_on_loop_ended(match_callbacks_t* ctx_base, +static int select_count_on_loop_ended(traverse_context_t* ctx, Sint slot_ix, Sint got, Sint iterations_left, Binary** mpp, Eterm* ret) { - select_count_context_t* ctx = (select_count_context_t*) ctx_base; ASSERT(iterations_left <= MAX_SELECT_COUNT_ITERATIONS); BUMP_REDS(ctx->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left); *ret = erts_make_integer(got, ctx->p); return DB_ERROR_NONE; } -static int select_count_on_trap(match_callbacks_t* ctx_base, +static int select_count_on_trap(traverse_context_t* ctx, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret) { - select_count_context_t* ctx = (select_count_context_t*) ctx_base; return on_simple_trap( - &ets_select_count_continue_exp, - ctx->p, - ctx->tb, - ctx->tid, - ctx->prev_continuation_tptr, + &ets_select_count_continue_exp, ctx, slot_ix, got, mpp, ret); } static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { - select_count_context_t ctx; + traverse_context_t ctx; Sint iterations_left = MAX_SELECT_COUNT_ITERATIONS; Sint chunk_size = 0; - ctx.base.on_nothing_can_match = select_count_on_nothing_can_match; - ctx.base.on_match_res = select_count_on_match_res; - ctx.base.on_loop_ended = select_count_on_loop_ended; - ctx.base.on_trap = select_count_on_trap; + ctx.on_nothing_can_match = select_count_on_nothing_can_match; + ctx.on_match_res = select_count_on_match_res; + ctx.on_loop_ended = select_count_on_loop_ended; + ctx.on_trap = select_count_on_trap; ctx.p = p; ctx.tb = &tbl->hash; ctx.tid = tid; ctx.prev_continuation_tptr = NULL; + ctx.safety = safety; return match_traverse( - ctx.p, ctx.tb, + &ctx, pattern, NULL, chunk_size, iterations_left, NULL, 0, - &ctx.base, ret); + ret); } /* * This is called when select_count traps */ static int db_select_count_continue_hash(Process* p, DbTable* tbl, - Eterm continuation, Eterm* ret) + Eterm continuation, Eterm* ret, + enum DbIterSafety* safety_p) { - select_count_context_t ctx; + traverse_context_t ctx; Eterm* tptr; Eterm tid; Binary* mp; @@ -1944,24 +1951,26 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl, Sint chunk_size = 0; *ret = NIL; - if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, + &got, safety_p)) { *ret = NIL; return DB_ERROR_BADPARAM; } - ctx.base.on_match_res = select_count_on_match_res; - ctx.base.on_loop_ended = select_count_on_loop_ended; - ctx.base.on_trap = select_count_on_trap; + ctx.on_match_res = select_count_on_match_res; + ctx.on_loop_ended = select_count_on_loop_ended; + ctx.on_trap = select_count_on_trap; ctx.p = p; ctx.tb = &tbl->hash; ctx.tid = tid; ctx.prev_continuation_tptr = tptr; + ctx.safety = *safety_p; return match_traverse_continue( - ctx.p, ctx.tb, chunk_size, + &ctx, chunk_size, MAX_SELECT_COUNT_ITERATIONS, NULL, slot_ix, got, &mp, 0, - &ctx.base, ret); + ret); } #undef MAX_SELECT_COUNT_ITERATIONS @@ -1976,24 +1985,20 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl, #define MAX_SELECT_DELETE_ITERATIONS 1000 typedef struct { - match_callbacks_t base; - Process* p; - DbTableHash* tb; - Eterm tid; - Eterm* prev_continuation_tptr; + traverse_context_t base; erts_aint_t fixated_by_me; Uint last_pseudo_delete; HashDbTerm* free_us; } select_delete_context_t; -static int select_delete_on_nothing_can_match(match_callbacks_t* ctx_base, +static int select_delete_on_nothing_can_match(traverse_context_t* ctx_base, Eterm* ret) { *ret = make_small(0); return DB_ERROR_NONE; } -static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, +static int select_delete_on_match_res(traverse_context_t* ctx_base, Sint slot_ix, HashDbTerm*** current_ptr_ptr, Eterm match_res) { @@ -2003,9 +2008,9 @@ static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, if (match_res != am_true) return 0; - if (NFIXED(ctx->tb) > ctx->fixated_by_me) { /* fixated by others? */ + if (NFIXED(ctx->base.tb) > ctx->fixated_by_me) { /* fixated by others? */ if (slot_ix != ctx->last_pseudo_delete) { - if (!add_fixed_deletion(ctx->tb, slot_ix, ctx->fixated_by_me)) + if (!add_fixed_deletion(ctx->base.tb, slot_ix, ctx->fixated_by_me)) goto do_erase; ctx->last_pseudo_delete = slot_ix; } @@ -2018,46 +2023,43 @@ static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, del->next = ctx->free_us; ctx->free_us = del; } - erts_atomic_dec_nob(&ctx->tb->common.nitems); + erts_atomic_dec_nob(&ctx->base.tb->common.nitems); return 1; } -static int select_delete_on_loop_ended(match_callbacks_t* ctx_base, +static int select_delete_on_loop_ended(traverse_context_t* ctx_base, Sint slot_ix, Sint got, Sint iterations_left, Binary** mpp, Eterm* ret) { select_delete_context_t* ctx = (select_delete_context_t*) ctx_base; - free_term_list(ctx->tb, ctx->free_us); + free_term_list(ctx->base.tb, ctx->free_us); ctx->free_us = NULL; ASSERT(iterations_left <= MAX_SELECT_DELETE_ITERATIONS); - BUMP_REDS(ctx->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left); + BUMP_REDS(ctx->base.p, MAX_SELECT_DELETE_ITERATIONS - iterations_left); if (got) { - try_shrink(ctx->tb); + try_shrink(ctx->base.tb); } - *ret = erts_make_integer(got, ctx->p); + *ret = erts_make_integer(got, ctx->base.p); return DB_ERROR_NONE; } -static int select_delete_on_trap(match_callbacks_t* ctx_base, +static int select_delete_on_trap(traverse_context_t* ctx_base, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret) { select_delete_context_t* ctx = (select_delete_context_t*) ctx_base; - free_term_list(ctx->tb, ctx->free_us); + free_term_list(ctx->base.tb, ctx->free_us); ctx->free_us = NULL; return on_simple_trap( - &ets_select_delete_continue_exp, - ctx->p, - ctx->tb, - ctx->tid, - ctx->prev_continuation_tptr, + &ets_select_delete_continue_exp, &ctx->base, slot_ix, got, mpp, ret); } static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { select_delete_context_t ctx; Sint chunk_size = 0; @@ -2066,27 +2068,29 @@ static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, ctx.base.on_match_res = select_delete_on_match_res; ctx.base.on_loop_ended = select_delete_on_loop_ended; ctx.base.on_trap = select_delete_on_trap; - ctx.p = p; - ctx.tb = &tbl->hash; - ctx.tid = tid; - ctx.prev_continuation_tptr = NULL; - ctx.fixated_by_me = ctx.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */ + ctx.base.p = p; + ctx.base.tb = &tbl->hash; + ctx.base.tid = tid; + ctx.base.prev_continuation_tptr = NULL; + ctx.base.safety = safety; + ctx.fixated_by_me = ctx.base.tb->common.is_thread_safe ? 0 : 1; ctx.last_pseudo_delete = (Uint) -1; ctx.free_us = NULL; return match_traverse( - ctx.p, ctx.tb, + &ctx.base, pattern, NULL, chunk_size, MAX_SELECT_DELETE_ITERATIONS, NULL, 1, - &ctx.base, ret); + ret); } /* * This is called when select_delete traps */ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, - Eterm continuation, Eterm* ret) + Eterm continuation, Eterm* ret, + enum DbIterSafety* safety_p) { select_delete_context_t ctx; Eterm* tptr; @@ -2096,7 +2100,8 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Sint slot_ix; Sint chunk_size = 0; - if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, + &got, safety_p)) { *ret = NIL; return DB_ERROR_BADPARAM; } @@ -2104,19 +2109,20 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, ctx.base.on_match_res = select_delete_on_match_res; ctx.base.on_loop_ended = select_delete_on_loop_ended; ctx.base.on_trap = select_delete_on_trap; - ctx.p = p; - ctx.tb = &tbl->hash; - ctx.tid = tid; - ctx.prev_continuation_tptr = tptr; - ctx.fixated_by_me = ONLY_WRITER(p, ctx.tb) ? 0 : 1; /* TODO: something nicer */ + ctx.base.p = p; + ctx.base.tb = &tbl->hash; + ctx.base.tid = tid; + ctx.base.prev_continuation_tptr = tptr; + ctx.base.safety = *safety_p; + ctx.fixated_by_me = ONLY_WRITER(p, ctx.base.tb) ? 0 : 1; ctx.last_pseudo_delete = (Uint) -1; ctx.free_us = NULL; return match_traverse_continue( - ctx.p, ctx.tb, chunk_size, + &ctx.base, chunk_size, MAX_SELECT_DELETE_ITERATIONS, NULL, slot_ix, got, &mp, 1, - &ctx.base, ret); + ret); } #undef MAX_SELECT_DELETE_ITERATIONS @@ -2130,26 +2136,17 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, #define MAX_SELECT_REPLACE_ITERATIONS 1000 -typedef struct { - match_callbacks_t base; - Process* p; - DbTableHash* tb; - Eterm tid; - Eterm* prev_continuation_tptr; -} select_replace_context_t; - -static int select_replace_on_nothing_can_match(match_callbacks_t* ctx_base, +static int select_replace_on_nothing_can_match(traverse_context_t* ctx_base, Eterm* ret) { *ret = make_small(0); return DB_ERROR_NONE; } -static int select_replace_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, +static int select_replace_on_match_res(traverse_context_t* ctx, Sint slot_ix, HashDbTerm*** current_ptr_ptr, Eterm match_res) { - select_replace_context_t* ctx = (select_replace_context_t*) ctx_base; DbTableHash* tb = ctx->tb; HashDbTerm* new; HashDbTerm* next; @@ -2175,11 +2172,10 @@ static int select_replace_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix return 0; } -static int select_replace_on_loop_ended(match_callbacks_t* ctx_base, Sint slot_ix, +static int select_replace_on_loop_ended(traverse_context_t* ctx, Sint slot_ix, Sint got, Sint iterations_left, Binary** mpp, Eterm* ret) { - select_replace_context_t* ctx = (select_replace_context_t*) ctx_base; ASSERT(iterations_left <= MAX_SELECT_REPLACE_ITERATIONS); /* the more objects we've replaced, the more reductions we've consumed */ BUMP_REDS(ctx->p, @@ -2189,23 +2185,20 @@ static int select_replace_on_loop_ended(match_callbacks_t* ctx_base, Sint slot_i return DB_ERROR_NONE; } -static int select_replace_on_trap(match_callbacks_t* ctx_base, +static int select_replace_on_trap(traverse_context_t* ctx, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret) { - select_replace_context_t* ctx = (select_replace_context_t*) ctx_base; return on_simple_trap( - &ets_select_replace_continue_exp, - ctx->p, - ctx->tb, - ctx->tid, - ctx->prev_continuation_tptr, + &ets_select_replace_continue_exp, ctx, slot_ix, got, mpp, ret); } -static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) +static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { - select_replace_context_t ctx; + traverse_context_t ctx; Sint chunk_size = 0; /* Bag implementation presented both semantic consistency and performance issues, @@ -2213,29 +2206,32 @@ static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pat */ ASSERT(!(tbl->hash.common.status & DB_BAG)); - ctx.base.on_nothing_can_match = select_replace_on_nothing_can_match; - ctx.base.on_match_res = select_replace_on_match_res; - ctx.base.on_loop_ended = select_replace_on_loop_ended; - ctx.base.on_trap = select_replace_on_trap; + ctx.on_nothing_can_match = select_replace_on_nothing_can_match; + ctx.on_match_res = select_replace_on_match_res; + ctx.on_loop_ended = select_replace_on_loop_ended; + ctx.on_trap = select_replace_on_trap; ctx.p = p; ctx.tb = &tbl->hash; ctx.tid = tid; ctx.prev_continuation_tptr = NULL; + ctx.safety = safety; return match_traverse( - ctx.p, ctx.tb, + &ctx, pattern, db_match_keeps_key, chunk_size, MAX_SELECT_REPLACE_ITERATIONS, NULL, 1, - &ctx.base, ret); + ret); } /* * This is called when select_replace traps */ -static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) +static int db_select_replace_continue_hash(Process* p, DbTable* tbl, + Eterm continuation, Eterm* ret, + enum DbIterSafety* safety_p) { - select_replace_context_t ctx; + traverse_context_t ctx; Eterm* tptr; Eterm tid ; Binary* mp; @@ -2244,25 +2240,27 @@ static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm conti Sint chunk_size = 0; *ret = NIL; - if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, + &got, safety_p)) { *ret = NIL; return DB_ERROR_BADPARAM; } /* Proceed */ - ctx.base.on_match_res = select_replace_on_match_res; - ctx.base.on_loop_ended = select_replace_on_loop_ended; - ctx.base.on_trap = select_replace_on_trap; + ctx.on_match_res = select_replace_on_match_res; + ctx.on_loop_ended = select_replace_on_loop_ended; + ctx.on_trap = select_replace_on_trap; ctx.p = p; ctx.tb = &tbl->hash; ctx.tid = tid; ctx.prev_continuation_tptr = tptr; + ctx.safety = *safety_p; return match_traverse_continue( - ctx.p, ctx.tb, chunk_size, + &ctx, chunk_size, MAX_SELECT_REPLACE_ITERATIONS, NULL, slot_ix, got, &mp, 1, - &ctx.base, ret); + ret); } diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index fe57348700..f9ba04f399 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -397,24 +397,31 @@ static int db_erase_object_tree(DbTable *tbl, Eterm object,Eterm *ret); static int db_slot_tree(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret); static int db_select_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, int reversed, Eterm *ret); + Eterm pattern, int reversed, Eterm *ret, + enum DbIterSafety); static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, enum DbIterSafety); static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, - int reversed, Eterm *ret); + int reversed, Eterm *ret, enum DbIterSafety); static int db_select_continue_tree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_count_continue_tree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, + enum DbIterSafety); static int db_select_delete_continue_tree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); + Eterm pattern, Eterm *ret, + enum DbIterSafety); static int db_select_replace_continue_tree(Process *p, DbTable *tbl, - Eterm continuation, Eterm *ret); + Eterm continuation, Eterm *ret, + enum DbIterSafety*); static int db_take_tree(Process *, DbTable *, Eterm, Eterm *); static void db_print_tree(fmtfn_t to, void *to_arg, int show, DbTable *tbl); @@ -1160,7 +1167,8 @@ int db_select_continue_tree_common(Process *p, static int db_select_continue_tree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { DbTableTree *tb = &tbl->tree; return db_select_continue_tree_common(p, &tb->common, @@ -1297,7 +1305,8 @@ int db_select_tree_common(Process *p, DbTable *tb, } static int db_select_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, int reverse, Eterm *ret) + Eterm pattern, int reverse, Eterm *ret, + enum DbIterSafety safety) { return db_select_tree_common(p, tbl, tid, pattern, reverse, ret, &tbl->tree, NULL); @@ -1408,7 +1417,8 @@ int db_select_count_continue_tree_common(Process *p, static int db_select_count_continue_tree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { DbTableTree *tb = &tbl->tree; return db_select_count_continue_tree_common(p, tbl, @@ -1527,7 +1537,8 @@ int db_select_count_tree_common(Process *p, DbTable *tb, } static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { DbTableTree *tb = &tbl->tree; return db_select_count_tree_common(p, tbl, @@ -1704,7 +1715,7 @@ int db_select_chunk_tree_common(Process *p, DbTable *tb, static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, int reverse, - Eterm *ret) + Eterm *ret, enum DbIterSafety safety) { DbTableTree *tb = &tbl->tree; return db_select_chunk_tree_common(p, tbl, @@ -1813,7 +1824,8 @@ int db_select_delete_continue_tree_common(Process *p, static int db_select_delete_continue_tree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { DbTableTree *tb = &tbl->tree; ASSERT(!erts_atomic_read_nob(&tb->is_stack_busy)); @@ -1942,7 +1954,8 @@ int db_select_delete_tree_common(Process *p, DbTable *tbl, } static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { DbTableTree *tb = &tbl->tree; return db_select_delete_tree_common(p, tbl, tid, pattern, ret, @@ -2052,7 +2065,8 @@ int db_select_replace_continue_tree_common(Process *p, static int db_select_replace_continue_tree(Process *p, DbTable *tbl, Eterm continuation, - Eterm *ret) + Eterm *ret, + enum DbIterSafety* safety_p) { return db_select_replace_continue_tree_common(p, tbl, continuation, ret, &tbl->tree, NULL); @@ -2177,7 +2191,8 @@ int db_select_replace_tree_common(Process *p, DbTable *tbl, } static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret) + Eterm pattern, Eterm *ret, + enum DbIterSafety safety) { return db_select_replace_tree_common(p, tbl, tid, pattern, ret, &tbl->tree, NULL); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index e1af9210ea..e3d3c0e804 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -101,6 +101,14 @@ typedef struct { } u; } DbUpdateHandle; +/* How safe are we from double-hits or missed objects + * when iterating without fixation? + */ +enum DbIterSafety { + ITER_UNSAFE, /* Must fixate to be safe */ + ITER_SAFE_LOCKED, /* Safe while table is locked, not between trap calls */ + ITER_SAFE /* No need to fixate at all */ +}; typedef struct db_table_method { @@ -150,44 +158,53 @@ typedef struct db_table_method Eterm pattern, Sint chunk_size, int reverse, - Eterm* ret); + Eterm* ret, + enum DbIterSafety); int (*db_select)(Process* p, DbTable* tb, /* [in out] */ Eterm tid, Eterm pattern, int reverse, - Eterm* ret); + Eterm* ret, + enum DbIterSafety); int (*db_select_delete)(Process* p, DbTable* tb, /* [in out] */ Eterm tid, Eterm pattern, - Eterm* ret); + Eterm* ret, + enum DbIterSafety); int (*db_select_continue)(Process* p, DbTable* tb, /* [in out] */ Eterm continuation, - Eterm* ret); + Eterm* ret, + enum DbIterSafety*); int (*db_select_delete_continue)(Process* p, DbTable* tb, /* [in out] */ Eterm continuation, - Eterm* ret); + Eterm* ret, + enum DbIterSafety*); int (*db_select_count)(Process* p, DbTable* tb, /* [in out] */ Eterm tid, Eterm pattern, - Eterm* ret); + Eterm* ret, + enum DbIterSafety); int (*db_select_count_continue)(Process* p, DbTable* tb, /* [in out] */ Eterm continuation, - Eterm* ret); + Eterm* ret, + enum DbIterSafety*); int (*db_select_replace)(Process* p, DbTable* tb, /* [in out] */ Eterm tid, Eterm pattern, - Eterm* ret); + Eterm* ret, + enum DbIterSafety); int (*db_select_replace_continue)(Process* p, DbTable* tb, /* [in out] */ Eterm continuation, - Eterm* ret); + Eterm* ret, + enum DbIterSafety*); int (*db_take)(Process *, DbTable *, Eterm, Eterm *); SWord (*db_delete_all_objects)(Process* p, DbTable* db, SWord reds); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 0a099e69bb..3fa06d1407 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -9460,6 +9460,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (!is_normal_sched & !!(flags & ERTS_RUNQ_FLG_HALTING)) { /* Wait for emulator to terminate... */ + erts_runq_unlock(rq); while (1) erts_milli_sleep(1000*1000); } @@ -13403,10 +13404,10 @@ void erts_halt(int code) if (-1 == erts_atomic32_cmpxchg_acqb(&erts_halt_progress, erts_no_schedulers, -1)) { + notify_reap_ports_relb(); ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_CPU_RUNQ, ERTS_RUNQ_FLG_HALTING); ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_IO_RUNQ, ERTS_RUNQ_FLG_HALTING); erts_halt_code = code; - notify_reap_ports_relb(); } } diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index e688c6996b..da5364183c 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -74,23 +74,19 @@ trace_jump W return +# To ensure that a "move Src x(0)" instruction can be combined with +# the following call instruction, we need to make sure that there is +# no line/1 instruction between the move and the call. # -# To ensure that a "move Src x(0)" instruction can be combined -# with the following call instruction, we need to make sure that -# there is no line/1 instruction between the move and the call. -# -# A tail-recursive call to an external function (non-BIF) will -# never be saved on the stack, so there is no reason to keep -# the line instruction. (The compiler did not remove the line -# instruction because it cannot tell the difference between -# BIFs and ordinary Erlang functions.) -# +# A tail-recursive call to an external function (BIF or non-BIF) will +# never be saved on the stack, so there is no reason to keep the line +# instruction. move S X0=x==0 | line Loc | call_ext Ar Func => \ line Loc | move S X0 | call_ext Ar Func -move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \ +move S X0=x==0 | line Loc | call_ext_last Ar Func D => \ move S X0 | call_ext_last Ar Func D -move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_not_bif => \ +move S X0=x==0 | line Loc | call_ext_only Ar Func => \ move S X0 | call_ext_only Ar Func move S X0=x==0 | line Loc | call Ar Func => \ line Loc | move S X0 | call Ar Func @@ -102,9 +98,9 @@ line I allocate t t? allocate_heap t I t? -%cold +# This instruction when a BIF is called tail-recursively when +# ther is stack frame. deallocate Q -%hot init y allocate_zero t t? @@ -985,10 +981,9 @@ call_ext_only u==0 u$func:os:perf_counter/0 => \ call_ext u Bif=u$is_bif => call_bif Bif -call_ext_last u Bif=u$is_bif D => call_bif Bif | deallocate_return D +call_ext_last u Bif=u$is_bif D => deallocate D | call_bif_only Bif -call_ext_only Ar=u Bif=u$is_bif => \ - allocate u Ar | call_bif Bif | deallocate_return u +call_ext_only Ar=u Bif=u$is_bif => call_bif_only Bif # # Any remaining calls are calls to Erlang functions, not BIFs. @@ -1020,6 +1015,7 @@ i_perf_counter %hot call_bif e +call_bif_only e # # Calls to non-building and guard BIFs. diff --git a/erts/emulator/nifs/common/net_nif.c b/erts/emulator/nifs/common/net_nif.c index 6c91bd74bd..252aa3c835 100644 --- a/erts/emulator/nifs/common/net_nif.c +++ b/erts/emulator/nifs/common/net_nif.c @@ -1363,7 +1363,7 @@ ERL_NIF_TERM encode_address_infos(ErlNifEnv* env, NDBG( ("NET", "encode_address_infos -> len: %d\r\n", len) ); if (len > 0) { - ERL_NIF_TERM* array = MALLOC(len * sizeof(ERL_NIF_TERM)); // LEAK? + ERL_NIF_TERM* array = MALLOC(len * sizeof(ERL_NIF_TERM)); unsigned int i = 0; struct addrinfo* p = addrInfo; @@ -1374,6 +1374,7 @@ ERL_NIF_TERM encode_address_infos(ErlNifEnv* env, } result = MKLA(env, array, len); + FREE(array); } else { result = MKEL(env); } diff --git a/erts/emulator/nifs/common/socket_nif.c b/erts/emulator/nifs/common/socket_nif.c index f131b45685..870ab63bdf 100644 --- a/erts/emulator/nifs/common/socket_nif.c +++ b/erts/emulator/nifs/common/socket_nif.c @@ -2309,12 +2309,14 @@ static void dec_socket(int domain, int type, int protocol); ERL_NIF_TERM sockRef); ACTIVATE_NEXT_FUNCS_DEFS #undef ACTIVATE_NEXT_FUNC_DEF - + +/* static BOOLEAN_T activate_next(ErlNifEnv* env, SocketDescriptor* descP, SocketRequestor* reqP, SocketRequestQueue* q, ERL_NIF_TERM sockRef); +*/ /* *** acceptor_search4pid | writer_search4pid | reader_search4pid *** * *** acceptor_push | writer_push | reader_push *** @@ -17051,93 +17053,81 @@ int esock_select_cancel(ErlNifEnv* env, * *** activate_next_writer *** * *** activate_next_reader *** * - * This functions pops the writer queue and then selects until it - * manages to successfully activate a writer or the queue is empty. + * This functions pops the requestors queue and then selects until it + * manages to successfully activate a requestor or the queue is empty. + * Return value indicates if a new requestor was activated or not. */ -#define ACTIVATE_NEXT_FUNCS \ - ACTIVATE_NEXT_FUNC_DECL(acceptor, currentAcceptor, acceptorsQ) \ - ACTIVATE_NEXT_FUNC_DECL(writer, currentWriter, writersQ) \ - ACTIVATE_NEXT_FUNC_DECL(reader, currentReader, readersQ) +#define ACTIVATE_NEXT_FUNCS \ + ACTIVATE_NEXT_FUNC_DECL(acceptor, read, currentAcceptor, acceptorsQ) \ + ACTIVATE_NEXT_FUNC_DECL(writer, write, currentWriter, writersQ) \ + ACTIVATE_NEXT_FUNC_DECL(reader, read, currentReader, readersQ) -#define ACTIVATE_NEXT_FUNC_DECL(F, R, Q) \ +#define ACTIVATE_NEXT_FUNC_DECL(F, S, R, Q) \ static \ BOOLEAN_T activate_next_##F(ErlNifEnv* env, \ SocketDescriptor* descP, \ ERL_NIF_TERM sockRef) \ { \ - return activate_next(env, descP, \ - &descP->R, &descP->Q, \ - sockRef); \ + BOOLEAN_T popped, activated; \ + int sres; \ + SocketRequestor* reqP = &descP->R; \ + SocketRequestQueue* q = &descP->Q; \ + \ + popped = FALSE; \ + do { \ + \ + if (requestor_pop(q, reqP)) { \ + \ + /* There was another one */ \ + \ + SSDBG( descP, \ + ("SOCKET", \ + "activate_next_" #F " -> new (active) requestor: " \ + "\r\n pid: %T" \ + "\r\n ref: %T" \ + "\r\n", reqP->pid, reqP->ref) ); \ + \ + if ((sres = esock_select_##S(env, descP->sock, descP, \ + &reqP->pid, reqP->ref)) < 0) { \ + /* We need to inform this process, reqP->pid, */ \ + /* that we failed to select, so we don't leave */ \ + /* it hanging. */ \ + /* => send abort */ \ + \ + esock_send_abort_msg(env, sockRef, reqP->ref, \ + sres, &reqP->pid); \ + \ + } else { \ + \ + /* Success: New requestor selected */ \ + popped = TRUE; \ + activated = FALSE; \ + \ + } \ + \ + } else { \ + \ + SSDBG( descP, \ + ("SOCKET", \ + "activate_next_" #F " -> no more requestors\r\n") ); \ + \ + popped = TRUE; \ + activated = FALSE; \ + } \ + \ + } while (!popped); \ + \ + SSDBG( descP, \ + ("SOCKET", "activate_next_" #F " -> " \ + "done with %s\r\n", B2S(activated)) ); \ + \ + return activated; \ } ACTIVATE_NEXT_FUNCS #undef ACTIVATE_NEXT_FUNC_DECL -/* *** activate_next *** - * - * This functions pops the requestor queue and then selects until it - * manages to successfully activate a new requestor or the queue is empty. - * Return value indicates if a new requestor was activated or not. - */ - -static -BOOLEAN_T activate_next(ErlNifEnv* env, - SocketDescriptor* descP, - SocketRequestor* reqP, - SocketRequestQueue* q, - ERL_NIF_TERM sockRef) -{ - BOOLEAN_T popped, activated; - int sres; - - popped = FALSE; - do { - - if (requestor_pop(q, reqP)) { - - /* There was another one */ - - SSDBG( descP, - ("SOCKET", "activate_next -> new (active) requestor: " - "\r\n pid: %T" - "\r\n ref: %T" - "\r\n", reqP->pid, reqP->ref) ); - - if ((sres = esock_select_read(env, descP->sock, descP, - &reqP->pid, reqP->ref)) < 0) { - /* We need to inform this process, reqP->pid, that we - * failed to select, so we don't leave it hanging. - * => send abort - */ - - esock_send_abort_msg(env, sockRef, reqP->ref, sres, &reqP->pid); - - } else { - - /* Success: New requestor selected */ - popped = TRUE; - activated = FALSE; - - } - - } else { - - SSDBG( descP, - ("SOCKET", "send_activate_next -> no more requestors\r\n") ); - - popped = TRUE; - activated = FALSE; - } - - } while (!popped); - - SSDBG( descP, - ("SOCKET", "activate_next -> " - "done with %s\r\n", B2S(activated)) ); - - return activated; -} /* ---------------------------------------------------------------------- diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 2309f844b9..62b7f77a52 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1223,7 +1223,7 @@ maps(Config) when is_list(Config) -> repeat_while(fun({35,_}) -> false; ({K,Map}) -> Map = maps_from_list_nif(maps:to_list(Map)), - Map = maps:filter(fun(K,V) -> V =:= K*100 end, Map), + Map = maps:filter(fun(K2,V) -> V =:= K2*100 end, Map), {K+1, maps:put(K,K*100,Map)} end, {1,#{}}), @@ -1294,24 +1294,29 @@ resource_hugo_do(Type) -> release_resource(HugoPtr), erlang:garbage_collect(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), - Pid = spawn_link(fun() -> - receive {Pid, Type, Resource, Ptr, Bin} -> - Pid ! {self(), got_it}, - receive {Pid, check_it} -> - {Ptr,Bin} = get_resource(Type,Resource), - Pid ! {self(), ok} - end - end - end), + {Pid,_} = + spawn_monitor(fun() -> + receive {Pid, Type, Resource, Ptr, Bin} -> + Pid ! {self(), got_it}, + receive {Pid, check_it} -> + {Ptr,Bin} = get_resource(Type,Resource) + end + end, + gc_and_exit(ok) + end), Pid ! {self(), Type, Hugo, HugoPtr, HugoBin}, {Pid, got_it} = receive_any(), erlang:garbage_collect(), % just to make our ProcBin move in memory Pid ! {self(), check_it}, - {Pid, ok} = receive_any(), + {'DOWN', _, process, Pid, ok} = receive_any(), [] = last_resource_dtor_call(), {HugoPtr,HugoBin} = get_resource(Type,Hugo), {HugoPtr, HugoBin, 1}. +gc_and_exit(Reason) -> + erlang:garbage_collect(), + exit(Reason). + resource_otto(Type) -> {OttoPtr, OttoBin} = resource_otto_do(Type), erlang:garbage_collect(), @@ -1388,14 +1393,14 @@ resource_binary_do() -> ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1), Papa = self(), - Forwarder = spawn_link(fun() -> forwarder(Papa) end), + {Forwarder,_} = spawn_monitor(fun() -> forwarder(Papa) end), io:format("sending to forwarder pid=~p\n",[Forwarder]), Forwarder ! ResBin1, ResBin2 = receive_any(), ResBin2 = ResBin1, ResInfo = get_resource(binary_resource_type,ResBin2), Forwarder ! terminate, - {Forwarder, 1} = receive_any(), + {'DOWN', _, process, Forwarder, 1} = receive_any(), erlang:garbage_collect(), ResInfo = get_resource(binary_resource_type,ResBin1), ResInfo = get_resource(binary_resource_type,ResBin2), @@ -1915,11 +1920,11 @@ send2_do1(SendBlobF) -> send2_do2(SendBlobF, self()), Papa = self(), - Forwarder = spawn_link(fun() -> forwarder(Papa) end), + {Forwarder,_} = spawn_monitor(fun() -> forwarder(Papa) end), io:format("sending to forwarder pid=~p\n",[Forwarder]), send2_do2(SendBlobF, Forwarder), Forwarder ! terminate, - {Forwarder, 4} = receive_any(), + {'DOWN', _, process, Forwarder, 4} = receive_any(), ok. send2_do2(SendBlobF, To) -> @@ -1975,7 +1980,7 @@ forwarder(To) -> forwarder(To, N) -> case receive_any() of terminate -> - To ! {self(), N}; + gc_and_exit(N); Msg -> To ! Msg, forwarder(To, N+1) diff --git a/erts/emulator/test/socket_SUITE.erl b/erts/emulator/test/socket_SUITE.erl index aec280485c..8a32efcd85 100644 --- a/erts/emulator/test/socket_SUITE.erl +++ b/erts/emulator/test/socket_SUITE.erl @@ -4541,7 +4541,7 @@ api_to_recv_tcp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recv(Sock, 0, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState) end). @@ -4566,7 +4566,7 @@ api_to_recv_tcp6(_Config) when is_list(_Config) -> end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState); false -> skip("ipv6 not supported") @@ -4900,7 +4900,7 @@ api_to_recvfrom_udp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvfrom(Sock, 0, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -4921,7 +4921,7 @@ api_to_recvfrom_udp6(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvfrom(Sock, 0, To) end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -4984,6 +4984,7 @@ api_to_receive_udp(InitState) -> %% *** Termination *** #{desc => "close socket", cmd => fun(#{sock := Sock} = _State) -> + socket:setopt(Sock, otp, debug, true), sock_close(Sock), ok end}, @@ -5015,7 +5016,7 @@ api_to_recvmsg_udp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -5036,7 +5037,7 @@ api_to_recvmsg_udp6(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_udp(InitState) end). @@ -5056,7 +5057,7 @@ api_to_recvmsg_tcp4(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState) end). @@ -5077,7 +5078,7 @@ api_to_recvmsg_tcp6(_Config) when is_list(_Config) -> Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end, InitState = #{domain => inet6, recv => Recv, - timeout => 5000}, + timeout => 2000}, ok = api_to_receive_tcp(InitState) end). diff --git a/erts/emulator/test/socket_test_evaluator.erl b/erts/emulator/test/socket_test_evaluator.erl index bd86b3b92e..c5748ac21b 100644 --- a/erts/emulator/test/socket_test_evaluator.erl +++ b/erts/emulator/test/socket_test_evaluator.erl @@ -104,8 +104,9 @@ start(Name, Seq, InitState) erlang:error({already_used, parent}); error -> InitState2 = InitState#{parent => self()}, - {Pid, MRef} = erlang:spawn_monitor( - fun() -> init(Name, Seq, InitState2) end), + Pid = erlang:spawn_link( + fun() -> init(Name, Seq, InitState2) end), + MRef = erlang:monitor(process, Pid), #ev{name = Name, pid = Pid, mref = MRef} end. @@ -149,55 +150,93 @@ loop(ID, [#{desc := Desc, Evs :: [ev()]. await_finish(Evs) -> - await_finish(Evs, []). + await_finish(Evs, [], []). -await_finish([], []) -> +await_finish([], _, []) -> ok; -await_finish([], Fails) -> +await_finish([], _OK, Fails) -> ?SEV_EPRINT("Fails: " "~n ~p", [Fails]), Fails; -await_finish(Evs, Fails) -> +await_finish(Evs, OK, Fails) -> receive %% Successfull termination of evaluator {'DOWN', _MRef, process, Pid, normal} -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) success", [Name, Pid]), - NewEvs = lists:keydelete(Pid, #ev.pid, Evs), - await_finish(NewEvs, Fails); - false -> - iprint("unknown process ~p died (normal)", [Pid]), - await_finish(Evs, Fails) - end; + {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2); + {'EXIT', Pid, normal} -> + {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2); %% The evaluator can skip the teat case: {'DOWN', _MRef, process, Pid, {skip, Reason}} -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) issued SKIP: " - "~n ~p", [Name, Pid, Reason]); + await_finish_skip(Pid, Reason, Evs, OK); + {'EXIT', Pid, {skip, Reason}} -> + await_finish_skip(Pid, Reason, Evs, OK); + + %% Evaluator failed + {'DOWN', _MRef, process, Pid, Reason} -> + {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2); + {'EXIT', Pid, Reason} -> + {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails), + await_finish(Evs2, OK2, Fails2) + end. + + +await_finish_normal(Pid, Evs, OK, Fails) -> + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + iprint("evaluator '~s' (~p) success", [Name, Pid]), + NewEvs = lists:keydelete(Pid, #ev.pid, Evs), + {NewEvs, [Pid|OK], Fails}; + false -> + case lists:member(Pid, OK) of + true -> + ok; + false -> + iprint("unknown process ~p died (normal)", [Pid]), + ok + end, + {Evs, OK, Fails} + end. + +await_finish_skip(Pid, Reason, Evs, OK) -> + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + iprint("evaluator '~s' (~p) issued SKIP: " + "~n ~p", [Name, Pid, Reason]); + false -> + case lists:member(Pid, OK) of + true -> + ok; false -> iprint("unknown process ~p issued SKIP: " "~n ~p", [Pid, Reason]) - end, - ?LIB:skip(Reason); + end + end, + ?LIB:skip(Reason). - %% Evaluator failed - {'DOWN', _MRef, process, Pid, Reason} -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) failed", [Name, Pid]), - NewEvs = lists:keydelete(Pid, #ev.pid, Evs), - await_finish(NewEvs, [{Pid, Reason}|Fails]); + +await_finish_fail(Pid, Reason, Evs, OK, Fails) -> + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + iprint("evaluator '~s' (~p) failed", [Name, Pid]), + NewEvs = lists:keydelete(Pid, #ev.pid, Evs), + {NewEvs, OK, [{Pid, Reason}|Fails]}; + false -> + case lists:member(Pid, OK) of + true -> + ok; false -> iprint("unknown process ~p died: " - "~n ~p", [Pid, Reason]), - await_finish(Evs, Fails) - end + "~n ~p", [Pid, Reason]) + end, + {Evs, OK, Fails} end. + %% ============================================================================ -spec announce_start(To) -> ok when diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 253d5fed23..ad802352b9 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1181,7 +1181,9 @@ undef(X) -> ?MODULE:undef(X, X). % undef lists_reverse(A, B) -> - lists:reverse(A, B). + Res = lists:reverse(A, B), + _ = (catch abs(A)), + Res. diff --git a/lib/compiler/scripts/smoke b/lib/compiler/scripts/smoke index 2429f104c0..ae31c923b8 100755 --- a/lib/compiler/scripts/smoke +++ b/lib/compiler/scripts/smoke @@ -54,6 +54,7 @@ setup_mix() -> ElixirBin = filename:join([SmokeDir,"elixir","bin"]), PATH = ElixirBin ++ ":" ++ os:getenv("PATH"), os:putenv("PATH", PATH), + mix("local.hex --force"), mix("local.rebar --force"), ok. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index ab8caa1a0d..4fba3fa1c6 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1595,8 +1595,11 @@ infer_types(_, #vst{}) -> infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> fun({atom,true}, S) -> - Infer = infer_types(RHS, S), - Infer(LHS, S); + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, S), + Infer_R = infer_types(LHS, S), + Infer_R(RHS, Infer_L(LHS, S)); (_, S) -> S end; infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> @@ -1772,8 +1775,11 @@ update_ne_types(LHS, RHS, Vst) -> end. update_eq_types(LHS, RHS, Vst0) -> - Infer = infer_types(LHS, Vst0), - Vst1 = Infer(RHS, Vst0), + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, Vst0), + Infer_R = infer_types(LHS, Vst0), + Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), T1 = get_term_type(LHS, Vst1), T2 = get_term_type(RHS, Vst1), diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 9380fe06c8..8e3b373d29 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -84,9 +84,16 @@ coverage(_) -> {'EXIT',{function_clause, [{?MODULE,fc,[y],[File,{line,2}]}|_]}} = (catch fc(y)), - {'EXIT',{function_clause, - [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} = - (catch fc([a,b,c])), + case ?MODULE of + beam_except_no_opt_SUITE -> + %% There will be a different stack fram in + %% unoptimized code. + ok; + _ -> + {'EXIT',{function_clause, + [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} = + (catch fc([a,b,c])) + end, {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} = (catch erlang:error(a, b, c)), diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 8b39fce479..de5a3c2873 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -34,7 +34,8 @@ undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, - receive_stacked/1,aliased_types/1,type_conflict/1]). + receive_stacked/1,aliased_types/1,type_conflict/1, + infer_on_eq/1]). -include_lib("common_test/include/ct.hrl"). @@ -63,7 +64,8 @@ groups() -> undef_label,illegal_instruction,failing_gc_guard_bif, map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, - receive_stacked,aliased_types,type_conflict]}]. + receive_stacked,aliased_types,type_conflict, + infer_on_eq]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -651,6 +653,32 @@ type_conflict_1(C) -> end, {C#r.e1, TRes}. +%% ERL-886; validation failed to infer types on both sides of '=:=' + +infer_on_eq(Config) when is_list(Config) -> + {ok, gurka} = infer_on_eq_1(id({gurka})), + {ok, gaffel} = infer_on_eq_2(id({gaffel})), + {ok, elefant} = infer_on_eq_3(id({elefant})), + {ok, myra} = infer_on_eq_4(id({myra})), + ok. + +infer_on_eq_1(T) -> + 1 = erlang:tuple_size(T), + {ok, erlang:element(1, T)}. + +infer_on_eq_2(T) -> + Size = erlang:tuple_size(T), + Size = 1, + {ok, erlang:element(1, T)}. + +infer_on_eq_3(T) -> + true = 1 =:= erlang:tuple_size(T), + {ok, erlang:element(1, T)}. + +infer_on_eq_4(T) -> + true = erlang:tuple_size(T) =:= 1, + {ok, erlang:element(1, T)}. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index e1e7f71538..b6a65d7488 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -77,9 +77,7 @@ CRYPTO_OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o \ $(OBJDIR)/algorithms$(TYPEMARKER).o \ $(OBJDIR)/api_ng$(TYPEMARKER).o \ $(OBJDIR)/atoms$(TYPEMARKER).o \ - $(OBJDIR)/block$(TYPEMARKER).o \ $(OBJDIR)/bn$(TYPEMARKER).o \ - $(OBJDIR)/chacha20$(TYPEMARKER).o \ $(OBJDIR)/cipher$(TYPEMARKER).o \ $(OBJDIR)/cmac$(TYPEMARKER).o \ $(OBJDIR)/dh$(TYPEMARKER).o \ @@ -98,7 +96,6 @@ CRYPTO_OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o \ $(OBJDIR)/pkey$(TYPEMARKER).o \ $(OBJDIR)/poly1305$(TYPEMARKER).o \ $(OBJDIR)/rand$(TYPEMARKER).o \ - $(OBJDIR)/rc4$(TYPEMARKER).o \ $(OBJDIR)/rsa$(TYPEMARKER).o \ $(OBJDIR)/srp$(TYPEMARKER).o CALLBACK_OBJS = $(OBJDIR)/crypto_callback$(TYPEMARKER).o diff --git a/lib/crypto/c_src/aes.c b/lib/crypto/c_src/aes.c index ee2bb70fb7..4b01e629f9 100644 --- a/lib/crypto/c_src/aes.c +++ b/lib/crypto/c_src/aes.c @@ -166,156 +166,7 @@ ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv } -#ifdef HAVE_EVP_AES_CTR -ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec) */ - ErlNifBinary key_bin, ivec_bin; - struct evp_cipher_ctx *ctx = NULL; - const EVP_CIPHER *cipher; - ERL_NIF_TERM ret; - - ASSERT(argc == 2); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) - goto bad_arg; - if (!enif_inspect_binary(env, argv[1], &ivec_bin)) - goto bad_arg; - if (ivec_bin.size != 16) - goto bad_arg; - - switch (key_bin.size) - { - case 16: - cipher = EVP_aes_128_ctr(); - break; - case 24: - cipher = EVP_aes_192_ctr(); - break; - case 32: - cipher = EVP_aes_256_ctr(); - break; - default: - goto bad_arg; - } - - if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL, - key_bin.data, ivec_bin.data, 1) != 1) - goto err; - - if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1) - goto err; - - ret = enif_make_resource(env, ctx); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (ctx) - enif_release_resource(ctx); - return ret; -} - -ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) */ - struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL; - ErlNifBinary data_bin; - ERL_NIF_TERM ret, cipher_term; - unsigned char *out; - int outl = 0; - - ASSERT(argc == 2); - - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) - goto bad_arg; - if (data_bin.size > INT_MAX) - goto bad_arg; - - if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) - goto err; - - if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL) - goto err; - - if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1) - goto err; - ASSERT(outl >= 0 && (size_t)outl == data_bin.size); - - ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); - CONSUME_REDS(env,data_bin); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (new_ctx) - enif_release_resource(new_ctx); - return ret; -} - -#else /* if not HAVE_EVP_AES_CTR */ - -ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec) */ - ASSERT(argc == 2); - - return aes_ctr_stream_init_compat(env, argv[0], argv[1]); -} - - -ERL_NIF_TERM aes_ctr_stream_init_compat(ErlNifEnv* env, const ERL_NIF_TERM key_term, const ERL_NIF_TERM iv_term) -{ - ErlNifBinary key_bin, ivec_bin; - ERL_NIF_TERM ecount_bin; - unsigned char *outp; - - if (!enif_inspect_iolist_as_binary(env, key_term, &key_bin)) - goto bad_arg; - if (key_bin.size != 16 && key_bin.size != 24 && key_bin.size != 32) - goto bad_arg; - if (!enif_inspect_binary(env, iv_term, &ivec_bin)) - goto bad_arg; - if (ivec_bin.size != 16) - goto bad_arg; - if ((outp = enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin)) == NULL) - goto err; - memset(outp, 0, AES_BLOCK_SIZE); - - return enif_make_tuple4(env, key_term, iv_term, ecount_bin, enif_make_int(env, 0)); - - bad_arg: - err: - return enif_make_badarg(env); -} - -ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{ - ASSERT(argc == 2); - - return aes_ctr_stream_encrypt_compat(env, argv[0], argv[1]); -} - - +#if !defined(HAVE_EVP_AES_CTR) ERL_NIF_TERM aes_ctr_stream_encrypt_compat(ErlNifEnv* env, const ERL_NIF_TERM state_arg, const ERL_NIF_TERM data_arg) {/* ({Key, IVec, ECount, Num}, Data) */ ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin; diff --git a/lib/crypto/c_src/aes.h b/lib/crypto/c_src/aes.h index 527d041410..c0b2b91f8d 100644 --- a/lib/crypto/c_src/aes.h +++ b/lib/crypto/c_src/aes.h @@ -27,10 +27,7 @@ ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #if !defined(HAVE_EVP_AES_CTR) -ERL_NIF_TERM aes_ctr_stream_init_compat(ErlNifEnv* env, const ERL_NIF_TERM key_term, const ERL_NIF_TERM iv_term); ERL_NIF_TERM aes_ctr_stream_encrypt_compat(ErlNifEnv* env, const ERL_NIF_TERM state_arg, const ERL_NIF_TERM data_arg); #endif diff --git a/lib/crypto/c_src/api_ng.c b/lib/crypto/c_src/api_ng.c index c4114d1626..6a833a0984 100644 --- a/lib/crypto/c_src/api_ng.c +++ b/lib/crypto/c_src/api_ng.c @@ -25,199 +25,532 @@ /* * A unified set of functions for encryption/decryption. * - * EXPERIMENTAL!! - * */ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -/* Try better error messages in new functions */ -#define ERROR_Term(Env, ReasonTerm) enif_make_tuple2((Env), atom_error, (ReasonTerm)) -#define ERROR_Str(Env, ReasonString) ERROR_Term((Env), enif_make_string((Env),(ReasonString),(ERL_NIF_LATIN1))) +/* All nif functions return a valid value or throws an exception */ +#define EXCP(Env, Class, Str) enif_raise_exception((Env), \ + enif_make_tuple2((Env), (Class), \ + enif_make_string((Env),(Str),(ERL_NIF_LATIN1)) )) -/* Initializes state for (de)encryption - */ -ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Cipher, Key, IVec, Encrypt) % if no IV for the Cipher, set IVec = <<>> - */ - ErlNifBinary key_bin, ivec_bin; - unsigned char *iv = NULL; - struct evp_cipher_ctx *ctx; - const struct cipher_type_t *cipherp; - const EVP_CIPHER *cipher; - ERL_NIF_TERM enc_flg_arg, ret; - int enc; - unsigned iv_len; - - enc_flg_arg = argv[argc-1]; - if (enc_flg_arg == atom_true) - enc = 1; - else if (enc_flg_arg == atom_false) - enc = 0; - else if (enc_flg_arg == atom_undefined) +#define EXCP_NOTSUP(Env, Str) EXCP((Env), atom_notsup, (Str)) +#define EXCP_BADARG(Env, Str) EXCP((Env), atom_badarg, (Str)) +#define EXCP_ERROR(Env, Str) EXCP((Env), atom_error, (Str)) + + +#ifdef HAVE_ECB_IVEC_BUG + /* <= 0.9.8l returns faulty ivec length */ +# define GET_IV_LEN(Ciph) ((Ciph)->flags & ECB_BUG_0_9_8L) ? 0 : EVP_CIPHER_iv_length((Ciph)->cipher.p) +#else +# define GET_IV_LEN(Ciph) EVP_CIPHER_iv_length((Ciph)->cipher.p) +#endif + +/*************************************************************************/ +/* Get the arguments for the initialization of the EVP_CIPHER_CTX. Check */ +/* them and initialize that context. */ +/*************************************************************************/ +static int get_init_args(ErlNifEnv* env, + struct evp_cipher_ctx *ctx_res, + const ERL_NIF_TERM cipher_arg, + const ERL_NIF_TERM key_arg, + const ERL_NIF_TERM ivec_arg, + const ERL_NIF_TERM encflg_arg, + const struct cipher_type_t **cipherp, + ERL_NIF_TERM *return_term) +{ + int ivec_len; + ErlNifBinary key_bin; + ErlNifBinary ivec_bin; + int encflg; + + ctx_res->ctx = NULL; /* For testing if *ctx should be freed after errors */ + + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ + if (encflg_arg == atom_true) + encflg = 1; + else if (encflg_arg == atom_false) + encflg = 0; + else if (encflg_arg == atom_undefined) /* For compat funcs in crypto.erl */ - enc = -1; + encflg = -1; else - return ERROR_Str(env, "Bad enc flag"); + { + *return_term = EXCP_BADARG(env, "Bad enc flag"); + goto err; + } - if (!enif_inspect_binary(env, argv[1], &key_bin)) - return ERROR_Str(env, "Bad key"); + /* Fetch the key */ + if (!enif_inspect_iolist_as_binary(env, key_arg, &key_bin)) + { + *return_term = EXCP_BADARG(env, "Bad key"); + goto err; + } - if (!(cipherp = get_cipher_type(argv[0], key_bin.size))) - return ERROR_Str(env, "Unknown cipher or bad key size"); + /* Fetch cipher type */ + if (!enif_is_atom(env, cipher_arg)) + { + *return_term = EXCP_BADARG(env, "Cipher id is not an atom"); + goto err; + } - if (FORBIDDEN_IN_FIPS(cipherp)) - return enif_raise_exception(env, atom_notsup); + if (!(*cipherp = get_cipher_type(cipher_arg, key_bin.size))) + { + if (!get_cipher_type_no_key(cipher_arg)) + *return_term = EXCP_BADARG(env, "Unknown cipher"); + else + *return_term = EXCP_BADARG(env, "Bad key size"); + goto err; + } - if (enc == -1) - return atom_undefined; + if (FORBIDDEN_IN_FIPS(*cipherp)) + { + *return_term = EXCP_NOTSUP(env, "Forbidden in FIPS"); + goto err; + } - if (!(cipher = cipherp->cipher.p)) { + /* Get ivec_len for this cipher (if we found one) */ #if !defined(HAVE_EVP_AES_CTR) - if (cipherp->flags & AES_CTR_COMPAT) - return aes_ctr_stream_init_compat(env, argv[1], argv[2]); - else + /* This code is for historic OpenSSL where EVP_aes_*_ctr is not defined.... */ + if ((*cipherp)->cipher.p) { + /* Not aes_ctr compatibility code since EVP_* + was defined and assigned to (*cipherp)->cipher.p */ + ivec_len = GET_IV_LEN(*cipherp); + } else { + /* No EVP_* was found */ + if ((*cipherp)->flags & AES_CTR_COMPAT) + /* Use aes_ctr compatibility code later */ + ivec_len = 16; + else { + /* Unsupported crypto */ + *return_term = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); + goto err; + } + } +#else + /* Normal code */ + if (!((*cipherp)->cipher.p)) { + *return_term = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); + goto err; + } + ivec_len = GET_IV_LEN(*cipherp); #endif - return enif_raise_exception(env, atom_notsup); + + /* (*cipherp)->cipher.p != NULL and ivec_len has a value */ + + /* Fetch IV */ + if (ivec_len && (ivec_arg != atom_undefined)) { + if (!enif_inspect_iolist_as_binary(env, ivec_arg, &ivec_bin)) + { + *return_term = EXCP_BADARG(env, "Bad iv type"); + goto err; + } + + if (ivec_len != ivec_bin.size) + { + *return_term = EXCP_BADARG(env, "Bad iv size"); + goto err; + } } -#ifdef HAVE_ECB_IVEC_BUG - if (cipherp->flags & ECB_BUG_0_9_8L) - iv_len = 0; /* <= 0.9.8l returns faulty ivec length */ - else + ctx_res->iv_len = ivec_len; + +#if !defined(HAVE_EVP_AES_CTR) + if (!((*cipherp)->cipher.p) + && ((*cipherp)->flags & AES_CTR_COMPAT) + ) { + /* Must use aes_ctr compatibility code */ + ERL_NIF_TERM ecount_bin; + unsigned char *outp; + if ((outp = enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin)) == NULL) { + *return_term = EXCP_ERROR(env, "Can't allocate ecount_bin"); + goto err; + } + memset(outp, 0, AES_BLOCK_SIZE); + + ctx_res->env = enif_alloc_env(); + if (!ctx_res->env) { + *return_term = EXCP_ERROR(env, "Can't allocate env"); + goto err; + } + ctx_res->state = + enif_make_copy(ctx_res->env, + enif_make_tuple4(env, key_arg, ivec_arg, ecount_bin, enif_make_int(env, 0))); + goto success; + } else { + /* Flag for subsequent calls that no aes_ctr compatibility code should be called */ + ctx_res->state = atom_undefined; + ctx_res->env = NULL; + } #endif - iv_len = EVP_CIPHER_iv_length(cipher); - if (iv_len) { - if (!enif_inspect_binary(env, argv[2], &ivec_bin)) - return ERROR_Str(env, "Bad iv type"); + /* Initialize the EVP_CIPHER_CTX */ - if (iv_len != ivec_bin.size) - return ERROR_Str(env, "Bad iv size"); + ctx_res->ctx = EVP_CIPHER_CTX_new(); + if (! ctx_res->ctx) + { + *return_term = EXCP_ERROR(env, "Can't allocate context"); + goto err; + } - iv = ivec_bin.data; - } + if (!EVP_CipherInit_ex(ctx_res->ctx, (*cipherp)->cipher.p, NULL, NULL, NULL, encflg)) + { + *return_term = EXCP_ERROR(env, "Can't initialize context, step 1"); + goto err; + } - if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - return ERROR_Str(env, "Can't allocate resource"); + if (!EVP_CIPHER_CTX_set_key_length(ctx_res->ctx, (int)key_bin.size)) + { + *return_term = EXCP_ERROR(env, "Can't initialize context, key_length"); + goto err; + } - ctx->ctx = EVP_CIPHER_CTX_new(); - if (! ctx->ctx) - return ERROR_Str(env, "Can't allocate context"); - if (!EVP_CipherInit_ex(ctx->ctx, cipher, NULL, NULL, NULL, enc)) { - enif_release_resource(ctx); - return ERROR_Str(env, "Can't initialize context, step 1"); + if (EVP_CIPHER_type((*cipherp)->cipher.p) == NID_rc2_cbc) { + if (key_bin.size > INT_MAX / 8) { + *return_term = EXCP_BADARG(env, "To large rc2_cbc key"); + goto err; + } + if (!EVP_CIPHER_CTX_ctrl(ctx_res->ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key_bin.size * 8, NULL)) { + *return_term = EXCP_ERROR(env, "ctrl rc2_cbc key"); + goto err; + } } - if (!EVP_CIPHER_CTX_set_key_length(ctx->ctx, (int)key_bin.size)) { - enif_release_resource(ctx); - return ERROR_Str(env, "Can't initialize context, key_length"); - } + if (ivec_arg == atom_undefined || ivec_len == 0) + { + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, key_bin.data, NULL, -1)) { + *return_term = EXCP_ERROR(env, "Can't initialize key"); + goto err; + } + } + else + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, key_bin.data, ivec_bin.data, -1)) + { + *return_term = EXCP_ERROR(env, "Can't initialize key or iv"); + goto err; + } - if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) { - if (key_bin.size > INT_MAX / 8) { - enif_release_resource(ctx); - return ERROR_Str(env, "To large rc2_cbc key"); + EVP_CIPHER_CTX_set_padding(ctx_res->ctx, 0); + + *return_term = atom_ok; + +#if !defined(HAVE_EVP_AES_CTR) + success: +#endif + return 1; + + err: + if (ctx_res->ctx) EVP_CIPHER_CTX_free(ctx_res->ctx); + return 0; +} + +/*************************************************************************/ +/* Get the arguments for the EVP_CipherUpdate function, and call it. */ +/*************************************************************************/ + +static int get_update_args(ErlNifEnv* env, + struct evp_cipher_ctx *ctx_res, + const ERL_NIF_TERM indata_arg, + ERL_NIF_TERM *return_term) +{ + ErlNifBinary in_data_bin, out_data_bin; + int out_len, block_size; + + if (!enif_inspect_binary(env, indata_arg, &in_data_bin) ) + { + *return_term = EXCP_BADARG(env, "Bad 2:nd arg"); + goto err; } - if (!EVP_CIPHER_CTX_ctrl(ctx->ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key_bin.size * 8, NULL)) { - enif_release_resource(ctx); - return ERROR_Str(env, "ctrl rc2_cbc key"); + + ASSERT(in_data_bin.size <= INT_MAX); + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res->state != atom_undefined) { + ERL_NIF_TERM state0, newstate_and_outdata; + const ERL_NIF_TERM *tuple_argv; + int tuple_argc; + + state0 = enif_make_copy(env, ctx_res->state); + + if (enif_get_tuple(env, state0, &tuple_argc, &tuple_argv) && (tuple_argc == 4)) { + /* A compatibility state term */ + /* encrypt and decrypt is performed by calling the same function */ + newstate_and_outdata = aes_ctr_stream_encrypt_compat(env, state0, indata_arg); + + if (enif_get_tuple(env, newstate_and_outdata, &tuple_argc, &tuple_argv) && (tuple_argc == 2)) { + /* newstate_and_outdata = {NewState, OutData} */ + ctx_res->state = enif_make_copy(ctx_res->env, tuple_argv[0]); + /* Return the OutData (from the newstate_and_outdata tuple) only: */ + *return_term = tuple_argv[1]; + } } + } else +#endif + { + block_size = EVP_CIPHER_CTX_block_size(ctx_res->ctx); + + if (!enif_alloc_binary((size_t)in_data_bin.size+block_size, &out_data_bin)) + { + *return_term = EXCP_ERROR(env, "Can't allocate outdata"); + goto err; + } + + if (!EVP_CipherUpdate(ctx_res->ctx, out_data_bin.data, &out_len, in_data_bin.data, in_data_bin.size)) + { + *return_term = EXCP_ERROR(env, "Can't update"); + goto err; + } + + if (!enif_realloc_binary(&out_data_bin, (size_t)out_len)) + { + *return_term = EXCP_ERROR(env, "Can't reallocate"); + goto err; + } + + CONSUME_REDS(env, in_data_bin); + /* return the result text as a binary: */ + *return_term = enif_make_binary(env, &out_data_bin); } - if (!EVP_CipherInit_ex(ctx->ctx, NULL, NULL, key_bin.data, iv, enc)) { - enif_release_resource(ctx); - return ERROR_Str(env, "Can't initialize key and/or iv"); - } + /* success: */ + return 1; - EVP_CIPHER_CTX_set_padding(ctx->ctx, 0); + err: + return 0; +} - ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); +/*************************************************************************/ +/* Initialize the state for (de/en)cryption */ +/*************************************************************************/ + +ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Cipher, Key, IVec, Encrypt) % if no IV for the Cipher, set IVec = <<>> + */ + struct evp_cipher_ctx *ctx_res = NULL; + const struct cipher_type_t *cipherp; + ERL_NIF_TERM ret; + int encflg; + + if (enif_is_atom(env, argv[0])) { + if ((ctx_res = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) + return EXCP_ERROR(env, "Can't allocate resource"); + + if (!get_init_args(env, ctx_res, argv[0], argv[1], argv[2], argv[argc-1], + &cipherp, &ret)) + /* Error msg in &ret */ + goto ret; + + ret = enif_make_resource(env, ctx_res); + if(ctx_res) enif_release_resource(ctx_res); + + } else if (enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx_res)) { + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ + if (argv[3] == atom_true) + encflg = 1; + else if (argv[3] == atom_false) + encflg = 0; + else { + ret = EXCP_BADARG(env, "Bad enc flag"); + goto ret; + } + if (ctx_res->ctx) { + /* It is *not* a ctx_res for the compatibility handling of non-EVP aes_ctr */ + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, NULL, NULL, encflg)) { + ret = EXCP_ERROR(env, "Can't initialize encflag"); + goto ret; + } + } + ret = argv[0]; + } else { + ret = EXCP_BADARG(env, "Bad 1:st arg"); + goto ret; + } + + ret: return ret; } -ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) - (Context, Data, IV) */ - struct evp_cipher_ctx *ctx; - ErlNifBinary in_data_bin, ivec_bin, out_data_bin; - int out_len, block_size; -#if !defined(HAVE_EVP_AES_CTR) - const ERL_NIF_TERM *state_term; - int state_arity; +/*************************************************************************/ +/* Encrypt/decrypt */ +/*************************************************************************/ - if (enif_get_tuple(env, argv[0], &state_arity, &state_term) && (state_arity == 4)) { - return aes_ctr_stream_encrypt_compat(env, argv[0], argv[1]); - } +#if !defined(HAVE_EVP_CIPHER_CTX_COPY) +/* + The EVP_CIPHER_CTX_copy is not available in older cryptolibs although + the function is needed. + Instead of implement it in-place, we have a copy here as a compatibility + function +*/ + +int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in); + +int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in) +{ + if ((in == NULL) || (in->cipher == NULL)) + { + return 0; + } +#ifdef HAS_ENGINE_SUPPORT + /* Make sure it's safe to copy a cipher context using an ENGINE */ + if (in->engine && !ENGINE_init(in->engine)) + return 0; #endif - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) - return ERROR_Str(env, "Bad 1:st arg"); - - if (!enif_inspect_binary(env, argv[1], &in_data_bin) ) - return ERROR_Str(env, "Bad 2:nd arg"); + EVP_CIPHER_CTX_cleanup(out); + memcpy(out,in,sizeof *out); - /* arg[1] was checked by the caller */ - ASSERT(in_data_bin.size =< INT_MAX); + if (in->cipher_data && in->cipher->ctx_size) + { + out->cipher_data=OPENSSL_malloc(in->cipher->ctx_size); + if (!out->cipher_data) + return 0; + memcpy(out->cipher_data,in->cipher_data,in->cipher->ctx_size); + } - block_size = EVP_CIPHER_CTX_block_size(ctx->ctx); - if (in_data_bin.size % (size_t)block_size != 0) - return ERROR_Str(env, "Data not a multiple of block size"); +#if defined(EVP_CIPH_CUSTOM_COPY) && defined(EVP_CTRL_COPY) + if (in->cipher->flags & EVP_CIPH_CUSTOM_COPY) + return in->cipher->ctrl((EVP_CIPHER_CTX *)in, EVP_CTRL_COPY, 0, out); +#endif + return 1; +} +/****** End of compatibility function ******/ +#endif - if (argc==3) { - if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec_bin)) - return ERROR_Str(env, "Not binary IV"); - - if (ivec_bin.size > INT_MAX) - return ERROR_Str(env, "Too big IV"); - - if (!EVP_CipherInit_ex(ctx->ctx, NULL, NULL, NULL, ivec_bin.data, -1)) - return ERROR_Str(env, "Can't set IV"); - } - if (!enif_alloc_binary((size_t)in_data_bin.size+block_size, &out_data_bin)) - return ERROR_Str(env, "Can't allocate outdata"); +ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data [, IV]) */ + struct evp_cipher_ctx *ctx_res; + ERL_NIF_TERM ret; + + if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx_res)) + return EXCP_BADARG(env, "Bad 1:st arg"); + + if (argc == 3) { + struct evp_cipher_ctx ctx_res_copy; + ErlNifBinary ivec_bin; - if (!EVP_CipherUpdate(ctx->ctx, out_data_bin.data, &out_len, in_data_bin.data, in_data_bin.size)) - return ERROR_Str(env, "Can't update"); + memcpy(&ctx_res_copy, ctx_res, sizeof ctx_res_copy); +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res_copy.state == atom_undefined) + /* Not going to use aes_ctr compat functions */ +#endif + { + ctx_res_copy.ctx = EVP_CIPHER_CTX_new(); - if (!enif_realloc_binary(&out_data_bin, (size_t)out_len)) - return ERROR_Str(env, "Can't reallocate"); + if (!EVP_CIPHER_CTX_copy(ctx_res_copy.ctx, ctx_res->ctx)) { + ret = EXCP_ERROR(env, "Can't copy ctx_res"); + goto err; + } + } - CONSUME_REDS(env, in_data_bin); - return enif_make_binary(env, &out_data_bin); + ctx_res = &ctx_res_copy; + + if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec_bin)) + { + ret = EXCP_BADARG(env, "Bad iv type"); + goto err; + } + + if (ctx_res_copy.iv_len != ivec_bin.size) + { + ret = EXCP_BADARG(env, "Bad iv size"); + goto err; + } + +#if !defined(HAVE_EVP_AES_CTR) + if ((ctx_res_copy.state != atom_undefined) ) { + /* replace the iv in state with argv[2] */ + ERL_NIF_TERM state0; + const ERL_NIF_TERM *tuple_argv; + int tuple_argc; + state0 = enif_make_copy(env, ctx_res_copy.state); + if (enif_get_tuple(env, state0, &tuple_argc, &tuple_argv) && (tuple_argc == 4)) { + /* A compatibility state term */ + ctx_res_copy.state = enif_make_tuple4(env, tuple_argv[0], argv[2], tuple_argv[2], tuple_argv[3]); + } + } else +#endif + if (!EVP_CipherInit_ex(ctx_res_copy.ctx, NULL, NULL, NULL, ivec_bin.data, -1)) + { + ret = EXCP_ERROR(env, "Can't set iv"); + goto err; + } + + get_update_args(env, &ctx_res_copy, argv[1], &ret); + } else + get_update_args(env, ctx_res, argv[1], &ret); + + err: + return ret; /* Both success and error */ } ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Context, Data) - (Context, Data, IV) */ - int i; +{/* (Context, Data [, IV]) */ ErlNifBinary data_bin; - ERL_NIF_TERM new_argv[3]; - ASSERT(argc =< 3); + ASSERT(argc <= 3); - if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) - return ERROR_Str(env, "iodata expected as data"); + if (!enif_inspect_binary(env, argv[1], &data_bin)) + return EXCP_BADARG(env, "expected binary as data"); if (data_bin.size > INT_MAX) - return ERROR_Str(env, "to long data"); - - for (i=0; i<argc; i++) new_argv[i] = argv[i]; - new_argv[1] = enif_make_binary(env, &data_bin); + return EXCP_BADARG(env, "to long data"); /* Run long jobs on a dirty scheduler to not block the current emulator thread */ if (data_bin.size > MAX_BYTES_TO_NIF) { return enif_schedule_nif(env, "ng_crypto_update", ERL_NIF_DIRTY_JOB_CPU_BOUND, - ng_crypto_update, argc, new_argv); + ng_crypto_update, argc, argv); } - return ng_crypto_update(env, argc, new_argv); + return ng_crypto_update(env, argc, argv); +} + +/*************************************************************************/ +/* One shot */ +/*************************************************************************/ + +ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Cipher, Key, IVec, Data, Encrypt) */ + struct evp_cipher_ctx ctx_res; + const struct cipher_type_t *cipherp; + ERL_NIF_TERM ret; + + if (!get_init_args(env, &ctx_res, argv[0], argv[1], argv[2], argv[4], &cipherp, &ret)) + goto ret; + + get_update_args(env, &ctx_res, argv[3], &ret); + + ret: + if (ctx_res.ctx) + EVP_CIPHER_CTX_free(ctx_res.ctx); + return ret; } +ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Cipher, Key, IVec, Data, Encrypt) % if no IV for the Cipher, set IVec = <<>> + */ + ErlNifBinary data_bin; + + ASSERT(argc == 5); + + if (!enif_inspect_binary(env, argv[3], &data_bin)) + return EXCP_BADARG(env, "expected binary as data"); + + if (data_bin.size > INT_MAX) + return EXCP_BADARG(env, "to long data"); + + /* Run long jobs on a dirty scheduler to not block the current emulator thread */ + if (data_bin.size > MAX_BYTES_TO_NIF) { + return enif_schedule_nif(env, "ng_crypto_one_shot", + ERL_NIF_DIRTY_JOB_CPU_BOUND, + ng_crypto_one_shot, argc, argv); + } + + return ng_crypto_one_shot(env, argc, argv); +} diff --git a/lib/crypto/c_src/api_ng.h b/lib/crypto/c_src/api_ng.h index a3b40fe7fc..5c7d9af3c5 100644 --- a/lib/crypto/c_src/api_ng.h +++ b/lib/crypto/c_src/api_ng.h @@ -25,5 +25,6 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AES_H__ */ diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c index 798c26c9bb..114e3c1985 100644 --- a/lib/crypto/c_src/atoms.c +++ b/lib/crypto/c_src/atoms.c @@ -33,6 +33,7 @@ ERL_NIF_TERM atom_undefined; ERL_NIF_TERM atom_ok; ERL_NIF_TERM atom_none; ERL_NIF_TERM atom_notsup; +ERL_NIF_TERM atom_badarg; ERL_NIF_TERM atom_digest; #ifdef FIPS_SUPPORT ERL_NIF_TERM atom_enabled; @@ -150,6 +151,7 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM atom_ok = enif_make_atom(env,"ok"); atom_none = enif_make_atom(env,"none"); atom_notsup = enif_make_atom(env,"notsup"); + atom_badarg = enif_make_atom(env,"badarg"); atom_digest = enif_make_atom(env,"digest"); atom_type = enif_make_atom(env,"type"); diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h index f8e9211459..fc46d838aa 100644 --- a/lib/crypto/c_src/atoms.h +++ b/lib/crypto/c_src/atoms.h @@ -37,6 +37,7 @@ extern ERL_NIF_TERM atom_undefined; extern ERL_NIF_TERM atom_ok; extern ERL_NIF_TERM atom_none; extern ERL_NIF_TERM atom_notsup; +extern ERL_NIF_TERM atom_badarg; extern ERL_NIF_TERM atom_digest; #ifdef FIPS_SUPPORT extern ERL_NIF_TERM atom_enabled; diff --git a/lib/crypto/c_src/block.c b/lib/crypto/c_src/block.c deleted file mode 100644 index 0a4fd72623..0000000000 --- a/lib/crypto/c_src/block.c +++ /dev/null @@ -1,149 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include "block.h" -#include "aes.h" -#include "cipher.h" - -ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */ - const struct cipher_type_t *cipherp; - const EVP_CIPHER *cipher; - ErlNifBinary key, ivec, text; - EVP_CIPHER_CTX *ctx = NULL; - ERL_NIF_TERM ret; - unsigned char *out; - int ivec_size, out_size = 0; - int cipher_len; - - ASSERT(argc == 4 || argc == 5); - - if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) - goto bad_arg; - if (key.size > INT_MAX) - goto bad_arg; - if ((cipherp = get_cipher_type(argv[0], key.size)) == NULL) - goto bad_arg; - if (cipherp->flags & (NON_EVP_CIPHER | AEAD_CIPHER)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) - goto bad_arg; - if (text.size > INT_MAX) - goto bad_arg; - - if (FORBIDDEN_IN_FIPS(cipherp)) - return enif_raise_exception(env, atom_notsup); - if ((cipher = cipherp->cipher.p) == NULL) - return enif_raise_exception(env, atom_notsup); - - if (cipherp->flags & AES_CFBx) { - if (argv[0] == atom_aes_cfb8 - && (key.size == 24 || key.size == 32)) { - /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? - * Fall back on low level API - */ - return aes_cfb_8_crypt(env, argc-1, argv+1); - } - else if (argv[0] == atom_aes_cfb128 - && (key.size == 24 || key.size == 32)) { - /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes? - * Fall back on low level API - */ - return aes_cfb_128_crypt_nif(env, argc-1, argv+1); - } - } - - ivec_size = EVP_CIPHER_iv_length(cipher); - -#ifdef HAVE_ECB_IVEC_BUG - if (cipherp->flags & ECB_BUG_0_9_8L) - ivec_size = 0; /* 0.9.8l returns faulty ivec_size */ -#endif - - if (ivec_size < 0) - goto bad_arg; - - if ((cipher_len = EVP_CIPHER_block_size(cipher)) < 0) - goto bad_arg; - if (text.size % (size_t)cipher_len != 0) - goto bad_arg; - - if (ivec_size == 0) { - if (argc != 4) - goto bad_arg; - } else { - if (argc != 5) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec)) - goto bad_arg; - if (ivec.size != (size_t)ivec_size) - goto bad_arg; - } - - if ((out = enif_make_new_binary(env, text.size, &ret)) == NULL) - goto err; - if ((ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (!EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL, - (argv[argc - 1] == atom_true))) - goto err; - if (!EVP_CIPHER_CTX_set_key_length(ctx, (int)key.size)) - goto err; - - if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) { - if (key.size > INT_MAX / 8) - goto err; - if (!EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key.size * 8, NULL)) - goto err; - } - - if (!EVP_CipherInit_ex(ctx, NULL, NULL, key.data, - ivec_size ? ivec.data : NULL, -1)) - goto err; - if (!EVP_CIPHER_CTX_set_padding(ctx, 0)) - goto err; - - /* OpenSSL 0.9.8h asserts text.size > 0 */ - if (text.size > 0) { - if (!EVP_CipherUpdate(ctx, out, &out_size, text.data, (int)text.size)) - goto err; - if (ASSERT(out_size == text.size), 0) - goto err; - if (!EVP_CipherFinal_ex(ctx, out + out_size, &out_size)) - goto err; - } - - ASSERT(out_size == 0); - CONSUME_REDS(env, text); - goto done; - - bad_arg: - ret = enif_make_badarg(env); - goto done; - - err: - ret = enif_raise_exception(env, atom_notsup); - - done: - if (ctx) - EVP_CIPHER_CTX_free(ctx); - return ret; -} diff --git a/lib/crypto/c_src/block.h b/lib/crypto/c_src/block.h deleted file mode 100644 index cc5e78ce12..0000000000 --- a/lib/crypto/c_src/block.h +++ /dev/null @@ -1,28 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifndef E_BLOCK_H__ -#define E_BLOCK_H__ 1 - -#include "common.h" - -ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); - -#endif /* E_BLOCK_H__ */ diff --git a/lib/crypto/c_src/chacha20.c b/lib/crypto/c_src/chacha20.c deleted file mode 100644 index cfcc395dca..0000000000 --- a/lib/crypto/c_src/chacha20.c +++ /dev/null @@ -1,124 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include "chacha20.h" -#include "cipher.h" - -ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IV) */ -#if defined(HAVE_CHACHA20) - ErlNifBinary key_bin, ivec_bin; - struct evp_cipher_ctx *ctx = NULL; - const EVP_CIPHER *cipher; - ERL_NIF_TERM ret; - - ASSERT(argc == 2); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) - goto bad_arg; - if (key_bin.size != 32) - goto bad_arg; - if (!enif_inspect_binary(env, argv[1], &ivec_bin)) - goto bad_arg; - if (ivec_bin.size != 16) - goto bad_arg; - - cipher = EVP_chacha20(); - - if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL, - key_bin.data, ivec_bin.data, 1) != 1) - goto err; - if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1) - goto err; - - ret = enif_make_resource(env, ctx); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (ctx) - enif_release_resource(ctx); - return ret; - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - -ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (State, Data) */ -#if defined(HAVE_CHACHA20) - struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL; - ErlNifBinary data_bin; - ERL_NIF_TERM ret, cipher_term; - unsigned char *out; - int outl = 0; - - ASSERT(argc == 2); - - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) - goto bad_arg; - if (data_bin.size > INT_MAX) - goto bad_arg; - - if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) - goto err; - if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) - goto err; - - if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) - goto err; - if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL) - goto err; - if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1) - goto err; - ASSERT(outl >= 0 && (size_t)outl == data_bin.size); - - ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); - CONSUME_REDS(env, data_bin); - goto done; - - bad_arg: - return enif_make_badarg(env); - - err: - ret = enif_make_badarg(env); - - done: - if (new_ctx) - enif_release_resource(new_ctx); - return ret; - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} diff --git a/lib/crypto/c_src/chacha20.h b/lib/crypto/c_src/chacha20.h deleted file mode 100644 index 7e2ccae2bb..0000000000 --- a/lib/crypto/c_src/chacha20.h +++ /dev/null @@ -1,29 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifndef E_CHACHA20_H__ -#define E_CHACHA20_H__ 1 - -#include "common.h" - -ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); - -#endif /* E_CHACHA20_H__ */ diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c index c055a62654..5c57898c50 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -98,7 +98,9 @@ static struct cipher_type_t cipher_types[] = {{"aes_128_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, {{"aes_192_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, {{"aes_256_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 0, AES_CTR_COMPAT}, + {{"aes_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, + {{"aes_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, + {{"aes_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, #endif #if defined(HAVE_CHACHA20) @@ -162,6 +164,11 @@ static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) { if (ctx->ctx) EVP_CIPHER_CTX_free(ctx->ctx); + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx->env) + enif_free_env(ctx->env); +#endif } int init_cipher_ctx(ErlNifEnv *env) { diff --git a/lib/crypto/c_src/cipher.h b/lib/crypto/c_src/cipher.h index b0d9d324e1..b94873940f 100644 --- a/lib/crypto/c_src/cipher.h +++ b/lib/crypto/c_src/cipher.h @@ -59,6 +59,11 @@ struct cipher_type_t { extern ErlNifResourceType* evp_cipher_ctx_rtype; struct evp_cipher_ctx { EVP_CIPHER_CTX* ctx; + int iv_len; +#if !defined(HAVE_EVP_AES_CTR) + ErlNifEnv* env; + ERL_NIF_TERM state; +#endif }; ERL_NIF_TERM cipher_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 261590d9a5..4aed06a489 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -29,9 +29,7 @@ #include "aes.h" #include "algorithms.h" #include "api_ng.h" -#include "block.h" #include "bn.h" -#include "chacha20.h" #include "cipher.h" #include "cmac.h" #include "dh.h" @@ -50,7 +48,6 @@ #include "pkey.h" #include "poly1305.h" #include "rand.h" -#include "rc4.h" #include "rsa.h" #include "srp.h" @@ -80,22 +77,16 @@ static ErlNifFunc nif_funcs[] = { {"hmac_final_nif", 2, hmac_final_nif, 0}, {"cmac_nif", 3, cmac_nif, 0}, {"cipher_info_nif", 1, cipher_info_nif, 0}, - {"block_crypt_nif", 5, block_crypt_nif, 0}, - {"block_crypt_nif", 4, block_crypt_nif, 0}, {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif, 0}, - {"aes_ctr_stream_init", 2, aes_ctr_stream_init, 0}, - {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt, 0}, - {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt, 0}, {"ng_crypto_init_nif", 4, ng_crypto_init_nif, 0}, {"ng_crypto_update_nif", 2, ng_crypto_update_nif, 0}, {"ng_crypto_update_nif", 3, ng_crypto_update_nif, 0}, + {"ng_crypto_one_shot_nif", 5, ng_crypto_one_shot_nif, 0}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0}, {"strong_rand_range_nif", 1, strong_rand_range_nif, 0}, {"rand_uniform_nif", 2, rand_uniform_nif, 0}, {"mod_exp_nif", 4, mod_exp_nif, 0}, {"do_exor", 2, do_exor, 0}, - {"rc4_set_key", 1, rc4_set_key, 0}, - {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state, 0}, {"pkey_sign_nif", 5, pkey_sign_nif, 0}, {"pkey_verify_nif", 6, pkey_verify_nif, 0}, {"pkey_crypt_nif", 6, pkey_crypt_nif, 0}, @@ -117,10 +108,6 @@ static ErlNifFunc nif_funcs[] = { {"aead_encrypt", 6, aead_encrypt, 0}, {"aead_decrypt", 6, aead_decrypt, 0}, - {"chacha20_stream_init", 2, chacha20_stream_init, 0}, - {"chacha20_stream_encrypt", 2, chacha20_stream_crypt, 0}, - {"chacha20_stream_decrypt", 2, chacha20_stream_crypt, 0}, - {"poly1305_nif", 2, poly1305_nif, 0}, {"engine_by_id_nif", 1, engine_by_id_nif, 0}, diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h index 45144a0c25..46868cb987 100644 --- a/lib/crypto/c_src/openssl_config.h +++ b/lib/crypto/c_src/openssl_config.h @@ -109,6 +109,7 @@ #ifndef HAS_LIBRESSL # if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) # define HAS_EVP_PKEY_CTX +# define HAVE_EVP_CIPHER_CTX_COPY # endif #endif @@ -203,12 +204,17 @@ #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0) # ifndef HAS_LIBRESSL -# define HAVE_CHACHA20 # define HAVE_CHACHA20_POLY1305 # define HAVE_RSA_OAEP_MD # endif #endif +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(1,1,0,'d') +# ifndef HAS_LIBRESSL +# define HAVE_CHACHA20 +# endif +#endif + // OPENSSL_VERSION_NUMBER >= 1.1.1-pre8 #if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1)-7) # ifndef HAS_LIBRESSL diff --git a/lib/crypto/c_src/pkey.c b/lib/crypto/c_src/pkey.c index 393358d173..638bb588fa 100644 --- a/lib/crypto/c_src/pkey.c +++ b/lib/crypto/c_src/pkey.c @@ -719,6 +719,11 @@ enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf); if (pkey) EVP_PKEY_free(pkey); +#ifdef HAVE_EDDSA + if (mdctx) + EVP_MD_CTX_free(mdctx); +#endif + return ret; } diff --git a/lib/crypto/c_src/poly1305.c b/lib/crypto/c_src/poly1305.c index db3433dce3..76579c0a29 100644 --- a/lib/crypto/c_src/poly1305.c +++ b/lib/crypto/c_src/poly1305.c @@ -85,6 +85,6 @@ ERL_NIF_TERM poly1305_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return ret; #else - return atom_notsup; + return enif_raise_exception(env, atom_notsup); #endif } diff --git a/lib/crypto/c_src/rc4.c b/lib/crypto/c_src/rc4.c deleted file mode 100644 index e423661097..0000000000 --- a/lib/crypto/c_src/rc4.c +++ /dev/null @@ -1,92 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include "rc4.h" - -ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key) */ -#ifndef OPENSSL_NO_RC4 - ErlNifBinary key; - ERL_NIF_TERM ret; - RC4_KEY *rc4_key; - - CHECK_NO_FIPS_MODE(); - - ASSERT(argc == 1); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key)) - goto bad_arg; - if (key.size > INT_MAX) - goto bad_arg; - - if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret)) == NULL) - goto err; - - RC4_set_key(rc4_key, (int)key.size, key.data); - return ret; - - bad_arg: - err: - return enif_make_badarg(env); - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - -ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (State, Data) */ -#ifndef OPENSSL_NO_RC4 - ErlNifBinary state, data; - RC4_KEY* rc4_key; - ERL_NIF_TERM new_state, new_data; - unsigned char *outp; - - CHECK_NO_FIPS_MODE(); - - ASSERT(argc == 2); - - if (!enif_inspect_iolist_as_binary(env, argv[0], &state)) - goto bad_arg; - if (state.size != sizeof(RC4_KEY)) - goto bad_arg; - if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) - goto bad_arg; - - if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state)) == NULL) - goto err; - if ((outp = enif_make_new_binary(env, data.size, &new_data)) == NULL) - goto err; - - memcpy(rc4_key, state.data, sizeof(RC4_KEY)); - RC4(rc4_key, data.size, data.data, outp); - - CONSUME_REDS(env, data); - return enif_make_tuple2(env, new_state, new_data); - - bad_arg: - err: - return enif_make_badarg(env); - -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - diff --git a/lib/crypto/c_src/rc4.h b/lib/crypto/c_src/rc4.h deleted file mode 100644 index 28bf674253..0000000000 --- a/lib/crypto/c_src/rc4.h +++ /dev/null @@ -1,29 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifndef E_RC4_H__ -#define E_RC4_H__ 1 - -#include "common.h" - -ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); - -#endif /* E_RC4_H__ */ diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 97a4a7a3f0..5cf34f8069 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -40,24 +40,27 @@ -export([rand_plugin_uniform/2]). -export([rand_cache_plugin_next/1]). -export([rand_uniform/2]). --export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]). -export([next_iv/2, next_iv/3]). --export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2]). -export([public_encrypt/4, private_decrypt/4]). -export([private_encrypt/4, public_decrypt/4]). -export([privkey_to_pubkey/2]). -export([ec_curve/1, ec_curves/0]). -export([rand_seed/1]). -%% Experiment --export([crypto_init/4, - crypto_update/2, crypto_update/3, - %% Emulates old api: - crypto_stream_init/2, crypto_stream_init/3, - crypto_stream_encrypt/2, - crypto_stream_decrypt/2, - crypto_block_encrypt/3, crypto_block_encrypt/4, - crypto_block_decrypt/3, crypto_block_decrypt/4 +%% Old interface. Now implemented with the New interface +-export([stream_init/2, stream_init/3, + stream_encrypt/2, + stream_decrypt/2, + block_encrypt/3, block_encrypt/4, + block_decrypt/3, block_decrypt/4 + ]). + +%% New interface +-export([crypto_init/4, crypto_init/3, + crypto_update/2, + crypto_one_shot/5, + crypto_init_dyn_iv/3, + crypto_update_dyn_iv/3 ]). @@ -533,10 +536,17 @@ poly1305(Key, Data) -> %%%================================================================ %%% -%%% Encrypt/decrypt +%%% Encrypt/decrypt, The "Old API" %%% %%%================================================================ +-define(COMPAT(CALL), + try CALL + catch + error:{E,_Reason} when E==notsup ; E==badarg -> + error(E) + end). + -spec cipher_info(Type) -> map() when Type :: block_cipher_with_iv() | aead_cipher() | block_cipher_without_iv(). @@ -544,7 +554,6 @@ cipher_info(Type) -> cipher_info_nif(Type). %%%---- Block ciphers - %%%---------------------------------------------------------------- -spec block_encrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> binary(); (Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), PlainText::iodata()}) -> @@ -556,11 +565,6 @@ cipher_info(Type) -> block_encrypt(Type, Key, Ivec, Data) -> do_block_encrypt(alias(Type), Key, Ivec, Data). -do_block_encrypt(Type, Key0, Ivec, Data) when Type =:= des_ede3_cbc; - Type =:= des_ede3_cfb -> - Key = check_des3_key(Key0), - block_crypt_nif(Type, Key, Ivec, Data, true); - do_block_encrypt(Type, Key, Ivec, PlainText) when Type =:= aes_ige256 -> notsup_to_error(aes_ige_crypt_nif(Key, Ivec, PlainText, true)); @@ -577,14 +581,13 @@ do_block_encrypt(Type, Key, Ivec, Data) when Type =:= aes_gcm; end; do_block_encrypt(Type, Key, Ivec, PlainText) -> - block_crypt_nif(Type, Key, Ivec, PlainText, true). - + ?COMPAT(crypto_one_shot(Type, Key, Ivec, PlainText, true)). -spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> binary(). block_encrypt(Type, Key, PlainText) -> - block_crypt_nif(alias(Type), Key, PlainText, true). + ?COMPAT(crypto_one_shot(Type, Key, <<>>, PlainText, true)). %%%---------------------------------------------------------------- %%%---------------------------------------------------------------- @@ -595,11 +598,6 @@ block_encrypt(Type, Key, PlainText) -> block_decrypt(Type, Key, Ivec, Data) -> do_block_decrypt(alias(Type), Key, Ivec, Data). -do_block_decrypt(Type, Key0, Ivec, Data) when Type =:= des_ede3_cbc; - Type =:= des_ede3_cfb -> - Key = check_des3_key(Key0), - block_crypt_nif(Type, Key, Ivec, Data, false); - do_block_decrypt(aes_ige256, Key, Ivec, Data) -> notsup_to_error(aes_ige_crypt_nif(Key, Ivec, Data, false)); @@ -609,14 +607,80 @@ do_block_decrypt(Type, Key, Ivec, {AAD, Data, Tag}) when Type =:= aes_gcm; aead_decrypt(Type, Key, Ivec, AAD, Data, Tag); do_block_decrypt(Type, Key, Ivec, Data) -> - block_crypt_nif(Type, Key, Ivec, Data, false). - + ?COMPAT(crypto_one_shot(Type, Key, Ivec, Data, false)). -spec block_decrypt(Type::block_cipher_without_iv(), Key::key(), Data::iodata()) -> binary(). block_decrypt(Type, Key, Data) -> - block_crypt_nif(alias(Type), Key, Data, false). + ?COMPAT(crypto_one_shot(Type, Key, <<>>, Data, false)). + +%%%-------- Stream ciphers API + +-opaque stream_state() :: {stream_cipher(), + crypto_state() | {crypto_state(),flg_undefined} + }. + +-type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() . +-type stream_cipher_no_iv() :: rc4 . +-type stream_cipher_iv() :: aes_ctr + | aes_128_ctr + | aes_192_ctr + | aes_256_ctr + | chacha20 . + +%%%---- stream_init +-spec stream_init(Type, Key, IVec) -> State | no_return() + when Type :: stream_cipher_iv(), + Key :: iodata(), + IVec ::binary(), + State :: stream_state() . +stream_init(Type, Key, IVec) when is_binary(IVec) -> + Ref = ?COMPAT(ng_crypto_init_nif(alias(Type), + iolist_to_binary(Key), iolist_to_binary(IVec), + undefined) + ), + {Type, {Ref,flg_undefined}}. + + +-spec stream_init(Type, Key) -> State | no_return() + when Type :: stream_cipher_no_iv(), + Key :: iodata(), + State :: stream_state() . +stream_init(rc4 = Type, Key) -> + Ref = ?COMPAT(ng_crypto_init_nif(alias(Type), + iolist_to_binary(Key), <<>>, + undefined) + ), + {Type, {Ref,flg_undefined}}. + +%%%---- stream_encrypt +-spec stream_encrypt(State, PlainText) -> {NewState, CipherText} | no_return() + when State :: stream_state(), + PlainText :: iodata(), + NewState :: stream_state(), + CipherText :: iodata() . +stream_encrypt(State, Data) -> + crypto_stream_emulate(State, Data, true). + +%%%---- stream_decrypt +-spec stream_decrypt(State, CipherText) -> {NewState, PlainText} | no_return() + when State :: stream_state(), + CipherText :: iodata(), + NewState :: stream_state(), + PlainText :: iodata() . +stream_decrypt(State, Data) -> + crypto_stream_emulate(State, Data, false). + +%%%-------- helpers +crypto_stream_emulate({Cipher,{Ref0,flg_undefined}}, Data, EncryptFlag) when is_reference(Ref0) -> + ?COMPAT(begin + Ref = ng_crypto_init_nif(Ref0, <<>>, <<>>, EncryptFlag), + {{Cipher,Ref}, crypto_update(Ref, Data)} + end); + +crypto_stream_emulate({Cipher,Ref}, Data, _) when is_reference(Ref) -> + ?COMPAT({{Cipher,Ref}, crypto_update(Ref, Data)}). %%%---------------------------------------------------------------- -spec next_iv(Type:: cbc_cipher(), Data) -> NextIVec when % Type :: cbc_cipher(), %des_cbc | des3_cbc | aes_cbc | aes_ige, @@ -645,59 +709,155 @@ next_iv(des_cfb, Data, IVec) -> next_iv(Type, Data, _Ivec) -> next_iv(Type, Data). -%%%---- Stream ciphers +%%%================================================================ +%%% +%%% Encrypt/decrypt, The "New API" +%%% +%%%================================================================ --opaque stream_state() :: {stream_cipher(), reference()}. +-opaque crypto_state() :: reference() . --type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() . --type stream_cipher_no_iv() :: rc4 . --type stream_cipher_iv() :: aes_ctr - | aes_128_ctr - | aes_192_ctr - | aes_256_ctr - | chacha20 . --spec stream_init(Type, Key, IVec) -> State when Type :: stream_cipher_iv(), - Key :: iodata(), - IVec :: binary(), - State :: stream_state() . -stream_init(aes_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(aes_128_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(aes_192_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(aes_256_ctr, Key, Ivec) -> - {aes_ctr, aes_ctr_stream_init(Key, Ivec)}; -stream_init(chacha20, Key, Ivec) -> - {chacha20, chacha20_stream_init(Key,Ivec)}. - --spec stream_init(Type, Key) -> State when Type :: stream_cipher_no_iv(), - Key :: iodata(), - State :: stream_state() . -stream_init(rc4, Key) -> - {rc4, notsup_to_error(rc4_set_key(Key))}. - --spec stream_encrypt(State, PlainText) -> {NewState, CipherText} - when State :: stream_state(), - PlainText :: iodata(), - NewState :: stream_state(), - CipherText :: iodata() . -stream_encrypt(State, Data0) -> - Data = iolist_to_binary(Data0), - MaxByts = max_bytes(), - stream_crypt(fun do_stream_encrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). +%%%---------------------------------------------------------------- +%%% +%%% Create and initialize a new state for encryption or decryption +%%% --spec stream_decrypt(State, CipherText) -> {NewState, PlainText} - when State :: stream_state(), - CipherText :: iodata(), - NewState :: stream_state(), - PlainText :: iodata() . -stream_decrypt(State, Data0) -> - Data = iolist_to_binary(Data0), - MaxByts = max_bytes(), - stream_crypt(fun do_stream_decrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). +-spec crypto_init(Cipher, Key, EncryptFlag) -> State | ng_crypto_error() + when Cipher :: block_cipher_without_iv() + | stream_cipher_no_iv(), + Key :: iodata(), + EncryptFlag :: boolean(), + State :: crypto_state() . +crypto_init(Cipher, Key, EncryptFlag) -> + %% The IV is supposed to be supplied by calling crypto_update/3 + ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), <<>>, EncryptFlag). + + +-spec crypto_init(Cipher, Key, IV, EncryptFlag) -> State | ng_crypto_error() + when Cipher :: stream_cipher_iv() + | block_cipher_with_iv(), + Key :: iodata(), + IV :: iodata(), + EncryptFlag :: boolean(), + State :: crypto_state() . +crypto_init(Cipher, Key, IV, EncryptFlag) -> + ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). + + + +%%%---------------------------------------------------------------- +-spec crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> State | ng_crypto_error() + when Cipher :: stream_cipher_iv() + | block_cipher_with_iv(), + Key :: iodata(), + EncryptFlag :: boolean(), + State :: crypto_state() . +crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> + %% The IV is supposed to be supplied by calling crypto_update/3 + ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), undefined, EncryptFlag). + +%%%---------------------------------------------------------------- +%%% +%%% Encrypt/decrypt a sequence of bytes. The sum of the sizes +%%% of all blocks must be an integer multiple of the crypto's +%%% blocksize. +%%% + +-spec crypto_update(State, Data) -> Result | ng_crypto_error() + when State :: crypto_state(), + Data :: iodata(), + Result :: binary() . +crypto_update(State, Data0) -> + case iolist_to_binary(Data0) of + <<>> -> + <<>>; % Known to fail on OpenSSL 0.9.8h + Data -> + ng_crypto_update_nif(State, Data) + end. + + +%%%---------------------------------------------------------------- +-spec crypto_update_dyn_iv(State, Data, IV) -> Result | ng_crypto_error() + when State :: crypto_state(), + Data :: iodata(), + IV :: iodata(), + Result :: binary() . +crypto_update_dyn_iv(State, Data0, IV) -> + %% When State is from State = crypto_init(Cipher, Key, undefined, EncryptFlag) + case iolist_to_binary(Data0) of + <<>> -> + <<>>; % Known to fail on OpenSSL 0.9.8h + Data -> + ng_crypto_update_nif(State, Data, iolist_to_binary(IV)) + end. + +%%%---------------------------------------------------------------- +%%% +%%% Encrypt/decrypt one set bytes. +%%% The size must be an integer multiple of the crypto's blocksize. +%%% + +-spec crypto_one_shot(Cipher, Key, IV, Data, EncryptFlag) -> Result | ng_crypto_error() + when Cipher :: stream_cipher() + | block_cipher_with_iv() + | block_cipher_without_iv(), + Key :: iodata(), + IV :: iodata() | undefined, + Data :: iodata(), + EncryptFlag :: boolean(), + Result :: binary() . +crypto_one_shot(Cipher, Key, undefined, Data, EncryptFlag) -> + crypto_one_shot(Cipher, Key, <<>>, Data, EncryptFlag); + +crypto_one_shot(Cipher, Key, IV, Data0, EncryptFlag) -> + case iolist_to_binary(Data0) of + <<>> -> + <<>>; % Known to fail on OpenSSL 0.9.8h + Data -> + ng_crypto_one_shot_nif(alias(Cipher), + iolist_to_binary(Key), iolist_to_binary(IV), Data, + EncryptFlag) + end. + +%%%---------------------------------------------------------------- +%%% NIFs + +-type ng_crypto_error() :: no_return() . + +-spec ng_crypto_init_nif(atom(), binary(), binary()|undefined, boolean()|undefined ) -> crypto_state() | ng_crypto_error() + ; (crypto_state(), <<>>, <<>>, boolean()) -> crypto_state() | ng_crypto_error(). +ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlg) -> ?nif_stub. + + +-spec ng_crypto_update_nif(crypto_state(), binary()) -> binary() | ng_crypto_error() . +ng_crypto_update_nif(_State, _Data) -> ?nif_stub. + +-spec ng_crypto_update_nif(crypto_state(), binary(), binary()) -> binary() | ng_crypto_error() . +ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. + + +-spec ng_crypto_one_shot_nif(atom(), binary(), binary(), binary(), boolean() ) -> binary() | ng_crypto_error(). +ng_crypto_one_shot_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. + +%%%---------------------------------------------------------------- +%%% Cipher aliases +%%% +prepend_cipher_aliases(L) -> + [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L]. + +%%%---- des_ede3_cbc +alias(des3_cbc) -> des_ede3_cbc; +alias(des_ede3) -> des_ede3_cbc; +%%%---- des_ede3_cfb +alias(des_ede3_cbf) -> des_ede3_cfb; +alias(des3_cbf) -> des_ede3_cfb; +alias(des3_cfb) -> des_ede3_cfb; +%%%---- aes_*_cbc +alias(aes_cbc128) -> aes_128_cbc; +alias(aes_cbc256) -> aes_256_cbc; +alias(Alg) -> Alg. %%%================================================================ %%% @@ -1785,19 +1945,6 @@ poly1305_nif(_Key, _Data) -> ?nif_stub. cipher_info_nif(_Type) -> ?nif_stub. -block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub. -block_crypt_nif(_Type, _Key, _Text, _IsEncrypt) -> ?nif_stub. - -check_des3_key(Key) -> - case lists:map(fun erlang:iolist_to_binary/1, Key) of - ValidKey = [B1, B2, B3] when byte_size(B1) =:= 8, - byte_size(B2) =:= 8, - byte_size(B3) =:= 8 -> - ValidKey; - _ -> - error(badarg) - end. - %% %% AES - in Galois/Counter Mode (GCM) %% @@ -1814,59 +1961,7 @@ aead_decrypt(_Type, _Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. aes_ige_crypt_nif(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -%% Stream ciphers -------------------------------------------------------------------- - -stream_crypt(Fun, State, Data, Size, MaxByts, []) when Size =< MaxByts -> - Fun(State, Data); -stream_crypt(Fun, State0, Data, Size, MaxByts, Acc) when Size =< MaxByts -> - {State, Cipher} = Fun(State0, Data), - {State, list_to_binary(lists:reverse([Cipher | Acc]))}; -stream_crypt(Fun, State0, Data, _, MaxByts, Acc) -> - <<Increment:MaxByts/binary, Rest/binary>> = Data, - {State, CipherText} = Fun(State0, Increment), - stream_crypt(Fun, State, Rest, erlang:byte_size(Rest), MaxByts, [CipherText | Acc]). - -do_stream_encrypt({aes_ctr, State0}, Data) -> - {State, Cipher} = aes_ctr_stream_encrypt(State0, Data), - {{aes_ctr, State}, Cipher}; -do_stream_encrypt({rc4, State0}, Data) -> - {State, Cipher} = rc4_encrypt_with_state(State0, Data), - {{rc4, State}, Cipher}; -do_stream_encrypt({chacha20, State0}, Data) -> - {State, Cipher} = chacha20_stream_encrypt(State0, Data), - {{chacha20, State}, Cipher}. - -do_stream_decrypt({aes_ctr, State0}, Data) -> - {State, Text} = aes_ctr_stream_decrypt(State0, Data), - {{aes_ctr, State}, Text}; -do_stream_decrypt({rc4, State0}, Data) -> - {State, Text} = rc4_encrypt_with_state(State0, Data), - {{rc4, State}, Text}; -do_stream_decrypt({chacha20, State0}, Data) -> - {State, Cipher} = chacha20_stream_decrypt(State0, Data), - {{chacha20, State}, Cipher}. - - -%% -%% AES - in counter mode (CTR) with state maintained for multi-call streaming -%% -aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub. -aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub. -aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. - -%% -%% RC4 - symmetric stream cipher -%% -rc4_set_key(_Key) -> ?nif_stub. -rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. - -%% -%% CHACHA20 - stream cipher -%% -chacha20_stream_init(_Key, _IVec) -> ?nif_stub. -chacha20_stream_encrypt(_State, _Data) -> ?nif_stub. -chacha20_stream_decrypt(_State, _Data) -> ?nif_stub. +%%%================================================================ %% Secure remote password ------------------------------------------------------------------- @@ -2232,176 +2327,3 @@ check_otp_test_engine(LibDir) -> end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% Experimental NG -%%% - -%%% -> {ok,State::ref()} | {error,Reason} - --opaque crypto_state() :: reference() | {any(),any(),any(),any()}. - - -%%%---------------------------------------------------------------- -%%% -%%% Create and initialize a new state for encryption or decryption -%%% - --spec crypto_init(Cipher, Key, IV, EncryptFlag) -> {ok,State} | {error,term()} | undefined - when Cipher :: stream_cipher() - | block_cipher_with_iv() - | block_cipher_without_iv() , - Key :: iodata(), - IV :: binary(), - EncryptFlag :: boolean() | undefined, - State :: crypto_state() . - -crypto_init(Cipher, Key, IV, EncryptFlag) when is_atom(Cipher), - is_binary(Key), - is_binary(IV), - is_atom(EncryptFlag) -> - case ng_crypto_init_nif(alias(Cipher), Key, IV, EncryptFlag) of - {error,Error} -> - {error,Error}; - undefined -> % For compatibility function crypto_stream_init/3 - undefined; - Ref when is_reference(Ref) -> - {ok,Ref}; - State when is_tuple(State), - size(State)==4 -> - {ok,State} % compatibility with old cryptolibs < 1.0.1 - end. - - -%%%---------------------------------------------------------------- -%%% -%%% Encrypt/decrypt a sequence of bytes. The sum of the sizes -%%% of all blocks must be an integer multiple of the crypto's -%%% blocksize. -%%% - --spec crypto_update(State, Data) -> {ok,Result} | {error,term()} - when State :: crypto_state(), - Data :: iodata(), - Result :: binary() | {crypto_state(),binary()}. -crypto_update(State, Data) -> - mk_ret(ng_crypto_update_nif(State, Data)). - -%%%---------------------------------------------------------------- -%%% -%%% Encrypt/decrypt a sequence of bytes but change the IV first. -%%% Not applicable for all modes. -%%% - --spec crypto_update(State, Data, IV) -> {ok,Result} | {error,term()} - when State :: crypto_state(), - Data :: iodata(), - IV :: binary(), - Result :: binary() | {crypto_state(),binary()}. -crypto_update(State, Data, IV) -> - mk_ret(ng_crypto_update_nif(State, Data, IV)). - -%%%---------------------------------------------------------------- -%%% Helpers -mk_ret(R) -> mk_ret(R, []). - -mk_ret({error,Error}, _) -> - {error,Error}; -mk_ret(Bin, Acc) when is_binary(Bin) -> - {ok, iolist_to_binary(lists:reverse([Bin|Acc]))}; -mk_ret({State1,Bin}, Acc) when is_tuple(State1), - size(State1) == 4, - is_binary(Bin) -> - %% compatibility with old cryptolibs < 1.0.1 - {ok, {State1, iolist_to_binary(lists:reverse([Bin|Acc]))}}. - -%%%---------------------------------------------------------------- -%%% NIFs -ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlg) -> ?nif_stub. -ng_crypto_update_nif(_State, _Data) -> ?nif_stub. -ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. - -%%%================================================================ -%%% Compatibility functions to be called by "old" api functions. - -%%%-------------------------------- -%%%---- block encrypt/decrypt -crypto_block_encrypt(Cipher, Key, Data) -> crypto_block_encrypt(Cipher, Key, <<>>, Data). -crypto_block_decrypt(Cipher, Key, Data) -> crypto_block_decrypt(Cipher, Key, <<>>, Data). - -crypto_block_encrypt(Cipher, Key, Ivec, Data) -> crypto_block(Cipher, Key, Ivec, Data, true). -crypto_block_decrypt(Cipher, Key, Ivec, Data) -> crypto_block(Cipher, Key, Ivec, Data, false). - -%% AEAD: use old funcs - -%%%---- helper -crypto_block(Cipher, Key, IV, Data, EncryptFlag) -> - case crypto_init(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag) of - {ok, Ref} -> - case crypto_update(Ref, Data) of - {ok, {_,Bin}} when is_binary(Bin) -> Bin; - {ok, Bin} when is_binary(Bin) -> Bin; - {error,_} -> error(badarg) - end; - - {error,_} -> error(badarg) - end. - -%%%-------------------------------- -%%%---- stream init, encrypt/decrypt - -crypto_stream_init(Cipher, Key) -> - crypto_stream_init(Cipher, Key, <<>>). - -crypto_stream_init(Cipher, Key0, IV0) -> - Key = iolist_to_binary(Key0), - IV = iolist_to_binary(IV0), - %% First check the argumensts: - case crypto_init(Cipher, Key, IV, undefined) of - undefined -> - {Cipher, {Key, IV}}; - {error,_} -> - {error,badarg} - end. - -crypto_stream_encrypt(State, PlainText) -> - crypto_stream_emulate(State, PlainText, true). - -crypto_stream_decrypt(State, CryptoText) -> - crypto_stream_emulate(State, CryptoText, false). - - -%%%---- helper -crypto_stream_emulate({Cipher,{Key,IV}}, Data, EncryptFlag) -> - case crypto_init(Cipher, Key, IV, EncryptFlag) of - {ok,State} -> - crypto_stream_emulate({Cipher,State}, Data, EncryptFlag); - {error,_} -> - error(badarg) - end; -crypto_stream_emulate({Cipher,State}, Data, _) -> - case crypto_update(State, Data) of - {ok, {State1,Bin}} when is_binary(Bin) -> {{Cipher,State1},Bin}; - {ok,Bin} when is_binary(Bin) -> {{Cipher,State},Bin}; - {error,_} -> error(badarg) - end. - - -%%%================================================================ - -prepend_cipher_aliases(L) -> - [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L]. - - -%%%---- des_ede3_cbc -alias(des3_cbc) -> des_ede3_cbc; -alias(des_ede3) -> des_ede3_cbc; -%%%---- des_ede3_cfb -alias(des_ede3_cbf) -> des_ede3_cfb; -alias(des3_cbf) -> des_ede3_cfb; -alias(des3_cfb) -> des_ede3_cfb; -%%%---- aes_*_cbc -alias(aes_cbc128) -> aes_128_cbc; -alias(aes_cbc256) -> aes_256_cbc; - -alias(Alg) -> Alg. diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 7257f4fb9f..7dbbde68e9 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -9,7 +9,7 @@ %% %% http://www.apache.org/licenses/LICENSE-2.0 %% -%% Unless required by applicable law or agreed to in writing, software + %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and @@ -46,53 +46,67 @@ all() -> ]. groups() -> - [{non_fips, [], [{group, md4}, + [{non_fips, [], [ + {group, blake2b}, + {group, blake2s}, + {group, dss}, + {group, ecdsa}, + {group, ed25519}, + {group, ed448}, + {group, rsa}, + + {group, md4}, {group, md5}, {group, ripemd160}, - {group, sha}, {group, sha224}, {group, sha256}, {group, sha384}, - {group, sha512}, {group, sha3_224}, {group, sha3_256}, {group, sha3_384}, {group, sha3_512}, - {group, blake2b}, - {group, blake2s}, - {group, rsa}, - {group, dss}, - {group, ecdsa}, - {group, ed25519}, - {group, ed448}, + {group, sha512}, + {group, sha}, + {group, dh}, {group, ecdh}, {group, srp}, - {group, des_cbc}, - {group, des_cfb}, - {group, des3_cbc}, - {group, des3_cbf}, - {group, des3_cfb}, - {group, des_ede3}, - {group, blowfish_cbc}, - {group, blowfish_ecb}, - {group, blowfish_cfb64}, - {group, blowfish_ofb64}, - {group, aes_cbc128}, - {group, aes_cfb8}, - {group, aes_cfb128}, - {group, aes_cbc256}, - {group, aes_ige256}, - {group, rc2_cbc}, - {group, rc4}, - {group, aes_ctr}, + + {group, aes_cbc}, {group, aes_ccm}, {group, aes_gcm}, {group, chacha20_poly1305}, {group, chacha20}, + {group, des3_cfb}, + {group, aes_cbc128}, + {group, aes_cbc256}, + {group, aes_cfb128}, + {group, aes_cfb8}, + {group, aes_ctr}, + {group, aes_ige256}, + {group, blowfish_cbc}, + {group, blowfish_cfb64}, + {group, blowfish_ecb}, + {group, blowfish_ofb64}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, des_cbc}, + {group, des_cfb}, + {group, des_ede3}, {group, poly1305}, - {group, aes_cbc}]}, - {fips, [], [{group, no_md4}, + {group, rc2_cbc}, + {group, rc4} + ]}, + {fips, [], [ + {group, no_blake2b}, + {group, no_blake2s}, + {group, dss}, + {group, ecdsa}, + {group, no_ed25519}, + {group, no_ed448}, + {group, rsa}, + + {group, no_md4}, {group, no_md5}, {group, no_ripemd160}, {group, sha}, @@ -100,37 +114,36 @@ groups() -> {group, sha256}, {group, sha384}, {group, sha512}, - {group, rsa}, - {group, dss}, - {group, ecdsa}, - {group, no_ed25519}, - {group, no_ed448}, + {group, dh}, {group, ecdh}, {group, no_srp}, - {group, no_des_cbc}, - {group, no_des_cfb}, - {group, des3_cbc}, - {group, des3_cbf}, + + {group, aes_cbc}, + {group, aes_ccm}, + {group, aes_gcm}, + {group, no_chacha20_poly1305}, + {group, no_chacha20}, {group, des3_cfb}, - {group, des_ede3}, - {group, no_blowfish_cbc}, - {group, no_blowfish_ecb}, - {group, no_blowfish_cfb64}, - {group, no_blowfish_ofb64}, {group, aes_cbc128}, - {group, no_aes_cfb8}, - {group, no_aes_cfb128}, {group, aes_cbc256}, + {group, no_aes_cfb128}, + {group, no_aes_cfb8}, + {group, aes_ctr}, {group, no_aes_ige256}, + {group, no_blowfish_cbc}, + {group, no_blowfish_cfb64}, + {group, no_blowfish_ecb}, + {group, no_blowfish_ofb64}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, no_des_cbc}, + {group, no_des_cfb}, + {group, des_ede3}, + {group, no_poly1305}, {group, no_rc2_cbc}, - {group, no_rc4}, - {group, aes_ctr}, - {group, aes_ccm}, - {group, aes_gcm}, - {group, no_chacha20_poly1305}, - {group, no_chacha20}, - {group, aes_cbc}]}, + {group, no_rc4} + ]}, {md4, [], [hash]}, {md5, [], [hash, hmac]}, {ripemd160, [], [hash]}, @@ -145,6 +158,8 @@ groups() -> {sha3_512, [], [hash, hmac]}, {blake2b, [], [hash, hmac]}, {blake2s, [], [hash, hmac]}, + {no_blake2b, [], [no_hash, no_hmac]}, + {no_blake2s, [], [no_hash, no_hmac]}, {rsa, [], [sign_verify, public_encrypt, private_encrypt, @@ -166,31 +181,32 @@ groups() -> compute_bug]}, {ecdh, [], [use_all_elliptic_curves, compute, generate]}, {srp, [], [generate_compute]}, - {des_cbc, [], [block]}, - {des_cfb, [], [block]}, - {des3_cbc,[], [block]}, - {des_ede3,[], [block]}, - {des3_cbf,[], [block]}, - {des3_cfb,[], [block]}, - {rc2_cbc,[], [block]}, - {aes_cbc128,[], [block, cmac]}, - {aes_cfb8,[], [block]}, - {aes_cfb128,[], [block]}, - {aes_cbc256,[], [block, cmac]}, - {aes_ecb,[], [block]}, + {des_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des3_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_ede3,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des3_cbf,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des3_cfb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc2_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cbc128,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, + {aes_cfb8,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cfb128,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cbc256,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, + {aes_ecb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {aes_ige256,[], [block]}, - {blowfish_cbc, [], [block]}, - {blowfish_ecb, [], [block]}, - {blowfish_cfb64, [], [block]}, - {blowfish_ofb64,[], [block]}, - {rc4, [], [stream]}, - {aes_ctr, [], [stream]}, + {blowfish_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ecb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_cfb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ofb64,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc4, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_ctr, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, {aes_ccm, [], [aead]}, {aes_gcm, [], [aead]}, {chacha20_poly1305, [], [aead]}, - {chacha20, [], [stream]}, + {chacha20, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, {poly1305, [], [poly1305]}, - {aes_cbc, [], [block]}, + {no_poly1305, [], [no_poly1305]}, + {aes_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, {no_aes_cfb8,[], [no_support, no_block]}, {no_aes_cfb128,[], [no_support, no_block]}, {no_md4, [], [no_support, no_hash]}, @@ -412,11 +428,19 @@ poly1305(Config) -> end, proplists:get_value(poly1305, Config)). %%-------------------------------------------------------------------- +no_poly1305() -> + [{doc, "Test disabled poly1305 function"}]. +no_poly1305(Config) -> + Type = ?config(type, Config), + Key = <<133,214,190,120,87,85,109,51,127,68,82,254,66,213,6,168,1, + 3,128,138,251,13,178,253,74,191,246,175,65,73,245,27>>, + Txt = <<"Cryptographic Forum Research Group">>, + notsup(fun crypto:poly1305/2, [Key,Txt]). + +%%-------------------------------------------------------------------- block() -> [{doc, "Test block ciphers"}]. block(Config) when is_list(Config) -> - Fips = proplists:get_bool(fips, Config), - Type = ?config(type, Config), Blocks = lazy_eval(proplists:get_value(block, Config)), lists:foreach(fun block_cipher/1, Blocks), lists:foreach(fun block_cipher/1, block_iolistify(Blocks)), @@ -439,6 +463,156 @@ no_block(Config) when is_list(Config) -> notsup(fun crypto:block_encrypt/N, Args), notsup(fun crypto:block_decrypt/N, Args). %%-------------------------------------------------------------------- +api_ng() -> + [{doc, "Test new api"}]. + +api_ng(Config) when is_list(Config) -> + Blocks = lazy_eval(proplists:get_value(block, Config, [])), + Streams = lazy_eval(proplists:get_value(stream, Config, [])), + lists:foreach(fun api_ng_cipher_increment/1, Blocks++Streams). + + +api_ng_cipher_increment({Type, Key, PlainTexts}=_X) -> + ct:log("~p",[_X]), + api_ng_cipher_increment({Type, Key, <<>>, PlainTexts}); + +api_ng_cipher_increment({Type, Key, IV, PlainTexts}=_X) -> + ct:log("~p",[_X]), + api_ng_cipher_increment({Type, Key, IV, PlainTexts, undefined}); + +api_ng_cipher_increment({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> + ct:log("~p",[_X]), + PlainTexts = iolistify(PlainText0), + RefEnc = crypto:crypto_init(Type, Key, IV, true), + RefDec = crypto:crypto_init(Type, Key, IV, false), + EncTexts = api_ng_cipher_increment_loop(RefEnc, PlainTexts), + Enc = iolist_to_binary(EncTexts), + case ExpectedEncText of + undefined -> + ok; + Enc -> + ok; + _ -> + ct:log("encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainTexts}, ExpectedEncText, Enc]), + ct:fail("api_ng_cipher_increment (encode)",[]) + end, + Plain = iolist_to_binary(PlainTexts), + case iolist_to_binary(api_ng_cipher_increment_loop(RefDec, EncTexts)) of + Plain -> + ok; + OtherPT -> + ct:log("decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTexts}, Plain, OtherPT]), + ct:fail("api_ng_cipher_increment (encode)",[]) + end. + + +api_ng_cipher_increment_loop(Ref, InTexts) -> + lists:map(fun(Txt) -> + try crypto:crypto_update(Ref, Txt) + of + Bin when is_binary(Bin) -> + Bin + catch + error:Error -> + ct:pal("Txt = ~p",[Txt]), + ct:fail("~p",[Error]) + end + end, InTexts). + +%%-------------------------------------------------------------------- +api_ng_one_shot() -> + [{doc, "Test new api"}]. + +api_ng_one_shot(Config) when is_list(Config) -> + Blocks = lazy_eval(proplists:get_value(block, Config, [])), + Streams = lazy_eval(proplists:get_value(stream, Config, [])), + lists:foreach(fun do_api_ng_one_shot/1, Blocks++Streams). + +do_api_ng_one_shot({Type, Key, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_one_shot({Type, Key, <<>>, PlainTexts}); + +do_api_ng_one_shot({Type, Key, IV, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_one_shot({Type, Key, IV, PlainTexts, undefined}); + +do_api_ng_one_shot({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> + ct:log("~p",[_X]), + PlainText = iolist_to_binary(PlainText0), + EncTxt = crypto:crypto_one_shot(Type, Key, IV, PlainText, true), + case ExpectedEncText of + undefined -> + ok; + EncTxt -> + ok; + _ -> + ct:log("encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, EncTxt]), + ct:fail("api_ng_one_shot (encode)",[]) + end, + case crypto:crypto_one_shot(Type, Key, IV, EncTxt, false) of + PlainText -> + ok; + OtherPT -> + ct:log("decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, OtherPT]), + ct:fail("api_ng_one_shot (decode)",[]) + end. + +%%-------------------------------------------------------------------- +api_ng_tls() -> + [{doc, "Test special tls api"}]. + +api_ng_tls(Config) when is_list(Config) -> + Blocks = lazy_eval(proplists:get_value(block, Config, [])), + Streams = lazy_eval(proplists:get_value(stream, Config, [])), + lists:foreach(fun do_api_ng_tls/1, Blocks++Streams). + + +do_api_ng_tls({Type, Key, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_tls({Type, Key, <<>>, PlainTexts}); + +do_api_ng_tls({Type, Key, IV, PlainTexts}=_X) -> + ct:log("~p",[_X]), + do_api_ng_tls({Type, Key, IV, PlainTexts, undefined}); + +do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> + ct:log("~p",[_X]), + PlainText = iolist_to_binary(PlainText0), + Renc = crypto:crypto_init_dyn_iv(Type, Key, true), + Rdec = crypto:crypto_init_dyn_iv(Type, Key, false), + EncTxt = crypto:crypto_update_dyn_iv(Renc, PlainText, IV), + case ExpectedEncText of + undefined -> + ok; + EncTxt -> + %% Now check that the state is NOT updated: + case crypto:crypto_update_dyn_iv(Renc, PlainText, IV) of + EncTxt -> + ok; + EncTxt2 -> + ct:log("2nd encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, EncTxt, EncTxt2]), + ct:fail("api_ng_tls (second encode)",[]) + end; + OtherEnc -> + ct:log("1st encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, OtherEnc]), + ct:fail("api_ng_tls (encode)",[]) + end, + case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + PlainText -> + %% Now check that the state is NOT updated: + case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + PlainText -> + ok; + PlainText2 -> + ct:log("2nd decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, PlainText2]), + ct:fail("api_ng_tls (second decode)",[]) + end; + OtherPT -> + ct:log("1st decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, OtherPT]), + ct:fail("api_ng_tlst (decode)",[]) + end. + +%%-------------------------------------------------------------------- no_aead() -> [{doc, "Test disabled aead ciphers"}]. no_aead(Config) when is_list(Config) -> @@ -774,6 +948,7 @@ cmac_check({Type, Key, Text, Size, CMac}) -> ct:fail({{crypto, cmac, [Type, Key, Text, Size]}, {expected, ExpCMac}, {got, Other}}) end. + block_cipher({Type, Key, PlainText}) -> Plain = iolist_to_binary(PlainText), CipherText = crypto:block_encrypt(Type, Key, PlainText), @@ -851,46 +1026,51 @@ block_cipher_increment(Type, Key, IV0, IV, [PlainText | PlainTexts], Plain, Ciph stream_cipher({Type, Key, PlainText}) -> Plain = iolist_to_binary(PlainText), - State = crypto:stream_init(Type, Key), - {_, CipherText} = crypto:stream_encrypt(State, PlainText), - case crypto:stream_decrypt(State, CipherText) of + StateE = crypto:stream_init(Type, Key), + StateD = crypto:stream_init(Type, Key), + {_, CipherText} = crypto:stream_encrypt(StateE, PlainText), + case crypto:stream_decrypt(StateD, CipherText) of {_, Plain} -> ok; Other -> - ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; stream_cipher({Type, Key, IV, PlainText}) -> Plain = iolist_to_binary(PlainText), - State = crypto:stream_init(Type, Key, IV), - {_, CipherText} = crypto:stream_encrypt(State, PlainText), - case crypto:stream_decrypt(State, CipherText) of + StateE = crypto:stream_init(Type, Key, IV), + StateD = crypto:stream_init(Type, Key, IV), + {_, CipherText} = crypto:stream_encrypt(StateE, PlainText), + case crypto:stream_decrypt(StateD, CipherText) of {_, Plain} -> ok; Other -> - ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; stream_cipher({Type, Key, IV, PlainText, CipherText}) -> Plain = iolist_to_binary(PlainText), - State = crypto:stream_init(Type, Key, IV), - case crypto:stream_encrypt(State, PlainText) of + StateE = crypto:stream_init(Type, Key, IV), + StateD = crypto:stream_init(Type, Key, IV), + case crypto:stream_encrypt(StateE, PlainText) of {_, CipherText} -> ok; {_, Other0} -> - ct:fail({{crypto, stream_encrypt, [State, Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) + ct:fail({{crypto, stream_encrypt, [StateE, Type, Key, IV, Plain]}, {expected, CipherText}, {got, Other0}}) end, - case crypto:stream_decrypt(State, CipherText) of + case crypto:stream_decrypt(StateD, CipherText) of {_, Plain} -> ok; Other1 -> - ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other1}}) + ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other1}}) end. stream_cipher_incment({Type, Key, PlainTexts}) -> - State = crypto:stream_init(Type, Key), - stream_cipher_incment_loop(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); + StateE = crypto:stream_init(Type, Key), + StateD = crypto:stream_init(Type, Key), + stream_cipher_incment_loop(StateE, StateD, PlainTexts, [], iolist_to_binary(PlainTexts)); stream_cipher_incment({Type, Key, IV, PlainTexts}) -> - State = crypto:stream_init(Type, Key, IV), - stream_cipher_incment_loop(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); + StateE = crypto:stream_init(Type, Key, IV), + StateD = crypto:stream_init(Type, Key, IV), + stream_cipher_incment_loop(StateE, StateD, PlainTexts, [], iolist_to_binary(PlainTexts)); stream_cipher_incment({Type, Key, IV, PlainTexts, _CipherText}) -> stream_cipher_incment({Type, Key, IV, PlainTexts}). diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index b686cfbf33..32d28b853b 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.11.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed two bugs in the <c>erl_call</c> program. A missing + initialization (introduced in <c>erl_interface-3.11</c>) + which either caused a crash or failure to connect to or + start a node, and an incorrectly calculated timeout which + could cause failure to start an erlang node. These bugs + only caused failures on some platforms.</p> + <p> + Own Id: OTP-15676 Aux Id: OTP-15442, ERL-881 </p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.11</title> <section><title>Improvements and New Features</title> diff --git a/lib/erl_interface/src/prog/ei_fake_prog.c b/lib/erl_interface/src/prog/ei_fake_prog.c index c7a16dc7c4..158464b385 100644 --- a/lib/erl_interface/src/prog/ei_fake_prog.c +++ b/lib/erl_interface/src/prog/ei_fake_prog.c @@ -98,11 +98,18 @@ int main(void) EI_ULONGLONG ulonglongx = 0; #endif erlang_char_encoding enc; + ei_socket_callbacks cbs; intx = erl_errno; + ei_init(); + + ei_close_connection(intx); + ei_connect_init(&xec, charp, charp, creation); + ei_connect_init_ussi(&xec, charp, charp, creation, &cbs, sizeof(cbs), NULL); ei_connect_xinit (&xec, charp, charp, charp, thisipaddr, charp, creation); + ei_connect_xinit_ussi(&xec, charp, charp, charp, thisipaddr, charp, creation, &cbs, sizeof(cbs), NULL); ei_connect(&xec, charp); ei_xconnect (&xec, thisipaddr, charp); @@ -121,6 +128,8 @@ int main(void) ei_publish(&xec, intx); ei_accept(&xec, intx, &conp); ei_unpublish(&xec); + ei_listen(&xec, intp, intx); + ei_xlisten(&xec, thisipaddr, intp, intx); ei_thisnodename(&xec); ei_thishostname(&xec); @@ -187,7 +196,7 @@ int main(void) ei_decode_char(charp, intp, charp); ei_decode_string(charp, intp, charp); ei_decode_atom(charp, intp, charp); - ei_decode_atom_as(charp, intp, charp, MAXATOMLEN_UTF8, ERLANG_WHATEVER, &enc, &enc); + ei_decode_atom_as(charp, intp, charp, MAXATOMLEN_UTF8, ERLANG_UTF8, &enc, &enc); ei_decode_binary(charp, intp, (void *)0, longp); ei_decode_fun(charp, intp, &efun); free_fun(&efun); diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c index 52ad6885e8..ab91157035 100644 --- a/lib/erl_interface/src/prog/erl_call.c +++ b/lib/erl_interface/src/prog/erl_call.c @@ -88,10 +88,6 @@ #include "ei_resolve.h" #include "erl_start.h" /* FIXME remove dependency */ -#ifdef __WIN32__ -static void initWinSock(void); -#endif - /* * Some nice global variables * (I don't think "nice" is the right word actually... -gordon) @@ -157,6 +153,8 @@ int erl_call(int argc, char **argv) char* progname = argv[0]; ei_cnode ec; + ei_init(); + /* Get the command line options */ while (i < argc) { if (argv[i][0] != '-') { @@ -317,14 +315,6 @@ int erl_call(int argc, char **argv) struct in_addr h_ipadr; char* ct; -#ifdef __WIN32__ - /* - * FIXME Extremly ugly, but needed to get ei_gethostbyname() below - * to work. - */ - initWinSock(); -#endif - /* gethostname requires len to be max(hostname) + 1 */ if (gethostname(h_hostname, EI_MAXHOSTNAMELEN+1) < 0) { fprintf(stderr,"erl_call: failed to get host name: %d\n", errno); @@ -857,46 +847,6 @@ static void usage(const char *progname) { exit(0); } - -/*************************************************************************** - * - * OS specific functions - * - ***************************************************************************/ - -#ifdef __WIN32__ -/* - * FIXME This should not be here. This is a quick fix to make erl_call - * work at all on Windows NT. - */ -static void initWinSock(void) -{ - WORD wVersionRequested; - WSADATA wsaData; - int err; - static int initialized; - - wVersionRequested = MAKEWORD(1, 1); - if (!initialized) { - initialized = 1; - err = WSAStartup(wVersionRequested, &wsaData); - - if (err != 0) { - fprintf(stderr,"erl_call: " - "Can't initialize windows sockets: %d\n", err); - } - - if ( LOBYTE( wsaData.wVersion ) != 1 || - HIBYTE( wsaData.wVersion ) != 1 ) { - fprintf(stderr,"erl_call: This version of " - "windows sockets not supported\n"); - WSACleanup(); - } - } -} -#endif - - /*************************************************************************** * * Utility functions diff --git a/lib/erl_interface/src/prog/erl_start.c b/lib/erl_interface/src/prog/erl_start.c index ba495ac818..b7aa451946 100644 --- a/lib/erl_interface/src/prog/erl_start.c +++ b/lib/erl_interface/src/prog/erl_start.c @@ -657,7 +657,7 @@ static int wait_for_erlang(int sockd, int magic, struct timeval *timeout) gettimeofday(&now,NULL); to.tv_sec = stop_time.tv_sec - now.tv_sec; to.tv_usec = stop_time.tv_usec - now.tv_usec; - while ((to.tv_usec <= 0) && (to.tv_sec >= 0)) { + while ((to.tv_usec < 0) && (to.tv_sec > 0)) { to.tv_usec += 1000000; to.tv_sec--; } diff --git a/lib/erl_interface/test/Makefile b/lib/erl_interface/test/Makefile index 94f4b422d6..f8f2ef0156 100644 --- a/lib/erl_interface/test/Makefile +++ b/lib/erl_interface/test/Makefile @@ -33,6 +33,7 @@ MODULES= \ ei_format_SUITE \ ei_print_SUITE \ ei_tmo_SUITE \ + erl_call_SUITE \ erl_connect_SUITE \ erl_global_SUITE \ erl_eterm_SUITE \ diff --git a/lib/erl_interface/test/erl_call_SUITE.erl b/lib/erl_interface/test/erl_call_SUITE.erl new file mode 100644 index 0000000000..9e2b2e4251 --- /dev/null +++ b/lib/erl_interface/test/erl_call_SUITE.erl @@ -0,0 +1,96 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(erl_call_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, smoke/1]). + +all() -> + [smoke]. + +smoke(Config) when is_list(Config) -> + ErlCall = find_erl_call(), + NameSwitch = case net_kernel:longnames() of + true -> + "-name"; + false -> + "-sname" + end, + Name = atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(erlang:system_time(microsecond)), + + ArgsList = ["-s", "-a", "erlang node", NameSwitch, Name], + io:format("erl_call: \"~ts\"\n~nargs list: ~p~n", [ErlCall, ArgsList]), + CmdRes = get_smoke_port_res(open_port({spawn_executable, ErlCall}, + [{args, ArgsList}, eof]), []), + io:format("CmdRes: ~p~n", [CmdRes]), + + [_, Hostname] = string:lexemes(atom_to_list(node()), "@"), + NodeName = list_to_atom(Name ++ "@" ++ Hostname), + io:format("NodeName: ~p~n~n", [NodeName]), + + pong = net_adm:ping(NodeName), + rpc:cast(NodeName, erlang, halt, []), + NodeName = list_to_atom(string:trim(CmdRes, both, "'")), + ok. + +% +% Utility functions... +% + +find_erl_call() -> + ErlCallName = case os:type() of + {win32, _} -> "erl_call.exe"; + _ -> "erl_call" + end, + LibDir = code:lib_dir(erl_interface), + InstalledErlCall = filename:join([LibDir, "bin", ErlCallName]), + TargetDir = erlang:system_info(system_architecture), + TargetErlCall = filename:join([LibDir, "bin", TargetDir, ErlCallName]), + + try + lists:foreach(fun (F) -> + io:format("Checking: \"~ts\"~n", [F]), + case file:read_file_info(F) of + {ok, _} -> + throw(F); + _ -> + ok + end + end, + [InstalledErlCall, TargetErlCall]), + exit({missing, erl_call}) + catch + throw:ErlCall -> + ErlCall + end. + +get_smoke_port_res(Port, Acc) when is_port(Port) -> + receive + {Port, {data, Data}} -> + get_smoke_port_res(Port, [Acc|Data]); + {Port, eof} -> + lists:flatten(Acc) + end. + diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 0ed5c07bca..dae6052d55 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.11 +EI_VSN = 3.11.1 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 64e0b9d8dd..99fecbe970 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -140,6 +140,11 @@ end_per_testcase(on_load_embedded, Config) -> LinkName = proplists:get_value(link_name, Config), _ = del_link(LinkName), end_per_testcase(Config); +end_per_testcase(upgrade, Config) -> + %% Make sure tracing is turned off even if the test times out. + erlang:trace_pattern({error_handler,undefined_function,3}, false, [global]), + erlang:trace(self(), false, [call]), + end_per_testcase(Config); end_per_testcase(_Func, Config) -> end_per_testcase(Config). @@ -1556,6 +1561,11 @@ on_load_update_code_1(3, Mod) -> %% Test -on_load while trace feature 'on_load' is enabled (OTP-14612) on_load_trace_on_load(Config) -> + %% 'on_load' enables tracing for all newly loaded modules, so we make a dry + %% run to ensure that ancillary modules like 'merl' won't be loaded during + %% the actual test. + on_load_update(Config), + Papa = self(), Tracer = spawn_link(fun F() -> receive M -> Papa ! M end, F() end), {tracer,[]} = erlang:trace_info(self(),tracer), diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 77afb8250c..02bc884e36 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -160,7 +160,7 @@ {'sync_transaction', Retries::non_neg_integer()}. -type table() :: atom(). -type storage_type() :: 'ram_copies' | 'disc_copies' | 'disc_only_copies'. --type index_attr() :: atom() | non_neg_integer(). +-type index_attr() :: atom() | non_neg_integer() | {atom()}. -type write_locks() :: 'write' | 'sticky_write'. -type read_locks() :: 'read'. -type lock_kind() :: write_locks() | read_locks(). @@ -1277,6 +1277,14 @@ match_object(Tid, Ts, Tab, Pat, LockKind) match_object(_Tid, _Ts, Tab, Pat, _LockKind) -> abort({bad_type, Tab, Pat}). +add_written_index(Store, Pos, Tab, Key, Objs) when is_integer(Pos) -> + Pat = setelement(Pos, val({Tab, wild_pattern}), Key), + add_written_match(Store, Pat, Tab, Objs); +add_written_index(Store, Pos, Tab, Key, Objs) when is_tuple(Pos) -> + IxF = mnesia_index:index_vals_f(val({Tab, storage_type}), Tab, Pos), + Ops = find_ops(Store, Tab, '_'), + add_ix_match(Ops, Objs, IxF, Key, val({Tab, setorbag})). + add_written_match(S, Pat, Tab, Objs) -> Ops = find_ops(S, Tab, Pat), FixedRes = add_match(Ops, Objs, val({Tab, setorbag})), @@ -1303,6 +1311,46 @@ add_match([{_Oid, Val, write}|R], Objs, bag) -> add_match([{Oid, Val, write}|R], Objs, set) -> add_match(R, [Val | deloid(Oid,Objs)],set). +add_ix_match([], Objs, _IxF, _Key, _Type) -> + Objs; +add_ix_match(Written, Objs, IxF, Key, ordered_set) -> + %% Must use keysort which is stable + add_ordered_match(lists:keysort(1, ix_filter_ops(IxF, Key, Written)), Objs, []); +add_ix_match([{Oid, _, delete}|R], Objs, IxF, Key, Type) -> + add_ix_match(R, deloid(Oid, Objs), IxF, Key, Type); +add_ix_match([{_Oid, Val, delete_object}|R], Objs, IxF, Key, Type) -> + case ix_match(Val, IxF, Key) of + true -> + add_ix_match(R, lists:delete(Val, Objs), IxF, Key, Type); + false -> + add_ix_match(R, Objs, IxF, Key, Type) + end; +add_ix_match([{_Oid, Val, write}|R], Objs, IxF, Key, bag) -> + case ix_match(Val, IxF, Key) of + true -> + add_ix_match(R, [Val | lists:delete(Val, Objs)], IxF, Key, bag); + false -> + add_ix_match(R, Objs, IxF, Key, bag) + end; +add_ix_match([{Oid, Val, write}|R], Objs, IxF, Key, set) -> + case ix_match(Val, IxF, Key) of + true -> + add_ix_match(R, [Val | deloid(Oid,Objs)],IxF,Key,set); + false -> + add_ix_match(R, Objs, IxF, Key, set) + end. + +ix_match(Val, IxF, Key) -> + lists:member(Key, IxF(Val)). + +ix_filter_ops(IxF, Key, Ops) -> + lists:filter( + fun({_Oid, Obj, write}) -> + ix_match(Obj, IxF, Key); + (_) -> + true + end, Ops). + %% For ordered_set only !! add_ordered_match(Written = [{{_, Key}, _, _}|_], [Obj|Objs], Acc) when Key > element(2, Obj) -> @@ -1641,6 +1689,16 @@ index_match_object(Tid, Ts, Tab, Pat, Attr, LockKind) dirty_index_match_object(Tab, Pat, Attr); % Should be optimized? tid -> case mnesia_schema:attr_tab_to_pos(Tab, Attr) of + {_} -> + case LockKind of + read -> + Store = Ts#tidstore.store, + mnesia_locker:rlock_table(Tid, Store, Tab), + Objs = dirty_match_object(Tab, Pat), + add_written_match(Store, Pat, Tab, Objs); + _ -> + abort({bad_type, Tab, LockKind}) + end; Pos when Pos =< tuple_size(Pat) -> case LockKind of read -> @@ -1688,8 +1746,8 @@ index_read(Tid, Ts, Tab, Key, Attr, LockKind) false -> Store = Ts#tidstore.store, Objs = mnesia_index:read(Tid, Store, Tab, Key, Pos), - Pat = setelement(Pos, val({Tab, wild_pattern}), Key), - add_written_match(Store, Pat, Tab, Objs); + add_written_index( + Ts#tidstore.store, Pos, Tab, Key, Objs); true -> abort({bad_type, Tab, Attr, Key}) end; @@ -1825,7 +1883,7 @@ remote_dirty_match_object(Tab, Pat) -> false -> mnesia_lib:db_match_object(Tab, Pat); true -> - PosList = val({Tab, index}), + PosList = regular_indexes(Tab), remote_dirty_match_object(Tab, Pat, PosList) end. @@ -1857,7 +1915,7 @@ remote_dirty_select(Tab, Spec) -> false -> mnesia_lib:db_select(Tab, Spec); true -> - PosList = val({Tab, index}), + PosList = regular_indexes(Tab), remote_dirty_select(Tab, Spec, PosList) end; _ -> @@ -1924,6 +1982,8 @@ dirty_index_match_object(Pat, _Attr) -> dirty_index_match_object(Tab, Pat, Attr) when is_atom(Tab), Tab /= schema, is_tuple(Pat), tuple_size(Pat) > 2 -> case mnesia_schema:attr_tab_to_pos(Tab, Attr) of + {_} -> + dirty_match_object(Tab, Pat); Pos when Pos =< tuple_size(Pat) -> case has_var(element(2, Pat)) of false -> @@ -3254,3 +3314,7 @@ put_activity_id(Activity) -> mnesia_tm:put_activity_id(Activity). put_activity_id(Activity,Fun) -> mnesia_tm:put_activity_id(Activity,Fun). + +regular_indexes(Tab) -> + PosList = val({Tab, index}), + [P || P <- PosList, is_integer(P)]. diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index 098265d5fc..6f1c21e3b9 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1996-2018. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,7 +14,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% @@ -37,7 +37,7 @@ db_match_erase/2, get_index_table/2, get_index_table/3, - + tab2filename/2, init_index/2, init_indecies/3, @@ -45,6 +45,7 @@ del_transient/3, del_index_table/3, + index_vals_f/3, index_info/2, ext_index_instances/1]). @@ -60,9 +61,14 @@ read(Tid, Store, Tab, IxKey, Pos) -> ResList = mnesia_locker:ixrlock(Tid, Store, Tab, IxKey, Pos), %% Remove all tuples which don't include Ixkey, happens when Tab is a bag case val({Tab, setorbag}) of - bag -> + bag when is_integer(Pos) -> mnesia_lib:key_search_all(IxKey, Pos, ResList); - _ -> + bag when is_tuple(Pos) -> + TabStorage = val({Tab, storage_type}), + ValsF = index_vals_f(TabStorage, Tab, Pos), + [Obj || Obj <- ResList, + lists:member(IxKey, ValsF(Obj))]; + _ -> ResList end. @@ -136,7 +142,7 @@ del_object_index2([], _, _Storage, _Tab, _K, _Obj) -> ok; del_object_index2([{{Pos, Type}, Ixt} | Tail], SoB, Storage, Tab, K, Obj) -> ValsF = index_vals_f(Storage, Tab, Pos), case SoB of - bag -> + bag -> del_object_bag(Type, ValsF, Tab, K, Obj, Ixt); _ -> %% If set remove the tuple in index table del_ixes(Type, Ixt, ValsF, Obj, K) @@ -197,7 +203,7 @@ merge([], _, _, Ack) -> realkeys(Tab, Pos, IxKey) -> Index = get_index_table(Tab, Pos), db_get(Index, IxKey). % a list on the form [{IxKey, RealKey1} , .... - + dirty_select(Tab, Spec, Pos) when is_integer(Pos) -> %% Assume that we are on the node where the replica is %% Returns the records without applying the match spec @@ -233,7 +239,7 @@ dirty_read2(Tab, IxKey, Pos) -> end, Acc, mnesia_lib:db_get(Storage, Tab, K)) end, [], Keys)). -pick_index([{{{Pfx,_},IxType}, Ixt}|_], _Tab, {_} = Pfx) -> +pick_index([{{{Pfx,_,_},IxType}, Ixt}|_], _Tab, {_} = Pfx) -> {IxType, Ixt}; pick_index([{{Pos,IxType}, Ixt}|_], _Tab, Pos) -> {IxType, Ixt}; @@ -242,7 +248,7 @@ pick_index([_|T], Tab, Pos) -> pick_index([], Tab, Pos) -> mnesia:abort({no_exist, Tab, {index, Pos}}). - + %%%%%%% Creation, Init and deletion routines for index tables %% We can have several indexes on the same table @@ -387,12 +393,12 @@ init_ext_index(Tab, Storage, Alias, Mod, [{Pos,Type} | Tail]) -> create_fun(Cont, Tab, Pos) -> IxF = index_vals_f(disc_only_copies, Tab, Pos), fun(read) -> - Data = + Data = case Cont of {start, KeysPerChunk} -> mnesia_lib:db_init_chunk( disc_only_copies, Tab, KeysPerChunk); - '$end_of_table' -> + '$end_of_table' -> '$end_of_table'; _Else -> mnesia_lib:db_chunk(disc_only_copies, Cont) @@ -462,7 +468,7 @@ add_index_info(Tab, SetOrBag, IxElem) -> %% Check later if mnesia_tm is sensitive about the order mnesia_lib:set({Tab, index_info}, IndexInfo), mnesia_lib:set({Tab, index}, index_positions(IndexInfo)), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit([IndexInfo | Commit])); {value, Old} -> %% We could check for consistency here @@ -470,7 +476,7 @@ add_index_info(Tab, SetOrBag, IxElem) -> mnesia_lib:set({Tab, index_info}, Index), mnesia_lib:set({Tab, index}, index_positions(Index)), NewC = lists:keyreplace(index, 1, Commit, Index), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit(NewC)) end. @@ -488,19 +494,19 @@ del_index_info(Tab, Pos) -> element(1,P)=/=Pos end, Old#index.pos_list) of - [] -> + [] -> IndexInfo = index_info(Old#index.setorbag,[]), mnesia_lib:set({Tab, index_info}, IndexInfo), mnesia_lib:set({Tab, index}, index_positions(IndexInfo)), NewC = lists:keydelete(index, 1, Commit), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit(NewC)); New -> Index = Old#index{pos_list = New}, mnesia_lib:set({Tab, index_info}, Index), mnesia_lib:set({Tab, index}, index_positions(Index)), NewC = lists:keyreplace(index, 1, Commit, Index), - mnesia_lib:set({Tab, commit_work}, + mnesia_lib:set({Tab, commit_work}, mnesia_lib:sort_commit(NewC)) end end. @@ -537,7 +543,7 @@ db_match_erase({{ext,_,_} = Ext, Ixt}, Pat) -> mnesia_lib:db_match_erase(Ext, Ixt, Pat); db_match_erase({dets, Ixt}, Pat) -> ok = dets:match_delete(Ixt, Pat). - + db_select({ram, Ixt}, Pat) -> ets:select(Ixt, Pat); db_select({{ext,_,_} = Ext, Ixt}, Pat) -> @@ -545,7 +551,7 @@ db_select({{ext,_,_} = Ext, Ixt}, Pat) -> db_select({dets, Ixt}, Pat) -> dets:select(Ixt, Pat). - + get_index_table(Tab, Pos) -> get_index_table(Tab, val({Tab, storage_type}), Pos). diff --git a/lib/mnesia/test/Makefile b/lib/mnesia/test/Makefile index 5b61b1af65..b43bc82801 100644 --- a/lib/mnesia/test/Makefile +++ b/lib/mnesia/test/Makefile @@ -53,7 +53,8 @@ MODULES= \ mnesia_measure_test \ mnesia_cost \ mnesia_dbn_meters \ - ext_test + ext_test \ + mnesia_index_plugin_test DocExamplesDir := ../doc/src/ diff --git a/lib/mnesia/test/mnesia_SUITE.erl b/lib/mnesia/test/mnesia_SUITE.erl index 24c1def6da..b41bf22efa 100644 --- a/lib/mnesia/test/mnesia_SUITE.erl +++ b/lib/mnesia/test/mnesia_SUITE.erl @@ -69,12 +69,13 @@ groups() -> %% covered. [{light, [], [{group, install}, {group, nice}, {group, evil}, - {group, mnesia_frag_test, light}, {group, qlc}, + {group, mnesia_frag_test, light}, {group, qlc}, {group, index_plugins}, {group, registry}, {group, config}, {group, examples}]}, {install, [], [{mnesia_install_test, all}]}, {nice, [], [{mnesia_nice_coverage_test, all}]}, {evil, [], [{mnesia_evil_coverage_test, all}]}, {qlc, [], [{mnesia_qlc_test, all}]}, + {index_plugins, [], [{mnesia_index_plugin_test, all}]}, {registry, [], [{mnesia_registry_test, all}]}, {config, [], [{mnesia_config_test, all}]}, {examples, [], [{mnesia_examples_test, all}]}, diff --git a/lib/mnesia/test/mnesia_index_plugin_test.erl b/lib/mnesia/test/mnesia_index_plugin_test.erl new file mode 100644 index 0000000000..44fe047c50 --- /dev/null +++ b/lib/mnesia/test/mnesia_index_plugin_test.erl @@ -0,0 +1,261 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(mnesia_index_plugin_test). +-author('[email protected]'). + +-export([init_per_testcase/2, end_per_testcase/2, + init_per_group/2, end_per_group/2, + init_per_suite/1, end_per_suite/1, + all/0, groups/0]). + +-export([ + add_rm_plugin/1, + tab_with_plugin_index/1, + tab_with_multiple_plugin_indexes/1, + ix_match_w_plugin/1, + ix_match_w_plugin_ordered/1, + ix_match_w_plugin_bag/1 + ]). + +-export([ix_prefixes/3, % test plugin + ix_prefixes2/3]). % test plugin 2 + +-include("mnesia_test_lib.hrl"). + +init_per_suite(Conf) -> + Conf. + +end_per_suite(Conf) -> + Conf. + +init_per_testcase(Func, Conf) -> + mnesia_test_lib:init_per_testcase(Func, Conf). + +end_per_testcase(Func, Conf) -> + mnesia_test_lib:end_per_testcase(Func, Conf). + +all() -> + [add_rm_plugin, + tab_with_plugin_index, + tab_with_multiple_plugin_indexes, + ix_match_w_plugin, + ix_match_w_plugin_ordered, + ix_match_w_plugin_bag]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +add_rm_plugin(suite) -> []; +add_rm_plugin(Config) when is_list(Config) -> + [N1, N2] = Nodes = ?acquire_nodes(2, Config), + ok = add_plugin(), + ok = rpc_check_plugin(N1), + ok = rpc_check_plugin(N2), + ok = add_plugin2(), + ok = del_plugin(), + ok = del_plugin2(), + ok = add_plugin(), + ok = add_plugin2(), + ok = del_plugin(), + ok = del_plugin2(), + ?verify_mnesia(Nodes, []). + +-define(PLUGIN1, {{pfx},?MODULE,ix_prefixes}). +-define(PLUGIN2, {{pfx2},?MODULE,ix_prefixes2}). + +add_plugin() -> + {atomic, ok} = mnesia_schema:add_index_plugin({pfx}, ?MODULE, ix_prefixes), + [?PLUGIN1] = mnesia_schema:index_plugins(), + ok. + +add_plugin2() -> + {atomic, ok} = mnesia_schema:add_index_plugin({pfx2}, ?MODULE, ix_prefixes2), + [?PLUGIN1, ?PLUGIN2] = lists:sort(mnesia_schema:index_plugins()), + ok. + +del_plugin() -> + {atomic, ok} = mnesia_schema:delete_index_plugin({pfx}), + [?PLUGIN2] = mnesia_schema:index_plugins(), + ok. + +del_plugin2() -> + {atomic, ok} = mnesia_schema:delete_index_plugin({pfx2}), + [] = mnesia_schema:index_plugins(), + ok. + +rpc_check_plugin(N) -> + [?PLUGIN1] = + rpc:call(N, mnesia_schema, index_plugins, []), + ok. + +tab_with_plugin_index(suite) -> []; +tab_with_plugin_index(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(t, [{attributes, [k,v1,v2]}, + {index, [{{pfx}, ordered}, + {v1, ordered}, + v2]}]), + [ok,ok,ok,ok] = + [mnesia:dirty_write({t, K, V1, V2}) + || {K,V1,V2} <- [{1,a,"123"}, + {2,b,"12345"}, + {3,c,"6789"}, + {4,d,nil}]], + [{t,1,a,"123"},{t,2,b,"12345"}] = + mnesia:dirty_index_read(t,<<"123">>,{pfx}), + [{t,3,c,"6789"}] = + mnesia:dirty_index_read(t,"6789",v2), + [{t,1,a,"123"}] = + mnesia:dirty_match_object({t,'_',a,"123"}), + [{t,1,a,"123"}] = + mnesia:dirty_select(t, [{ {t,'_',a,"123"}, [], ['$_']}]), + mnesia:dirty_delete(t,2), + [{t,1,a,"123"}] = + mnesia:dirty_index_read(t,<<"123">>,{pfx}), + ?verify_mnesia(Nodes, []). + +tab_with_multiple_plugin_indexes(suite) -> []; +tab_with_multiple_plugin_indexes(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + ok = add_plugin2(), + {atomic, ok} = + mnesia:create_table(u, [{attributes, [k,v1,v2]}, + {index, [{{pfx}, ordered}, + {{pfx2}, ordered}]}]), + [ok,ok,ok,ok] = + [mnesia:dirty_write({u, K, V1, V2}) + || {K,V1,V2} <- [{1,a,"123"}, + {2,b,"12345"}, + {3,c,"6789"}, + {4,d,nil}]], + [{u,1,a,"123"},{u,2,b,"12345"}] = + mnesia:dirty_index_read(u,<<"123">>,{pfx}), + [{u,1,a,"123"},{u,2,b,"12345"}] = + mnesia:dirty_index_read(u,<<"321">>,{pfx2}), + ?verify_mnesia(Nodes, []). + +ix_match_w_plugin(suite) -> []; +ix_match_w_plugin(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(im1, [{attributes, [k, v1, v2]}, + {index, [{{pfx}, ordered}, + {v1, ordered}]}]), + fill_and_test_index_match(im1, set), + ?verify_mnesia(Nodes, []). + + +ix_match_w_plugin_ordered(suite) -> []; +ix_match_w_plugin_ordered(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(im2, [{attributes, [k, v1, v2]}, + {type, ordered_set}, + {index, [{{pfx}, ordered}, + {v1, ordered}]}]), + fill_and_test_index_match(im2, ordered_set), + ?verify_mnesia(Nodes, []). + +ix_match_w_plugin_bag(suite) -> []; +ix_match_w_plugin_bag(Config) when is_list(Config) -> + [_N1] = Nodes = ?acquire_nodes(1, Config), + ok = add_plugin(), + {atomic, ok} = mnesia:create_table(im3, [{attributes, [k, v1, v2]}, + {type, bag}, + {index, [{{pfx}, ordered}, + {v1, ordered}]}]), + fill_and_test_index_match(im3, bag), + ?verify_mnesia(Nodes, []). + +fill_and_test_index_match(Tab, Type) -> + [ok,ok,ok,ok,ok,ok,ok,ok,ok] = + [mnesia:dirty_write({Tab, K, V1, V2}) + || {K,V1,V2} <- [{1,a,"123"}, + {2,b,"12345"}, + {3,c,"123"}, + {4,d,nil}, + {5,e,nil}, + {6,f,nil}, + {7,g,nil}, %% overwritten if not bag + {7,g,"234"}, + {8,h,"123"}]], + mnesia:activity( + transaction, + fun() -> + ok = mnesia:write({Tab, 1, aa, "1234"}), %% replaces if not bag + ok = mnesia:delete({Tab, 2}), + ok = mnesia:delete({Tab, 4}), + ok = mnesia:write({Tab, 6, ff, nil}), + ok = mnesia:write({Tab, 7, gg, "123"}), + ok = mnesia:write({Tab, 100, x, nil}), + ok = mnesia:delete_object({Tab,3,c,"123"}), + ok = mnesia:delete_object({Tab,5,e,nil}), + Res = mnesia:index_read(Tab, <<"123">>, {pfx}), + SetRes = [{Tab,1,aa,"1234"}, {Tab,7,gg,"123"}, {Tab,8,h,"123"}], + case Type of + set -> + SetRes = lists:sort(Res); + ordered_set -> + SetRes = Res; + bag -> + [{Tab,1,a,"123"}, {Tab,1,aa,"1234"}, + {Tab,7,gg,"123"}, {Tab,8,h,"123"}] = lists:sort(Res) + end + end). + +%% ============================================================ +%% +ix_prefixes(_Tab, _Pos, Obj) -> + lists:foldl( + fun(V, Acc) when is_list(V) -> + try Pfxs = prefixes(list_to_binary(V)), + Pfxs ++ Acc + catch + error:_ -> + Acc + end; + (V, Acc) when is_binary(V) -> + Pfxs = prefixes(V), + Pfxs ++ Acc; + (_, Acc) -> + Acc + end, [], tl(tuple_to_list(Obj))). + +ix_prefixes2(Tab, Pos, Obj) -> + [rev(P) || P <- ix_prefixes(Tab, Pos, Obj)]. + +rev(B) when is_binary(B) -> + list_to_binary(lists:reverse(binary_to_list(B))). + +prefixes(<<P:3/binary, _/binary>>) -> + [P]; +prefixes(_) -> + []. diff --git a/lib/mnesia/test/mt.erl b/lib/mnesia/test/mt.erl index 5a981bf539..037d6adb38 100644 --- a/lib/mnesia/test/mt.erl +++ b/lib/mnesia/test/mt.erl @@ -67,6 +67,7 @@ alias(recovery) -> mnesia_recovery_test; alias(registry) -> mnesia_registry_test; alias(suite) -> mnesia_SUITE; alias(trans) -> mnesia_trans_access_test; +alias(ixp) -> mnesia_index_plugin_test; alias(Other) -> Other. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index 9bcd99fba3..ff3250b383 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -233,9 +233,13 @@ countryName ATTRIBUTE-TYPE-AND-VALUE-CLASS ::= { -- regarding how to handle and sometimes accept incorrect certificates -- we define and use the type below instead of X520countryName + -- We accept utf8String encoding of the US-ASCII + -- country name code and the mix up with other country code systems + -- that uses three characters instead of two. + OTP-X520countryname ::= CHOICE { - printableString PrintableString (SIZE (2)), - utf8String UTF8String (SIZE (2)) + printableString PrintableString (SIZE (2..3)), + utf8String UTF8String (SIZE (2..3)) } serialNumber ATTRIBUTE-TYPE-AND-VALUE-CLASS ::= { diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 9fcedf6ef9..fb81ea68a4 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -423,7 +423,7 @@ <p>Available options:</p> <taglist> - <tag>{verify_fun, fun()}</tag> + <tag>{verify_fun, {fun(), InitialUserState::term()}</tag> <item> <p>The fun must be defined as:</p> diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 806f7c5b0f..e6bcedd1b1 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -42,15 +42,14 @@ encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, KeyDevParams)); - encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data)); - encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, KeyDevParams)). + %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). %% @@ -59,21 +58,20 @@ encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_decrypt(des_cbc, Key, IV, Data); - decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, crypto:block_decrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); - decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), crypto:block_decrypt(rc2_cbc, Key, IV, Data); +decode(Data, Password,"AES-128-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_decrypt(aes_cbc128, Key, IV, Data); +decode(Data, Password,"AES-256-CBC"= Cipher, KeyDevParams) -> + {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), + crypto:block_decrypt(aes_cbc256, Key, IV, Data). -decode(Data, Password,"AES-128-CBC"= Cipher, IV) -> - %% PKCS5_SALT_LEN is 8 bytes - <<Salt:8/binary,_/binary>> = IV, - {Key, _} = password_to_key_and_iv(Password, Cipher, Salt), - crypto:block_decrypt(aes_cbc128, Key, IV, Data). %%-------------------------------------------------------------------- -spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary(). @@ -131,13 +129,15 @@ password_to_key_and_iv(Password, _Cipher, {#'PBEParameter'{salt = Salt, <<Key:8/binary, IV:8/binary, _/binary>> = pbdkdf1(Password, Salt, Count, Hash), {Key, IV}; -password_to_key_and_iv(Password, Cipher, Salt) -> - KeyLen = derived_key_length(Cipher, undefined), +password_to_key_and_iv(Password, Cipher, KeyDevParams) -> + %% PKCS5_SALT_LEN is 8 bytes + <<Salt:8/binary,_/binary>> = KeyDevParams, + KeyLen = derived_key_length(Cipher, undefined), <<Key:KeyLen/binary, _/binary>> = pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5), %% Old PEM encryption does not use standard encryption method - %% pbdkdf1 and uses then salt as IV - {Key, Salt}. + %% pbdkdf1 + {Key, KeyDevParams}. pem_encrypt(_, _, _, 0, Acc, _) -> Acc; pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> @@ -267,7 +267,9 @@ derived_key_length(Cipher,_) when (Cipher == ?'des-EDE3-CBC') or (Cipher == "DES-EDE3-CBC") -> 24; derived_key_length(Cipher,_) when (Cipher == "AES-128-CBC") -> - 16. + 16; +derived_key_length(Cipher,_) when (Cipher == "AES-256-CBC") -> + 32. cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'desCBC'}) -> "DES-CBC"; diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index d7e5bc3ad8..0fd1453f7c 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -101,10 +101,10 @@ encode_pem_entry({'PrivateKeyInfo', Der, EncParams}) -> EncDer = encode_encrypted_private_keyinfo(Der, EncParams), StartStr = pem_start('EncryptedPrivateKeyInfo'), [StartStr, "\n", b64encode_and_split(EncDer), "\n", pem_end(StartStr) ,"\n\n"]; -encode_pem_entry({Type, Der, {Cipher, Salt}}) -> +encode_pem_entry({Type, Decrypted, {Cipher, Salt}}) -> StartStr = pem_start(Type), [StartStr,"\n", pem_decrypt(),"\n", pem_decrypt_info(Cipher, Salt),"\n\n", - b64encode_and_split(Der), "\n", pem_end(StartStr) ,"\n\n"]. + b64encode_and_split(Decrypted), "\n", pem_end(StartStr) ,"\n\n"]. decode_pem_entries([], Entries) -> lists:reverse(Entries); diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index 523c9e2515..1136267411 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.erl @@ -37,7 +37,7 @@ all() -> [ pbdkdf1, pbdkdf2, - old_enc, + old_pbe, pbes1, pbes2]. @@ -197,23 +197,11 @@ pbdkdf2(Config) when is_list(Config) -> = pubkey_pbe:pbdkdf2("pass\0word", "sa\0lt", 4096, 16, fun crypto:hmac/4, sha, 20). -old_enc() -> - [{doc,"Tests encode/decode RSA key encrypted with different ciphers using old PEM encryption scheme"}]. -old_enc(Config) when is_list(Config) -> - Datadir = proplists:get_value(data_dir, Config), - %% key generated with ssh-keygen -N hello_aes -f old_aes_128_cbc_enc_key.pem - {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "old_aes_128_cbc_enc_key.pem")), - - PemAesCbcEntry = public_key:pem_decode(PemAesCbc), - ct:print("Pem entry: ~p" , [PemAesCbcEntry]), - [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = PubAesCbcEntry] = PemAesCbcEntry, - #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"). - pbes1() -> [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES1"}]. pbes1(Config) when is_list(Config) -> decode_encode_key_file("pbes1_des_cbc_md5_enc_key.pem", "password", "DES-CBC", Config). - + pbes2() -> [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES2"}]. pbes2(Config) when is_list(Config) -> @@ -225,13 +213,33 @@ pbes2(Config) when is_list(Config) -> false -> ok end. +old_pbe() -> + [{doc,"Tests encode/decode with old format used before PBE"}]. +old_pbe(Config) when is_list(Config) -> + Datadir = proplists:get_value(data_dir, Config), + % key generated with ssh-keygen -N hello_aes -f old_aes_128_cbc.pem + {ok, PemAes128Cbc} = file:read_file(filename:join(Datadir, "old_aes_128_cbc.pem")), + + PemAes128CbcEntries = public_key:pem_decode(PemAes128Cbc), + ct:print("Pem entry: ~p" , [PemAes128CbcEntries]), + [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = Aes128CbcEntry] = PemAes128CbcEntries, + #'RSAPrivateKey'{} = Key = public_key:pem_entry_decode(Aes128CbcEntry, "hello_aes"), + + %% Converted with openssl rsa -in old_aes_128_cbc.pem -out old_aes_256_cbc.pem -aes256 + {ok, PemAes256Cbc} = file:read_file(filename:join(Datadir, "old_aes_256_cbc.pem")), + + PemAes256CbcEntries = public_key:pem_decode(PemAes256Cbc), + ct:print("Pem entry: ~p" , [PemAes256CbcEntries]), + [{'RSAPrivateKey', _, {"AES-256-CBC",_}} = Aes256CbcEntry] = PemAes256CbcEntries, + Key = public_key:pem_entry_decode(Aes256CbcEntry, "hello_aes"). + decode_encode_key_file(File, Password, Cipher, Config) -> Datadir = proplists:get_value(data_dir, Config), {ok, PemKey} = file:read_file(filename:join(Datadir, File)), PemEntry = public_key:pem_decode(PemKey), - ct:print("Pem entry: ~p" , [PemEntry]), + ct:pal("Pem entry: ~p" , [PemEntry]), [{Asn1Type, _, {Cipher,_} = CipherInfo} = PubEntry] = PemEntry, #'RSAPrivateKey'{} = KeyInfo = public_key:pem_entry_decode(PubEntry, Password), PemKey1 = public_key:pem_encode([public_key:pem_entry_encode(Asn1Type, KeyInfo, {CipherInfo, Password})]), diff --git a/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc.pem index 34c7543f30..34c7543f30 100644 --- a/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc.pem diff --git a/lib/public_key/test/pbe_SUITE_data/old_aes_256_cbc.pem b/lib/public_key/test/pbe_SUITE_data/old_aes_256_cbc.pem new file mode 100644 index 0000000000..e6aec2869d --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/old_aes_256_cbc.pem @@ -0,0 +1,30 @@ +-----BEGIN RSA PRIVATE KEY----- +Proc-Type: 4,ENCRYPTED +DEK-Info: AES-256-CBC,ABDA22398E511E9465983E1A50706044 + +XhIcPOb6pTWL++pgeeTH5rsx0tackhllVqyXyOfbYMBJnVFRhQ/V/1MDg3Jt4wD1 +Nerhcv5srHeiwmf+vwXwDFOzvFzLVM1jFMUJe/2XloYFX4TBiLZAF/zekQA3uPY6 +DKJuBuO5vVSZ0VlxGpu3jphIAwxbssfZkZmryCP3b1/oX5Y3Em/wEWW3RduaeWFu +Z2nTsPH3yNmHkuqFF3cq0aZs+VxtjcuYo0gbkN5hNVgOoOVxIBzw7DsgBAkdXvr3 +LRCMGg7Y2pVthA963s0xkN37XtZEiYbydoLnzHlW/Kx5QSvED8/Fn94Lcdy5NsQN +7nYWWgYZRH39Wnsi0BrTZv399U5rBe7DnpStKWPn2Sa8Bdu3CX2oLajM1cZjAp1X +y6vuasK7SoZ8rWpcsHQpV1HyNBTl/uRU5nrYc/KGD8l2x7tdNidGx2Hey/6O4H5v +rxL1TB4PlzDYwCsReuyLbEjyuZQ10j0SK/SFzikHuvD2IEpM/oUaPdVFqcW8/sjw +VhcsupAf4EXfsi2dJBylmDjI2W7h9XwBDLzQN+69DtkBmvimE5CguTITf8MAHQQ6 +Q1vYF2ij7W675tj9ulksRPaMxSsI03luai/Jrieh0mPqGEenGEEC5QU0XPOvsfyw +GMYaBUbdYrMpbHM3wFPxM2wRlXf4gX5BhZKRGZX7OaEs54pfglyQtTPuZmD0VcAp +EWHq70G9mbuBlhbMX1rKAomuDmIvgLeLRUpAFf59Qr8KoJSLD1S8TJB3uEPk6i39 +4GnylbpmqS4gv/OIc6WTeOeUZTAD3A77HBwSlELPk3/s1d/MLyfciYClOBEuZ6NB +FXEKCGCEC786zJA678gLEaa2XPNkEM+2gjzNFqtYMIn5ehAq/HRRsFvW+wkTbee4 +z+qe5HbVKAQ3EOfbidvYrDaGd7HvHVG8zosl+O61iIFs04lLEMDFXBIdvIgEncOK +Rq3yXdpBKMg89aoZLniaPobSvuvdjNOMzW6EKlb5FKZduCiR68MEZ+rLHYHTwE3W +Z5+TCbrbV2F6WQpq3zqnB14wGu8igEb5Veq+N2vMkx4iTMTUyCty1SwIjj4NidM1 +dJM7Ighdal6tQ6hIwbDfpIPsY4eGH/UrdVZ0SkxuDR2s76cZ8nFX3lJ/BNwTZLKo +IqAC4NjUOv3ID+0Q6Lz+sxLCi5pLYUf0E+s4pgi1BYAOu+BF3GwxyqnqVoq/Fs5D +LXxuY0946YM+WcrYzke4mq3MPx6QQYj04H5KJ2mzxtnbZJrfLF23PVRVhvgKSjyV +I3/zgJ16fV2H/fb26oCpTNbb11pQvhorkLwdvpwtM+go7dJGebAi1762Nbj/CqnW +fbBPxPRvNPZn6pEodJ/L/APhvGv1K7eC9THj66H7Kmeoq8Lz74idhywP9I3QS0ZO +15ORbTDjuiRYNJPxxu79A3/tWMUlprJ9ljhI/0DXRB0M3UGic52D/32Q64I7eewy +qRNS/3C3ejDShIRBDFTdDkM3s/42LySXJjmjU9bpZY4POQ3kOaJb3EzSvbzTyXzu +3FiHvDQY+b8XwbxtE/kTMaAPQZ7TtWOao7SRi7J94MvCQ5/tbakFP2suM8psnigC +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 9ff20454cd..1f4e281a30 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -162,14 +162,14 @@ supported_algorithms(cipher) -> select_crypto_supported( [ {'[email protected]', [{ciphers,chacha20}, {macs,poly1305}]}, - {'[email protected]', [{ciphers,{aes_gcm,256}}]}, - {'aes256-ctr', [{ciphers,{aes_ctr,256}}]}, - {'aes192-ctr', [{ciphers,{aes_ctr,192}}]}, - {'[email protected]', [{ciphers,{aes_gcm,128}}]}, - {'aes128-ctr', [{ciphers,{aes_ctr,128}}]}, - {'AEAD_AES_256_GCM', [{ciphers,{aes_gcm,256}}]}, - {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, - {'aes128-cbc', [{ciphers,aes_cbc128}]}, + {'[email protected]', [{ciphers,aes_256_gcm}]}, + {'aes256-ctr', [{ciphers,aes_256_ctr}]}, + {'aes192-ctr', [{ciphers,aes_192_ctr}]}, + {'[email protected]', [{ciphers,aes_128_gcm}]}, + {'aes128-ctr', [{ciphers,aes_128_ctr}]}, + {'AEAD_AES_256_GCM', [{ciphers,aes_256_gcm}]}, + {'AEAD_AES_128_GCM', [{ciphers,aes_128_gcm}]}, + {'aes128-cbc', [{ciphers,aes_128_cbc}]}, {'3des-cbc', [{ciphers,des3_cbc}]} ] )); @@ -179,8 +179,8 @@ supported_algorithms(mac) -> [{'hmac-sha2-256', [{macs,hmac}, {hashs,sha256}]}, {'hmac-sha2-512', [{macs,hmac}, {hashs,sha512}]}, {'hmac-sha1', [{macs,hmac}, {hashs,sha}]}, - {'AEAD_AES_128_GCM', [{ciphers,{aes_gcm,128}}]}, - {'AEAD_AES_256_GCM', [{ciphers,{aes_gcm,256}}]} + {'AEAD_AES_128_GCM', [{ciphers,aes_128_gcm}]}, + {'AEAD_AES_256_GCM', [{ciphers,aes_256_gcm}]} ] )); supported_algorithms(compression) -> @@ -1256,11 +1256,6 @@ get_length(aead, EncryptedBuffer, Ssh) -> end. -pkt_type('AEAD_AES_128_GCM') -> aead; -pkt_type('AEAD_AES_256_GCM') -> aead; -pkt_type('[email protected]') -> aead; -pkt_type(_) -> common. - payload(<<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) -> PayloadLen = PacketLen - PaddingLen - 1, <<Payload:PayloadLen/binary, _/binary>> = PayloadAndPadding, @@ -1323,162 +1318,115 @@ verify(PlainText, HashAlg, Sig, Key, _) -> %%% Unit: bytes --record(cipher_data, { - key_bytes, - iv_bytes, - block_bytes - }). +-record(cipher, { + impl, + key_bytes, + iv_bytes, + block_bytes, + pkt_type = common + }). %%% Start of a more parameterized crypto handling. cipher('AEAD_AES_128_GCM') -> - #cipher_data{key_bytes = 16, - iv_bytes = 12, - block_bytes = 16}; + #cipher{key_bytes = 16, + iv_bytes = 12, + block_bytes = 16, + pkt_type = aead}; cipher('AEAD_AES_256_GCM') -> - #cipher_data{key_bytes = 32, - iv_bytes = 12, - block_bytes = 16}; + #cipher{key_bytes = 32, + iv_bytes = 12, + block_bytes = 16, + pkt_type = aead}; cipher('3des-cbc') -> - #cipher_data{key_bytes = 24, - iv_bytes = 8, - block_bytes = 8}; + #cipher{impl = des3_cbc, + key_bytes = 24, + iv_bytes = 8, + block_bytes = 8}; cipher('aes128-cbc') -> - #cipher_data{key_bytes = 16, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_cbc, + key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; cipher('aes128-ctr') -> - #cipher_data{key_bytes = 16, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_128_ctr, + key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; cipher('aes192-ctr') -> - #cipher_data{key_bytes = 24, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_192_ctr, + key_bytes = 24, + iv_bytes = 16, + block_bytes = 16}; cipher('aes256-ctr') -> - #cipher_data{key_bytes = 32, - iv_bytes = 16, - block_bytes = 16}; + #cipher{impl = aes_256_ctr, + key_bytes = 32, + iv_bytes = 16, + block_bytes = 16}; cipher('[email protected]') -> % FIXME: Verify!! - #cipher_data{key_bytes = 32, - iv_bytes = 12, - block_bytes = 8}. - + #cipher{key_bytes = 32, + iv_bytes = 12, + block_bytes = 8, + pkt_type = aead}; + +cipher(_) -> + #cipher{}. + + +pkt_type(SshCipher) -> (cipher(SshCipher))#cipher.pkt_type. + +decrypt_magic(server) -> {"A", "C"}; +decrypt_magic(client) -> {"B", "D"}. + +encrypt_magic(client) -> decrypt_magic(server); +encrypt_magic(server) -> decrypt_magic(client). + encrypt_init(#ssh{encrypt = none} = Ssh) -> {ok, Ssh}; -encrypt_init(#ssh{encrypt = '[email protected]', role = client} = Ssh) -> + +encrypt_init(#ssh{encrypt = '[email protected]', role = Role} = Ssh) -> %% [email protected] uses two independent crypto streams, one (chacha20) %% for the length used in stream mode, and the other (chacha20-poly1305) as AEAD for %% the payload and to MAC the length||payload. %% See draft-josefsson-ssh-chacha20-poly1305-openssh-00 - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "C", 512), + {_, KeyMagic} = encrypt_magic(Role), + <<K2:32/binary,K1:32/binary>> = hash(Ssh, KeyMagic, 8*64), {ok, Ssh#ssh{encrypt_keys = {K1,K2} % encrypt_block_size = 16, %default = 8. What to set it to? 64 (openssl chacha.h) % ctx and iv is setup for each packet }}; -encrypt_init(#ssh{encrypt = '[email protected]', role = server} = Ssh) -> - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "D", 512), - {ok, Ssh#ssh{encrypt_keys = {K1,K2} - % encrypt_block_size = 16, %default = 8. What to set it to? - }}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:16/binary>> = hash(Ssh, "C", 128), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:16/binary>> = hash(Ssh, "D", 128), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_256_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:32/binary>> = hash(Ssh, "C", 256), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'AEAD_AES_256_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:32/binary>> = hash(Ssh, "D", 256), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = '3des-cbc', role = client} = Ssh) -> - IV = hash(Ssh, "A", 64), - <<K1:8/binary, K2:8/binary, K3:8/binary>> = hash(Ssh, "C", 192), - {ok, Ssh#ssh{encrypt_keys = {K1,K2,K3}, - encrypt_block_size = 8, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = '3des-cbc', role = server} = Ssh) -> - IV = hash(Ssh, "B", 64), - <<K1:8/binary, K2:8/binary, K3:8/binary>> = hash(Ssh, "D", 192), - {ok, Ssh#ssh{encrypt_keys = {K1,K2,K3}, - encrypt_block_size = 8, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'aes128-cbc', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:16/binary>> = hash(Ssh, "C", 128), + +encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; + SshCipher == 'AEAD_AES_256_GCM' -> + {IvMagic, KeyMagic} = encrypt_magic(Role), + #cipher{key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, + encrypt_block_size = BlockBytes, encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'aes128-cbc', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:16/binary>> = hash(Ssh, "D", 128), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = IV}}; -encrypt_init(#ssh{encrypt = 'aes128-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:16/binary>> = hash(Ssh, "C", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes192-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:24/binary>> = hash(Ssh, "C", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes256-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:32/binary>> = hash(Ssh, "C", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes128-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:16/binary>> = hash(Ssh, "D", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes192-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:24/binary>> = hash(Ssh, "D", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}; -encrypt_init(#ssh{encrypt = 'aes256-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:32/binary>> = hash(Ssh, "D", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{encrypt_keys = K, - encrypt_block_size = 16, - encrypt_ctx = State}}. + +encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) -> + {IvMagic, KeyMagic} = encrypt_magic(Role), + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), + Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, true), + {ok, Ssh#ssh{encrypt_block_size = BlockBytes, + encrypt_ctx = Ctx0}}. encrypt_final(Ssh) -> {ok, Ssh#ssh{encrypt = none, @@ -1487,249 +1435,126 @@ encrypt_final(Ssh) -> encrypt_ctx = undefined }}. + encrypt(#ssh{encrypt = none} = Ssh, Data) -> {Ssh, Data}; + encrypt(#ssh{encrypt = '[email protected]', encrypt_keys = {K1,K2}, send_sequence = Seq} = Ssh, <<LenData:4/binary, PayloadData/binary>>) -> %% Encrypt length IV1 = <<0:8/unit:8, Seq:8/unit:8>>, - {_,EncLen} = crypto:stream_encrypt(crypto:stream_init(chacha20, K1, IV1), - LenData), + EncLen = crypto:crypto_one_shot(chacha20, K1, IV1, LenData, true), %% Encrypt payload IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - {_,EncPayloadData} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, IV2), - PayloadData), - + EncPayloadData = crypto:crypto_one_shot(chacha20, K2, IV2, PayloadData, true), %% MAC tag - {_,PolyKey} = crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), - <<0:32/unit:8>>), + PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), EncBytes = <<EncLen/binary,EncPayloadData/binary>>, Ctag = crypto:poly1305(PolyKey, EncBytes), %% Result {Ssh, {EncBytes,Ctag}}; -encrypt(#ssh{encrypt = 'AEAD_AES_128_GCM', - encrypt_keys = K, + +encrypt(#ssh{encrypt = SshCipher, + encrypt_keys = K, encrypt_ctx = IV0} = Ssh, - <<LenData:4/binary, PayloadData/binary>>) -> - {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), - IV = next_gcm_iv(IV0), - {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; -encrypt(#ssh{encrypt = 'AEAD_AES_256_GCM', - encrypt_keys = K, - encrypt_ctx = IV0} = Ssh, - <<LenData:4/binary, PayloadData/binary>>) -> + <<LenData:4/binary, PayloadData/binary>>) when SshCipher == 'AEAD_AES_128_GCM' ; + SshCipher == 'AEAD_AES_256_GCM' -> {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), IV = next_gcm_iv(IV0), {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; -encrypt(#ssh{encrypt = '3des-cbc', - encrypt_keys = {K1,K2,K3}, - encrypt_ctx = IV0} = Ssh, Data) -> - Enc = crypto:block_encrypt(des3_cbc, [K1,K2,K3], IV0, Data), - IV = crypto:next_iv(des3_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}; -encrypt(#ssh{encrypt = 'aes128-cbc', - encrypt_keys = K, - encrypt_ctx = IV0} = Ssh, Data) -> - Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), - IV = crypto:next_iv(aes_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}; -encrypt(#ssh{encrypt = 'aes128-ctr', - encrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_encrypt(State0,Data), - {Ssh#ssh{encrypt_ctx = State}, Enc}; -encrypt(#ssh{encrypt = 'aes192-ctr', - encrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_encrypt(State0,Data), - {Ssh#ssh{encrypt_ctx = State}, Enc}; -encrypt(#ssh{encrypt = 'aes256-ctr', - encrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_encrypt(State0,Data), - {Ssh#ssh{encrypt_ctx = State}, Enc}. - +encrypt(#ssh{encrypt_ctx = Ctx0} = Ssh, Data) -> + Enc = crypto:crypto_update(Ctx0, Data), + {Ssh, Enc}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Decryption %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% decrypt_init(#ssh{decrypt = none} = Ssh) -> {ok, Ssh}; -decrypt_init(#ssh{decrypt = '[email protected]', role = client} = Ssh) -> - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "D", 512), - {ok, Ssh#ssh{decrypt_keys = {K1,K2} - }}; -decrypt_init(#ssh{decrypt = '[email protected]', role = server} = Ssh) -> - <<K2:32/binary,K1:32/binary>> = hash(Ssh, "C", 512), + +decrypt_init(#ssh{decrypt = '[email protected]', role = Role} = Ssh) -> + {_, KeyMagic} = decrypt_magic(Role), + <<K2:32/binary,K1:32/binary>> = hash(Ssh, KeyMagic, 8*64), {ok, Ssh#ssh{decrypt_keys = {K1,K2} }}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:16/binary>> = hash(Ssh, "D", 128), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_128_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:16/binary>> = hash(Ssh, "C", 128), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_256_GCM', role = client} = Ssh) -> - IV = hash(Ssh, "B", 12*8), - <<K:32/binary>> = hash(Ssh, "D", 256), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = 'AEAD_AES_256_GCM', role = server} = Ssh) -> - IV = hash(Ssh, "A", 12*8), - <<K:32/binary>> = hash(Ssh, "C", 256), + +decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; + SshCipher == 'AEAD_AES_256_GCM' -> + {IvMagic, KeyMagic} = decrypt_magic(Role), + #cipher{key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, + decrypt_block_size = BlockBytes, decrypt_ctx = IV}}; -decrypt_init(#ssh{decrypt = '3des-cbc', role = client} = Ssh) -> - {IV, KD} = {hash(Ssh, "B", 64), - hash(Ssh, "D", 192)}, - <<K1:8/binary, K2:8/binary, K3:8/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = {K1,K2,K3}, decrypt_ctx = IV, - decrypt_block_size = 8}}; -decrypt_init(#ssh{decrypt = '3des-cbc', role = server} = Ssh) -> - {IV, KD} = {hash(Ssh, "A", 64), - hash(Ssh, "C", 192)}, - <<K1:8/binary, K2:8/binary, K3:8/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = {K1, K2, K3}, decrypt_ctx = IV, - decrypt_block_size = 8}}; -decrypt_init(#ssh{decrypt = 'aes128-cbc', role = client} = Ssh) -> - {IV, KD} = {hash(Ssh, "B", 128), - hash(Ssh, "D", 128)}, - <<K:16/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}; -decrypt_init(#ssh{decrypt = 'aes128-cbc', role = server} = Ssh) -> - {IV, KD} = {hash(Ssh, "A", 128), - hash(Ssh, "C", 128)}, - <<K:16/binary>> = KD, - {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}; -decrypt_init(#ssh{decrypt = 'aes128-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:16/binary>> = hash(Ssh, "D", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes192-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:24/binary>> = hash(Ssh, "D", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes256-ctr', role = client} = Ssh) -> - IV = hash(Ssh, "B", 128), - <<K:32/binary>> = hash(Ssh, "D", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes128-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:16/binary>> = hash(Ssh, "C", 128), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes192-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:24/binary>> = hash(Ssh, "C", 192), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}; -decrypt_init(#ssh{decrypt = 'aes256-ctr', role = server} = Ssh) -> - IV = hash(Ssh, "A", 128), - <<K:32/binary>> = hash(Ssh, "C", 256), - State = crypto:stream_init(aes_ctr, K, IV), - {ok, Ssh#ssh{decrypt_keys = K, - decrypt_block_size = 16, - decrypt_ctx = State}}. - +decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) -> + {IvMagic, KeyMagic} = decrypt_magic(Role), + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, + iv_bytes = IvBytes, + block_bytes = BlockBytes} = cipher(SshCipher), + IV = hash(Ssh, IvMagic, 8*IvBytes), + K = hash(Ssh, KeyMagic, 8*KeyBytes), + Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, false), + {ok, Ssh#ssh{decrypt_block_size = BlockBytes, + decrypt_ctx = Ctx0}}. + decrypt_final(Ssh) -> {ok, Ssh#ssh {decrypt = none, decrypt_keys = undefined, decrypt_ctx = undefined, decrypt_block_size = 8}}. + decrypt(Ssh, <<>>) -> {Ssh, <<>>}; + decrypt(#ssh{decrypt = '[email protected]', decrypt_keys = {K1,_K2}, recv_sequence = Seq} = Ssh, {length,EncryptedLen}) -> - {_State,PacketLenBin} = - crypto:stream_decrypt(crypto:stream_init(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>), - EncryptedLen), + PacketLenBin = crypto:crypto_one_shot(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>, EncryptedLen, false), {Ssh, PacketLenBin}; + decrypt(#ssh{decrypt = '[email protected]', decrypt_keys = {_K1,K2}, recv_sequence = Seq} = Ssh, {AAD,Ctext,Ctag}) -> %% The length is already decoded and used to divide the input %% Check the mac (important that it is timing-safe): - {_,PolyKey} = - crypto:stream_encrypt(crypto:stream_init(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>), - <<0:32/unit:8>>), + PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of true -> %% MAC is ok, decode IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - {_,PlainText} = - crypto:stream_decrypt(crypto:stream_init(chacha20,K2,IV2), Ctext), + PlainText = crypto:crypto_one_shot(chacha20, K2, IV2, Ctext, false), {Ssh, PlainText}; false -> {Ssh,error} end; + decrypt(#ssh{decrypt = none} = Ssh, Data) -> {Ssh, Data}; -decrypt(#ssh{decrypt = 'AEAD_AES_128_GCM', - decrypt_keys = K, - decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) -> - Dec = crypto:block_decrypt(aes_gcm, K, IV0, Data), % Dec = PlainText | error - IV = next_gcm_iv(IV0), - {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = 'AEAD_AES_256_GCM', + +decrypt(#ssh{decrypt = SshCipher, decrypt_keys = K, - decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) -> + decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) when SshCipher == 'AEAD_AES_128_GCM' ; + SshCipher == 'AEAD_AES_256_GCM' -> Dec = crypto:block_decrypt(aes_gcm, K, IV0, Data), % Dec = PlainText | error IV = next_gcm_iv(IV0), {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = '3des-cbc', decrypt_keys = Keys, - decrypt_ctx = IV0} = Ssh, Data) -> - {K1, K2, K3} = Keys, - Dec = crypto:block_decrypt(des3_cbc, [K1,K2,K3], IV0, Data), - IV = crypto:next_iv(des3_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, - decrypt_ctx = IV0} = Ssh, Data) -> - Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), - IV = crypto:next_iv(aes_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}; -decrypt(#ssh{decrypt = 'aes128-ctr', - decrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_decrypt(State0,Data), - {Ssh#ssh{decrypt_ctx = State}, Enc}; -decrypt(#ssh{decrypt = 'aes192-ctr', - decrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_decrypt(State0,Data), - {Ssh#ssh{decrypt_ctx = State}, Enc}; -decrypt(#ssh{decrypt = 'aes256-ctr', - decrypt_ctx = State0} = Ssh, Data) -> - {State, Enc} = crypto:stream_decrypt(State0,Data), - {Ssh#ssh{decrypt_ctx = State}, Enc}. +decrypt(#ssh{decrypt_ctx = Ctx0} = Ssh, Data) -> + Dec = crypto:crypto_update(Ctx0, Data), + {Ssh, Dec}. next_gcm_iv(<<Fixed:32, InvCtr:64>>) -> <<Fixed:32, (InvCtr+1):64>>. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compression %% @@ -2058,9 +1883,9 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> dh_bits(#alg{encrypt = Encrypt, send_mac = SendMac}) -> C = cipher(Encrypt), - 8 * lists:max([C#cipher_data.key_bytes, - C#cipher_data.block_bytes, - C#cipher_data.iv_bytes, + 8 * lists:max([C#cipher.key_bytes, + C#cipher.block_bytes, + C#cipher.iv_bytes, mac_key_bytes(SendMac) ]). @@ -2091,40 +1916,13 @@ select_crypto_supported(L) -> crypto_supported(Conditions, Supported) -> lists:all( fun({Tag,CryptoName}) when is_atom(CryptoName) -> - crypto_name_supported(Tag,CryptoName,Supported); - ({Tag,{Name,Len}}) when is_integer(Len) -> - crypto_name_supported(Tag,Name,Supported) andalso - len_supported(Name,Len) + crypto_name_supported(Tag,CryptoName,Supported) end, Conditions). crypto_name_supported(Tag, CryptoName, Supported) -> - Vs = case proplists:get_value(Tag,Supported,[]) of - [] when Tag == curves -> crypto:ec_curves(); - L -> L - end, + Vs = proplists:get_value(Tag,Supported,[]), lists:member(CryptoName, Vs). -len_supported(Name, Len) -> - try - case Name of - aes_ctr -> - {_, <<_/binary>>} = - %% Test encryption - crypto:stream_encrypt(crypto:stream_init(Name, <<0:Len>>, <<0:128>>), <<"">>); - aes_gcm -> - {<<_/binary>>, <<_/binary>>} = - crypto:block_encrypt(Name, - _Key = <<0:Len>>, - _IV = <<0:12/unsigned-unit:8>>, - {<<"AAD">>,"PT"}) - end - of - _ -> true - catch - _:_ -> false - end. - - same(Algs) -> [{client2server,Algs}, {server2client,Algs}]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 732fdc71e7..a511cb4db3 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,30 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The timeout for a passive receive was sometimes not + cancelled and later caused a server crash. This bug has + now been corrected.</p> + <p> + Own Id: OTP-14701 Aux Id: ERL-883, ERL-884 </p> + </item> + <item> + <p> + Add tag for passive message (active N) in cb_info to + retain transport transparency.</p> + <p> + Own Id: OTP-15679 Aux Id: ERL-861 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index b145aac6ab..37bf9033a1 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -101,16 +101,21 @@ <datatype> <name name="transport_option"/> <desc> - <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> - for TLS and <c>{gen_udp, udp, udp_closed, udp_error}</c> for - DTLS. Can be used to customize the transport layer. The tag - values should be the values used by the underlying transport - in its active mode messages. For TLS the callback module must implement a - reliable transport protocol, behave as <c>gen_tcp</c>, and have functions - corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, - <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>. - The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> - directly. For DTLS this feature must be considered exprimental. + <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error, + tcp_passive}</c> for TLS (for backward compatibility a four + tuple will be converted to a five tuple with the last element + "second_element"_passive) and <c>{gen_udp, udp, udp_closed, + udp_error}</c> for DTLS (might also be changed to five tuple in + the future). Can be used to customize the transport layer. The + tag values should be the values used by the underlying + transport in its active mode messages. For TLS the callback + module must implement a reliable transport protocol, behave as + <c>gen_tcp</c>, and have functions corresponding to + <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, + <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and + <c>inet:port/1</c>. The callback <c>gen_tcp</c> is treated + specially and calls <c>inet</c> directly. For DTLS this + feature must be considered exprimental. </p> </desc> </datatype> @@ -1658,17 +1663,6 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 22.0">set_log_level(Level) -> ok | {error, Reason}</name> - <fsummary>Sets log level for the SSL application.</fsummary> - <type> - <v>Level = atom()</v> - </type> - <desc> - <p>Sets log level for the SSL application.</p> - </desc> - </func> - - <func> <name since="OTP R14B">shutdown(SslSocket, How) -> ok | {error, Reason}</name> <fsummary>Immediately closes a socket.</fsummary> <type> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 5a2d31ffc2..bfa349c8d8 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -55,8 +55,7 @@ format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc --export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1, - set_log_level/1]). +-export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1]). -deprecated({ssl_accept, 1, eventually}). -deprecated({ssl_accept, 2, eventually}). @@ -96,7 +95,9 @@ -type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | {ssl_error, sslsocket(), Reason::term()} | {ssl_passive, sslsocket()}. -type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), - ClosedTag::atom(), ErrTag::atom()}}. + ClosedTag::atom(), ErrTag::atom()}} | + {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag::atom(), PassiveTag::atom()}}. -type host() :: hostname() | ip_address(). -type hostname() :: string(). -type ip_address() :: inet:ip_address(). @@ -422,9 +423,9 @@ connect(Socket, SslOptions) when is_port(Socket) -> timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. connect(Socket, SslOptions0, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> - {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, - {gen_tcp, tcp, tcp_closed, tcp_error}), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> + CbInfo = handle_option(cb_info, SslOptions0, default_cb_info(tls)), + Transport = element(1, CbInfo), EmulatedOptions = tls_socket:emulated_options(), {ok, SocketValues} = tls_socket:getopts(Transport, Socket, EmulatedOptions), try handle_options(SslOptions0 ++ SocketValues, client) of @@ -572,8 +573,8 @@ handshake(#sslsocket{pid = [Pid|_], fd = {_, _, _}} = Socket, SslOpts, Timeout) end; handshake(Socket, SslOptions, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> - {Transport,_,_,_} = - proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), + CbInfo = handle_option(cb_info, SslOptions, default_cb_info(tls)), + Transport = element(1, CbInfo), EmulatedOptions = tls_socket:emulated_options(), {ok, SocketValues} = tls_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), @@ -625,7 +626,7 @@ close(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> ssl_connection:close(Pid, {close, ?DEFAULT_TIMEOUT}); close(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, _}}}}) -> dtls_packet_demux:close(Pid); -close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}) -> +close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_}}}}) -> Transport:close(ListenSocket). %%-------------------------------------------------------------------- @@ -641,7 +642,7 @@ close(#sslsocket{pid = [TLSPid|_]}, close(#sslsocket{pid = [TLSPid|_]}, Timeout) when is_pid(TLSPid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, Timeout}); -close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}, _) -> +close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_}}}}, _) -> Transport:close(ListenSocket). %%-------------------------------------------------------------------- @@ -657,7 +658,8 @@ send(#sslsocket{pid = {_, #config{transport_info={_, udp, _, _}}}}, _) -> {error,enotconn}; %% Emulate connection behaviour send(#sslsocket{pid = {dtls,_}}, _) -> {error,enotconn}; %% Emulate connection behaviour -send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}}}}, Data) -> +send(#sslsocket{pid = {ListenSocket, #config{transport_info = Info}}}, Data) -> + Transport = element(1, Info), Transport:send(ListenSocket, Data). %% {error,enotconn} %%-------------------------------------------------------------------- @@ -675,7 +677,8 @@ recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid), recv(#sslsocket{pid = {dtls,_}}, _, _) -> {error,enotconn}; recv(#sslsocket{pid = {Listen, - #config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)-> + #config{transport_info = Info}}},_,_) when is_port(Listen)-> + Transport = element(1, Info), Transport:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- @@ -690,7 +693,7 @@ controlling_process(#sslsocket{pid = {dtls, _}}, NewOwner) when is_pid(NewOwner) -> ok; %% Meaningless but let it be allowed to conform with TLS controlling_process(#sslsocket{pid = {Listen, - #config{transport_info = {Transport, _, _, _}}}}, + #config{transport_info = {Transport,_,_,_,_}}}}, NewOwner) when is_port(Listen), is_pid(NewOwner) -> %% Meaningless but let it be allowed to conform with normal sockets @@ -733,13 +736,13 @@ connection_information(#sslsocket{pid = [Pid|_]}, Items) when is_pid(Pid) -> %% %% 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)-> dtls_socket:peername(Transport, Socket); -peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = [Pid|_], fd = {Transport, Socket,_,_}}) when is_pid(Pid)-> tls_socket:peername(Transport, Socket); -peername(#sslsocket{pid = {dtls, #config{dtls_handler = {_Pid, _}}}}) -> +peername(#sslsocket{pid = {dtls, #config{dtls_handler = {_Pid,_}}}}) -> dtls_socket:peername(dtls, undefined); -peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> +peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_,_}}}}) -> tls_socket:peername(Transport, ListenSocket); %% Will return {error, enotconn} peername(#sslsocket{pid = {dtls,_}}) -> {error,enotconn}. @@ -931,7 +934,7 @@ getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = _:Error -> {error, {options, {socket_options, OptionTags, Error}}} end; -getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, +getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try tls_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> @@ -988,7 +991,7 @@ setopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = _:Error -> {error, {options, {socket_options, Options, Error}}} end; -setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try tls_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; @@ -1032,8 +1035,9 @@ getstat(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}, Options) when %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}, +shutdown(#sslsocket{pid = {Listen, #config{transport_info = Info}}}, How) when is_port(Listen) -> + Transport = element(1, Info), Transport:shutdown(Listen, How); shutdown(#sslsocket{pid = {dtls,_}},_) -> {error, enotconn}; @@ -1045,13 +1049,13 @@ shutdown(#sslsocket{pid = [Pid|_]}, How) when is_pid(Pid) -> %% %% 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) -> tls_socket:sockname(Transport, Listen); sockname(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, _}}}}) -> dtls_packet_demux:sockname(Pid); -sockname(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = [Pid|_], fd = {Transport, Socket,_}}) when is_pid(Pid) -> dtls_socket:sockname(Transport, Socket); -sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket,_,_}}) when is_pid(Pid) -> tls_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- @@ -1167,32 +1171,6 @@ suite_to_str(Cipher) -> ssl_cipher_format:suite_to_str(Cipher). -%%-------------------------------------------------------------------- --spec set_log_level(atom()) -> ok | {error, term()}. -%% -%% Description: Set log level for the SSL application -%%-------------------------------------------------------------------- -set_log_level(Level) -> - case application:get_all_key(ssl) of - {ok, PropList} -> - Modules = proplists:get_value(modules, PropList), - set_module_level(Modules, Level); - undefined -> - {error, ssl_not_started} - end. - -set_module_level(Modules, Level) -> - Fun = fun (Module) -> - ok = logger:set_module_level(Module, Level) - end, - try lists:map(Fun, Modules) of - _ -> - ok - catch - error:{badmatch, Error} -> - Error - end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -1211,7 +1189,7 @@ supported_suites(all, Version) -> supported_suites(anonymous, Version) -> ssl_cipher:anonymous_suites(Version). -do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) -> +do_listen(Port, #config{transport_info = {Transport, _, _, _,_}} = Config, tls_connection) -> tls_socket:listen(Transport, Port, Config); do_listen(Port, Config, dtls_connection) -> @@ -1381,7 +1359,7 @@ handle_options(Opts0, Role, Host) -> log_level = handle_option(log_level, Opts, LogLevel) }, - CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), + CbInfo = handle_option(cb_info, Opts, default_cb_info(Protocol)), SslOptions = [protocol, versions, verify, verify_fun, partial_chain, fail_if_no_peer_cert, verify_client_once, depth, cert, certfile, key, keyfile, @@ -1425,6 +1403,10 @@ handle_option(sni_fun, Opts, Default) -> _ -> throw({error, {conflict_options, [sni_fun, sni_hosts]}}) end; +handle_option(cb_info, Opts, Default) -> + CbInfo = proplists:get_value(cb_info, Opts, Default), + true = validate_option(cb_info, CbInfo), + handle_cb_info(CbInfo, Default); handle_option(OptionName, Opts, Default) -> validate_option(OptionName, proplists:get_value(OptionName, Opts, Default)). @@ -1659,9 +1641,29 @@ validate_option(handshake, full = Value) -> Value; validate_option(customize_hostname_check, Value) when is_list(Value) -> Value; +validate_option(cb_info, {V1, V2, V3, V4}) when is_atom(V1), + is_atom(V2), + is_atom(V3), + is_atom(V4) + -> + true; +validate_option(cb_info, {V1, V2, V3, V4, V5}) when is_atom(V1), + is_atom(V2), + is_atom(V3), + is_atom(V4), + is_atom(V5) + -> + true; +validate_option(cb_info, _) -> + false; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). +handle_cb_info({V1, V2, V3, V4}, {_,_,_,_,_}) -> + {V1,V2,V3,V4, list_to_atom(atom_to_list(V2) ++ "passive")}; +handle_cb_info(CbInfo, _) -> + CbInfo. + handle_hashsigns_option(Value, Version) when is_list(Value) andalso Version >= {3, 4} -> case tls_v1:signature_schemes(Version, Value) of @@ -2132,7 +2134,7 @@ default_option_role(_,_,_) -> default_cb_info(tls) -> - {gen_tcp, tcp, tcp_closed, tcp_error}; + {gen_tcp, tcp, tcp_closed, tcp_error, tcp_passive}; default_cb_info(dtls) -> {gen_udp, udp, udp_closed, udp_error}. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index e17476f33b..06b1b005a5 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -161,6 +161,8 @@ description_txt(?INSUFFICIENT_SECURITY) -> "Insufficient Security"; description_txt(?INTERNAL_ERROR) -> "Internal Error"; +description_txt(?INAPPROPRIATE_FALLBACK) -> + "Inappropriate Fallback"; description_txt(?USER_CANCELED) -> "User Canceled"; description_txt(?NO_RENEGOTIATION) -> @@ -179,8 +181,6 @@ description_txt(?BAD_CERTIFICATE_HASH_VALUE) -> "Bad Certificate Hash Value"; description_txt(?UNKNOWN_PSK_IDENTITY) -> "Unknown Psk Identity"; -description_txt(?INAPPROPRIATE_FALLBACK) -> - "Inappropriate Fallback"; description_txt(?CERTIFICATE_REQUIRED) -> "Certificate required"; description_txt(?NO_APPLICATION_PROTOCOL) -> @@ -232,10 +232,14 @@ description_atom(?INSUFFICIENT_SECURITY) -> insufficient_security; description_atom(?INTERNAL_ERROR) -> internal_error; +description_atom(?INAPPROPRIATE_FALLBACK) -> + inappropriate_fallback; description_atom(?USER_CANCELED) -> user_canceled; description_atom(?NO_RENEGOTIATION) -> no_renegotiation; +description_atom(?MISSING_EXTENSION) -> + missing_extension; description_atom(?UNSUPPORTED_EXTENSION) -> unsupported_extension; description_atom(?CERTIFICATE_UNOBTAINABLE) -> @@ -248,9 +252,9 @@ description_atom(?BAD_CERTIFICATE_HASH_VALUE) -> bad_certificate_hash_value; description_atom(?UNKNOWN_PSK_IDENTITY) -> unknown_psk_identity; -description_atom(?INAPPROPRIATE_FALLBACK) -> - inappropriate_fallback; +description_atom(?CERTIFICATE_REQUIRED) -> + certificate_required; description_atom(?NO_APPLICATION_PROTOCOL) -> no_application_protocol; description_atom(_) -> - 'unsupported/unkonwn_alert'. + 'unsupported/unknown_alert'. diff --git a/lib/ssl/src/ssl_app.erl b/lib/ssl/src/ssl_app.erl index 2a5047c75c..9e6d676bef 100644 --- a/lib/ssl/src/ssl_app.erl +++ b/lib/ssl/src/ssl_app.erl @@ -44,11 +44,11 @@ start_logger() -> formatter => {ssl_logger, #{}}}, Filter = {fun logger_filters:domain/2,{log,sub,[otp,ssl]}}, logger:add_handler(ssl_handler, logger_std_h, Config), - logger:add_handler_filter(ssl_handler, filter_non_ssl, Filter). + logger:add_handler_filter(ssl_handler, filter_non_ssl, Filter), + logger:set_application_level(ssl, debug). %% %% Description: Stop SSL logger stop_logger() -> + logger:unset_application_level(ssl), logger:remove_handler(ssl_handler). - - diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 6e751f9ceb..fe8736d2df 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -45,7 +45,7 @@ random_bytes/1, calc_mac_hash/4, calc_mac_hash/6, is_stream_ciphersuite/1, signature_scheme/1, scheme_to_components/1, hash_size/1, effective_key_bits/1, - key_material/1]). + key_material/1, signature_algorithm_to_scheme/1]). %% RFC 8446 TLS 1.3 -export([generate_client_shares/1, generate_server_share/1, add_zero_padding/2]). @@ -900,6 +900,18 @@ scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined}; scheme_to_components(rsa_pkcs1_sha1) -> {sha1, rsa_pkcs1, undefined}; scheme_to_components(ecdsa_sha1) -> {sha1, ecdsa, undefined}. + +%% TODO: Add support for EC and RSA-SSA signatures +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha1WithRSAEncryption}) -> + rsa_pkcs1_sha1; +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha256WithRSAEncryption}) -> + rsa_pkcs1_sha256; +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha384WithRSAEncryption}) -> + rsa_pkcs1_sha384; +signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha512WithRSAEncryption}) -> + rsa_pkcs1_sha512. + + %% RFC 5246: 6.2.3.2. CBC Block Cipher %% %% Implementation note: Canvel et al. [CBCTIME] have demonstrated a diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e5b01cce5f..1e97fe046b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -385,7 +385,8 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName, log_alert(SslOpts#ssl_options.log_level, Role, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}), Pids = Connection:pids(State), - alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection), + alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, + opposite_role(Role), Connection), {stop, {shutdown, normal}, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 201164949a..ff7207a8ce 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -40,6 +40,7 @@ data_tag :: atom(), % ex tcp. close_tag :: atom(), % ex tcp_closed error_tag :: atom(), % ex tcp_error + passive_tag :: atom(), % ex tcp_passive host :: string() | inet:ip_address(), port :: integer(), socket :: port() | tuple(), %% TODO: dtls socket diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 260f603e90..6c95a7edf8 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -79,7 +79,10 @@ select_hashsign_algs/3, empty_extensions/2, add_server_share/3 ]). --export([get_cert_params/1]). +-export([get_cert_params/1, + server_name/3, + validation_fun_and_state/9, + handle_path_validation_error/7]). %%==================================================================== %% Create handshake messages diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index d4233bea9b..b248edcaa9 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -47,7 +47,9 @@ srp_username, is_resumable, time_stamp, - ecc + ecc, %% TLS 1.3 Group + sign_alg, %% TLS 1.3 Signature Algorithm + dh_public_value %% TLS 1.3 DH Public Value from peer }). -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index b82b3937a1..f497315235 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -181,6 +181,11 @@ parse_handshake(Direction, #hello_request{} = HelloRequest) -> [header_prefix(Direction)]), Message = io_lib:format("~p", [?rec_info(hello_request, HelloRequest)]), {Header, Message}; +parse_handshake(Direction, #certificate_request_1_3{} = CertificateRequest) -> + Header = io_lib:format("~s Handshake, CertificateRequest", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(certificate_request_1_3, CertificateRequest)]), + {Header, Message}; parse_handshake(Direction, #certificate_1_3{} = Certificate) -> Header = io_lib:format("~s Handshake, Certificate", [header_prefix(Direction)]), diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 8eb9e56375..fde73cdef1 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -98,7 +98,7 @@ %% Setup %%==================================================================== start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, + User, {CbModule, _,_, _, _} = CbInfo, Timeout) -> try {ok, Sender} = tls_sender:start(), @@ -112,7 +112,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} end; start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, + User, {CbModule, _,_, _, _} = CbInfo, Timeout) -> try {ok, Sender} = tls_sender:start([{spawn_opt, ?DIST_CNTRL_SPAWN_OPTS}]), @@ -251,13 +251,28 @@ next_event(StateName, Record, State, Actions) -> %%% TLS record protocol level application data messages - -handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName0, State0) -> +handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, + #state{start_or_recv_from = From, + socket_options = #socket_options{active = false}} = State0) when From =/= undefined -> + case ssl_connection:read_application_data(Data, State0) of + {stop, _, _} = Stop-> + Stop; + {Record, #state{start_or_recv_from = Caller} = State1} -> + TimerAction = case Caller of + undefined -> %% Passive recv complete cancel timer + [{{timeout, recv}, infinity, timeout}]; + _ -> + [] + end, + {next_state, StateName, State, Actions} = next_event(StateName, Record, State1, TimerAction), + ssl_connection:hibernate_after(StateName, State, Actions) + end; +handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State0) -> case ssl_connection:read_application_data(Data, State0) of {stop, _, _} = Stop-> Stop; {Record, State1} -> - case next_event(StateName0, Record, State1) of + case next_event(StateName, Record, State1) of {next_state, StateName, State, Actions} -> ssl_connection:hibernate_after(StateName, State, Actions); {stop, _, _} = Stop -> @@ -308,9 +323,7 @@ handle_protocol_record(#ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, handle_alerts(Alerts, {next_state, StateName, State}); [] -> ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert), - Version, StateName, State); - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, Version, StateName, State) + Version, StateName, State) catch _:_ -> ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error), @@ -941,7 +954,7 @@ code_change(_OldVsn, StateName, State, _) -> %%% Internal functions %%-------------------------------------------------------------------- initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, - {CbModule, DataTag, CloseTag, ErrorTag}) -> + {CbModule, DataTag, CloseTag, ErrorTag, PassiveTag}) -> #ssl_options{beast_mitigation = BeastMitigation, erl_dist = IsErlDist} = SSLOptions, ConnectionStates = tls_record:init_connection_states(Role, BeastMitigation), @@ -965,6 +978,7 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac data_tag = DataTag, close_tag = CloseTag, error_tag = ErrorTag, + passive_tag = PassiveTag, host = Host, port = Port, socket = Socket, @@ -1061,8 +1075,9 @@ handle_info({Protocol, _, Data}, StateName, ssl_connection:handle_normal_shutdown(Alert, StateName, State0), {stop, {shutdown, own_alert}, State0} end; -handle_info({tcp_passive, Socket}, StateName, - #state{static_env = #static_env{socket = Socket}, +handle_info({PassiveTag, Socket}, StateName, + #state{static_env = #static_env{socket = Socket, + passive_tag = PassiveTag}, protocol_specific = PS } = State) -> next_event(StateName, no_record, @@ -1135,6 +1150,7 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0) -> encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> tls_record:encode_change_cipher_spec(Version, ConnectionStates). +-spec decode_alerts(binary()) -> list(). decode_alerts(Bin) -> ssl_alert:decode(Bin). diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl index 71ac6a9310..701a5860c2 100644 --- a/lib/ssl/src/tls_connection_1_3.erl +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -110,51 +110,75 @@ %% gen_statem helper functions -export([start/4, negotiated/4, + wait_cert/4, + wait_cv/4, wait_finished/4 ]). -start(internal, - #change_cipher_spec{} = ChangeCipherSpec, State0, _Module) -> - case tls_handshake_1_3:do_start(ChangeCipherSpec, State0) of - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, {3,4}, start, State0); - State1 -> - {Record, State} = tls_connection:next_record(State1), - tls_connection:next_event(?FUNCTION_NAME, Record, State) - end; +start(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); start(internal, #client_hello{} = Hello, State0, _Module) -> case tls_handshake_1_3:do_start(Hello, State0) of #alert{} = Alert -> ssl_connection:handle_own_alert(Alert, {3,4}, start, State0); - {State, _, start} -> + {State, start} -> {next_state, start, State, []}; - {State, Context, negotiated} -> - {next_state, negotiated, State, [{next_event, internal, Context}]} + {State, negotiated} -> + {next_state, negotiated, State, [{next_event, internal, start_handshake}]} end; start(Type, Msg, State, Connection) -> ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). -negotiated(internal, Map, State0, _Module) -> - case tls_handshake_1_3:do_negotiated(Map, State0) of +negotiated(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); +negotiated(internal, Message, State0, _Module) -> + case tls_handshake_1_3:do_negotiated(Message, State0) of #alert{} = Alert -> ssl_connection:handle_own_alert(Alert, {3,4}, negotiated, State0); - State -> - {next_state, wait_finished, State, []} - + {State, NextState} -> + {next_state, NextState, State, []} end. -wait_finished(internal, - #change_cipher_spec{} = ChangeCipherSpec, State0, _Module) -> - case tls_handshake_1_3:do_wait_finished(ChangeCipherSpec, State0) of - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, {3,4}, wait_finished, State0); - State1 -> +wait_cert(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); +wait_cert(internal, + #certificate_1_3{} = Certificate, State0, _Module) -> + case tls_handshake_1_3:do_wait_cert(Certificate, State0) of + {#alert{} = Alert, State} -> + ssl_connection:handle_own_alert(Alert, {3,4}, wait_cert, State); + {State1, NextState} -> {Record, State} = tls_connection:next_record(State1), - tls_connection:next_event(?FUNCTION_NAME, Record, State) + tls_connection:next_event(NextState, Record, State) end; +wait_cert(Type, Msg, State, Connection) -> + ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). + + +wait_cv(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); +wait_cv(internal, + #certificate_verify_1_3{} = CertificateVerify, State0, _Module) -> + case tls_handshake_1_3:do_wait_cv(CertificateVerify, State0) of + {#alert{} = Alert, State} -> + ssl_connection:handle_own_alert(Alert, {3,4}, wait_cv, State); + {State1, NextState} -> + {Record, State} = tls_connection:next_record(State1), + tls_connection:next_event(NextState, Record, State) + end; +wait_cv(Type, Msg, State, Connection) -> + ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). + + +wait_finished(internal, #change_cipher_spec{}, State0, _Module) -> + {Record, State} = tls_connection:next_record(State0), + tls_connection:next_event(?FUNCTION_NAME, Record, State); wait_finished(internal, #finished{} = Finished, State0, Module) -> case tls_handshake_1_3:do_wait_finished(Finished, State0) of diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 3bc1290361..1e8b046c1e 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -44,6 +44,8 @@ -export([do_start/2, do_negotiated/2, + do_wait_cert/2, + do_wait_cv/2, do_wait_finished/2]). %%==================================================================== @@ -87,6 +89,36 @@ encrypted_extensions() -> }. +certificate_request(SignAlgs0, SignAlgsCert0) -> + %% Input arguments contain TLS 1.2 algorithms due to backward compatibility + %% reasons. These {Hash, Algo} tuples must be filtered before creating the + %% the extensions. + SignAlgs = filter_tls13_algs(SignAlgs0), + SignAlgsCert = filter_tls13_algs(SignAlgsCert0), + Extensions0 = add_signature_algorithms(#{}, SignAlgs), + Extensions = add_signature_algorithms_cert(Extensions0, SignAlgsCert), + #certificate_request_1_3{ + certificate_request_context = <<>>, + extensions = Extensions}. + + +add_signature_algorithms(Extensions, SignAlgs) -> + Extensions#{signature_algorithms => + #signature_algorithms{signature_scheme_list = SignAlgs}}. + + +add_signature_algorithms_cert(Extensions, undefined) -> + Extensions; +add_signature_algorithms_cert(Extensions, SignAlgsCert) -> + Extensions#{signature_algorithms_cert => + #signature_algorithms{signature_scheme_list = SignAlgsCert}}. + + +filter_tls13_algs(undefined) -> undefined; +filter_tls13_algs(Algo) -> + lists:filter(fun is_atom/1, Algo). + + %% TODO: use maybe monad for error handling! %% enum { %% X509(0), @@ -144,7 +176,7 @@ certificate_verify(PrivateKey, SignatureScheme, %% Digital signatures use the hash function defined by the selected signature %% scheme. - case digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>, + case sign(THash, <<"TLS 1.3, server CertificateVerify">>, HashAlgo, PrivateKey) of {ok, Signature} -> {ok, #certificate_verify_1_3{ @@ -352,7 +384,7 @@ certificate_entry(DER) -> %% 79 %% 00 %% 0101010101010101010101010101010101010101010101010101010101010101 -digitally_sign(THash, Context, HashAlgo, PrivateKey) -> +sign(THash, Context, HashAlgo, PrivateKey) -> Content = build_content(Context, THash), %% The length of the Salt MUST be equal to the length of the output @@ -369,6 +401,23 @@ digitally_sign(THash, Context, HashAlgo, PrivateKey) -> end. +verify(THash, Context, HashAlgo, Signature, PublicKey) -> + Content = build_content(Context, THash), + + %% The length of the Salt MUST be equal to the length of the output + %% of the digest algorithm: rsa_pss_saltlen = -1 + try public_key:verify(Content, HashAlgo, Signature, PublicKey, + [{rsa_padding, rsa_pkcs1_pss_padding}, + {rsa_pss_saltlen, -1}, + {rsa_mgf1_md, HashAlgo}]) of + Result -> + {ok, Result} + catch + error:badarg -> + {error, badarg} + end. + + build_content(Context, THash) -> Prefix = binary:copy(<<32>>, 64), <<Prefix/binary,Context/binary,?BYTE(0),THash/binary>>. @@ -379,36 +428,12 @@ build_content(Context, THash) -> %%==================================================================== -do_start(#change_cipher_spec{}, - #state{connection_states = _ConnectionStates0, - session = #session{session_id = _SessionId, - own_certificate = _OwnCert}, - ssl_options = #ssl_options{} = _SslOpts, - key_share = _KeyShare, - handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, - static_env = #static_env{ - cert_db = _CertDbHandle, - cert_db_ref = _CertDbRef, - socket = _Socket, - transport_cb = _Transport} - } = State0) -> - %% {Ref,Maybe} = maybe(), - - try - - State0 - - catch - {_Ref, {state_not_implemented, State}} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) - end; do_start(#client_hello{cipher_suites = ClientCiphers, session_id = SessionId, extensions = Extensions} = _Hello, #state{connection_states = _ConnectionStates0, ssl_options = #ssl_options{ciphers = ServerCiphers, signature_algs = ServerSignAlgs, - signature_algs_cert = _SignatureSchemes, %% TODO: check! supported_groups = ServerGroups0}, session = #session{own_certificate = Cert}} = State0) -> @@ -454,7 +479,8 @@ do_start(#client_hello{cipher_suites = ClientCiphers, %% Generate server_share KeyShare = ssl_cipher:generate_server_share(Group), - State1 = update_start_state(State0, Cipher, KeyShare, SessionId), + State1 = update_start_state(State0, Cipher, KeyShare, SessionId, + Group, SelectedSignAlg, ClientPubKey), %% 4.1.4. Hello Retry Request %% @@ -462,14 +488,7 @@ do_start(#client_hello{cipher_suites = ClientCiphers, %% message if it is able to find an acceptable set of parameters but the %% ClientHello does not contain sufficient information to proceed with %% the handshake. - {State2, NextState} = - Maybe(send_hello_retry_request(State1, ClientPubKey, KeyShare, SessionId)), - - %% TODO: Add Context to state? - Context = #{group => Group, - sign_alg => SelectedSignAlg, - client_share => ClientPubKey}, - {State2, Context, NextState} + Maybe(send_hello_retry_request(State1, ClientPubKey, KeyShare, SessionId)) %% TODO: %% - session handling @@ -484,29 +503,29 @@ do_start(#client_hello{cipher_suites = ClientCiphers, {Ref, no_suitable_cipher} -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_cipher); {Ref, {insufficient_security, no_suitable_signature_algorithm}} -> - ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, "No suitable signature algorithm"); {Ref, {insufficient_security, no_suitable_public_key}} -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_public_key) end. -do_negotiated(#{client_share := ClientKey, - group := SelectedGroup, - sign_alg := SignatureScheme - }, - #state{connection_states = ConnectionStates0, - session = #session{session_id = SessionId, - own_certificate = OwnCert}, - ssl_options = #ssl_options{} = _SslOpts, - key_share = KeyShare, - handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, - connection_env = #connection_env{private_key = CertPrivateKey}, - static_env = #static_env{ - cert_db = CertDbHandle, - cert_db_ref = CertDbRef, - socket = _Socket, - transport_cb = _Transport} - } = State0) -> +do_negotiated(start_handshake, + #state{connection_states = ConnectionStates0, + session = #session{session_id = SessionId, + own_certificate = OwnCert, + ecc = SelectedGroup, + sign_alg = SignatureScheme, + dh_public_value = ClientKey}, + ssl_options = #ssl_options{} = SslOpts, + key_share = KeyShare, + handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, + connection_env = #connection_env{private_key = CertPrivateKey}, + static_env = #static_env{ + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + socket = _Socket, + transport_cb = _Transport} + } = State0) -> {Ref,Maybe} = maybe(), try @@ -527,59 +546,71 @@ do_negotiated(#{client_share := ClientKey, %% Encode EncryptedExtensions State4 = tls_connection:queue_handshake(EncryptedExtensions, State3), + %% Create and send CertificateRequest ({verify, verify_peer}) + {State5, NextState} = maybe_send_certificate_request(State4, SslOpts), + %% Create Certificate Certificate = certificate(OwnCert, CertDbHandle, CertDbRef, <<>>, server), %% Encode Certificate - State5 = tls_connection:queue_handshake(Certificate, State4), + State6 = tls_connection:queue_handshake(Certificate, State5), %% Create CertificateVerify CertificateVerify = Maybe(certificate_verify(CertPrivateKey, SignatureScheme, - State5, server)), + State6, server)), %% Encode CertificateVerify - State6 = tls_connection:queue_handshake(CertificateVerify, State5), + State7 = tls_connection:queue_handshake(CertificateVerify, State6), %% Create Finished - Finished = finished(State6), + Finished = finished(State7), %% Encode Finished - State7 = tls_connection:queue_handshake(Finished, State6), + State8 = tls_connection:queue_handshake(Finished, State7), %% Send first flight - {State8, _} = tls_connection:send_handshake_flight(State7), + {State9, _} = tls_connection:send_handshake_flight(State8), - State8 + {State9, NextState} catch - {Ref, {state_not_implemented, State}} -> - %% TODO - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) + {Ref, badarg} -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {digitally_sign, badarg}) end. -do_wait_finished(#change_cipher_spec{}, - #state{connection_states = _ConnectionStates0, - session = #session{session_id = _SessionId, - own_certificate = _OwnCert}, - ssl_options = #ssl_options{} = _SslOpts, - key_share = _KeyShare, - handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, - static_env = #static_env{ - cert_db = _CertDbHandle, - cert_db_ref = _CertDbRef, - socket = _Socket, - transport_cb = _Transport} - } = State0) -> - %% {Ref,Maybe} = maybe(), - +do_wait_cert(#certificate_1_3{} = Certificate, State0) -> + {Ref,Maybe} = maybe(), try + Maybe(process_client_certificate(Certificate, State0)) + catch + {Ref, {certificate_required, State}} -> + {?ALERT_REC(?FATAL, ?CERTIFICATE_REQUIRED, certificate_required), State}; + {Ref, {{certificate_unknown, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, Reason), State}; + {Ref, {{internal_error, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?INTERNAL_ERROR, Reason), State}; + {Ref, {{handshake_failure, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason), State}; + {#alert{} = Alert, State} -> + {Alert, State} + end. - State0 +do_wait_cv(#certificate_verify_1_3{} = CertificateVerify, State0) -> + {Ref,Maybe} = maybe(), + try + Maybe(verify_signature_algorithm(State0, CertificateVerify)), + Maybe(verify_certificate_verify(State0, CertificateVerify)) catch - {_Ref, {state_not_implemented, State}} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) - end; + {Ref, {{bad_certificate, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?BAD_CERTIFICATE, {bad_certificate, Reason}), State}; + {Ref, {badarg, State}} -> + {?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {verify, badarg}), State}; + {Ref, {{handshake_failure, Reason}, State}} -> + {?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {handshake_failure, Reason}), State} + end. + + do_wait_finished(#finished{verify_data = VerifyData}, #state{connection_states = _ConnectionStates0, session = #session{session_id = _SessionId, @@ -607,16 +638,19 @@ do_wait_finished(#finished{verify_data = VerifyData}, catch {Ref, decrypt_error} -> - ?ALERT_REC(?FATAL, ?DECRYPT_ERROR, decrypt_error); - {_, {state_not_implemented, State}} -> - %% TODO - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State}) + ?ALERT_REC(?FATAL, ?DECRYPT_ERROR, decrypt_error) end. %% TODO: Remove this function! -%% not_implemented(State) -> -%% {error, {state_not_implemented, State}}. +%% not_implemented(State, Reason) -> +%% {error, {not_implemented, State, Reason}}. +%% +%% not_implemented(update_secrets, State0, Reason) -> +%% State1 = calculate_traffic_secrets(State0), +%% State = ssl_record:step_encryption_state(State1), +%% {error, {not_implemented, State, Reason}}. + %% Recipients of Finished messages MUST verify that the contents are @@ -659,6 +693,138 @@ send_hello_retry_request(State0, _, _, _) -> {ok, {State0, negotiated}}. +maybe_send_certificate_request(State, #ssl_options{verify = verify_none}) -> + {State, wait_finished}; +maybe_send_certificate_request(State, #ssl_options{ + verify = verify_peer, + signature_algs = SignAlgs, + signature_algs_cert = SignAlgsCert}) -> + CertificateRequest = certificate_request(SignAlgs, SignAlgsCert), + {tls_connection:queue_handshake(CertificateRequest, State), wait_cert}. + + +process_client_certificate(#certificate_1_3{ + certificate_request_context = <<>>, + certificate_list = []}, + #state{ssl_options = + #ssl_options{ + fail_if_no_peer_cert = false}} = State) -> + {ok, {State, wait_finished}}; +process_client_certificate(#certificate_1_3{ + certificate_request_context = <<>>, + certificate_list = []}, + #state{ssl_options = + #ssl_options{ + fail_if_no_peer_cert = true}} = State0) -> + + %% At this point the client believes that the connection is up and starts using + %% its traffic secrets. In order to be able send an proper Alert to the client + %% the server should also change its connection state and use the traffic + %% secrets. + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {certificate_required, State}}; +process_client_certificate(#certificate_1_3{certificate_list = Certs0}, + #state{ssl_options = + #ssl_options{signature_algs = SignAlgs, + signature_algs_cert = SignAlgsCert} = SslOptions, + static_env = + #static_env{ + role = Role, + host = Host, + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + crl_db = CRLDbHandle}} = State0) -> + %% TODO: handle extensions! + + %% Remove extensions from list of certificates! + Certs = convert_certificate_chain(Certs0), + case is_supported_signature_algorithm(Certs, SignAlgs, SignAlgsCert) of + true -> + case validate_certificate_chain(Certs, CertDbHandle, CertDbRef, + SslOptions, CRLDbHandle, Role, Host) of + {ok, {PeerCert, PublicKeyInfo}} -> + State = store_peer_cert(State0, PeerCert, PublicKeyInfo), + {ok, {State, wait_cv}}; + {error, Reason} -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {Reason, State}}; + #alert{} = Alert -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {Alert, State} + end; + false -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {{handshake_failure, + "Client certificate uses unsupported signature algorithm"}, State}} + end. + + +%% TODO: check whole chain! +is_supported_signature_algorithm(Certs, SignAlgs, undefined) -> + is_supported_signature_algorithm(Certs, SignAlgs); +is_supported_signature_algorithm(Certs, _, SignAlgsCert) -> + is_supported_signature_algorithm(Certs, SignAlgsCert). +%% +is_supported_signature_algorithm([BinCert|_], SignAlgs0) -> + #'OTPCertificate'{signatureAlgorithm = SignAlg} = + public_key:pkix_decode_cert(BinCert, otp), + SignAlgs = filter_tls13_algs(SignAlgs0), + Scheme = ssl_cipher:signature_algorithm_to_scheme(SignAlg), + lists:member(Scheme, SignAlgs). + + +validate_certificate_chain(Certs, CertDbHandle, CertDbRef, SslOptions, CRLDbHandle, Role, Host) -> + ServerName = ssl_handshake:server_name(SslOptions#ssl_options.server_name_indication, Host, Role), + [PeerCert | ChainCerts ] = Certs, + try + {TrustedCert, CertPath} = + ssl_certificate:trusted_cert_and_path(Certs, CertDbHandle, CertDbRef, + SslOptions#ssl_options.partial_chain), + ValidationFunAndState = + ssl_handshake:validation_fun_and_state(SslOptions#ssl_options.verify_fun, Role, + CertDbHandle, CertDbRef, ServerName, + SslOptions#ssl_options.customize_hostname_check, + SslOptions#ssl_options.crl_check, CRLDbHandle, CertPath), + Options = [{max_path_length, SslOptions#ssl_options.depth}, + {verify_fun, ValidationFunAndState}], + %% TODO: Validate if Certificate is using a supported signature algorithm + %% (signature_algs_cert)! + case public_key:pkix_path_validation(TrustedCert, CertPath, Options) of + {ok, {PublicKeyInfo,_}} -> + {ok, {PeerCert, PublicKeyInfo}}; + {error, Reason} -> + ssl_handshake:handle_path_validation_error(Reason, PeerCert, ChainCerts, + SslOptions, Options, + CertDbHandle, CertDbRef) + end + catch + error:{badmatch,{asn1, Asn1Reason}} -> + %% ASN-1 decode of certificate somehow failed + {error, {certificate_unknown, {failed_to_decode_certificate, Asn1Reason}}}; + error:OtherReason -> + {error, {internal_error, {unexpected_error, OtherReason}}} + end. + + +store_peer_cert(#state{session = Session, + handshake_env = HsEnv} = State, PeerCert, PublicKeyInfo) -> + State#state{session = Session#session{peer_certificate = PeerCert}, + handshake_env = HsEnv#handshake_env{public_key_info = PublicKeyInfo}}. + + +convert_certificate_chain(Certs) -> + Fun = fun(#certificate_entry{data = Data}) -> + {true, Data}; + (_) -> + false + end, + lists:filtermap(Fun, Certs). + + %% 4.4.1. The Transcript Hash %% %% As an exception to this general rule, when the server responds to a @@ -746,10 +912,8 @@ calculate_traffic_secrets(#state{connection_states = ConnectionStates, MasterSecret = tls_v1:key_schedule(master_secret, HKDFAlgo, HandshakeSecret), - {Messages0, _} = HHistory, - - %% Drop Client Finish - [_|Messages] = Messages0, + %% Get the correct list messages for the handshake context. + Messages = get_handshake_context(HHistory), %% Calculate [sender]_application_traffic_secret_0 ClientAppTrafficSecret0 = @@ -778,6 +942,11 @@ get_private_key(#key_share_entry{ {_, PrivateKey}}) -> PrivateKey. +%% TODO: implement EC keys +get_public_key({?'rsaEncryption', PublicKey, _}) -> + PublicKey. + + %% X25519, X448 calculate_shared_secret(OthersKey, MyKey, Group) when is_binary(OthersKey) andalso is_binary(MyKey) andalso @@ -822,7 +991,8 @@ update_connection_state(ConnectionState = #{security_parameters := SecurityParam update_start_state(#state{connection_states = ConnectionStates0, connection_env = CEnv, session = Session} = State, - Cipher, KeyShare, SessionId) -> + Cipher, KeyShare, SessionId, + Group, SelectedSignAlg, ClientPubKey) -> #{security_parameters := SecParamsR0} = PendingRead = maps:get(pending_read, ConnectionStates0), #{security_parameters := SecParamsW0} = PendingWrite = @@ -834,7 +1004,10 @@ update_start_state(#state{connection_states = ConnectionStates0, pending_write => PendingWrite#{security_parameters => SecParamsW}}, State#state{connection_states = ConnectionStates, key_share = KeyShare, - session = Session#session{session_id = SessionId}, + session = Session#session{session_id = SessionId, + ecc = Group, + sign_alg = SelectedSignAlg, + dh_public_value = ClientPubKey}, connection_env = CEnv#connection_env{negotiated_version = {3,4}}}. @@ -845,6 +1018,126 @@ cipher_init(Key, IV, FinishedKey) -> tag_len = 16}. +%% Get handshake context for verification of CertificateVerify. +%% +%% Verify CertificateVerify: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% CertificateRequest (server) (13) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Certificate (client) (11) +%% CertificateVerify (client) (15) - Drop! Not included in calculations! +get_handshake_context_cv({[<<15,_/binary>>|Messages], _}) -> + Messages. + + +%% Get handshake context for traffic key calculation. +%% +%% Client is authenticated with certificate: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% CertificateRequest (server) (13) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Certificate (client) (11) - Drop! Not included in calculations! +%% CertificateVerify (client) (15) - Drop! Not included in calculations! +%% Finished (client) (20) - Drop! Not included in calculations! +%% +%% Client is authenticated but sends empty certificate: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% CertificateRequest (server) (13) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Certificate (client) (11) - Drop! Not included in calculations! +%% Finished (client) (20) - Drop! Not included in calculations! +%% +%% Client is not authenticated: +%% ClientHello (client) (1) +%% ServerHello (server) (2) +%% EncryptedExtensions (server) (8) +%% Certificate (server) (11) +%% CertificateVerify (server) (15) +%% Finished (server) (20) +%% Finished (client) (20) - Drop! Not included in calculations! +%% +%% Drop all client messages from the front of the iolist using the property that +%% incoming messages are binaries. +get_handshake_context({Messages, _}) -> + get_handshake_context(Messages); +get_handshake_context([H|T]) when is_binary(H) -> + get_handshake_context(T); +get_handshake_context(L) -> + L. + + +%% If sent by a client, the signature algorithm used in the signature +%% MUST be one of those present in the supported_signature_algorithms +%% field of the "signature_algorithms" extension in the +%% CertificateRequest message. +verify_signature_algorithm(#state{ssl_options = + #ssl_options{ + signature_algs = ServerSignAlgs}} = State0, + #certificate_verify_1_3{algorithm = ClientSignAlg}) -> + case lists:member(ClientSignAlg, ServerSignAlgs) of + true -> + ok; + false -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {{handshake_failure, + "CertificateVerify uses unsupported signature algorithm"}, State}} + end. + + +verify_certificate_verify(#state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + public_key_info = PublicKeyInfo, + tls_handshake_history = HHistory}} = State0, + #certificate_verify_1_3{ + algorithm = SignatureScheme, + signature = Signature}) -> + #{security_parameters := SecParamsR} = + ssl_record:pending_connection_state(ConnectionStates, write), + #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR, + + {HashAlgo, _, _} = + ssl_cipher:scheme_to_components(SignatureScheme), + + Messages = get_handshake_context_cv(HHistory), + + Context = lists:reverse(Messages), + + %% Transcript-Hash uses the HKDF hash function defined by the cipher suite. + THash = tls_v1:transcript_hash(Context, HKDFAlgo), + + PublicKey = get_public_key(PublicKeyInfo), + + %% Digital signatures use the hash function defined by the selected signature + %% scheme. + case verify(THash, <<"TLS 1.3, client CertificateVerify">>, + HashAlgo, Signature, PublicKey) of + {ok, true} -> + {ok, {State0, wait_finished}}; + {ok, false} -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {{handshake_failure, "Failed to verify CertificateVerify"}, State}}; + {error, badarg} -> + State1 = calculate_traffic_secrets(State0), + State = ssl_record:step_encryption_state(State1), + {error, {badarg, State}} + end. + + %% If there is no overlap between the received %% "supported_groups" and the groups supported by the server, then the %% server MUST abort the handshake with a "handshake_failure" or an @@ -861,7 +1154,6 @@ select_common_groups(ServerGroups, ClientGroups) -> end. - %% RFC 8446 - 4.2.8. Key Share %% This vector MAY be empty if the client is requesting a %% HelloRetryRequest. Each KeyShareEntry value MUST correspond to a diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl index 05acc08392..97331e1510 100644 --- a/lib/ssl/src/tls_record_1_3.erl +++ b/lib/ssl/src/tls_record_1_3.erl @@ -124,6 +124,20 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, {decode_inner_plaintext(PlainFragment), ConnectionStates} end; + +%% RFC8446 - TLS 1.3 (OpenSSL compatibility) +%% Handle unencrypted Alerts from openssl s_client when server's +%% connection states are already stepped into traffic encryption. +%% (E.g. openssl s_client receives a CertificateRequest with +%% a signature_algorithms_cert extension that does not contain +%% the signature algorithm of the client's certificate.) +decode_cipher_text(#ssl_tls{type = ?ALERT, + version = ?LEGACY_VERSION, + fragment = <<2,47>>}, + ConnectionStates0) -> + {#ssl_tls{type = ?ALERT, + version = {3,4}, %% Internally use real version + fragment = <<2,47>>}, ConnectionStates0}; %% RFC8446 - TLS 1.3 %% D.4. Middlebox Compatibility Mode %% - If not offering early data, the client sends a dummy @@ -139,7 +153,6 @@ decode_cipher_text(#ssl_tls{type = ?CHANGE_CIPHER_SPEC, {#ssl_tls{type = ?CHANGE_CIPHER_SPEC, version = {3,4}, %% Internally use real version fragment = <<1>>}, ConnectionStates0}; - decode_cipher_text(#ssl_tls{type = Type, version = ?LEGACY_VERSION, fragment = CipherFragment}, diff --git a/lib/ssl/src/tls_socket.erl b/lib/ssl/src/tls_socket.erl index c3c41d3e12..6c32e6fa04 100644 --- a/lib/ssl/src/tls_socket.erl +++ b/lib/ssl/src/tls_socket.erl @@ -46,7 +46,7 @@ send(Transport, Socket, Data) -> Transport:send(Socket, Data). -listen(Transport, Port, #config{transport_info = {Transport, _, _, _}, +listen(Transport, Port, #config{transport_info = {Transport, _, _, _, _}, inet_user = Options, ssl = SslOpts, emulated = EmOpts} = Config) -> case Transport:listen(Port, Options ++ internal_inet_values()) of @@ -59,7 +59,7 @@ listen(Transport, Port, #config{transport_info = {Transport, _, _, _}, Err end. -accept(ListenSocket, #config{transport_info = {Transport,_,_,_} = CbInfo, +accept(ListenSocket, #config{transport_info = {Transport,_,_,_,_} = CbInfo, connection_cb = ConnectionCb, ssl = SslOpts, emulated = Tracker}, Timeout) -> @@ -80,7 +80,7 @@ accept(ListenSocket, #config{transport_info = {Transport,_,_,_} = CbInfo, {error, Reason} end. -upgrade(Socket, #config{transport_info = {Transport,_,_,_}= CbInfo, +upgrade(Socket, #config{transport_info = {Transport,_,_,_,_}= CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}, Timeout) -> ok = setopts(Transport, Socket, tls_socket:internal_inet_values()), @@ -98,7 +98,7 @@ connect(Address, Port, #config{transport_info = CbInfo, inet_user = UserOpts, ssl = SslOpts, emulated = EmOpts, inet_ssl = SocketOpts, connection_cb = ConnetionCb}, Timeout) -> - {Transport, _, _, _} = CbInfo, + {Transport, _, _, _, _} = CbInfo, try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> ssl_connection:connect(ConnetionCb, Address, Port, Socket, @@ -125,7 +125,7 @@ setopts(gen_tcp, Socket = #sslsocket{pid = {ListenSocket, #config{emulated = Tra ok = set_emulated_opts(Tracker, EmulatedOpts), check_active_n(EmulatedOpts, Socket), inet:setopts(ListenSocket, SockOpts); -setopts(_, Socket = #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}, +setopts(_, Socket = #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_,_}, emulated = Tracker}}}, Options) -> {SockOpts, EmulatedOpts} = split_options(Options), ok = set_emulated_opts(Tracker, EmulatedOpts), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 292916692d..ff5638ff34 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -281,7 +281,15 @@ tls13_test_group() -> tls13_1_RTT_handshake, tls13_basic_ssl_server_openssl_client, tls13_custom_groups_ssl_server_openssl_client, - tls13_hello_retry_request_ssl_server_openssl_client]. + tls13_hello_retry_request_ssl_server_openssl_client, + tls13_client_auth_empty_cert_alert_ssl_server_openssl_client, + tls13_client_auth_empty_cert_ssl_server_openssl_client, + tls13_client_auth_ssl_server_openssl_client, + tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client, + tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client, + tls13_hrr_client_auth_ssl_server_openssl_client, + tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client, + tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client]. %%-------------------------------------------------------------------- init_per_suite(Config0) -> @@ -4078,7 +4086,7 @@ tls_tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), StaticEnv = element(2, State), - Socket = element(10, StaticEnv), + Socket = element(11, StaticEnv), %% Fake tcp error Pid ! {tcp_error, Socket, etimedout}, @@ -5588,6 +5596,258 @@ tls13_hello_retry_request_ssl_server_openssl_client(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close_port(Client). +tls13_client_auth_empty_cert_alert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to true."}]. + +tls13_client_auth_empty_cert_alert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts = proplists:delete(keyfile, ClientOpts1), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, + {error, + {tls_alert, + {certificate_required, + "received SERVER ALERT: Fatal - Certificate required - certificate_required"}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + +tls13_client_auth_empty_cert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to false."}]. + +tls13_client_auth_empty_cert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts = proplists:delete(keyfile, ClientOpts1), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, false}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication."}]. + +tls13_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to true."}]. + +tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts2 = proplists:delete(keyfile, ClientOpts1), + ClientOpts = [{groups,"P-256:X25519"}|ClientOpts2], + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}, + {supported_groups, [x448, x25519]}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, + {error, + {tls_alert, + {certificate_required, + "received SERVER ALERT: Fatal - Certificate required - certificate_required"}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client() -> + [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to false."}]. + +tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + %% Delete Client Cert and Key + ClientOpts1 = proplists:delete(certfile, ClientOpts0), + ClientOpts2 = proplists:delete(keyfile, ClientOpts1), + ClientOpts = [{groups,"P-256:X25519"}|ClientOpts2], + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, false}, + {supported_groups, [x448, x25519]}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_hrr_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication."}]. + +tls13_hrr_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), + ClientOpts = [{groups,"P-256:X25519"}|ClientOpts0], + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + {fail_if_no_peer_cert, true}, + {supported_groups, [x448, x25519]}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication with unsupported signature_algorithm"}]. + +tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {verify, verify_peer}, + %% Skip rsa_pkcs1_sha256! + {signature_algs, [rsa_pkcs1_sha384, rsa_pkcs1_sha512]}, + {fail_if_no_peer_cert, true}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result( + Server, + {error, + {tls_alert, + {insufficient_security, + "received SERVER ALERT: Fatal - Insufficient Security - " + "\"No suitable signature algorithm\""}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + + +%% Triggers Client Alert as openssl s_client does not have a certificate with a +%% signature algorithm supported by the server (signature_algorithms_cert extension +%% of CertificateRequest does not contain the algorithm of the client certificate). +tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client() -> + [{doc,"TLS 1.3: Test client authentication with unsupported signature_algorithm_cert"}]. + +tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), + + ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), + %% Set versions + ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}, + {log_level, debug}, + {verify, verify_peer}, + {signature_algs, [rsa_pkcs1_sha256, rsa_pkcs1_sha384, rsa_pss_rsae_sha256]}, + %% Skip rsa_pkcs1_sha256! + {signature_algs_cert, [rsa_pkcs1_sha384, rsa_pkcs1_sha512]}, + {fail_if_no_peer_cert, true}|ServerOpts0], + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts), + + ssl_test_lib:check_result( + Server, + {error, + {tls_alert, + {illegal_parameter, + "received CLIENT ALERT: Fatal - Illegal Parameter"}}}), + ssl_test_lib:close(Server), + ssl_test_lib:close_port(Client). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index f628b4e6d4..7f8e81dbd8 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1114,15 +1114,23 @@ start_basic_client(openssl, Version, Port, ClientOpts) -> Exe = "openssl", Args0 = ["s_client", "-verify", "2", "-port", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-cert", Cert, "-CAfile", CA, - "-key", Key, "-host","localhost", "-msg", "-debug"], - Args = + "-CAfile", CA, "-host", "localhost", "-msg", "-debug"], + Args1 = case Groups0 of undefined -> Args0; G -> Args0 ++ ["-groups", G] end, + Args = + case {Cert, Key} of + {C, K} when C =:= undefined orelse + K =:= undefined -> + Args1; + {C, K} -> + Args1 ++ ["-cert", C, "-key", K] + end, + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), true = port_command(OpenSslPort, "Hello world"), OpenSslPort. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 0d9f907d5c..c4bcc1560c 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.2 +SSL_VSN = 9.2.1 diff --git a/lib/stdlib/doc/src/beam_lib.xml b/lib/stdlib/doc/src/beam_lib.xml index 8bb4cf9101..bb44ca3201 100644 --- a/lib/stdlib/doc/src/beam_lib.xml +++ b/lib/stdlib/doc/src/beam_lib.xml @@ -470,6 +470,18 @@ CryptoKeyFun(clear) -> term()</code> </func> <func> + <name name="strip" arity="2" since=""/> + <fsummary>Remove chunks not needed by the loader from a BEAM file. + </fsummary> + <desc> + <p>Removes all chunks from a BEAM + file except those needed by the loader or passed in. In particular, + the debug information (chunk <c>debug_info</c> and <c>abstract_code</c>) + is removed.</p> + </desc> + </func> + + <func> <name name="strip_files" arity="1" since=""/> <fsummary>Removes chunks not needed by the loader from BEAM files. </fsummary> @@ -483,6 +495,19 @@ CryptoKeyFun(clear) -> term()</code> </func> <func> + <name name="strip_files" arity="2" since=""/> + <fsummary>Removes chunks not needed by the loader from BEAM files. + </fsummary> + <desc> + <p>Removes all chunks except + those needed by the loader or passed in from BEAM files. In particular, + the debug information (chunk <c>debug_info</c> and <c>abstract_code</c>) + is removed. The returned list contains one element for each + specified filename, in the same order as in <c>Files</c>.</p> + </desc> + </func> + + <func> <name name="strip_release" arity="1" since=""/> <fsummary>Remove chunks not needed by the loader from all BEAM files of a release.</fsummary> @@ -497,6 +522,20 @@ CryptoKeyFun(clear) -> term()</code> </func> <func> + <name name="strip_release" arity="2" since=""/> + <fsummary>Remove chunks not needed by the loader from all BEAM files of + a release.</fsummary> + <desc> + <p>Removes all chunks + except those needed by the loader or passed in from the BEAM files of a + release. <c><anno>Dir</anno></c> is to be the installation root + directory. For example, the current OTP release can be + stripped with the call + <c>beam_lib:strip_release(code:root_dir())</c>.</p> + </desc> + </func> + + <func> <name name="version" arity="1" since=""/> <fsummary>Read the module version of the BEAM file.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index d2ac6a75b1..2cb677785d 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -642,12 +642,11 @@ Error: fun containing local Erlang function calls <p><marker id="info_2_safe_fixed_monotonic_time"/></p> <p><c>Item=safe_fixed|safe_fixed_monotonic_time, Value={FixationTime,Info}|false</c></p> - <p>If the table has been fixed using + <p>If the table is fixed using <seealso marker="#safe_fixtable/2"> <c>safe_fixtable/2</c></seealso>, the call returns a tuple where <c>FixationTime</c> is the - time when the table was first fixed by a process, which either - is or is not one of the processes it is fixed by now.</p> + last time when the table changed from unfixed to fixed.</p> <p>The format and value of <c>FixationTime</c> depends on <c>Item</c>:</p> <taglist> @@ -679,8 +678,15 @@ Error: fun containing local Erlang function calls table is fixed by now. <c>RefCount</c> is the value of the reference counter and it keeps track of how many times the table has been fixed by the process.</p> - <p>If the table never has been fixed, the call returns - <c>false</c>.</p> + <p>Table fixations are not limited to <seealso marker="#safe_fixtable/2"> + <c>safe_fixtable/2</c></seealso>. Temporary fixations may also + be done by for example <seealso marker="#traversal">traversing + functions</seealso> like <c>select</c> and <c>match</c>. Such + table fixations are automatically released before the + corresponding functions returns, but they may be seen by a + concurrent call to + <c>ets:info(T,safe_fixed|safe_fixed_monotonic_time)</c>.</p> + <p>If the table is not fixed at all, the call returns <c>false</c>.</p> </item> <item> <p><c>Item=stats, Value=tuple()</c></p> diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl index 939b1fb488..1504326c61 100644 --- a/lib/stdlib/src/array.erl +++ b/lib/stdlib/src/array.erl @@ -126,11 +126,12 @@ %% per write than base 10, but the speedup is only 21%.) -define(DEFAULT, undefined). --define(LEAFSIZE, 10). % the "base" --define(NODESIZE, ?LEAFSIZE). % (no reason to have a different size) +-define(LEAFSIZE, 10). % the "base" (assumed to be > 1) +-define(NODESIZE, ?LEAFSIZE). % must not be LEAFSIZE-1; keep same as leaf -define(NODEPATTERN(S), {_,_,_,_,_,_,_,_,_,_,S}). % NODESIZE+1 elements! --define(NEW_NODE(S), % beware of argument duplication! - setelement((?NODESIZE+1),erlang:make_tuple((?NODESIZE+1),(S)),(S))). +-define(NEW_NODE(E,S), % general case (currently unused) + setelement((?NODESIZE+1),erlang:make_tuple((?NODESIZE+1),(E)),(S))). +-define(NEW_NODE(S), erlang:make_tuple((?NODESIZE+1),(S))). % when E = S -define(NEW_LEAF(D), erlang:make_tuple(?LEAFSIZE,(D))). -define(NODELEAFS, ?NODESIZE*?LEAFSIZE). @@ -605,7 +606,7 @@ grow(I, E, M) -> grow_1(I, E, M). grow_1(I, E, M) when I >= M -> - grow(I, setelement(1, ?NEW_NODE(M), E), ?extend(M)); + grow_1(I, setelement(1, ?NEW_NODE(M), E), ?extend(M)); grow_1(_I, E, M) -> {E, M}. @@ -1631,12 +1632,11 @@ foldl_test_() -> ?_assert(foldl(Sum, 0, from_list(lists:seq(0,10))) =:= 55), ?_assert(foldl(Reverse, [], from_list(lists:seq(0,1000))) =:= lists:reverse(lists:seq(0,1000))), - ?_assert({999,[N0*100+1+2,N0*2+1+1,0]} =:= - foldl(Vals, {0,[]}, + ?_assertEqual({N0*100+1-2,[N0*100+1+2,N0*2+1+1,0]}, + foldl(Vals, {0,[]}, set(N0*100+1,2, set(N0*2+1,1, set(0,0,new()))))) - ]. -endif. @@ -1786,12 +1786,11 @@ foldr_test_() -> ?_assert(foldr(Sum, 0, from_list(lists:seq(0,10))) =:= 55), ?_assert(foldr(List, [], from_list(lists:seq(0,1000))) =:= lists:seq(0,1000)), - ?_assert({999,[0,N0*2+1+1,N0*100+1+2]} =:= - foldr(Vals, {0,[]}, + ?_assertEqual({N0*100+1-2,[0,N0*2+1+1,N0*100+1+2]}, + foldr(Vals, {0,[]}, set(N0*100+1,2, set(N0*2+1,1, set(0,0,new()))))) - ]. -endif. diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 3386cfcbe6..aa992f17ab 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -32,8 +32,12 @@ all_chunks/1, diff_dirs/2, strip/1, + strip/2, strip_files/1, + strip_files/2, strip_release/1, + strip_release/2, + significant_chunks/0, build_module/1, version/1, md5/1, @@ -188,7 +192,16 @@ diff_dirs(Dir1, Dir2) -> Beam2 :: beam(). strip(FileName) -> - try strip_file(FileName) + strip(FileName, []). + +-spec strip(Beam1, AdditionalChunks) -> + {'ok', {module(), Beam2}} | {'error', 'beam_lib', info_rsn()} when + Beam1 :: beam(), + AdditionalChunks :: [chunkid()], + Beam2 :: beam(). + +strip(FileName, AdditionalChunks) -> + try strip_file(FileName, AdditionalChunks) catch Error -> Error end. -spec strip_files(Files) -> @@ -196,8 +209,17 @@ strip(FileName) -> Files :: [beam()], Beam :: beam(). -strip_files(Files) when is_list(Files) -> - try strip_fils(Files) +strip_files(Files) -> + strip_files(Files, []). + +-spec strip_files(Files, AdditionalChunks) -> + {'ok', [{module(), Beam}]} | {'error', 'beam_lib', info_rsn()} when + Files :: [beam()], + AdditionalChunks :: [chunkid()], + Beam :: beam(). + +strip_files(Files, AdditionalChunks) when is_list(Files) -> + try strip_fils(Files, AdditionalChunks) catch Error -> Error end. -spec strip_release(Dir) -> @@ -207,7 +229,17 @@ strip_files(Files) when is_list(Files) -> Reason :: {'not_a_directory', term()} | info_rsn(). strip_release(Root) -> - catch strip_rel(Root). + strip_release(Root, []). + +-spec strip_release(Dir, AdditionalChunks) -> + {'ok', [{module(), file:filename()}]} + | {'error', 'beam_lib', Reason} when + Dir :: atom() | file:filename(), + AdditionalChunks :: [chunkid()], + Reason :: {'not_a_directory', term()} | info_rsn(). + +strip_release(Root, AdditionalChunks) -> + catch strip_rel(Root, AdditionalChunks). -spec version(Beam) -> {'ok', {module(), [Version :: term()]}} | @@ -401,17 +433,17 @@ cmp_lists([{Id, C1} | R1], [{Id, C2} | R2]) -> cmp_lists(_, _) -> error(different_chunks). -strip_rel(Root) -> +strip_rel(Root, AdditionalChunks) -> ok = assert_directory(Root), - strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam"))). + strip_fils(filelib:wildcard(filename:join(Root, "lib/*/ebin/*.beam")), AdditionalChunks). %% -> {ok, [{Mod, BinaryOrFileName}]} | throw(Error) -strip_fils(Files) -> - {ok, [begin {ok, Reply} = strip_file(F), Reply end || F <- Files]}. +strip_fils(Files, AdditionalChunks) -> + {ok, [begin {ok, Reply} = strip_file(F, AdditionalChunks), Reply end || F <- Files]}. %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) -strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), +strip_file(File, AdditionalChunks) -> + {ok, {Mod, Chunks}} = read_significant_chunks(File, AdditionalChunks ++ significant_chunks()), {ok, Stripped0} = build_module(Chunks), Stripped = compress(Stripped0), case File of diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 2939e78d9d..1f8bdc5432 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1247,18 +1247,20 @@ split_1(Bin, [_C|_]=Needle, Start, Where, Curr0, Acc) -> end end. -lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps, Ts) when is_integer(CP) -> +lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps0, Ts) when is_integer(CP) -> case lists:member(CP, CPs) of true -> [GC|Cs2] = unicode_util:gc(Cs0), case lists:member(GC, GCs) of true -> - lexemes_m(Cs2, Seps, Ts); + lexemes_m(Cs2, Seps0, Ts); false -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), lexemes_m(Rest, Seps, [Lexeme|Ts]) end; false -> + Seps = search_compile(Seps0), {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []), lexemes_m(Rest, Seps, [Lexeme|Ts]) end; diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 6418dc7eb6..4b2694320e 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -35,7 +35,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - normal/1, error/1, cmp/1, cmp_literals/1, strip/1, otp_6711/1, + normal/1, error/1, cmp/1, cmp_literals/1, strip/1, strip_add_chunks/1, otp_6711/1, building/1, md5/1, encrypted_abstr/1, encrypted_abstr_file/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -45,7 +45,7 @@ suite() -> {timetrap,{minutes,2}}]. all() -> - [error, normal, cmp, cmp_literals, strip, otp_6711, + [error, normal, cmp, cmp_literals, strip, strip_add_chunks, otp_6711, building, md5, encrypted_abstr, encrypted_abstr_file]. groups() -> @@ -401,6 +401,69 @@ strip(Conf) when is_list(Conf) -> Source5D1, BeamFile5D1]), ok. +strip_add_chunks(Conf) when is_list(Conf) -> + PrivDir = ?privdir, + {SourceD1, BeamFileD1} = make_beam(PrivDir, simple, member), + {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat), + {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun), + {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant), + {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines), + + NoOfTables = erlang:system_info(ets_count), + P0 = pps(), + + %% strip binary + verify(not_a_beam_file, beam_lib:strip(<<>>)), + {ok, B1} = file:read_file(BeamFileD1), + {ok, {simple, NB1}} = beam_lib:strip(B1), + + BId1 = chunk_ids(B1), + NBId1 = chunk_ids(NB1), + true = length(BId1) > length(NBId1), + compare_chunks(B1, NB1, NBId1), + + %% Keep all the extra chunks + ExtraChunks = ["Abst" , "Dbgi" , "Attr" , "CInf" , "LocT" , "Atom" ], + {ok, {simple, AB1}} = beam_lib:strip(B1, ExtraChunks), + ABId1 = chunk_ids(AB1), + true = length(BId1) == length(ABId1), + compare_chunks(B1, AB1, ABId1), + + %% strip file - Keep extra chunks + verify(file_error, beam_lib:strip(foo)), + {ok, {simple, _}} = beam_lib:strip(BeamFileD1, ExtraChunks), + compare_chunks(B1, BeamFileD1, ABId1), + + %% strip_files + {ok, B2} = file:read_file(BeamFile2D1), + {ok, [{simple,_},{simple2,_}]} = beam_lib:strip_files([B1, B2], ExtraChunks), + {ok, [{simple,_},{simple2,_},{make_fun,_},{constant,_}]} = + beam_lib:strip_files([BeamFileD1, BeamFile2D1, BeamFile3D1, BeamFile4D1], ExtraChunks), + + %% check that each module can be loaded. + {module, simple} = code:load_abs(filename:rootname(BeamFileD1)), + {module, simple2} = code:load_abs(filename:rootname(BeamFile2D1)), + {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)), + {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)), + + %% check that line number information is still present after stripping + {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = (catch lines:t(atom)), + false = code:purge(lines), + true = code:delete(lines), + {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1), + {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = (catch lines:t(atom)), + + true = (P0 == pps()), + NoOfTables = erlang:system_info(ets_count), + + delete_files([SourceD1, BeamFileD1, + Source2D1, BeamFile2D1, + Source3D1, BeamFile3D1, + Source4D1, BeamFile4D1, + Source5D1, BeamFile5D1]), + ok. otp_6711(Conf) when is_list(Conf) -> {'EXIT',{function_clause,_}} = (catch {a, beam_lib:info(3)}), @@ -729,6 +792,7 @@ make_beam(Dir, Module, F) -> FileBase = filename:join(Dir, atom_to_list(Module)), Source = FileBase ++ ".erl", BeamFile = FileBase ++ ".beam", + file:delete(BeamFile), simple_file(Source, Module, F), {ok, _} = compile:file(Source, [{outdir,Dir}, debug_info, report]), {Source, BeamFile}. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 7703198c4c..87ca9bd32c 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -56,6 +56,7 @@ -export([t_match_spec_run/1]). -export([t_bucket_disappears/1]). -export([t_named_select/1]). +-export([select_fixtab_owner_change/1]). -export([otp_5340/1]). -export([otp_6338/1]). -export([otp_6842_select_1000/1]). @@ -69,7 +70,10 @@ -export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, smp_ordered_iteration/1, smp_select_replace/1, otp_8166/1, otp_8732/1, delete_unfix_race/1]). --export([throughput_benchmark/0, test_throughput_benchmark/1]). +-export([throughput_benchmark/0, + throughput_benchmark/1, + test_throughput_benchmark/1, + long_throughput_benchmark/1]). -export([exit_large_table_owner/1, exit_many_large_table_owner/1, exit_many_tables_owner/1, @@ -92,6 +96,7 @@ -include_lib("stdlib/include/ms_transform.hrl"). % ets:fun2ms -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). -define(m(A,B), assert_eq(A,B)). -define(heap_binary_size, 64). @@ -130,7 +135,7 @@ all() -> t_insert_list, t_test_ms, t_select_delete, t_select_replace, t_select_replace_next_bug, t_ets_dets, memory, t_select_reverse, t_bucket_disappears, - t_named_select, + t_named_select, select_fixtab_owner_change, select_fail, t_insert_new, t_repair_continuation, otp_5340, otp_6338, otp_6842_select_1000, otp_7665, select_mbuf_trapping, @@ -150,7 +155,8 @@ all() -> take, whereis_table, delete_unfix_race, - test_throughput_benchmark]. + test_throughput_benchmark, + {group, benchmark}]. groups() -> [{new, [], @@ -178,7 +184,9 @@ groups() -> {meta_smp, [], [meta_lookup_unnamed_read, meta_lookup_unnamed_write, meta_lookup_named_read, meta_lookup_named_write, - meta_newdel_unnamed, meta_newdel_named]}]. + meta_newdel_unnamed, meta_newdel_named]}, + {benchmark, [], + [long_throughput_benchmark]}]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -191,9 +199,61 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false), ok. +init_per_group(benchmark, Config) -> + P = self(), + %% Spawn owner of ETS table that is alive until end_per_group is run + EtsProcess = + spawn( + fun()-> + Tab = ets:new(ets_benchmark_result_summary_tab, [public]), + P ! {the_table, Tab}, + receive + kill -> ok + end + end), + Tab = receive {the_table, T} -> T end, + CounterNames = [nr_of_benchmarks, + total_throughput, + nr_of_set_benchmarks, + total_throughput_set, + nr_of_ordered_set_benchmarks, + total_throughput_ordered_set], + lists:foreach(fun(CtrName) -> + ets:insert(Tab, {CtrName, 0.0}) + end, + CounterNames), + [{ets_benchmark_result_summary_tab, Tab}, + {ets_benchmark_result_summary_tab_process, EtsProcess} | Config]; init_per_group(_GroupName, Config) -> Config. +end_per_group(benchmark, Config) -> + T = proplists:get_value(ets_benchmark_result_summary_tab, Config), + EtsProcess = proplists:get_value(ets_benchmark_result_summary_tab_process, Config), + Report = + fun(NOfBenchmarksCtr, TotThroughoutCtr, Name) -> + Average = + ets:lookup_element(T, TotThroughoutCtr, 2) / + ets:lookup_element(T, NOfBenchmarksCtr, 2), + io:format("~p ~p~n", [Name, Average]), + ct_event:notify( + #event{name = benchmark_data, + data = [{suite,"ets_bench"}, + {name, Name}, + {value, Average}]}) + end, + Report(nr_of_benchmarks, + total_throughput, + "Average Throughput"), + Report(nr_of_set_benchmarks, + total_throughput_set, + "Average Throughput Set"), + Report(nr_of_ordered_set_benchmarks, + total_throughput_ordered_set, + "Average Throughput Ordered Set"), + ets:delete(T), + EtsProcess ! kill, + Config; end_per_group(_GroupName, Config) -> Config. @@ -249,7 +309,64 @@ t_named_select_do(Opts) -> verify_etsmem(EtsMem). +%% Verify select and friends release fixtab as they should +%% even when owneship is changed between traps. +select_fixtab_owner_change(_Config) -> + T = ets:new(xxx, [protected]), + NKeys = 2000, + [ets:insert(T,{K,K band 7}) || K <- lists:seq(1,NKeys)], + + %% Buddy and Papa will ping-pong table ownership between them + %% and the aim is to give Buddy the table when he is + %% in the middle of a yielding select* call. + {Buddy,_} = spawn_opt(fun() -> sfoc_buddy_loop(T, 1, undefined) end, + [link,monitor]), + sfoc_papa_loop(T, Buddy), + + receive {'DOWN', _, process, Buddy, _} -> ok end, + ets:delete(T), + ok. + +sfoc_buddy_loop(T, I, State0) -> + receive + {'ETS-TRANSFER', T, Papa, _} -> + ets:give_away(T, Papa, State0), + case State0 of + done -> + ok; + _ -> + State1 = sfoc_traverse(T, I, State0), + %% Verify no fixation left + {I, false} = {I, ets:info(T, safe_fixed_monotonic_time)}, + sfoc_buddy_loop(T, I+1, State1) + end + end. + +sfoc_papa_loop(T, Buddy) -> + ets:give_away(T, Buddy, "Catch!"), + receive + {'ETS-TRANSFER', T, Buddy, State} -> + case State of + done -> + ok; + _ -> + sfoc_papa_loop(T, Buddy) + end + end. + +sfoc_traverse(T, 1, S) -> + ets:select(T, [{{'$1',7}, [], ['$1']}]), S; +sfoc_traverse(T, 2, S) -> + 0 = ets:select_count(T, [{{'$1',7}, [], [false]}]), S; +sfoc_traverse(T, 3, _) -> + Limit = ets:info(T, size) div 2, + {_, Continuation} = ets:select(T, [{{'$1',7}, [], ['$1']}], + Limit), + Continuation; +sfoc_traverse(_T, 4, Continuation) -> + _ = ets:select(Continuation), + done. %% Check ets:match_spec_run/2. t_match_spec_run(Config) when is_list(Config) -> @@ -6472,8 +6589,8 @@ whereis_table(Config) when is_list(Config) -> ok. -%% The following work functions are used by -%% throughput_benchmark/4. They are declared on the top level beacuse +%% The following help functions are used by +%% throughput_benchmark. They are declared on the top level beacuse %% declaring them as function local funs cause a scalability issue. get_op([{_,O}], _RandNum) -> O; @@ -6508,10 +6625,131 @@ prefill_table_loop(T, RS0, N, ObjFun) -> ets:insert(T, ObjFun(Key)), prefill_table_loop(T, RS1, N-1, ObjFun). -throughput_benchmark() -> - throughput_benchmark(false, not_set, not_set). +-record(ets_throughput_bench_config, + {benchmark_duration_ms = 3000, + recover_time_ms = 1000, + thread_counts = not_set, + key_ranges = [1000000], + scenarios = + [ + [ + {0.5, insert}, + {0.5, delete} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.8, lookup} + ], + [ + {0.01, insert}, + {0.01, delete}, + {0.98, lookup} + ], + [ + {1.0, lookup} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq10} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq100} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq1000} + ], + [ + {1.0, nextseq1000} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.7999, lookup}, + {0.0001, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.799999, lookup}, + {0.000001, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, partial_select1000} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.7999, lookup}, + {0.0001, partial_select1000} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.799999, lookup}, + {0.000001, partial_select1000} + ] + ], + table_types = + [ + [ordered_set, public], + [ordered_set, public, {write_concurrency, true}], + [ordered_set, public, {read_concurrency, true}], + [ordered_set, public, {write_concurrency, true}, {read_concurrency, true}], + [set, public], + [set, public, {write_concurrency, true}], + [set, public, {read_concurrency, true}], + [set, public, {write_concurrency, true}, {read_concurrency, true}] + ], + etsmem_fun = fun() -> ok end, + verify_etsmem_fun = fun(_) -> true end, + notify_res_fun = fun(_Name, _Throughput) -> ok end, + print_result_paths_fun = + fun(ResultPath, _LatestResultPath) -> + Comment = + io_lib:format("<a href=\"file:///~s\">Result visualization</a>",[ResultPath]), + {comment, Comment} + end + }). + +stdout_notify_res(ResultPath, LatestResultPath) -> + io:format("Result Location: /~s~n", [ResultPath]), + io:format("Latest Result Location: ~s~n", [LatestResultPath]). -throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> +throughput_benchmark() -> + throughput_benchmark( + #ets_throughput_bench_config{ + print_result_paths_fun = fun stdout_notify_res/2}). + +throughput_benchmark( + #ets_throughput_bench_config{ + benchmark_duration_ms = BenchmarkDurationMs, + recover_time_ms = RecoverTimeMs, + thread_counts = ThreadCountsOpt, + key_ranges = KeyRanges, + scenarios = Scenarios, + table_types = TableTypes, + etsmem_fun = ETSMemFun, + verify_etsmem_fun = VerifyETSMemFun, + notify_res_fun = NotifyResFun, + print_result_paths_fun = PrintResultPathsFun}) -> NrOfSchedulers = erlang:system_info(schedulers), %% Definitions of operations that are supported by the benchmark NextSeqOp = @@ -6576,7 +6814,7 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> fun(T,KeyRange) -> NextSeqOp(T,KeyRange,1000) end, selectAll => fun(T,_KeyRange) -> - case -1 =:= ets:select_count(T, ets:fun2ms(fun(X) -> true end)) of + case -1 =:= ets:select_count(T, ets:fun2ms(fun(_X) -> true end)) of true -> io:format("Will never be printed"); false -> ok end @@ -6625,11 +6863,28 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> false -> ok end end, + DataHolder = + fun DataHolderFun(Data)-> + receive + {get_data, Pid} -> Pid ! {ets_bench_data, Data}; + D -> DataHolderFun([Data,D]) + end + end, + DataHolderPid = spawn_link(fun()-> DataHolder([]) end), + PrintData = + fun (Str, List) -> + io:format(Str, List), + DataHolderPid ! io_lib:format(Str, List) + end, + GetData = + fun () -> + DataHolderPid ! {get_data, self()}, + receive {ets_bench_data, Data} -> Data end + end, %% Function that runs a benchmark instance and returns the number %% of operations that were performed RunBenchmark = - fun(NrOfProcs, TableConfig, Scenario, - Range, Duration, RecoverTime) -> + fun({NrOfProcs, TableConfig, Scenario, Range, Duration}) -> ProbHelpTab = CalculateOpsProbHelpTab(Scenario, 0), Table = ets:new(t, TableConfig), Nobj = Range div 2, @@ -6637,16 +6892,15 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> Nobj = ets:info(Table, size), SafeFixTableIfRequired(Table, Scenario, true), ParentPid = self(), + Worker = + fun() -> + receive start -> ok end, + WorksDone = + do_work(0, Table, ProbHelpTab, Range, Operations), + ParentPid ! WorksDone + end, ChildPids = - lists:map( - fun(_N) -> - spawn(fun() -> - receive start -> ok end, - WorksDone = - do_work(0, Table, ProbHelpTab, Range, Operations), - ParentPid ! WorksDone - end) - end, lists:seq(1, NrOfProcs)), + lists:map(fun(_N) ->spawn_link(Worker)end, lists:seq(1, NrOfProcs)), lists:foreach(fun(Pid) -> Pid ! start end, ChildPids), timer:sleep(Duration), lists:foreach(fun(Pid) -> Pid ! stop end, ChildPids), @@ -6658,185 +6912,194 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> end, 0, ChildPids), SafeFixTableIfRequired(Table, Scenario, false), ets:delete(Table), - timer:sleep(RecoverTime), TotalWorksDone end, - %% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% Benchmark Configuration %%%%%%%%%%%%%%%%%%%%%%%% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% - %% Change the following variables to configure the benchmark runs - ThreadCounts = - case TestMode of - true -> [1, NrOfSchedulers]; - false -> CalculateThreadCounts([1]) + RunBenchmarkInSepProcess = + fun(ParameterTuple) -> + P = self(), + spawn_link(fun()-> P ! {bench_result, RunBenchmark(ParameterTuple)} end), + Result = receive {bench_result, Res} -> Res end, + timer:sleep(RecoverTimeMs), + Result end, - KeyRanges = % Sizes of the key ranges - case TestMode of - true -> [50000]; - false -> [1000000] + RunBenchmarkAndReport = + fun(ThreadCount, + TableType, + Scenario, + KeyRange, + Duration) -> + Result = RunBenchmarkInSepProcess({ThreadCount, + TableType, + Scenario, + KeyRange, + Duration}), + Throughput = Result/(Duration/1000.0), + PrintData("; ~f",[Throughput]), + Name = io_lib:format("Scenario: ~w, Key Range Size: ~w, " + "# of Processes: ~w, Table Type: ~w", + [Scenario, KeyRange, ThreadCount, TableType]), + NotifyResFun(Name, Throughput) end, - Duration = - case BenchmarkRunMs of % Duration of a benchmark run in milliseconds - not_set -> 30000; - _ -> BenchmarkRunMs - end, - TimeMsToSleepAfterEachBenchmarkRun = - case RecoverTimeMs of - not_set -> 1000; - _ -> RecoverTimeMs + ThreadCounts = + case ThreadCountsOpt of + not_set -> + CalculateThreadCounts([1]); + _ -> ThreadCountsOpt end, - TableTypes = % The table types that will be benchmarked - [ - [ordered_set, public], - [ordered_set, public, {write_concurrency, true}], - [ordered_set, public, {read_concurrency, true}], - [ordered_set, public, {write_concurrency, true}, {read_concurrency, true}], - [set, public], - [set, public, {write_concurrency, true}], - [set, public, {read_concurrency, true}], - [set, public, {write_concurrency, true}, {read_concurrency, true}] - ], - Scenarios = % Benchmark scenarios (the fractions should add up to approximately 1.0) - [ - [ - {0.5, insert}, - {0.5, delete} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.8, lookup} - ], - [ - {0.01, insert}, - {0.01, delete}, - {0.98, lookup} - ], - [ - {1.0, lookup} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.4, lookup}, - {0.4, nextseq10} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.4, lookup}, - {0.4, nextseq100} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.4, lookup}, - {0.4, nextseq1000} - ], - [ - {1.0, nextseq1000} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.79, lookup}, - {0.01, selectAll} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.7999, lookup}, - {0.0001, selectAll} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.799999, lookup}, - {0.000001, selectAll} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.79, lookup}, - {0.01, partial_select1000} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.7999, lookup}, - {0.0001, partial_select1000} - ], - [ - {0.1, insert}, - {0.1, delete}, - {0.799999, lookup}, - {0.000001, partial_select1000} - ] - ], - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% End of Benchmark Configuration %%%%%%%%%%%%%%%% - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Prepare for memory check - EtsMem = case TestMode of - true -> etsmem(); - false -> ok - end, %% Run the benchmark - io:format("# Each instance of the benchmark runs for ~w seconds:~n", [Duration/1000]), - io:format("# The result of a benchmark instance is presented as a number representing~n"), - io:format("# the number of operations performed per second:~n~n~n"), - io:format("# To plot graphs for the results below:~n"), - io:format("# 1. Open \"$ERL_TOP/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html\" in a web browser~n"), - io:format("# 2. Copy the lines between \"#BENCHMARK STARTED$\" and \"#BENCHMARK ENDED$\" below~n"), - io:format("# 3. Paste the lines copied in step 2 to the text box in the browser window opened in~n"), - io:format("# step 1 and press the Render button~n~n"), - io:format("#BENCHMARK STARTED$~n"), + PrintData("# Each instance of the benchmark runs for ~w seconds:~n", [BenchmarkDurationMs/1000]), + PrintData("# The result of a benchmark instance is presented as a number representing~n",[]), + PrintData("# the number of operations performed per second:~n~n~n",[]), + PrintData("# To plot graphs for the results below:~n",[]), + PrintData("# 1. Open \"$ERL_TOP/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html\" in a web browser~n",[]), + PrintData("# 2. Copy the lines between \"#BENCHMARK STARTED$\" and \"#BENCHMARK ENDED$\" below~n",[]), + PrintData("# 3. Paste the lines copied in step 2 to the text box in the browser window opened in~n",[]), + PrintData("# step 1 and press the Render button~n~n",[]), + PrintData("#BENCHMARK STARTED$~n",[]), + EtsMem = ETSMemFun(), %% The following loop runs all benchmark scenarios and prints the results (i.e, operations/second) lists:foreach( fun(KeyRange) -> lists:foreach( fun(Scenario) -> - io:format("Scenario: ~s | Key Range Size: ~w$~n", - [RenderScenario(Scenario, ""), - KeyRange]), + PrintData("Scenario: ~s | Key Range Size: ~w$~n", + [RenderScenario(Scenario, ""), KeyRange]), lists:foreach( fun(ThreadCount) -> - io:format("; ~w",[ThreadCount]) + PrintData("; ~w",[ThreadCount]) end, ThreadCounts), - io:format("$~n",[]), + PrintData("$~n",[]), lists:foreach( fun(TableType) -> - io:format("~w ",[TableType]), + PrintData("~w ",[TableType]), lists:foreach( fun(ThreadCount) -> - Result = RunBenchmark(ThreadCount, + RunBenchmarkAndReport(ThreadCount, TableType, Scenario, KeyRange, - Duration, - TimeMsToSleepAfterEachBenchmarkRun), - io:format("; ~f",[Result/(Duration/1000.0)]) + BenchmarkDurationMs) end, ThreadCounts), - io:format("$~n",[]) + PrintData("$~n",[]) end, TableTypes) end, Scenarios) end, KeyRanges), - io:format("~n#BENCHMARK ENDED$~n~n"), - case TestMode of - true -> verify_etsmem(EtsMem); - false -> ok - end. + PrintData("~n#BENCHMARK ENDED$~n~n",[]), + VerifyETSMemFun(EtsMem), + DataDir = filename:join(filename:dirname(code:which(?MODULE)), "ets_SUITE_data"), + TemplatePath = filename:join(DataDir, "visualize_throughput.html"), + {ok, Template} = file:read_file(TemplatePath), + OutputData = string:replace(Template, "#bench_data_placeholder", GetData()), + OutputPath1 = filename:join(DataDir, "ets_bench_result.html"), + {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_datetime(erlang:timestamp()), + StrTime = lists:flatten(io_lib:format("~4..0w-~2..0w-~2..0wT~2..0w:~2..0w:~2..0w",[Year,Month,Day,Hour,Minute,Second])), + OutputPath2 = filename:join(DataDir, io_lib:format("ets_bench_result_~s.html", [StrTime])), + file:write_file(OutputPath1, OutputData), + file:write_file(OutputPath2, OutputData), + PrintResultPathsFun(OutputPath2, OutputPath1). test_throughput_benchmark(Config) when is_list(Config) -> - throughput_benchmark(true, 100, 0). - + throughput_benchmark( + #ets_throughput_bench_config{ + benchmark_duration_ms = 100, + recover_time_ms = 0, + thread_counts = [1, erlang:system_info(schedulers)], + key_ranges = [50000], + etsmem_fun = fun etsmem/0, + verify_etsmem_fun = fun verify_etsmem/1}). + +long_throughput_benchmark(Config) when is_list(Config) -> + N = erlang:system_info(schedulers), + throughput_benchmark( + #ets_throughput_bench_config{ + benchmark_duration_ms = 3000, + recover_time_ms = 1000, + thread_counts = [1, N div 2, N], + key_ranges = [1000000], + scenarios = + [ + [ + {0.5, insert}, + {0.5, delete} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.8, lookup} + ], + [ + {0.01, insert}, + {0.01, delete}, + {0.98, lookup} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.4, lookup}, + {0.4, nextseq100} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, selectAll} + ], + [ + {0.1, insert}, + {0.1, delete}, + {0.79, lookup}, + {0.01, partial_select1000} + ] + ], + table_types = + [ + [ordered_set, public, {write_concurrency, true}, {read_concurrency, true}], + [set, public, {write_concurrency, true}, {read_concurrency, true}] + ], + etsmem_fun = fun etsmem/0, + verify_etsmem_fun = fun verify_etsmem/1, + notify_res_fun = + fun(Name, Throughput) -> + SummaryTable = + proplists:get_value(ets_benchmark_result_summary_tab, Config), + AddToSummaryCounter = + case SummaryTable of + undefined -> + fun(_, _) -> + ok + end; + Tab -> + fun(CounterName, ToAdd) -> + OldVal = ets:lookup_element(Tab, CounterName, 2), + NewVal = OldVal + ToAdd, + ets:insert(Tab, {CounterName, NewVal}) + end + end, + Record = + fun(NoOfBenchsCtr, TotThrputCtr) -> + AddToSummaryCounter(NoOfBenchsCtr, 1), + AddToSummaryCounter(TotThrputCtr, Throughput) + end, + Record(nr_of_benchmarks, total_throughput), + case string:find(Name, "ordered_set") of + nomatch -> + Record(nr_of_set_benchmarks, total_throughput_set); + _ -> + Record(nr_of_ordered_set_benchmarks, + total_throughput_ordered_set) + end, + ct_event:notify( + #event{name = benchmark_data, + data = [{suite,"ets_bench"}, + {name, Name}, + {value,Throughput}]}) + end + }). add_lists(L1,L2) -> add_lists(L1,L2,[]). diff --git a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html index a2c61aa938..27d6849c60 100644 --- a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html +++ b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html @@ -42,7 +42,7 @@ </p> Paste the generated data in the field below and press the Render button: <br> - <textarea id="dataField" rows="4" cols="50"></textarea> + <textarea id="dataField" rows="4" cols="50">#bench_data_placeholder</textarea> <br> <input type="checkbox" id="barPlot"> Bar Plot <br> @@ -56,13 +56,13 @@ <br> <input type="checkbox" class="showCheck" value="[ordered_set,public,{write_concurrency,true},{read_concurrency,true}]" checked> Show <code>[ordered_set,public,{write_concurrency,true},{read_concurrency,true}]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public]"> Show <code>[set,public]</code> + <input type="checkbox" class="showCheck" value="[set,public]" checked> Show <code>[set,public]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true}]"> Show <code>[set,public,{write_concurrency,true}]</code> + <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true}]" checked> Show <code>[set,public,{write_concurrency,true}]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public,{read_concurrency,true}]"> Show <code>[set,public,{read_concurrency,true}]</code> + <input type="checkbox" class="showCheck" value="[set,public,{read_concurrency,true}]" checked> Show <code>[set,public,{read_concurrency,true}]</code> <br> - <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true},{read_concurrency,true}]"> Show <code>[set,public,{write_concurrency,true},{read_concurrency,true}]</code> + <input type="checkbox" class="showCheck" value="[set,public,{write_concurrency,true},{read_concurrency,true}]" checked> Show <code>[set,public,{write_concurrency,true},{read_concurrency,true}]</code> <br> <button id="renderButton" type="button">Render</button> diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec index 4de7c1a0eb..bf64eae2c7 100644 --- a/lib/stdlib/test/stdlib.spec +++ b/lib/stdlib/test/stdlib.spec @@ -2,3 +2,6 @@ {skip_groups,"../stdlib_test",stdlib_bench_SUITE, [binary,base64,gen_server,gen_statem,unicode], "Benchmark only"}. +{skip_groups,"../stdlib_test",ets_SUITE, + [benchmark], + "Benchmark only"}. diff --git a/lib/stdlib/test/stdlib_bench.spec b/lib/stdlib/test/stdlib_bench.spec index 7a0da811a0..6d665f22b6 100644 --- a/lib/stdlib/test/stdlib_bench.spec +++ b/lib/stdlib/test/stdlib_bench.spec @@ -8,3 +8,4 @@ {skip_groups,"../stdlib_test",stdlib_bench_SUITE, [gen_server_comparison,gen_statem_comparison], "Not a benchmark"}. +{groups,"../stdlib_test",ets_SUITE,[benchmark]}. diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 251e09121c..6afe9e7a76 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -52,7 +52,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,1}}]. + {timetrap,{minutes,2}}]. all() -> [{group, chardata}, {group, list_string}]. @@ -737,10 +737,10 @@ meas(Config) -> case ct:get_timetrap_info() of {_,{_,Scale}} when Scale > 1 -> {skip,{will_not_run_in_debug,Scale}}; - _ -> % No scaling, run at most 1.5 min + _ -> % No scaling, run at most 2 mins Tester = spawn(Exec), receive {test_done, Tester} -> ok - after 90000 -> + after 120000 -> io:format("Timelimit reached stopping~n",[]), exit(Tester, die) end, @@ -754,19 +754,22 @@ do_measure(DataDir) -> io:format("~p~n",[byte_size(Bin)]), Do = fun(Name, Func, Mode) -> {N, Mean, Stddev, _} = time_func(Func, Mode, Bin, 20), - io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + io:format("~15w ~15w ~8.2fms ±~6.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, Do2 = fun(Name, Func, Mode) -> {N, Mean, Stddev, _} = time_func(Func, binary, <<>>, 20), - io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + io:format("~15w ~15w ~8.2fms ±~6.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, + %% lefty_list means a list balanced to the left, like + %% [[[30],31],32]. Only some functions check such lists. + Modes = [list, lefty_list, binary, {many_lists,1}, {many_lists, 4}], io:format("----------------------~n"), Do(old_tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list), Tokens = {lexemes, fun(Str) -> string:lexemes(Str, [$\n,$\r]) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- Modes], S0 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....", S0B = <<"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....">>, @@ -824,17 +827,17 @@ do_measure(DataDir) -> io:format("--~n",[]), NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- Modes], Do2(take_t, repeat(fun() -> string:take(S0, [$.,$y], false, trailing) end), list), Do2(take_t, repeat(fun() -> string:take(S0B, [$.,$y], false, trailing) end), binary), Do2(take_tc, repeat(fun() -> string:take(S0, [$x], true, trailing) end), list), Do2(take_tc, repeat(fun() -> string:take(S0B, [$x], true, trailing) end), binary), Length = {length, fun(Str) -> string:length(Str) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- Modes], Reverse = {reverse, fun(Str) -> string:reverse(Str) end}, - [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- [list, binary]], + [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- Modes], ok. @@ -1064,7 +1067,33 @@ time_func(N,Sum,SumSq, _, _, Res, _) -> {N, Mean, Stdev, Res}. mode(binary, Bin) -> Bin; -mode(list, Bin) -> unicode:characters_to_list(Bin). +mode(list, Bin) -> unicode:characters_to_list(Bin); +mode(lefty_list, Bin) -> + L = unicode:characters_to_list(Bin), + to_left(L); +mode({many_lists, N}, Bin) -> + group(unicode:characters_to_list(Bin), N). + +group([], _N) -> + []; +group(L, N) -> + try lists:split(N, L) of + {L1, L2} -> + [L1 | group(L2, N)] + catch + _:_ -> + [L] + end. + +to_left([]) -> + []; +to_left([H|L]) -> + to_left([H], L). + +to_left(V, []) -> + V; +to_left(V, [H|L]) -> + to_left([V,H], L). %% %% Old string lists Test cases starts here. diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index 70eec1a6f2..8636c69a0d 100755..100644 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017. All Rights Reserved. +%% Copyright Ericsson AB 2017-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -460,17 +460,73 @@ gen_cp(Fd) -> " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, "cp([C|_]=L) when is_integer(C) -> L;\n"), io:put_chars(Fd, "cp([List]) -> cp(List);\n"), - io:put_chars(Fd, "cp([List|R]) ->\n"), - io:put_chars(Fd, " case cp(List) of\n"), - io:put_chars(Fd, " [] -> cp(R);\n"), - io:put_chars(Fd, " [CP] -> [CP|R];\n"), - io:put_chars(Fd, " [C|R0] -> [C|[R0|R]];\n"), - io:put_chars(Fd, " {error,Error} -> {error,[Error|R]}\n"), - io:put_chars(Fd, " end;\n"), + io:put_chars(Fd, "cp([List|R]) -> cpl(List, R);\n"), io:put_chars(Fd, "cp([]) -> [];\n"), io:put_chars(Fd, "cp(<<C/utf8, R/binary>>) -> [C|R];\n"), io:put_chars(Fd, "cp(<<>>) -> [];\n"), - io:put_chars(Fd, "cp(<<R/binary>>) -> {error,R}.\n\n"), + io:put_chars(Fd, "cp(<<R/binary>>) -> {error,R}.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl([C], R) when is_integer(C) -> [C|cpl_1_cont(R)];\n"), + io:put_chars(Fd, "cpl([C|T], R) when is_integer(C) -> [C|cpl_cont(T, R)];\n"), + io:put_chars(Fd, "cpl([List], R) -> cpl(List, R);\n"), + io:put_chars(Fd, "cpl([List|T], R) -> cpl(List, [T|R]);\n"), + io:put_chars(Fd, "cpl([], R) -> cp(R);\n"), + io:put_chars(Fd, "cpl(<<C/utf8, T/binary>>, R) -> [C,T|R];\n"), + io:put_chars(Fd, "cpl(<<>>, R) -> cp(R);\n"), + io:put_chars(Fd, "cpl(<<B/binary>>, R) -> {error,[B|R]}.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "%%%\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_cont([C|T], R) when is_integer(C) -> [C|cpl_cont2(T, R)];\n"), + io:put_chars(Fd, "cpl_cont([L], R) -> cpl_cont(L, R);\n"), + io:put_chars(Fd, "cpl_cont([L|T], R) -> cpl_cont(L, [T|R]);\n"), + io:put_chars(Fd, "cpl_cont([], R) -> cpl_1_cont(R);\n"), + io:put_chars(Fd, "cpl_cont(T, R) -> [T|R].\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_cont2([C|T], R) when is_integer(C) -> [C|cpl_cont3(T, R)];\n"), + io:put_chars(Fd, "cpl_cont2([L], R) -> cpl_cont2(L, R);\n"), + io:put_chars(Fd, "cpl_cont2([L|T], R) -> cpl_cont2(L, [T|R]);\n"), + io:put_chars(Fd, "cpl_cont2([], R) -> cpl_1_cont2(R);\n"), + io:put_chars(Fd, "cpl_cont2(T, R) -> [T|R].\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_cont3([C], R) when is_integer(C) -> [C|R];\n"), + io:put_chars(Fd, "cpl_cont3([C|T], R) when is_integer(C) -> [C,T|R];\n"), + io:put_chars(Fd, "cpl_cont3([L], R) -> cpl_cont3(L, R);\n"), + io:put_chars(Fd, "cpl_cont3([L|T], R) -> cpl_cont3(L, [T|R]);\n"), + io:put_chars(Fd, "cpl_cont3([], R) -> cpl_1_cont3(R);\n"), + io:put_chars(Fd, "cpl_cont3(T, R) -> [T|R].\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "%%%\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_1_cont([C|T]) when is_integer(C) -> [C|cpl_1_cont2(T)];\n"), + io:put_chars(Fd, "cpl_1_cont([L]) -> cpl_1_cont(L);\n"), + io:put_chars(Fd, "cpl_1_cont([L|T]) -> cpl_cont(L, T);\n"), + io:put_chars(Fd, "cpl_1_cont(T) -> T.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_1_cont2([C|T]) when is_integer(C) -> [C|cpl_1_cont3(T)];\n"), + io:put_chars(Fd, "cpl_1_cont2([L]) -> cpl_1_cont2(L);\n"), + io:put_chars(Fd, "cpl_1_cont2([L|T]) -> cpl_cont2(L, T);\n"), + io:put_chars(Fd, "cpl_1_cont2(T) -> T.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cpl_1_cont3([C|_]=T) when is_integer(C) -> T;\n"), + io:put_chars(Fd, "cpl_1_cont3([L]) -> cpl_1_cont3(L);\n"), + io:put_chars(Fd, "cpl_1_cont3([L|T]) -> cpl_cont3(L, T);\n"), + io:put_chars(Fd, "cpl_1_cont3(T) -> T.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "%%%\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cp_no_bin([C|_]=L) when is_integer(C) -> L;\n"), + io:put_chars(Fd, "cp_no_bin([List]) -> cp_no_bin(List);\n"), + io:put_chars(Fd, "cp_no_bin([List|R]) -> cp_no_binl(List, R);\n"), + io:put_chars(Fd, "cp_no_bin([]) -> [];\n"), + io:put_chars(Fd, "cp_no_bin(_) -> binary_found.\n"), + io:put_chars(Fd, "\n"), + io:put_chars(Fd, "cp_no_binl([C], R) when is_integer(C) -> [C|cpl_1_cont(R)];\n"), + io:put_chars(Fd, "cp_no_binl([C|T], R) when is_integer(C) -> [C|cpl_cont(T, R)];\n"), + io:put_chars(Fd, "cp_no_binl([List], R) -> cp_no_binl(List, R);\n"), + io:put_chars(Fd, "cp_no_binl([List|T], R) -> cp_no_binl(List, [T|R]);\n"), + io:put_chars(Fd, "cp_no_binl([], R) -> cp_no_bin(R);\n"), + io:put_chars(Fd, "cp_no_binl(_, _) -> binary_found.\n\n"), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -481,11 +537,26 @@ gen_gc(Fd, GBP) -> "-spec gc(String::unicode:chardata()) ->" " maybe_improper_list() | {error, unicode:chardata()}.\n"), io:put_chars(Fd, - "gc([CP1, CP2|_]=T)\n" - " when CP1 < 256, CP2 < 256, CP1 =/= $\r -> %% Ascii Fast path\n" - " T;\n" + "gc([]=R) -> R;\n" + "gc([CP]=R) when is_integer(CP) -> R;\n" + "gc([$\\r=CP|R0]) ->\n" + " case cp(R0) of % Don't break CRLF\n" + " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" + " T -> [CP|T]\n" + " end;\n" + "gc([CP1|T1]=T) when CP1 < 256 ->\n" + " case T1 of\n" + " [CP2|_] when CP2 < 256 -> T; %% Ascii Fast path\n" + " _ -> %% Keep the tail binary.\n" + " case cp_no_bin(T1) of\n" + " [CP2|_]=T3 when CP2 < 256 -> [CP1|T3]; %% Asciii Fast path\n" + " binary_found -> gc_1(T);\n" + " T4 -> gc_1([CP1|T4])\n" + " end\n" + " end;\n" + "gc(<<>>) -> [];\n" "gc(<<CP1/utf8, Rest/binary>>) ->\n" - " if CP1 < 256, CP1 =/= $\r ->\n" + " if CP1 < 256, CP1 =/= $\\r ->\n" " case Rest of\n" " <<CP2/utf8, _/binary>> when CP2 < 256 -> %% Ascii Fast path\n" " [CP1|Rest];\n" @@ -493,13 +564,12 @@ gen_gc(Fd, GBP) -> " end;\n" " true -> gc_1([CP1|Rest])\n" " end;\n" + "gc([CP|_]=T) when is_integer(CP) -> gc_1(T);\n" "gc(Str) ->\n" - " gc_1(cp(Str)).\n\n" - "gc_1([$\\r|R0] = R) ->\n" - " case cp(R0) of % Don't break CRLF\n" - " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" - " _ -> R\n" - " end;\n" + " case cp(Str) of\n" + " {error,_}=Error -> Error;\n" + " CPs -> gc(CPs)\n" + " end.\n" ), GenExtP = fun(Range) -> io:format(Fd, "gc_1~s gc_ext_pict(R1,[CP]);\n", [gen_clause(Range)]) end, @@ -507,7 +577,12 @@ gen_gc(Fd, GBP) -> %% Pick codepoints below 256 (some data knowledge here) {ExtendedPictographicLow,ExtendedPictographicHigh} = lists:splitwith(fun({Start,undefined}) -> Start < 256 end,ExtendedPictographic0), - + io:put_chars(Fd, + "\ngc_1([$\\r|R0] = R) ->\n" + " case cp(R0) of % Don't break CRLF\n" + " [$\\n|R1] -> [[$\\r,$\\n]|R1];\n" + " _ -> R\n" + " end;\n"), io:put_chars(Fd, "\n%% Handle control\n"), GenControl = fun(Range) -> io:format(Fd, "gc_1~s R0;\n", [gen_clause(Range)]) end, CRs0 = merge_ranges(maps:get(cr, GBP) ++ maps:get(lf, GBP) ++ maps:get(control, GBP), false), @@ -516,7 +591,14 @@ gen_gc(Fd, GBP) -> %%GenControl(R1),GenControl(R2),GenControl(R3), io:put_chars(Fd, "\n%% Optimize Latin-1\n"), [GenExtP(CP) || CP <- merge_ranges(ExtendedPictographicLow)], - io:format(Fd, "gc_1([CP|R]) when CP < 256 -> gc_extend(R,CP);\n\n", []), + + io:format(Fd, + "gc_1([CP|R]=R0) when CP < 256 ->\n" + " case R of\n" + " [CP2|_] when CP2 < 256 -> R0;\n" + " _ -> gc_extend(cp(R), R, CP)\n" + " end;\n", + []), io:put_chars(Fd, "\n%% Continue control\n"), [GenControl(CP) || CP <- Crs], %% One clause per CP @@ -540,7 +622,7 @@ gen_gc(Fd, GBP) -> io:put_chars(Fd, "gc_1([CP|_]=R0) when 44000 < CP, CP < 56000 -> gc_h_lv_lvt(R0, []);\n"), io:put_chars(Fd, "\n%% Handle Regional\n"), - GenRegional = fun(Range) -> io:format(Fd, "gc_1~s gc_regional(R1,[CP]);\n", [gen_clause(Range)]) end, + GenRegional = fun(Range) -> io:format(Fd, "gc_1~s gc_regional(R1,CP);\n", [gen_clause(Range)]) end, [GenRegional(CP) || CP <- merge_ranges(maps:get(regional_indicator,GBP))], %% io:put_chars(Fd, "%% Handle E_Base\n"), %% GenEBase = fun(Range) -> io:format(Fd, "gc_1~s gc_e_cont(R1,[CP]);\n", [gen_clause(Range)]) end, @@ -552,9 +634,7 @@ gen_gc(Fd, GBP) -> io:put_chars(Fd, "%% Handle extended_pictographic\n"), [GenExtP(CP) || CP <- merge_ranges(ExtendedPictographicHigh)], io:put_chars(Fd, "\n%% default clauses\n"), - io:put_chars(Fd, "gc_1([CP|R]) -> gc_extend(R, CP);\n"), - io:put_chars(Fd, "gc_1([]) -> [];\n"), - io:put_chars(Fd, "gc_1({error,_}=Error) -> Error.\n\n"), + io:put_chars(Fd, "gc_1([CP|R]) -> gc_extend(cp(R), R, CP).\n\n"), io:put_chars(Fd, "%% Handle Prepend\n"), io:put_chars(Fd, @@ -581,31 +661,24 @@ gen_gc(Fd, GBP) -> "%% To simplify binary handling in libraries the tail should be kept binary\n" "%% and not a lookahead CP\n" ), - io:put_chars(Fd, "gc_extend(T, Acc) ->\n" - " gc_extend(cp(T), T, Acc).\n\n"), io:put_chars(Fd, - "gc_extend([CP|T], T0, Acc0) ->\n" + "gc_extend([CP|T], T0, CP0) ->\n" " case is_extend(CP) of\n" - " false ->\n" - " case Acc0 of\n" - " [Acc] -> [Acc|T0];\n" - " [_|_]=Acc -> [lists:reverse(Acc)|T0];\n" - " Acc -> [Acc|T0]\n" - " end;\n" - " _TrueOrZWJ ->\n" - " case Acc0 of\n" - " [_|_] -> gc_extend(T, [CP|Acc0]);\n" - " Acc -> gc_extend(T, [CP,Acc])\n" - " end\n" + " false -> [CP0|T0]; % losing work done on T\n" + " _TrueOrZWJ -> gc_extend2(cp(T), T, [CP,CP0])\n" " end;\n" - "gc_extend([], _, Acc0) ->\n" - " case Acc0 of\n" - " [_]=Acc -> Acc;\n" - " [_|_]=Acc -> [lists:reverse(Acc)];\n" - " Acc -> [Acc]\n" + "gc_extend([], _, CP) -> [CP];\n" + "gc_extend({error,R}, _, CP) -> [CP|R].\n\n"), + io:put_chars(Fd, + "gc_extend2([CP|T], T0, Acc) ->\n" + " case is_extend(CP) of\n" + " false -> [lists:reverse(Acc)|T0]; % losing work done on T\n" + " _TrueOrZWJ -> gc_extend2(cp(T), T, [CP|Acc])\n" " end;\n" - "gc_extend({error,R}, T, Acc0) ->\n" - " gc_extend([], T, Acc0) ++ [R].\n\n" + "gc_extend2([], _, Acc) ->\n" + " [lists:reverse(Acc)];\n" + "gc_extend2({error,R}, _, Acc) ->\n" + " [lists:reverse(Acc)] ++ [R].\n\n" ), [ZWJ] = maps:get(zwj, GBP), GenExtend = fun(R) when R =:= ZWJ -> io:format(Fd, "is_extend~s zwj;\n", [gen_single_clause(ZWJ)]); @@ -660,10 +733,10 @@ gen_gc(Fd, GBP) -> %% -------------------- io:put_chars(Fd, "%% Handle Regional\n"), [{RLess,RLarge}] = merge_ranges(maps:get(regional_indicator,GBP)), - io:put_chars(Fd,"gc_regional(R0, Acc) ->\n" + io:put_chars(Fd,"gc_regional(R0, CP0) ->\n" " case cp(R0) of\n"), - io:format(Fd, " [CP|R1] when ~w =< CP,CP =< ~w-> gc_extend(R1,[CP|Acc]);~n",[RLess, RLarge]), - io:put_chars(Fd," R1 -> gc_extend(R1, R0, Acc)\n" + io:format(Fd, " [CP|R1] when ~w =< CP,CP =< ~w-> gc_extend2(cp(R1),R1,[CP,CP0]);~n",[RLess, RLarge]), + io:put_chars(Fd," R1 -> gc_extend(R1, R0, CP0)\n" " end.\n\n"), %% Special hangul @@ -685,16 +758,23 @@ gen_gc(Fd, GBP) -> GenHangulV_2 = fun(Range) -> io:format(Fd, "~8c~s gc_h_T(R1,[CP|Acc]);\n", [$\s,gen_case_clause(Range)]) end, [GenHangulV_2(CP) || CP <- merge_ranges(maps:get(t,GBP))], - io:put_chars(Fd, " R1 -> gc_extend(R1, R0, Acc)\n end.\n\n"), - + io:put_chars(Fd, + " R1 ->\n" + " case Acc of\n" + " [CP] -> gc_extend(R1, R0, CP);\n" + " _ -> gc_extend2(R1, R0, Acc)\n" + " end\n end.\n\n"), io:put_chars(Fd, "%% Handle Hangul T\n"), io:put_chars(Fd, "gc_h_T(R0, Acc) ->\n case cp(R0) of\n"), GenHangulT_1 = fun(Range) -> io:format(Fd, "~8c~s gc_h_T(R1,[CP|Acc]);\n", [$\s,gen_case_clause(Range)]) end, [GenHangulT_1(CP) || CP <- merge_ranges(maps:get(t,GBP))], - io:put_chars(Fd, " R1 -> gc_extend(R1, R0, Acc)\n end.\n\n"), - - io:put_chars(Fd, "gc_h_lv_lvt({error,_}=Error, Acc) -> gc_extend(Error, [], Acc);\n"), + io:put_chars(Fd, + " R1 ->\n" + " case Acc of\n" + " [CP] -> gc_extend(R1, R0, CP);\n" + " _ -> gc_extend2(R1, R0, Acc)\n" + " end\n end.\n\n"), io:put_chars(Fd, "%% Handle Hangul LV\n"), GenHangulLV = fun(Range) -> io:format(Fd, "gc_h_lv_lvt~s gc_h_V(R1,[CP|Acc]);\n", [gen_clause2(Range)]) end, @@ -703,8 +783,10 @@ gen_gc(Fd, GBP) -> GenHangulLVT = fun(Range) -> io:format(Fd, "gc_h_lv_lvt~s gc_h_T(R1,[CP|Acc]);\n", [gen_clause2(Range)]) end, [GenHangulLVT(CP) || CP <- merge_ranges(maps:get(lvt,GBP))], - io:put_chars(Fd, "gc_h_lv_lvt([CP|R], []) -> gc_extend(R, CP);\n"), %% From gc_1/1 - io:put_chars(Fd, "gc_h_lv_lvt(R, Acc) -> gc_extend(R, Acc).\n\n"), + io:put_chars(Fd, "gc_h_lv_lvt([CP|R], []) -> gc_extend(cp(R), R, CP);\n"), %% From gc_1/1 + io:put_chars(Fd, "%% Also handles error tuples\n"), + io:put_chars(Fd, "gc_h_lv_lvt(R, [CP]) -> gc_extend(R, R, CP);\n"), + io:put_chars(Fd, "gc_h_lv_lvt(R, Acc) -> gc_extend2(R, R, Acc).\n\n"), ok. gen_compose_pairs(Fd, ExclData, Data) -> diff --git a/make/otp_version_tickets_in_merge b/make/otp_version_tickets_in_merge index 77633c2ce2..e69de29bb2 100644 --- a/make/otp_version_tickets_in_merge +++ b/make/otp_version_tickets_in_merge @@ -1,79 +0,0 @@ -OTP-14702 -OTP-15229 -OTP-15298 -OTP-15369 -OTP-15375 -OTP-15398 -OTP-15423 -OTP-15442 -OTP-15445 -OTP-15447 -OTP-15460 -OTP-15479 -OTP-15484 -OTP-15490 -OTP-15493 -OTP-15494 -OTP-15498 -OTP-15502 -OTP-15503 -OTP-15508 -OTP-15514 -OTP-15518 -OTP-15519 -OTP-15527 -OTP-15529 -OTP-15539 -OTP-15540 -OTP-15541 -OTP-15542 -OTP-15545 -OTP-15552 -OTP-15553 -OTP-15555 -OTP-15556 -OTP-15557 -OTP-15558 -OTP-15561 -OTP-15562 -OTP-15567 -OTP-15569 -OTP-15570 -OTP-15572 -OTP-15576 -OTP-15577 -OTP-15578 -OTP-15580 -OTP-15583 -OTP-15584 -OTP-15586 -OTP-15587 -OTP-15592 -OTP-15599 -OTP-15600 -OTP-15601 -OTP-15602 -OTP-15604 -OTP-15605 -OTP-15619 -OTP-15624 -OTP-15625 -OTP-15629 -OTP-15630 -OTP-15634 -OTP-15637 -OTP-15639 -OTP-15642 -OTP-15647 -OTP-15650 -OTP-15654 -OTP-15657 -OTP-15659 -OTP-15660 -OTP-15662 -OTP-15663 -OTP-15665 -OTP-15666 -OTP-15667 -OTP-15669 -OTP-15670 diff --git a/otp_versions.table b/otp_versions.table index eef6a9c8fe..a31759a8ef 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-21.3.1 : erl_interface-3.11.1 ssl-9.2.1 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erts-10.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.19 : OTP-21.3 : common_test-1.17 compiler-7.3.2 crypto-4.4.1 dialyzer-3.3.2 diameter-2.2 edoc-0.10 erl_docgen-0.9 erl_interface-3.11 erts-10.3 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 kernel-6.3 mnesia-4.15.6 observer-2.9 odbc-2.12.3 public_key-1.6.5 runtime_tools-1.13.2 ssh-4.7.4 ssl-9.2 stdlib-3.8 syntax_tools-2.1.7 tools-3.1 wx-1.8.7 # asn1-5.0.8 debugger-4.2.6 eldap-1.2.6 et-1.6.4 eunit-2.3.7 jinterface-1.9.1 megaco-3.18.4 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 sasl-3.3 snmp-5.2.12 tftp-1.0.1 xmerl-1.3.19 : OTP-21.2.7 : erts-10.2.5 kernel-6.2.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.5 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 stdlib-3.7.1 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 : OTP-21.2.6 : erts-10.2.4 stdlib-3.7.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.5 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 : |