diff options
149 files changed, 5089 insertions, 2368 deletions
diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 3314ad6e0b..5cd4a762ed 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/erts/configure.in b/erts/configure.in index 765e32fcd4..eb3d975edc 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -621,7 +621,7 @@ case $chk_arch_ in powerpc) ARCH=ppc;; ppc) ARCH=ppc;; ppc64) ARCH=ppc64;; - ppc64le) ARCH=ppc64;; + ppc64le) ARCH=ppc64le;; "Power Macintosh") ARCH=ppc;; armv5b) ARCH=arm;; armv5teb) ARCH=arm;; diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 1c1fd89825..f93b386392 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -32,6 +32,37 @@ <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 8.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Trying to open a directory with file:read_file/1 on Unix + leaked a file descriptor. This bug has now been fixed.</p> + <p> + Own Id: OTP-14308 Aux Id: ERL-383 </p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Invoking <c>init:stop/0</c> via the SIGTERM signal, in a + non-SMP BEAM, could cause BEAM to terminate with fatal + error. This has now been fixed and the BEAM will + terminate normally when SIGTERM is received.</p> + <p> + Own Id: OTP-14290</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 8.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 9a91fdce08..6010c17c17 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3044,10 +3044,12 @@ do { \ GetArg2(2, Op1, Op2); if (is_both_small(Op1, Op2)) { /* - * We could extract the tag from one argument, but a tag extraction - * could mean a shift. Therefore, play it safe here. + * TAG ^ TAG == 0. + * + * Therefore, we perform the XOR operation on the tagged values, + * and OR in the tag bits. */ - Eterm result = make_small(signed_val(Op1) ^ signed_val(Op2)); + Eterm result = (Op1 ^ Op2) | make_small(0); StoreBifResult(4, result); } DO_OUTLINED_ARITH_2(bxor, Op1, Op2); diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 6f50297fc5..4140938210 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -361,6 +361,7 @@ bif ets:select_reverse/1 bif ets:select_reverse/2 bif ets:select_reverse/3 bif ets:select_delete/2 +bif ets:select_replace/2 bif ets:match_spec_compile/1 bif ets:match_spec_run_r/3 diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 2f188b5391..378328856d 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -362,6 +362,7 @@ static SWord free_table_continue(Process *p, DbTable *tb, SWord reds); static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb); static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1); static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1); +static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1); static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1); static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1); static Eterm table_info(Process* p, DbTable* tb, Eterm What); @@ -376,6 +377,7 @@ static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3); */ Export ets_select_delete_continue_exp; Export ets_select_count_continue_exp; +Export ets_select_replace_continue_exp; Export ets_select_continue_exp; /* @@ -2922,6 +2924,103 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2) return result; } +/* + ** This is for trapping, cannot be called directly. + */ +static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1) +{ + Process *p = BIF_P; + Eterm a1 = BIF_ARG_1; + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + Eterm *tptr; + db_lock_kind_t kind = LCK_WRITE_REC; + + CHECK_TABLES(); + ASSERT(is_tuple(a1)); + tptr = tuple_val(a1); + ASSERT(arityval(*tptr) >= 1); + + if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) { + BIF_ERROR(p,BADARG); + } + + cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret); + + if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { + unfix_table_locked(p, tb, &kind); + } + + db_unlock(tb, kind); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + default: + ERTS_BIF_PREP_ERROR(result, p, BADARG); + break; + } + erts_match_set_release_result(p); + + return result; +} + + +BIF_RETTYPE ets_select_replace_2(BIF_ALIST_2) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + enum DbIterSafety safety; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + if (tb->common.status & DB_BAG) { + /* Bag implementation presented both semantic consistency + and performance issues */ + db_unlock(tb, LCK_WRITE_REC); + BIF_ERROR(BIF_P, BADARG); + } + + safety = ITERATION_SAFETY(BIF_P,tb); + 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); + + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P,tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_WRITE_REC); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + + erts_match_set_release_result(BIF_P); + + return result; +} + BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) { @@ -3335,6 +3434,11 @@ void init_db(ErtsDbSpinCount db_spin_count) &ets_select_count_1); /* Non visual BIF to trap to. */ + erts_init_trap_export(&ets_select_replace_continue_exp, + am_ets, am_atom_put("replace_trap",11), 1, + &ets_select_replace_1); + + /* Non visual BIF to trap to. */ erts_init_trap_export(&ets_select_continue_exp, am_ets, am_atom_put("select_trap",11), 1, &ets_select_trap_1); diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index cbf4b9e007..4ff9f224e8 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -122,6 +122,7 @@ extern int erts_ets_realloc_always_moves; /* set in erl_init */ extern int erts_ets_always_compress; /* set in erl_init */ extern Export ets_select_delete_continue_exp; extern Export ets_select_count_continue_exp; +extern Export ets_select_replace_continue_exp; extern Export ets_select_continue_exp; extern erts_smp_atomic_t erts_ets_misc_mem_size; diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 18405342da..7ab27df00c 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -288,6 +288,9 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, #endif } +#ifndef MIN +#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) +#endif /* * Some special binary flags @@ -352,7 +355,8 @@ static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb, erts_smp_atomic_set_nob(&tb->segtab, (erts_aint_t) segtab); } - +/* Used by select_replace on analyze_pattern */ +typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Eterm body); /* ** Forward decl's (static functions) @@ -368,8 +372,9 @@ static void shrink(DbTableHash* tb, int nitems); static void grow(DbTableHash* tb, int nitems); static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, Uint sz, DbTableHash*); -static int analyze_pattern(DbTableHash *tb, Eterm pattern, - struct mp_info *mpi); +static int analyze_pattern(DbTableHash *tb, Eterm pattern, + extra_match_validator_t extra_validator, /* Optional callback */ + struct mp_info *mpi); /* * Method interface functions @@ -398,19 +403,24 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, int reverse, Eterm *ret); static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, int reverse, Eterm *ret); -static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); -static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Eterm *ret); - -static int db_select_continue_hash(Process *p, DbTable *tbl, +static int db_select_continue_hash(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret); +static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret); static int db_select_count_continue_hash(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret); +static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret); static int db_select_delete_continue_hash(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret); + +static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret); +static int db_select_replace_continue_hash(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); + static int db_take_hash(Process *, DbTable *, Eterm, Eterm *); static void db_print_hash(fmtfn_t to, void *to_arg, @@ -523,6 +533,8 @@ DbTableMethod db_hash = db_select_delete_continue_hash, db_select_count_hash, db_select_count_continue_hash, + db_select_replace_hash, + db_select_replace_continue_hash, db_take_hash, db_delete_all_objects_hash, db_free_table_hash, @@ -1139,816 +1151,1104 @@ static BIF_RETTYPE bif_trap1(Export *bif, { BIF_TRAP1(bif, p, p1); } - + + /* - * Continue collecting select matches, this may happen either due to a trap - * or when the user calls ets:select/1 + * Match traversal callbacks */ -static int db_select_continue_hash(Process *p, - DbTable *tbl, - Eterm continuation, - Eterm *ret) -{ - DbTableHash *tb = &tbl->hash; - Sint slot_ix; - Sint save_slot_ix; - Sint chunk_size; - int all_objects; - Binary *mp; - int num_left = 1000; - HashDbTerm *current = 0; - Eterm match_list; - Eterm *hp; - Eterm match_res; - Sint got; - Eterm *tptr; - erts_smp_rwmtx_t* lck; -#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0); +/* Called when no match is possible. + * context_ptr: Pointer to context + * ret: Pointer to traversal function term return. + * + * Both the direct return value and 'ret' are used as the traversal function return values. + */ +typedef int (*mtraversal_on_nothing_can_match_t)(void* context_ptr, Eterm* ret); + +/* Called for each match result. + * context_ptr: Pointer to context + * slot_ix: Current slot index + * current_ptr_ptr: Triple pointer to either the bucket or the 'next' pointer in the previous element; + * can be (carefully) used to adjust iteration when deleting or replacing elements. + * match_res: The result of running the match program against the current term. + * + * Should return 1 for successful match, 0 otherwise. + */ +typedef int (*mtraversal_on_match_res_t)(void* context_ptr, 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. + * context_ptr: Pointer to context + * slot_ix: Current slot index + * got: How many elements have been matched so far + * iterations_left: Number of intended iterations (down from an initial max.) left in this traversal cycle + * mpp: Double pointer to the compiled match program + * ret: Pointer to traversal function term return. + * + * 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.) + */ +typedef int (*mtraversal_on_loop_ended_t)(void* context_ptr, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret); + +/* Called when it's time to trap + * context_ptr: Pointer to context + * slot_ix: Current slot index + * got: How many elements have been matched so far + * mpp: Double pointer to the compiled match program + * ret: Pointer to traversal function term return. + * + * 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.) + */ +typedef int (*mtraversal_on_trap_t)(void* context_ptr, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret); - /* Decode continuation. We know it's a tuple but not the arity or anything else */ +/* + * Begin hash table match traversal + */ +static int match_traverse(Process* p, DbTableHash* tb, + Eterm pattern, + extra_match_validator_t extra_match_validator, /* Optional */ + Sint chunk_size, /* If 0, no chunking */ + Sint iterations_left, /* Nr. of iterations left */ + Eterm** hpp, /* Heap */ + int lock_for_write, /* Set to 1 if we're going to delete or + modify existing terms */ + mtraversal_on_nothing_can_match_t on_nothing_can_match, + mtraversal_on_match_res_t on_match_res, + mtraversal_on_loop_ended_t on_loop_ended, + mtraversal_on_trap_t on_trap, + void* context_ptr, /* State for callbacks above */ + Eterm* ret) +{ + Sint slot_ix; /* Slot index */ + HashDbTerm** current_ptr; /* Refers to either the bucket pointer or + * the 'next' pointer in the previous term + */ + HashDbTerm* saved_current; /* Helper to avoid double skip on match */ + struct mp_info mpi; + unsigned current_list_pos = 0; /* Prefound buckets list index */ + Eterm match_res; + Sint got = 0; /* Matched terms counter */ + erts_smp_rwmtx_t* lck; /* Slot lock */ + int ret_value; +#ifdef ERTS_SMP + erts_smp_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue) + = (lock_for_write ? WLOCK_HASH : RLOCK_HASH); + void (*unlock_hash_function)(erts_smp_rwmtx_t*) + = (lock_for_write ? WUNLOCK_HASH : RUNLOCK_HASH); +#else + #define lock_hash_function(tb, hval) NULL + #define unlock_hash_function(lck) ((void)lck) +#endif + Sint (*next_slot_function)(DbTableHash*, Uint, erts_smp_rwmtx_t**) + = (lock_for_write ? next_slot_w : next_slot); - tptr = tuple_val(continuation); + if ((ret_value = analyze_pattern(tb, pattern, extra_match_validator, &mpi)) + != DB_ERROR_NONE) + { + *ret = NIL; + goto done; + } - if (arityval(*tptr) != 6) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - - if (!is_small(tptr[2]) || !is_small(tptr[3]) || - !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6])) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - if ((chunk_size = signed_val(tptr[3])) < 0) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - mp = erts_db_get_match_prog_binary(tptr[4]); - if (!mp) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); - all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS; - match_list = tptr[5]; - if ((got = signed_val(tptr[6])) < 0) - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + if (!mpi.something_can_match) { + /* Can't possibly match anything */ + ret_value = on_nothing_can_match(context_ptr, ret); + goto done; + } - slot_ix = signed_val(tptr[2]); - if (slot_ix < 0 /* EOT */ - || (chunk_size && got >= chunk_size)) { - goto done; /* Already got all or enough in the match_list */ + if (mpi.all_objects) { + mpi.mp->flags |= BIN_FLAG_ALL_OBJECTS; } - lck = RLOCK_HASH(tb,slot_ix); - if (slot_ix >= NACTIVE(tb)) { - RUNLOCK_HASH(lck); - RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + /* + * Look for initial slot / bucket + */ + if (!mpi.key_given) { + /* Run this code if pattern is variable or GETKEY(pattern) */ + /* is a variable */ + slot_ix = 0; + lck = lock_hash_function(tb,slot_ix); + for (;;) { + ASSERT(slot_ix < NACTIVE(tb)); + if (*(current_ptr = &BUCKET(tb,slot_ix)) != NULL) { + break; + } + slot_ix = next_slot_function(tb,slot_ix,&lck); + if (slot_ix == 0) { + ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret); + goto done; + } + } + } else { + /* We have at least one */ + slot_ix = mpi.lists[current_list_pos].ix; + lck = lock_hash_function(tb, slot_ix); + current_ptr = mpi.lists[current_list_pos].bucket; + ASSERT(*current_ptr == BUCKET(tb,slot_ix)); + ++current_list_pos; } - while ((current = BUCKET(tb,slot_ix)) == NULL) { - slot_ix = next_slot(tb, slot_ix, &lck); - if (slot_ix == 0) { - slot_ix = -1; /* EOT */ - goto done; - } - } + /* + * Execute traversal cycle + */ for(;;) { - if (current->hvalue != INVALID_HASH && - (match_res = db_match_dbterm(&tb->common, p, mp, all_objects, - ¤t->dbterm, &hp, 2), - is_value(match_res))) { + if (*current_ptr != NULL) { + if ((*current_ptr)->hvalue != INVALID_HASH) { + match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0, + &(*current_ptr)->dbterm, hpp, 2); + saved_current = *current_ptr; + if (on_match_res(context_ptr, slot_ix, ¤t_ptr, match_res)) { + ++got; + } + --iterations_left; + if (*current_ptr != saved_current) { + /* Don't advance to next, the callback did it already */ + continue; + } + } + current_ptr = &((*current_ptr)->next); + } + else if (mpi.key_given) { /* Key is bound */ + unlock_hash_function(lck); + if (current_list_pos == mpi.num_lists) { + ret_value = on_loop_ended(context_ptr, -1, got, iterations_left, &mpi.mp, ret); + goto done; + } else { + slot_ix = mpi.lists[current_list_pos].ix; + lck = lock_hash_function(tb, slot_ix); + current_ptr = mpi.lists[current_list_pos].bucket; + ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); + ++current_list_pos; + } + } + else { /* Key is variable */ + if ((slot_ix = next_slot_function(tb,slot_ix,&lck)) == 0) { + slot_ix = -1; + break; + } + if (chunk_size && got >= chunk_size) { + unlock_hash_function(lck); + break; + } + if (iterations_left <= 0 || MBUF(p)) { + /* + * We have either reached our limit, or just created some heap fragments. + * Since many heap fragments will make the GC slower, trap and GC now. + */ + unlock_hash_function(lck); + ret_value = on_trap(context_ptr, slot_ix, got, &mpi.mp, ret); + goto done; + } + current_ptr = &BUCKET(tb,slot_ix); + } + } - match_list = CONS(hp, match_res, match_list); - ++got; - } + ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret); - --num_left; - save_slot_ix = slot_ix; - if ((current = next(tb, (Uint*)&slot_ix, &lck, current)) == NULL) { - slot_ix = -1; /* EOT */ - break; - } - if (slot_ix != save_slot_ix) { - if (chunk_size && got >= chunk_size) { - RUNLOCK_HASH(lck); - break; - } - if (num_left <= 0 || MBUF(p)) { - /* - * We have either reached our limit, or just created some heap fragments. - * Since many heap fragments will make the GC slower, trap and GC now. - */ - RUNLOCK_HASH(lck); - goto trap; - } - } - } done: - BUMP_REDS(p, 1000 - num_left); - if (chunk_size) { - Eterm continuation; - Eterm rest = NIL; - Sint rest_size = 0; - - if (got > chunk_size) { /* Cannot write destructively here, - the list may have - been in user space */ - rest = NIL; - hp = HAlloc(p, (got - chunk_size) * 2); - while (got-- > chunk_size) { - rest = CONS(hp, CAR(list_val(match_list)), rest); - hp += 2; - match_list = CDR(list_val(match_list)); - ++rest_size; - } - } - if (rest != NIL || slot_ix >= 0) { - hp = HAlloc(p,3+7); - continuation = TUPLE6(hp, tptr[1], make_small(slot_ix), - tptr[3], tptr[4], rest, - make_small(rest_size)); - hp += 7; - RET_TO_BIF(TUPLE2(hp, match_list, continuation),DB_ERROR_NONE); - } else { - if (match_list != NIL) { - hp = HAlloc(p, 3); - RET_TO_BIF(TUPLE2(hp, match_list, am_EOT),DB_ERROR_NONE); - } else { - RET_TO_BIF(am_EOT, DB_ERROR_NONE); - } - } + /* We should only jump directly to this label if + * we've already called on_nothing_can_match / on_loop_ended / on_trap + */ + if (mpi.mp != NULL) { + erts_bin_free(mpi.mp); } - RET_TO_BIF(match_list,DB_ERROR_NONE); - -trap: - BUMP_ALL_REDS(p); - - hp = HAlloc(p,7); - continuation = TUPLE6(hp, tptr[1], make_small(slot_ix), tptr[3], - tptr[4], match_list, make_small(got)); - RET_TO_BIF(bif_trap1(&ets_select_continue_exp, p, - continuation), - DB_ERROR_NONE); - -#undef RET_TO_BIF - -} + if (mpi.lists != mpi.dlists) { + erts_free(ERTS_ALC_T_DB_SEL_LIST, + (void *) mpi.lists); + } + return ret_value; -static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, int reverse, - Eterm *ret) -{ - return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret); +#ifndef SMP +#undef lock_hash_function +#undef unlock_hash_function +#endif } -static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, - Eterm pattern, Sint chunk_size, - int reverse, /* not used */ - Eterm *ret) +/* + * Continue hash table match traversal + */ +static int match_traverse_continue(Process* p, DbTableHash* tb, + Sint chunk_size, /* If 0, no chunking */ + Sint iterations_left, /* Nr. of iterations left */ + Eterm** hpp, /* Heap */ + Sint slot_ix, /* Slot index to resume traversal from */ + Sint got, /* Matched terms counter */ + Binary** mpp, /* Existing match program */ + int lock_for_write, /* Set to 1 if we're going to delete or + modify existing terms */ + mtraversal_on_match_res_t on_match_res, + mtraversal_on_loop_ended_t on_loop_ended, + mtraversal_on_trap_t on_trap, + void* context_ptr, /* For callbacks */ + Eterm* ret) { - DbTableHash *tb = &tbl->hash; - struct mp_info mpi; - Sint slot_ix; - HashDbTerm *current = 0; - unsigned current_list_pos = 0; - Eterm match_list; + int all_objects = (*mpp)->flags & BIN_FLAG_ALL_OBJECTS; + HashDbTerm** current_ptr; /* Refers to either the bucket pointer or + * the 'next' pointer in the previous term + */ + HashDbTerm* saved_current; /* Helper to avoid double skip on match */ Eterm match_res; - Eterm *hp; - int num_left = 1000; - Uint got = 0; - Eterm continuation; - int errcode; - Eterm mpb; erts_smp_rwmtx_t* lck; + int ret_value; +#ifdef ERTS_SMP + erts_smp_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue) + = (lock_for_write ? WLOCK_HASH : RLOCK_HASH); + void (*unlock_hash_function)(erts_smp_rwmtx_t*) + = (lock_for_write ? WUNLOCK_HASH : RUNLOCK_HASH); +#else + #define lock_hash_function(tb, hval) NULL + #define unlock_hash_function(lck) ((void)lck) +#endif + Sint (*next_slot_function)(DbTableHash* tb, Uint ix, erts_smp_rwmtx_t** lck_ptr) + = (lock_for_write ? next_slot_w : next_slot); - -#define RET_TO_BIF(Term,RetVal) do { \ - if (mpi.mp != NULL) { \ - erts_bin_free(mpi.mp); \ - } \ - if (mpi.lists != mpi.dlists) { \ - erts_free(ERTS_ALC_T_DB_SEL_LIST, \ - (void *) mpi.lists); \ - } \ - *ret = (Term); \ - return RetVal; \ - } while(0) - - - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { - RET_TO_BIF(NIL,errcode); + if (got < 0) { + *ret = NIL; + return DB_ERROR_BADPARAM; } - if (!mpi.something_can_match) { - if (chunk_size) { - RET_TO_BIF(am_EOT, DB_ERROR_NONE); /* We're done */ - } - RET_TO_BIF(NIL, DB_ERROR_NONE); - /* can't possibly match anything */ + if (slot_ix < 0 /* EOT */ + || (chunk_size && got >= chunk_size)) + { + /* Already got all or enough in the match_list */ + ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret); + goto done; } - if (!mpi.key_given) { - /* Run this code if pattern is variable or GETKEY(pattern) */ - /* is a variable */ - slot_ix = 0; - lck = RLOCK_HASH(tb,slot_ix); - for (;;) { - ASSERT(slot_ix < NACTIVE(tb)); - if ((current = BUCKET(tb,slot_ix)) != NULL) { - break; - } - slot_ix = next_slot(tb,slot_ix,&lck); - if (slot_ix == 0) { - if (chunk_size) { - RET_TO_BIF(am_EOT, DB_ERROR_NONE); /* We're done */ - } - RET_TO_BIF(NIL,DB_ERROR_NONE); - } - } - } else { - /* We have at least one */ - slot_ix = mpi.lists[current_list_pos].ix; - lck = RLOCK_HASH(tb, slot_ix); - current = *(mpi.lists[current_list_pos].bucket); - ASSERT(current == BUCKET(tb,slot_ix)); - ++current_list_pos; + lck = lock_hash_function(tb, slot_ix); + if (slot_ix >= NACTIVE(tb)) { /* Is this possible? */ + unlock_hash_function(lck); + *ret = NIL; + ret_value = DB_ERROR_BADPARAM; + goto done; } - match_list = NIL; - + /* + * Resume traversal cycle from where we left + */ + current_ptr = &BUCKET(tb,slot_ix); for(;;) { - if (current != NULL) { - if (current->hvalue != INVALID_HASH) { - match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0, - ¤t->dbterm, &hp, 2); - if (is_value(match_res)) { - match_list = CONS(hp, match_res, match_list); - ++got; - } - --num_left; - } - current = current->next; - } - else if (mpi.key_given) { /* Key is bound */ - RUNLOCK_HASH(lck); - if (current_list_pos == mpi.num_lists) { - slot_ix = -1; /* EOT */ - goto done; - } else { - slot_ix = mpi.lists[current_list_pos].ix; - lck = RLOCK_HASH(tb, slot_ix); - current = *(mpi.lists[current_list_pos].bucket); - ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); - ++current_list_pos; - } - } - else { /* Key is variable */ - - if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) { - slot_ix = -1; - break; - } - if (chunk_size && got >= chunk_size) { - RUNLOCK_HASH(lck); - break; - } - if (num_left <= 0 || MBUF(p)) { - /* - * We have either reached our limit, or just created some heap fragments. - * Since many heap fragments will make the GC slower, trap and GC now. - */ - RUNLOCK_HASH(lck); - goto trap; - } - current = BUCKET(tb,slot_ix); + if (*current_ptr != NULL) { + if ((*current_ptr)->hvalue != INVALID_HASH) { + match_res = db_match_dbterm(&tb->common, p, *mpp, all_objects, + &(*current_ptr)->dbterm, hpp, 2); + saved_current = *current_ptr; + if (on_match_res(context_ptr, slot_ix, ¤t_ptr, match_res)) { + ++got; + } + --iterations_left; + if (*current_ptr != saved_current) { + /* Don't advance to next, the callback did it already */ + continue; + } + } + current_ptr = &((*current_ptr)->next); + } + else { + if ((slot_ix=next_slot_function(tb,slot_ix,&lck)) == 0) { + slot_ix = -1; + break; + } + if (chunk_size && got >= chunk_size) { + unlock_hash_function(lck); + break; + } + if (iterations_left <= 0 || MBUF(p)) { + /* + * We have either reached our limit, or just created some heap fragments. + * Since many heap fragments will make the GC slower, trap and GC now. + */ + unlock_hash_function(lck); + ret_value = on_trap(context_ptr, slot_ix, got, mpp, ret); + goto done; + } + current_ptr = &BUCKET(tb,slot_ix); } } -done: - BUMP_REDS(p, 1000 - num_left); - if (chunk_size) { - Eterm continuation; - Eterm rest = NIL; - Sint rest_size = 0; - - if (mpi.all_objects) - (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - if (got > chunk_size) { /* Split list in return value and 'rest' */ - Eterm tmp = match_list; - rest = match_list; - while (got-- > chunk_size + 1) { - tmp = CDR(list_val(tmp)); - ++rest_size; - } - ++rest_size; - match_list = CDR(list_val(tmp)); - CDR(list_val(tmp)) = NIL; /* Destructive, the list has never - been in 'user space' */ - } - if (rest != NIL || slot_ix >= 0) { /* Need more calls */ - hp = HAlloc(p,3+7+ERTS_MAGIC_REF_THING_SIZE); - mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp); - if (mpi.all_objects) - (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - continuation = TUPLE6(hp, tid, make_small(slot_ix), - make_small(chunk_size), - mpb, rest, - make_small(rest_size)); - mpi.mp = NULL; /*otherwise the return macro will destroy it */ - hp += 7; - RET_TO_BIF(TUPLE2(hp, match_list, continuation),DB_ERROR_NONE); - } else { /* All data is exhausted */ - if (match_list != NIL) { /* No more data to search but still a - result to return to the caller */ - hp = HAlloc(p, 3); - RET_TO_BIF(TUPLE2(hp, match_list, am_EOT),DB_ERROR_NONE); - } else { /* Reached the end of the ttable with no data to return */ - RET_TO_BIF(am_EOT, DB_ERROR_NONE); - } - } - } - RET_TO_BIF(match_list,DB_ERROR_NONE); -trap: - BUMP_ALL_REDS(p); - if (mpi.all_objects) - (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; - hp = HAlloc(p,7+ERTS_MAGIC_REF_THING_SIZE); - mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp); - continuation = TUPLE6(hp, tid, make_small(slot_ix), - make_small(chunk_size), - mpb, match_list, - make_small(got)); - mpi.mp = NULL; /*otherwise the return macro will destroy it */ - RET_TO_BIF(bif_trap1(&ets_select_continue_exp, p, - continuation), - DB_ERROR_NONE); -#undef RET_TO_BIF + ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret); + +done: + /* We should only jump directly to this label if + * we've already called on_loop_ended / on_trap + */ + return ret_value; +#ifndef SMP +#undef lock_hash_function +#undef unlock_hash_function +#endif } -static int db_select_count_hash(Process *p, - DbTable *tbl, - Eterm tid, - Eterm pattern, - Eterm *ret) + +/* + * Common traversal trapping/continuation code; + * used by select_count, select_delete and select_replace, + * as well as their continuation-handling counterparts. + */ + +static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function, + Process* p, + DbTableHash* tb, + Eterm tid, + Eterm* prev_continuation_tptr, + Sint slot_ix, + Sint got, + Binary** mpp, + Eterm* ret) { - DbTableHash *tb = &tbl->hash; - struct mp_info mpi; - Uint slot_ix = 0; - HashDbTerm* current = NULL; - unsigned current_list_pos = 0; - Eterm *hp; - int num_left = 1000; - Uint got = 0; - Eterm continuation; - int errcode; + Eterm* hp; Eterm egot; Eterm mpb; - erts_smp_rwmtx_t* lck; - -#define RET_TO_BIF(Term,RetVal) do { \ - if (mpi.mp != NULL) { \ - erts_bin_free(mpi.mp); \ - } \ - if (mpi.lists != mpi.dlists) { \ - erts_free(ERTS_ALC_T_DB_SEL_LIST, \ - (void *) mpi.lists); \ - } \ - *ret = (Term); \ - return RetVal; \ - } while(0) - - - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { - RET_TO_BIF(NIL,errcode); - } - - if (!mpi.something_can_match) { - RET_TO_BIF(make_small(0), DB_ERROR_NONE); - /* can't possibly match anything */ - } - - if (!mpi.key_given) { - /* Run this code if pattern is variable or GETKEY(pattern) */ - /* is a variable */ - slot_ix = 0; - lck = RLOCK_HASH(tb,slot_ix); - current = BUCKET(tb,slot_ix); - } else { - /* We have at least one */ - slot_ix = mpi.lists[current_list_pos].ix; - lck = RLOCK_HASH(tb, slot_ix); - current = *(mpi.lists[current_list_pos].bucket); - ASSERT(current == BUCKET(tb,slot_ix)); - ++current_list_pos; - } + Eterm continuation; + int is_first_trap = (prev_continuation_tptr == NULL); + size_t base_halloc_sz = (is_first_trap ? ERTS_MAGIC_REF_THING_SIZE : 0); - for(;;) { - if (current != NULL) { - if (current->hvalue != INVALID_HASH) { - if (db_match_dbterm(&tb->common, p, mpi.mp, 0, - ¤t->dbterm, NULL,0) == am_true) { - ++got; - } - --num_left; - } - current = current->next; - } - else { /* next bucket */ - if (mpi.key_given) { /* Key is bound */ - RUNLOCK_HASH(lck); - if (current_list_pos == mpi.num_lists) { - goto done; - } else { - slot_ix = mpi.lists[current_list_pos].ix; - lck = RLOCK_HASH(tb, slot_ix); - current = *(mpi.lists[current_list_pos].bucket); - ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); - ++current_list_pos; - } - } - else { - if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) { - goto done; - } - if (num_left <= 0) { - RUNLOCK_HASH(lck); - goto trap; - } - current = BUCKET(tb,slot_ix); - } - } - } -done: - BUMP_REDS(p, 1000 - num_left); - RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); -trap: BUMP_ALL_REDS(p); if (IS_USMALL(0, got)) { - hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 5); + hp = HAlloc(p, base_halloc_sz + 5); egot = make_small(got); } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + ERTS_MAGIC_REF_THING_SIZE + 5); + hp = HAlloc(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } - mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); - continuation = TUPLE4(hp, tid, make_small(slot_ix), - mpb, - egot); - mpi.mp = NULL; /*otherwise the return macro will destroy it */ - RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p, - continuation), - DB_ERROR_NONE); -#undef RET_TO_BIF + if (is_first_trap) { + mpb = erts_db_make_match_prog_ref(p, *mpp, &hp); + *mpp = NULL; /* otherwise the caller will destroy it */ + } + else { + mpb = prev_continuation_tptr[3]; + } + + continuation = TUPLE4( + hp, + tid, + make_small(slot_ix), + mpb, + egot); + *ret = bif_trap1(trap_function, p, continuation); + return DB_ERROR_NONE; } -static int db_select_delete_hash(Process *p, - DbTable *tbl, - Eterm tid, - Eterm pattern, - Eterm *ret) +static ERTS_INLINE int unpack_simple_mtraversal_continuation(Eterm continuation, + Eterm** tptr_ptr, + Eterm* tid_ptr, + Sint* slot_ix_p, + Binary** mpp, + Sint* got_p) { - DbTableHash *tb = &tbl->hash; - struct mp_info mpi; - Uint slot_ix = 0; - HashDbTerm **current = NULL; - unsigned current_list_pos = 0; - Eterm *hp; - int num_left = 1000; - Uint got = 0; - Eterm continuation; - int errcode; - Uint last_pseudo_delete = (Uint)-1; - Eterm mpb; - Eterm egot; -#ifdef ERTS_SMP - erts_aint_t fixated_by_me = tb->common.is_thread_safe ? 0 : 1; /* ToDo: something nicer */ -#else - erts_aint_t fixated_by_me = 0; -#endif - erts_smp_rwmtx_t* lck; - -#define RET_TO_BIF(Term,RetVal) do { \ - if (mpi.mp != NULL) { \ - erts_bin_free(mpi.mp); \ - } \ - if (mpi.lists != mpi.dlists) { \ - erts_free(ERTS_ALC_T_DB_SEL_LIST, \ - (void *) mpi.lists); \ - } \ - *ret = (Term); \ - return RetVal; \ - } while(0) - + Eterm* tptr; + ASSERT(is_tuple(continuation)); + tptr = tuple_val(continuation); + if (arityval(*tptr) != 4) + return 1; - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { - RET_TO_BIF(NIL,errcode); + if (! is_small(tptr[2]) || !(is_big(tptr[4]) || is_small(tptr[4]))) { + return 1; } - if (!mpi.something_can_match) { - RET_TO_BIF(make_small(0), DB_ERROR_NONE); - /* can't possibly match anything */ + *tptr_ptr = tptr; + *tid_ptr = tptr[1]; + *slot_ix_p = unsigned_val(tptr[2]); + *mpp = erts_db_get_match_prog_binary_unchecked(tptr[3]); + if (is_big(tptr[4])) { + *got_p = big_to_uint32(tptr[4]); + } + else { + *got_p = unsigned_val(tptr[4]); } + return 0; +} - if (!mpi.key_given) { - /* Run this code if pattern is variable or GETKEY(pattern) */ - /* is a variable */ - lck = WLOCK_HASH(tb,slot_ix); - current = &BUCKET(tb,slot_ix); - } else { - /* We have at least one */ - slot_ix = mpi.lists[current_list_pos].ix; - lck = WLOCK_HASH(tb, slot_ix); - current = mpi.lists[current_list_pos++].bucket; - ASSERT(*current == BUCKET(tb,slot_ix)); + +/* + * + * select / select_chunk match traversal + * + */ + +#define MAX_SELECT_CHUNK_ITERATIONS 1000 + +typedef struct { + Process* p; + DbTableHash* tb; + Eterm tid; + Eterm* hp; + Sint chunk_size; + Eterm match_list; + Eterm* prev_continuation_tptr; +} mtraversal_select_chunk_context_t; + +static int mtraversal_select_chunk_on_nothing_can_match(void* context_ptr, Eterm* ret) { + mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL); + return DB_ERROR_NONE; +} + +static int mtraversal_select_chunk_on_match_res(void* context_ptr, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) +{ + mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + if (is_value(match_res)) { + sc_context_ptr->match_list = CONS(sc_context_ptr->hp, match_res, sc_context_ptr->match_list); + return 1; } + return 0; +} +static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret) +{ + mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + Eterm mpb; - for(;;) { - if ((*current) == NULL) { - if (mpi.key_given) { /* Key is bound */ - WUNLOCK_HASH(lck); - if (current_list_pos == mpi.num_lists) { - goto done; - } else { - slot_ix = mpi.lists[current_list_pos].ix; - lck = WLOCK_HASH(tb, slot_ix); - current = mpi.lists[current_list_pos].bucket; - ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); - ++current_list_pos; - } - } else { - if ((slot_ix=next_slot_w(tb,slot_ix,&lck)) == 0) { - goto done; - } - if (num_left <= 0) { - WUNLOCK_HASH(lck); - goto trap; - } - current = &BUCKET(tb,slot_ix); - } - } - else if ((*current)->hvalue == INVALID_HASH) { - current = &((*current)->next); - } - else { - int did_erase = 0; - if (db_match_dbterm(&tb->common, p, mpi.mp, 0, - &(*current)->dbterm, NULL, 0) == am_true) { - HashDbTerm *del; - if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ - if (slot_ix != last_pseudo_delete) { - if (!add_fixed_deletion(tb, slot_ix, fixated_by_me)) - goto do_erase; - last_pseudo_delete = slot_ix; - } - (*current)->hvalue = INVALID_HASH; - } else { - do_erase: - del = *current; - *current = (*current)->next; - free_term(tb, del); - did_erase = 1; - } - erts_smp_atomic_dec_nob(&tb->common.nitems); - ++got; - } - --num_left; - if (!did_erase) { - current = &((*current)->next); - } - } + if (iterations_left == MAX_SELECT_CHUNK_ITERATIONS) { + /* We didn't get to iterate a single time, which means EOT */ + ASSERT(sc_context_ptr->match_list == NIL); + *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL); + return DB_ERROR_NONE; } -done: - BUMP_REDS(p, 1000 - num_left); - if (got) { - try_shrink(tb); + else { + ASSERT(iterations_left < MAX_SELECT_CHUNK_ITERATIONS); + BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); + if (sc_context_ptr->chunk_size) { + Eterm continuation; + Eterm rest = NIL; + Sint rest_size = 0; + + if (got > sc_context_ptr->chunk_size) { /* Split list in return value and 'rest' */ + Eterm tmp = sc_context_ptr->match_list; + rest = sc_context_ptr->match_list; + while (got-- > sc_context_ptr->chunk_size + 1) { + tmp = CDR(list_val(tmp)); + ++rest_size; + } + ++rest_size; + sc_context_ptr->match_list = CDR(list_val(tmp)); + CDR(list_val(tmp)) = NIL; /* Destructive, the list has never + been in 'user space' */ + } + if (rest != NIL || slot_ix >= 0) { /* Need more calls */ + sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3 + 7 + ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &sc_context_ptr->hp); + continuation = TUPLE6( + sc_context_ptr->hp, + sc_context_ptr->tid, + make_small(slot_ix), + make_small(sc_context_ptr->chunk_size), + mpb, rest, + make_small(rest_size)); + *mpp = NULL; /* Otherwise the caller will destroy it */ + sc_context_ptr->hp += 7; + *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, continuation); + return DB_ERROR_NONE; + } else { /* All data is exhausted */ + if (sc_context_ptr->match_list != NIL) { /* No more data to search but still a + result to return to the caller */ + sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3); + *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, am_EOT); + return DB_ERROR_NONE; + } else { /* Reached the end of the ttable with no data to return */ + *ret = am_EOT; + return DB_ERROR_NONE; + } + } + } + *ret = sc_context_ptr->match_list; + return DB_ERROR_NONE; } - RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); -trap: - BUMP_ALL_REDS(p); - if (IS_USMALL(0, got)) { - hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 5); - egot = make_small(got); +} + +static int mtraversal_select_chunk_on_trap(void* context_ptr, Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) +{ + mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + Eterm mpb; + Eterm continuation; + Eterm* hp; + + BUMP_ALL_REDS(sc_context_ptr->p); + + if (sc_context_ptr->prev_continuation_tptr == NULL) { + /* First time we're trapping */ + hp = HAlloc(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &hp); + continuation = TUPLE6( + hp, + sc_context_ptr->tid, + make_small(slot_ix), + make_small(sc_context_ptr->chunk_size), + mpb, + sc_context_ptr->match_list, + make_small(got)); + *mpp = NULL; /* otherwise the caller will destroy it */ } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + ERTS_MAGIC_REF_THING_SIZE + 5); - egot = uint_to_big(got, hp); - hp += BIG_UINT_HEAP_SIZE; - } - mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); - continuation = TUPLE4(hp, tid, make_small(slot_ix), - mpb, - egot); - mpi.mp = NULL; /*otherwise the return macro will destroy it */ - RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p, - continuation), - DB_ERROR_NONE); + /* Not the first time we're trapping; reuse continuation terms */ + hp = HAlloc(sc_context_ptr->p, 7); + continuation = TUPLE6( + hp, + sc_context_ptr->prev_continuation_tptr[1], + make_small(slot_ix), + sc_context_ptr->prev_continuation_tptr[3], + sc_context_ptr->prev_continuation_tptr[4], + sc_context_ptr->match_list, + make_small(got)); + } + *ret = bif_trap1(&ets_select_continue_exp, sc_context_ptr->p, continuation); + return DB_ERROR_NONE; +} -#undef RET_TO_BIF +static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, int reverse, Eterm *ret) { + return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret); +} +static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, + int reverse, Eterm *ret) +{ + mtraversal_select_chunk_context_t sc_context; + sc_context.p = p; + sc_context.tb = &tbl->hash; + sc_context.tid = tid; + sc_context.hp = NULL; + sc_context.chunk_size = chunk_size; + sc_context.match_list = NIL; + sc_context.prev_continuation_tptr = NULL; + + return match_traverse( + sc_context.p, sc_context.tb, + pattern, NULL, + sc_context.chunk_size, + MAX_SELECT_CHUNK_ITERATIONS, + &sc_context.hp, 0, + mtraversal_select_chunk_on_nothing_can_match, + mtraversal_select_chunk_on_match_res, + mtraversal_select_chunk_on_loop_ended, + mtraversal_select_chunk_on_trap, + &sc_context, ret); } + /* -** This is called when select_delete traps -*/ -static int db_select_delete_continue_hash(Process *p, - DbTable *tbl, - Eterm continuation, - Eterm *ret) + * + * select_continue match traversal + * + */ + +static int mtraversal_select_chunk_continue_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret) { - DbTableHash *tb = &tbl->hash; - Uint slot_ix; - Uint last_pseudo_delete = (Uint)-1; - HashDbTerm **current = NULL; - Eterm *hp; - int num_left = 1000; - Uint got; - Eterm *tptr; - Binary *mp; - Eterm egot; - int fixated_by_me = ONLY_WRITER(p,tb) ? 0 : 1; /* ToDo: something nicer */ - erts_smp_rwmtx_t* lck; + mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + Eterm continuation; + Eterm rest = NIL; + Eterm* hp; + + ASSERT(iterations_left <= MAX_SELECT_CHUNK_ITERATIONS); + BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); + if (sc_context_ptr->chunk_size) { + Sint rest_size = 0; + if (got > sc_context_ptr->chunk_size) { + /* Cannot write destructively here, + the list may have + been in user space */ + hp = HAlloc(sc_context_ptr->p, (got - sc_context_ptr->chunk_size) * 2); + while (got-- > sc_context_ptr->chunk_size) { + rest = CONS(hp, CAR(list_val(sc_context_ptr->match_list)), rest); + hp += 2; + sc_context_ptr->match_list = CDR(list_val(sc_context_ptr->match_list)); + ++rest_size; + } + } + if (rest != NIL || slot_ix >= 0) { + hp = HAlloc(sc_context_ptr->p, 3 + 7); + continuation = TUPLE6( + hp, + sc_context_ptr->prev_continuation_tptr[1], + make_small(slot_ix), + sc_context_ptr->prev_continuation_tptr[3], + sc_context_ptr->prev_continuation_tptr[4], + rest, + make_small(rest_size)); + hp += 7; + *ret = TUPLE2(hp, sc_context_ptr->match_list, continuation); + return DB_ERROR_NONE; + } else { + if (sc_context_ptr->match_list != NIL) { + hp = HAlloc(sc_context_ptr->p, 3); + *ret = TUPLE2(hp, sc_context_ptr->match_list, am_EOT); + return DB_ERROR_NONE; + } else { + *ret = am_EOT; + return DB_ERROR_NONE; + } + } + } + *ret = sc_context_ptr->match_list; + return DB_ERROR_NONE; +} -#define RET_TO_BIF(Term,RetVal) do { \ - *ret = (Term); \ - return RetVal; \ - } while(0) +/* + * This is called when select traps + */ +static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { + mtraversal_select_chunk_context_t sc_context = {0}; + Eterm* tptr; + Eterm tid; + Binary* mp; + Sint got; + Sint slot_ix; + Sint chunk_size; + Eterm match_list; + Sint iterations_left = MAX_SELECT_CHUNK_ITERATIONS; - + /* Decode continuation. We know it's a tuple but not the arity or anything else */ + ASSERT(is_tuple(continuation)); tptr = tuple_val(continuation); - slot_ix = unsigned_val(tptr[2]); - mp = erts_db_get_match_prog_binary_unchecked(tptr[3]); - if (is_big(tptr[4])) { - got = big_to_uint32(tptr[4]); - } else { - got = unsigned_val(tptr[4]); - } - - lck = WLOCK_HASH(tb,slot_ix); - if (slot_ix >= NACTIVE(tb)) { - WUNLOCK_HASH(lck); - goto done; - } - current = &BUCKET(tb,slot_ix); - for(;;) { - if ((*current) == NULL) { - if ((slot_ix=next_slot_w(tb,slot_ix,&lck)) == 0) { - goto done; - } - if (num_left <= 0) { - WUNLOCK_HASH(lck); - goto trap; - } - current = &BUCKET(tb,slot_ix); - } - else if ((*current)->hvalue == INVALID_HASH) { - current = &((*current)->next); - } - else { - int did_erase = 0; - if (db_match_dbterm(&tb->common, p, mp, 0, - &(*current)->dbterm, NULL, 0) == am_true) { - HashDbTerm *del; - if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ - if (slot_ix != last_pseudo_delete) { - if (!add_fixed_deletion(tb, slot_ix, fixated_by_me)) - goto do_erase; - last_pseudo_delete = slot_ix; - } - (*current)->hvalue = INVALID_HASH; - } else { - do_erase: - del = *current; - *current = (*current)->next; - free_term(tb, del); - did_erase = 1; - } - erts_smp_atomic_dec_nob(&tb->common.nitems); - ++got; - } - - --num_left; - if (!did_erase) { - current = &((*current)->next); - } - } - } -done: - BUMP_REDS(p, 1000 - num_left); - if (got) { - try_shrink(tb); - } - RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); -trap: - BUMP_ALL_REDS(p); - if (IS_USMALL(0, got)) { - hp = HAlloc(p, 5); - egot = make_small(got); - } - else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + 5); - egot = uint_to_big(got, hp); - hp += BIG_UINT_HEAP_SIZE; - } - continuation = TUPLE4(hp, tptr[1], make_small(slot_ix), - tptr[3], - egot); - RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p, - continuation), - DB_ERROR_NONE); + if (arityval(*tptr) != 6) + goto badparam; + + if (!is_small(tptr[2]) || !is_small(tptr[3]) || + !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6])) + goto badparam; + if ((chunk_size = signed_val(tptr[3])) < 0) + goto badparam; + + mp = erts_db_get_match_prog_binary(tptr[4]); + if (mp == NULL) + goto badparam; -#undef RET_TO_BIF + if ((got = signed_val(tptr[6])) < 0) + goto badparam; + + tid = tptr[1]; + slot_ix = signed_val(tptr[2]); + match_list = tptr[5]; + /* Proceed */ + sc_context.p = p; + sc_context.tb = &tbl->hash; + sc_context.tid = tid; + sc_context.hp = NULL; + sc_context.chunk_size = chunk_size; + sc_context.match_list = match_list; + sc_context.prev_continuation_tptr = tptr; + + return match_traverse_continue( + sc_context.p, sc_context.tb, sc_context.chunk_size, + iterations_left, &sc_context.hp, slot_ix, got, &mp, 0, + mtraversal_select_chunk_on_match_res, /* Reuse callback */ + mtraversal_select_chunk_continue_on_loop_ended, + mtraversal_select_chunk_on_trap, /* Reuse callback */ + &sc_context, ret); + +badparam: + *ret = NIL; + return DB_ERROR_BADPARAM; } - + +#undef MAX_SELECT_CHUNK_ITERATIONS + + /* -** This is called when select_count traps -*/ -static int db_select_count_continue_hash(Process *p, - DbTable *tbl, - Eterm continuation, - Eterm *ret) + * + * select_count match traversal + * + */ + +#define MAX_SELECT_COUNT_ITERATIONS 1000 + +typedef struct { + Process* p; + DbTableHash* tb; + Eterm tid; + Eterm* hp; + Eterm* prev_continuation_tptr; +} mtraversal_select_count_context_t; + +static int mtraversal_select_count_on_nothing_can_match(void* context_ptr, Eterm* ret) { + *ret = make_small(0); + return DB_ERROR_NONE; +} + +static int mtraversal_select_count_on_match_res(void* context_ptr, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) { - DbTableHash *tb = &tbl->hash; - Uint slot_ix; - HashDbTerm* current; - Eterm *hp; - int num_left = 1000; - Uint got; - Eterm *tptr; - Binary *mp; - Eterm egot; - erts_smp_rwmtx_t* lck; + return (match_res == am_true); +} -#define RET_TO_BIF(Term,RetVal) do { \ - *ret = (Term); \ - return RetVal; \ - } while(0) +static int mtraversal_select_count_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret) +{ + mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr; + ASSERT(iterations_left <= MAX_SELECT_COUNT_ITERATIONS); + BUMP_REDS(scnt_context_ptr->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left); + *ret = erts_make_integer(got, scnt_context_ptr->p); + return DB_ERROR_NONE; +} - - tptr = tuple_val(continuation); - slot_ix = unsigned_val(tptr[2]); - mp = erts_db_get_match_prog_binary_unchecked(tptr[3]); - if (is_big(tptr[4])) { - got = big_to_uint32(tptr[4]); - } else { - got = unsigned_val(tptr[4]); - } - +static int mtraversal_select_count_on_trap(void* context_ptr, Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) +{ + mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr; + return on_mtraversal_simple_trap( + &ets_select_count_continue_exp, + scnt_context_ptr->p, + scnt_context_ptr->tb, + scnt_context_ptr->tid, + scnt_context_ptr->prev_continuation_tptr, + slot_ix, got, mpp, ret); +} - lck = RLOCK_HASH(tb, slot_ix); - if (slot_ix >= NACTIVE(tb)) { /* Is this posible? */ - RUNLOCK_HASH(lck); - goto done; - } - current = BUCKET(tb,slot_ix); - - for(;;) { - if (current != NULL) { - if (current->hvalue == INVALID_HASH) { - current = current->next; - continue; - } - if (db_match_dbterm(&tb->common, p, mp, 0, ¤t->dbterm, - NULL, 0) == am_true) { - ++got; - } - --num_left; - current = current->next; - } - else { /* next bucket */ - if ((slot_ix = next_slot(tb,slot_ix,&lck)) == 0) { - goto done; - } - if (num_left <= 0) { - RUNLOCK_HASH(lck); - goto trap; - } - current = BUCKET(tb,slot_ix); - } - } -done: - BUMP_REDS(p, 1000 - num_left); - RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); -trap: - BUMP_ALL_REDS(p); - if (IS_USMALL(0, got)) { - hp = HAlloc(p, 5); - egot = make_small(got); +static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { + mtraversal_select_count_context_t scnt_context = {0}; + Sint iterations_left = MAX_SELECT_COUNT_ITERATIONS; + Sint chunk_size = 0; + + scnt_context.p = p; + scnt_context.tb = &tbl->hash; + scnt_context.tid = tid; + scnt_context.hp = NULL; + scnt_context.prev_continuation_tptr = NULL; + + return match_traverse( + scnt_context.p, scnt_context.tb, + pattern, NULL, + chunk_size, iterations_left, NULL, 0, + mtraversal_select_count_on_nothing_can_match, + mtraversal_select_count_on_match_res, + mtraversal_select_count_on_loop_ended, + mtraversal_select_count_on_trap, + &scnt_context, ret); +} + +/* + * This is called when select_count traps + */ +static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { + mtraversal_select_count_context_t scnt_context = {0}; + Eterm* tptr; + Eterm tid; + Binary* mp; + Sint got; + Sint slot_ix; + Sint chunk_size = 0; + *ret = NIL; + + if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + *ret = NIL; + return DB_ERROR_BADPARAM; + } + + scnt_context.p = p; + scnt_context.tb = &tbl->hash; + scnt_context.tid = tid; + scnt_context.hp = NULL; + scnt_context.prev_continuation_tptr = tptr; + + return match_traverse_continue( + scnt_context.p, scnt_context.tb, chunk_size, + MAX_SELECT_COUNT_ITERATIONS, + NULL, slot_ix, got, &mp, 0, + mtraversal_select_count_on_match_res, /* Reuse callback */ + mtraversal_select_count_on_loop_ended, /* Reuse callback */ + mtraversal_select_count_on_trap, /* Reuse callback */ + &scnt_context, ret); +} + +#undef MAX_SELECT_COUNT_ITERATIONS + + +/* + * + * select_delete match traversal + * + */ + +#define MAX_SELECT_DELETE_ITERATIONS 1000 + +typedef struct { + Process* p; + DbTableHash* tb; + Eterm tid; + Eterm* hp; + Eterm* prev_continuation_tptr; + erts_aint_t fixated_by_me; + Uint last_pseudo_delete; +} mtraversal_select_delete_context_t; + +static int mtraversal_select_delete_on_nothing_can_match(void* context_ptr, Eterm* ret) { + *ret = make_small(0); + return DB_ERROR_NONE; +} + +static int mtraversal_select_delete_on_match_res(void* context_ptr, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) +{ + HashDbTerm** current_ptr = *current_ptr_ptr; + mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr; + HashDbTerm* del; + if (match_res != am_true) + return 0; + + if (NFIXED(sd_context_ptr->tb) > sd_context_ptr->fixated_by_me) { /* fixated by others? */ + if (slot_ix != sd_context_ptr->last_pseudo_delete) { + if (!add_fixed_deletion(sd_context_ptr->tb, slot_ix, sd_context_ptr->fixated_by_me)) + goto do_erase; + sd_context_ptr->last_pseudo_delete = slot_ix; + } + (*current_ptr)->hvalue = INVALID_HASH; } else { - hp = HAlloc(p, BIG_UINT_HEAP_SIZE + 5); - egot = uint_to_big(got, hp); - hp += BIG_UINT_HEAP_SIZE; + do_erase: + del = *current_ptr; + *current_ptr = (*current_ptr)->next; // replace pointer to term using next + free_term(sd_context_ptr->tb, del); } - continuation = TUPLE4(hp, tptr[1], make_small(slot_ix), - tptr[3], - egot); - RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p, - continuation), - DB_ERROR_NONE); + erts_smp_atomic_dec_nob(&sd_context_ptr->tb->common.nitems); -#undef RET_TO_BIF + return 1; +} +static int mtraversal_select_delete_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret) +{ + mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr; + ASSERT(iterations_left <= MAX_SELECT_DELETE_ITERATIONS); + BUMP_REDS(sd_context_ptr->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left); + if (got) { + try_shrink(sd_context_ptr->tb); + } + *ret = erts_make_integer(got, sd_context_ptr->p); + return DB_ERROR_NONE; } - + +static int mtraversal_select_delete_on_trap(void* context_ptr, Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) +{ + mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr; + return on_mtraversal_simple_trap( + &ets_select_delete_continue_exp, + sd_context_ptr->p, + sd_context_ptr->tb, + sd_context_ptr->tid, + sd_context_ptr->prev_continuation_tptr, + slot_ix, got, mpp, ret); +} + +static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { + mtraversal_select_delete_context_t sd_context = {0}; + Sint chunk_size = 0; + + sd_context.p = p; + sd_context.tb = &tbl->hash; + sd_context.tid = tid; + sd_context.hp = NULL; + sd_context.prev_continuation_tptr = NULL; +#ifdef ERTS_SMP + sd_context.fixated_by_me = sd_context.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */ +#else + sd_context.fixated_by_me = 0; +#endif + sd_context.last_pseudo_delete = (Uint) -1; + + return match_traverse( + sd_context.p, sd_context.tb, + pattern, NULL, + chunk_size, + MAX_SELECT_DELETE_ITERATIONS, NULL, 1, + mtraversal_select_delete_on_nothing_can_match, + mtraversal_select_delete_on_match_res, + mtraversal_select_delete_on_loop_ended, + mtraversal_select_delete_on_trap, + &sd_context, ret); +} + +/* + * This is called when select_delete traps + */ +static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { + mtraversal_select_delete_context_t sd_context = {0}; + Eterm* tptr; + Eterm tid; + Binary* mp; + Sint got; + Sint slot_ix; + Sint chunk_size = 0; + + if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + *ret = NIL; + return DB_ERROR_BADPARAM; + } + + sd_context.p = p; + sd_context.tb = &tbl->hash; + sd_context.tid = tid; + sd_context.hp = NULL; + sd_context.prev_continuation_tptr = tptr; + sd_context.fixated_by_me = ONLY_WRITER(p, sd_context.tb) ? 0 : 1; /* TODO: something nicer */ + sd_context.last_pseudo_delete = (Uint) -1; + + return match_traverse_continue( + sd_context.p, sd_context.tb, chunk_size, + MAX_SELECT_DELETE_ITERATIONS, + NULL, slot_ix, got, &mp, 1, + mtraversal_select_delete_on_match_res, /* Reuse callback */ + mtraversal_select_delete_on_loop_ended, /* Reuse callback */ + mtraversal_select_delete_on_trap, /* Reuse callback */ + &sd_context, ret); +} + +#undef MAX_SELECT_DELETE_ITERATIONS + + +/* + * + * select_replace match traversal + * + */ + +#define MAX_SELECT_REPLACE_ITERATIONS 1000 + +typedef struct { + Process* p; + DbTableHash* tb; + Eterm tid; + Eterm* hp; + Eterm* prev_continuation_tptr; +} mtraversal_select_replace_context_t; + +static int mtraversal_select_replace_on_nothing_can_match(void* context_ptr, Eterm* ret) { + *ret = make_small(0); + return DB_ERROR_NONE; +} + +static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) +{ + mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr; + DbTableHash* tb = sr_context_ptr->tb; + HashDbTerm* new; + HashDbTerm* next; + HashValue hval; + + if (is_value(match_res)) { +#ifdef DEBUG + Eterm key = db_getkey(tb->common.keypos, match_res); + ASSERT(is_value(key)); + ASSERT(eq(key, GETKEY(tb, (**current_ptr_ptr)->dbterm.tpl))); +#endif + next = (**current_ptr_ptr)->next; + hval = (**current_ptr_ptr)->hvalue; + new = new_dbterm(tb, match_res); + new->next = next; + new->hvalue = hval; + free_term(tb, **current_ptr_ptr); + **current_ptr_ptr = new; /* replace 'next' pointer in previous object */ + *current_ptr_ptr = &((**current_ptr_ptr)->next); /* advance to next object */ + return 1; + } + return 0; +} + +static int mtraversal_select_replace_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret) +{ + mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr; + ASSERT(iterations_left <= MAX_SELECT_REPLACE_ITERATIONS); + /* the more objects we've replaced, the more reductions we've consumed */ + BUMP_REDS(sr_context_ptr->p, + MIN(MAX_SELECT_REPLACE_ITERATIONS * 2, + (MAX_SELECT_REPLACE_ITERATIONS - iterations_left) + (int)got)); + *ret = erts_make_integer(got, sr_context_ptr->p); + return DB_ERROR_NONE; +} + +static int mtraversal_select_replace_on_trap(void* context_ptr, Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) +{ + mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr; + return on_mtraversal_simple_trap( + &ets_select_replace_continue_exp, + sr_context_ptr->p, + sr_context_ptr->tb, + sr_context_ptr->tid, + sr_context_ptr->prev_continuation_tptr, + slot_ix, got, mpp, ret); +} + +static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) +{ + mtraversal_select_replace_context_t sr_context = {0}; + Sint chunk_size = 0; + + /* Bag implementation presented both semantic consistency and performance issues, + * unsupported for now + */ + ASSERT(!(tbl->hash.common.status & DB_BAG)); + + sr_context.p = p; + sr_context.tb = &tbl->hash; + sr_context.tid = tid; + sr_context.hp = NULL; + sr_context.prev_continuation_tptr = NULL; + + return match_traverse( + sr_context.p, sr_context.tb, + pattern, db_match_keeps_key, + chunk_size, + MAX_SELECT_REPLACE_ITERATIONS, NULL, 1, + mtraversal_select_replace_on_nothing_can_match, + mtraversal_select_replace_on_match_res, + mtraversal_select_replace_on_loop_ended, + mtraversal_select_replace_on_trap, + &sr_context, ret); +} + +/* + * This is called when select_replace traps + */ +static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) +{ + mtraversal_select_replace_context_t sr_context = {0}; + Eterm* tptr; + Eterm tid ; + Binary* mp; + Sint got; + Sint slot_ix; + Sint chunk_size = 0; + *ret = NIL; + + if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + *ret = NIL; + return DB_ERROR_BADPARAM; + } + + /* Proceed */ + sr_context.p = p; + sr_context.tb = &tbl->hash; + sr_context.tid = tid; + sr_context.hp = NULL; + sr_context.prev_continuation_tptr = tptr; + + return match_traverse_continue( + sr_context.p, sr_context.tb, chunk_size, + MAX_SELECT_REPLACE_ITERATIONS, + NULL, slot_ix, got, &mp, 1, + mtraversal_select_replace_on_match_res, /* Reuse callback */ + mtraversal_select_replace_on_loop_ended, /* Reuse callback */ + mtraversal_select_replace_on_trap, /* Reuse callback */ + &sr_context, ret); +} + + static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) { DbTableHash *tb = &tbl->hash; @@ -1989,6 +2289,7 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) return DB_ERROR_NONE; } + /* ** Other interface routines (not directly coupled to one bif) */ @@ -2147,7 +2448,8 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds) ** slots should be searched. Also compiles the match program */ static int analyze_pattern(DbTableHash *tb, Eterm pattern, - struct mp_info *mpi) + extra_match_validator_t extra_validator, /* Optional callback */ + struct mp_info *mpi) { Eterm *ptpl; Eterm lst, tpl, ttpl; @@ -2185,7 +2487,10 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, i = 0; for(lst = pattern; is_list(lst); lst = CDR(list_val(lst))) { - Eterm body; + Eterm match; + Eterm guard; + Eterm body; + ttpl = CAR(list_val(lst)); if (!is_tuple(ttpl)) { if (buff != sbuff) { @@ -2200,9 +2505,17 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, } return DB_ERROR_BADPARAM; } - matches[i] = tpl = ptpl[1]; - guards[i] = ptpl[2]; + matches[i] = match = tpl = ptpl[1]; + guards[i] = guard = ptpl[2]; bodies[i] = body = ptpl[3]; + + if(extra_validator != NULL && !extra_validator(tb->common.keypos, match, guard, body)) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + if (!is_list(body) || CDR(list_val(body)) != NIL || CAR(list_val(body)) != am_DollarUnderscore) { mpi->all_objects = 0; diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 14a7451267..ab8da6ccf6 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -76,9 +76,18 @@ ((Dtt->pos) ? \ (Dtt)->array[(Dtt)->pos - 1] : NULL) -#define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL) +#define TOPN_NODE(Dtt, Pos) \ + (((Pos) < Dtt->pos) ? \ + (Dtt)->array[(Dtt)->pos - ((Pos) + 1)] : NULL) + +#define REPLACE_TOP_NODE(Dtt, Node) \ + if ((Dtt)->pos) (Dtt)->array[(Dtt)->pos - 1] = (Node) +#define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL) +#ifndef MIN +#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) +#endif /* Obtain table static stack if available. NULL if not. ** Must be released with release_stack() @@ -225,9 +234,9 @@ struct mp_info { Eterm most; /* The highest matching key (possibly * partially bound expression) */ - TreeDbTerm *save_term; /* If the key is completely bound, this - * will be the Tree node we're searching - * for, otherwise it will be useless */ + TreeDbTerm **save_term; /* If the key is completely bound, this + * will be the Tree node we're searching + * for, otherwise it will be useless */ Binary *mp; /* The compiled match program */ }; @@ -277,6 +286,24 @@ struct select_delete_context { }; /* + * Used by doit_select_replace + */ +struct select_replace_context { + Process *p; + DbTableTree *tb; + Binary *mp; + Eterm end_condition; + Eterm *lastobj; + Sint32 max; + int keypos; + int all_objects; + Sint replaced; +}; + +/* Used by select_replace on analyze_pattern */ +typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Eterm body); + +/* ** Forward declarations */ static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); @@ -290,6 +317,7 @@ static int delsub(TreeDbTerm **this); static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot); static TreeDbTerm *find_node(DbTableTree *tb, Eterm key); static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key); +static TreeDbTerm **find_ptr(DbTableTree *tb, DbTreeStack*, TreeDbTerm *this); static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*, @@ -311,14 +339,23 @@ static void traverse_forward(DbTableTree *tb, TreeDbTerm *, void *, int), - void *context); -static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, + void *context); +static void traverse_update_backwards(DbTableTree *tb, + DbTreeStack*, + Eterm lastkey, + int (*doit)(DbTableTree *tb, + TreeDbTerm **, // out + void *, + int), + void *context); +static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm ***ret, Eterm *partly_bound_key); static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key); static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done); static int analyze_pattern(DbTableTree *tb, Eterm pattern, - struct mp_info *mpi); + extra_match_validator_t extra_validator, /* Optional callback */ + struct mp_info *mpi); static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, @@ -335,6 +372,10 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, int forward); +static int doit_select_replace(DbTableTree *tb, + TreeDbTerm **this_ptr, + void *ptr, + int forward); static int partly_bound_can_match_lesser(Eterm partly_bound_1, Eterm partly_bound_2); @@ -383,6 +424,10 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret); static int db_select_delete_continue_tree(Process *p, DbTable *tbl, Eterm continuation, Eterm *ret); +static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret); +static int db_select_replace_continue_tree(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); static int db_take_tree(Process *, DbTable *, Eterm, Eterm *); static void db_print_tree(fmtfn_t to, void *to_arg, int show, DbTable *tbl); @@ -435,6 +480,8 @@ DbTableMethod db_tree = db_select_delete_continue_tree, db_select_count_tree, db_select_count_continue_tree, + db_select_replace_tree, + db_select_replace_continue_tree, db_take_tree, db_delete_all_objects_tree, db_free_table_tree, @@ -1089,7 +1136,7 @@ static int db_select_tree(Process *p, DbTable *tbl, Eterm tid, sc.got = 0; sc.chunk_size = 0; - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) { RET_TO_BIF(NIL,errcode); } @@ -1103,7 +1150,7 @@ static int db_select_tree(Process *p, DbTable *tbl, Eterm tid, if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { - doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */); + doit_select(tb,*(mpi.save_term),&sc,0 /* direction doesn't matter */); RET_TO_BIF(sc.accum,DB_ERROR_NONE); } @@ -1292,7 +1339,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid, sc.keypos = tb->common.keypos; sc.got = 0; - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) { RET_TO_BIF(NIL,errcode); } @@ -1306,7 +1353,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid, if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { - doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */); + doit_select_count(tb,*(mpi.save_term),&sc,0 /* dummy */); RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE); } @@ -1395,7 +1442,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, sc.got = 0; sc.chunk_size = chunk_size; - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) { RET_TO_BIF(NIL,errcode); } @@ -1409,7 +1456,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { - doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); + doit_select(tb,*(mpi.save_term),&sc, 0 /* direction doesn't matter */); if (sc.accum != NIL) { hp=HAlloc(p, 3); RET_TO_BIF(TUPLE2(hp,sc.accum,am_EOT),DB_ERROR_NONE); @@ -1637,7 +1684,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid, sc.keypos = tb->common.keypos; sc.tb = tb; - if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + if ((errcode = analyze_pattern(tb, pattern, NULL, &mpi)) != DB_ERROR_NONE) { RET_TO_BIF(0,errcode); } @@ -1650,7 +1697,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid, if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { - doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't + doit_select_delete(tb,*(mpi.save_term),&sc, 0 /* direction doesn't matter */); RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); } @@ -1702,6 +1749,208 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid, } +static int db_select_replace_continue_tree(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_replace_context sc; + unsigned sz; + Eterm *hp; + Eterm lastkey; + Eterm end_condition; + Binary *mp; + Eterm key; + Eterm *tptr; + Eterm ereplaced; + Sint prev_replaced; + + +#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0); + + /* Decode continuation. We know it's a tuple and everything else as + this is only called by ourselves */ + + /* continuation: + {Table, Lastkey, EndCondition, MatchProgBin, HowManyReplaced}*/ + + tptr = tuple_val(continuation); + + if (arityval(*tptr) != 5) + erts_exit(ERTS_ERROR_EXIT,"Internal error in ets:select_replace/1"); + + lastkey = tptr[2]; + end_condition = tptr[3]; + mp = erts_db_get_match_prog_binary_unchecked(tptr[4]); + + sc.p = p; + sc.mp = mp; + sc.end_condition = NIL; + sc.lastobj = NULL; + sc.max = 1000; + sc.keypos = tb->common.keypos; + if (is_big(tptr[5])) { + sc.replaced = big_to_uint32(tptr[5]); + } else { + sc.replaced = unsigned_val(tptr[5]); + } + prev_replaced = sc.replaced; + + stack = get_any_stack(tb); + traverse_update_backwards(tb, stack, lastkey, &doit_select_replace, &sc); + release_stack(tb,stack); + + // the more objects we've replaced, the more reductions we've consumed + BUMP_REDS(p, MIN(2000, (1000 - sc.max) + (sc.replaced - prev_replaced))); + + if (sc.max > 0) { + RET_TO_BIF(erts_make_integer(sc.replaced,p), DB_ERROR_NONE); + } + key = GETKEY(tb, sc.lastobj); + if (end_condition != NIL && + (cmp_partly_bound(end_condition,key) > 0)) { + /* done anyway */ + RET_TO_BIF(make_small(sc.replaced),DB_ERROR_NONE); + } + /* Not done yet, let's trap. */ + sz = size_object(key); + if (IS_USMALL(0, sc.replaced)) { + hp = HAlloc(p, sz + 6); + ereplaced = make_small(sc.replaced); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + 6); + ereplaced = uint_to_big(sc.replaced, hp); + hp += BIG_UINT_HEAP_SIZE; + } + key = copy_struct(key, sz, &hp, &MSO(p)); + continuation = TUPLE5 + (hp, + tptr[1], + key, + tptr[3], + tptr[4], + ereplaced); + RET_TO_BIF(bif_trap1(&ets_select_replace_continue_exp, p, continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF +} + +static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_replace_context sc; + struct mp_info mpi; + Eterm lastkey = THE_NON_VALUE; + Eterm key; + Eterm continuation; + unsigned sz; + Eterm *hp; + TreeDbTerm *this; + int errcode; + Eterm ereplaced; + Eterm mpb; + + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + mpi.mp = NULL; + + sc.lastobj = NULL; + sc.p = p; + sc.tb = tb; + sc.max = 1000; + sc.end_condition = NIL; + sc.keypos = tb->common.keypos; + sc.replaced = 0; + + if ((errcode = analyze_pattern(tb, pattern, db_match_keeps_key, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(make_small(0),DB_ERROR_NONE); + /* can't possibly match anything */ + } + + sc.mp = mpi.mp; + sc.all_objects = mpi.all_objects; + + stack = get_static_stack(tb); + if (!mpi.got_partial && mpi.some_limitation && + CMP_EQ(mpi.least,mpi.most)) { + TreeDbTerm* term = *(mpi.save_term); + doit_select_replace(tb,mpi.save_term,&sc,0 /* dummy */); + if (stack != NULL) { + if (TOP_NODE(stack) == term) + // throw away potentially invalid reference + REPLACE_TOP_NODE(stack, *(mpi.save_term)); + release_stack(tb, stack); + } + RET_TO_BIF(erts_make_integer(sc.replaced,p),DB_ERROR_NONE); + } + + if (stack == NULL) + stack = get_any_stack(tb); + + if (mpi.some_limitation) { + if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.least; + } + + traverse_update_backwards(tb, stack, lastkey, &doit_select_replace, &sc); + release_stack(tb,stack); + // the more objects we've replaced, the more reductions we've consumed + BUMP_REDS(p, MIN(2000, (1000 - sc.max) + sc.replaced)); + if (sc.max > 0) { + RET_TO_BIF(erts_make_integer(sc.replaced,p),DB_ERROR_NONE); + } + + key = GETKEY(tb, sc.lastobj); + sz = size_object(key); + if (IS_USMALL(0, sc.replaced)) { + hp = HAlloc(p, sz + ERTS_MAGIC_REF_THING_SIZE + 6); + ereplaced = make_small(sc.replaced); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + ERTS_MAGIC_REF_THING_SIZE + 6); + ereplaced = uint_to_big(sc.replaced, hp); + hp += BIG_UINT_HEAP_SIZE; + } + key = copy_struct(key, sz, &hp, &MSO(p)); + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); + + continuation = TUPLE5 + (hp, + tid, + key, + sc.end_condition, /* From the match program, needn't be copied */ + mpb, + ereplaced); + + /* Don't free mpi.mp, so don't use macro */ + *ret = bif_trap1(&ets_select_replace_continue_exp, p, continuation); + return DB_ERROR_NONE; + +#undef RET_TO_BIF + +} + static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) { DbTableTree *tb = &tbl->tree; @@ -1947,8 +2196,9 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb, ** For the select functions, analyzes the pattern and determines which ** part of the tree should be searched. Also compiles the match program */ -static int analyze_pattern(DbTableTree *tb, Eterm pattern, - struct mp_info *mpi) +static int analyze_pattern(DbTableTree *tb, Eterm pattern, + extra_match_validator_t extra_validator, /* Optional callback */ + struct mp_info *mpi) { Eterm lst, tpl, ttpl; Eterm *matches,*guards, *bodies; @@ -1986,7 +2236,10 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, i = 0; for(lst = pattern; is_list(lst); lst = CDR(list_val(lst))) { - Eterm body; + Eterm match; + Eterm guard; + Eterm body; + ttpl = CAR(list_val(lst)); if (!is_tuple(ttpl)) { if (buff != sbuff) { @@ -2001,9 +2254,17 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, } return DB_ERROR_BADPARAM; } - matches[i] = tpl = ptpl[1]; - guards[i] = ptpl[2]; + matches[i] = match = tpl = ptpl[1]; + guards[i] = guard = ptpl[2]; bodies[i] = body = ptpl[3]; + + if(extra_validator != NULL && !extra_validator(tb->common.keypos, match, guard, body)) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + if (!is_list(body) || CDR(list_val(body)) != NIL || CAR(list_val(body)) != am_DollarUnderscore) { mpi->all_objects = 0; @@ -2011,7 +2272,7 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, ++i; partly_bound = NIL; - res = key_given(tb, tpl, &mpi->save_term, &partly_bound); + res = key_given(tb, tpl, &(mpi->save_term), &partly_bound); if ( res >= 0 ) { /* Can match something */ key = 0; mpi->something_can_match = 1; @@ -2514,6 +2775,58 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) return this; } +/* + * Find node and return the address of the node pointer (NULL if not found) + * Tries to reuse the existing stack for performance. + */ + +static TreeDbTerm **find_ptr(DbTableTree *tb, DbTreeStack *stack, TreeDbTerm *this) { + Eterm key = GETKEY(tb, this->dbterm.tpl); + TreeDbTerm *tmp; + TreeDbTerm *parent; + Sint c; + + if(( tmp = TOP_NODE(stack)) != NULL) { + if (!cmp_key_eq(tb,key,tmp)) { + /* Start from the beginning */ + stack->pos = stack->slot = 0; + } + } + if (EMPTY_NODE(stack)) { /* Have to rebuild the stack */ + if (( tmp = tb->root ) == NULL) + return NULL; + for (;;) { + PUSH_NODE(stack, tmp); + if (( c = cmp_key(tb,key,tmp) ) < 0) { + if (tmp->left == NULL) /* We are at the next + and the element does + not exist */ + break; + else + tmp = tmp->left; + } else if (c > 0) { + if (tmp->right == NULL) /* Done */ + return NULL; + else + tmp = tmp->right; + } else + break; + } + } + + if (TOP_NODE(stack) != this) + return NULL; + + parent = TOPN_NODE(stack, 1); + if (parent == NULL) + return ((this != tb->root) ? NULL : &(tb->root)); + if (parent->left == this) + return &(parent->left); + if (parent->right == this) + return &(parent->right); + return NULL; +} + static int db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj, DbUpdateHandle* handle) @@ -2655,13 +2968,60 @@ static void traverse_forward(DbTableTree *tb, } /* + * Traverse the tree with an update callback function, used by db_select_replace + */ +static void traverse_update_backwards(DbTableTree *tb, + DbTreeStack* stack, + Eterm lastkey, + int (*doit)(DbTableTree*, + TreeDbTerm**, + void*, + int), + void* context) +{ + int res; + TreeDbTerm *this, *next, **this_ptr; + + if (lastkey == THE_NON_VALUE) { + stack->pos = stack->slot = 0; + if (( this = tb->root ) == NULL) { + return; + } + while (this != NULL) { + PUSH_NODE(stack, this); + this = this->right; + } + this = TOP_NODE(stack); + this_ptr = find_ptr(tb, stack, this); + ASSERT(this_ptr != NULL); + res = (*doit)(tb, this_ptr, context, 0); + REPLACE_TOP_NODE(stack, *this_ptr); + next = find_prev(tb, stack, GETKEY(tb, (*this_ptr)->dbterm.tpl)); + if (!res) + return; + } else { + next = find_prev(tb, stack, lastkey); + } + + while ((this = next) != NULL) { + this_ptr = find_ptr(tb, stack, this); + ASSERT(this_ptr != NULL); + res = (*doit)(tb, this_ptr, context, 0); + REPLACE_TOP_NODE(stack, *this_ptr); + next = find_prev(tb, stack, GETKEY(tb, (*this_ptr)->dbterm.tpl)); + if (!res) + return; + } +} + +/* * Returns 0 if not given 1 if given and -1 on no possible match * if key is given; *ret is set to point to the object concerned. */ -static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, +static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm ***ret, Eterm *partly_bound) { - TreeDbTerm *this; + TreeDbTerm **this; Eterm key; ASSERT(ret != NULL); @@ -2671,7 +3031,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, if (is_non_value(key)) return -1; /* can't possibly match anything */ if (!db_has_variable(key)) { /* Bound key */ - if (( this = find_node(tb, key) ) == NULL) { + if (( this = find_node2(tb, key) ) == NULL) { return -1; } *ret = this; @@ -3094,6 +3454,46 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, return 1; } +static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr, + int forward) +{ + struct select_replace_context *sc = (struct select_replace_context *) ptr; + Eterm ret; + + sc->lastobj = (*this)->dbterm.tpl; + + /* Always backwards traversing */ + if (sc->end_condition != NIL && + (cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, (*this)->dbterm.tpl)) > 0)) { + return 0; + } + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, + &(*this)->dbterm, NULL, 0); + + if (is_value(ret)) { + TreeDbTerm* new; + TreeDbTerm* old = *this; +#ifdef DEBUG + Eterm key = db_getkey(tb->common.keypos, ret); + ASSERT(is_value(key)); + ASSERT(cmp_key(tb, key, old) == 0); +#endif + new = new_dbterm(tb, ret); + new->left = old->left; + new->right = old->right; + new->balance = old->balance; + sc->lastobj = new->dbterm.tpl; + *this = new; + free_term(tb, old); + ++(sc->replaced); + } + if (--(sc->max) <= 0) { + return 0; + } + return 1; +} + #ifdef TREE_DEBUG static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show, TreeDbTerm *t, int offset) diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 6f30b1d3dd..03cc11bdc4 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1119,6 +1119,177 @@ error: return NULL; } +/* + * Compare a matching term 'a' with a constructing term 'b' for equality. + * + * Returns true if 'b' is guaranteed to always construct + * the same term as 'a' has matched. + */ +static int db_match_eq_body(Eterm a, Eterm b) +{ + DECLARE_ESTACK(s); + Uint arity; + Eterm *ap, *bp; + int const_mode = 0; + const Eterm CONST_MODE_OFF = THE_NON_VALUE; + + while (1) { + switch(b & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + if (!is_list(a)) + return 0; + ESTACK_PUSH2(s, CDR(list_val(a)), CDR(list_val(b))); + a = CAR(list_val(a)); + b = CAR(list_val(b)); + continue; /* loop without pop */ + + case TAG_PRIMARY_BOXED: + if (is_tuple(b)) { + bp = tuple_val(b); + if (!const_mode) { + if (bp[0] == make_arityval(1) && is_tuple(bp[1])) { + b = bp[1]; /* double-tuple syntax */ + } + else if (bp[0] == make_arityval(2) && bp[1] == am_const) { + ESTACK_PUSH(s, CONST_MODE_OFF); + const_mode = 1; /* {const, term()} syntax */ + b = bp[2]; + continue; /* loop without pop */ + } + else + return 0; /* function call or invalid tuple syntax */ + } + if (!is_tuple(a)) + return 0; + + ap = tuple_val(a); + bp = tuple_val(b); + if (ap[0] != bp[0]) + return 0; + arity = arityval(ap[0]); + if (arity > 0) { + a = *(++ap); + b = *(++bp); + while(--arity) { + ESTACK_PUSH2(s, *(++ap), *(++bp)); + } + continue; /* loop without pop */ + } + } + else if (is_map(b)) { + /* We don't know what other pairs the matched map may contain */ + return 0; + } + else if (!eq(a,b)) /* other boxed */ + return 0; + break; + + case TAG_PRIMARY_IMMED1: + if (a != b || a == am_Underscore || a == am_DollarDollar + || a == am_DollarUnderscore + || (const_mode && db_is_variable(a) >= 0)) { + + return 0; + } + break; + default: + erts_exit(ERTS_ABORT_EXIT, "db_compare: " + "Bad object on ESTACK: 0x%bex\n", b); + } + +pop_next: + if (ESTACK_ISEMPTY(s)) + break; /* done */ + + b = ESTACK_POP(s); + if (b == CONST_MODE_OFF) { + ASSERT(const_mode); + const_mode = 0; + goto pop_next; + } + a = ESTACK_POP(s); + } + + DESTROY_ESTACK(s); + return 1; +} + +/* This is used by select_replace */ +int db_match_keeps_key(int keypos, Eterm match, Eterm guard, Eterm body) +{ + Eterm match_key; + Eterm* body_list; + Eterm single_body_term; + Eterm* single_body_term_tpl; + Eterm single_body_subterm; + Eterm single_body_subterm_key; + Eterm* single_body_subterm_key_tpl; + + if (!is_list(body)) { + return 0; + } + + body_list = list_val(body); + if (CDR(body_list) != NIL) { + return 0; + } + + single_body_term = CAR(body_list); + if (single_body_term == am_DollarUnderscore) { + /* same tuple is returned */ + return 1; + } + + if (!is_tuple(single_body_term)) { + return 0; + } + + single_body_term_tpl = tuple_val(single_body_term); + if (arityval(*single_body_term_tpl) != 1) { + // not the 1-element tuple we're expecting + return 0; + } + + match_key = db_getkey(keypos, match); + if (!is_value(match_key)) { + // can't get key out of match + return 0; + } + + single_body_subterm = single_body_term_tpl[1]; + single_body_subterm_key = db_getkey(keypos, single_body_subterm); + if (!is_value(single_body_subterm_key)) { + // can't get key out of single body subterm + return 0; + } + + if (db_match_eq_body(match_key, single_body_subterm_key)) { + /* tuple with same key is returned */ + return 1; + } + + if (!is_tuple(single_body_subterm_key)) { + /* can't possibly be an element instruction */ + return 0; + } + + single_body_subterm_key_tpl = tuple_val(single_body_subterm_key); + if (arityval(*single_body_subterm_key_tpl) != 3) { + /* can't possibly be an element instruction */ + return 0; + } + + if (single_body_subterm_key_tpl[1] == am_element && + single_body_subterm_key_tpl[3] == am_DollarUnderscore && + single_body_subterm_key_tpl[2] == make_small(keypos)) + { + /* {element, KeyPos, '$_'} */ + return 1; + } + + return 0; +} + /* This is used when tracing */ Eterm erts_match_set_lint(Process *p, Eterm matchexpr) { return db_match_set_lint(p, matchexpr, DCOMP_TRACE); @@ -2172,7 +2343,7 @@ restart: } } else { - *esp = term; + *esp++ = term; } break; case matchPushArrayAsList: @@ -5161,6 +5332,7 @@ void db_free_tmp_uncompressed(DbTerm* obj) Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra) { + enum erts_pam_run_flags flags; Uint32 dummy; Eterm res; @@ -5168,9 +5340,13 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, obj = db_alloc_tmp_uncompressed(tb, obj); } + flags = (hpp ? + ERTS_PAM_COPY_RESULT | ERTS_PAM_CONTIGUOUS_TUPLE : + ERTS_PAM_TMP_RESULT | ERTS_PAM_CONTIGUOUS_TUPLE); + res = db_prog_match(c_p, c_p, bprog, make_tuple(obj->tpl), NULL, 0, - ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); + flags, &dummy); if (is_value(res) && hpp!=NULL) { *hpp = HAlloc(c_p, extra); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 72298842d7..9be77fcefa 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -169,6 +169,15 @@ typedef struct db_table_method DbTable* tb, /* [in out] */ Eterm continuation, Eterm* ret); + int (*db_select_replace)(Process* p, + DbTable* tb, /* [in out] */ + Eterm tid, + Eterm pattern, + Eterm* ret); + int (*db_select_replace_continue)(Process* p, + DbTable* tb, /* [in out] */ + Eterm continuation, + Eterm* ret); int (*db_take)(Process *, DbTable *, Eterm, Eterm *); int (*db_delete_all_objects)(Process* p, @@ -374,6 +383,7 @@ Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr); Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags); Binary *db_match_set_compile(Process *p, Eterm matchexpr, Uint flags); +int db_match_keeps_key(int keypos, Eterm match, Eterm guard, Eterm body); int erts_db_match_prog_destructor(Binary *); typedef struct match_prog { diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 3ff68a8859..0acc2432a7 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -430,6 +430,9 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ if ( (stat("/dev/null", &nullstatbuf) < 0) || (statbuf.st_ino != nullstatbuf.st_ino) || (statbuf.st_dev != nullstatbuf.st_dev) ) { +#ifdef HAVE_FSTAT + efile_closefile(fd); +#endif errno = EISDIR; return check_error(-1, errInfo); } diff --git a/erts/emulator/hipe/elf64ppc.x b/erts/emulator/hipe/elf64ppc.x index 46d2632970..bb14a6cd29 100644 --- a/erts/emulator/hipe/elf64ppc.x +++ b/erts/emulator/hipe/elf64ppc.x @@ -28,7 +28,7 @@ SEARCH_DIR("/mnt/archive/cross-ppc64/ppc64-unknown-linux/lib"); SECTIONS { /* Read-only sections, merged into text segment: */ - PROVIDE (__executable_start = 0x0180000); . = 0x01800000 + SIZEOF_HEADERS; + PROVIDE (__executable_start = 0x01800000); . = 0x01800000 + SIZEOF_HEADERS; .interp : { *(.interp) } .hash : { *(.hash) } .dynsym : { *(.dynsym) } diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c index 6fd27d46ea..b10b331cb5 100644 --- a/erts/epmd/src/epmd_cli.c +++ b/erts/epmd/src/epmd_cli.c @@ -46,10 +46,11 @@ void kill_epmd(EpmdVars *g) if ((rval = read_fill(fd,buf,2)) == 2) { if (buf[0] == 'O' && buf[1] == 'K') { printf("Killed\n"); + epmd_cleanup_exit(g,0); } else { printf("Killing not allowed - living nodes in database.\n"); + epmd_cleanup_exit(g,1); } - epmd_cleanup_exit(g,0); } else if (rval < 0) { printf("epmd: failed to read answer from local epmd\n"); epmd_cleanup_exit(g,1); diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 5b03019d8e..4b2f07f1a4 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex 4cf1b5ed82..c4e1e57c40 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 5d6f36b222..c584fe6f97 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 0a318b70bb..af7028b01c 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam Binary files differindex 20ee82a134..a6ecba2a17 100644 --- a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam +++ b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex c0ff53f503..c4b281163e 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam Binary files differindex e925636787..4552a34ae2 100644 --- a/erts/preloaded/ebin/erts_literal_area_collector.beam +++ b/erts/preloaded/ebin/erts_literal_area_collector.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 92eedd73d8..e90a988a07 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex b91fa63e7d..77b0b7a537 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex a011890c1a..ac9916cc86 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex b5e5ff9f88..2d8a355c82 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 994677872c..e2559ac034 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 6f1c82509f..12cbb5bf7a 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex eb9e07af7e..f5217eadf6 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 3dc6953b4c..c12a5b159a 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -263,21 +263,30 @@ boot(Start,Flags,Args) -> boot_loop(BootPid,State). %%% Convert a term to a printable string, if possible. -to_string(X) when is_list(X) -> % assume string +to_string(X, D) when is_list(X), D < 4 -> % assume string F = flatten(X, []), case printable_list(F) of - true -> F; - false -> "" + true when length(F) > 0 -> F; + _false -> + List = [to_string(E, D+1) || E <- X], + flatten(["[",join(List),"]"], []) end; -to_string(X) when is_atom(X) -> +to_string(X, _D) when is_list(X) -> + "[_]"; +to_string(X, _D) when is_atom(X) -> atom_to_list(X); -to_string(X) when is_pid(X) -> +to_string(X, _D) when is_pid(X) -> pid_to_list(X); -to_string(X) when is_float(X) -> +to_string(X, _D) when is_float(X) -> float_to_list(X); -to_string(X) when is_integer(X) -> +to_string(X, _D) when is_integer(X) -> integer_to_list(X); -to_string(_X) -> +to_string(X, D) when is_tuple(X), D < 4 -> + List = [to_string(E, D+1) || E <- tuple_to_list(X)], + flatten(["{",join(List),"}"], []); +to_string(X, _D) when is_tuple(X) -> + "{_}"; +to_string(_X, _D) -> "". % can't do anything with it %% This is an incorrect and narrow definition of printable characters. @@ -291,6 +300,13 @@ printable_list([$\t|T]) -> printable_list(T); printable_list([]) -> true; printable_list(_) -> false. +join([] = T) -> + T; +join([_Elem] = T) -> + T; +join([Elem|T]) -> + [Elem,","|join(T)]. + flatten([H|T], Tail) when is_list(H) -> flatten(H, flatten(T, Tail)); flatten([H|T], Tail) -> @@ -299,7 +315,7 @@ flatten([], Tail) -> Tail. things_to_string([X|Rest]) -> - " (" ++ to_string(X) ++ ")" ++ things_to_string(Rest); + " (" ++ to_string(X, 0) ++ ")" ++ things_to_string(Rest); things_to_string([]) -> "". @@ -307,9 +323,8 @@ halt_string(String, List) -> String ++ things_to_string(List). %% String = string() -%% List = [string() | atom() | pid() | number()] -%% Any other items in List, such as tuples, are ignored when creating -%% the string used as argument to erlang:halt/1. +%% List = [string() | atom() | pid() | number() | list() | tuple()] +%% Items in List are truncated if found to be too large -spec crash(_, _) -> no_return(). crash(String, List) -> halt(halt_string(String, List)). diff --git a/lib/asn1/src/asn1rt_nif.erl b/lib/asn1/src/asn1rt_nif.erl index ff464885f6..e540b9f50d 100644 --- a/lib/asn1/src/asn1rt_nif.erl +++ b/lib/asn1/src/asn1rt_nif.erl @@ -26,6 +26,7 @@ decode_ber_tlv/1, encode_ber_tlv/1]). +-compile(no_native). -on_load(load_nif/0). -define(ASN1_NIF_VSN,1). diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 6a0d87bcaf..c230148b29 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -1036,7 +1036,7 @@ Importance >= (100-VerbosityLevel)</pre> <p>Note that the category argument is not required in order to only specify the importance of a printout. Example:</p> <pre> -<c>ct:pal(?LOW_IMPORTANCE, "Info report: ~p", [Info])</c></pre> +ct:pal(?LOW_IMPORTANCE, "Info report: ~p", [Info])</pre> <p>Or perhaps in combination with constants:</p> <pre> -define(INFO, ?LOW_IMPORTANCE). diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 571958ca03..4188bd7c3b 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -309,7 +309,12 @@ is_started(ENode) -> % make a Erlang node name from name and hostname enodename(Host, Node) -> - list_to_atom(atom_to_list(Node)++"@"++atom_to_list(Host)). + case lists:member($@, atom_to_list(Node)) of + true -> + Node; + false -> + list_to_atom(atom_to_list(Node)++"@"++atom_to_list(Host)) + end. % performs actual start of the "slave" node do_start(Host, Node, Options) -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index b2f31870b9..1f4ce9a3da 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -425,10 +425,12 @@ static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM static ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_range_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -501,6 +503,7 @@ static ErlNifFunc nif_funcs[] = { {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt}, {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, + {"strong_rand_range_nif", 1, strong_rand_range_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 4, mod_exp_nif}, {"dss_verify_nif", 4, dss_verify_nif}, @@ -1736,17 +1739,20 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_raise_exception(env, atom_notsup); } - if ((argv[0] == atom_aes_cfb8 || argv[0] == atom_aes_cfb128) - && (key.size == 24 || key.size == 32) -#ifdef FIPS_SUPPORT - && !FIPS_mode() -#endif - ) { + 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); @@ -1822,6 +1828,31 @@ static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM return ret; } +static ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data, IsEncrypt) */ + ErlNifBinary key, ivec, text; + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + int new_ivlen = 0; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !(key.size == 16 || key.size == 24 || key.size == 32) + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + + memcpy(ivec_clone, ivec.data, 16); + AES_set_encrypt_key(key.data, key.size * 8, &aes_key); + AES_cfb128_encrypt((unsigned char *) text.data, + enif_make_new_binary(env, text.size, &ret), + text.size, &aes_key, ivec_clone, &new_ivlen, + (argv[3] != atom_true)); + CONSUME_REDS(env,text); + return ret; +} + static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data, IsEncrypt) */ #ifdef HAVE_AES_IGE @@ -2331,6 +2362,27 @@ static ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn) return term; } +static ERL_NIF_TERM strong_rand_range_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Range) */ + BIGNUM *bn_range, *bn_rand; + ERL_NIF_TERM ret; + + if(!get_bn_from_bin(env, argv[0], &bn_range)) { + return enif_make_badarg(env); + } + + bn_rand = BN_new(); + if (BN_rand_range(bn_rand, bn_range) != 1) { + ret = atom_false; + } + else { + ret = bin_from_bn(env, bn_rand); + } + BN_free(bn_rand); + BN_free(bn_range); + return ret; +} + static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Lo,Hi) */ BIGNUM *bn_from = NULL, *bn_to, *bn_rand; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index d0deaceaaf..552d95d7dc 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -658,10 +658,11 @@ </type> <desc> <p>Set the seed for PRNG to the given binary. This calls the - RAND_seed function from openssl. Only use this if the system - you are running on does not have enough "randomness" built in. - Normally this is when <seealso marker="#strong_rand_bytes/1"> - strong_rand_bytes/1</seealso> returns <c>low_entropy</c></p> + RAND_seed function from openssl. Only use this if the system + you are running on does not have enough "randomness" built in. + Normally this is when + <seealso marker="#strong_rand_bytes/1">strong_rand_bytes/1</seealso> + throws <c>low_entropy</c></p> </desc> </func> @@ -728,6 +729,43 @@ failed due to lack of secure "randomness".</p> </desc> </func> + + <func> + <name>rand_seed() -> rand:state()</name> + <fsummary>Strong random number generation plugin state</fsummary> + <desc> + <p> + Creates state object for + <seealso marker="stdlib:rand">random number generation</seealso>, + in order to generate cryptographically strong random numbers + (based on OpenSSL's <c>BN_rand_range</c>), + and saves it on process dictionary before returning it as well. + See also + <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso>. + </p> + <p><em>Example</em></p> + <pre> +_ = crypto:rand_seed(), +_IntegerValue = rand:uniform(42), % [1; 42] +_FloatValue = rand:uniform(). % [0.0; 1.0[</pre> + </desc> + </func> + + <func> + <name>rand_seed_s() -> rand:state()</name> + <fsummary>Strong random number generation plugin state</fsummary> + <desc> + <p> + Creates state object for + <seealso marker="stdlib:rand">random number generation</seealso>, + in order to generate cryptographically strongly random numbers + (based on OpenSSL's <c>BN_rand_range</c>). + See also + <seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>. + </p> + </desc> + </func> + <func> <name>stream_init(Type, Key) -> State</name> <fsummary></fsummary> diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 37997b649b..887aeca680 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,22 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 3.7.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix a bug with AES CFB 128 for 192 and 256 bit keys. + Thanks to kellymclaughlin !</p> + <p> + Own Id: OTP-14313 Aux Id: PR-1393 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 3.7.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index ce8add6559..1287ec6176 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -30,6 +30,12 @@ -export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([cmac/3, cmac/4]). -export([exor/2, strong_rand_bytes/1, mod_pow/3]). +-export([rand_seed/0]). +-export([rand_seed_s/0]). +-export([rand_plugin_next/1]). +-export([rand_plugin_uniform/1]). +-export([rand_plugin_uniform/2]). +-export([rand_plugin_jump/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]). @@ -45,6 +51,9 @@ %% This should correspond to the similar macro in crypto.c -define(MAX_BYTES_TO_NIF, 20000). %% Current value is: erlang:system_info(context_reductions) * 10 +%% Used by strong_rand_float/0 +-define(HALF_DBL_EPSILON, 1.1102230246251565e-16). % math:pow(2, -53) + %%-type ecdsa_digest_type() :: 'md5' | 'sha' | 'sha256' | 'sha384' | 'sha512'. -type crypto_integer() :: binary() | integer(). %%-type ec_named_curve() :: atom(). @@ -56,6 +65,7 @@ %%-type ec_curve() :: ec_named_curve() | ec_curve_spec(). %%-type ec_key() :: {Curve :: ec_curve(), PrivKey :: binary() | undefined, PubKey :: ec_point() | undefined}. +-compile(no_native). -on_load(on_load/0). -define(CRYPTO_NIF_VSN,302). @@ -285,9 +295,11 @@ stream_decrypt(State, Data0) -> stream_crypt(fun do_stream_decrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). %% -%% RAND - pseudo random numbers using RN_ functions in crypto lib +%% RAND - pseudo random numbers using RN_ and BN_ functions in crypto lib %% -spec strong_rand_bytes(non_neg_integer()) -> binary(). +-spec rand_seed() -> rand:state(). +-spec rand_seed_s() -> rand:state(). -spec rand_uniform(crypto_integer(), crypto_integer()) -> crypto_integer(). @@ -299,6 +311,46 @@ strong_rand_bytes(Bytes) -> strong_rand_bytes_nif(_Bytes) -> ?nif_stub. +rand_seed() -> + rand:seed(rand_seed_s()). + +rand_seed_s() -> + {#{ type => ?MODULE, + max => infinity, + next => fun ?MODULE:rand_plugin_next/1, + uniform => fun ?MODULE:rand_plugin_uniform/1, + uniform_n => fun ?MODULE:rand_plugin_uniform/2, + jump => fun ?MODULE:rand_plugin_jump/1}, + no_seed}. + +rand_plugin_next(Seed) -> + {bytes_to_integer(strong_rand_range(1 bsl 64)), Seed}. + +rand_plugin_uniform(State) -> + {strong_rand_float(), State}. + +rand_plugin_uniform(Max, State) -> + {bytes_to_integer(strong_rand_range(Max)) + 1, State}. + +rand_plugin_jump(State) -> + State. + +strong_rand_range(Range) when is_integer(Range), Range > 0 -> + BinRange = int_to_bin(Range), + strong_rand_range(BinRange); +strong_rand_range(BinRange) when is_binary(BinRange) -> + case strong_rand_range_nif(BinRange) of + false -> + erlang:error(low_entropy); + <<BinResult/binary>> -> + BinResult + end. +strong_rand_range_nif(_BinRange) -> ?nif_stub. + +strong_rand_float() -> + WholeRange = strong_rand_range(1 bsl 53), + ?HALF_DBL_EPSILON * bytes_to_integer(WholeRange). + rand_uniform(From,To) when is_binary(From), is_binary(To) -> case rand_uniform_nif(From,To) of <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> @@ -327,6 +379,7 @@ rand_uniform_pos(_,_) -> rand_uniform_nif(_From,_To) -> ?nif_stub. + -spec rand_seed(binary()) -> ok. rand_seed(Seed) -> rand_seed_nif(Seed). diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 1d7037d003..1b7456af18 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -36,7 +36,9 @@ all() -> {group, non_fips}, mod_pow, exor, - rand_uniform + rand_uniform, + rand_plugin, + rand_plugin_s ]. groups() -> @@ -486,6 +488,17 @@ rand_uniform(Config) when is_list(Config) -> 10 = byte_size(crypto:strong_rand_bytes(10)). %%-------------------------------------------------------------------- +rand_plugin() -> + [{doc, "crypto rand plugin testing (implicit state / process dictionary)"}]. +rand_plugin(Config) when is_list(Config) -> + rand_plugin_aux(implicit_state). + +rand_plugin_s() -> + [{doc, "crypto rand plugin testing (explicit state)"}]. +rand_plugin_s(Config) when is_list(Config) -> + rand_plugin_aux(explicit_state). + +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- hash(_, [], []) -> @@ -951,6 +964,101 @@ crypto_rand_uniform(L,H) -> ct:fail({"Not in interval", R1, L, H}) end. +foldallmap(_Fun, AccN, []) -> + {true, AccN}; +foldallmap(Fun, AccN, [H|T]) -> + case Fun(H, AccN) of + {true, AccM} -> foldallmap(Fun, AccM, T); + {{false, Result}, AccM} -> {Result, AccM} + end. + +allmap(_Fun, []) -> + true; +allmap(Fun, [H|T]) -> + case Fun(H) of + true -> allmap(Fun, T); + {false, Result} -> Result + end. + +rand_plugin_aux(StateType) -> + {Seeder, SeedExporter, FloatGenerator, IntegerGenerator} = rand_plugin_functions(StateType), + State0 = Seeder(), + {crypto, no_seed} = SeedExporter(State0), + {FloatTestResult, State1} = rand_plugin_aux_floats(State0, FloatGenerator), + case FloatTestResult of + true -> + {IntegerTestResult, _State2} = rand_plugin_aux_integers(State1, IntegerGenerator), + IntegerTestResult; + {false, _} -> + FloatTestResult + end. + +% returns {Seeder, SeedExporter, FloatGenerator, IntegerGenerator} with consistent signatures +rand_plugin_functions(implicit_state) -> + {fun () -> crypto:rand_seed(), implicit_state end, + fun (implicit_state) -> rand:export_seed() end, + fun (implicit_state) -> {rand:uniform(), implicit_state} end, + fun (N, implicit_state) -> {rand:uniform(N), implicit_state} end}; +rand_plugin_functions(explicit_state) -> + {fun crypto:rand_seed_s/0, + fun rand:export_seed_s/1, + fun rand:uniform_s/1, + fun rand:uniform_s/2}. + +rand_plugin_aux_floats(State0, FloatGenerator) -> + {FloatSamples, State1} = + lists:mapfoldl( + fun (_, StateAcc) -> + FloatGenerator(StateAcc) + end, + State0, + lists:seq(1, 10000)), + + {allmap( + fun (V) -> + (V >= 0.0 andalso V < 1.0) + orelse {false, ct:fail({"Float sample not in interval", V, 0.0, 1.0})} + end, + FloatSamples), + State1}. + +rand_plugin_aux_integers(State0, IntegerGenerator) -> + MaxIntegerCeiling = 1 bsl 32, + {IntegerCeilings, State1} = + lists:mapfoldl( + fun (_, StateAcc) -> + IntegerGenerator(MaxIntegerCeiling, StateAcc) + end, + State0, + lists:seq(1, 100)), + + foldallmap( + fun (Ceiling, StateAcc) -> + case Ceiling >= 1 andalso Ceiling =< MaxIntegerCeiling of + false -> + {{false, ct:fail({"Integer ceiling not in interval", + Ceiling, 1, MaxIntegerCeiling})}, + StateAcc}; + true -> + foldallmap( + fun (_, SubStateAcc) -> + {Sample, NewSubStateAcc} = IntegerGenerator(Ceiling, SubStateAcc), + case Sample >= 1 andalso Sample =< Ceiling of + false -> + {{false, ct:fail({"Integer sample not in interval", + Sample, 1, Ceiling})}, + NewSubStateAcc}; + true -> + {true, NewSubStateAcc} + end + end, + StateAcc, + lists:seq(1, 100)) + end + end, + State1, + IntegerCeilings). + %%-------------------------------------------------------------------- %% Test data ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index 81cb2f8130..f3e0623ac9 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 3.7.3 +CRYPTO_VSN = 3.7.4 diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index f5e079ef7e..88c7caacb0 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1486,7 +1486,6 @@ guard_expr({map,_,E0,Fs0}, Bs) -> Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, E, Fs), - io:format("~p~n", [{E,Value}]), {value,Value}; guard_expr({bin,_,Flds}, Bs) -> {value,V,_Bs} = diff --git a/lib/debugger/src/dbg_wx_code.erl b/lib/debugger/src/dbg_wx_code.erl index 473963500a..bca8a0d241 100644 --- a/lib/debugger/src/dbg_wx_code.erl +++ b/lib/debugger/src/dbg_wx_code.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -190,6 +190,6 @@ find(Ed, Str, Case, Next) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/debugger/src/dbg_wx_src_view.erl b/lib/debugger/src/dbg_wx_src_view.erl index 207c407fbc..ee8eb72407 100644 --- a/lib/debugger/src/dbg_wx_src_view.erl +++ b/lib/debugger/src/dbg_wx_src_view.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -62,6 +62,6 @@ code_area(Parent, Sizer) -> keyWords() -> L = ["after","begin","case","try","cond","catch","andalso","orelse", - "end","fun","if","let","of","query","receive","when","bnot","not", + "end","fun","if","let","of","receive","when","bnot","not", "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], lists:flatten([K ++ " " || K <- L] ++ [0]). diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 29c8e8cefb..f4ee30618c 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -524,7 +524,8 @@ gui_cmd({edit, {Var, Value}}, State) -> cancel -> State; {Var, Term} -> - Cmd = atom_to_list(Var)++"="++io_lib:format("~w", [Term]), + %% The space after "=" is needed for handling "B= <<1>>". + Cmd = atom_to_list(Var)++"= "++io_lib:format("~w", [Term]), gui_cmd({user_command, lists:flatten(Cmd)}, State) end. diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index e5bade9abe..fdf5957182 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -533,7 +533,9 @@ load({Mod, Src, Beam, BeamBin, Exp, Abst}, Dist) -> case erl_prim_loader:get_file(filename:absname(Src)) of {ok, SrcBin, _} -> MD5 = code:module_md5(BeamBin), - Bin = term_to_binary({interpreter_module,Exp,Abst,SrcBin,MD5}), + SrcBin1 = unicode:characters_to_binary(SrcBin, enc(SrcBin)), + true = is_binary(SrcBin1), + Bin = term_to_binary({interpreter_module,Exp,Abst,SrcBin1,MD5}), {module, Mod} = dbg_iserver:safe_call({load, Mod, Src, Bin}), _ = everywhere(Dist, fun() -> diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 7276a57268..b641118c5d 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -197,7 +197,7 @@ application(App, Dir, Options) when is_atom(App) -> ?OVERVIEW_FILE), Opts = Options ++ [{source_path, [Src]}, subpackages, - {title, io_lib:fwrite("The ~s application", [App])}, + {title, io_lib:fwrite("The ~ts application", [App])}, {overview, Overview}, {dir, filename:join(Dir, ?EDOC_DIR)}, {includes, [filename:join(Dir, "include")]}], diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index 006b07574b..6e17ec0af0 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -152,7 +152,7 @@ title(App, Options) -> if App == ?NO_APP -> "Overview"; true -> - io_lib:fwrite("Application: ~s", [App]) + io_lib:fwrite("Application: ~ts", [App]) end). diff --git a/lib/edoc/src/edoc_extract.erl b/lib/edoc/src/edoc_extract.erl index 68edad1a3e..390851e9ef 100644 --- a/lib/edoc/src/edoc_extract.erl +++ b/lib/edoc/src/edoc_extract.erl @@ -488,8 +488,15 @@ find_names([P | Ps], Ns) -> find_names([P1 | Ps], Ns); record_expr -> A = erl_syntax:record_expr_type(P), - N = list_to_atom(capitalize(erl_syntax:atom_name(A))), - find_names(Ps, [N | Ns]); + AtomName = erl_syntax:atom_name(A), + Atom = list_to_atom(AtomName), + case AtomName =:= lists:flatten(io_lib:write_atom(Atom)) of + true -> + N = list_to_atom(capitalize(AtomName)), + find_names(Ps, [N | Ns]); + false -> + find_names(Ps, Ns) + end; infix_expr -> %% this can only be a '++' operation P1 = erl_syntax:infix_expr_right(P), @@ -540,6 +547,7 @@ tidy_name_1(Cs) -> [$_ | Cs]. %% Change initial character from lowercase to uppercase. capitalize([C | Cs]) when C >= $a, C =< $z -> [C - 32 | Cs]; +capitalize([C | Cs]) when C >= $\340, C =< $\376, C /= $\367 -> [C - 32 | Cs]; capitalize(Cs) -> Cs. %% Collects the tags belonging to each entry, checks them, expands diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index 5ef210980c..5b1889ab06 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -109,14 +109,20 @@ module(Element, Options) -> stylesheet, index_columns, sort_functions, + encoding, pretty_printer}). init_opts(Element, Options) -> + Encoding = case get_attrval(encoding, Element) of + "latin1" -> latin1; + _ -> utf8 + end, R = #opts{root = get_attrval(root, Element), index_columns = proplists:get_value(index_columns, Options, 1), sort_functions = proplists:get_value(sort_functions, Options, true), + encoding = Encoding, pretty_printer = proplists:get_value(pretty_printer, Options, '') }, @@ -183,8 +189,9 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> Desc = get_content(description, Es), ShortDesc = get_content(briefDescription, Desc), FullDesc = get_content(fullDescription, Desc), - Functions = [{function_name(E), E} || E <- get_content(functions, Es)], - Types = [{type_name(E), E} || E <- get_content(typedecls, Es)], + Functions = [{function_name(E, Opts), E} || + E <- get_content(functions, Es)], + Types = [{type_name(E, Opts), E} || E <- get_content(typedecls, Es)], SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions); true -> Functions end, @@ -198,7 +205,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> ++ [?NL] ++ version(Es) ++ since(Es) - ++ behaviours(Es, Name) + ++ behaviours(Es, Name, Opts) ++ authors(Es) ++ references(Es) ++ sees(Es) @@ -215,7 +222,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> ++ [hr, ?NL] ++ navigation("bottom") ++ footer()), - Encoding = get_attrval(encoding, E), + Encoding = Opts#opts.encoding, xhtml(Title, stylesheet(Opts), Body, Encoding). module_params(Es) -> @@ -367,7 +374,7 @@ function(Name, E=#xmlElement{content = Es}, Opts) -> case typespec(get_content(typespec, Es), Opts) of [] -> signature(get_content(args, Es), - get_attrval(name, E)); + atom(get_attrval(name, E), Opts)); Spec -> Spec end}, ?NL] @@ -387,8 +394,8 @@ function(Name, E=#xmlElement{content = Es}, Opts) -> ++ sees(Es) ++ todos(Es)). -function_name(E) -> - atom(get_attrval(name, E)) ++ "/" ++ get_attrval(arity, E). +function_name(E, Opts) -> + atom(get_attrval(name, E), Opts) ++ "/" ++ get_attrval(arity, E). function_header(Name, E, Private) -> case is_exported(E) of @@ -449,7 +456,7 @@ throws(Es, Opts) -> [] -> []; Es1 -> %% Doesn't use format_type; keep it short! - [{p, (["throws ", {tt, t_utype(get_elem(type, Es1))}] + [{p, (["throws ", {tt, t_utype(get_elem(type, Es1), Opts)}] ++ local_defs(get_elem(localdef, Es1), Opts))}, ?NL] end. @@ -458,7 +465,7 @@ throws(Es, Opts) -> typespec([], _Opts) -> []; typespec(Es, Opts) -> - Name = t_name(get_elem(erlangName, Es)), + Name = t_name(get_elem(erlangName, Es), Opts), Defs = get_elem(localdef, Es), [Type] = get_elem(type, Es), format_spec(Name, Type, Defs, Opts) ++ local_defs(Defs, Opts). @@ -479,12 +486,12 @@ typedecl(Name, E=#xmlElement{content = Es}, Opts) -> ++ [{p, typedef(get_content(typedef, Es), Opts)}, ?NL] ++ fulldesc(Es)). -type_name(#xmlElement{content = Es}) -> - t_name(get_elem(erlangName, get_content(typedef, Es))). +type_name(#xmlElement{content = Es}, Opts) -> + t_name(get_elem(erlangName, get_content(typedef, Es)), Opts). typedef(Es, Opts) -> - Name = ([t_name(get_elem(erlangName, Es)), "("] - ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), [")"])), + Name = ([t_name(get_elem(erlangName, Es), Opts), "("] + ++ seq(t_utype_elem_fun(Opts), get_content(argtypes, Es), [")"])), (case get_elem(type, Es) of [] -> [{b, ["abstract datatype"]}, ": ", {tt, Name}]; Type -> format_type(Name, Name, Type, [], Opts) @@ -505,7 +512,9 @@ local_defs(Es0, Last, Opts) -> localdef(E = #xmlElement{content = Es}, Last, Opts) -> Name = case get_elem(typevar, Es) of [] -> - label_anchor(N0 = t_abstype(get_content(abstype, Es)), E); + label_anchor(N0 = t_abstype(get_content(abstype, Es), + Opts), + E); [V] -> N0 = t_var(V) end, @@ -516,97 +525,99 @@ localdef(E = #xmlElement{content = Es}, Last, Opts) -> %% (fast) Erlang pretty printer). format_spec(Name, Type, Defs, #opts{pretty_printer = erl_pp}=Opts) -> try - L = t_clause(Name, Type), - O = pp_clause(Name, Type), - {R, ".\n"} = etypef(L, O), + L = t_clause(Name, Type, Opts), + O = pp_clause(Name, Type, Opts), + {R, ".\n"} = etypef(L, O, Opts), [{pre, R}] catch _:_ -> %% Should not happen. format_spec(Name, Type, Defs, Opts#opts{pretty_printer=''}) end; -format_spec(Sep, Type, Defs, _Opts) -> +format_spec(Sep, Type, Defs, Opts) -> %% Very limited formatting. Br = if Defs =:= [] -> br; true -> [] end, - [{tt, t_clause(Sep, Type)}, Br]. + [{tt, t_clause(Sep, Type, Opts)}, Br]. -t_clause(Name, Type) -> +t_clause(Name, Type, Opts) -> #xmlElement{content = [#xmlElement{name = 'fun', content = C}]} = Type, - [Name] ++ t_fun(C). + [Name] ++ t_fun(C, Opts). -pp_clause(Pre, Type) -> +pp_clause(Pre, Type, Opts) -> Types = ot_utype([Type]), - Atom = lists:duplicate(iolist_size(Pre), $a), + Atom = lists:duplicate(string_length(Pre), $a), Attr = {attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}, - L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), + L1 = erl_pp:attribute(erl_parse:new_anno(Attr), + [{encoding, Opts#opts.encoding}]), "-spec " ++ L2 = lists:flatten(L1), L3 = Pre ++ lists:nthtail(length(Atom), L2), - re:replace(L3, "\n ", "\n", [{return,list},global]). + re:replace(L3, "\n ", "\n", [{return,list},global,unicode]). format_type(Prefix, Name, Type, Last, #opts{pretty_printer = erl_pp}=Opts) -> try - L = t_utype(Type), - O = pp_type(Name, Type), - {R, ".\n"} = etypef(L, O), + L = t_utype(Type, Opts), + O = pp_type(Name, Type, Opts), + {R, ".\n"} = etypef(L, O, Opts), [{pre, Prefix ++ [" = "] ++ R ++ Last}] catch _:_ -> %% Example: "t() = record(a)." format_type(Prefix, Name, Type, Last, Opts#opts{pretty_printer =''}) end; -format_type(Prefix, _Name, Type, Last, _Opts) -> - [{tt, Prefix ++ [" = "] ++ t_utype(Type) ++ Last}]. +format_type(Prefix, _Name, Type, Last, Opts) -> + [{tt, Prefix ++ [" = "] ++ t_utype(Type, Opts) ++ Last}]. -pp_type(Prefix, Type) -> - Atom = list_to_atom(lists:duplicate(iolist_size(Prefix), $a)), +pp_type(Prefix, Type, Opts) -> + Atom = list_to_atom(lists:duplicate(string_length(Prefix), $a)), Attr = {attribute,0,type,{Atom,ot_utype(Type),[]}}, - L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), + L1 = erl_pp:attribute(erl_parse:new_anno(Attr), + [{encoding, Opts#opts.encoding}]), {L2,N} = case lists:dropwhile(fun(C) -> C =/= $: end, lists:flatten(L1)) of ":: " ++ L3 -> {L3,9}; % compensation for extra "()" and ":" "::\n" ++ L3 -> {"\n"++L3,6} end, Ss = lists:duplicate(N, $\s), - re:replace(L2, "\n"++Ss, "\n", [{return,list},global]). + re:replace(L2, "\n"++Ss, "\n", [{return,list},global,unicode]). -etypef(L, O0) -> - {R, O} = etypef(L, [], O0, []), +etypef(L, O0, Opts) -> + {R, O} = etypef(L, [], O0, [], Opts), {lists:reverse(R), O}. -etypef([C | L], St, [C | O], R) -> - etypef(L, St, O, [[C] | R]); -etypef(" "++L, St, O, R) -> - etypef(L, St, O, R); -etypef("", [Cs | St], O, R) -> - etypef(Cs, St, O, R); -etypef("", [], O, R) -> +etypef([C | L], St, [C | O], R, Opts) -> + etypef(L, St, O, [[C] | R], Opts); +etypef(" "++L, St, O, R, Opts) -> + etypef(L, St, O, R, Opts); +etypef("", [Cs | St], O, R, Opts) -> + etypef(Cs, St, O, R, Opts); +etypef("", [], O, R, _Opts) -> {R, O}; -etypef(L, St, " "++O, R) -> - etypef(L, St, O, [" " | R]); -etypef(L, St, "\n"++O, R) -> +etypef(L, St, " "++O, R, Opts) -> + etypef(L, St, O, [" " | R], Opts); +etypef(L, St, "\n"++O, R, Opts) -> Ss = lists:takewhile(fun(C) -> C =:= $\s end, O), - etypef(L, St, lists:nthtail(length(Ss), O), ["\n"++Ss | R]); -etypef([{a, HRef, S0} | L], St, O0, R) -> - {S, O} = etypef(S0, app_fix(O0)), - etypef(L, St, O, [{a, HRef, S} | R]); -etypef("="++L, St, "::"++O, R) -> + etypef(L, St, lists:nthtail(length(Ss), O), ["\n"++Ss | R], Opts); +etypef([{a, HRef, S0} | L], St, O0, R, Opts) -> + {S, O} = etypef(S0, app_fix(O0, Opts), Opts), + etypef(L, St, O, [{a, HRef, S} | R], Opts); +etypef("="++L, St, "::"++O, R, Opts) -> %% EDoc uses "=" for record field types; Erlang types use "::". %% Maybe there should be an option for this, possibly affecting %% other similar discrepancies. - etypef(L, St, O, ["=" | R]); -etypef([Cs | L], St, O, R) -> - etypef(Cs, [L | St], O, R). + etypef(L, St, O, ["=" | R], Opts); +etypef([Cs | L], St, O, R, Opts) -> + etypef(Cs, [L | St], O, R, Opts). -app_fix(L) -> +app_fix(L, Opts) -> try - {"//" ++ R1,L2} = app_fix(L, 1), + {"//" ++ R1,L2} = app_fix1(L, 1), [App, Mod] = string:tokens(R1, "/"), - "//" ++ atom(App) ++ "/" ++ atom(Mod) ++ L2 + "//" ++ atom(App, Opts) ++ "/" ++ atom(Mod, Opts) ++ L2 catch _:_ -> L end. -app_fix(L, I) -> % a bit slow +app_fix1(L, I) -> % a bit slow {L1, L2} = lists:split(I, L), case erl_scan:tokens([], L1 ++ ". ", 1) of {done, {ok,[{atom,_,Atom}|_],_}, _} -> {atom_to_list(Atom), L2}; - _ -> app_fix(L, I+1) + _ -> app_fix1(L, I+1) end. fulldesc(Es) -> @@ -703,7 +714,7 @@ deprecated(Es, S) -> ?NL] end. -behaviours(Es, Name) -> +behaviours(Es, Name, Opts) -> CBs = get_content(callbacks, Es), OCBs = get_content(optional_callbacks, Es), (case get_elem(behaviour, Es) of @@ -717,17 +728,18 @@ behaviours(Es, Name) -> if CBs =:= [], OCBs =:= [] -> []; true -> + CBFun = fun(E) -> callback(E, Opts) end, Req = if CBs =:= [] -> []; true -> [br, " Required callback functions: "] - ++ seq(fun callback/1, CBs, ["."]) + ++ seq(CBFun, CBs, ["."]) end, Opt = if OCBs =:= [] -> []; true -> [br, " Optional callback functions: "] - ++ seq(fun callback/1, OCBs, ["."]) + ++ seq(CBFun, OCBs, ["."]) end, [{p, ([{b, ["This module defines the ", {tt, [Name]}, " behaviour."]}] @@ -738,10 +750,10 @@ behaviours(Es, Name) -> behaviour(E=#xmlElement{content = Es}) -> see(E, [{tt, Es}]). -callback(E=#xmlElement{}) -> +callback(E=#xmlElement{}, Opts) -> Name = get_attrval(name, E), Arity = get_attrval(arity, E), - [{tt, [Name, "/", Arity]}]. + [{tt, [atom(Name, Opts), "/", Arity]}]. authors(Es) -> case get_elem(author, Es) of @@ -751,9 +763,26 @@ authors(Es) -> ?NL] end. -atom(String) -> +atom(String, #opts{encoding = latin1}) -> + io_lib:write_atom_as_latin1(list_to_atom(String)); +atom(String, #opts{encoding = utf8}) -> io_lib:write_atom(list_to_atom(String)). +-dialyzer({nowarn_function, string_length/1}). +string_length(Data) -> + try iolist_size(Data) + catch + _:_ -> + M = string, + F = length, + As = [Data], + try apply(M, F, As) + catch + _:_ -> + 20 + end + end. + %% <!ATTLIST author %% name CDATA #REQUIRED %% email CDATA #IMPLIED @@ -799,70 +828,73 @@ todos(Es) -> ?NL] end. -t_name([E]) -> +t_name([E], Opts) -> N = get_attrval(name, E), case get_attrval(module, E) of - "" -> atom(N); + "" -> atom(N, Opts); M -> - S = atom(M) ++ ":" ++ atom(N), + S = atom(M, Opts) ++ ":" ++ atom(N, Opts), case get_attrval(app, E) of "" -> S; - A -> "//" ++ atom(A) ++ "/" ++ S + A -> "//" ++ atom(A, Opts) ++ "/" ++ S end end. -t_utype([E]) -> - t_utype_elem(E). +t_utype([E], Opts) -> + t_utype_elem(E, Opts). -t_utype_elem(E=#xmlElement{content = Es}) -> +t_utype_elem_fun(Opts) -> + fun(E) -> t_utype_elem(E, Opts) end. + +t_utype_elem(E=#xmlElement{content = Es}, Opts) -> case get_attrval(name, E) of - "" -> t_type(Es); + "" -> t_type(Es, Opts); Name -> - T = t_type(Es), + T = t_type(Es, Opts), case T of [Name] -> T; % avoid generating "Foo::Foo" T -> [Name] ++ ["::"] ++ T end end. -t_type([E=#xmlElement{name = typevar}]) -> +t_type([E=#xmlElement{name = typevar}], _Opts) -> t_var(E); -t_type([E=#xmlElement{name = atom}]) -> - t_atom(E); -t_type([E=#xmlElement{name = integer}]) -> +t_type([E=#xmlElement{name = atom}], Opts) -> + t_atom(E, Opts); +t_type([E=#xmlElement{name = integer}], _Opts) -> t_integer(E); -t_type([E=#xmlElement{name = range}]) -> +t_type([E=#xmlElement{name = range}], _Opts) -> t_range(E); -t_type([E=#xmlElement{name = binary}]) -> +t_type([E=#xmlElement{name = binary}], _Opts) -> t_binary(E); -t_type([E=#xmlElement{name = float}]) -> +t_type([E=#xmlElement{name = float}], _Opts) -> t_float(E); -t_type([#xmlElement{name = nil}]) -> +t_type([#xmlElement{name = nil}], _Opts) -> t_nil(); -t_type([#xmlElement{name = paren, content = Es}]) -> - t_paren(Es); -t_type([#xmlElement{name = list, content = Es}]) -> - t_list(Es); -t_type([#xmlElement{name = nonempty_list, content = Es}]) -> - t_nonempty_list(Es); -t_type([#xmlElement{name = map, content = Es}]) -> - t_map(Es); -t_type([#xmlElement{name = tuple, content = Es}]) -> - t_tuple(Es); -t_type([#xmlElement{name = 'fun', content = Es}]) -> - ["fun("] ++ t_fun(Es) ++ [")"]; -t_type([E = #xmlElement{name = record, content = Es}]) -> - t_record(E, Es); -t_type([E = #xmlElement{name = abstype, content = Es}]) -> - t_abstype(E, Es); -t_type([#xmlElement{name = union, content = Es}]) -> - t_union(Es). +t_type([#xmlElement{name = paren, content = Es}], Opts) -> + t_paren(Es, Opts); +t_type([#xmlElement{name = list, content = Es}], Opts) -> + t_list(Es, Opts); +t_type([#xmlElement{name = nonempty_list, content = Es}], Opts) -> + t_nonempty_list(Es, Opts); +t_type([#xmlElement{name = map, content = Es}], Opts) -> + t_map(Es, Opts); +t_type([#xmlElement{name = tuple, content = Es}], Opts) -> + t_tuple(Es, Opts); +t_type([#xmlElement{name = 'fun', content = Es}], Opts) -> + ["fun("] ++ t_fun(Es, Opts) ++ [")"]; +t_type([E = #xmlElement{name = record, content = Es}], Opts) -> + t_record(E, Es, Opts); +t_type([E = #xmlElement{name = abstype, content = Es}], Opts) -> + t_abstype(E, Es, Opts); +t_type([#xmlElement{name = union, content = Es}], Opts) -> + t_union(Es, Opts). t_var(E) -> [get_attrval(name, E)]. -t_atom(E) -> - [get_attrval(value, E)]. +t_atom(E, Opts) -> + [atom(get_attrval(value, E), Opts)]. t_integer(E) -> [get_attrval(value, E)]. @@ -879,62 +911,64 @@ t_float(E) -> t_nil() -> ["[]"]. -t_paren(Es) -> - ["("] ++ t_utype(get_elem(type, Es)) ++ [")"]. +t_paren(Es, Opts) -> + ["("] ++ t_utype(get_elem(type, Es), Opts) ++ [")"]. -t_list(Es) -> - ["["] ++ t_utype(get_elem(type, Es)) ++ ["]"]. +t_list(Es, Opts) -> + ["["] ++ t_utype(get_elem(type, Es), Opts) ++ ["]"]. -t_nonempty_list(Es) -> - ["["] ++ t_utype(get_elem(type, Es)) ++ [", ...]"]. +t_nonempty_list(Es, Opts) -> + ["["] ++ t_utype(get_elem(type, Es), Opts) ++ [", ...]"]. -t_tuple(Es) -> - ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). +t_tuple(Es, Opts) -> + ["{"] ++ seq(t_utype_elem_fun(Opts), Es, ["}"]). -t_fun(Es) -> - ["("] ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), - [") -> "] ++ t_utype(get_elem(type, Es))). +t_fun(Es, Opts) -> + ["("] ++ seq(t_utype_elem_fun(Opts), get_content(argtypes, Es), + [") -> "] ++ t_utype(get_elem(type, Es), Opts)). -t_map(Es) -> +t_map(Es, Opts) -> Fs = get_elem(map_field, Es), - ["#{"] ++ seq(fun t_map_field/1, Fs, ["}"]). + ["#{"] ++ seq(fun(E) -> t_map_field(E, Opts) end, Fs, ["}"]). -t_map_field(#xmlElement{content = [K,V]}=E) -> - KElem = t_utype_elem(K), - VElem = t_utype_elem(V), +t_map_field(#xmlElement{content = [K,V]}=E, Opts) -> + KElem = t_utype_elem(K, Opts), + VElem = t_utype_elem(V, Opts), AS = case get_attrval(assoc_type, E) of "assoc" -> " => "; "exact" -> " := " end, KElem ++ [AS] ++ VElem. -t_record(E, Es) -> - Name = ["#"] ++ t_type(get_elem(atom, Es)), +t_record(E, Es, Opts) -> + Name = ["#"] ++ t_type(get_elem(atom, Es), Opts), case get_elem(field, Es) of [] -> see(E, [Name, "{}"]); Fs -> - see(E, Name) ++ ["{"] ++ seq(fun t_field/1, Fs, ["}"]) + see(E, Name) ++ ["{"] ++ seq(fun(F) -> t_field(F, Opts) end, + Fs, ["}"]) end. -t_field(#xmlElement{content = Es}) -> - t_type(get_elem(atom, Es)) ++ [" = "] ++ t_utype(get_elem(type, Es)). +t_field(#xmlElement{content = Es}, Opts) -> + (t_type(get_elem(atom, Es), Opts) ++ [" = "] ++ + t_utype(get_elem(type, Es), Opts)). -t_abstype(E, Es) -> - Name = t_name(get_elem(erlangName, Es)), +t_abstype(E, Es, Opts) -> + Name = t_name(get_elem(erlangName, Es), Opts), case get_elem(type, Es) of [] -> see(E, [Name, "()"]); Ts -> - see(E, [Name]) ++ ["("] ++ seq(fun t_utype_elem/1, Ts, [")"]) + see(E, [Name]) ++ ["("] ++ seq(t_utype_elem_fun(Opts), Ts, [")"]) end. -t_abstype(Es) -> - ([t_name(get_elem(erlangName, Es)), "("] - ++ seq(fun t_utype_elem/1, get_elem(type, Es), [")"])). +t_abstype(Es, Opts) -> + ([t_name(get_elem(erlangName, Es), Opts), "("] + ++ seq(t_utype_elem_fun(Opts), get_elem(type, Es), [")"])). -t_union(Es) -> - seq(fun t_utype_elem/1, Es, " | ", []). +t_union(Es, Opts) -> + seq(t_utype_elem_fun(Opts), Es, " | ", []). seq(F, Es) -> seq(F, Es, []). @@ -989,8 +1023,8 @@ local_label(R) -> xhtml(Title, CSS, Body, Encoding) -> EncString = case Encoding of - "latin1" -> "ISO-8859-1"; - _ -> "UTF-8" + latin1 -> "ISO-8859-1"; + utf8 -> "UTF-8" end, [{html, [?NL, {head, [?NL, @@ -1009,11 +1043,11 @@ xhtml(Title, CSS, Body, Encoding) -> %% --------------------------------------------------------------------- type(E) -> - type(E, []). + Opts = init_opts(E, []), + type(E, [], Opts). -type(E, Ds) -> - Opts = [], - xmerl:export_simple_content(t_utype_elem(E) ++ local_defs(Ds, Opts), +type(E, Ds, Opts) -> + xmerl:export_simple_content(t_utype_elem(E, Opts) ++ local_defs(Ds, Opts), ?HTML_EXPORT). overview(E=#xmlElement{name = overview, content = Es}, Options) -> @@ -1036,7 +1070,7 @@ overview(E=#xmlElement{name = overview, content = Es}, Options) -> ++ [?NL, hr] ++ navigation("bottom") ++ footer()), - Encoding = get_attrval(encoding, E), + Encoding = Opts#opts.encoding, XML = xhtml(Title, stylesheet(Opts), Body, Encoding), xmerl:export_simple(XML, ?HTML_EXPORT, []). @@ -1094,8 +1128,8 @@ ot_var(E) -> {var,0,list_to_atom(get_attrval(name, E))}. ot_atom(E) -> - {ok, [{atom,A,Name}], _} = erl_scan:string(get_attrval(value, E), 0), - {atom,erl_anno:line(A),Name}. + Name = list_to_atom(get_attrval(value, E)), + {atom,erl_anno:new(0),Name}. ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. diff --git a/lib/edoc/src/edoc_report.erl b/lib/edoc/src/edoc_report.erl index ed778c8112..76557ef483 100644 --- a/lib/edoc/src/edoc_report.erl +++ b/lib/edoc/src/edoc_report.erl @@ -94,7 +94,7 @@ where({File, footer}) -> where({File, header}) -> io_lib:fwrite("~ts, in header file: ", [File]); where({File, {F, A}}) -> - io_lib:fwrite("~ts, function ~s/~w: ", [File, F, A]); + io_lib:fwrite("~ts, function ~ts/~w: ", [File, F, A]); where([]) -> io_lib:fwrite("~s: ", [?APPLICATION]); where(File) when is_list(File) -> diff --git a/lib/edoc/src/edoc_scanner.erl b/lib/edoc/src/edoc_scanner.erl index f1d5e1d4b9..35d00c6c0e 100644 --- a/lib/edoc/src/edoc_scanner.erl +++ b/lib/edoc/src/edoc_scanner.erl @@ -86,6 +86,8 @@ scan1([C|Cs], Toks, Pos) when C >= 0, C =< $ -> % Skip blanks scan1(Cs, Toks, Pos); scan1([C|Cs], Toks, Pos) when C >= $a, C =< $z -> % Unquoted atom scan_atom(C, Cs, Toks, Pos); +scan1([C|Cs], Toks, Pos) when C >= $\337, C =< $\377, C /= $\367 -> + scan_atom(C, Cs, Toks, Pos); scan1([C|Cs], Toks, Pos) when C >= $0, C =< $9 -> % Numbers scan_number(C, Cs, Toks, Pos); scan1([$-,C| Cs], Toks, Pos) when C >= $0, C =< $9 -> % Signed numbers @@ -96,6 +98,8 @@ scan1([C|Cs], Toks, Pos) when C >= $A, C =< $Z -> % Variables scan_variable(C, Cs, Toks, Pos); scan1([$_|Cs], Toks, Pos) -> % Variables scan_variable($_, Cs, Toks, Pos); +scan1([C|Cs], Toks, Pos) when C >= $\300, C =< $\336, C /= $\327 -> + scan_variable(C, Cs, Toks, Pos); scan1([$$|Cs], Toks, Pos) -> % Character constant case scan_char_const(Cs, Toks, Pos) of {ok, Result} -> @@ -261,6 +265,15 @@ scan_char([], _Pos) -> %% The following conforms to Standard Erlang escape sequences. +-define(HEX(C), C >= $0 andalso C =< $9 orelse + C >= $A andalso C =< $F orelse + C >= $a andalso C =< $f). + +-define(UNICODE(C), + (C >= 0 andalso C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF)). + scan_escape([O1, O2, O3 | Cs], Pos) when % \<1-3> octal digits O1 >= $0, O1 =< $3, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> Val = (O1*8 + O2)*8 + O3 - 73*$0, @@ -272,6 +285,11 @@ scan_escape([O1, O2 | Cs], Pos) when scan_escape([O1 | Cs], Pos) when O1 >= $0, O1 =< $7 -> {O1 - $0,Cs,Pos}; +scan_escape([$x, ${ | Cs], Pos) -> + scan_hex(Cs, Pos, []); +scan_escape([$x, H1, H2 | Cs], Pos) when ?HEX(H1), ?HEX(H2) -> + Val = (H1*16 + H2) - 17*$0, + {Val,Cs,Pos}; scan_escape([$^, C | Cs], Pos) -> % \^X -> CTL-X if C >= $\100, C =< $\137 -> {C - $\100,Cs,Pos}; @@ -285,6 +303,18 @@ scan_escape([C | Cs], Pos) -> scan_escape([], _Pos) -> {error, truncated_char}. +scan_hex([C | Cs], Pos, HCs) when ?HEX(C) -> + scan_hex(Cs, Pos, [C | HCs]); +scan_hex([$} | Cs], Pos, HCs) -> + case catch erlang:list_to_integer(lists:reverse(HCs), 16) of + Val when ?UNICODE(Val) -> + {Val,Cs,Pos}; + _ -> + {error, undefined_escape_sequence} + end; +scan_hex(_Cs, _Pos, _HCs) -> + {error, undefined_escape_sequence}. + %% Note that we return $\000 for undefined escapes. escape_char($b) -> $\010; % \b = BS escape_char($d) -> $\177; % \d = DEL diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index c15dfd328f..fb04bfce0e 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -274,12 +274,19 @@ parms([A | As], [D | Ds]) -> param(#t_paren{type = Type}, Default) -> param(Type, Default); -param(#t_record{name = #t_atom{val = Name}}, _Default) -> - list_to_atom(capitalize(atom_to_list(Name))); +param(#t_record{name = #t_atom{val = Name}}=T, Default) -> + AtomList = atom_to_list(Name), + case AtomList =:= lists:flatten(io_lib:write_atom(Name)) of + true -> + list_to_atom(capitalize(AtomList)); + false -> + arg_name(?t_ann(T), Default) + end; param(T, Default) -> arg_name(?t_ann(T), Default). capitalize([C | Cs]) when C >= $a, C =< $z -> [C - 32 | Cs]; +capitalize([C | Cs]) when C >= $\340, C =< $\376, C /= $\367 -> [C - 32 | Cs]; capitalize(Cs) -> Cs. %% Like edoc_types:arg_name/1 diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl index 4d846ad63d..29ca9d1203 100644 --- a/lib/edoc/test/edoc_SUITE.erl +++ b/lib/edoc/test/edoc_SUITE.erl @@ -23,12 +23,13 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([app/1,appup/1,build_std/1,build_map_module/1,otp_12008/1, build_app/1]). +-export([app/1,appup/1,build_std/1,build_map_module/1,otp_12008/1, + build_app/1, otp_14285/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app,appup,build_std,build_map_module,otp_12008, build_app]. + [app,appup,build_std,build_map_module,otp_12008, build_app, otp_14285]. groups() -> []. @@ -113,3 +114,18 @@ build_app(Config) -> true = filelib:is_regular(filename:join(OutDir, "a.html")), true = filelib:is_regular(filename:join(OutDir, "b.html")), ok. + +otp_14285(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Un1 = filename:join(DataDir, "un_atom1.erl"), + Un2 = filename:join(DataDir, "un_atom2.erl"), + %% epp_dodger + Opts1 = [{dir, PrivDir}], + ok = edoc:files([Un1], Opts1), + ok = edoc:files([Un2], Opts1), + %% epp + Opts2 = [{preprocess, true}, {dir, PrivDir}], + ok = edoc:files([Un1], Opts2), + ok = edoc:files([Un2], Opts2), + ok. diff --git a/lib/edoc/test/edoc_SUITE_data/un_atom1.erl b/lib/edoc/test/edoc_SUITE_data/un_atom1.erl new file mode 100644 index 0000000000..20ca50d5d2 --- /dev/null +++ b/lib/edoc/test/edoc_SUITE_data/un_atom1.erl @@ -0,0 +1,41 @@ +%% coding:latin-1 + +-module(un_atom1). + +-export(['\x{aaa}memory'/0, 'func-\x{400}'/1, func/1, �func/1]). + +-record('rec-\x{400}', {'field-\x{400}'}). + +-type cs() :: $\x{a} + | $\x{aa} + | $\x{aaa} + | $\xaa. + +-callback 'callback-\x{400}'() -> 'apa'. + +-type 'type-\x{400}'() :: 'atom-\x{400}' + | cs() + | #'rec-\x{400}'{'field-\x{400}' :: 'type-\x{400}'()}. + +-spec '\x{aaa}memory'() -> 'type-\x{400}'(). + +'\x{aaa}memory'() -> + apa:foo(). + +%% @deprecated Please use {@link m:f/1}. +-spec 'func-\x{400}'(#'rec-\x{400}'{}) -> #'rec-\x{400}'{}. + +'func-\x{400}'(_T) -> + foo:bar(#'rec-\x{400}'{}). + +-record(rec, {}). + +-spec func(#rec{}) -> #rec{}. + +func(#rec{}) -> #rec{}. + +-record(�rec, {}). + +-spec �func(#�rec{}) -> #�rec{}. + +�func(#�rec{}) -> #�rec{}. diff --git a/lib/edoc/test/edoc_SUITE_data/un_atom2.erl b/lib/edoc/test/edoc_SUITE_data/un_atom2.erl new file mode 100644 index 0000000000..66c83e30e0 --- /dev/null +++ b/lib/edoc/test/edoc_SUITE_data/un_atom2.erl @@ -0,0 +1,40 @@ +%% coding:utf-8 +-module(un_atom2). + +-export(['\x{aaa}memory'/0, 'func-\x{400}'/1, func/1, äfunc/1]). + +-record('rec-\x{400}', {'field-\x{400}'}). + +-type cs() :: $\x{a} + | $\x{aa} + | $\x{aaa} + | $\xaa. + +-callback 'callback-\x{400}'() -> 'apa'. + +-type 'type-\x{400}'() :: 'atom-\x{400}' + | cs() + | #'rec-\x{400}'{'field-\x{400}' :: 'type-\x{400}'()}. + +-spec '\x{aaa}memory'() -> 'type-\x{400}'(). + +'\x{aaa}memory'() -> + apa:foo(). + +%% @deprecated Please use {@link m:f/1}. +-spec 'func-\x{400}'(#'rec-\x{400}'{}) -> #'rec-\x{400}'{}. + +'func-\x{400}'(_T) -> + foo:bar(#'rec-\x{400}'{}). + +-record(rec, {}). + +-spec func(#rec{}) -> #rec{}. + +func(#rec{}) -> #rec{}. + +-record(ärec, {}). + +-spec äfunc(#ärec{}) -> #ärec{}. + +äfunc(#ärec{}) -> #ärec{}. diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 2ed02e021e..2aa48cd50a 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,23 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.3.6</title> + <section><title>Inets 6.3.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a bug in ftp that made further operations after a + recv_chunk operation impossible.</p> + <p> + Own Id: OTP-14242</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.3.6</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 23d6483291..de869e3204 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -108,7 +108,7 @@ -define(DBG(F,A), 'n/a'). %%-define(DBG(F,A), io:format(F,A)). -%%-define(DBG(F,A), if is_list(F) -> ct:pal(F,A); is_atom(F)->ct:pal(atom_to_list(F),A) end). +%%-define(DBG(F,A), ct:pal("~p:~p " ++ if is_list(F) -> F; is_atom(F) -> atom_to_list(F) end, [?MODULE,?LINE|A])). %%%========================================================================= %%% API - CLIENT FUNCTIONS @@ -1482,13 +1482,13 @@ handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, activate_ctrl_connection(State), {noreply, State#state{dsock = undefined, data = <<>>}}; -handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, client = From, +handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = recv_chunk} = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} -> - gen_server:reply(From, ok), - {noreply, State#state{dsock = undefined, client = undefined, - data = <<>>, caller = undefined, - chunk = false}}; + activate_ctrl_connection(State), + {noreply, State#state{dsock = undefined, data = <<>>, + caller = recv_chunk_closed + }}; handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = recv_bin, data = Data} = State) @@ -1601,13 +1601,13 @@ terminate(normal, State) -> %% If terminate reason =/= normal the progress reporting process will %% be killed by the exit signal. progress_report(stop, State), - do_termiante({error, econn}, State); + do_terminate({error, econn}, State); terminate(Reason, State) -> Report = io_lib:format("Ftp connection closed due to: ~p~n", [Reason]), error_logger:error_report(Report), - do_termiante({error, eclosed}, State). + do_terminate({error, eclosed}, State). -do_termiante(ErrorMsg, State) -> +do_terminate(ErrorMsg, State) -> close_data_connection(State), close_ctrl_connection(State), case State#state.client of @@ -2046,6 +2046,16 @@ handle_ctrl_result({pos_prel, _}, #state{client = From, end; %%-------------------------------------------------------------------------- +%% File handling - chunk_transfer complete +handle_ctrl_result({pos_compl, _}, #state{client = From, + caller = recv_chunk_closed} + = State0) -> + gen_server:reply(From, ok), + {noreply, State0#state{caller = undefined, + chunk = false, + client = undefined}}; + +%%-------------------------------------------------------------------------- %% File handling - recv_file handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) -> case accept_data_connection(State0) of diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index bd5f6df39e..418b6247b0 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -524,7 +524,7 @@ handle_request(Method, Url, Options = request_options(Options0), Sync = proplists:get_value(sync, Options), Stream = proplists:get_value(stream, Options), - Host2 = header_host(Scheme, Host, Port), + Host2 = http_request:normalize_host(Scheme, Host, Port), HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions), Receiver = proplists:get_value(receiver, Options), SocketOpts = proplists:get_value(socket_opts, Options), @@ -1035,14 +1035,6 @@ bad_option(Option, BadValue) -> throw({error, {bad_option, Option, BadValue}}). -header_host(https, Host, 443 = _Port) -> - Host; -header_host(http, Host, 80 = _Port) -> - Host; -header_host(_Scheme, Host, Port) -> - Host ++ ":" ++ integer_to_list(Port). - - header_record(NewHeaders, Host, #http_options{version = Version}) -> header_record(NewHeaders, #http_request_h{}, Host, Version). diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index d24705a845..d81afde5fe 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -362,8 +362,9 @@ redirect(Response = {StatusLine, Headers, Body}, Request) -> {ok, error(Request, Reason), Data}; %% Automatic redirection {ok, {Scheme, _, Host, Port, Path, Query}} -> + HostPort = http_request:normalize_host(Scheme, Host, Port), NewHeaders = - (Request#request.headers)#http_request_h{host = Host++":"++integer_to_list(Port)}, + (Request#request.headers)#http_request_h{host = HostPort}, NewRequest = Request#request{redircount = Request#request.redircount+1, diff --git a/lib/inets/src/http_lib/http_request.erl b/lib/inets/src/http_lib/http_request.erl index c77b616f0d..4c50edb5ef 100644 --- a/lib/inets/src/http_lib/http_request.erl +++ b/lib/inets/src/http_lib/http_request.erl @@ -22,7 +22,7 @@ -include("http_internal.hrl"). --export([headers/2, http_headers/1, is_absolut_uri/1, key_value/1]). +-export([headers/2, http_headers/1, is_absolut_uri/1, key_value/1, normalize_host/3]). key_value(KeyValueStr) -> @@ -85,6 +85,22 @@ is_absolut_uri("https://" ++ _) -> is_absolut_uri(_) -> false. +%%------------------------------------------------------------------------- +%% normalize_host(Scheme, Host, Port) -> string() +%% Scheme - http | https +%% Host - string() +%% Port - integer() +%% +%% Description: returns a normalized Host header value, with the port +%% number omitted for well-known ports +%%------------------------------------------------------------------------- +normalize_host(https, Host, 443 = _Port) -> + Host; +normalize_host(http, Host, 80 = _Port) -> + Host; +normalize_host(_Scheme, Host, Port) -> + Host ++ ":" ++ integer_to_list(Port). + %%%======================================================================== %%% Internal functions %%%======================================================================== diff --git a/lib/inets/test/ftp_SUITE.erl b/lib/inets/test/ftp_SUITE.erl index e2dec0c42a..0053ba6edd 100644 --- a/lib/inets/test/ftp_SUITE.erl +++ b/lib/inets/test/ftp_SUITE.erl @@ -93,8 +93,10 @@ ftp_tests()-> append_chunk, recv, recv_3, - recv_bin, + recv_bin, + recv_bin_twice, recv_chunk, + recv_chunk_twice, type, quote, error_elogin, @@ -191,9 +193,22 @@ end_per_suite(Config) -> ok. %%-------------------------------------------------------------------- -init_per_group(_Group, Config) -> Config. - -end_per_group(_Group, Config) -> Config. +init_per_group(Group, Config) when Group == ftps_active, + Group == ftps_passive -> + catch crypto:stop(), + try crypto:start() of + ok -> + Config + catch + _:_ -> + {skip, "Crypto did not start"} + end; + +init_per_group(_Group, Config) -> + Config. + +end_per_group(_Group, Config) -> + Config. %%-------------------------------------------------------------------- init_per_testcase(Case, Config0) -> @@ -533,15 +548,19 @@ append_chunk(Config0) -> recv() -> [{doc, "Receive a file using recv/2"}]. recv(Config0) -> - File = "f_dst.txt", + File1 = "f_dst1.txt", + File2 = "f_dst2.txt", SrcDir = "a_dir", - Contents = <<"ftp_SUITE test ...">>, - Config = set_state([reset, {mkfile,[SrcDir,File],Contents}], Config0), + Contents1 = <<"1 ftp_SUITE test ...">>, + Contents2 = <<"2 ftp_SUITE test ...">>, + Config = set_state([reset, {mkfile,[SrcDir,File1],Contents1}, {mkfile,[SrcDir,File2],Contents2}], Config0), Pid = proplists:get_value(ftp, Config), ok = ftp:cd(Pid, id2ftp(SrcDir,Config)), ok = ftp:lcd(Pid, id2ftp("",Config)), - ok = ftp:recv(Pid, File), - chk_file(File, Contents, Config), + ok = ftp:recv(Pid, File1), + chk_file(File1, Contents1, Config), + ok = ftp:recv(Pid, File2), + chk_file(File2, Contents2, Config), {error,epath} = ftp:recv(Pid, "non_existing_file"), ok. @@ -572,6 +591,25 @@ recv_bin(Config0) -> ok. %%------------------------------------------------------------------------- +recv_bin_twice() -> + [{doc, "Receive two files as a binaries."}]. +recv_bin_twice(Config0) -> + File1 = "f_dst1.txt", + File2 = "f_dst2.txt", + Contents1 = <<"1 ftp_SUITE test ...">>, + Contents2 = <<"2 ftp_SUITE test ...">>, + Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0), + ct:log("First transfer",[]), + Pid = proplists:get_value(ftp, Config), + {ok,Received1} = ftp:recv_bin(Pid, id2ftp(File1,Config)), + find_diff(Received1, Contents1), + ct:log("Second transfer",[]), + {ok,Received2} = ftp:recv_bin(Pid, id2ftp(File2,Config)), + find_diff(Received2, Contents2), + ct:log("Transfers ready!",[]), + {error,epath} = ftp:recv_bin(Pid, id2ftp("non_existing_file",Config)), + ok. +%%------------------------------------------------------------------------- recv_chunk() -> [{doc, "Receive a file using chunk-wise."}]. recv_chunk(Config0) -> @@ -584,6 +622,23 @@ recv_chunk(Config0) -> {ok, ReceivedContents, _Ncunks} = recv_chunk(Pid, <<>>), find_diff(ReceivedContents, Contents). +recv_chunk_twice() -> + [{doc, "Receive two files using chunk-wise."}]. +recv_chunk_twice(Config0) -> + File1 = "big_file1.txt", + File2 = "big_file2.txt", + Contents1 = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ), + Contents2 = crypto:strong_rand_bytes(1200), + Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0), + Pid = proplists:get_value(ftp, Config), + {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>), + ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)), + {ok, ReceivedContents1, _Ncunks1} = recv_chunk(Pid, <<>>), + ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)), + {ok, ReceivedContents2, _Ncunks2} = recv_chunk(Pid, <<>>), + find_diff(ReceivedContents1, Contents1), + find_diff(ReceivedContents2, Contents2). + recv_chunk(Pid, Acc) -> recv_chunk(Pid, Acc, 0). diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 8aea38037d..67aa78aa06 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -163,21 +163,17 @@ init_per_group(misc = Group, Config) -> ok = httpc:set_options([{ipfamily, Inet}]), Config; + init_per_group(Group, Config0) when Group =:= sim_https; Group =:= https-> - ct:timetrap({seconds, 30}), - start_apps(Group), - StartSsl = try ssl:start() + catch crypto:stop(), + try crypto:start() of + ok -> + ct:timetrap({seconds, 30}), + start_apps(Group), + do_init_per_group(Group, Config0) catch - Error:Reason -> - {skip, lists:flatten(io_lib:format("Failed to start apps for https Error=~p Reason=~p", [Error, Reason]))} - end, - case StartSsl of - {error, {already_started, _}} -> - do_init_per_group(Group, Config0); - ok -> - do_init_per_group(Group, Config0); - _ -> - StartSsl + _:_ -> + {skip, "Crypto did not start"} end; init_per_group(Group, Config0) -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index aae4ce5256..44b1e09cbc 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -197,7 +197,14 @@ init_per_group(Group, Config0) when Group == https_basic; Group == https_security; Group == https_reload -> - init_ssl(Group, Config0); + catch crypto:stop(), + try crypto:start() of + ok -> + init_ssl(Group, Config0) + catch + _:_ -> + {skip, "Crypto did not start"} + end; init_per_group(Group, Config0) when Group == http_basic; Group == http_limit; Group == http_custom; @@ -232,7 +239,14 @@ init_per_group(https_htaccess = Group, Config) -> Path = proplists:get_value(doc_root, Config), catch remove_htaccess(Path), create_htaccess_data(Path, proplists:get_value(address, Config)), - init_ssl(Group, Config); + catch crypto:stop(), + try crypto:start() of + ok -> + init_ssl(Group, Config) + catch + _:_ -> + {skip, "Crypto did not start"} + end; init_per_group(auth_api, Config) -> [{auth_prefix, ""} | Config]; init_per_group(auth_api_dets, Config) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 5637170c15..411bbfc043 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.3.6 +INETS_VSN = 6.3.7 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 59eca242b1..b901da95b8 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -100,63 +100,112 @@ get_error_logger_type() -> %%%----------------------------------------------------------------- init([]) -> - SupFlags = {one_for_all, 0, 1}, - - Config = {kernel_config, - {kernel_config, start_link, []}, - permanent, 2000, worker, [kernel_config]}, - Code = {code_server, - {code, start_link, []}, - permanent, 2000, worker, [code]}, - File = {file_server_2, - {file_server, start_link, []}, - permanent, 2000, worker, - [file, file_server, file_io_server, prim_file]}, - StdError = {standard_error, - {standard_error, start_link, []}, - temporary, 2000, supervisor, [user_sup]}, - User = {user, - {user_sup, start, []}, - temporary, 2000, supervisor, [user_sup]}, - + SupFlags = #{strategy => one_for_all, + intensity => 0, + period => 1}, + + Config = #{id => kernel_config, + start => {kernel_config, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [kernel_config]}, + + Code = #{id => code_server, + start => {code, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [code]}, + + File = #{id => file_server_2, + start => {file_server, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modeules => [file, file_server, file_io_server, prim_file]}, + + StdError = #{id => standard_error, + start => {standard_error, start_link, []}, + restart => temporary, + shutdown => 2000, + type => supervisor, + modules => [user_sup]}, + + User = #{id => user, + start => {user_sup, start, []}, + restart => temporary, + shutdown => 2000, + type => supervisor, + modules => [user_sup]}, + + SafeSup = #{id => kernel_safe_sup, + start =>{supervisor, start_link, [{local, kernel_safe_sup}, ?MODULE, safe]}, + restart => permanent, + shutdown => infinity, + type => supervisor, + modules => [?MODULE]}, + case init:get_argument(mode) of - {ok, [["minimal"]]} -> - SafeSupervisor = {kernel_safe_sup, - {supervisor, start_link, - [{local, kernel_safe_sup}, ?MODULE, safe]}, - permanent, infinity, supervisor, [?MODULE]}, - {ok, {SupFlags, - [Code, File, StdError, User, - Config, SafeSupervisor]}}; - _ -> - Rpc = {rex, {rpc, start_link, []}, - permanent, 2000, worker, [rpc]}, - Global = {global_name_server, {global, start_link, []}, - permanent, 2000, worker, [global]}, - Glo_grp = {global_group, {global_group,start_link,[]}, - permanent, 2000, worker, [global_group]}, - InetDb = {inet_db, {inet_db, start_link, []}, - permanent, 2000, worker, [inet_db]}, - NetSup = {net_sup, {erl_distribution, start_link, []}, - permanent, infinity, supervisor,[erl_distribution]}, + {ok, [["minimal"]]} -> + {ok, {SupFlags, [Code, File, StdError, User, Config, SafeSup]}}; + _ -> + Rpc = #{id => rex, + start => {rpc, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [rpc]}, + + Global = #{id => global_name_server, + start => {global, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [global]}, + + GlGroup = #{id => global_group, + start => {global_group,start_link,[]}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [global_group]}, + + InetDb = #{id => inet_db, + start => {inet_db, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [inet_db]}, + + NetSup = #{id => net_sup, + start => {erl_distribution, start_link, []}, + restart => permanent, + shutdown => infinity, + type => supervisor, + modules => [erl_distribution]}, + SigSrv = #{id => erl_signal_server, start => {gen_event, start_link, [{local, erl_signal_server}]}, - type => worker, restart => permanent, shutdown => 2000, modules => dynamic}, - DistAC = start_dist_ac(), - - Timer = start_timer(), - - SafeSupervisor = {kernel_safe_sup, - {supervisor, start_link, - [{local, kernel_safe_sup}, ?MODULE, safe]}, - permanent, infinity, supervisor, [?MODULE]}, - {ok, {SupFlags, - [Code, Rpc, Global, InetDb | DistAC] ++ - [NetSup, Glo_grp, File, SigSrv, - StdError, User, Config, SafeSupervisor] ++ Timer}} + restart => permanent, + shutdown => 2000, + type => worker, + modules => dynamic}, + + DistAC = start_dist_ac(), + + Timer = start_timer(), + + {ok, {SupFlags, + [Code, Rpc, Global, InetDb | DistAC] ++ + [NetSup, GlGroup, File, SigSrv, + StdError, User, Config, SafeSup] ++ Timer}} end; init(safe) -> - SupFlags = {one_for_one, 4, 3600}, + SupFlags = #{strategy => one_for_one, + intensity => 4, + period => 3600}, + Boot = start_boot_server(), DiskLog = start_disk_log(), Pg2 = start_pg2(), @@ -170,60 +219,85 @@ init(safe) -> {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. start_dist_ac() -> - Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], + Spec = [#{id => dist_ac, + start => {dist_ac,start_link,[]}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [dist_ac]}], case application:get_env(kernel, start_dist_ac) of - {ok, true} -> Spec; - {ok, false} -> []; - undefined -> - case application:get_env(kernel, distributed) of - {ok, _} -> Spec; - _ -> [] - end + {ok, true} -> Spec; + {ok, false} -> []; + undefined -> + case application:get_env(kernel, distributed) of + {ok, _} -> Spec; + _ -> [] + end end. start_boot_server() -> case application:get_env(kernel, start_boot_server) of - {ok, true} -> - Args = get_boot_args(), - [{boot_server, {erl_boot_server, start_link, [Args]}, permanent, - 1000, worker, [erl_boot_server]}]; - _ -> - [] + {ok, true} -> + Args = get_boot_args(), + [#{id => boot_server, + start => {erl_boot_server, start_link, [Args]}, + restart => permanent, + shutdown => 1000, + type => worker, + modules => [erl_boot_server]}]; + _ -> + [] end. get_boot_args() -> case application:get_env(kernel, boot_server_slaves) of - {ok, Slaves} -> Slaves; - _ -> [] + {ok, Slaves} -> Slaves; + _ -> [] end. start_disk_log() -> case application:get_env(kernel, start_disk_log) of - {ok, true} -> - [{disk_log_server, - {disk_log_server, start_link, []}, - permanent, 2000, worker, [disk_log_server]}, - {disk_log_sup, {disk_log_sup, start_link, []}, permanent, - 1000, supervisor, [disk_log_sup]}]; - _ -> - [] + {ok, true} -> + [#{id => disk_log_server, + start => {disk_log_server, start_link, []}, + restart => permanent, + shutdown => 2000, + type => worker, + modules => [disk_log_server]}, + #{id => disk_log_sup, + start => {disk_log_sup, start_link, []}, + restart => permanent, + shutdown => 1000, + type => supervisor, + modules => [disk_log_sup]}]; + _ -> + [] end. start_pg2() -> case application:get_env(kernel, start_pg2) of - {ok, true} -> - [{pg2, {pg2, start_link, []}, permanent, 1000, worker, [pg2]}]; - _ -> - [] + {ok, true} -> + [#{id => pg2, + start => {pg2, start_link, []}, + restart => permanent, + shutdown => 1000, + type => worker, + modules => [pg2]}]; + _ -> + [] end. start_timer() -> case application:get_env(kernel, start_timer) of - {ok, true} -> - [{timer_server, {timer, start_link, []}, permanent, 1000, worker, - [timer]}]; - _ -> - [] + {ok, true} -> + [#{id => timer_server, + start => {timer, start_link, []}, + restart => permanent, + shutdown => 1000, + type => worker, + modules => [timer]}]; + _ -> + [] end. %%----------------------------------------------------------------- diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 19d36a7613..088d851b09 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -107,6 +107,10 @@ init_per_testcase(big_boot_embedded, Config) -> _Else -> {skip, "Needs crypto!"} end; +init_per_testcase(on_load_embedded, Config) -> + LibRoot = code:lib_dir(), + LinkName = filename:join(LibRoot, "on_load_app-1.0"), + [{link_name,LinkName}|Config]; init_per_testcase(_Func, Config) -> P = code:get_path(), [{code_path, P}|Config]. @@ -124,6 +128,10 @@ end_per_testcase(TC, Config) when TC == mult_lib_roots; NodeName = list_to_atom(atom_to_list(TC)++"@"++HostName), test_server:stop_node(NodeName), end_per_testcase(Config); +end_per_testcase(on_load_embedded, Config) -> + LinkName = proplists:get_value(link_name, Config), + _ = del_link(LinkName), + end_per_testcase(Config); end_per_testcase(_Func, Config) -> end_per_testcase(Config). @@ -1271,10 +1279,9 @@ on_load_embedded(Config) when is_list(Config) -> on_load_embedded_1(Config) -> DataDir = proplists:get_value(data_dir, Config), + LinkName = proplists:get_value(link_name, Config), %% Link the on_load_app application into the lib directory. - LibRoot = code:lib_dir(), - LinkName = filename:join(LibRoot, "on_load_app-1.0"), OnLoadApp = filename:join(DataDir, "on_load_app-1.0"), del_link(LinkName), io:format("LinkName :~p, OnLoadApp: ~p~n",[LinkName,OnLoadApp]), @@ -1308,8 +1315,7 @@ on_load_embedded_1(Config) -> ok = rpc:call(Node, on_load_embedded, status, []), %% Clean up. - stop_node(Node), - ok = del_link(LinkName). + stop_node(Node). del_link(LinkName) -> case file:delete(LinkName) of diff --git a/lib/observer/doc/src/etop.xml b/lib/observer/doc/src/etop.xml index d70d9d1d23..059f9f05d8 100644 --- a/lib/observer/doc/src/etop.xml +++ b/lib/observer/doc/src/etop.xml @@ -35,7 +35,7 @@ <file></file> </header> <module>etop</module> - <modulesummary>Erlang Top is a tool for presenting information about Erlang + <modulesummary>Erlang Top is a tool for presenting information about Erlang processes similar to the information presented by "top" in UNIX.</modulesummary> <description> @@ -60,11 +60,11 @@ <p>Value: <c>atom()</c></p> <p>Mandatory</p></item> <tag><c>setcookie</c></tag> - <item><p>Cookie to use for the <c>etop</c> node. Must be same as the + <item><p>Cookie to use for the <c>etop</c> node. Must be same as the cookie on the measured node.</p> <p>Value: <c>atom()</c></p></item> <tag><c>lines</c></tag> - <item><p>Number of lines (processes) to display.</p> + <item><p>Number of lines (processes) to display.</p> <p>Value: <c>integer()</c></p> <p>Default: <c>10</c></p></item> <tag><c>interval</c></tag> @@ -92,7 +92,7 @@ <p>Default: <c>on</c></p></item> </taglist> - <p>For detalis about Erlang Top, see the + <p>For details about Erlang Top, see the <seealso marker="etop_ug">User's Guide</seealso>.</p> </description> diff --git a/lib/observer/doc/src/observer.xml b/lib/observer/doc/src/observer.xml index 4d43ffe39f..fc6395d2c0 100644 --- a/lib/observer/doc/src/observer.xml +++ b/lib/observer/doc/src/observer.xml @@ -43,7 +43,7 @@ <seealso marker="ttb"><c>ttb</c></seealso>. </p> - <p>For detalis about how to get started, see the + <p>For details about how to get started, see the <seealso marker="observer_ug"><c>User's Guide</c></seealso>.</p> </description> <funcs> diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index cad02087be..9e1442a5ca 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(observer_alloc_wx). --export([start_link/2]). +-export([start_link/3]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -49,10 +49,10 @@ [make_win/4, setup_graph_drawing/1, refresh_panel/4, interval_dialog/2, add_data/5, precalc/4]). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). -init([Notebook, Parent]) -> +init([Notebook, Parent, Config]) -> try TopP = wxPanel:new(Notebook), Main = wxBoxSizer:new(?wxVERTICAL), @@ -75,7 +75,7 @@ init([Notebook, Parent]) -> wins = Windows, mem = MemWin, paint = PaintInfo, - time = setup_time(), + time = setup_time(Config), max = #{} } } @@ -84,9 +84,11 @@ init([Notebook, Parent]) -> {stop, Err} end. -setup_time() -> - Freq = 1, - #ti{fetch=Freq, disp=?DISP_FREQ/Freq}. +setup_time(Config) -> + Freq = maps:get(fetch, Config, 1), + #ti{disp=?DISP_FREQ/Freq, + fetch=Freq, + secs=maps:get(secs, Config, ?DISP_SECONDS)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, @@ -117,6 +119,10 @@ handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, refresh_panel(Active, Win, Ti, Paint), ok. %%%%%%%%%% +handle_call(get_config, _, #state{time=Ti}=State) -> + #ti{fetch=Fetch, secs=Range} = Ti, + {reply, #{fetch=>Fetch, secs=>Range}, State}; + handle_call(Event, From, _State) -> error({unhandled_call, Event, From}). diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index 80a41fdde9..63ca3aeba7 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(observer_app_wx). --export([start_link/2]). +-export([start_link/3]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -73,10 +73,10 @@ -define(wxGC, wxGraphicsContext). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). -init([Notebook, Parent]) -> +init([Notebook, Parent, _Config]) -> Panel = wxPanel:new(Notebook, [{size, wxWindow:getClientSize(Notebook)}, {winid, 1} ]), @@ -258,6 +258,8 @@ handle_sync_event(#wx{event = #wxPaint{}},_, destroy_gc(GC), ok. %%%%%%%%%% +handle_call(get_config, _, State) -> + {reply, #{}, State}; handle_call(Event, From, _State) -> error({unhandled_call, Event, From}). diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 47844c1307..68095d7f58 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -24,7 +24,7 @@ display_progress_dialog/2, destroy_progress_dialog/0, wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, - interval_dialog/4, start_timer/1, stop_timer/1, + interval_dialog/4, start_timer/1, start_timer/2, stop_timer/1, timer_config/1, display_info/2, display_info/3, fill_info/2, update_info/2, to_str/1, create_menus/3, create_menu_item/3, create_attrs/0, @@ -90,6 +90,12 @@ stop_timer(Timer = {true, _}) -> Timer; stop_timer(Timer = {_, Intv}) -> setup_timer(false, Timer), {true, Intv}. + +start_timer(#{interval:=Intv}, _Def) -> + setup_timer(true, {false, Intv}); +start_timer(_, Def) -> + setup_timer(true, {false, Def}). + start_timer(Intv) when is_integer(Intv) -> setup_timer(true, {true, Intv}); start_timer(Timer) -> @@ -105,6 +111,11 @@ setup_timer(Bool, {Timer, Old}) -> timer:cancel(Timer), setup_timer(Bool, {false, Old}). +timer_config({_, Interval}) -> + #{interval=>Interval}; +timer_config(#{}=Config) -> + Config. + display_info_dialog(Parent,Str) -> display_info_dialog(Parent,"",Str). display_info_dialog(Parent,Title,Str) -> diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 0cbcdbceb4..fc5fb226db 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(observer_perf_wx). --export([start_link/2]). +-export([start_link/3]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -57,10 +57,10 @@ -record(paint, {font, small, pen, pen2, pens, dot_pens, usegc = false}). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). -init([Notebook, Parent]) -> +init([Notebook, Parent, Config]) -> try Panel = wxPanel:new(Notebook), Main = wxBoxSizer:new(?wxVERTICAL), @@ -81,7 +81,9 @@ init([Notebook, Parent]) -> panel =Panel, wins = Windows, paint=PaintInfo, - samples=reset_data() + samples=reset_data(), + time=#ti{fetch=maps:get(fetch, Config, ?FETCH_DATA), + secs=maps:get(secs, Config, ?DISP_SECONDS)} }, {Panel, State0} catch _:Err -> @@ -177,6 +179,10 @@ refresh_panel(Active, #win{name=_Id, panel=Panel}=Win, Ti, #paint{usegc=UseGC}=P destroy_gc(GC). %%%%%%%%%% +handle_call(get_config, _, #state{time=Ti}=State) -> + #ti{fetch=Fetch, secs=Range} = Ti, + {reply, #{fetch=>Fetch, secs=>Range}, State}; + handle_call(Event, From, _State) -> error({unhandled_call, Event, From}). @@ -210,7 +216,7 @@ handle_info({refresh, Seq}, #state{panel=Panel, time=#ti{tick=Seq, disp=DispF}=T handle_info({refresh, _}, State) -> {noreply, State}; -handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old, time=_Ti} = State) -> +handle_info({active, Node}, #state{parent=Parent, panel=Panel, appmon=Old} = State) -> create_menus(Parent, []), try Node = node(Old), diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index c21d2705c0..db5e6ceb38 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(observer_port_wx). --export([start_link/2]). +-export([start_link/3]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -77,10 +77,10 @@ open_wins=[] }). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). -init([Notebook, Parent]) -> +init([Notebook, Parent, Config]) -> Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), Style = ?wxLC_REPORT bor ?wxLC_HRULES, @@ -110,12 +110,12 @@ init([Notebook, Parent]) -> wxListCtrl:connect(Grid, size, [{skip, true}]), wxWindow:setFocus(Grid), - {Panel, #state{grid=Grid, parent=Parent, panel=Panel, timer={false, 10}}}. + {Panel, #state{grid=Grid, parent=Parent, panel=Panel, timer=Config}}. handle_event(#wx{id=?ID_REFRESH}, State = #state{node=Node, grid=Grid, opt=Opt}) -> Ports0 = get_ports(Node), - Ports = update_grid(Grid, Opt, Ports0), + Ports = update_grid(Grid, sel(State), Opt, Ports0), {noreply, State#state{ports=Ports}}; handle_event(#wx{obj=Obj, event=#wxClose{}}, #state{open_wins=Opened} = State) -> @@ -134,7 +134,7 @@ handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, NewKey -> Opt0#opt{sort_key=NewKey} end, Ports0 = get_ports(Node), - Ports = update_grid(Grid, Opt, Ports0), + Ports = update_grid(Grid, sel(State), Opt, Ports0), wxWindow:setFocus(Grid), {noreply, State#state{opt=Opt, ports=Ports}}; @@ -260,6 +260,9 @@ handle_event(Event, _State) -> handle_sync_event(_Event, _Obj, _State) -> ok. +handle_call(get_config, _, #state{timer=Timer}=State) -> + {reply, observer_lib:timer_config(Timer), State}; + handle_call(Event, From, _State) -> error({unhandled_call, Event, From}). @@ -269,7 +272,7 @@ handle_cast(Event, _State) -> handle_info({portinfo_open, PortIdStr}, State = #state{node=Node, grid=Grid, opt=Opt, open_wins=Opened}) -> Ports0 = get_ports(Node), - Ports = update_grid(Grid, Opt, Ports0), + Ports = update_grid(Grid, sel(State), Opt, Ports0), Port = lists:keyfind(PortIdStr, #port.id_str, Ports), NewOpened = case Port of @@ -288,17 +291,17 @@ handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, %% no change {noreply, State}; Ports0 -> - Ports = update_grid(Grid, Opt, Ports0), + Ports = update_grid(Grid, sel(State), Opt, Ports0), {noreply, State#state{ports=Ports}} end; handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt, timer=Timer0}) -> Ports0 = get_ports(Node), - Ports = update_grid(Grid, Opt, Ports0), + Ports = update_grid(Grid, sel(State), Opt, Ports0), wxWindow:setFocus(Grid), create_menus(Parent), - Timer = observer_lib:start_timer(Timer0), + Timer = observer_lib:start_timer(Timer0, 10), {noreply, State#state{node=Node, ports=Ports, timer=Timer}}; handle_info(not_active, State = #state{timer = Timer0}) -> @@ -511,9 +514,9 @@ filter_monitor_info() -> [Pid || {process, Pid} <- Ms] end. -update_grid(Grid, Opt, Ports) -> - wx:batch(fun() -> update_grid2(Grid, Opt, Ports) end). -update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) -> +update_grid(Grid, Sel, Opt, Ports) -> + wx:batch(fun() -> update_grid2(Grid, Sel, Opt, Ports) end). +update_grid2(Grid, Sel, #opt{sort_key=Sort,sort_incr=Dir}, Ports) -> wxListCtrl:deleteAllItems(Grid), Update = fun(#port{id = Id, @@ -533,6 +536,12 @@ update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) -> observer_lib:to_str(Val)) end, [{0,Id},{1,Connected},{2,Name},{3,Ctrl},{4,Slot}]), + case lists:member(Id, Sel) of + true -> + wxListCtrl:setItemState(Grid, Row, 16#FFFF, ?wxLIST_STATE_SELECTED); + false -> + wxListCtrl:setItemState(Grid, Row, 0, ?wxLIST_STATE_SELECTED) + end, Row + 1 end, PortInfo = case Dir of @@ -542,6 +551,8 @@ update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) -> lists:foldl(Update, 0, PortInfo), PortInfo. +sel(#state{grid=Grid, ports=Ports}) -> + [Id || #port{id=Id} <- get_selected_items(Grid, Ports)]. get_selected_items(Grid, Data) -> get_indecies(get_selected_items(Grid, -1, []), Data). diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index f07b9e295a..3ecf8bdd92 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -20,7 +20,7 @@ -behaviour(wx_object). --export([start_link/2]). +-export([start_link/3]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -86,18 +86,19 @@ right_clicked_pid, holder}). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([Notebook, Parent]) -> +init([Notebook, Parent, Config]) -> Attrs = observer_lib:create_attrs(), Self = self(), - Holder = spawn_link(fun() -> init_table_holder(Self, Attrs) end), - {ProPanel, State} = setup(Notebook, Parent, Holder), + Acc = maps:get(acc, Config, false), + Holder = spawn_link(fun() -> init_table_holder(Self, Acc, Attrs) end), + {ProPanel, State} = setup(Notebook, Parent, Holder, Config), {ProPanel, State#state{holder=Holder}}. -setup(Notebook, Parent, Holder) -> +setup(Notebook, Parent, Holder, Config) -> ProPanel = wxPanel:new(Notebook, []), Grid = create_list_box(ProPanel, Holder), @@ -113,7 +114,7 @@ setup(Notebook, Parent, Holder) -> panel=ProPanel, parent_notebook=Notebook, holder=Holder, - timer={false, 10} + timer=Config }, {ProPanel, State}. @@ -246,7 +247,7 @@ handle_info({active, Node}, #state{holder=Holder, timer=Timer, parent=Parent}=State) -> create_pro_menu(Parent, Holder), Holder ! {change_node, Node}, - {noreply, State#state{timer=observer_lib:start_timer(Timer)}}; + {noreply, State#state{timer=observer_lib:start_timer(Timer, 10)}}; handle_info(not_active, #state{timer=Timer0}=State) -> Timer = observer_lib:stop_timer(Timer0), @@ -264,11 +265,15 @@ terminate(_Reason, #state{holder=Holder}) -> code_change(_, _, State) -> {ok, State}. +handle_call(get_config, _, #state{holder=Holder, timer=Timer}=State) -> + Conf = observer_lib:timer_config(Timer), + Accum = call(Holder, {get_accum, self()}), + {reply, Conf#{acc=>Accum}, State}; + handle_call(Msg, _From, State) -> io:format("~p:~p: Unhandled call ~p~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. - handle_cast(Msg, State) -> io:format("~p:~p: Unhandled cast ~p~n", [?MODULE, ?LINE, Msg]), {noreply, State}. @@ -453,14 +458,19 @@ rm_selected(_, [], [], AccIds, AccPids) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%TABLE HOLDER%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_table_holder(Parent, Attrs) -> +init_table_holder(Parent, Accum0, Attrs) -> Backend = spawn_link(node(), observer_backend,etop_collect,[self()]), + Accum = case Accum0 of + true -> true; + false -> [] + end, table_holder(#holder{parent=Parent, etop=#etop_info{}, info=array:new(), node=node(), backend_pid=Backend, - attrs=Attrs + attrs=Attrs, + accum=Accum }). table_holder(#holder{info=Info, attrs=Attrs, diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl index fa824995f7..2529e79e20 100644 --- a/lib/observer/src/observer_sys_wx.erl +++ b/lib/observer/src/observer_sys_wx.erl @@ -20,7 +20,7 @@ -behaviour(wx_object). --export([start_link/2]). +-export([start_link/3]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, handle_event/2, handle_cast/2]). @@ -41,12 +41,12 @@ fields, timer}). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([Notebook, Parent]) -> +init([Notebook, Parent, Config]) -> SysInfo = observer_backend:sys_info(), {Sys, Mem, Cpu, Stats} = info_fields(), Panel = wxPanel:new(Notebook), @@ -69,7 +69,7 @@ init([Notebook, Parent]) -> wxSizer:add(Sizer, HSizer1, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, {proportion, 0}, {border, 5}]), wxPanel:setSizer(Panel, Sizer), - Timer = observer_lib:start_timer(10), + Timer = observer_lib:start_timer(Config, 10), {Panel, #sys_wx_state{parent=Parent, parent_notebook=Notebook, panel=Panel, sizer=Sizer, @@ -167,6 +167,9 @@ terminate(_Reason, _State) -> code_change(_, _, State) -> {ok, State}. +handle_call(get_config, _, #sys_wx_state{timer=Timer}=State) -> + {reply, observer_lib:timer_config(Timer), State}; + handle_call(Msg, _From, State) -> io:format("~p~p: Unhandled Call ~p~n",[?MODULE, ?LINE, Msg]), {reply, ok, State}. diff --git a/lib/observer/src/observer_trace_wx.erl b/lib/observer/src/observer_trace_wx.erl index af90e2100c..247a4608d5 100644 --- a/lib/observer/src/observer_trace_wx.erl +++ b/lib/observer/src/observer_trace_wx.erl @@ -19,7 +19,7 @@ -module(observer_trace_wx). --export([start_link/2, add_processes/1, add_ports/1]). +-export([start_link/3, add_processes/1, add_ports/1]). -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, handle_event/2, handle_cast/2]). @@ -88,8 +88,8 @@ -record(titem, {id, opts}). -start_link(Notebook, ParentPid) -> - wx_object:start_link(?MODULE, [Notebook, ParentPid], []). +start_link(Notebook, ParentPid, Config) -> + wx_object:start_link(?MODULE, [Notebook, ParentPid, Config], []). add_processes(Pids) when is_list(Pids) -> wx_object:cast(observer_wx:get_tracer(), {add_processes, Pids}). @@ -99,10 +99,10 @@ add_ports(Ports) when is_list(Ports) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([Notebook, ParentPid]) -> - wx:batch(fun() -> create_window(Notebook, ParentPid) end). +init([Notebook, ParentPid, Config]) -> + wx:batch(fun() -> create_window(Notebook, ParentPid, Config) end). -create_window(Notebook, ParentPid) -> +create_window(Notebook, ParentPid, Config) -> %% Create the window Panel = wxPanel:new(Notebook, [{size, wxWindow:getClientSize(Notebook)}]), Sizer = wxBoxSizer:new(?wxVERTICAL), @@ -130,11 +130,16 @@ create_window(Notebook, ParentPid) -> wxSizer:add(Sizer, Buttons, [{flag, ?wxLEFT bor ?wxRIGHT bor ?wxDOWN}, {border, 5}, {proportion,0}]), wxWindow:setSizer(Panel, Sizer), + MS = parse_ms(maps:get(match_specs, Config, []), default_matchspecs()), {Panel, #state{parent=ParentPid, panel=Panel, n_view=NodeView, proc_view=ProcessView, port_view=PortView, m_view=ModView, f_view=FuncView, toggle_button = ToggleButton, - match_specs=default_matchspecs()}}. + output=maps:get(output, Config, []), + def_proc_flags=maps:get(procflags, Config, []), + def_port_flags=maps:get(portflags, Config, []), + match_specs=MS + }}. default_matchspecs() -> [{Key,default_matchspecs(Key)} || Key <- [funcs,send,'receive']]. @@ -397,27 +402,19 @@ handle_event(#wx{id=?LOG_SAVE, userData=TCtrl}, #state{panel=Panel} = State) -> {noreply, State}; handle_event(#wx{id = ?SAVE_TRACEOPTS}, - #state{panel = Panel, - def_proc_flags = ProcFlags, - def_port_flags = PortFlags, - match_specs = MatchSpecs, - tpatterns = TracePatterns, - output = Output - } = State) -> + #state{panel = Panel} = State) -> Dialog = wxFileDialog:new(Panel, [{style, ?wxFD_SAVE bor ?wxFD_OVERWRITE_PROMPT}]), case wxFileDialog:showModal(Dialog) of ?wxID_OK -> Path = wxFileDialog:getPath(Dialog), - write_file(Panel, Path, - ProcFlags, PortFlags, MatchSpecs, Output, - dict:to_list(TracePatterns) - ); + write_file(Panel, Path, get_config(State)); _ -> ok end, wxDialog:destroy(Dialog), {noreply, State}; + handle_event(#wx{id = ?LOAD_TRACEOPTS}, #state{panel = Panel} = State) -> Dialog = wxFileDialog:new(Panel, [{style, ?wxFD_FILE_MUST_EXIST}]), State2 = case wxFileDialog:showModal(Dialog) of @@ -690,6 +687,10 @@ handle_event(#wx{id=ID, event = What}, State) -> {noreply, State}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_call(get_config, _, State) -> + Config0 = get_config(State), + Config = lists:keydelete(trace_p, 1, Config0), + {reply, maps:from_list(Config), State}; handle_call(Msg, From, _State) -> error({unhandled_call, Msg, From}). @@ -1101,26 +1102,38 @@ ftup(Trace, Index, Size) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -write_file(Frame, Filename, ProcFlags, PortFlags, MatchSpecs, Output, TPs) -> +get_config(#state{def_proc_flags = ProcFlags, + def_port_flags = PortFlags, + match_specs = MatchSpecs0, + tpatterns = TracePatterns, + output = Output}) -> MSToList = fun(#match_spec{name=Id, term=T, func=F}) -> [{name,Id},{term,T},{func,F}] end, - MSTermList = [{ms,Key,[MSToList(MS) || MS <- MSs]} || - {Key,MSs} <- MatchSpecs], + MatchSpecs = [{ms,Key,[MSToList(MS) || MS <- MSs]} || + {Key,MSs} <- MatchSpecs0], TPToTuple = fun(#tpattern{fa={F,A}, ms=Ms}) -> - {F,A,MSToList(Ms)} + {F,A,MSToList(Ms)} end, ModuleTermList = [{tp, Module, [TPToTuple(FTP) || FTP <- FTPs]} || - {Module,FTPs} <- TPs], - + {Module,FTPs} <- dict:to_list(TracePatterns)], + [{procflags,ProcFlags}, + {portflags,PortFlags}, + {match_specs,MatchSpecs}, + {output,Output}, + {trace_p,ModuleTermList}]. + +write_file(Frame, Filename, Config) -> Str = ["%%%\n%%% This file is generated by Observer\n", "%%%\n%%% DO NOT EDIT!\n%%%\n", - [io_lib:format("~p.~n",[MSTerm]) || MSTerm <- MSTermList], - io_lib:format("~p.~n",[{procflags,ProcFlags}]), - io_lib:format("~p.~n",[{portflags,PortFlags}]), - io_lib:format("~p.~n",[{output,Output}]), - [io_lib:format("~p.~n",[ModuleTerm]) || ModuleTerm <- ModuleTermList] + [io_lib:format("~p.~n",[MSTerm]) || + MSTerm <- proplists:get_value(match_specs, Config)], + io_lib:format("~p.~n",[lists:keyfind(procflags, 1, Config)]), + io_lib:format("~p.~n",[lists:keyfind(portflags, 1, Config)]), + io_lib:format("~p.~n",[lists:keyfind(output, 1, Config)]), + [io_lib:format("~p.~n",[ModuleTerm]) || + ModuleTerm <- proplists:get_value(trace_p, Config)] ], case file:write_file(Filename, list_to_binary(Str)) of diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 75e6919642..46da65e005 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -233,9 +233,22 @@ handle_event(#wx{id=?ID_REFRESH},State = #state{pid=Pid}) -> {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, - State = #state{pid=Pid}) -> + State = #state{pid=Pid, grid=Grid, selected=OldSel}) -> + SelObj = case OldSel of + undefined -> undefined; + _ -> get_row(Pid, OldSel, term) + end, Pid ! {sort, Col+1}, - {noreply, State}; + case SelObj =/= undefined andalso search(Pid, SelObj, -1, true, term) of + false when is_integer(OldSel) -> + wxListCtrl:setItemState(Grid, OldSel, 0, ?wxLIST_STATE_SELECTED), + {noreply, State#state{selected=undefined}}; + false -> + {noreply, State#state{selected=undefined}}; + Row -> + wxListCtrl:setItemState(Grid, Row, 16#FFFF, ?wxLIST_STATE_SELECTED), + {noreply, State#state{selected=Row}} + end; handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> observer_lib:set_listctrl_col_size(Grid, W), @@ -607,6 +620,17 @@ keysort(Col, Table) -> end, lists:sort(Sort, Table). +search([Term, -1, true, term], S=#holder{parent=Parent, table=Table}) -> + Search = fun(Idx, [Tuple|_]) -> + Tuple =:= Term andalso throw(Idx), + Tuple + end, + try array:map(Search, Table) of + _ -> Parent ! {self(), false} + catch Index -> + Parent ! {self(), Index} + end, + S; search([Str, Row, Dir0, CaseSens], S=#holder{parent=Parent, n=N, table=Table}) -> Opt = case CaseSens of @@ -642,6 +666,8 @@ get_row(From, Row, Col, Table) -> From ! {self(), format(Object)}; [Object|_] when Col =:= all_multiline -> From ! {self(), io_lib:format("~p", [Object])}; + [Object|_] when Col =:= term -> + From ! {self(), Object}; [Object|_] when tuple_size(Object) >= Col -> From ! {self(), format(element(Col, Object))}; _ -> diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index d04fb839c8..e112c54534 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% -module(observer_tv_wx). --export([start_link/2, display_table_info/4]). +-export([start_link/3, display_table_info/4]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -58,10 +58,10 @@ timer }). -start_link(Notebook, Parent) -> - wx_object:start_link(?MODULE, [Notebook, Parent], []). +start_link(Notebook, Parent, Config) -> + wx_object:start_link(?MODULE, [Notebook, Parent, Config], []). -init([Notebook, Parent]) -> +init([Notebook, Parent, Config]) -> Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, @@ -94,25 +94,31 @@ init([Notebook, Parent]) -> wxListCtrl:connect(Grid, size, [{skip, true}]), wxWindow:setFocus(Grid), - {Panel, #state{grid=Grid, parent=Parent, panel=Panel, timer={false, 10}}}. + {Panel, #state{grid=Grid, parent=Parent, panel=Panel, + timer=Config, + opt=#opt{type=maps:get(type, Config, ets), + sys_hidden=maps:get(sys_hidden, Config, true), + unread_hidden=maps:get(unread_hidden, Config, true)} + }}. handle_event(#wx{id=?ID_REFRESH}, State = #state{node=Node, grid=Grid, opt=Opt}) -> Tables = get_tables(Node, Opt), - Tabs = update_grid(Grid, Opt, Tables), - {noreply, State#state{tabs=Tabs}}; + {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), + Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), + {noreply, State#state{tabs=Tabs, selected=Sel}}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, State = #state{node=Node, grid=Grid, opt=Opt0=#opt{sort_key=Key, sort_incr=Bool}}) -> - Opt = case Col+2 of + Opt = case col2key(Col) of Key -> Opt0#opt{sort_incr=not Bool}; NewKey -> Opt0#opt{sort_key=NewKey} end, Tables = get_tables(Node, Opt), - Tabs = update_grid(Grid, Opt, Tables), + {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs}}; + {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}}; handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) when Id >= ?ID_ETS, Id =< ?ID_SYSTEM_TABLES -> @@ -129,9 +135,9 @@ handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) self() ! Error, {noreply, State}; Tables -> - Tabs = update_grid(Grid, Opt, Tables), + {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs}} + {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}} end; handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> @@ -202,6 +208,12 @@ handle_event(Event, _State) -> handle_sync_event(_Event, _Obj, _State) -> ok. +handle_call(get_config, _, #state{timer=Timer, opt=Opt}=State) -> + #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, + Conf0 = observer_lib:timer_config(Timer), + Conf = Conf0#{type=>Type, sys_hidden=>Sys, unread_hidden=>Unread}, + {reply, Conf, State}; + handle_call(Event, From, _State) -> error({unhandled_call, Event, From}). @@ -215,8 +227,9 @@ handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, %% no change {noreply, State}; Tables -> - Tabs = update_grid(Grid, Opt, Tables), - {noreply, State#state{tabs=Tabs}} + {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), + Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), + {noreply, State#state{tabs=Tabs, selected=Sel}} end; handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt0, @@ -228,11 +241,11 @@ handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt0, Opt1 = Opt0#opt{type=ets}, {get_tables(Node, Opt1), Opt1} end, - Tabs = update_grid(Grid, Opt, Tables), + {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), wxWindow:setFocus(Grid), create_menus(Parent, Opt), - Timer = observer_lib:start_timer(Timer0), - {noreply, State#state{node=Node, tabs=Tabs, timer=Timer, opt=Opt}}; + Timer = observer_lib:start_timer(Timer0, 10), + {noreply, State#state{node=Node, tabs=Tabs, timer=Timer, opt=Opt, selected=Sel}}; handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), @@ -296,6 +309,13 @@ get_tables2(Node, #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> [list_to_tabrec(Tab) || Tab <- Result] end. +col2key(0) -> #tab.name; +col2key(1) -> #tab.size; +col2key(2) -> #tab.memory; +col2key(3) -> #tab.owner; +col2key(4) -> #tab.reg_name; +col2key(5) -> #tab.id. + list_to_tabrec(PL) -> #tab{name = proplists:get_value(name, PL), id = proplists:get_value(id, PL, ignore), @@ -366,13 +386,15 @@ list_to_strings([A]) -> integer_to_list(A); list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). -update_grid(Grid, Opt, Tables) -> - wx:batch(fun() -> update_grid2(Grid, Opt, Tables) end). -update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> +update_grid(Grid, Selected, Opt, Tables) -> + wx:batch(fun() -> update_grid2(Grid, Selected, Opt, Tables) end). + +update_grid2(Grid, {SelName,SelId}, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> wxListCtrl:deleteAllItems(Grid), Update = fun(#tab{name = Name, id = Id, owner = Owner, size = Size, memory = Memory, - protection = Protection, reg_name = RegName}, Row) -> + protection = Protection, reg_name = RegName}, + {Row, Sel}) -> _Item = wxListCtrl:insertItem(Grid, Row, ""), if (Row rem 2) =:= 0 -> wxListCtrl:setItemBackgroundColour(Grid, Row, ?BG_EVEN); @@ -389,11 +411,24 @@ update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> end, [{0,Name}, {1,Size}, {2, Memory div 1024}, {3,Owner}, {4,RegName}, {5,Id}]), - Row + 1 + if SelName =:= Name, SelId =:= Id -> + wxListCtrl:setItemState(Grid, Row, 16#FFFF, ?wxLIST_STATE_SELECTED), + {Row+1, Row}; + true -> + wxListCtrl:setItemState(Grid, Row, 0, ?wxLIST_STATE_SELECTED), + {Row+1, Sel} + end end, ProcInfo = case Dir of false -> lists:reverse(lists:keysort(Sort, Tables)); true -> lists:keysort(Sort, Tables) end, - lists:foldl(Update, 0, ProcInfo), - ProcInfo. + {_, Sel} = lists:foldl(Update, {0, undefined}, ProcInfo), + {ProcInfo, Sel}. + +sel(#state{selected=Sel, tabs=Tabs}) -> + try lists:nth(Sel+1, Tabs) of + #tab{name=Name, id=Id} -> {Name, Id} + catch _:_ -> + {undefined, undefined} + end. diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 83de4fa64c..0a591babdd 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -54,20 +54,14 @@ status_bar, notebook, main_panel, - pro_panel, - port_panel, - tv_panel, - sys_panel, - trace_panel, - app_panel, - perf_panel, - allc_panel, + panels, active_tab, node, nodes, prev_node="", log = false, - reply_to=false + reply_to=false, + config }). start() -> @@ -118,6 +112,10 @@ init(_Args) -> setup(#state{frame = Frame} = State) -> %% Setup Menubar & Menus + Config = load_config(), + Cnf = fun(Who) -> + proplists:get_value(Who, Config, #{}) + end, MenuBar = wxMenuBar:new(), {Nodes, NodeMenus} = get_nodes(), @@ -131,7 +129,7 @@ setup(#state{frame = Frame} = State) -> Notebook = wxNotebook:new(Panel, ?ID_NOTEBOOK, [{style, ?wxBK_DEFAULT}]), %% System Panel - SysPanel = observer_sys_wx:start_link(Notebook, self()), + SysPanel = observer_sys_wx:start_link(Notebook, self(), Cnf(sys_panel)), wxNotebook:addPage(Notebook, SysPanel, "System", []), %% Setup sizer create early to get it when window shows @@ -145,43 +143,44 @@ setup(#state{frame = Frame} = State) -> wxFrame:setTitle(Frame, atom_to_list(node())), wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), - wxNotebook:connect(Notebook, command_notebook_page_changing), - wxFrame:connect(Frame, close_window, [{skip, true}]), + wxNotebook:connect(Notebook, command_notebook_page_changed, [{skip, true}]), + wxFrame:connect(Frame, close_window, []), wxMenu:connect(Frame, command_menu_selected), wxFrame:show(Frame), %% Freeze and thaw is buggy currently - DoFreeze = [?wxMAJOR_VERSION,?wxMINOR_VERSION] < [2,9], + DoFreeze = [?wxMAJOR_VERSION,?wxMINOR_VERSION] < [2,9] + orelse element(1, os:type()) =:= win32, DoFreeze andalso wxWindow:freeze(Panel), %% I postpone the creation of the other tabs so they can query/use %% the window size %% Perf Viewer Panel - PerfPanel = observer_perf_wx:start_link(Notebook, self()), + PerfPanel = observer_perf_wx:start_link(Notebook, self(), Cnf(perf_panel)), wxNotebook:addPage(Notebook, PerfPanel, "Load Charts", []), %% Memory Allocator Viewer Panel - AllcPanel = observer_alloc_wx:start_link(Notebook, self()), + AllcPanel = observer_alloc_wx:start_link(Notebook, self(), Cnf(allc_panel)), wxNotebook:addPage(Notebook, AllcPanel, ?ALLOC_STR, []), %% App Viewer Panel - AppPanel = observer_app_wx:start_link(Notebook, self()), + AppPanel = observer_app_wx:start_link(Notebook, self(), Cnf(app_panel)), wxNotebook:addPage(Notebook, AppPanel, "Applications", []), %% Process Panel - ProPanel = observer_pro_wx:start_link(Notebook, self()), + ProPanel = observer_pro_wx:start_link(Notebook, self(), Cnf(pro_panel)), wxNotebook:addPage(Notebook, ProPanel, "Processes", []), %% Port Panel - PortPanel = observer_port_wx:start_link(Notebook, self()), + PortPanel = observer_port_wx:start_link(Notebook, self(), Cnf(port_panel)), wxNotebook:addPage(Notebook, PortPanel, "Ports", []), %% Table Viewer Panel - TVPanel = observer_tv_wx:start_link(Notebook, self()), + TVPanel = observer_tv_wx:start_link(Notebook, self(), Cnf(tv_panel)), wxNotebook:addPage(Notebook, TVPanel, "Table Viewer", []), %% Trace Viewer Panel - TracePanel = observer_trace_wx:start_link(Notebook, self()), + TracePanel = observer_trace_wx:start_link(Notebook, self(), Cnf(trace_panel)), wxNotebook:addPage(Notebook, TracePanel, ?TRACE_STR, []), %% Force redraw (windows needs it) @@ -193,19 +192,21 @@ setup(#state{frame = Frame} = State) -> SysPid = wx_object:get_pid(SysPanel), SysPid ! {active, node()}, + Panels = [{sys_panel, SysPanel, "System"}, %% In order + {perf_panel, PerfPanel, "Load Charts"}, + {allc_panel, AllcPanel, ?ALLOC_STR}, + {app_panel, AppPanel, "Applications"}, + {pro_panel, ProPanel, "Processes"}, + {port_panel, PortPanel, "Ports"}, + {tv_panel, TVPanel, "Table Viewer"}, + {trace_panel, TracePanel, ?TRACE_STR}], + UpdState = State#state{main_panel = Panel, notebook = Notebook, menubar = MenuBar, status_bar = StatusBar, - sys_panel = SysPanel, - pro_panel = ProPanel, - port_panel = PortPanel, - tv_panel = TVPanel, - trace_panel = TracePanel, - app_panel = AppPanel, - perf_panel = PerfPanel, - allc_panel = AllcPanel, active_tab = SysPid, + panels = Panels, node = node(), nodes = Nodes }, @@ -228,10 +229,12 @@ setup(#state{frame = Frame} = State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%Callbacks -handle_event(#wx{event=#wxNotebook{type=command_notebook_page_changing}}, - #state{active_tab=Previous, node=Node} = State) -> - case get_active_pid(State) of - Previous -> {noreply, State}; +handle_event(#wx{event=#wxNotebook{type=command_notebook_page_changed, nSel=Next}}, + #state{active_tab=Previous, node=Node, panels=Panels} = State) -> + {_, Obj, _} = lists:nth(Next+1, Panels), + case wx_object:get_pid(Obj) of + Previous -> + {noreply, State}; Pid -> Previous ! not_active, Pid ! {active, Node}, @@ -362,8 +365,7 @@ handle_event(#wx{id = Id, event = #wxCommand{type = command_menu_selected}}, end, {noreply, change_node_view(Node, LState)}; -handle_event(Event, State) -> - Pid = get_active_pid(State), +handle_event(Event, #state{active_tab=Pid} = State) -> Pid ! Event, {noreply, State}. @@ -388,7 +390,8 @@ handle_call({create_menus, TabMenus}, _From, handle_call({get_attrib, Attrib}, _From, State) -> {reply, get(Attrib), State}; -handle_call(get_tracer, _From, State=#state{trace_panel=TraceP}) -> +handle_call(get_tracer, _From, State=#state{panels=Panels}) -> + {_, TraceP, _} = lists:keyfind(trace_panel, 1, Panels), {reply, TraceP, State}; handle_call(get_active_node, _From, State=#state{node=Node}) -> @@ -424,9 +427,7 @@ handle_info({nodedown, Node}, create_txt_dialog(Frame, Msg, "Node down", ?wxICON_EXCLAMATION), {noreply, State3}; -handle_info({open_link, Id0}, State = #state{pro_panel=ProcViewer, - port_panel=PortViewer, - frame=Frame}) -> +handle_info({open_link, Id0}, State = #state{panels=Panels,frame=Frame}) -> Id = case Id0 of [_|_] -> try list_to_pid(Id0) catch _:_ -> Id0 end; _ -> Id0 @@ -434,8 +435,10 @@ handle_info({open_link, Id0}, State = #state{pro_panel=ProcViewer, %% Forward to process tab case Id of Pid when is_pid(Pid) -> + {pro_panel, ProcViewer, _} = lists:keyfind(pro_panel, 1, Panels), wx_object:get_pid(ProcViewer) ! {procinfo_open, Pid}; "#Port" ++ _ = Port -> + {port_panel, PortViewer, _} = lists:keyfind(port_panel, 1, Panels), wx_object:get_pid(PortViewer) ! {portinfo_open, Port}; _ -> Msg = io_lib:format("Information about ~p is not available or implemented",[Id]), @@ -465,15 +468,13 @@ handle_info({stop, Me}, State) when Me =:= self() -> handle_info(_Info, State) -> {noreply, State}. -stop_servers(#state{node=Node, log=LogOn, sys_panel=Sys, pro_panel=Procs, tv_panel=TVs, - trace_panel=Trace, app_panel=Apps, perf_panel=Perfs, - allc_panel=Alloc, port_panel=Ports} = _State) -> +stop_servers(#state{node=Node, log=LogOn, panels=Panels} = _State) -> LogOn andalso rpc:block_call(Node, rb, stop, []), Me = self(), - Tabs = [Sys, Procs, Ports, TVs, Trace, Apps, Perfs, Alloc], + save_config(Panels), Stop = fun() -> try - _ = [wx_object:stop(Panel) || Panel <- Tabs], + _ = [wx_object:stop(Panel) || {_, Panel, _} <- Panels], ok catch _:_ -> ok end, @@ -490,6 +491,27 @@ terminate(_Reason, #state{frame = Frame, reply_to=From}) -> end, ok. +load_config() -> + case file:consult(config_file()) of + {ok, Config} -> Config; + _ -> [] + end. + +save_config(Panels) -> + Configs = [{Name, wx_object:call(Panel, get_config)} || {Name, Panel, _} <- Panels], + File = config_file(), + case filelib:ensure_dir(File) of + ok -> + Format = [io_lib:format("~p.~n",[Conf]) || Conf <- Configs], + _ = file:write_file(File, Format); + _ -> + ignore + end. + +config_file() -> + Dir = filename:basedir(user_config, "erl_observer"), + filename:join(Dir, "config.txt"). + code_change(_, _, State) -> {ok, State}. @@ -549,8 +571,7 @@ connect2(NodeName, Opts, Cookie) -> {error, net_kernel, Reason} end. -change_node_view(Node, State) -> - Tab = get_active_pid(State), +change_node_view(Node, #state{active_tab=Tab} = State) -> Tab ! not_active, Tab ! {active, Node}, StatusText = ["Observer - " | atom_to_list(Node)], @@ -562,38 +583,13 @@ check_page_title(Notebook) -> Selection = wxNotebook:getSelection(Notebook), wxNotebook:getPageText(Notebook, Selection). -get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys, - tv_panel=Tv, trace_panel=Trace, app_panel=App, - perf_panel=Perf, allc_panel=Alloc, port_panel=Port - }) -> - Panel = case check_page_title(Notebook) of - "Processes" -> Pro; - "Ports" -> Port; - "System" -> Sys; - "Table Viewer" -> Tv; - ?TRACE_STR -> Trace; - "Load Charts" -> Perf; - "Applications" -> App; - ?ALLOC_STR -> Alloc - end, - wx_object:get_pid(Panel). - -pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys, - tv_panel=Tv, trace_panel=Trace, app_panel=App, - perf_panel=Perf, allc_panel=Alloc, port_panel=Port}) -> - case Pid of - Pro -> "Processes"; - Port -> "Ports"; - Sys -> "System"; - Tv -> "Table Viewer" ; - Trace -> ?TRACE_STR; - Perf -> "Load Charts"; - App -> "Applications"; - Alloc -> ?ALLOC_STR; - _ -> "unknown" +pid2panel(Pid, #state{panels=Panels}) -> + PanelPids = [{Name, wx_object:get_pid(Obj)} || {Name, Obj, _} <- Panels], + case lists:keyfind(Pid, 2, PanelPids) of + false -> "unknown"; + {Name,_} -> Name end. - create_connect_dialog(ping, #state{frame = Frame, prev_node=Prev}) -> Dialog = wxTextEntryDialog:new(Frame, "Connect to node", [{value, Prev}]), case wxDialog:showModal(Dialog) of diff --git a/lib/parsetools/doc/src/leex.xml b/lib/parsetools/doc/src/leex.xml index 29d546105f..1227625287 100644 --- a/lib/parsetools/doc/src/leex.xml +++ b/lib/parsetools/doc/src/leex.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2009</year><year>2016</year> + <year>2009</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -446,7 +446,8 @@ D = [0-9] </item> </taglist> - <p>The following examples define Erlang data types:</p> + <p>The following examples define simplified versions of a few + Erlang data types:</p> <code> Atoms [a-z][0-9a-zA-Z_]* diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index e0f37ae9df..e2e7d7359f 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -1548,22 +1548,23 @@ out_action_code(File, XrlFile, {_A,Code,_Vars,Name,Args,ArgsChars}) -> L = erl_scan:line(hd(Code)), output_file_directive(File, XrlFile, L-2), io:fwrite(File, "~s(~s) ->~n", [Name, ArgsChars]), - io:fwrite(File, " ~s\n", [pp_tokens(Code, L)]). + io:fwrite(File, " ~ts\n", [pp_tokens(Code, L, File)]). -%% pp_tokens(Tokens, Line) -> [char()]. +%% pp_tokens(Tokens, Line, File) -> [char()]. %% Prints the tokens keeping the line breaks of the original code. -pp_tokens(Tokens, Line0) -> pp_tokens(Tokens, Line0, none). +pp_tokens(Tokens, Line0, File) -> pp_tokens(Tokens, Line0, File, none). -pp_tokens([], _Line0, _) -> []; -pp_tokens([T | Ts], Line0, Prev) -> +pp_tokens([], _Line0, _, _) -> []; +pp_tokens([T | Ts], Line0, File, Prev) -> Line = erl_scan:line(T), - [pp_sep(Line, Line0, Prev, T), pp_symbol(T) | pp_tokens(Ts, Line, T)]. + [pp_sep(Line, Line0, Prev, T), + pp_symbol(T, File) | pp_tokens(Ts, Line, File, T)]. -pp_symbol({var,_,Var}) -> atom_to_list(Var); -pp_symbol({_,_,Symbol}) -> io_lib:fwrite("~p", [Symbol]); -pp_symbol({dot, _}) -> "."; -pp_symbol({Symbol, _}) -> atom_to_list(Symbol). +pp_symbol({var,_,Var}, _) -> atom_to_list(Var); +pp_symbol({_,_,Symbol}, File) -> format_symbol(Symbol, File); +pp_symbol({dot, _}, _) -> "."; +pp_symbol({Symbol, _}, _) -> atom_to_list(Symbol). pp_sep(Line, Line0, Prev, T) when Line > Line0 -> ["\n " | pp_sep(Line - 1, Line0, Prev, T)]; @@ -1622,17 +1623,17 @@ out_dfa_edges(File, DFA) -> end, orddict:new(), Pt), foreach(fun (T) -> Crs = orddict:fetch(T, Tdict), - Edgelab = dfa_edgelabel(Crs), + Edgelab = dfa_edgelabel(Crs, File), io:fwrite(File, " ~b -> ~b [label=\"~ts\"];~n", [S,T,Edgelab]) end, sort(orddict:fetch_keys(Tdict))) end, DFA). -dfa_edgelabel([C]) when is_integer(C) -> quote(C); -dfa_edgelabel(Cranges) -> +dfa_edgelabel([C], File) when is_integer(C) -> quote(C, File); +dfa_edgelabel(Cranges, File) -> %% io:fwrite("el: ~p\n", [Cranges]), - "[" ++ map(fun ({A,B}) -> [quote(A), "-", quote(B)]; - (C) -> [quote(C)] + "[" ++ map(fun ({A,B}) -> [quote(A, File), "-", quote(B, File)]; + (C) -> [quote(C, File)] end, Cranges) ++ "]". set_encoding(#leex{encoding = none}, File) -> @@ -1651,33 +1652,50 @@ output_file_directive(File, Filename, Line) -> format_filename(Filename0, File) -> Filename = filename:flatten(Filename0), + case enc(File) of + unicode -> io_lib:write_string(Filename); + latin1 -> io_lib:write_string_as_latin1(Filename) + end. + +format_symbol(Symbol, File) -> + Format = case enc(File) of + latin1 -> "~p"; + unicode -> "~tp" + end, + io_lib:fwrite(Format, [Symbol]). + +enc(File) -> case lists:keyfind(encoding, 1, io:getopts(File)) of - {encoding, unicode} -> io_lib:write_string(Filename); - _ -> io_lib:write_string_as_latin1(Filename) + false -> latin1; % should never happen + {encoding, Enc} -> Enc end. -quote($^) -> "\\^"; -quote($.) -> "\\."; -quote($$) -> "\\$"; -quote($-) -> "\\-"; -quote($[) -> "\\["; -quote($]) -> "\\]"; -quote($\s) -> "\\\\s"; -quote($\") -> "\\\""; -quote($\b) -> "\\\\b"; -quote($\f) -> "\\\\f"; -quote($\n) -> "\\\\n"; -quote($\r) -> "\\\\r"; -quote($\t) -> "\\\\t"; -quote($\e) -> "\\\\e"; -quote($\v) -> "\\\\v"; -quote($\d) -> "\\\\d"; -quote($\\) -> "\\\\"; -quote(C) when is_integer(C) -> +quote($^, _File) -> "\\^"; +quote($., _File) -> "\\."; +quote($$, _File) -> "\\$"; +quote($-, _File) -> "\\-"; +quote($[, _File) -> "\\["; +quote($], _File) -> "\\]"; +quote($\s, _File) -> "\\\\s"; +quote($\", _File) -> "\\\""; +quote($\b, _File) -> "\\\\b"; +quote($\f, _File) -> "\\\\f"; +quote($\n, _File) -> "\\\\n"; +quote($\r, _File) -> "\\\\r"; +quote($\t, _File) -> "\\\\t"; +quote($\e, _File) -> "\\\\e"; +quote($\v, _File) -> "\\\\v"; +quote($\d, _File) -> "\\\\d"; +quote($\\, _File) -> "\\\\"; +quote(C, File) when is_integer(C) -> %% Must remove the $ and get the \'s right. - case io_lib:write_char(C) of + S = case enc(File) of + unicode -> io_lib:write_char(C); + latin1 -> io_lib:write_char_as_latin1(C) + end, + case S of [$$,$\\|Cs] -> "\\\\" ++ Cs; [$$|Cs] -> Cs end; -quote(maxchar) -> +quote(maxchar, _File) -> "MAXCHAR". diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 05446c1a85..48559ec402 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -154,13 +154,13 @@ compile(Input0, Output0, format_error(bad_declaration) -> io_lib:fwrite("unknown or bad declaration, ignored", []); format_error({bad_expect, SymName}) -> - io_lib:fwrite("argument ~s of Expect is not an integer", + io_lib:fwrite("argument ~ts of Expect is not an integer", [format_symbol(SymName)]); format_error({bad_rootsymbol, SymName}) -> - io_lib:fwrite("rootsymbol ~s is not a nonterminal", + io_lib:fwrite("rootsymbol ~ts is not a nonterminal", [format_symbol(SymName)]); format_error({bad_states, SymName}) -> - io_lib:fwrite("argument ~s of States is not an integer", + io_lib:fwrite("argument ~ts of States is not an integer", [format_symbol(SymName)]); format_error({conflict, Conflict}) -> format_conflict(Conflict); @@ -169,19 +169,19 @@ format_error({conflicts, SR, RR}) -> format_error({duplicate_declaration, Tag}) -> io_lib:fwrite("duplicate declaration of ~s", [atom_to_list(Tag)]); format_error({duplicate_nonterminal, Nonterminal}) -> - io_lib:fwrite("duplicate non-terminals ~s", + io_lib:fwrite("duplicate non-terminals ~ts", [format_symbol(Nonterminal)]); format_error({duplicate_precedence, Op}) -> - io_lib:fwrite("duplicate precedence operator ~s", + io_lib:fwrite("duplicate precedence operator ~ts", [format_symbol(Op)]); format_error({duplicate_terminal, Terminal}) -> - io_lib:fwrite("duplicate terminal ~s", + io_lib:fwrite("duplicate terminal ~ts", [format_symbol(Terminal)]); format_error({endsymbol_is_nonterminal, Symbol}) -> - io_lib:fwrite("endsymbol ~s is a nonterminal", + io_lib:fwrite("endsymbol ~ts is a nonterminal", [format_symbol(Symbol)]); format_error({endsymbol_is_terminal, Symbol}) -> - io_lib:fwrite("endsymbol ~s is a terminal", + io_lib:fwrite("endsymbol ~ts is a terminal", [format_symbol(Symbol)]); format_error({error, Module, Error}) -> Module:format_error(Error); @@ -192,7 +192,7 @@ format_error(illegal_empty) -> format_error({internal_error, Error}) -> io_lib:fwrite("internal yecc error: ~w", [Error]); format_error({missing_syntax_rule, Nonterminal}) -> - io_lib:fwrite("no syntax rule for non-terminal symbol ~s", + io_lib:fwrite("no syntax rule for non-terminal symbol ~ts", [format_symbol(Nonterminal)]); format_error({n_states, Exp, N}) -> io_lib:fwrite("expected ~w states, but got ~p states", [Exp, N]); @@ -201,31 +201,31 @@ format_error(no_grammar_rules) -> format_error(nonterminals_missing) -> io_lib:fwrite("Nonterminals is missing", []); format_error({precedence_op_is_endsymbol, SymName}) -> - io_lib:fwrite("precedence operator ~s is endsymbol", + io_lib:fwrite("precedence operator ~ts is endsymbol", [format_symbol(SymName)]); format_error({precedence_op_is_unknown, SymName}) -> - io_lib:fwrite("unknown precedence operator ~s", + io_lib:fwrite("unknown precedence operator ~ts", [format_symbol(SymName)]); format_error({reserved, N}) -> io_lib:fwrite("the use of ~w should be avoided", [N]); format_error({symbol_terminal_and_nonterminal, SymName}) -> - io_lib:fwrite("symbol ~s is both a terminal and nonterminal", + io_lib:fwrite("symbol ~ts is both a terminal and nonterminal", [format_symbol(SymName)]); format_error(rootsymbol_missing) -> io_lib:fwrite("Rootsymbol is missing", []); format_error(terminals_missing) -> io_lib:fwrite("Terminals is missing", []); format_error({undefined_nonterminal, Symbol}) -> - io_lib:fwrite("undefined nonterminal: ~s", [format_symbol(Symbol)]); + io_lib:fwrite("undefined nonterminal: ~ts", [format_symbol(Symbol)]); format_error({undefined_pseudo_variable, Atom}) -> io_lib:fwrite("undefined pseudo variable ~w", [Atom]); format_error({undefined_symbol, SymName}) -> - io_lib:fwrite("undefined rhs symbol ~s", [format_symbol(SymName)]); + io_lib:fwrite("undefined rhs symbol ~ts", [format_symbol(SymName)]); format_error({unused_nonterminal, Nonterminal}) -> - io_lib:fwrite("non-terminal symbol ~s not used", + io_lib:fwrite("non-terminal symbol ~ts not used", [format_symbol(Nonterminal)]); format_error({unused_terminal, Terminal}) -> - io_lib:fwrite("terminal symbol ~s not used", + io_lib:fwrite("terminal symbol ~ts not used", [format_symbol(Terminal)]); format_error({bad_symbol, String}) -> io_lib:fwrite("bad symbol ~ts", [String]); @@ -1809,9 +1809,9 @@ report_conflict(Conflict, St, ActionName, How) -> Formated = format_symbol(ActionName), case How of prec -> - io:fwrite(<<"Resolved in favor of ~s.\n\n">>, [Formated]); + io:fwrite(<<"Resolved in favor of ~ts.\n\n">>, [Formated]); default -> - io:fwrite(<<"Conflict resolved in favor of ~s.\n\n">>, + io:fwrite(<<"Conflict resolved in favor of ~ts.\n\n">>, [Formated]) end; true -> @@ -1856,7 +1856,7 @@ format_conflict({Symbol, N, _, {one_level_up, {L1, RuleN1, {P1, Ass1}}, {L2, RuleN2, {P2, Ass2}}}}) -> S1 = io_lib:fwrite(<<"Conflicting precedences of symbols when " - "scanning ~s in state ~w:\n">>, + "scanning ~ts in state ~w:\n">>, [format_symbol(Symbol), N]), S2 = io_lib:fwrite(<<" ~s ~w (rule ~w at line ~w)\n" " vs.\n">>, @@ -1866,26 +1866,26 @@ format_conflict({Symbol, N, _, {one_level_up, [S1, S2, S3]; format_conflict({Symbol, N, Reduce, Confl}) -> S1 = io_lib:fwrite(<<"Parse action conflict scanning symbol " - "~s in state ~w:\n">>, [format_symbol(Symbol), N]), + "~ts in state ~w:\n">>, [format_symbol(Symbol), N]), S2 = case Reduce of {[HR | TR], RuleNmbr, RuleLine} -> - io_lib:fwrite(<<" Reduce to ~s from ~s (rule ~w at " + io_lib:fwrite(<<" Reduce to ~ts from ~ts (rule ~w at " "line ~w)\n vs.\n">>, [format_symbol(HR), format_symbols(TR), RuleNmbr, RuleLine]) end, S3 = case Confl of {reduce, [HR2|TR2], RuleNmbr2, RuleLine2} -> - io_lib:fwrite(<<" reduce to ~s from ~s " + io_lib:fwrite(<<" reduce to ~ts from ~ts " "(rule ~w at line ~w).">>, [format_symbol(HR2), format_symbols(TR2), RuleNmbr2, RuleLine2]); {shift, NewState, Sym} -> io_lib:fwrite(<<" shift to state ~w, adding right " - "sisters to ~s.">>, + "sisters to ~ts.">>, [NewState, format_symbol(Sym)]); {accept, Rootsymbol} -> - io_lib:fwrite(<<" reduce to rootsymbol ~s.">>, + io_lib:fwrite(<<" reduce to rootsymbol ~ts.">>, [format_symbol(Rootsymbol)]) end, [S1, S2, S3]. @@ -1926,8 +1926,9 @@ format_conflict({Symbol, N, Reduce, Confl}) -> -define(CODE_VERSION, "1.4"). -define(YECC_BUG(M, A), - iolist_to_binary([" erlang:error({yecc_bug,\"",?CODE_VERSION,"\",", - io_lib:fwrite(M, A), "}).\n\n"])). + unicode:characters_to_binary( + [" erlang:error({yecc_bug,\"",?CODE_VERSION,"\",", + io_lib:fwrite(M, A), "}).\n\n"])). %% Returns number of newlines in included files. output_prelude(Outport, Inport, St0) when St0#yecc.includefile =:= [] -> @@ -1980,7 +1981,7 @@ output_header(St0) -> output_goto(St, [{_Nonterminal, []} | Go], StateInfo) -> output_goto(St, Go, StateInfo); output_goto(St0, [{Nonterminal, List} | Go], StateInfo) -> - F = function_name(yeccgoto, Nonterminal), + F = function_name(St0, yeccgoto, Nonterminal), St05 = fwrite(St0, <<"-dialyzer({nowarn_function, ~w/7}).\n">>, [F]), St10 = output_goto1(St05, List, F, StateInfo, true), St = output_goto_fini(F, Nonterminal, St10), @@ -2018,7 +2019,8 @@ output_goto_fini(F, NT, #yecc{includefile_version = {1,1}}=St0) -> St = fwrite(St10, <<"~w(State, _Cat, _Ss, _Stack, _T, _Ts, _Tzr) ->\n">>, [F]), fwrite(St, - ?YECC_BUG(<<"{~w, State, missing_in_goto_table}">>, [NT]), + ?YECC_BUG(<<"{~ts, State, missing_in_goto_table}">>, + [quoted_atom(St0, NT)]), []); output_goto_fini(_F, _NT, St) -> fwrite(St, <<".\n\n">>, []). @@ -2027,7 +2029,7 @@ output_goto_fini(_F, _NT, St) -> find_user_code(ParseActions, St) -> [#user_code{state = State, terminal = Terminal, - funname = inlined_function_name(State, Terminal), + funname = inlined_function_name(St, State, Terminal), action = Action} || {State, La_actions} <- ParseActions, {Action, Terminals, RuleNmbr, NmbrOfDaughters} @@ -2148,14 +2150,14 @@ output_action(St, State, Terminal, #reduce{}=Action, IsFirst, SI) -> output_reduce(St, State, Terminal, Action, IsFirst, SI); output_action(St0, State, Terminal, #shift{state = NewState}, IsFirst, _SI) -> St10 = delim(St0, IsFirst), - St = fwrite(St10, <<"yeccpars2_~w(S, ~s, Ss, Stack, T, Ts, Tzr) ->\n">>, - [State, quoted_atom(Terminal)]), + St = fwrite(St10, <<"yeccpars2_~w(S, ~ts, Ss, Stack, T, Ts, Tzr) ->\n">>, + [State, quoted_atom(St10, Terminal)]), output_call_to_includefile(NewState, St); output_action(St0, State, Terminal, accept, IsFirst, _SI) -> St10 = delim(St0, IsFirst), St = fwrite(St10, - <<"yeccpars2_~w(_S, ~s, _Ss, Stack, _T, _Ts, _Tzr) ->\n">>, - [State, quoted_atom(Terminal)]), + <<"yeccpars2_~w(_S, ~ts, _Ss, Stack, _T, _Ts, _Tzr) ->\n">>, + [State, quoted_atom(St10, Terminal)]), fwrite(St, <<" {ok, hd(Stack)}">>, []); output_action(St, _State, _Terminal, nonassoc, _IsFirst, _SI) -> St. @@ -2174,19 +2176,19 @@ output_state_actions_fini(State, IsFirst, St0) -> St = fwrite(St10, <<"yeccpars2_~w(_, _, _, _, T, _, _) ->\n">>, [State]), fwrite(St, <<" yeccerror(T).\n\n">>, []). -output_reduce(St0, State, Terminal0, +output_reduce(St0, State, Terminal, #reduce{rule_nmbr = RuleNmbr, head = Head, nmbr_of_daughters = NmbrOfDaughters}, IsFirst, StateInfo) -> St10 = delim(St0, IsFirst), - Terminal = if - is_atom(Terminal0) -> quoted_atom(Terminal0); - true -> Terminal0 - end, + QuotedTerminal = if + is_atom(Terminal) -> quoted_atom(St10, Terminal); + true -> Terminal + end, St20 = fwrite(St10, - <<"yeccpars2_~w(_S, ~s, Ss, Stack, T, Ts, Tzr) ->\n">>, - [State, Terminal]), + <<"yeccpars2_~w(_S, ~ts, Ss, Stack, T, Ts, Tzr) ->\n">>, + [State, QuotedTerminal]), St30 = if NmbrOfDaughters < 2 -> @@ -2205,7 +2207,7 @@ output_reduce(St0, State, Terminal0, _ -> NewStack = "NewStack", fwrite(St30, <<" NewStack = ~w(Stack),\n">>, - [inlined_function_name(State, Terminal0)]) + [inlined_function_name(St30, State, Terminal)]) end, if NmbrOfDaughters =:= 0 -> @@ -2221,13 +2223,13 @@ output_reduce(St0, State, Terminal0, St = fwrite(St40, <<"~s">>, [C]), %% Short-circuit call to yeccpars2: fwrite(St, - <<" yeccpars2_~w(~s, ~s, [~w | Ss], ~s, T, Ts, Tzr)">>, - [Repr, NextS, Terminal, State, NewStack]); + <<" yeccpars2_~w(~s, ~ts, [~w | Ss], ~s, T, Ts, Tzr)">>, + [Repr, NextS, QuotedTerminal, State, NewStack]); true -> fwrite(St40, - <<" ~w(hd(~s), ~s, ~s, ~s, T, Ts, Tzr)">>, - [function_name(yeccgoto, Head), Ns, - Terminal, Ns, NewStack]) + <<" ~w(hd(~s), ~ts, ~s, ~s, T, Ts, Tzr)">>, + [function_name(St40, yeccgoto, Head), Ns, + QuotedTerminal, Ns, NewStack]) end. delim(St, true) -> @@ -2235,8 +2237,10 @@ delim(St, true) -> delim(St, false) -> fwrite(St, <<";\n">>, []). -quoted_atom(Atom) -> - io_lib:fwrite(<<"~w">>, [Atom]). +quoted_atom(#yecc{encoding = latin1}, Atom) when is_atom(Atom) -> + io_lib:write_atom_as_latin1(Atom); +quoted_atom(_St, Atomic) -> + io_lib:write(Atomic). output_inlined(St, UserCodeActions, Infile) -> foldl(fun(#user_code{funname = InlinedFunctionName, @@ -2288,14 +2292,16 @@ output_inlined(St0, FunctionName, Reduce, Infile) -> fwrite(St, <<" [begin\n ~ts\n end | ~s].\n\n">>, [pp_tokens(Tokens, Line0, St#yecc.encoding), Stack]). -inlined_function_name(State, "Cat") -> - inlined_function_name(State, ""); -inlined_function_name(State, Terminal) -> - list_to_atom(concat([yeccpars2_, State, '_', Terminal])). +inlined_function_name(St, State, Terminal) -> + End = case Terminal of + "Cat" -> []; + _ -> [quoted_atom(St, Terminal)] + end, + list_to_atom(concat([yeccpars2_, State, '_'] ++ End)). --compile({nowarn_unused_function,function_name/2}). -function_name(Name, Suf) -> - list_to_atom(concat([Name, '_' | quoted_atom(Suf)])). +-compile({nowarn_unused_function,function_name/3}). +function_name(St, Name, Suf) -> + list_to_atom(concat([Name, '_'] ++ [quoted_atom(St, Suf)])). rule(RulePointer, St) -> #rule{n = N, anno = Anno, symbols = Symbols} = diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 54602848ec..3f5d9fee3e 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -45,7 +45,7 @@ pt/1, man/1, ex/1, ex2/1, not_yet/1, line_wrap/1, - otp_10302/1, otp_11286/1, unicode/1, otp_13916/1]). + otp_10302/1, otp_11286/1, unicode/1, otp_13916/1, otp_14285/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -67,7 +67,7 @@ all() -> groups() -> [{checks, [], [file, compile, syntax]}, {examples, [], [pt, man, ex, ex2, not_yet, unicode]}, - {tickets, [], [otp_10302, otp_11286, otp_13916]}, + {tickets, [], [otp_10302, otp_11286, otp_13916, otp_14285]}, {bugs, [], [line_wrap]}]. init_per_suite(Config) -> @@ -1131,6 +1131,45 @@ otp_13916(Config) when is_list(Config) -> ?line run(Config, Ts), ok. +otp_14285(Config) -> + Dir = ?privdir, + Filename = filename:join(Dir, "file.xrl"), + + Ts = [{otp_14285_1, + <<"%% encoding: latin-1\n" + "Definitions.\n" + "A = a\n" + "Z = z\n" + "L = [{A}-{Z}]\n" + "U = [\\x{400}]\n" + "Rules.\n" + "{L}+ : {token,l}.\n" + "{U}+ : {token,'\\x{400}'}.\n" + "Erlang code.\n" + "-export([t/0]).\n" + "t() ->\n" + " {ok,['\\x{400}'],1} = string(\"\\x{400}\"), ok.\n">>, + default, + ok}, + {otp_14285_2, + <<"%% encoding: UTF-8\n" + "Definitions.\n" + "A = a\n" + "Z = z\n" + "L = [{A}-{Z}]\n" + "U = [\x{400}]\n" + "Rules.\n" + "{L}+ : {token,l}.\n" + "{U}+ : {token,'\x{400}'}.\n" + "Erlang code.\n" + "-export([t/0]).\n" + "t() ->\n" + " {ok,['\x{400}'],1} = string(\"\x{400}\"), ok.\n">>, + default, + ok}], + run(Config, Ts), + ok. + start_node(Name, Args) -> [_,Host] = string:tokens(atom_to_list(node()), "@"), ct:log("Trying to start ~w@~s~n", [Name,Host]), diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index 2c37278d4b..a7166b91ed 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -50,7 +50,7 @@ otp_5369/1, otp_6362/1, otp_7945/1, otp_8483/1, otp_8486/1, otp_7292/1, otp_7969/1, otp_8919/1, otp_10302/1, otp_11269/1, - otp_11286/1]). + otp_11286/1, otp_14285/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -78,7 +78,7 @@ groups() -> {bugs, [], [otp_5369, otp_6362, otp_7945, otp_8483, otp_8486]}, {improvements, [], [otp_7292, otp_7969, otp_8919, otp_10302, - otp_11269, otp_11286]}]. + otp_11269, otp_11286, otp_14285]}]. init_per_suite(Config) -> Config. @@ -2048,6 +2048,90 @@ otp_11286(Config) when is_list(Config) -> true = test_server:stop_node(Node), ok. +otp_14285(Config) -> + Dir = ?privdir, + YeccPre = filename:join(Dir, "yeccpre.hrl"), + ?line ok = file:write_file(YeccPre, + [<<"-export([t/0]).\n">>,my_yeccpre()]), + + T0 = <<" + Nonterminals '\\x{400}'. + Terminals t. + Rootsymbol '\\x{400}'. + '\\x{400}' -> t : '$1'. + Erlang code. + t() -> + L = [{t, 1}], + {ok, R} = parse(L), + {t, 1} = R, + ok.">>, + Ts0 = [{otp_14285_1, + [<<"%% coding: Latin-1\n">>,T0],YeccPre,ok}, + {otp_14285_2, + [<<"%% coding: coding: UTF-8\n">>,T0],YeccPre,ok}], + run(Config, Ts0), + file:delete(YeccPre), + + T1 = <<" + Nonterminals '1\\x{400}' list 'unused\\x{400}'. + Terminals '2\\x{400}'. + Rootsymbol '1\\x{400}'. + + '1\\x{400}' -> list : '$1'. + + list -> '2\\x{400}' : '$1'. + list -> list '2\\x{400}' : {foo,'\\x{400}'}. + + Erlang code. + + -export([t/0]). + + t() -> + L = [{'2\\x{400}', 1}, {'2\\x{400}',2}], + {ok, R} = parse(L), + {foo,A} = R, + '\\x{400}' = A, + [1024] = atom_to_list(A), + ok.">>, + + Ts1 = [{otp_14285_3, + [<<"%% coding: Latin-1\n">>,T1],default,ok}, + {otp_14285_4, + [<<"%% coding: UTF-8\n">>,T1],default,ok}], + run(Config, Ts1), + + T2 = <<" + Nonterminals E. + Terminals '-' '+' '=' id. + Rootsymbol E. + Endsymbol '\\x{400}'. + + E -> E '=' E : {op, '=', '$1', '$3'}. + E -> E '+' E : {op, '+', '$1', '$3'}. + E -> '-' E : {op, '-', '$2'}. + E -> id : '$1'. + + Nonassoc 100 '='. + Right 200 '+' '-'. + + Erlang code. + + -export([t/0]). + + t() -> + {ok,{op,'=',{id,1},{op,'-',{op,'+',{id,4},{id,6}}}}} = + parse([{id,1},{'=',2},{'-',3},{id,4},{'+',5},{id,6}, + {'\\x{400}',1}]), + ok.">>, + + Ts2 = [{otp_14285_5, + [<<"%% coding: Latin-1\n">>,T2],default,ok}, + {otp_14285_6, + [<<"%% coding: UTF-8\n">>,T2],default,ok}], + run(Config, Ts2), + + ok. + start_node(Name, Args) -> [_,Host] = string:tokens(atom_to_list(node()), "@"), ct:log("Trying to start ~w@~s~n", [Name,Host]), diff --git a/lib/runtime_tools/src/dyntrace.erl b/lib/runtime_tools/src/dyntrace.erl index 58c5a773c3..5fe62a46f6 100644 --- a/lib/runtime_tools/src/dyntrace.erl +++ b/lib/runtime_tools/src/dyntrace.erl @@ -61,8 +61,8 @@ enabled_garbage_collection/3, enabled/3]). - -export([user_trace_i4s4/9]). % Know what you're doing! +-compile(no_native). -on_load(on_load/0). -type probe_arg() :: integer() | iolist(). diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 02a39f030c..c8c6e61cc8 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,22 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + ssh:daemon_info/1 crashed if the listening IP was not + 'any'</p> + <p> + Own Id: OTP-14298 Aux Id: seq13294 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 968983c862..368261968d 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -379,7 +379,7 @@ on the given port.</fsummary> <type> <v>Port = integer()</v> - <v>HostAddress = ip_address() | any</v> + <v>HostAddress = ip_address() | any | loopback</v> <v>Options = [{Option, Value}]</v> <v>Option = atom()</v> <v>Value = term()</v> @@ -390,6 +390,26 @@ <p>Starts a server listening for SSH connections on the given port. If the <c>Port</c> is 0, a random free port is selected. See <seealso marker="#daemon_info/1">daemon_info/1</seealso> about how to find the selected port number.</p> + + <p>Please note that by historical reasons both the <c>HostAddress</c> argument and the inet socket option + <c>ip</c> set the listening address. This is a source of possible inconsistent settings.</p> + + <p>The rules for handling the two address passing options are:</p> + <list> + <item>if <c>HostAddress</c> is an IP-address, that IP-address is the listening address. + An 'ip'-option will be discarded if present.</item> + + <item>if <c>HostAddress</c> is <c>loopback</c>, the listening address + is <c>loopback</c> and an loopback address will be choosen by the underlying layers. + An 'ip'-option will be discarded if present.</item> + + <item>if <c>HostAddress</c> is <c>any</c> and no 'ip'-option is present, the listening address is + <c>any</c> and the socket will listen to all addresses</item> + + <item>if <c>HostAddress</c> is <c>any</c> and an 'ip'-option is present, the listening address is + set to the value of the 'ip'-option</item> + </list> + <p>Options:</p> <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> @@ -699,6 +719,12 @@ <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p> </item> + <tag><c><![CDATA[{idle_time, integer()}]]></c></tag> + <item> + <p>Sets a time-out on a connection when no channels are active. + Defaults to <c>infinity</c>.</p> + </item> + <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag> <item> <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p> diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index 5f710decc1..515b0639d5 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -109,7 +109,7 @@ </section> <section> <title>Host Keys</title> - <p>RSA and DSA host keys are supported and are + <p>RSA, DSA and ECDSA host keys are supported and are expected to be found in files named <c>ssh_host_rsa_key</c>, <c>ssh_host_dsa_key</c> and <c>ssh_host_ecdsa_key</c>. </p> @@ -160,7 +160,7 @@ <item>ecdsa-sha2-nistp384</item> <item>ecdsa-sha2-nistp521</item> <item>ssh-rsa</item> - <item>(ssh-dss, retired: can be enabled with the <c>preferred_algorithms</c> option)</item> + <item>ssh-dss</item> </list> </item> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index e2a289d737..3e80a04b70 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -26,6 +26,7 @@ -include("ssh_connect.hrl"). -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). +-include_lib("kernel/include/inet.hrl"). -export([start/0, start/1, stop/0, connect/2, connect/3, connect/4, @@ -108,7 +109,7 @@ connect(Socket, UserOptions, Timeout) when is_port(Socket), case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of ok -> {ok, {Host,_Port}} = inet:sockname(Socket), - Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,fmt_host(Host)}], Options), + Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); {error,SockError} -> {error,SockError} @@ -120,7 +121,7 @@ connect(Host, Port, UserOptions) when is_integer(Port), is_list(UserOptions) -> connect(Host, Port, UserOptions, infinity). -connect(Host, Port, UserOptions, Timeout) when is_integer(Port), +connect(Host0, Port, UserOptions, Timeout) when is_integer(Port), Port>0, is_list(UserOptions) -> case ssh_options:handle_options(client, UserOptions) of @@ -130,6 +131,7 @@ connect(Host, Port, UserOptions, Timeout) when is_integer(Port), {_, Transport, _} = TransportOpts = ?GET_OPT(transport, Options), ConnectionTimeout = ?GET_OPT(connect_timeout, Options), SocketOpts = [{active,false} | ?GET_OPT(socket_options,Options)], + Host = mangle_connect_address(Host0, SocketOpts), try Transport:connect(Host, Port, SocketOpts, ConnectionTimeout) of {ok, Socket} -> Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), @@ -138,7 +140,6 @@ connect(Host, Port, UserOptions, Timeout) when is_integer(Port), {error, Reason} catch exit:{function_clause, _F} -> - io:format('function_clause ~p~n',[_F]), {error, {options, {transport, TransportOpts}}}; exit:badarg -> {error, {options, {socket_options, SocketOpts}}} @@ -183,16 +184,88 @@ daemon(Port) -> daemon(Port, []). -daemon(Port, UserOptions) when is_integer(Port), Port >= 0 -> - daemon(any, Port, UserOptions); - daemon(Socket, UserOptions) when is_port(Socket) -> - daemon(socket, Socket, UserOptions). + try + #{} = Options = ssh_options:handle_options(server, UserOptions), + case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of + ok -> + {ok, {IP,Port}} = inet:sockname(Socket), + finalize_start(IP, Port, ?GET_OPT(profile, Options), + ?PUT_INTERNAL_OPT({connected_socket, Socket}, Options), + fun(Opts, DefaultResult) -> + try ssh_acceptor:handle_established_connection( + IP, Port, Opts, Socket) + of + {error,Error} -> + {error,Error}; + _ -> + DefaultResult + catch + C:R -> + {error,{could_not_start_connection,{C,R}}} + end + end); + {error,SockError} -> + {error,SockError} + end + catch + throw:bad_fd -> + {error,bad_fd}; + throw:bad_socket -> + {error,bad_socket}; + error:{badmatch,{error,Error}} -> + {error,Error}; + error:Error -> + {error,Error}; + _C:_E -> + {error,{cannot_start_daemon,_C,_E}} + end; + +daemon(Port, UserOptions) when 0 =< Port, Port =< 65535 -> + daemon(any, Port, UserOptions). + + +daemon(Host0, Port0, UserOptions0) when 0 =< Port0, Port0 =< 65535, + Host0 == any ; Host0 == loopback ; is_tuple(Host0) -> + try + {Host1, UserOptions} = handle_daemon_args(Host0, UserOptions0), + #{} = Options0 = ssh_options:handle_options(server, UserOptions), + + {{Host,Port}, ListenSocket} = + open_listen_socket(Host1, Port0, Options0), + + %% Now Host,Port is what to use for the supervisor to register its name, + %% and ListenSocket is for listening on connections. But it is still owned + %% by self()... + + finalize_start(Host, Port, ?GET_OPT(profile, Options0), + ?PUT_INTERNAL_OPT({lsocket,{ListenSocket,self()}}, Options0), + fun(Opts, Result) -> + {_, Callback, _} = ?GET_OPT(transport, Opts), + receive + {request_control, ListenSocket, ReqPid} -> + ok = Callback:controlling_process(ListenSocket, ReqPid), + ReqPid ! {its_yours,ListenSocket}, + Result + end + end) + catch + throw:bad_fd -> + {error,bad_fd}; + throw:bad_socket -> + {error,bad_socket}; + error:{badmatch,{error,Error}} -> + {error,Error}; + error:Error -> + {error,Error}; + _C:_E -> + {error,{cannot_start_daemon,_C,_E}} + end; + +daemon(_, _, _) -> + {error, badarg}. -daemon(Host0, Port, UserOptions0) -> - {Host, UserOptions} = handle_daemon_args(Host0, UserOptions0), - start_daemon(Host, Port, ssh_options:handle_options(server, UserOptions)). %%-------------------------------------------------------------------- -spec daemon_info(daemon_ref()) -> ok_error( [{atom(), term()}] ). @@ -200,11 +273,17 @@ daemon(Host0, Port, UserOptions0) -> daemon_info(Pid) -> case catch ssh_system_sup:acceptor_supervisor(Pid) of AsupPid when is_pid(AsupPid) -> - [{ListenAddr,Port,Profile}] = - [{LA,Prt,Prf} || {{ssh_acceptor_sup,LA,Prt,Prf}, - _WorkerPid,worker,[ssh_acceptor]} <- supervisor:which_children(AsupPid)], + [{IP,Port,Profile}] = + [{IP,Prt,Prf} + || {{ssh_acceptor_sup,Hst,Prt,Prf},_Pid,worker,[ssh_acceptor]} + <- supervisor:which_children(AsupPid), + IP <- [case inet:parse_strict_address(Hst) of + {ok,IP} -> IP; + _ -> Hst + end] + ], {ok, [{port,Port}, - {listen_address,ListenAddr}, + {ip,IP}, {profile,Profile} ]}; _ -> @@ -222,8 +301,14 @@ stop_listener(SysSup) -> ssh_system_sup:stop_listener(SysSup). stop_listener(Address, Port) -> stop_listener(Address, Port, ?DEFAULT_PROFILE). +stop_listener(any, Port, Profile) -> + map_ip(fun(IP) -> + ssh_system_sup:stop_listener(IP, Port, Profile) + end, [{0,0,0,0},{0,0,0,0,0,0,0,0}]); stop_listener(Address, Port, Profile) -> - ssh_system_sup:stop_listener(Address, Port, Profile). + map_ip(fun(IP) -> + ssh_system_sup:stop_listener(IP, Port, Profile) + end, {address,Address}). %%-------------------------------------------------------------------- -spec stop_daemon(daemon_ref()) -> ok. @@ -236,9 +321,15 @@ stop_listener(Address, Port, Profile) -> stop_daemon(SysSup) -> ssh_system_sup:stop_system(SysSup). stop_daemon(Address, Port) -> - ssh_system_sup:stop_system(Address, Port, ?DEFAULT_PROFILE). + stop_daemon(Address, Port, ?DEFAULT_PROFILE). +stop_daemon(any, Port, Profile) -> + map_ip(fun(IP) -> + ssh_system_sup:stop_system(IP, Port, Profile) + end, [{0,0,0,0},{0,0,0,0,0,0,0,0}]); stop_daemon(Address, Port, Profile) -> - ssh_system_sup:stop_system(Address, Port, Profile). + map_ip(fun(IP) -> + ssh_system_sup:stop_system(IP, Port, Profile) + end, {address,Address}). %%-------------------------------------------------------------------- -spec shell(inet:socket() | string()) -> _. @@ -292,35 +383,34 @@ default_algorithms() -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -handle_daemon_args(Host, UserOptions0) -> - case Host of - socket -> - {Host, UserOptions0}; - any -> - {ok, Host0} = inet:gethostname(), - Inet = proplists:get_value(inet, UserOptions0, inet), - {Host0, [Inet | UserOptions0]}; - {_,_,_,_} -> - {Host, [inet, {ip,Host} | UserOptions0]}; - {_,_,_,_,_,_,_,_} -> - {Host, [inet6, {ip,Host} | UserOptions0]}; - _ -> - error(badarg) +%% The handle_daemon_args/2 function basically only sets the ip-option in Opts +%% so that it is correctly set when opening the listening socket. + +handle_daemon_args(any, Opts) -> + case proplists:get_value(ip, Opts) of + undefined -> {any, Opts}; + IP -> {IP, Opts} + end; + +handle_daemon_args(IPaddr, Opts) when is_tuple(IPaddr) ; IPaddr == loopback -> + case proplists:get_value(ip, Opts) of + undefined -> {IPaddr, [{ip,IPaddr}|Opts]}; + IPaddr -> {IPaddr, Opts}; + IP -> {IPaddr, [{ip,IPaddr}|Opts--[{ip,IP}]]} %% Backward compatibility end. %%%---------------------------------------------------------------- valid_socket_to_use(Socket, {tcp,_,_}) -> %% Is this tcp-socket a valid socket? - case {is_tcp_socket(Socket), - {ok,[{active,false}]} == inet:getopts(Socket, [active]) - } + try {is_tcp_socket(Socket), + {ok,[{active,false}]} == inet:getopts(Socket, [active]) + } of - {true, true} -> - ok; - {true, false} -> - {error, not_passive_mode}; - _ -> - {error, not_tcp_socket} + {true, true} -> ok; + {true, false} -> {error, not_passive_mode}; + _ -> {error, not_tcp_socket} + catch + _:_ -> {error, bad_socket} end; valid_socket_to_use(_, {L4,_,_}) -> @@ -334,158 +424,62 @@ is_tcp_socket(Socket) -> end. %%%---------------------------------------------------------------- -start_daemon(_, _, {error,Error}) -> - {error,Error}; - -start_daemon(socket, Socket, Options) -> - case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of - ok -> - try - do_start_daemon(Socket, Options) - catch - throw:bad_fd -> {error,bad_fd}; - throw:bad_socket -> {error,bad_socket}; - _C:_E -> {error,{cannot_start_daemon,_C,_E}} - end; - {error,SockError} -> - {error,SockError} - end; +open_listen_socket(_Host0, Port0, Options0) -> + {ok,LSock} = + case ?GET_SOCKET_OPT(fd, Options0) of + undefined -> + ssh_acceptor:listen(Port0, Options0); + Fd when is_integer(Fd) -> + %% Do gen_tcp:listen with the option {fd,Fd}: + ssh_acceptor:listen(0, Options0) + end, + {ok,{LHost,LPort}} = inet:sockname(LSock), + {{LHost,LPort}, LSock}. -start_daemon(Host, Port, Options) -> +%%%---------------------------------------------------------------- +finalize_start(Host, Port, Profile, Options0, F) -> try - do_start_daemon(Host, Port, Options) + sshd_sup:start_child(Host, Port, Profile, Options0) + of + {error, {already_started, _}} -> + {error, eaddrinuse}; + {error, Error} -> + {error, Error}; + Result = {ok,_} -> + F(Options0, Result) catch - throw:bad_fd -> {error,bad_fd}; - throw:bad_socket -> {error,bad_socket}; - _C:_E -> {error,{cannot_start_daemon,_C,_E}} + exit:{noproc, _} -> + {error, ssh_not_started} end. +%%%---------------------------------------------------------------- +map_ip(Fun, {address,IP}) when is_tuple(IP) -> + Fun(IP); +map_ip(Fun, {address,Address}) -> + IPs = try {ok,#hostent{h_addr_list=IP0s}} = inet:gethostbyname(Address), + IP0s + catch + _:_ -> [] + end, + map_ip(Fun, IPs); +map_ip(Fun, IPs) -> + lists:map(Fun, IPs). -do_start_daemon(Socket, Options) -> - {ok, {IP,Port}} = - try {ok,_} = inet:sockname(Socket) - catch - _:_ -> throw(bad_socket) - end, - Host = fmt_host(IP), - Opts = ?PUT_INTERNAL_OPT([{asocket, Socket}, - {asock_owner,self()}, - {address, Host}, - {port, Port}, - {role, server}], Options), - - Profile = ?GET_OPT(profile, Options), - case ssh_system_sup:system_supervisor(Host, Port, Profile) of - undefined -> - try sshd_sup:start_child(Opts) of - {error, {already_started, _}} -> - {error, eaddrinuse}; - Result = {ok,_} -> - call_ssh_acceptor_handle_connection(Host, Port, Opts, Socket, Result); - Result = {error, _} -> - Result - catch - exit:{noproc, _} -> - {error, ssh_not_started} - end; - Sup -> - AccPid = ssh_system_sup:acceptor_supervisor(Sup), - case ssh_acceptor_sup:start_child(AccPid, Opts) of - {error, {already_started, _}} -> - {error, eaddrinuse}; - {ok, _} -> - call_ssh_acceptor_handle_connection(Host, Port, Opts, Socket, {ok,Sup}); - Other -> - Other - end - end. - -do_start_daemon(Host0, Port0, Options0) -> - {Host,Port1} = - try - case ?GET_SOCKET_OPT(fd, Options0) of - undefined -> - {Host0,Port0}; - Fd when Port0==0 -> - find_hostport(Fd) - end - catch - _:_ -> throw(bad_fd) - end, - {Port, WaitRequestControl, Options1} = - case Port1 of - 0 -> %% Allocate the socket here to get the port number... - {ok,LSock} = ssh_acceptor:callback_listen(0, Options0), - {ok,{_,LPort}} = inet:sockname(LSock), - {LPort, - LSock, - ?PUT_INTERNAL_OPT({lsocket,{LSock,self()}}, Options0) - }; - _ -> - {Port1, false, Options0} - end, - Options = ?PUT_INTERNAL_OPT([{address, Host}, - {port, Port}, - {role, server}], Options1), - Profile = ?GET_OPT(profile, Options0), - case ssh_system_sup:system_supervisor(Host, Port, Profile) of - undefined -> - try sshd_sup:start_child(Options) of - {error, {already_started, _}} -> - {error, eaddrinuse}; - Result = {ok,_} -> - sync_request_control(WaitRequestControl, Options), - Result; - Result = {error, _} -> - Result - catch - exit:{noproc, _} -> - {error, ssh_not_started} - end; - Sup -> - AccPid = ssh_system_sup:acceptor_supervisor(Sup), - case ssh_acceptor_sup:start_child(AccPid, Options) of - {error, {already_started, _}} -> - {error, eaddrinuse}; - {ok, _} -> - sync_request_control(WaitRequestControl, Options), - {ok, Sup}; - Other -> - Other - end - end. - -call_ssh_acceptor_handle_connection(Host, Port, Options, Socket, DefaultResult) -> - {_, Callback, _} = ?GET_OPT(transport, Options), - try ssh_acceptor:handle_connection(Callback, Host, Port, Options, Socket) - of - {error,Error} -> {error,Error}; - _ -> DefaultResult - catch - C:R -> {error,{could_not_start_connection,{C,R}}} - end. - - -sync_request_control(false, _Options) -> - ok; -sync_request_control(LSock, Options) -> - {_, Callback, _} = ?GET_OPT(transport, Options), - receive - {request_control,LSock,ReqPid} -> - ok = Callback:controlling_process(LSock, ReqPid), - ReqPid ! {its_yours,LSock}, - ok +%%%---------------------------------------------------------------- +mangle_connect_address(A, SockOpts) -> + mangle_connect_address1(A, proplists:get_value(inet6,SockOpts,false)). + +loopback(true) -> {0,0,0,0,0,0,0,1}; +loopback(false) -> {127,0,0,1}. + +mangle_connect_address1( loopback, V6flg) -> loopback(V6flg); +mangle_connect_address1( any, V6flg) -> loopback(V6flg); +mangle_connect_address1({0,0,0,0}, _) -> loopback(false); +mangle_connect_address1({0,0,0,0,0,0,0,0}, _) -> loopback(true); +mangle_connect_address1( IP, _) when is_tuple(IP) -> IP; +mangle_connect_address1(A, _) -> + case catch inet:parse_address(A) of + {ok, {0,0,0,0}} -> loopback(false); + {ok, {0,0,0,0,0,0,0,0}} -> loopback(true); + _ -> A end. - -find_hostport(Fd) -> - %% Using internal functions inet:open/8 and inet:close/0. - %% Don't try this at home unless you know what you are doing! - {ok,S} = inet:open(Fd, {0,0,0,0}, 0, [], tcp, inet, stream, inet_tcp), - {ok, HostPort} = inet:sockname(S), - ok = inet:close(S), - HostPort. - -fmt_host({A,B,C,D}) -> - lists:concat([A,".",B,".",C,".",D]); -fmt_host(T={_,_,_,_,_,_,_,_}) -> - lists:flatten(string:join([io_lib:format("~.16B",[A]) || A <- tuple_to_list(T)], ":")). diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index c1ba58ed40..315310f700 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -75,9 +75,12 @@ %% Option access macros -define(do_get_opt(C,K,O), ssh_options:get_value(C,K,O, ?MODULE,?LINE)). --define(do_get_opt(C,K,O,D), ssh_options:get_value(C,K,O,D,?MODULE,?LINE)). +-define(do_get_opt(C,K,O,D), ssh_options:get_value(C,K,O,?LAZY(D),?MODULE,?LINE)). + +-define(LAZY(D), fun()-> D end). -define(GET_OPT(Key,Opts), ?do_get_opt(user_options, Key,Opts ) ). +-define(GET_OPT(Key,Opts,Def), ?do_get_opt(user_options, Key,Opts,Def) ). -define(GET_INTERNAL_OPT(Key,Opts), ?do_get_opt(internal_options,Key,Opts ) ). -define(GET_INTERNAL_OPT(Key,Opts,Def), ?do_get_opt(internal_options,Key,Opts,Def) ). -define(GET_SOCKET_OPT(Key,Opts), ?do_get_opt(socket_options, Key,Opts ) ). @@ -89,6 +92,10 @@ -define(PUT_INTERNAL_OPT(KeyVal,Opts), ?do_put_opt(internal_options,KeyVal,Opts) ). -define(PUT_SOCKET_OPT(KeyVal,Opts), ?do_put_opt(socket_options, KeyVal,Opts) ). +-define(do_del_opt(C,K,O), ssh_options:delete_key(C,K,O, ?MODULE,?LINE)). +-define(DELETE_INTERNAL_OPT(Key,Opts), ?do_del_opt(internal_options,Key,Opts) ). + + %% Types -type role() :: client | server . -type ok_error(SuccessType) :: {ok, SuccessType} | {error, any()} . @@ -109,12 +116,25 @@ -type double_algs() :: list( {client2serverlist,simple_algs()} | {server2client,simple_algs()} ) | simple_algs() . +-type options() :: #{socket_options := socket_options(), + internal_options := internal_options(), + option_key() => any() + }. + +-type socket_options() :: proplists:proplist(). +-type internal_options() :: #{option_key() => any()}. + +-type option_key() :: atom(). + + %% Records -record(ssh, { - role, %% client | server - peer, %% string version of peer address + role :: client | role(), + peer :: undefined | + {inet:hostname(), + {inet:ip_adress(),inet:port_number()}}, %% string version of peer address c_vsn, %% client version {Major,Minor} s_vsn, %% server version {Major,Minor} diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 42be18f2ad..f7fbd7ccad 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -27,8 +27,8 @@ %% Internal application API -export([start_link/4, number_of_connections/1, - callback_listen/2, - handle_connection/5]). + listen/2, + handle_established_connection/4]). %% spawn export -export([acceptor_init/5, acceptor_loop/6]). @@ -42,41 +42,57 @@ start_link(Port, Address, Options, AcceptTimeout) -> Args = [self(), Port, Address, Options, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). +%%%---------------------------------------------------------------- +number_of_connections(SystemSup) -> + length([X || + {R,X,supervisor,[ssh_subsystem_sup]} <- supervisor:which_children(SystemSup), + is_pid(X), + is_reference(R) + ]). + +%%%---------------------------------------------------------------- +listen(Port, Options) -> + {_, Callback, _} = ?GET_OPT(transport, Options), + SockOpts = [{active, false}, {reuseaddr,true} | ?GET_OPT(socket_options, Options)], + case Callback:listen(Port, SockOpts) of + {error, nxdomain} -> + Callback:listen(Port, lists:delete(inet6, SockOpts)); + {error, enetunreach} -> + Callback:listen(Port, lists:delete(inet6, SockOpts)); + {error, eafnosupport} -> + Callback:listen(Port, lists:delete(inet6, SockOpts)); + Other -> + Other + end. + +%%%---------------------------------------------------------------- +handle_established_connection(Address, Port, Options, Socket) -> + {_, Callback, _} = ?GET_OPT(transport, Options), + handle_connection(Callback, Address, Port, Options, Socket). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- acceptor_init(Parent, Port, Address, Opts, AcceptTimeout) -> - {_, Callback, _} = ?GET_OPT(transport, Opts), try - {LSock0,SockOwner0} = ?GET_INTERNAL_OPT(lsocket, Opts), - true = is_pid(SockOwner0), - {ok,{_,Port}} = inet:sockname(LSock0), - {LSock0, SockOwner0} + ?GET_INTERNAL_OPT(lsocket, Opts) of {LSock, SockOwner} -> - %% Use existing socket - proc_lib:init_ack(Parent, {ok, self()}), - request_ownership(LSock, SockOwner), - acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout) - catch - error:{badkey,lsocket} -> - %% Open new socket - try - socket_listen(Port, Opts) - of - {ok, ListenSocket} -> + case inet:sockname(LSock) of + {ok,{_,Port}} -> % A usable, open LSock proc_lib:init_ack(Parent, {ok, self()}), - {_, Callback, _} = ?GET_OPT(transport, Opts), - acceptor_loop(Callback, - Port, Address, Opts, ListenSocket, AcceptTimeout); - {error,Error} -> - proc_lib:init_ack(Parent, Error), - {error,Error} - catch - _:_ -> - {error,listen_socket_failed} - end; + request_ownership(LSock, SockOwner), + {_, Callback, _} = ?GET_OPT(transport, Opts), + acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout); + {error,_} -> % Not open, a restart + {ok,NewLSock} = listen(Port, Opts), + proc_lib:init_ack(Parent, {ok, self()}), + Opts1 = ?DELETE_INTERNAL_OPT(lsocket, Opts), + {_, Callback, _} = ?GET_OPT(transport, Opts1), + acceptor_loop(Callback, Port, Address, Opts1, NewLSock, AcceptTimeout) + end + catch _:_ -> {error,use_existing_socket_failed} end. @@ -88,30 +104,7 @@ request_ownership(LSock, SockOwner) -> {its_yours,LSock} -> ok end. - -socket_listen(Port0, Opts) -> - Port = case ?GET_SOCKET_OPT(fd, Opts) of - undefined -> Port0; - _ -> 0 - end, - callback_listen(Port, Opts). - - -callback_listen(Port, Opts0) -> - {_, Callback, _} = ?GET_OPT(transport, Opts0), - Opts = ?PUT_SOCKET_OPT([{active, false}, {reuseaddr,true}], Opts0), - SockOpts = ?GET_OPT(socket_options, Opts), - case Callback:listen(Port, SockOpts) of - {error, nxdomain} -> - Callback:listen(Port, lists:delete(inet6, SockOpts)); - {error, enetunreach} -> - Callback:listen(Port, lists:delete(inet6, SockOpts)); - {error, eafnosupport} -> - Callback:listen(Port, lists:delete(inet6, SockOpts)); - Other -> - Other - end. - +%%%---------------------------------------------------------------- acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> case (catch Callback:accept(ListenSocket, AcceptTimeout)) of {ok, Socket} -> @@ -128,6 +121,7 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> ListenSocket, AcceptTimeout) end. +%%%---------------------------------------------------------------- handle_connection(Callback, Address, Port, Options, Socket) -> Profile = ?GET_OPT(profile, Options), SystemSup = ssh_system_sup:system_supervisor(Address, Port, Profile), @@ -135,7 +129,8 @@ handle_connection(Callback, Address, Port, Options, Socket) -> MaxSessions = ?GET_OPT(max_sessions, Options), case number_of_connections(SystemSup) < MaxSessions of true -> - {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options), + {ok, SubSysSup} = + ssh_system_sup:start_subsystem(SystemSup, server, Address, Port, Profile, Options), ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup), NegTimeout = ?GET_OPT(negotiation_timeout, Options), ssh_connection_handler:start_connection(server, Socket, @@ -159,7 +154,7 @@ handle_connection(Callback, Address, Port, Options, Socket) -> {error,max_sessions} end. - +%%%---------------------------------------------------------------- handle_error(timeout) -> ok; @@ -186,10 +181,3 @@ handle_error(Reason) -> error_logger:error_report(String), exit({accept_failed, String}). - -number_of_connections(SystemSup) -> - length([X || - {R,X,supervisor,[ssh_subsystem_sup]} <- supervisor:which_children(SystemSup), - is_pid(X), - is_reference(R) - ]). diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 77f7826918..26defcfdbd 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -29,7 +29,7 @@ -include("ssh.hrl"). --export([start_link/1, start_child/2, stop_child/4]). +-export([start_link/4, start_child/5, stop_child/4]). %% Supervisor callback -export([init/1]). @@ -41,19 +41,19 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link(Servers) -> - supervisor:start_link(?MODULE, [Servers]). +start_link(Address, Port, Profile, Options) -> + supervisor:start_link(?MODULE, [Address, Port, Profile, Options]). -start_child(AccSup, Options) -> - Spec = child_spec(Options), +start_child(AccSup, Address, Port, Profile, Options) -> + Spec = child_spec(Address, Port, Profile, Options), case supervisor:start_child(AccSup, Spec) of {error, already_present} -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), - Profile = ?GET_OPT(profile, Options), + %% Is this ever called? stop_child(AccSup, Address, Port, Profile), supervisor:start_child(AccSup, Spec); Reply -> + %% Reply = {ok,SystemSupPid} when the user calls ssh:daemon + %% after having called ssh:stop_listening Reply end. @@ -69,34 +69,29 @@ stop_child(AccSup, Address, Port, Profile) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= -init([Options]) -> - RestartStrategy = one_for_one, - MaxR = 10, - MaxT = 3600, - Children = [child_spec(Options)], - {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. +init([Address, Port, Profile, Options]) -> + %% Initial start of ssh_acceptor_sup for this port or new start after + %% ssh:stop_daemon + SupFlags = #{strategy => one_for_one, + intensity => 10, + period => 3600 + }, + ChildSpecs = [child_spec(Address, Port, Profile, Options)], + {ok, {SupFlags,ChildSpecs}}. %%%========================================================================= %%% Internal functions %%%========================================================================= -child_spec(Options) -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), +child_spec(Address, Port, Profile, Options) -> Timeout = ?GET_INTERNAL_OPT(timeout, Options, ?DEFAULT_TIMEOUT), - Profile = ?GET_OPT(profile, Options), - Name = id(Address, Port, Profile), - StartFunc = {ssh_acceptor, start_link, [Port, Address, Options, Timeout]}, - Restart = transient, - Shutdown = brutal_kill, - Modules = [ssh_acceptor], - Type = worker, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. + #{id => id(Address, Port, Profile), + start => {ssh_acceptor, start_link, [Port, Address, Options, Timeout]}, + restart => transient, + shutdown => 5500, %brutal_kill, + type => worker, + modules => [ssh_acceptor] + }. id(Address, Port, Profile) -> - case is_list(Address) of - true -> - {ssh_acceptor_sup, any, Port, Profile}; - false -> - {ssh_acceptor_sup, Address, Port, Profile} - end. + {ssh_acceptor_sup, Address, Port, Profile}. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index b9c643c77e..ff94e5dfb6 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -400,7 +400,9 @@ init_process_state(Role, Socket, Opts) -> timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), cache_init_idle_timer(D); server -> - D#data{connection_state = init_connection(Role, C, Opts)} + cache_init_idle_timer( + D#data{connection_state = init_connection(Role, C, Opts)} + ) end. @@ -411,14 +413,8 @@ init_connection(server, C = #connection{}, Opts) -> SubSystemSup = proplists:get_value(subsystem_sup, Sups), ConnectionSup = proplists:get_value(connection_sup, Sups), - Shell = ?GET_OPT(shell, Opts), - Exec = ?GET_OPT(exec, Opts), - CliSpec = case ?GET_OPT(ssh_cli, Opts) of - undefined -> {ssh_cli, [Shell]}; - Spec -> Spec - end, - C#connection{cli_spec = CliSpec, - exec = Exec, + C#connection{cli_spec = ?GET_OPT(ssh_cli, Opts, {ssh_cli,[?GET_OPT(shell, Opts)]}), + exec = ?GET_OPT(exec, Opts), system_supervisor = SystemSup, sub_system_supervisor = SubSystemSup, connection_supervisor = ConnectionSup @@ -444,7 +440,12 @@ init_ssh_record(Role, Socket, Opts) -> {Vsn, Version} = ssh_transport:versions(Role, Opts), case Role of client -> - PeerName = ?GET_INTERNAL_OPT(host, Opts), + PeerName = case ?GET_INTERNAL_OPT(host, Opts) of + PeerIP when is_tuple(PeerIP) -> + inet_parse:ntoa(PeerIP); + PeerName0 -> + PeerName0 + end, S0#ssh{c_vsn = Vsn, c_version = Version, io_cb = case ?GET_OPT(user_interaction, Opts) of @@ -919,6 +920,9 @@ handle_event(internal, Msg=#ssh_msg_channel_extended_data{}, StateName, D) - handle_event(internal, Msg=#ssh_msg_channel_eof{}, StateName, D) -> handle_connection_msg(Msg, StateName, D); +handle_event(internal, Msg=#ssh_msg_channel_close{}, {connected,server} = StateName, D) -> + handle_connection_msg(Msg, StateName, cache_request_idle_timer_check(D)); + handle_event(internal, Msg=#ssh_msg_channel_close{}, StateName, D) -> handle_connection_msg(Msg, StateName, D); diff --git a/lib/ssh/src/ssh_connection_sup.erl b/lib/ssh/src/ssh_connection_sup.erl index 0f54053f52..fad796f196 100644 --- a/lib/ssh/src/ssh_connection_sup.erl +++ b/lib/ssh/src/ssh_connection_sup.erl @@ -45,19 +45,17 @@ start_child(Sup, Args) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - init(_) -> - RestartStrategy = simple_one_for_one, - MaxR = 0, - MaxT = 3600, - - Name = undefined, % As simple_one_for_one is used. - StartFunc = {ssh_connection_handler, start_link, []}, - Restart = temporary, % E.g. should not be restarted - Shutdown = 4000, - Modules = [ssh_connection_handler], - Type = worker, - - ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, - {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. + SupFlags = #{strategy => simple_one_for_one, + intensity => 0, + period => 3600 + }, + ChildSpecs = [#{id => undefined, % As simple_one_for_one is used. + start => {ssh_connection_handler, start_link, []}, + restart => temporary, + shutdown => 4000, + type => worker, + modules => [ssh_connection_handler] + } + ], + {ok, {SupFlags,ChildSpecs}}. diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 898b4cc5c4..88f4d10792 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -221,6 +221,8 @@ file_name(Type, Name, Opts) -> %% in: "host" out: "host,1.2.3.4. +add_ip(IP) when is_tuple(IP) -> + ssh_connection:encode_ip(IP); add_ip(Host) -> case inet:getaddr(Host, inet) of {ok, Addr} -> diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index a882a01eaf..ee3cdbb8a0 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -28,6 +28,7 @@ -export([default/1, get_value/5, get_value/6, put_value/5, + delete_key/5, handle_options/2 ]). @@ -37,16 +38,6 @@ %%%================================================================ %%% Types --type options() :: #{socket_options := socket_options(), - internal_options := internal_options(), - option_key() => any() - }. - --type socket_options() :: proplists:proplist(). --type internal_options() :: #{option_key() => any()}. - --type option_key() :: atom(). - -type option_in() :: proplists:property() | proplists:proplist() . -type option_class() :: internal_options | socket_options | user_options . @@ -75,22 +66,23 @@ get_value(Class, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> user_options -> maps:get(Key, Opts) end; get_value(Class, Key, Opts, _CallerMod, _CallerLine) -> - io:format("*** Bad Opts GET OPT ~p ~p:~p Key=~p,~n Opts=~p~n",[Class,_CallerMod,_CallerLine,Key,Opts]), error({bad_options,Class, Key, Opts, _CallerMod, _CallerLine}). --spec get_value(option_class(), option_key(), options(), any(), +-spec get_value(option_class(), option_key(), options(), fun(() -> any()), atom(), non_neg_integer()) -> any() | no_return(). -get_value(socket_options, Key, Opts, Def, _CallerMod, _CallerLine) when is_map(Opts) -> - proplists:get_value(Key, maps:get(socket_options,Opts), Def); -get_value(Class, Key, Opts, Def, CallerMod, CallerLine) when is_map(Opts) -> +get_value(socket_options, Key, Opts, DefFun, _CallerMod, _CallerLine) when is_map(Opts) -> + proplists:get_value(Key, maps:get(socket_options,Opts), DefFun); +get_value(Class, Key, Opts, DefFun, CallerMod, CallerLine) when is_map(Opts) -> try get_value(Class, Key, Opts, CallerMod, CallerLine) + of + undefined -> DefFun(); + Value -> Value catch - error:{badkey,Key} -> Def + error:{badkey,Key} -> DefFun() end; -get_value(Class, Key, Opts, _Def, _CallerMod, _CallerLine) -> - io:format("*** Bad Opts GET OPT ~p ~p:~p Key=~p,~n Opts=~p~n",[Class,_CallerMod,_CallerLine,Key,Opts]), +get_value(Class, Key, Opts, _DefFun, _CallerMod, _CallerLine) -> error({bad_options,Class, Key, Opts, _CallerMod, _CallerLine}). @@ -136,6 +128,19 @@ put_socket_value(A, SockOpts) when is_atom(A) -> %%%================================================================ %%% +%%% Delete an option +%%% + +-spec delete_key(option_class(), option_key(), options(), + atom(), non_neg_integer()) -> options(). + +delete_key(internal_options, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> + InternalOpts = maps:get(internal_options,Opts), + Opts#{internal_options := maps:remove(Key, InternalOpts)}. + + +%%%================================================================ +%%% %%% Initialize the options %%% @@ -490,12 +495,6 @@ default(client) -> class => user_options }, - {idle_time, def} => - #{default => infinity, - chk => fun check_timeout/1, - class => user_options - }, - %%%%% Undocumented {keyboard_interact_fun, def} => #{default => undefined, @@ -548,6 +547,12 @@ default(common) -> class => user_options }, + {idle_time, def} => + #{default => infinity, + chk => fun check_timeout/1, + class => user_options + }, + %% This is a "SocketOption"... %% {fd, def} => %% #{default => undefined, @@ -792,18 +797,17 @@ read_moduli_file(D, I, Acc) -> check_silently_accept_hosts(B) when is_boolean(B) -> true; check_silently_accept_hosts(F) when is_function(F,2) -> true; -check_silently_accept_hosts({S,F}) when is_atom(S), - is_function(F,2) -> - lists:member(S, ?SHAs) andalso - lists:member(S, proplists:get_value(hashs,crypto:supports())); -check_silently_accept_hosts({L,F}) when is_list(L), - is_function(F,2) -> - lists:all(fun(S) -> - lists:member(S, ?SHAs) andalso - lists:member(S, proplists:get_value(hashs,crypto:supports())) - end, L); +check_silently_accept_hosts({false,S}) when is_atom(S) -> valid_hash(S); +check_silently_accept_hosts({S,F}) when is_function(F,2) -> valid_hash(S); check_silently_accept_hosts(_) -> false. + +valid_hash(S) -> valid_hash(S, proplists:get_value(hashs,crypto:supports())). + +valid_hash(S, Ss) when is_atom(S) -> lists:member(S, ?SHAs) andalso lists:member(S, Ss); +valid_hash(L, Ss) when is_list(L) -> lists:all(fun(S) -> valid_hash(S,Ss) end, L); +valid_hash(X, _) -> error_in_check(X, "Expect atom or list in fingerprint spec"). + %%%---------------------------------------------------------------- check_preferred_algorithms(Algs) -> try alg_duplicates(Algs, [], []) @@ -871,6 +875,7 @@ handle_pref_alg(Key, Vs, _) -> chk_alg_vs(OptKey, Values, SupportedValues) -> case (Values -- SupportedValues) of [] -> Values; + [none] -> [none]; % for testing only Bad -> error_in_check({OptKey,Bad}, "Unsupported value(s) found") end. diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 140856c8e3..f1f7b57e8d 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -1063,15 +1063,6 @@ attr_to_info(A) when is_record(A, ssh_xfer_attr) -> gid = A#ssh_xfer_attr.group}. -%% Added workaround for sftp timestam problem. (Timestamps should be -%% in UTC but they where not) . The workaround uses a deprecated -%% function i calandar. This will work as expected most of the time -%% but has problems for the same reason as -%% calendar:local_time_to_universal_time/1. We consider it better that -%% the timestamps work as expected most of the time instead of none of -%% the time. Hopfully the file-api will be updated so that we can -%% solve this problem in a better way in the future. - unix_to_datetime(undefined) -> undefined; unix_to_datetime(UTCSecs) -> diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 9352046795..b879116393 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -34,8 +34,7 @@ %%-------------------------------------------------------------------- %% External exports --export([subsystem_spec/1, - listen/1, listen/2, listen/3, stop/1]). +-export([subsystem_spec/1]). -export([init/1, handle_ssh_msg/2, handle_msg/2, terminate/2]). @@ -76,29 +75,6 @@ subsystem_spec(Options) -> {"sftp", {?MODULE, Options}}. -%%% DEPRECATED START %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%-------------------------------------------------------------------- -%% Function: listen() -> Pid | {error,Error} -%% Description: Starts the server -%%-------------------------------------------------------------------- -listen(Port) -> - listen(any, Port, []). -listen(Port, Options) -> - listen(any, Port, Options). -listen(Addr, Port, Options) -> - SubSystems = [subsystem_spec(Options)], - ssh:daemon(Addr, Port, [{subsystems, SubSystems} |Options]). - -%%-------------------------------------------------------------------- -%% Function: stop(Pid) -> ok -%% Description: Stops the listener -%%-------------------------------------------------------------------- -stop(Pid) -> - ssh:stop_listener(Pid). - - -%%% DEPRECATED END %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%==================================================================== %% subsystem callbacks diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_subsystem_sup.erl index cf82db458f..cf409ade6b 100644 --- a/lib/ssh/src/ssh_subsystem_sup.erl +++ b/lib/ssh/src/ssh_subsystem_sup.erl @@ -28,7 +28,7 @@ -include("ssh.hrl"). --export([start_link/1, +-export([start_link/5, connection_supervisor/1, channel_supervisor/1 ]). @@ -39,8 +39,8 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link(Options) -> - supervisor:start_link(?MODULE, [Options]). +start_link(Role, Address, Port, Profile, Options) -> + supervisor:start_link(?MODULE, [Role, Address, Port, Profile, Options]). connection_supervisor(SupPid) -> Children = supervisor:which_children(SupPid), @@ -53,49 +53,40 @@ channel_supervisor(SupPid) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - -init([Options]) -> - RestartStrategy = one_for_all, - MaxR = 0, - MaxT = 3600, - Children = child_specs(Options), - {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. +init([Role, Address, Port, Profile, Options]) -> + SupFlags = #{strategy => one_for_all, + intensity => 0, + period => 3600 + }, + ChildSpecs = child_specs(Role, Address, Port, Profile, Options), + {ok, {SupFlags,ChildSpecs}}. %%%========================================================================= %%% Internal functions %%%========================================================================= -child_specs(Options) -> - case ?GET_INTERNAL_OPT(role, Options) of - client -> - []; - server -> - [ssh_channel_child_spec(Options), ssh_connectinon_child_spec(Options)] - end. +child_specs(client, _Address, _Port, _Profile, _Options) -> + []; +child_specs(server, Address, Port, Profile, Options) -> + [ssh_channel_child_spec(server, Address, Port, Profile, Options), + ssh_connection_child_spec(server, Address, Port, Profile, Options)]. -ssh_connectinon_child_spec(Options) -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), - Role = ?GET_INTERNAL_OPT(role, Options), - Name = id(Role, ssh_connection_sup, Address, Port), - StartFunc = {ssh_connection_sup, start_link, [Options]}, - Restart = temporary, - Shutdown = 5000, - Modules = [ssh_connection_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -ssh_channel_child_spec(Options) -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), - Role = ?GET_INTERNAL_OPT(role, Options), - Name = id(Role, ssh_channel_sup, Address, Port), - StartFunc = {ssh_channel_sup, start_link, [Options]}, - Restart = temporary, - Shutdown = infinity, - Modules = [ssh_channel_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. +ssh_connection_child_spec(Role, Address, Port, _Profile, Options) -> + #{id => id(Role, ssh_connection_sup, Address, Port), + start => {ssh_connection_sup, start_link, [Options]}, + restart => temporary, + shutdown => 5000, + type => supervisor, + modules => [ssh_connection_sup] + }. + +ssh_channel_child_spec(Role, Address, Port, _Profile, Options) -> + #{id => id(Role, ssh_channel_sup, Address, Port), + start => {ssh_channel_sup, start_link, [Options]}, + restart => temporary, + shutdown => infinity, + type => supervisor, + modules => [ssh_channel_sup] + }. id(Role, Sup, Address, Port) -> {Role, Sup, Address, Port}. diff --git a/lib/ssh/src/ssh_sup.erl b/lib/ssh/src/ssh_sup.erl index 8b57387589..26574763e4 100644 --- a/lib/ssh/src/ssh_sup.erl +++ b/lib/ssh/src/ssh_sup.erl @@ -31,63 +31,20 @@ %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - -init([]) -> - SupFlags = {one_for_one, 10, 3600}, - Children = children(), - {ok, {SupFlags, Children}}. - -%%%========================================================================= -%%% Internal functions -%%%========================================================================= -get_services() -> - case (catch application:get_env(ssh, services)) of - {ok, Services} -> - Services; - _ -> - [] - end. - -children() -> - Services = get_services(), - Clients = [Service || Service <- Services, is_client(Service)], - Servers = [Service || Service <- Services, is_server(Service)], - - [server_child_spec(Servers), client_child_spec(Clients)]. - -server_child_spec(Servers) -> - Name = sshd_sup, - StartFunc = {sshd_sup, start_link, [Servers]}, - Restart = permanent, - Shutdown = infinity, - Modules = [sshd_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -client_child_spec(Clients) -> - Name = sshc_sup, - StartFunc = {sshc_sup, start_link, [Clients]}, - Restart = permanent, - Shutdown = infinity, - Modules = [sshc_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -is_server({sftpd, _}) -> - true; -is_server({shelld, _}) -> - true; -is_server(_) -> - false. - -is_client({sftpc, _}) -> - true; -is_client({shellc, _}) -> - true; -is_client(_) -> - false. - - - +init(_) -> + SupFlags = #{strategy => one_for_one, + intensity => 10, + period => 3600 + }, + ChildSpecs = [#{id => Module, + start => {Module, start_link, []}, + restart => permanent, + shutdown => 4000, %brutal_kill, + type => supervisor, + modules => [Module] + } + || Module <- [sshd_sup, + sshc_sup] + ], + {ok, {SupFlags,ChildSpecs}}. diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index b0bbd3aae5..84b4cd3241 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -21,7 +21,7 @@ %% %%---------------------------------------------------------------------- %% Purpose: The ssh server instance supervisor, an instans of this supervisor -%% exists for every ip-address and port combination, hangs under +%% exists for every ip-address and port combination, hangs under %% sshd_sup. %%---------------------------------------------------------------------- @@ -31,64 +31,103 @@ -include("ssh.hrl"). --export([start_link/1, stop_listener/1, +-export([start_link/4, stop_listener/1, stop_listener/3, stop_system/1, stop_system/3, system_supervisor/3, - subsystem_supervisor/1, channel_supervisor/1, - connection_supervisor/1, - acceptor_supervisor/1, start_subsystem/2, restart_subsystem/3, - restart_acceptor/3, stop_subsystem/2]). + subsystem_supervisor/1, channel_supervisor/1, + connection_supervisor/1, + acceptor_supervisor/1, start_subsystem/6, + stop_subsystem/2]). %% Supervisor callback -export([init/1]). %%%========================================================================= -%%% Internal API +%%% API %%%========================================================================= -start_link(Options) -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), - Profile = ?GET_OPT(profile, Options), +start_link(Address, Port, Profile, Options) -> Name = make_name(Address, Port, Profile), - supervisor:start_link({local, Name}, ?MODULE, [Options]). + supervisor:start_link({local, Name}, ?MODULE, [Address, Port, Profile, Options]). -stop_listener(SysSup) -> - stop_acceptor(SysSup). +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init([Address, Port, Profile, Options]) -> + SupFlags = #{strategy => one_for_one, + intensity => 0, + period => 3600 + }, + ChildSpecs = + case ?GET_INTERNAL_OPT(connected_socket,Options,undefined) of + undefined -> + [#{id => id(ssh_acceptor_sup, Address, Port, Profile), + start => {ssh_acceptor_sup, start_link, [Address, Port, Profile, Options]}, + restart => transient, + shutdown => infinity, + type => supervisor, + modules => [ssh_acceptor_sup] + }]; + _ -> + [] + end, + {ok, {SupFlags,ChildSpecs}}. + +%%%========================================================================= +%%% Service API +%%%========================================================================= +stop_listener(SystemSup) -> + {Name, AcceptorSup, _, _} = lookup(ssh_acceptor_sup, SystemSup), + case supervisor:terminate_child(AcceptorSup, Name) of + ok -> + supervisor:delete_child(AcceptorSup, Name); + Error -> + Error + end. stop_listener(Address, Port, Profile) -> - Name = make_name(Address, Port, Profile), - stop_acceptor(whereis(Name)). - + stop_listener( + system_supervisor(Address, Port, Profile)). + + stop_system(SysSup) -> - Name = sshd_sup:system_name(SysSup), - spawn(fun() -> sshd_sup:stop_child(Name) end), + spawn(fun() -> sshd_sup:stop_child(SysSup) end), ok. -stop_system(Address, Port, Profile) -> +stop_system(Address, Port, Profile) -> spawn(fun() -> sshd_sup:stop_child(Address, Port, Profile) end), ok. + system_supervisor(Address, Port, Profile) -> Name = make_name(Address, Port, Profile), whereis(Name). subsystem_supervisor(SystemSup) -> - ssh_subsystem_sup(supervisor:which_children(SystemSup)). + {_, Child, _, _} = lookup(ssh_subsystem_sup, SystemSup), + Child. channel_supervisor(SystemSup) -> - SubSysSup = ssh_subsystem_sup(supervisor:which_children(SystemSup)), - ssh_subsystem_sup:channel_supervisor(SubSysSup). + ssh_subsystem_sup:channel_supervisor( + subsystem_supervisor(SystemSup)). connection_supervisor(SystemSup) -> - SubSysSup = ssh_subsystem_sup(supervisor:which_children(SystemSup)), - ssh_subsystem_sup:connection_supervisor(SubSysSup). + ssh_subsystem_sup:connection_supervisor( + subsystem_supervisor(SystemSup)). acceptor_supervisor(SystemSup) -> - ssh_acceptor_sup(supervisor:which_children(SystemSup)). + {_, Child, _, _} = lookup(ssh_acceptor_sup, SystemSup), + Child. -start_subsystem(SystemSup, Options) -> - Spec = ssh_subsystem_child_spec(Options), - supervisor:start_child(SystemSup, Spec). + +start_subsystem(SystemSup, Role, Address, Port, Profile, Options) -> + SubsystemSpec = + #{id => make_ref(), + start => {ssh_subsystem_sup, start_link, [Role, Address, Port, Profile, Options]}, + restart => temporary, + shutdown => infinity, + type => supervisor, + modules => [ssh_subsystem_sup]}, + supervisor:start_child(SystemSup, SubsystemSpec). stop_subsystem(SystemSup, SubSys) -> case catch lists:keyfind(SubSys, 2, supervisor:which_children(SystemSup)) of @@ -106,100 +145,21 @@ stop_subsystem(SystemSup, SubSys) -> ok end. - -restart_subsystem(Address, Port, Profile) -> - SysSupName = make_name(Address, Port, Profile), - SubSysName = id(ssh_subsystem_sup, Address, Port, Profile), - case supervisor:terminate_child(SysSupName, SubSysName) of - ok -> - supervisor:restart_child(SysSupName, SubSysName); - Error -> - Error - end. - -restart_acceptor(Address, Port, Profile) -> - SysSupName = make_name(Address, Port, Profile), - AcceptorName = id(ssh_acceptor_sup, Address, Port, Profile), - supervisor:restart_child(SysSupName, AcceptorName). - -%%%========================================================================= -%%% Supervisor callback -%%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - -init([Options]) -> - RestartStrategy = one_for_one, - MaxR = 0, - MaxT = 3600, - Children = case ?GET_INTERNAL_OPT(asocket,Options,undefined) of - undefined -> child_specs(Options); - _ -> [] - end, - {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. - %%%========================================================================= %%% Internal functions %%%========================================================================= -child_specs(Options) -> - [ssh_acceptor_child_spec(Options)]. - -ssh_acceptor_child_spec(Options) -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), - Profile = ?GET_OPT(profile, Options), - Name = id(ssh_acceptor_sup, Address, Port, Profile), - StartFunc = {ssh_acceptor_sup, start_link, [Options]}, - Restart = transient, - Shutdown = infinity, - Modules = [ssh_acceptor_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -ssh_subsystem_child_spec(Options) -> - Name = make_ref(), - StartFunc = {ssh_subsystem_sup, start_link, [Options]}, - Restart = temporary, - Shutdown = infinity, - Modules = [ssh_subsystem_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - - id(Sup, Address, Port, Profile) -> - case is_list(Address) of - true -> - {Sup, any, Port, Profile}; - false -> - {Sup, Address, Port, Profile} - end. + {Sup, Address, Port, Profile}. make_name(Address, Port, Profile) -> - case is_list(Address) of - true -> - list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", - [any, Port, Profile]))); - false -> - list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", - [Address, Port, Profile]))) - end. + list_to_atom(lists:flatten(io_lib:format("ssh_system_~s_~p_~p_sup", [fmt_host(Address), Port, Profile]))). -ssh_subsystem_sup([{_, Child, _, [ssh_subsystem_sup]} | _]) -> - Child; -ssh_subsystem_sup([_ | Rest]) -> - ssh_subsystem_sup(Rest). +fmt_host(IP) when is_tuple(IP) -> inet:ntoa(IP); +fmt_host(A) when is_atom(A) -> A; +fmt_host(S) when is_list(S) -> S. -ssh_acceptor_sup([{_, Child, _, [ssh_acceptor_sup]} | _]) -> - Child; -ssh_acceptor_sup([_ | Rest]) -> - ssh_acceptor_sup(Rest). -stop_acceptor(Sup) -> - [{Name, AcceptorSup}] = - [{SupName, ASup} || {SupName, ASup, _, [ssh_acceptor_sup]} <- - supervisor:which_children(Sup)], - case supervisor:terminate_child(AcceptorSup, Name) of - ok -> - supervisor:delete_child(AcceptorSup, Name); - Error -> - Error - end. +lookup(SupModule, SystemSup) -> + lists:keyfind([SupModule], 4, + supervisor:which_children(SystemSup)). + diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 02c995399a..54ea80c727 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -200,9 +200,6 @@ is_valid_mac(Mac, Data, #ssh{recv_mac = Algorithm, recv_mac_key = Key, recv_sequence = SeqNum}) -> Mac == mac(Algorithm, Key, SeqNum, Data). -yes_no(Ssh, Prompt) -> - (Ssh#ssh.io_cb):yes_no(Prompt, Ssh). - format_version({Major,Minor}, SoftwareVersion) -> "SSH-" ++ integer_to_list(Major) ++ "." ++ integer_to_list(Minor) ++ "-" ++ SoftwareVersion. @@ -755,16 +752,44 @@ public_algo({#'ECPoint'{},{namedCurve,OID}}) -> accepted_host(Ssh, PeerName, Public, Opts) -> case ?GET_OPT(silently_accept_hosts, Opts) of - F when is_function(F,2) -> + + %% Original option values; User question and no host key fingerprints known. + %% Keep the original question unchanged: + false -> yes == yes_no(Ssh, "New host " ++ PeerName ++ " accept"); + true -> true; + + %% Variant: User question but with host key fingerprint in the question: + {false,Alg} -> + HostKeyAlg = (Ssh#ssh.algorithms)#alg.hkey, + Prompt = io_lib:format("The authenticity of the host can't be established.~n" + "~s host key fingerprint is ~s.~n" + "New host ~p accept", + [fmt_hostkey(HostKeyAlg), + public_key:ssh_hostkey_fingerprint(Alg,Public), + PeerName]), + yes == yes_no(Ssh, Prompt); + + %% Call-back alternatives: A user provided fun is called for the decision: + F when is_function(F,2) -> true == (catch F(PeerName, public_key:ssh_hostkey_fingerprint(Public))); + {DigestAlg,F} when is_function(F,2) -> - true == (catch F(PeerName, public_key:ssh_hostkey_fingerprint(DigestAlg,Public))); - true -> - true; - false -> - yes == yes_no(Ssh, "New host " ++ PeerName ++ " accept") + true == (catch F(PeerName, public_key:ssh_hostkey_fingerprint(DigestAlg,Public))) + end. + +yes_no(Ssh, Prompt) -> + (Ssh#ssh.io_cb):yes_no(Prompt, Ssh#ssh.opts). + + +fmt_hostkey('ssh-rsa') -> "RSA"; +fmt_hostkey('ssh-dss') -> "DSA"; +fmt_hostkey(A) when is_atom(A) -> fmt_hostkey(atom_to_list(A)); +fmt_hostkey("ecdsa"++_) -> "ECDSA"; +fmt_hostkey(X) -> X. + + known_host_key(#ssh{opts = Opts, key_cb = {KeyCb,KeyCbOpts}, peer = {PeerName,_}} = Ssh, Public, Alg) -> UserOpts = ?GET_OPT(user_options, Opts), diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 15858f36e1..c71b81dc6d 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -27,23 +27,25 @@ -behaviour(supervisor). --export([start_link/1, start_child/1, stop_child/1]). +-export([start_link/0, start_child/1, stop_child/1]). %% Supervisor callback -export([init/1]). +-define(SSHC_SUP, ?MODULE). + %%%========================================================================= %%% API %%%========================================================================= -start_link(Args) -> - supervisor:start_link({local, ?MODULE}, ?MODULE, [Args]). +start_link() -> + supervisor:start_link({local,?SSHC_SUP}, ?MODULE, []). start_child(Args) -> supervisor:start_child(?MODULE, Args). stop_child(Client) -> spawn(fun() -> - ClientSup = whereis(?MODULE), + ClientSup = whereis(?SSHC_SUP), supervisor:terminate_child(ClientSup, Client) end), ok. @@ -51,22 +53,17 @@ stop_child(Client) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - -init(Args) -> - RestartStrategy = simple_one_for_one, - MaxR = 0, - MaxT = 3600, - {ok, {{RestartStrategy, MaxR, MaxT}, [child_spec(Args)]}}. - -%%%========================================================================= -%%% Internal functions -%%%========================================================================= -child_spec(_) -> - Name = undefined, % As simple_one_for_one is used. - StartFunc = {ssh_connection_handler, start_link, []}, - Restart = temporary, - Shutdown = 4000, - Modules = [ssh_connection_handler], - Type = worker, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. +init(_) -> + SupFlags = #{strategy => simple_one_for_one, + intensity => 0, + period => 3600 + }, + ChildSpecs = [#{id => undefined, % As simple_one_for_one is used. + start => {ssh_connection_handler, start_link, []}, + restart => temporary, + shutdown => 4000, + type => worker, + modules => [ssh_connection_handler] + } + ], + {ok, {SupFlags,ChildSpecs}}. diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index 14f1937abd..449ba20d02 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -19,7 +19,7 @@ %% %% %%---------------------------------------------------------------------- -%% Purpose: The top supervisor for ssh servers hangs under +%% Purpose: The top supervisor for ssh servers hangs under %% ssh_sup. %%---------------------------------------------------------------------- @@ -29,90 +29,79 @@ -include("ssh.hrl"). --export([start_link/1, start_child/1, stop_child/1, - stop_child/3, system_name/1]). +-export([start_link/0, + start_child/4, + stop_child/1, + stop_child/3 +]). %% Supervisor callback -export([init/1]). +-define(SSHD_SUP, ?MODULE). + %%%========================================================================= %%% API %%%========================================================================= -start_link(Servers) -> - supervisor:start_link({local, ?MODULE}, ?MODULE, [Servers]). +start_link() -> + %% No children are start now. We wait until the user calls ssh:daemon + %% and uses start_child/4 to create the children + supervisor:start_link({local,?SSHD_SUP}, ?MODULE, []). -start_child(Options) -> - Address = ?GET_INTERNAL_OPT(address, Options), - Port = ?GET_INTERNAL_OPT(port, Options), - Profile = ?GET_OPT(profile, Options), +start_child(Address, Port, Profile, Options) -> case ssh_system_sup:system_supervisor(Address, Port, Profile) of undefined -> - Spec = child_spec(Address, Port, Options), - case supervisor:start_child(?MODULE, Spec) of - {error, already_present} -> - Name = id(Address, Port, Profile), - supervisor:delete_child(?MODULE, Name), - supervisor:start_child(?MODULE, Spec); - Reply -> - Reply - end; + %% Here we start listening on a new Host/Port/Profile + Spec = child_spec(Address, Port, Profile, Options), + supervisor:start_child(?SSHD_SUP, Spec); Pid -> + %% Here we resume listening on a new Host/Port/Profile after + %% haveing stopped listening to he same with ssh:stop_listen(Pid) AccPid = ssh_system_sup:acceptor_supervisor(Pid), - ssh_acceptor_sup:start_child(AccPid, Options) + ssh_acceptor_sup:start_child(AccPid, Address, Port, Profile, Options), + {ok,Pid} end. -stop_child(Name) -> - supervisor:terminate_child(?MODULE, Name). +stop_child(ChildId) when is_tuple(ChildId) -> + supervisor:terminate_child(?SSHD_SUP, ChildId); +stop_child(ChildPid) when is_pid(ChildPid)-> + stop_child(system_name(ChildPid)). -stop_child(Address, Port, Profile) -> - Name = id(Address, Port, Profile), - stop_child(Name). -system_name(SysSup) -> - Children = supervisor:which_children(sshd_sup), - system_name(SysSup, Children). +stop_child(Address, Port, Profile) -> + Id = id(Address, Port, Profile), + stop_child(Id). %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - -init([Servers]) -> - RestartStrategy = one_for_one, - MaxR = 10, - MaxT = 3600, - Fun = fun(ServerOpts) -> - Address = ?GET_INTERNAL_OPT(address, ServerOpts), - Port = ?GET_INTERNAL_OPT(port, ServerOpts), - child_spec(Address, Port, ServerOpts) - end, - Children = lists:map(Fun, Servers), - {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. +init(_) -> + SupFlags = #{strategy => one_for_one, + intensity => 10, + period => 3600 + }, + ChildSpecs = [ + ], + {ok, {SupFlags,ChildSpecs}}. %%%========================================================================= %%% Internal functions %%%========================================================================= -child_spec(Address, Port, Options) -> - Profile = ?GET_OPT(profile, Options), - Name = id(Address, Port,Profile), - StartFunc = {ssh_system_sup, start_link, [Options]}, - Restart = temporary, - Shutdown = infinity, - Modules = [ssh_system_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. +child_spec(Address, Port, Profile, Options) -> + #{id => id(Address, Port, Profile), + start => {ssh_system_sup, start_link, [Address, Port, Profile, Options]}, + restart => temporary, + shutdown => infinity, + type => supervisor, + modules => [ssh_system_sup] + }. id(Address, Port, Profile) -> - case is_list(Address) of - true -> - {server, ssh_system_sup, any, Port, Profile}; - false -> - {server, ssh_system_sup, Address, Port, Profile} + {server, ssh_system_sup, Address, Port, Profile}. + +system_name(SysSup) -> + case lists:keyfind(SysSup, 2, supervisor:which_children(?SSHD_SUP)) of + {Name, SysSup, _, _} -> Name; + false -> undefind end. -system_name([], _ ) -> - undefined; -system_name(SysSup, [{Name, SysSup, _, _} | _]) -> - Name; -system_name(SysSup, [_ | Rest]) -> - system_name(SysSup, Rest). diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 6f75d83c4a..2990d1e02a 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -235,13 +235,12 @@ sshc_simple_exec_os_cmd(Config) -> Parent = self(), Client = spawn( fun() -> - Cmd = lists:concat(["ssh -p ",Port, - " -C" - " -o UserKnownHostsFile=",KnownHosts, - " -o StrictHostKeyChecking=no" - " ",Host," 1+1."]), - Result = os:cmd(Cmd), - ct:log("~p~n = ~p",[Cmd, Result]), + Result = ssh_test_lib:open_sshc(Host, Port, + [" -C" + " -o UserKnownHostsFile=",KnownHosts, + " -o StrictHostKeyChecking=no" + ], + " 1+1."), Parent ! {result, self(), Result, "2"} end), receive diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index cdf6cf9ae1..089d191fea 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -46,7 +46,8 @@ exec_key_differs2/1, exec_key_differs3/1, exec_key_differs_fail/1, - idle_time/1, + idle_time_client/1, + idle_time_server/1, inet6_option/1, inet_option/1, internal_error/1, @@ -139,7 +140,7 @@ basic_tests() -> exec, exec_compressed, shell, shell_no_unicode, shell_unicode_string, cli, known_hosts, - idle_time, openssh_zlib_basic_test, + idle_time_client, idle_time_server, openssh_zlib_basic_test, misc_ssh_options, inet_option, inet6_option]. @@ -522,8 +523,8 @@ exec_compressed(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- -%%% Idle timeout test -idle_time(Config) -> +%%% Idle timeout test, client +idle_time_client(Config) -> SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), UserDir = proplists:get_value(priv_dir, Config), @@ -544,6 +545,28 @@ idle_time(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +%%% Idle timeout test, server +idle_time_server(Config) -> + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {idle_time, 2000}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}]), + {ok, Id} = ssh_connection:session_channel(ConnectionRef, 1000), + ssh_connection:close(ConnectionRef, Id), + receive + after 10000 -> + {error, closed} = ssh_connection:session_channel(ConnectionRef, 1000) + end, + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- %%% Test that ssh:shell/2 works shell(Config) when is_list(Config) -> process_flag(trap_exit, true), @@ -719,7 +742,8 @@ known_hosts(Config) when is_list(Config) -> Lines = string:tokens(binary_to_list(Binary), "\n"), [Line] = Lines, [HostAndIp, Alg, _KeyData] = string:tokens(Line, " "), - [Host, _Ip] = string:tokens(HostAndIp, ","), + [StoredHost, _Ip] = string:tokens(HostAndIp, ","), + true = ssh_test_lib:match_ip(StoredHost, Host), "ssh-" ++ _ = Alg, ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl index ac52bb7e28..317e50ed1d 100644 --- a/lib/ssh/test/ssh_bench_SUITE.erl +++ b/lib/ssh/test/ssh_bench_SUITE.erl @@ -98,7 +98,7 @@ end_per_testcase(_Func, _Conf) -> connect(Config) -> KexAlgs = proplists:get_value(kex, ssh:default_algorithms()), - ct:pal("KexAlgs = ~p",[KexAlgs]), + ct:log("KexAlgs = ~p",[KexAlgs]), lists:foreach( fun(KexAlg) -> PrefAlgs = preferred_algorithms(KexAlg), @@ -242,11 +242,11 @@ median(Data) when is_list(Data) -> 1 -> lists:nth(N div 2 + 1, SortedData) end, - ct:pal("median(~p) = ~p",[SortedData,Median]), + ct:log("median(~p) = ~p",[SortedData,Median]), Median. report(Data) -> - ct:pal("EventData = ~p",[Data]), + ct:log("EventData = ~p",[Data]), ct_event:notify(#event{name = benchmark_data, data = Data}). diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 2819a4dbd9..b911cf0e9e 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -89,7 +89,7 @@ end_per_suite(Config) -> %%-------------------------------------------------------------------- init_per_group(openssh, Config) -> - case gen_tcp:connect("localhost", 22, []) of + case ssh_test_lib:gen_tcp_connect("localhost", 22, []) of {error,econnrefused} -> {skip,"No openssh deamon"}; {ok, Socket} -> @@ -126,7 +126,7 @@ simple_exec(Config) when is_list(Config) -> simple_exec_sock(_Config) -> - {ok, Sock} = gen_tcp:connect("localhost", ?SSH_DEFAULT_PORT, [{active,false}]), + {ok, Sock} = ssh_test_lib:gen_tcp_connect("localhost", ?SSH_DEFAULT_PORT, [{active,false}]), {ok, ConnectionRef} = ssh:connect(Sock, [{silently_accept_hosts, true}, {user_interaction, false}]), do_simple_exec(ConnectionRef). @@ -179,13 +179,13 @@ daemon_sock_not_tcp(_Config) -> %%-------------------------------------------------------------------- connect_sock_not_passive(_Config) -> - {ok,Sock} = gen_tcp:connect("localhost", ?SSH_DEFAULT_PORT, []), + {ok,Sock} = ssh_test_lib:gen_tcp_connect("localhost", ?SSH_DEFAULT_PORT, []), {error, not_passive_mode} = ssh:connect(Sock, []), gen_tcp:close(Sock). %%-------------------------------------------------------------------- daemon_sock_not_passive(_Config) -> - {ok,Sock} = gen_tcp:connect("localhost", ?SSH_DEFAULT_PORT, []), + {ok,Sock} = ssh_test_lib:gen_tcp_connect("localhost", ?SSH_DEFAULT_PORT, []), {error, not_passive_mode} = ssh:daemon(Sock), gen_tcp:close(Sock). @@ -585,12 +585,13 @@ start_shell_sock_exec_fun(Config) when is_list(Config) -> UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), SysDir = proplists:get_value(data_dir, Config), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}, - {exec, fun ssh_exec/1}]), + {Pid, HostD, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, fun ssh_exec/1}]), + Host = ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(HostD)), - {ok, Sock} = gen_tcp:connect(Host, Port, [{active,false}]), + {ok, Sock} = ssh_test_lib:gen_tcp_connect(Host, Port, [{active,false}]), {ok,ConnectionRef} = ssh:connect(Sock, [{silently_accept_hosts, true}, {user, "foo"}, {password, "morot"}, @@ -623,7 +624,7 @@ start_shell_sock_daemon_exec(Config) -> {ok,{_IP,Port}} = inet:sockname(Sl), % _IP is likely to be {0,0,0,0}. Win don't like... spawn_link(fun() -> - {ok,Ss} = gen_tcp:connect("localhost", Port, [{active,false}]), + {ok,Ss} = ssh_test_lib:gen_tcp_connect("localhost", Port, [{active,false}]), {ok, _Pid} = ssh:daemon(Ss, [{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, @@ -658,10 +659,10 @@ gracefull_invalid_version(Config) when is_list(Config) -> SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}]), + {user_dir, UserDir}, + {password, "morot"}]), - {ok, S} = gen_tcp:connect(Host, Port, []), + {ok, S} = ssh_test_lib:gen_tcp_connect(Host, Port, []), ok = gen_tcp:send(S, ["SSH-8.-1","\r\n"]), receive Verstring -> @@ -680,10 +681,10 @@ gracefull_invalid_start(Config) when is_list(Config) -> file:make_dir(UserDir), SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}]), + {user_dir, UserDir}, + {password, "morot"}]), - {ok, S} = gen_tcp:connect(Host, Port, []), + {ok, S} = ssh_test_lib:gen_tcp_connect(Host, Port, []), ok = gen_tcp:send(S, ["foobar","\r\n"]), receive Verstring -> @@ -702,10 +703,10 @@ gracefull_invalid_long_start(Config) when is_list(Config) -> file:make_dir(UserDir), SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}]), + {user_dir, UserDir}, + {password, "morot"}]), - {ok, S} = gen_tcp:connect(Host, Port, []), + {ok, S} = ssh_test_lib:gen_tcp_connect(Host, Port, []), ok = gen_tcp:send(S, [lists:duplicate(257, $a), "\r\n"]), receive Verstring -> @@ -725,10 +726,10 @@ gracefull_invalid_long_start_no_nl(Config) when is_list(Config) -> file:make_dir(UserDir), SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}]), + {user_dir, UserDir}, + {password, "morot"}]), - {ok, S} = gen_tcp:connect(Host, Port, []), + {ok, S} = ssh_test_lib:gen_tcp_connect(Host, Port, []), ok = gen_tcp:send(S, [lists:duplicate(257, $a), "\r\n"]), receive Verstring -> @@ -779,22 +780,21 @@ stop_listener(Config) when is_list(Config) -> ct:fail("Exec Timeout") end, - {ok, HostAddr} = inet:getaddr(Host, inet), - case ssh_test_lib:daemon(HostAddr, Port, [{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "potatis"}, - {exec, fun ssh_exec/1}]) of - {Pid1, HostAddr, Port} -> + case ssh_test_lib:daemon(Port, [{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "potatis"}, + {exec, fun ssh_exec/1}]) of + {Pid1, Host, Port} -> ConnectionRef1 = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {user, "foo"}, {password, "potatis"}, {user_interaction, true}, {user_dir, UserDir}]), {error, _} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "morot"}, - {user_interaction, true}, - {user_dir, UserDir}]), + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), ssh:close(ConnectionRef0), ssh:close(ConnectionRef1), ssh:stop_daemon(Pid0), diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 758c20e2b8..344a042d79 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -868,13 +868,13 @@ really_do_hostkey_fingerprint_check(Config, HashAlg) -> ct:log("Fingerprints(~p) = ~p",[HashAlg,FPs]), %% Start daemon with the public keys that we got fingerprints from - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {Pid, Host0, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDirServer}, {password, "morot"}]), - + Host = ssh_test_lib:ntoa(Host0), FP_check_fun = fun(PeerName, FP) -> - ct:pal("PeerName = ~p, FP = ~p",[PeerName,FP]), - HostCheck = (Host == PeerName), + ct:log("PeerName = ~p, FP = ~p",[PeerName,FP]), + HostCheck = ssh_test_lib:match_ip(Host, PeerName), FPCheck = if is_atom(HashAlg) -> lists:member(FP, FPs); is_list(HashAlg) -> lists:all(fun(FP1) -> lists:member(FP1,FPs) end, @@ -1052,20 +1052,20 @@ id_string_random_client(Config) -> %%-------------------------------------------------------------------- id_string_no_opt_server(Config) -> {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, []), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), + {ok,S1}=ssh_test_lib:gen_tcp_connect(Host,Port,[{active,false},{packet,line}]), {ok,"SSH-2.0-Erlang/"++Vsn} = gen_tcp:recv(S1, 0, 2000), true = expected_ssh_vsn(Vsn). %%-------------------------------------------------------------------- id_string_own_string_server(Config) -> {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, [{id_string,"Olle"}]), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), + {ok,S1}=ssh_test_lib:gen_tcp_connect(Host,Port,[{active,false},{packet,line}]), {ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000). %%-------------------------------------------------------------------- id_string_random_server(Config) -> {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, [{id_string,random}]), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), + {ok,S1}=ssh_test_lib:gen_tcp_connect(Host,Port,[{active,false},{packet,line}]), {ok,"SSH-2.0-"++Rnd} = gen_tcp:recv(S1, 0, 2000), case Rnd of "Erlang"++_ -> ct:log("Id=~p",[Rnd]), @@ -1086,11 +1086,11 @@ ssh_connect_negtimeout(Config, Parallel) -> ct:log("Parallel: ~p",[Parallel]), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, - {parallel_login, Parallel}, - {negotiation_timeout, NegTimeOut}, - {failfun, fun ssh_test_lib:failfun/2}]), - - {ok,Socket} = gen_tcp:connect(Host, Port, []), + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + + {ok,Socket} = ssh_test_lib:gen_tcp_connect(Host, Port, []), Factor = 2, ct:log("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), diff --git a/lib/ssh/test/ssh_relay.erl b/lib/ssh/test/ssh_relay.erl index 28000fbb97..1e3810e9d4 100644 --- a/lib/ssh/test/ssh_relay.erl +++ b/lib/ssh/test/ssh_relay.erl @@ -131,7 +131,8 @@ init([ListenAddr, ListenPort, PeerAddr, PeerPort | _Options]) -> S = #state{local_addr = ListenAddr, local_port = ListenPort, lpid = LPid, - peer_addr = PeerAddr, + peer_addr = ssh_test_lib:ntoa( + ssh_test_lib:mangle_connect_address(PeerAddr)), peer_port = PeerPort }, {ok, S}; diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index acf76157a2..7efeb3a0ad 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -660,7 +660,7 @@ start_channel_sock(Config) -> {Host,Port} = proplists:get_value(peer, Config), %% Get a tcp socket - {ok, Sock} = gen_tcp:connect(Host, Port, [{active,false}]), + {ok, Sock} = ssh_test_lib:gen_tcp_connect(Host, Port, [{active,false}]), %% and open one channel on one new Connection {ok, ChPid1, Conn} = ssh_sftp:start_channel(Sock, Opts), diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index b167f98ac8..379c0bcb0a 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -151,8 +151,8 @@ init_per_testcase(TestCase, Config) -> SubSystems = [ssh_sftpd:subsystem_spec([])], ssh:daemon(0, [{subsystems, SubSystems}|Options]) end, - {ok,Dinf} = ssh:daemon_info(Sftpd), - Port = proplists:get_value(port, Dinf), + + Port = ssh_test_lib:daemon_port(Sftpd), Cm = ssh_test_lib:connect(Port, [{user_dir, ClientUserDir}, @@ -187,7 +187,7 @@ init_per_testcase(TestCase, Config) -> [{sftp, {Cm, Channel}}, {sftpd, Sftpd }| Config]. end_per_testcase(_TestCase, Config) -> - ssh_sftpd:stop(proplists:get_value(sftpd, Config)), + catch ssh:stop_daemon(proplists:get_value(sftpd, Config)), {Cm, Channel} = proplists:get_value(sftp, Config), ssh_connection:close(Cm, Channel), ssh:close(Cm), @@ -705,10 +705,10 @@ try_access(Path, Cm, Channel, ReqId) -> {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(Code), Rest/binary>>, <<>>} -> case Code of ?SSH_FX_FILE_IS_A_DIRECTORY -> - ct:pal("Got the expected SSH_FX_FILE_IS_A_DIRECTORY status",[]), + ct:log("Got the expected SSH_FX_FILE_IS_A_DIRECTORY status",[]), ok; ?SSH_FX_FAILURE -> - ct:pal("Got the expected SSH_FX_FAILURE status",[]), + ct:log("Got the expected SSH_FX_FAILURE status",[]), ok; _ -> case Rest of diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index b4d7eadfa4..9b5d6b5fae 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -138,7 +138,7 @@ init_per_testcase(TestCase, Config) -> [{port, Port}, {sftp, {ChannelPid, Connection}}, {sftpd, Sftpd} | NewConfig]. end_per_testcase(_TestCase, Config) -> - catch ssh_sftpd:stop(proplists:get_value(sftpd, Config)), + catch ssh:stop_daemon(proplists:get_value(sftpd, Config)), {Sftp, Connection} = proplists:get_value(sftp, Config), catch ssh_sftp:stop_channel(Sftp), catch ssh:close(Connection), diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index ff53e1c4c6..dd7c4b1473 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -41,7 +41,8 @@ suite() -> {timetrap,{seconds,100}}]. all() -> - [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. + [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile, + killed_acceptor_restarts]. groups() -> []. @@ -100,6 +101,7 @@ default_tree(Config) when is_list(Config) -> ?wait_match([], supervisor:which_children(sshc_sup)), ?wait_match([], supervisor:which_children(sshd_sup)). +%%------------------------------------------------------------------------- sshc_subtree() -> [{doc, "Make sure the sshc subtree is correct"}]. sshc_subtree(Config) when is_list(Config) -> @@ -128,27 +130,31 @@ sshc_subtree(Config) when is_list(Config) -> ssh:close(Pid2), ?wait_match([], supervisor:which_children(sshc_sup)). +%%------------------------------------------------------------------------- sshd_subtree() -> [{doc, "Make sure the sshd subtree is correct"}]. sshd_subtree(Config) when is_list(Config) -> HostIP = proplists:get_value(host_ip, Config), Port = proplists:get_value(port, Config), SystemDir = proplists:get_value(data_dir, Config), - ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, - {failfun, fun ssh_test_lib:failfun/2}, - {user_passwords, - [{?USER, ?PASSWD}]}]), + {ok,Daemon} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), - ?wait_match([{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + ct:log("Expect HostIP=~p, Port=~p, Daemon=~p",[HostIP,Port,Daemon]), + ?wait_match([{{server,ssh_system_sup, ListenIP, Port, ?DEFAULT_PROFILE}, Daemon, supervisor, [ssh_system_sup]}], supervisor:which_children(sshd_sup), - Daemon), + [ListenIP,Daemon]), + true = ssh_test_lib:match_ip(HostIP, ListenIP), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port), ct:sleep(?WAIT_FOR_SHUTDOWN), ?wait_match([], supervisor:which_children(sshd_sup)). +%%------------------------------------------------------------------------- sshd_subtree_profile() -> [{doc, "Make sure the sshd subtree using profile option is correct"}]. sshd_subtree_profile(Config) when is_list(Config) -> @@ -157,34 +163,105 @@ sshd_subtree_profile(Config) when is_list(Config) -> Profile = proplists:get_value(profile, Config), SystemDir = proplists:get_value(data_dir, Config), - {ok, _} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, - {failfun, fun ssh_test_lib:failfun/2}, - {user_passwords, - [{?USER, ?PASSWD}]}, - {profile, Profile}]), - ?wait_match([{{server,ssh_system_sup, HostIP,Port,Profile}, + {ok, Daemon} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}, + {profile, Profile}]), + ct:log("Expect HostIP=~p, Port=~p, Profile=~p, Daemon=~p",[HostIP,Port,Profile,Daemon]), + ?wait_match([{{server,ssh_system_sup, ListenIP,Port,Profile}, Daemon, supervisor, [ssh_system_sup]}], supervisor:which_children(sshd_sup), - Daemon), + [ListenIP,Daemon]), + true = ssh_test_lib:match_ip(HostIP, ListenIP), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port, Profile), ct:sleep(?WAIT_FOR_SHUTDOWN), ?wait_match([], supervisor:which_children(sshd_sup)). +%%------------------------------------------------------------------------- +killed_acceptor_restarts(Config) -> + Profile = proplists:get_value(profile, Config), + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(userdir, Config), + {ok, DaemonPid} = ssh:daemon(0, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, [{?USER, ?PASSWD}]}, + {profile, Profile}]), + + {ok, DaemonPid2} = ssh:daemon(0, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, [{?USER, ?PASSWD}]}, + {profile, Profile}]), + + Port = ssh_test_lib:daemon_port(DaemonPid), + Port2 = ssh_test_lib:daemon_port(DaemonPid2), + true = (Port /= Port2), + + ct:pal("~s",[lists:flatten(ssh_info:string())]), + + {ok,[{AccPid,ListenAddr,Port}]} = acceptor_pid(DaemonPid), + {ok,[{AccPid2,ListenAddr,Port2}]} = acceptor_pid(DaemonPid2), + + true = (AccPid /= AccPid2), + + %% Connect first client and check it is alive: + {ok,C1} = ssh:connect("localhost", Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, + {password, ?PASSWD}, + {user_dir, UserDir}]), + [{client_version,_}] = ssh:connection_info(C1,[client_version]), + + %% Make acceptor restart: + exit(AccPid, kill), + %% Check it is a new acceptor: + {ok,[{AccPid1,ListenAddr,Port}]} = acceptor_pid(DaemonPid), + true = (AccPid /= AccPid1), + true = (AccPid2 /= AccPid1), + + %% Connect second client and check it is alive: + {ok,C2} = ssh:connect("localhost", Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, + {password, ?PASSWD}, + {user_dir, UserDir}]), + [{client_version,_}] = ssh:connection_info(C2,[client_version]), + + ct:pal("~s",[lists:flatten(ssh_info:string())]), + + %% Check first client is still alive: + [{client_version,_}] = ssh:connection_info(C1,[client_version]), + + ok = ssh:stop_daemon(DaemonPid2), + timer:sleep(15000), + [{client_version,_}] = ssh:connection_info(C1,[client_version]), + [{client_version,_}] = ssh:connection_info(C2,[client_version]), + + ok = ssh:stop_daemon(DaemonPid), + timer:sleep(15000), + {error,closed} = ssh:connection_info(C1,[client_version]), + {error,closed} = ssh:connection_info(C2,[client_version]). + +%%------------------------------------------------------------------------- +%% Help functions +%%------------------------------------------------------------------------- check_sshd_system_tree(Daemon, Config) -> Host = proplists:get_value(host, Config), Port = proplists:get_value(port, Config), UserDir = proplists:get_value(userdir, Config), {ok, Client} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, - {user_interaction, false}, - {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + {user_interaction, false}, + {user, ?USER}, + {password, ?PASSWD}, + {user_dir, UserDir}]), ?wait_match([{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}], supervisor:which_children(Daemon), - [SubSysSup,AccSup]), + [SubSysSup,AccSup]), ?wait_match([{{server,ssh_connection_sup, _,_}, ConnectionSup, supervisor, @@ -208,4 +285,33 @@ check_sshd_system_tree(Daemon, Config) -> ?wait_match([{_, _,worker,[ssh_channel]}], supervisor:which_children(ChannelSup)), ssh:close(Client). - + +acceptor_pid(DaemonPid) -> + Parent = self(), + Pid = spawn(fun() -> + Parent ! {self(), supsearch, + [{AccPid,ListenAddr,Port} + + || {{server,ssh_system_sup,ListenAddr,Port,NS}, + DPid,supervisor, + [ssh_system_sup]} <- supervisor:which_children(sshd_sup), + DPid == DaemonPid, + + {{ssh_acceptor_sup,L1,P1,NS1}, + AccSupPid,supervisor, + [ssh_acceptor_sup]} <- supervisor:which_children(DaemonPid), + L1 == ListenAddr, + P1 == Port, + NS1 == NS1, + + {{ssh_acceptor_sup,L2,P2,NS2}, + AccPid,worker, + [ssh_acceptor]} <- supervisor:which_children(AccSupPid), + L2 == ListenAddr, + P2 == Port, + NS2 == NS]} + end), + receive {Pid, supsearch, L} -> {ok,L} + after 2000 -> timeout + end. + diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 1673f52821..6186d44890 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -32,15 +32,18 @@ -define(TIMEOUT, 50000). +%%%---------------------------------------------------------------- connect(Port, Options) when is_integer(Port) -> connect(hostname(), Port, Options). connect(any, Port, Options) -> connect(hostname(), Port, Options); connect(Host, Port, Options) -> + ct:log("~p:~p Calling ssh:connect(~p, ~p, ~p)",[?MODULE,?LINE,Host, Port, Options]), {ok, ConnectionRef} = ssh:connect(Host, Port, Options), ConnectionRef. +%%%---------------------------------------------------------------- daemon(Options) -> daemon(any, 0, Options). @@ -53,23 +56,57 @@ daemon(Host, Options) -> daemon(Host, Port, Options) -> ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), case ssh:daemon(Host, Port, Options) of - {ok, Pid} when Host == any -> - ct:log("ssh:daemon ok (1)",[]), - {Pid, hostname(), daemon_port(Port,Pid)}; {ok, Pid} -> - ct:log("ssh:daemon ok (2)",[]), - {Pid, Host, daemon_port(Port,Pid)}; + {ok,L} = ssh:daemon_info(Pid), + ListenPort = proplists:get_value(port, L), + ListenIP = proplists:get_value(ip, L), + {Pid, ListenIP, ListenPort}; Error -> ct:log("ssh:daemon error ~p",[Error]), Error end. +%%%---------------------------------------------------------------- +daemon_port(Pid) -> daemon_port(0, Pid). + + daemon_port(0, Pid) -> {ok,Dinf} = ssh:daemon_info(Pid), proplists:get_value(port, Dinf); daemon_port(Port, _) -> Port. - +%%%---------------------------------------------------------------- +gen_tcp_connect(Host0, Port, Options) -> + Host = ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(Host0)), + ct:log("~p:~p gen_tcp:connect(~p, ~p, ~p)~nHost0 = ~p", + [?MODULE,?LINE, Host, Port, Options, Host0]), + Result = gen_tcp:connect(Host, Port, Options), + ct:log("~p:~p Result = ~p", [?MODULE,?LINE, Result]), + Result. + +%%%---------------------------------------------------------------- +open_sshc(Host0, Port, OptStr) -> + open_sshc(Host0, Port, OptStr, ""). +open_sshc(Host0, Port, OptStr, ExecStr) -> + Cmd = open_sshc_cmd(Host0, Port, OptStr, ExecStr), + Result = os:cmd(Cmd), + ct:log("~p:~p Result = ~p", [?MODULE,?LINE, Result]), + Result. + + +open_sshc_cmd(Host, Port, OptStr) -> + open_sshc_cmd(Host, Port, OptStr, ""). + +open_sshc_cmd(Host0, Port, OptStr, ExecStr) -> + Host = ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(Host0)), + Cmd = lists:flatten(["ssh -p ", integer_to_list(Port), + " ", OptStr, + " ", Host, + " ", ExecStr]), + ct:log("~p:~p OpenSSH Cmd = ~p", [?MODULE,?LINE, Cmd]), + Cmd. + +%%%---------------------------------------------------------------- std_daemon(Config, ExtraOpts) -> PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth @@ -85,6 +122,7 @@ std_daemon1(Config, ExtraOpts) -> {failfun, fun ssh_test_lib:failfun/2} | ExtraOpts]). +%%%---------------------------------------------------------------- std_connect(Config, Host, Port, ExtraOpts) -> UserDir = proplists:get_value(priv_dir, Config), _ConnectionRef = @@ -95,6 +133,7 @@ std_connect(Config, Host, Port, ExtraOpts) -> {user_interaction, false} | ExtraOpts]). +%%%---------------------------------------------------------------- std_simple_sftp(Host, Port, Config) -> std_simple_sftp(Host, Port, Config, []). @@ -109,6 +148,7 @@ std_simple_sftp(Host, Port, Config, Opts) -> ok = ssh:close(ConnectionRef), Data == ReadData. +%%%---------------------------------------------------------------- std_simple_exec(Host, Port, Config) -> std_simple_exec(Host, Port, Config, []). @@ -135,6 +175,7 @@ std_simple_exec(Host, Port, Config, Opts) -> ct:fail(ExecResult) end. +%%%---------------------------------------------------------------- start_shell(Port, IOServer) -> start_shell(Port, IOServer, []). @@ -149,6 +190,7 @@ start_shell(Port, IOServer, ExtraOptions) -> end). +%%%---------------------------------------------------------------- start_io_server() -> spawn_link(?MODULE, init_io_server, [self()]). @@ -207,8 +249,7 @@ reply(TestCase, Result) -> %%ct:log("reply ~p sending ~p ! ~p",[self(), TestCase, Result]), TestCase ! Result. - - +%%%---------------------------------------------------------------- rcv_expected(Expect, SshPort, Timeout) -> receive {SshPort, Recvd} when is_function(Expect) -> @@ -862,3 +903,73 @@ create_random_dir(Config) -> %% The likelyhood of always generating an existing file name is low create_random_dir(Config) end. + +%%%---------------------------------------------------------------- +match_ip(A, B) -> + R = match_ip0(A,B) orelse match_ip0(B,A), + ct:log("match_ip(~p, ~p) -> ~p",[A, B, R]), + R. + +match_ip0(A, A) -> + true; +match_ip0(any, _) -> + true; +match_ip0(A, B) -> + case match_ip1(A, B) of + true -> + true; + false when is_list(A) -> + case inet:parse_address(A) of + {ok,IPa} -> match_ip0(IPa, B); + _ -> false + end; + false when is_list(B) -> + case inet:parse_address(B) of + {ok,IPb} -> match_ip0(A, IPb); + _ -> false + end; + false -> + false + end. + +match_ip1(any, _) -> true; +match_ip1(loopback, {127,_,_,_}) -> true; +match_ip1({0,0,0,0}, {127,_,_,_}) -> true; +match_ip1(loopback, {0,0,0,0,0,0,0,1}) -> true; +match_ip1({0,0,0,0,0,0,0,0}, {0,0,0,0,0,0,0,1}) -> true; +match_ip1(_, _) -> false. + +%%%---------------------------------------------------------------- +mangle_connect_address(A) -> + mangle_connect_address(A, []). + +mangle_connect_address(A, SockOpts) -> + mangle_connect_address1(A, proplists:get_value(inet6,SockOpts,false)). + +loopback(true) -> {0,0,0,0,0,0,0,1}; +loopback(false) -> {127,0,0,1}. + +mangle_connect_address1( loopback, V6flg) -> loopback(V6flg); +mangle_connect_address1( any, V6flg) -> loopback(V6flg); +mangle_connect_address1({0,0,0,0}, _) -> loopback(false); +mangle_connect_address1({0,0,0,0,0,0,0,0}, _) -> loopback(true); +mangle_connect_address1( IP, _) when is_tuple(IP) -> IP; +mangle_connect_address1(A, _) -> + case catch inet:parse_address(A) of + {ok, {0,0,0,0}} -> loopback(false); + {ok, {0,0,0,0,0,0,0,0}} -> loopback(true); + _ -> A + end. + +%%%---------------------------------------------------------------- +ntoa(A) -> + try inet:ntoa(A) + of + {error,_} when is_atom(A) -> atom_to_list(A); + {error,_} when is_list(A) -> A; + S when is_list(S) -> S + catch + _:_ when is_atom(A) -> atom_to_list(A); + _:_ when is_list(A) -> A + end. + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 7eda009552..35e3ee3edf 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -376,18 +376,18 @@ erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> erlang_server_openssh_client_public_key_X(Config, ssh_rsa). -erlang_server_openssh_client_public_key_X(Config, PubKeyAlg) -> +erlang_server_openssh_client_public_key_X(Config, _PubKeyAlg) -> SystemDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}]), - ct:sleep(500), - Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o UserKnownHostsFile=" ++ KnownHosts ++ - " " ++ Host ++ " 1+1.", + Cmd = ssh_test_lib:open_sshc_cmd(Host, Port, + [" -o UserKnownHostsFile=", KnownHosts, + " -o StrictHostKeyChecking=no"], + "1+1."), OpenSsh = ssh_test_lib:open_port({spawn, Cmd}), ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT), ssh:stop_daemon(Pid). @@ -395,13 +395,13 @@ erlang_server_openssh_client_public_key_X(Config, PubKeyAlg) -> %%-------------------------------------------------------------------- %% Test that the Erlang/OTP server can renegotiate with openSSH erlang_server_openssh_client_renegotiate(Config) -> - PubKeyAlg = ssh_rsa, + _PubKeyAlg = ssh_rsa, SystemDir = proplists:get_value(data_dir, Config), PrivDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {failfun, fun ssh_test_lib:failfun/2}]), + {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), RenegLimitK = 3, @@ -409,11 +409,13 @@ erlang_server_openssh_client_renegotiate(Config) -> Data = lists:duplicate(trunc(1.1*RenegLimitK*1024), $a), ok = file:write_file(DataFile, Data), - Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o UserKnownHostsFile=" ++ KnownHosts ++ - " -o RekeyLimit=" ++ integer_to_list(RenegLimitK) ++"K" ++ - " " ++ Host ++ " < " ++ DataFile, - OpenSsh = ssh_test_lib:open_port({spawn, Cmd}), + Cmd = ssh_test_lib:open_sshc_cmd(Host, Port, + [" -o UserKnownHostsFile=", KnownHosts, + " -o StrictHostKeyChecking=no", + " -o RekeyLimit=",integer_to_list(RenegLimitK),"K"]), + + + OpenSsh = ssh_test_lib:open_port({spawn, Cmd++" < "++DataFile}), Expect = fun({data,R}) -> try @@ -462,7 +464,7 @@ erlang_client_openssh_server_renegotiate(_Config) -> {silently_accept_hosts,true}], group_leader(IO, self()), {ok, ConnRef} = ssh:connect(Host, ?SSH_DEFAULT_PORT, Options), - ct:pal("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]), + ct:log("Parent = ~p, IO = ~p, Shell = ~p, ConnRef = ~p~n",[Parent, IO, self(), ConnRef]), case ssh_connection:session_channel(ConnRef, infinity) of {ok,ChannelId} -> success = ssh_connection:ptty_alloc(ConnRef, ChannelId, []), diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index 261239c152..e1f4c65300 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -314,8 +314,7 @@ mangle_opts(Options) -> lists:keydelete(K,1,Opts) end, Options, SysOpts). -host({0,0,0,0}) -> "localhost"; -host(H) -> H. +host(H) -> ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(H)). %%%---------------------------------------------------------------- send(S=#s{ssh=C}, hello) -> diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 96c83cb0f7..48332d2e5a 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.4.1 +SSH_VSN = 4.4.2 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index d3ab3e9216..7ffb9c0e88 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -28,6 +28,24 @@ <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 8.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct active once emulation, for TLS. Now all data + received by the connection process will be delivered + through active once, even when the active once arrives + after that the gen_tcp socket is closed by the peer.</p> + <p> + Own Id: OTP-14300</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 8.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index f607c86ae3..16e0df2101 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -263,9 +263,14 @@ init({call, From}, {start, Timeout}, {Record, State} = next_record(State3), next_event(hello, Record, State, Actions); init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) -> - ssl_connection:init(Type, Event, - State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}}, - ?MODULE); + Result = ssl_connection:init(Type, Event, + State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}, + protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(), + previous_cookie_secret => <<>>}}, + ?MODULE), + erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret), + Result; + init({call, _} = Type, Event, #state{role = server} = State) -> %% I.E. DTLS over sctp ssl_connection:init(Type, Event, State#state{flight_state = reliable}, ?MODULE); @@ -288,10 +293,10 @@ error(_, _, _) -> hello(internal, #client_hello{cookie = <<>>, client_version = Version} = Hello, #state{role = server, transport_cb = Transport, - socket = Socket} = State0) -> - %% TODO: not hard code key + socket = Socket, + protocol_specific = #{current_cookie_secret := Secret}} = State0) -> {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), - Cookie = dtls_handshake:cookie(<<"secret">>, IP, Port, Hello), + Cookie = dtls_handshake:cookie(Secret, IP, Port, Hello), VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version), State1 = prepare_flight(State0#state{negotiated_version = Version}), {State2, Actions} = send_handshake(VerifyRequest, State1), @@ -299,15 +304,21 @@ hello(internal, #client_hello{cookie = <<>>, next_event(hello, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions); hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server, transport_cb = Transport, - socket = Socket} = State0) -> + socket = Socket, + protocol_specific = #{current_cookie_secret := Secret, + previous_cookie_secret := PSecret}} = State0) -> {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), - %% TODO: not hard code key - case dtls_handshake:cookie(<<"secret">>, IP, Port, Hello) of + case dtls_handshake:cookie(Secret, IP, Port, Hello) of Cookie -> handle_client_hello(Hello, State0); _ -> - %% Handle bad cookie as new cookie request RFC 6347 4.1.2 - hello(internal, Hello#client_hello{cookie = <<>>}, State0) + case dtls_handshake:cookie(PSecret, IP, Port, Hello) of + Cookie -> + handle_client_hello(Hello, State0); + _ -> + %% Handle bad cookie as new cookie request RFC 6347 4.1.2 + hello(internal, Hello#client_hello{cookie = <<>>}, State0) + end end; hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, host = Host, port = Port, @@ -471,9 +482,14 @@ handle_info({CloseTag, Socket}, StateName, end, ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), {stop, {shutdown, transport_closed}}; +handle_info(new_cookie_secret, StateName, #state{protocol_specific = #{cookie_secret := Secret} = CookieInfo} = State) -> + erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret), + {next_state, StateName, State#state{protocol_specific = CookieInfo#{cookie_secret => dtls_v1:cookie_secret(), + previous_cookie_secret => Secret}}}; handle_info(Msg, StateName, State) -> ssl_connection:handle_info(Msg, StateName, State). + handle_call(Event, From, StateName, State) -> ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 4c525fae1b..d3ba90a226 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -474,14 +474,12 @@ merge_fragments(#handshake_fragment{ fragment = <<PreviousData/binary, Data/binary>>}; %% already fully contained fragment merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen, - fragment = PreviousData - } = Previous, - #handshake_fragment{ - fragment_offset = CurrentOffSet, - fragment_length = CurrentLen, - fragment = CurrentData}) + fragment_offset = PreviousOffSet, + fragment_length = PreviousLen + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffSet, + fragment_length = CurrentLen}) when PreviousOffSet + PreviousLen >= CurrentOffSet andalso PreviousOffSet + PreviousLen >= CurrentOffSet + CurrentLen -> Previous; diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index dd0d35d404..4aaf8baa6c 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -22,7 +22,10 @@ -include("ssl_cipher.hrl"). -export([suites/1, all_suites/1, mac_hash/7, ecc_curves/1, - corresponding_tls_version/1, corresponding_dtls_version/1]). + corresponding_tls_version/1, corresponding_dtls_version/1, + cookie_secret/0, cookie_timeout/0]). + +-define(COOKIE_BASE_TIMEOUT, 30000). -spec suites(Minor:: 253|255) -> [ssl_cipher:cipher_suite()]. @@ -47,6 +50,13 @@ ecc_curves({_Major, Minor}) -> corresponding_tls_version({254, Minor}) -> {3, corresponding_minor_tls_version(Minor)}. +cookie_secret() -> + crypto:strong_rand_bytes(32). + +cookie_timeout() -> + %% Cookie will live for two timeouts periods + round(rand:uniform() * ?COOKIE_BASE_TIMEOUT/2). + corresponding_minor_tls_version(255) -> 2; corresponding_minor_tls_version(253) -> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index bfdd0c205b..2eda9d9491 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"8.1.1">>, [{load_module, tls_connection, soft_purge, soft_purge, []}]}, {<<"8\\..*">>, [{restart_application, ssl}]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, @@ -9,6 +10,7 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ + {<<"8.1.1">>, [{load_module, tls_connection, soft_purge, soft_purge, []}]}, {<<"8\\..*">>, [{restart_application, ssl}]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index b597c059af..368eaf6090 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -91,7 +91,8 @@ %% underlaying packet format. Introduced by DTLS - RFC 4347. %% The mecahnism is also usefull in TLS although we do not %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr - flight_state = reliable %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp. + flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp. + protocol_specific = #{} :: map() }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, #'DHParameter'{prime = ?DEFAULT_DIFFIE_HELLMAN_PRIME, diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index c10ec3a2d6..0fbaa82b6a 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -144,7 +144,7 @@ honor_ecc_order :: boolean(), v2_hello_compatible :: boolean(), max_handshake_size :: integer() - }). + }). -record(socket_options, { diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index c6e530e164..bda6bf0349 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -397,23 +397,36 @@ handle_info({Protocol, _, Data}, StateName, end; handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, + socket_options = #socket_options{active = Active}, + protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}, negotiated_version = Version} = State) -> + %% Note that as of TLS 1.1, %% failure to properly close a connection no longer requires that a %% session not be resumed. This is a change from TLS 1.0 to conform %% with widespread implementation practice. - case Version of - {1, N} when N >= 1 -> - ok; - _ -> - %% As invalidate_sessions here causes performance issues, - %% we will conform to the widespread implementation - %% practice and go aginst the spec - %%invalidate_session(Role, Host, Port, Session) - ok - end, - ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}}; + + case (Active == false) andalso (CTs =/= []) of + false -> + case Version of + {1, N} when N >= 1 -> + ok; + _ -> + %% As invalidate_sessions here causes performance issues, + %% we will conform to the widespread implementation + %% practice and go aginst the spec + %%invalidate_session(Role, Host, Port, Session) + ok + end, + + ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), + {stop, {shutdown, transport_closed}}; + true -> + %% Fixes non-delivery of final TLS record in {active, once}. + %% Basically allows the application the opportunity to set {active, once} again + %% and then receive the final message. + next_event(StateName, no_record, State) + end; handle_info(Msg, StateName, State) -> ssl_connection:handle_info(Msg, StateName, State). diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 415a47949d..82184f5c74 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 8.1.1 +SSL_VSN = 8.1.2 diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml index 57bb5207df..ea23cca2ee 100644 --- a/lib/stdlib/doc/src/assert_hrl.xml +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -4,7 +4,7 @@ <fileref> <header> <copyright> - <year>2012</year><year>2016</year> + <year>2012</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -92,18 +92,21 @@ erlc -DNOASSERT=true *.erl</code> <title>Macros</title> <taglist> <tag><c>assert(BoolExpr)</c></tag> - <tag><c>assert(BoolExpr, Comment)</c></tag> + <item></item> + <tag><c>URKAassert(BoolExpr, Comment)</c></tag> <item> <p>Tests that <c>BoolExpr</c> completes normally returning <c>true</c>.</p> </item> <tag><c>assertNot(BoolExpr)</c></tag> + <item></item> <tag><c>assertNot(BoolExpr, Comment)</c></tag> <item> <p>Tests that <c>BoolExpr</c> completes normally returning <c>false</c>.</p> </item> <tag><c>assertMatch(GuardedPattern, Expr)</c></tag> + <item></item> <tag><c>assertMatch(GuardedPattern, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that @@ -115,6 +118,7 @@ erlc -DNOASSERT=true *.erl</code> ?assertMatch({bork, X} when X > 0, f())</code> </item> <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag> + <item></item> <tag><c>assertNotMatch(GuardedPattern, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that does @@ -123,18 +127,21 @@ erlc -DNOASSERT=true *.erl</code> <c>when</c> part.</p> </item> <tag><c>assertEqual(ExpectedValue, Expr)</c></tag> + <item></item> <tag><c>assertEqual(ExpectedValue, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that is exactly equal to <c>ExpectedValue</c>.</p> </item> <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag> + <item></item> <tag><c>assertNotEqual(ExpectedValue, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes normally yielding a value that is not exactly equal to <c>ExpectedValue</c>.</p> </item> <tag><c>assertException(Class, Term, Expr)</c></tag> + <item></item> <tag><c>assertException(Class, Term, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> completes abnormally with an exception of type @@ -145,6 +152,7 @@ erlc -DNOASSERT=true *.erl</code> patterns, as in <c>assertMatch</c>.</p> </item> <tag><c>assertNotException(Class, Term, Expr)</c></tag> + <item></item> <tag><c>assertNotException(Class, Term, Expr, Comment)</c></tag> <item> <p>Tests that <c>Expr</c> does not evaluate abnormally with an @@ -155,16 +163,19 @@ erlc -DNOASSERT=true *.erl</code> be guarded patterns.</p> </item> <tag><c>assertError(Term, Expr)</c></tag> + <item></item> <tag><c>assertError(Term, Expr, Comment)</c></tag> <item> <p>Equivalent to <c>assertException(error, Term, Expr)</c></p> </item> <tag><c>assertExit(Term, Expr)</c></tag> + <item></item> <tag><c>assertExit(Term, Expr, Comment)</c></tag> <item> <p>Equivalent to <c>assertException(exit, Term, Expr)</c></p> </item> <tag><c>assertThrow(Term, Expr)</c></tag> + <item></item> <tag><c>assertThrow(Term, Expr, Comment)</c></tag> <item> <p>Equivalent to <c>assertException(throw, Term, Expr)</c></p> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 05401a2d40..d1ec176f81 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -1491,6 +1491,25 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code> </func> <func> + <name name="select_replace" arity="2"/> + <fsummary>Match and replace objects atomically in an ETS table</fsummary> + <desc> + <p>Matches the objects in the table <c><anno>Tab</anno></c> using a + <seealso marker="#match_spec">match specification</seealso>. If + an object is matched, the existing object is replaced with + the match specification result, which <em>must</em> retain + the original key or the operation will fail with <c>badarg</c>.</p> + <p>For the moment, due to performance and semantic constraints, + tables of type <c>bag</c> are not yet supported.</p> + <p>The function returns the total number of replaced objects.</p> + <note> + <p>The match/replacement operation atomicity scope is limited + to each individual object.</p> + </note> + </desc> + </func> + + <func> <name name="select_reverse" arity="1"/> <fsummary>Continue matching objects in an ETS table.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml index 931e50f6f2..5ae400da62 100644 --- a/lib/stdlib/doc/src/io_lib.xml +++ b/lib/stdlib/doc/src/io_lib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2016</year> + <year>1996</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -147,7 +147,7 @@ format string (that is, <c>~ts</c> or <c>~tc</c>), the resulting list can contain characters beyond the ISO Latin-1 character range (that is, numbers > 255). If so, the - result is not an ordinary Erlang <c>string()</c>, but can well be + result is still an ordinary Erlang <c>string()</c>, and can well be used in any context where Unicode data is allowed.</p> </desc> </func> @@ -384,6 +384,16 @@ </func> <func> + <name name="write_atom_as_latin1" arity="1"/> + <fsummary>Write an atom.</fsummary> + <desc> + <p>Returns the list of characters needed to print atom + <c><anno>Atom</anno></c>. Non-Latin-1 characters + are escaped.</p> + </desc> + </func> + + <func> <name name="write_char" arity="1"/> <fsummary>Write a character.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml index 8745e16908..2ddf3021ac 100644 --- a/lib/stdlib/doc/src/rand.xml +++ b/lib/stdlib/doc/src/rand.xml @@ -120,27 +120,50 @@ S0 = rand:seed_s(exsplus), {SND0, S2} = rand:normal_s(S1),</pre> <note> - <p>This random number generator is not cryptographically - strong. If a strong cryptographic random number generator is - needed, use one of functions in the - <seealso marker="crypto:crypto"><c>crypto</c></seealso> - module, for example, <seealso marker="crypto:crypto"> - <c>crypto:strong_rand_bytes/1</c></seealso>.</p> + <p>The builtin random number generator algorithms are not + cryptographically strong. If a cryptographically strong + random number generator is needed, use something like + <seealso marker="crypto:crypto#rand_seed-0"><c>crypto:rand_seed/0</c></seealso>. + </p> </note> </description> <datatypes> <datatype> + <name name="builtin_alg"/> + </datatype> + <datatype> <name name="alg"/> </datatype> <datatype> + <name name="alg_handler"/> + </datatype> + <datatype> + <name name="alg_state"/> + </datatype> + <datatype> + <name name="exs64_state"/> + <desc><p>Algorithm specific internal state</p></desc> + </datatype> + <datatype> + <name name="exsplus_state"/> + <desc><p>Algorithm specific internal state</p></desc> + </datatype> + <datatype> + <name name="exs1024_state"/> + <desc><p>Algorithm specific internal state</p></desc> + </datatype> + <datatype> <name name="state"/> <desc><p>Algorithm-dependent state.</p></desc> </datatype> <datatype> <name name="export_state"/> - <desc><p>Algorithm-dependent state that can be printed or saved to - file.</p></desc> + <desc> + <p> + Algorithm-dependent state that can be printed or saved to file. + </p> + </desc> </datatype> </datatypes> @@ -215,8 +238,11 @@ S0 = rand:seed_s(exsplus), <fsummary>Seed random number generator.</fsummary> <desc> <marker id="seed-1"/> - <p>Seeds random number generation with the specifed algorithm and - time-dependent data if <anno>AlgOrExpState</anno> is an algorithm.</p> + <p> + Seeds random number generation with the specifed algorithm and + time-dependent data if <c><anno>AlgOrStateOrExpState</anno></c> + is an algorithm. + </p> <p>Otherwise recreates the exported seed in the process dictionary, and returns the state. See also <seealso marker="#export_seed-0"><c>export_seed/0</c></seealso>.</p> @@ -236,8 +262,11 @@ S0 = rand:seed_s(exsplus), <name name="seed_s" arity="1"/> <fsummary>Seed random number generator.</fsummary> <desc> - <p>Seeds random number generation with the specifed algorithm and - time-dependent data if <anno>AlgOrExpState</anno> is an algorithm.</p> + <p> + Seeds random number generation with the specifed algorithm and + time-dependent data if <c><anno>AlgOrStateOrExpState</anno></c> + is an algorithm. + </p> <p>Otherwise recreates the exported seed and returns the state. See also <seealso marker="#export_seed-0"> <c>export_seed/0</c></seealso>.</p> @@ -258,7 +287,7 @@ S0 = rand:seed_s(exsplus), <fsummary>Return a random float.</fsummary> <desc><marker id="uniform-0"/> <p>Returns a random float uniformly distributed in the value - range <c>0.0 < <anno>X</anno> < 1.0</c> and + range <c>0.0 =< <anno>X</anno> < 1.0</c> and updates the state in the process dictionary.</p> </desc> </func> @@ -269,7 +298,7 @@ S0 = rand:seed_s(exsplus), <desc><marker id="uniform-1"/> <p>Returns, for a specified integer <c><anno>N</anno> >= 1</c>, a random integer uniformly distributed in the value range - <c>1 <= <anno>X</anno> <= <anno>N</anno></c> and + <c>1 =< <anno>X</anno> =< <anno>N</anno></c> and updates the state in the process dictionary.</p> </desc> </func> @@ -279,7 +308,7 @@ S0 = rand:seed_s(exsplus), <fsummary>Return a random float.</fsummary> <desc> <p>Returns, for a specified state, random float - uniformly distributed in the value range <c>0.0 < + uniformly distributed in the value range <c>0.0 =< <anno>X</anno> < 1.0</c> and a new state.</p> </desc> </func> @@ -290,7 +319,7 @@ S0 = rand:seed_s(exsplus), <desc> <p>Returns, for a specified integer <c><anno>N</anno> >= 1</c> and a state, a random integer uniformly distributed in the value - range <c>1 <= <anno>X</anno> <= <anno>N</anno></c> and a + range <c>1 =< <anno>X</anno> =< <anno>N</anno></c> and a new state.</p> </desc> </func> diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index f52bc39deb..ab62c2fcdd 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2016</year> + <year>1996</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -854,7 +854,7 @@ q - quit erlang <c>{history, N}</c>, where <c>N</c> is the current command number. The function is to return a list of characters or an atom. This constraint is because of the Erlang I/O protocol. Unicode characters - beyond code point 255 are allowed in the list. Notice + beyond code point 255 are allowed in the list and the atom. Notice that in restricted mode the call <c>Mod:Func(L)</c> must be allowed or the default shell prompt function is called.</p> </section> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 6068afb293..ee5e7a11bf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -44,7 +44,7 @@ | {encoding, latin1 | unicode | utf8}). -type(options() :: hook_function() | [option()]). --record(pp, {string_fun, char_fun}). +-record(pp, {value_fun, string_fun, char_fun}). -record(options, {hook, encoding, opts}). @@ -214,11 +214,15 @@ state(_Hook) -> state(). state() -> - #pp{string_fun = fun io_lib:write_string_as_latin1/1, + Options = [{encoding,latin1}], + #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end, + string_fun = fun io_lib:write_string_as_latin1/1, char_fun = fun io_lib:write_char_as_latin1/1}. unicode_state() -> - #pp{string_fun = fun io_lib:write_string/1, + Options = [{encoding,unicode}], + #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end, + string_fun = fun io_lib:write_string/1, char_fun = fun io_lib:write_char/1}. encoding(Options) -> @@ -253,31 +257,30 @@ lattribute({attribute,_Line,Name,Arg}, Opts) -> lattribute(module, {M,Vs}, _Opts) -> A = a0(), - attr("module",[{var,A,pname(M)}, - foldr(fun(V, C) -> {cons,A,{var,A,V},C} - end, {nil,A}, Vs)]); + attr(module,[{var,A,pname(M)}, + foldr(fun(V, C) -> {cons,A,{var,A,V},C} + end, {nil,A}, Vs)]); lattribute(module, M, _Opts) -> - attr("module", [{var,a0(),pname(M)}]); + attr(module, [{var,a0(),pname(M)}]); lattribute(export, Falist, _Opts) -> - call({var,a0(),"-export"}, [falist(Falist)], 0, options(none)); + attrib(export, falist(Falist)); lattribute(import, Name, _Opts) when is_list(Name) -> - attr("import", [{var,a0(),pname(Name)}]); + attr(import, [{var,a0(),pname(Name)}]); lattribute(import, {From,Falist}, _Opts) -> - attr("import",[{var,a0(),pname(From)},falist(Falist)]); + attrib(import, [leaf(pname(From)),falist(Falist)]); lattribute(export_type, Talist, _Opts) -> - call({var,a0(),"-export_type"}, [falist(Talist)], 0, options(none)); + attrib(export_type, falist(Talist)); lattribute(optional_callbacks, Falist, Opts) -> - ArgL = try falist(Falist) - catch _:_ -> abstract(Falist, Opts) - end, - call({var,a0(),"-optional_callbacks"}, [ArgL], 0, options(none)); + try attrib(optional_callbacks, falist(Falist)) + catch _:_ -> attr(optional_callbacks, [abstract(Falist, Opts)]) + end; lattribute(file, {Name,Line}, _Opts) -> - attr("file", [{string,a0(),Name},{integer,a0(),Line}]); + attr(file, [{string,a0(),Name},{integer,a0(),Line}]); lattribute(record, {Name,Is}, Opts) -> - Nl = leaf(format("-record(~w,", [Name])), + Nl = [leaf("-record("),{atom,Name},$,], [{first,Nl,record_fields(Is, Opts)},$)]; lattribute(Name, Arg, Options) -> - attr(write(Name), [abstract(Arg, Options)]). + attr(Name, [abstract(Arg, Options)]). abstract(Arg, #options{encoding = Encoding}) -> erl_parse:abstract(Arg, [{encoding,Encoding}]). @@ -340,7 +343,7 @@ ltype({user_type,Line,T,Ts}, _) -> ltype({remote_type,Line,[M,F,Ts]}, _) -> simple_type({remote,Line,M,F}, Ts); ltype({atom,_,T}, _) -> - leaf(write(T)); + {atom,T}; ltype(E, P) -> lexpr(E, P, options(none)). @@ -382,12 +385,12 @@ tuple_type(Ts, F) -> specattr(SpecKind, {FuncSpec,TypeSpecs}) -> Func = case FuncSpec of {F,_A} -> - format("~w", [F]); + {atom,F}; {M,F,_A} -> - format("~w:~w", [M, F]) + [{atom,M},$:,{atom,F}] end, {first,leaf(lists:concat(["-", SpecKind, " "])), - {list,[{first,leaf(Func),spec_clauses(TypeSpecs)}]}}. + {list,[{first,Func,spec_clauses(TypeSpecs)}]}}. spec_clauses(TypeSpecs) -> {prefer_nl,[$;],[sig_type(T) || T <- TypeSpecs]}. @@ -429,7 +432,10 @@ ltypes(Ts, F, Prec) -> [F(T, Prec) || T <- Ts]. attr(Name, Args) -> - call({var,a0(),format("-~s", [Name])}, Args, 0, options(none)). + {first,[$-,{atom,Name}],args(Args, options(none))}. + +attrib(Name, Args) -> + {first,[$-,{atom,Name}],[{seq,$(,$),[$,],Args}]}. pname(['' | As]) -> [$. | pname(As)]; @@ -441,10 +447,13 @@ pname(A) when is_atom(A) -> write(A). falist([]) -> - {nil,a0()}; -falist([{Name,Arity}|Falist]) -> - A = a0(), - {cons,A,{var,A,format("~w/~w", [Name,Arity])},falist(Falist)}. + [leaf("[]")]; +falist(Falist) -> + L = [begin + {Name,Arity} = Fa, + [{atom,Name},leaf(format("/~w", [Arity]))] + end || Fa <- Falist], + [{seq,$[,$],$,,L}]. lfunction({function,_Line,Name,_Arity,Cs}, Opts) -> Cll = nl_clauses(fun (C, H) -> func_clause(Name, C, H) end, $;, Opts, Cs), @@ -489,7 +498,7 @@ lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V])); lexpr({char,_,C}, _, _) -> {char,C}; lexpr({integer,_,N}, _, _) -> leaf(write(N)); lexpr({float,_,F}, _, _) -> leaf(write(F)); -lexpr({atom,_,A}, _, _) -> leaf(write(A)); +lexpr({atom,_,A}, _, _) -> {atom,A}; lexpr({string,_,S}, _, _) -> {string,S}; lexpr({nil,_}, _, _) -> '[]'; lexpr({cons,_,H,T}, _, Opts) -> @@ -519,7 +528,7 @@ lexpr({record, _, Name, Fs}, Prec, Opts) -> lexpr({record_field, _, Rec, Name, F}, Prec, Opts) -> {L,P,R} = inop_prec('#'), Rl = lexpr(Rec, L, Opts), - Nl = leaf(format("#~w.", [Name])), + Nl = [$#,{atom,Name},$.], El = [Rl,Nl,lexpr(F, R, Opts)], maybe_paren(P, Prec, El); lexpr({record, _, Rec, Name, Fs}, Prec, Opts) -> @@ -538,12 +547,12 @@ lexpr({record_field, _, Rec, F}, Prec, Opts) -> maybe_paren(P, Prec, El); lexpr({map, _, Fs}, Prec, Opts) -> {P,_R} = preop_prec('#'), - El = {first,leaf("#"),map_fields(Fs, Opts)}, + El = {first,$#,map_fields(Fs, Opts)}, maybe_paren(P, Prec, El); lexpr({map, _, Map, Fs}, Prec, Opts) -> {L,P,_R} = inop_prec('#'), Rl = lexpr(Map, L, Opts), - El = {first,[Rl,leaf("#")],map_fields(Fs, Opts)}, + El = {first,[Rl,$#],map_fields(Fs, Opts)}, maybe_paren(P, Prec, El); lexpr({block,_,Es}, _, Opts) -> {list,[{step,'begin',body(Es, Opts)},'end']}; @@ -563,13 +572,16 @@ lexpr({'receive',_,Cs,To,ToOpt}, _, Opts) -> {step,'after',Al}, 'end']}; lexpr({'fun',_,{function,F,A}}, _Prec, _Opts) -> - leaf(format("fun ~w/~w", [F,A])); -lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Opts) -> - {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Opts) + [leaf("fun "),{atom,F},leaf(format("/~w", [A]))]; +lexpr({'fun',L,{function,_,_}=Func,Extra}, Prec, Opts) -> + {force_nl,fun_info(Extra),lexpr({'fun',L,Func}, Prec, Opts)}; +lexpr({'fun',L,{function,M,F,A}}, Prec, Opts) when is_atom(M), is_atom(F), is_integer(A) -> %% For backward compatibility with pre-R15 abstract format. - leaf(format("fun ~w:~w/~w", [M,F,A])); + Mod = erl_parse:abstract(M), + Fun = erl_parse:abstract(F), + Arity = erl_parse:abstract(A), + lexpr({'fun',L,{function,Mod,Fun,Arity}}, Prec, Opts); lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) -> %% New format in R15. NameItem = lexpr(M, Opts), @@ -660,7 +672,7 @@ lexpr({bin,_,Fs}, _, Opts) -> bit_grp(Fs, Opts); %% Special case for straight values. lexpr({value,_,Val}, _,_) -> - leaf(write(Val)); + {value,Val}; %% Now do the hook. lexpr(Other, _Precedence, #options{hook = none}) -> leaf(format("INVALID-FORM:~w:",[Other])); @@ -676,7 +688,7 @@ call(Name, Args, Prec, Opts) -> maybe_paren(P, Prec, Item). fun_info(Extra) -> - leaf(format("% fun-info: ~w", [Extra])). + [leaf("% fun-info: "),{value,Extra}]. %% BITS: @@ -717,7 +729,7 @@ bit_elem_type(T) -> %% end of BITS record_name(Name) -> - leaf(format("#~w", [Name])). + [$#,{atom,Name}]. record_fields(Fs, Opts) -> tuple(Fs, fun record_field/2, Opts). @@ -919,8 +931,10 @@ frmt(Item, I, PP) -> %%% - {force_nl,ExtraInfo,I}: fun-info (a comment) forces linebreak before I. %%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative %%% indentation. +%%% - {atom,A}: an atom %%% - {char,C}: a character %%% - {string,S}: a string. +%%% - {value,T}: a term. %%% - {hook,...}, {ehook,...}: hook expressions. %%% %%% list, first, seq, force_nl, and prefer_nl all accept IPs, where each @@ -981,6 +995,10 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) -> true -> {insert_newlines(CharsSize2L, I0, ST),nsz(lists:last(Sizes), I0)} end; +f({value,V}, I, ST, WT, PP) -> + f(write_a_value(V, PP), I, ST, WT, PP); +f({atom,A}, I, ST, WT, PP) -> + f(write_an_atom(A, PP), I, ST, WT, PP); f({char,C}, I, ST, WT, PP) -> f(write_a_char(C, PP), I, ST, WT, PP); f({string,S}, I, ST, WT, PP) -> @@ -1119,6 +1137,12 @@ has_nl([C|Cs]) -> has_nl([]) -> false. +write_a_value(V, PP) -> + flat_leaf(write_value(V, PP)). + +write_an_atom(A, PP) -> + flat_leaf(write_atom(A, PP)). + write_a_char(C, PP) -> flat_leaf(write_char(C, PP)). @@ -1135,7 +1159,7 @@ write_a_string([], _N, _Len, _PP) -> write_a_string(S, N, Len, PP) -> SS = string:sub_string(S, 1, N), Sl = write_string(SS, PP), - case (length(Sl) > Len) and (N > ?MIN_SUBSTRING) of + case (chars_size(Sl) > Len) and (N > ?MIN_SUBSTRING) of true -> write_a_string(S, N-1, Len, PP); false -> @@ -1147,11 +1171,17 @@ flat_leaf(S) -> L = lists:flatten(S), {leaf,length(L),L}. +write_value(V, PP) -> + (PP#pp.value_fun)(V). + +write_atom(A, PP) -> + (PP#pp.value_fun)(A). + write_string(S, PP) -> - lists:flatten((PP#pp.string_fun)(S)). + (PP#pp.string_fun)(S). write_char(C, PP) -> - lists:flatten((PP#pp.char_fun)(C)). + (PP#pp.char_fun)(C). %% %% Utilities diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 90e19e6b9f..195a407570 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -70,7 +70,7 @@ match_object/2, match_object/3, match_spec_compile/1, match_spec_run_r/3, member/2, new/2, next/2, prev/2, rename/2, safe_fixtable/2, select/1, select/2, select/3, - select_count/2, select_delete/2, select_reverse/1, + select_count/2, select_delete/2, select_replace/2, select_reverse/1, select_reverse/2, select_reverse/3, setopts/2, slot/2, take/2, update_counter/3, update_counter/4, update_element/3]). @@ -379,6 +379,14 @@ select_count(_, _) -> select_delete(_, _) -> erlang:nif_error(undef). +-spec select_replace(Tab, MatchSpec) -> NumReplaced when + Tab :: tab(), + MatchSpec :: match_spec(), + NumReplaced :: non_neg_integer(). + +select_replace(_, _) -> + erlang:nif_error(undef). + -spec select_reverse(Tab, MatchSpec) -> [Match] when Tab :: tab(), MatchSpec :: match_spec(), diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index a91143a764..28e5007e5a 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -68,8 +68,8 @@ -export([write_atom/1,write_string/1,write_string/2,write_latin1_string/1, write_latin1_string/2, write_char/1, write_latin1_char/1]). --export([write_string_as_latin1/1, write_string_as_latin1/2, - write_char_as_latin1/1]). +-export([write_atom_as_latin1/1, write_string_as_latin1/1, + write_string_as_latin1/2, write_char_as_latin1/1]). -export([quote_atom/2, char_list/1, latin1_char_list/1, deep_char_list/1, deep_latin1_char_list/1, @@ -344,6 +344,11 @@ write_binary_body(B, _D) -> <<X:L>> = B, [integer_to_list(X),$:,integer_to_list(L)]. +%%% There are two functions to write Unicode atoms: +%%% - they both escape control characters < 160; +%%% - write_atom() never escapes characters >= 160; +%%% - write_atom_as_latin1() also escapes characters >= 255. + %% write_atom(Atom) -> [Char] %% Generate the list of characters needed to print an atom. @@ -351,17 +356,26 @@ write_binary_body(B, _D) -> Atom :: atom(). write_atom(Atom) -> + write_possibly_quoted_atom(Atom, fun write_string/2). + +-spec write_atom_as_latin1(Atom) -> latin1_string() when + Atom :: atom(). + +write_atom_as_latin1(Atom) -> + write_possibly_quoted_atom(Atom, fun write_string_as_latin1/2). + +write_possibly_quoted_atom(Atom, PFun) -> Chars = atom_to_list(Atom), case quote_atom(Atom, Chars) of true -> - write_string(Chars, $'); %' + PFun(Chars, $'); %' false -> Chars end. %% quote_atom(Atom, CharList) %% Return 'true' if atom with chars in CharList needs to be quoted, else -%% return 'false'. +%% return 'false'. Notice that characters >= 160 are always quoted. -spec quote_atom(atom(), chars()) -> boolean(). diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index aabccfc5d9..ff368d02da 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -105,6 +105,8 @@ print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> %% ensure Col is at least 1 print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); +print(Atom, _Col, _Ll, _D, _M, _RF, Enc, _Str) when is_atom(Atom) -> + write_atom(Atom, Enc); print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); is_list(Term); is_map(Term); @@ -407,6 +409,9 @@ print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 -> {"#{}", 3}; +print_length(Atom, _D, _RF, Enc, _Str) when is_atom(Atom) -> + S = write_atom(Atom, Enc), + {S, lists:flatlength(S)}; print_length(List, D, RF, Enc, Str) when is_list(List) -> %% only flat lists are "printable" case Str andalso printable_list(List, D, Enc) of @@ -500,7 +505,7 @@ print_length_tuple(Tuple, D, RF, Enc, Str) -> print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> {"{...}", 5}; print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> - Name = [$# | io_lib:write_atom(element(1, Tuple))], + Name = [$# | write_atom(element(1, Tuple), Enc)], NameL = length(Name), Elements = tl(tuple_to_list(Tuple)), L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), @@ -515,7 +520,7 @@ print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. print_length_field(Def, D, E, RF, Enc, Str) -> - Name = io_lib:write_atom(Def), + Name = write_atom(Def, Enc), {S, L} = print_length(E, D, RF, Enc, Str), NameL = length(Name) + 3, {{field, Name, NameL, {S, L}}, NameL + L}. @@ -664,6 +669,11 @@ printable_char(C,unicode) -> C > 16#DFFF andalso C < 16#FFFE orelse C > 16#FFFF andalso C =< 16#10FFFF. +write_atom(A, latin1) -> + io_lib:write_atom_as_latin1(A); +write_atom(A, _Uni) -> + io_lib:write_atom(A). + write_string(S, latin1) -> io_lib:write_latin1_string(S, $"); %" write_string(S, _Uni) -> diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 1f457b9e0e..dfd102f9ef 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -45,20 +45,31 @@ %% ===================================================================== %% This depends on the algorithm handler function --type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state(). +-type alg_state() :: + exs64_state() | exsplus_state() | exs1024_state() | term(). + %% This is the algorithm handler function within this module --type alg_handler() :: #{type := alg(), - max := integer(), - next := fun(), - uniform := fun(), - uniform_n := fun(), - jump := fun()}. - -%% Internal state --opaque state() :: {alg_handler(), alg_seed()}. --type alg() :: exs64 | exsplus | exs1024. --opaque export_state() :: {alg(), alg_seed()}. --export_type([alg/0, state/0, export_state/0]). +-type alg_handler() :: + #{type := alg(), + max := integer() | infinity, + next := + fun((alg_state()) -> {non_neg_integer(), alg_state()}), + uniform := + fun((state()) -> {float(), state()}), + uniform_n := + fun((pos_integer(), state()) -> {pos_integer(), state()}), + jump := + fun((state()) -> state())}. + +%% Algorithm state +-type state() :: {alg_handler(), alg_state()}. +-type builtin_alg() :: exs64 | exsplus | exs1024. +-type alg() :: builtin_alg() | atom(). +-type export_state() :: {alg(), alg_state()}. +-export_type( + [builtin_alg/0, alg/0, alg_handler/0, alg_state/0, + state/0, export_state/0]). +-export_type([exs64_state/0, exsplus_state/0, exs1024_state/0]). %% ===================================================================== %% API @@ -72,7 +83,7 @@ export_seed() -> _ -> undefined end. --spec export_seed_s(state()) -> export_state(). +-spec export_seed_s(State :: state()) -> export_state(). export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. %% seed(Alg) seeds RNG with runtime dependent values @@ -81,27 +92,37 @@ export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. %% seed({Alg,Seed}) setup RNG with a previously exported seed %% and return the NEW state --spec seed(AlgOrExpState::alg() | export_state()) -> state(). +-spec seed( + AlgOrStateOrExpState :: builtin_alg() | state() | export_state()) -> + state(). seed(Alg) -> seed_put(seed_s(Alg)). --spec seed_s(AlgOrExpState::alg() | export_state()) -> state(). -seed_s(Alg) when is_atom(Alg) -> - seed_s(Alg, {erlang:phash2([{node(),self()}]), - erlang:system_time(), - erlang:unique_integer()}); +-spec seed_s( + AlgOrStateOrExpState :: builtin_alg() | state() | export_state()) -> + state(). +seed_s({AlgHandler, _Seed} = State) when is_map(AlgHandler) -> + State; seed_s({Alg0, Seed}) -> {Alg,_SeedFun} = mk_alg(Alg0), - {Alg, Seed}. + {Alg, Seed}; +seed_s(Alg) -> + seed_s(Alg, {erlang:phash2([{node(),self()}]), + erlang:system_time(), + erlang:unique_integer()}). %% seed/2: seeds RNG with the algorithm and given values %% and returns the NEW state. --spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +-spec seed( + Alg :: builtin_alg(), Seed :: {integer(), integer(), integer()}) -> + state(). seed(Alg0, S0) -> seed_put(seed_s(Alg0, S0)). --spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +-spec seed_s( + Alg :: builtin_alg(), Seed :: {integer(), integer(), integer()}) -> + state(). seed_s(Alg0, S0 = {_, _, _}) -> {Alg, Seed} = mk_alg(Alg0), AS = Seed(S0), @@ -113,7 +134,7 @@ seed_s(Alg0, S0 = {_, _, _}) -> %% uniform/0: returns a random float X where 0.0 < X < 1.0, %% updating the state in the process dictionary. --spec uniform() -> X::float(). +-spec uniform() -> X :: float(). uniform() -> {X, Seed} = uniform_s(seed_get()), _ = seed_put(Seed), @@ -123,7 +144,7 @@ uniform() -> %% uniform/1 returns a random integer X where 1 =< X =< N, %% updating the state in the process dictionary. --spec uniform(N :: pos_integer()) -> X::pos_integer(). +-spec uniform(N :: pos_integer()) -> X :: pos_integer(). uniform(N) -> {X, Seed} = uniform_s(N, seed_get()), _ = seed_put(Seed), @@ -133,7 +154,7 @@ uniform(N) -> %% returns a random float X where 0.0 < X < 1.0, %% and a new state. --spec uniform_s(state()) -> {X::float(), NewS :: state()}. +-spec uniform_s(State :: state()) -> {X :: float(), NewState :: state()}. uniform_s(State = {#{uniform:=Uniform}, _}) -> Uniform(State). @@ -141,7 +162,8 @@ uniform_s(State = {#{uniform:=Uniform}, _}) -> %% uniform_s/2 returns a random integer X where 1 =< X =< N, %% and a new state. --spec uniform_s(N::pos_integer(), state()) -> {X::pos_integer(), NewS::state()}. +-spec uniform_s(N :: pos_integer(), State :: state()) -> + {X :: pos_integer(), NewState :: state()}. uniform_s(N, State = {#{uniform_n:=Uniform, max:=Max}, _}) when 0 < N, N =< Max -> Uniform(N, State); @@ -155,7 +177,7 @@ uniform_s(N, State0 = {#{uniform:=Uniform}, _}) %% after a large number of call defined for each algorithm. %% The large number is algorithm dependent. --spec jump(state()) -> NewS :: state(). +-spec jump(state()) -> NewState :: state(). jump(State = {#{jump:=Jump}, _}) -> Jump(State). @@ -164,7 +186,7 @@ jump(State = {#{jump:=Jump}, _}) -> %% and write back the new value to the internal state, %% then returns the new value. --spec jump() -> NewS :: state(). +-spec jump() -> NewState :: state(). jump() -> seed_put(jump(seed_get())). @@ -182,7 +204,7 @@ normal() -> %% The Ziggurat Method for generating random variables - Marsaglia and Tsang %% Paper and reference code: http://www.jstatsoft.org/v05/i08/ --spec normal_s(state()) -> {float(), NewS :: state()}. +-spec normal_s(State :: state()) -> {float(), NewState :: state()}. normal_s(State0) -> {Sign, R, State} = get_52(State0), Idx = R band 16#FF, @@ -245,7 +267,7 @@ mk_alg(exs1024) -> %% Reference URL: http://xorshift.di.unimi.it/ %% ===================================================================== --type exs64_state() :: uint64(). +-opaque exs64_state() :: uint64(). exs64_seed({A1, A2, A3}) -> {V1, _} = exs64_next(((A1 band ?UINT32MASK) * 4294967197 + 1)), @@ -280,7 +302,7 @@ exs64_jump(_) -> %% Modification of the original Xorshift128+ algorithm to 116 %% by Sebastiano Vigna, a lot of thanks for his help and work. %% ===================================================================== --type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). +-opaque exsplus_state() :: nonempty_improper_list(uint58(), uint58()). -dialyzer({no_improper_lists, exsplus_seed/1}). @@ -349,7 +371,7 @@ exsplus_jump(S, [AS0|AS1], J, N) -> %% Reference URL: http://xorshift.di.unimi.it/ %% ===================================================================== --type exs1024_state() :: {list(uint64()), list(uint64())}. +-opaque exs1024_state() :: {list(uint64()), list(uint64())}. exs1024_seed({A1, A2, A3}) -> B1 = (((A1 band ?UINT21MASK) + 1) * 2097131) band ?UINT21MASK, diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 28f37ef8bf..394f4f2fa4 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -349,10 +349,16 @@ default_prompt(N) -> %% Don't bother flattening the list irrespective of what the %% I/O-protocol states. case is_alive() of - true -> io_lib:format(<<"(~s)~w> ">>, [node(), N]); + true -> io_lib:format(<<"(~ts)~w> ">>, [node_string(), N]); false -> io_lib:format(<<"~w> ">>, [N]) end. +node_string() -> + case encoding() of + latin1 -> io_lib:write_atom_as_latin1(node()); + _ -> io_lib:write_atom(node()) + end. + %% expand_hist(Expressions, CommandNumber) %% Preprocess the expression list replacing all history list commands %% with their expansions. @@ -967,10 +973,11 @@ local_func(f, [{var,_,Name}], Bs, _Shell, _RT, _Lf, _Ef) -> {value,ok,erl_eval:del_binding(Name, Bs)}; local_func(f, [_Other], _Bs, _Shell, _RT, _Lf, _Ef) -> erlang:raise(error, function_clause, [{shell,f,1}]); -local_func(rd, [{atom,_,RecName},RecDef0], Bs, _Shell, RT, _Lf, _Ef) -> +local_func(rd, [{atom,_,RecName0},RecDef0], Bs, _Shell, RT, _Lf, _Ef) -> RecDef = expand_value(RecDef0), RDs = lists:flatten(erl_pp:expr(RecDef)), - Attr = lists:concat(["-record('", RecName, "',", RDs, ")."]), + RecName = io_lib:write_atom_as_latin1(RecName0), + Attr = lists:concat(["-record(", RecName, ",", RDs, ")."]), {ok, Tokens, _} = erl_scan:string(Attr), case erl_parse:parse_form(Tokens) of {ok,AttrForm} -> @@ -1417,9 +1424,11 @@ columns() -> {ok,N} -> N; _ -> 80 end. + encoding() -> [{encoding, Encoding}] = enc(), Encoding. + enc() -> case lists:keyfind(encoding, 1, io:getopts()) of false -> [{encoding,latin1}]; % should never happen diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 1a028204b4..808ba9b4c1 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -51,7 +51,7 @@ otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1, - otp_13662/1]). + otp_13662/1, otp_14285/1]). %% Internal export. -export([ehook/6]). @@ -80,7 +80,8 @@ groups() -> {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, - otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662]}]. + otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662, + otp_14285]}]. init_per_suite(Config) -> Config. @@ -627,11 +628,6 @@ do_hook(HookFun) -> true = "{some,value}" =:= lists:flatten(erl_pp:expr({value,A0,{some,value}})), - %% Silly... - true = - "if true -> 0 end" =:= - flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}), - %% More compatibility: before R6 OldIf = {'if',A0,[{clause,A0,[],[{atom,A0,true}],[{atom,A0,b}]}]}, NewIf = {'if',A0,[{clause,A0,[],[[{atom,A0,true}]],[{atom,A0,b}]}]}, @@ -1069,9 +1065,6 @@ otp_11100(Config) when is_list(Config) -> %% doesn't make a difference (pp:bit_elem_type/1 is an example). A1 = erl_anno:new(1), - %% Cannot trigger the use of the hook function with export/import. - "-export([{fy,a}/b]).\n" = - pf({attribute,A1,export,[{{fy,a},b}]}), "-type foo() :: integer(INVALID-FORM:{foo,bar}:).\n" = pf({attribute,A1,type,{foo,{type,A1,integer,[{foo,bar}]},[]}}), pf({attribute,A1,type, @@ -1146,6 +1139,34 @@ otp_13662(Config) -> ], compile(Config, Ts). +otp_14285(_Config) -> + pp_forms(<<"-export([t/0, '\\x{400}\\''/0]).">>), + pp_forms(<<"-import(lists, [append/2]).">>), + pp_forms(<<"-optional_callbacks([]).">>), + pp_forms(<<"-optional_callbacks(['\\x{400}\\''/1]).">>), + pp_forms(<<"-'\\x{400}\\''('\\x{400}\\'').">>), + pp_forms(<<"-type '\\x{400}\\''() :: '\\x{400}\\''.">>), + pp_forms(<<"-record('\\x{400}\\'', {'\\x{400}\\''}).">>), + pp_forms(<<"-callback '\\x{400}\\''(_) -> '\\x{400}\\''.">>), + pp_forms(<<"t() -> '\\x{400}\\''('\\x{400}\\'').">>), + pp_forms(<<"'\\x{400}\\''(_) -> '\\x{400}\\''.">>), + pp_forms(<<"-spec '\\x{400}'() -> " + "#'\\x{400}'{'\\x{400}' :: '\\x{400}'}.">>), + pp_forms(<<"'\\x{400}\\''() ->" + "R = #'\\x{400}\\''{}," + "#'\\x{400}\\''{'\\x{400}\\'' =" + "{'\\x{400}\\''," + "fun '\\x{400}\\''/0," + "R#'\\x{400}\\''.'\\x{400}\\''," + "#'\\x{400}\\''.'\\x{400}\\''}}.">>), + + %% Special... + true = + "{some,'\\x{400}\\''}" =:= + lists:flatten(erl_pp:expr({value,erl_anno:new(0),{some,'\x{400}\''}}, + [{encoding,latin1}])), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index ebf7dbff62..ac68fdcc34 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -39,8 +39,9 @@ -export([lookup_element_mult/1]). -export([foldl_ordered/1, foldr_ordered/1, foldl/1, foldr/1, fold_empty/1]). -export([t_delete_object/1, t_init_table/1, t_whitebox/1, + select_bound_chunk/1, t_delete_all_objects/1, t_insert_list/1, t_test_ms/1, - t_select_delete/1,t_ets_dets/1]). + t_select_delete/1,t_select_replace/1,t_ets_dets/1]). -export([ordered/1, ordered_match/1, interface_equality/1, fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, @@ -64,7 +65,7 @@ meta_lookup_named_read/1, meta_lookup_named_write/1, meta_newdel_unnamed/1, meta_newdel_named/1]). -export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, - otp_8166/1, otp_8732/1]). + smp_select_replace/1, otp_8166/1, otp_8732/1]). -export([exit_large_table_owner/1, exit_many_large_table_owner/1, exit_many_tables_owner/1, @@ -87,6 +88,7 @@ -include_lib("common_test/include/ct.hrl"). -define(m(A,B), assert_eq(A,B)). +-define(heap_binary_size, 64). init_per_testcase(Case, Config) -> rand:seed(exsplus), @@ -117,15 +119,16 @@ all() -> update_counter_with_default, partly_bound, update_counter_table_growth, match_heavy, {group, fold}, member, t_delete_object, + select_bound_chunk, t_init_table, t_whitebox, t_delete_all_objects, - t_insert_list, t_test_ms, t_select_delete, t_ets_dets, - memory, t_select_reverse, t_bucket_disappears, + t_insert_list, t_test_ms, t_select_delete, t_select_replace, + t_ets_dets, memory, t_select_reverse, t_bucket_disappears, select_fail, t_insert_new, t_repair_continuation, otp_5340, otp_6338, otp_6842_select_1000, otp_7665, otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted, shrink_pseudo_deleted, {group, meta_smp}, smp_insert, - smp_fixed_delete, smp_unfix_fix, smp_select_delete, - otp_8166, exit_large_table_owner, + smp_fixed_delete, smp_unfix_fix, smp_select_replace, + smp_select_delete, otp_8166, exit_large_table_owner, exit_many_large_table_owner, exit_many_tables_owner, exit_many_many_tables_owner, write_concurrency, heir, give_away, setopts, bad_table, types, @@ -695,6 +698,15 @@ whitebox_2(Opts) -> ets:delete(T2), ok. +select_bound_chunk(Config) -> + repeat_for_opts(fun select_bound_chunk_do/1, [all_types]). + +select_bound_chunk_do(Opts) -> + T = ets:new(x, Opts), + ets:insert(T, [{key, 1}]), + {[{key, 1}], '$end_of_table'} = ets:select(T, [{{key,1},[],['$_']}], 100000), + ok. + %% Test ets:to/from_dets. t_ets_dets(Config) when is_list(Config) -> @@ -1136,6 +1148,211 @@ t_select_delete(Config) when is_list(Config) -> lists:foreach(fun(Tab) -> ets:delete(Tab) end,Tables), verify_etsmem(EtsMem). +%% Tests the ets:select_replace/2 BIF +t_select_replace(Config) when is_list(Config) -> + EtsMem = etsmem(), + Tables = fill_sets_int(10000) ++ fill_sets_int(10000, [{write_concurrency,true}]), + + TestFun = fun (Table, TableType) when TableType =:= bag -> + % Operation not supported; bag implementation + % presented both semantic consistency and performance issues. + 10000 = ets:select_delete(Table, [{'_',[],[true]}]); + + (Table, TableType) -> + % Invalid replacement doesn't keep the key + MatchSpec1 = [{{'$1', '$2'}, + [{'=:=', {'band', '$1', 2#11}, 2#11}, + {'=/=', {'hd', '$2'}, $x}], + [{{'$2', '$1'}}]}], + {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec1)), + + % Invalid replacement doesn't keep the key (even though it would be the same value) + MatchSpec2 = [{{'$1', '$2'}, + [{'=:=', {'band', '$1', 2#11}, 2#11}], + [{{{'+', '$1', 0}, '$2'}}]}, + {{'$1', '$2'}, + [{'=/=', {'band', '$1', 2#11}, 2#11}], + [{{{'-', '$1', 0}, '$2'}}]}], + {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec2)), + + % Invalid replacement changes key to float equivalent + MatchSpec3 = [{{'$1', '$2'}, + [{'=:=', {'band', '$1', 2#11}, 2#11}, + {'=/=', {'hd', '$2'}, $x}], + [{{{'*', '$1', 1.0}, '$2'}}]}], + {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec3)), + + % Replacements are differently-sized tuples + MatchSpec4_A = [{{'$1','$2'}, + [{'<', {'rem', '$1', 5}, 2}], + [{{'$1', [$x | '$2'], stuff}}]}], + MatchSpec4_B = [{{'$1','$2','_'}, + [], + [{{'$1','$2'}}]}], + 4000 = ets:select_replace(Table, MatchSpec4_A), + 4000 = ets:select_replace(Table, MatchSpec4_B), + + % Replacement is the same tuple + MatchSpec5 = [{{'$1', '$2'}, + [{'>', {'rem', '$1', 5}, 3}], + ['$_']}], + 2000 = ets:select_replace(Table, MatchSpec5), + + % Replacement reconstructs an equal tuple + MatchSpec6 = [{{'$1', '$2'}, + [{'>', {'rem', '$1', 5}, 3}], + [{{'$1', '$2'}}]}], + 2000 = ets:select_replace(Table, MatchSpec6), + + % Replacement uses {element,KeyPos,T} for key + 2000 = ets:select_replace(Table, + [{{'$1', '$2'}, + [{'>', {'rem', '$1', 5}, 3}], + [{{{element, 1, '$_'}, '$2'}}]}]), + + % Replacement uses wrong {element,KeyPos,T} for key + {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, + [{{'$1', '$2'}, + [], + [{{{element, 2, '$_'}, '$2'}}]}])), + + check(Table, + fun ({N, [$x, C | _]}) when ((N rem 5) < 2) -> (C >= $0) andalso (C =< $9); + ({N, [C | _]}) when is_float(N) -> (C >= $0) andalso (C =< $9); + ({N, [C | _]}) when ((N rem 5) > 3) -> (C >= $0) andalso (C =< $9); + ({_, [C | _]}) -> (C >= $0) andalso (C =< $9) + end, + 10000), + + % Replace unbound range (>) + MatchSpec7 = [{{'$1', '$2'}, + [{'>', '$1', 7000}], + [{{'$1', {{gt_range, '$2'}}}}]}], + 3000 = ets:select_replace(Table, MatchSpec7), + + % Replace unbound range (<) + MatchSpec8 = [{{'$1', '$2'}, + [{'<', '$1', 3000}], + [{{'$1', {{le_range, '$2'}}}}]}], + case TableType of + ordered_set -> 2999 = ets:select_replace(Table, MatchSpec8); + set -> 2999 = ets:select_replace(Table, MatchSpec8); + duplicate_bag -> 2998 = ets:select_replace(Table, MatchSpec8) + end, + + % Replace bound range + MatchSpec9 = [{{'$1', '$2'}, + [{'>=', '$1', 3001}, + {'<', '$1', 7000}], + [{{'$1', {{range, '$2'}}}}]}], + case TableType of + ordered_set -> 3999 = ets:select_replace(Table, MatchSpec9); + set -> 3999 = ets:select_replace(Table, MatchSpec9); + duplicate_bag -> 3998 = ets:select_replace(Table, MatchSpec9) + end, + + % Replace particular keys + MatchSpec10 = [{{'$1', '$2'}, + [{'==', '$1', 3000}], + [{{'$1', {{specific1, '$2'}}}}]}, + {{'$1', '$2'}, + [{'==', '$1', 7000}], + [{{'$1', {{specific2, '$2'}}}}]}], + case TableType of + ordered_set -> 2 = ets:select_replace(Table, MatchSpec10); + set -> 2 = ets:select_replace(Table, MatchSpec10); + duplicate_bag -> 4 = ets:select_replace(Table, MatchSpec10) + end, + + check(Table, + fun ({N, {gt_range, _}}) -> N > 7000; + ({N, {le_range, _}}) -> N < 3000; + ({N, {range, _}}) -> (N >= 3001) andalso (N < 7000); + ({N, {specific1, _}}) -> N == 3000; + ({N, {specific2, _}}) -> N == 7000 + end, + 10000), + + 10000 = ets:select_delete(Table, [{'_',[],[true]}]), + check(Table, fun (_) -> false end, 0) + end, + + lists:foreach( + fun(Table) -> + TestFun(Table, ets:info(Table, type)), + ets:delete(Table) + end, + Tables), + + %% Test key-safe match-specs are accepted + BigNum = (123 bsl 123), + RefcBin = list_to_binary(lists:seq(1,?heap_binary_size+1)), + Terms = [a, "hej", 123, 1.23, BigNum , <<"123">>, RefcBin, TestFun, self()], + EqPairs = fun(X,Y) -> + [{ '$1', '$1'}, + { {X, Y}, {{X, Y}}}, + { {'$1', Y}, {{'$1', Y}}}, + { {{X, Y}}, {{{{X, Y}}}}}, + { {X}, {{X}}}, + { X, {const, X}}, + { {X,Y}, {const, {X,Y}}}, + { {X}, {const, {X}}}, + { {X, Y}, {{X, {const, Y}}}}, + { {X, {Y,'$1'}}, {{{const, X}, {{Y,'$1'}}}}}, + { [X, Y | '$1'], [X, Y | '$1']}, + { [{X, '$1'}, Y], [{{X, '$1'}}, Y]}, + { [{X, Y} | '$1'], [{const, {X, Y}} | '$1']}, + { [$p,$r,$e,$f,$i,$x | '$1'], [$p,$r,$e,$f,$i,$x | '$1']}, + { {[{X,Y}]}, {{[{{X,Y}}]}}}, + { {[{X,Y}]}, {{{const, [{X,Y}]}}}}, + { {[{X,Y}]}, {{[{const,{X,Y}}]}}} + ] + end, + + T2 = ets:new(x, []), + [lists:foreach(fun({A, B}) -> + %% just check that matchspec is accepted + 0 = ets:select_replace(T2, [{{A, '$2', '$3'}, [], [{{B, '$3', '$2'}}]}]) + end, + EqPairs(X,Y)) || X <- Terms, Y <- Terms], + + %% Test key-unsafe matchspecs are rejected + NeqPairs = fun(X, Y) -> + [{'$1', '$2'}, + {{X, Y}, {X, Y}}, + {{{X, Y}}, {{{X, Y}}}}, + {{X}, {{{X}}}}, + {{const, X}, {const, X}}, + {{const, {X,Y}}, {const, {X,Y}}}, + {'$1', {const, '$1'}}, + {{X}, {const, {{X}}}}, + {{X, {Y,'$1'}}, {{{const, X}, {Y,'$1'}}}}, + {[X, Y | '$1'], [X, Y]}, + {[X, Y], [X, Y | '$1']}, + {[{X, '$1'}, Y], [{X, '$1'}, Y]}, + {[$p,$r,$e,$f,$i,$x | '$1'], [$p,$r,$e,$f,$I,$x | '$1']}, + { {[{X,Y}]}, {{[{X,Y}]}}}, + { {[{X,Y}]}, {{{const, [{{X,Y}}]}}}}, + { {[{X,Y}]}, {{[{const,{{X,Y}}}]}}}, + {'_', '_'}, + {'$_', '$_'}, + {'$$', '$$'}, + {#{}, #{}}, + {#{X => '$1'}, #{X => '$1'}} + ] + end, + + [lists:foreach(fun({A, B}) -> + %% just check that matchspec is rejected + {'EXIT',{badarg,_}} = (catch ets:select_replace(T2, [{{A, '$2', '$3'}, [], [{{B, '$3', '$2'}}]}])) + end, + NeqPairs(X,Y)) || X <- Terms, Y <- Terms], + + + ets:delete(T2), + + verify_etsmem(EtsMem). + %% Test that partly bound keys gives faster matches. partly_bound(Config) when is_list(Config) -> case os:type() of @@ -5419,6 +5636,42 @@ smp_select_delete(Config) when is_list(Config) -> false = ets:info(T,fixed), ets:delete(T). +smp_select_replace(Config) when is_list(Config) -> + lists:foreach( + fun (TableType) -> + T = ets_new(smp_select_replace, [TableType, named_table, public, + {write_concurrency, true}]), + WorkerCount = 20, + CounterIterations = 10000, + InitF = fun (_) -> no_state end, + ExecF = fun (State) -> + lists:foreach( + fun F(IterId) -> + CounterId = rand:uniform(WorkerCount), + Match = [{{'$1', '$2'}, + [{'=:=', '$1', CounterId}], + [{{'$1', {'+', '$2', 1}}}]}], + case ets:select_replace(T, Match) of + 1 -> ok; + 0 -> + ets:insert_new(T, {CounterId, 1}) orelse + F(IterId) + end + end, + lists:seq(1, CounterIterations)), + State + end, + FiniF = fun (State) -> State end, + run_workers_do(InitF, ExecF, FiniF, WorkerCount), + FinalCounts = ets:select(T, [{{'_', '$1'}, [], ['$1']}]), + TotalIterations = WorkerCount * CounterIterations * erlang:system_info(schedulers), + TotalIterations = lists:sum(FinalCounts), + WorkerCount = ets:select_delete(T, [{{'_', '_'}, [], [true]}]), + 0 = ets:info(T, size), + ets:delete(T) + end, + [ordered_set, set, duplicate_bag]). + %% Test different types. types(Config) when is_list(Config) -> init_externals(), @@ -5959,7 +6212,6 @@ only_if_smp(Schedulers, Func) -> end. %% Copy-paste from emulator/test/binary_SUITE.erl --define(heap_binary_size, 64). test_terms(Test_Func, Mode) -> garbage_collect(), Pib0 = process_info(self(),binary), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 87fba815d2..6133a3ded4 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -507,7 +507,12 @@ file_props_symlink(Config) -> end. find_source(Config) when is_list(Config) -> - BeamFile = code:which(lists), + %% filename:find_{file,source}() does not work if the files are + %% cover-compiled. To make sure that the test does not fail + %% when the STDLIB is cover-compiled, search for modules in + %% the compiler application. + + BeamFile = code:which(compile), BeamName = filename:basename(BeamFile), BeamDir = filename:dirname(BeamFile), SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", @@ -530,7 +535,7 @@ find_source(Config) when is_list(Config) -> {error, not_found} = filelib:find_source(BeamName, BeamDir, [{".erl",".yrl",[{"",""}]}]), - {ok, ParserErl} = filelib:find_source(code:which(erl_parse)), + {ok, ParserErl} = filelib:find_source(code:which(core_parse)), {ok, ParserYrl} = filelib:find_source(ParserErl), "lry." ++ _ = lists:reverse(ParserYrl), {ok, ParserYrl} = filelib:find_source(ParserErl, diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index d546e8fad2..b2754e47ba 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -30,7 +30,8 @@ io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, otp_10836/1, io_lib_width_too_small/1, io_with_huge_message_queue/1, format_string/1, - maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1]). + maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1, + otp_14285/1]). -export([pretty/2]). @@ -61,7 +62,8 @@ all() -> printable_range, bad_printable_range, io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836, io_lib_width_too_small, io_with_huge_message_queue, - format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175]. + format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175, + otp_14285]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -755,6 +757,8 @@ rfd(rrrrr, 3) -> [f1, f2, f3]; rfd(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 0) -> []; +rfd('\x{400}', 1) -> + ['\x{400}']; rfd(_, _) -> no. @@ -1881,6 +1885,7 @@ otp_10302(Suite) when is_list(Suite) -> pretty(Term, Depth) when is_integer(Depth) -> Opts = [{column, 1}, {line_length, 20}, {depth, Depth}, {max_chars, 60}, + {record_print_fun, fun rfd/2}, {encoding, unicode}], pretty(Term, Opts); pretty(Term, Opts) when is_list(Opts) -> @@ -2324,3 +2329,23 @@ text1([T|Ts]) -> [erl_anno:text(Anno) | text1(Ts)]. -endif. % EXACT + +otp_14285(_Config) -> + UOpts = [{record_print_fun, fun rfd/2}, + {encoding, unicode}], + LOpts = [{record_print_fun, fun rfd/2}, + {encoding, latin1}], + + RT = {'\x{400}','\x{400}'}, + "#'\x{400}'{'\x{400}' = '\x{400}'}" = pretty(RT, UOpts), + "#'\\x{400}'{'\\x{400}' = '\\x{400}'}" = pretty(RT, LOpts), + + Chars = lists:seq(0, 512), + [] = [C || + C <- Chars, + S <- io_lib:write_atom_as_latin1(list_to_atom([C])), + not is_latin1(S)], + L1 = [S || C <- Chars, S <- io_lib:write_atom(list_to_atom([C])), + not is_latin1(S)], + L1 = lists:seq(256, 512), + ok. diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index fe5eaccda5..098eefeb61 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -356,14 +356,23 @@ basic_normal_1(0, {#{type:=Alg}, _}, Sum, SumSq) -> %% Test that the user can write algorithms. plugin(Config) when is_list(Config) -> - _ = lists:foldl(fun(_, S0) -> - {V1, S1} = rand:uniform_s(10000, S0), - true = is_integer(V1), - {V2, S2} = rand:uniform_s(S1), - true = is_float(V2), - S2 - end, crypto_seed(), lists:seq(1, 200)), - ok. + try crypto:strong_rand_bytes(1) of + <<_>> -> + _ = lists:foldl( + fun(_, S0) -> + {V1, S1} = rand:uniform_s(10000, S0), + true = is_integer(V1), + {V2, S2} = rand:uniform_s(S1), + true = is_float(V2), + S2 + end, crypto_seed(), lists:seq(1, 200)), + ok + catch + error:low_entropy -> + {skip,low_entropy}; + error:undef -> + {skip,no_crypto} + end. %% Test implementation crypto_seed() -> @@ -397,7 +406,13 @@ crypto_uniform_n(N, State0) -> measure(Suite) when is_atom(Suite) -> []; measure(_Config) -> ct:timetrap({minutes,15}), %% valgrind needs a lot of time - Algos = [crypto64|algs()], + Algos = + try crypto:strong_rand_bytes(1) of + <<_>> -> [crypto64] + catch + error:low_entropy -> []; + error:undef -> [] + end ++ algs(), io:format("RNG uniform integer performance~n",[]), _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), _ = [measure_1(Algo, fun(State) -> {int, rand:uniform_s(10000, State)} end) || Algo <- Algos], diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 4864bc3d72..56002dda25 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% Copyright Ericsson AB 2004-2017. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,7 +30,8 @@ progex_bit_syntax/1, progex_records/1, progex_lc/1, progex_funs/1, otp_5990/1, otp_6166/1, otp_6554/1, - otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1]). + otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1, + otp_14285/1]). -export([ start_restricted_from_shell/1, start_restricted_on_command_line/1,restricted_local/1]). @@ -91,7 +92,7 @@ groups() -> progex_funs]}, {tickets, [], [otp_5990, otp_6166, otp_6554, otp_7184, - otp_7232, otp_8393, otp_10302, otp_13719]}]. + otp_7232, otp_8393, otp_10302, otp_13719, otp_14285]}]. init_per_suite(Config) -> Config. @@ -2824,6 +2825,22 @@ otp_13719(Config) when is_list(Config) -> file:delete(File), ok. +otp_14285(Config) -> + {ok,Node} = start_node(shell_suite_helper_4, + "-pa "++proplists:get_value(priv_dir,Config)++ + " +pc unicode"), + Test1 = + <<"begin + io:setopts([{encoding,utf8}]), + [1024] = atom_to_list('\\x{400}'), + rd('\\x{400}', {'\\x{400}' = '\\x{400}'}), + ok = rl('\\x{400}') + end.">>, + "-record('\x{400}',{'\x{400}' = '\x{400}'}).\nok.\n" = + t({Node,Test1}), + test_server:stop_node(Node), + ok. + scan(B) -> F = fun(Ts) -> case erl_parse:parse_term(Ts) of diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 378d69095d..40ddd2b22a 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -452,7 +452,7 @@ lay_2(Node, Ctxt) -> text(erl_syntax:variable_literal(Node)); atom -> - text(erl_syntax:atom_literal(Node)); + text(erl_syntax:atom_literal(Node, Ctxt#ctxt.encoding)); integer -> text(erl_syntax:integer_literal(Node)); diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 4347cc46c1..9b2b503762 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -139,6 +139,7 @@ is_atom/2, atom_value/1, atom_literal/1, + atom_literal/2, atom_name/1, attribute/1, attribute/2, @@ -1841,7 +1842,7 @@ char_literal(Node) -> %% @doc Returns the literal string represented by a `char' %% node. This includes the leading "`$'" character. %% Depending on the encoding a character beyond 255 will be escaped -%% ('latin1') or copied as is ('utf8'). +%% (`latin1') or copied as is (`utf8'). %% %% @see char/1 @@ -1944,7 +1945,7 @@ string_literal(Node) -> %% @doc Returns the literal string represented by a `string' %% node. This includes surrounding double-quote characters. %% Depending on the encoding characters beyond 255 will be escaped -%% ('latin1') or copied as is ('utf8'). +%% (`latin1') or copied as is (`utf8'). %% %% @see string/1 @@ -1965,6 +1966,7 @@ string_literal(Node, latin1) -> %% @see atom_value/1 %% @see atom_name/1 %% @see atom_literal/1 +%% @see atom_literal/2 %% @see is_atom/2 %% type(Node) = atom @@ -2037,6 +2039,7 @@ atom_name(Node) -> %% ===================================================================== %% @doc Returns the literal string represented by an `atom' %% node. This includes surrounding single-quote characters if necessary. +%% Characters beyond 255 will be escaped. %% %% Note that e.g. the result of `atom("x\ny")' represents %% any and all of `'x\ny'', `'x\12y'', @@ -2048,8 +2051,24 @@ atom_name(Node) -> -spec atom_literal(syntaxTree()) -> string(). atom_literal(Node) -> - io_lib:write_atom(atom_value(Node)). + atom_literal(Node, latin1). + +%% ===================================================================== +%% @doc Returns the literal string represented by an `atom' +%% node. This includes surrounding single-quote characters if necessary. +%% Depending on the encoding a character beyond 255 will be escaped +%% (`latin1') or copied as is (`utf8'). +%% +%% @see atom/1 +%% @see atom_literal/1 +%% @see string/1 +atom_literal(Node, utf8) -> + io_lib:write_atom(atom_value(Node)); +atom_literal(Node, unicode) -> + io_lib:write_atom(atom_value(Node)); +atom_literal(Node, latin1) -> + io_lib:write_atom_as_latin1(atom_value(Node)). %% ===================================================================== %% @equiv map_expr(none, Fields) diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 0d2da5d4a7..05d56667ab 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -128,7 +128,7 @@ bool WxeApp::OnInit() delayed_cleanup = new wxList; wxe_ps_init2(); - // wxIdleEvent::SetMode(wxIDLE_PROCESS_SPECIFIED); // Hmm printpreview doesn't work in 2.9 with this + wxIdleEvent::SetMode(wxIDLE_PROCESS_SPECIFIED); Connect(wxID_ANY, wxEVT_IDLE, (wxObjectEventFunction) (wxEventFunction) &WxeApp::idle); Connect(CREATE_PORT, wxeEVT_META_COMMAND,(wxObjectEventFunction) (wxEventFunction) &WxeApp::newMemEnv); @@ -200,7 +200,8 @@ void WxeApp::OnAssertFailure(const wxChar *file, int line, const wxChar *cfunc, // Called by wx thread void WxeApp::idle(wxIdleEvent& event) { event.Skip(true); - dispatch_cmds(); + if(dispatch_cmds()) + event.RequestMore(); } /* ************************************************************ @@ -233,14 +234,15 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) } } -void WxeApp::dispatch_cmds() +int WxeApp::dispatch_cmds() { + int more = 0; if(wxe_status != WXE_INITIATED) - return; + return more; recurse_level++; // fprintf(stderr, "\r\ndispatch_normal %d\r\n", recurse_level);fflush(stderr); wxe_queue->cb_start = 0; - dispatch(wxe_queue); + more = dispatch(wxe_queue); // fprintf(stderr, "\r\ndispatch_done %d\r\n", recurse_level);fflush(stderr); recurse_level--; @@ -262,12 +264,14 @@ void WxeApp::dispatch_cmds() delete event; } } + return more; } int WxeApp::dispatch(wxeFifo * batch) { int ping = 0; int blevel = 0; + int wait = 0; // Let event handling generate events sometime wxeCommand *event; erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { @@ -275,10 +279,10 @@ int WxeApp::dispatch(wxeFifo * batch) erl_drv_mutex_unlock(wxe_batch_locker_m); switch(event->op) { case WXE_BATCH_END: - {--blevel; } + if(blevel>0) blevel--; break; case WXE_BATCH_BEGIN: - {blevel++; } + blevel++; break; case WXE_DEBUG_PING: // When in debugger we don't want to hang waiting for a BATCH_END @@ -293,7 +297,7 @@ int WxeApp::dispatch(wxeFifo * batch) memcpy(cb_buff, event->buffer, event->len); } event->Delete(); - return blevel; + return 1; default: if(event->op < OPENGL_START) { // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); @@ -307,13 +311,15 @@ int WxeApp::dispatch(wxeFifo * batch) erl_drv_mutex_lock(wxe_batch_locker_m); batch->Cleanup(); } - if(blevel <= 0) { + if(blevel <= 0 || wait > 3) { erl_drv_mutex_unlock(wxe_batch_locker_m); - return blevel; + if(blevel > 0) return 1; // We are still in a batch but we can let wx check for events + else return 0; } // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel);fflush(stderr); + // fprintf(stderr, "%s:%d sleep %d %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel, wait);fflush(stderr); wxe_needs_signal = 1; + wait += 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } diff --git a/lib/wx/c_src/wxe_impl.h b/lib/wx/c_src/wxe_impl.h index 57dac997ab..68f5deb336 100644 --- a/lib/wx/c_src/wxe_impl.h +++ b/lib/wx/c_src/wxe_impl.h @@ -73,7 +73,7 @@ public: void wxe_dispatch(wxeCommand& event); void idle(wxIdleEvent& event); - void dispatch_cmds(); + int dispatch_cmds(); void dummy_close(wxEvent& Ev); bool sendevent(wxEvent *event); diff --git a/lib/wx/examples/demo/demo.erl b/lib/wx/examples/demo/demo.erl index 8b7412017a..0258202a67 100644 --- a/lib/wx/examples/demo/demo.erl +++ b/lib/wx/examples/demo/demo.erl @@ -243,6 +243,9 @@ handle_event(#wx{id = Id, %% If you are going to printout mainly text it is easier if %% you generate HTML code and use a wxHtmlEasyPrint %% instead of using DCs + + %% Printpreview doesn't work in >2.9 without this + wxIdleEvent:setMode(?wxIDLE_PROCESS_ALL), Module = "ex_" ++ wxListBox:getStringSelection(State#state.selector) ++ ".erl", HEP = wxHtmlEasyPrinting:new([{name, "Print"}, {parentWindow, State#state.win}]), diff --git a/lib/wx/src/wxe_master.erl b/lib/wx/src/wxe_master.erl index e17a3327ac..913bf4d41b 100644 --- a/lib/wx/src/wxe_master.erl +++ b/lib/wx/src/wxe_master.erl @@ -82,8 +82,14 @@ init_port(SilentStart) -> %% Initalizes the opengl library %%-------------------------------------------------------------------- init_opengl() -> - GLLib = wxe_util:wxgl_dl(), - wxe_util:call(?WXE_INIT_OPENGL, <<(list_to_binary(GLLib))/binary, 0:8>>). + case get(wx_init_opengl) of + true -> {ok, "already initialized"}; + _ -> + GLLib = wxe_util:wxgl_dl(), + Res = wxe_util:call(?WXE_INIT_OPENGL, <<(list_to_binary(GLLib))/binary, 0:8>>), + element(1, Res) =:= ok andalso put(wx_init_opengl, true), + Res + end. %%-------------------------------------------------------------------- %% Fetch early messages, hack to get start up args on mac diff --git a/otp_versions.table b/otp_versions.table index 40a01f6899..8fb437bb96 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-19.3.1 : crypto-3.7.4 erts-8.3.1 inets-6.3.7 ssh-4.4.2 ssl-8.1.2 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 dialyzer-3.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.13 : OTP-19.3 : common_test-1.14 compiler-7.0.4 crypto-3.7.3 dialyzer-3.1 diameter-1.12.2 erl_interface-3.9.3 erts-8.3 hipe-3.15.4 inets-6.3.6 kernel-5.2 observer-2.3.1 os_mon-2.4.2 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.1 ssl-8.1.1 stdlib-3.3 tools-2.9.1 typer-0.9.12 xmerl-1.3.13 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 et-1.6 eunit-2.3.2 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 mnesia-4.14.3 odbc-2.12 orber-3.8.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 syntax_tools-2.1.1 wx-1.8 : OTP-19.2.3 : erts-8.2.2 inets-6.3.5 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : OTP-19.2.2 : mnesia-4.14.3 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2.1 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 : |