diff options
74 files changed, 1720 insertions, 636 deletions
diff --git a/.gitignore b/.gitignore index d67116d6e3..54bfadea9a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,10 @@ # Match at any level. + +# emacs *~ +# vim +.*.sw[a-z] + autom4te.cache *.beam *.asn1db @@ -162,6 +167,7 @@ make/win32/ /erts/emulator/test/*_SUITE_make.erl /erts/emulator/test/*_SUITE_data/Makefile /erts/test/install_SUITE_data/install_bin +/erts/test/autoimport_SUITE_data/erlang.xml # asn1 diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d4a43f6e5f..bb237e378a 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1351,9 +1351,10 @@ BIF_RETTYPE exit_2(BIF_ALIST_2) #ifdef ERTS_SMP if (rp == BIF_P) rp_locks &= ~ERTS_PROC_LOCK_MAIN; - else + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + if (rp != BIF_P) erts_smp_proc_dec_refc(rp); - erts_smp_proc_unlock(rp, rp_locks); #endif /* * We may have exited ourselves and may have to take action. diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 694460d702..02910fad90 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -917,6 +917,7 @@ int erts_net_message(Port *prt, Eterm token_size; ErtsMonitor *mon; ErtsLink *lnk; + Uint tuple_arity; int res; #ifdef ERTS_DIST_MSG_DBG int orig_len = len; @@ -1003,29 +1004,23 @@ int erts_net_message(Port *prt, #endif if (is_not_tuple(arg) || - (tuple = tuple_val(arg), arityval(*tuple) < 1) || + (tuple = tuple_val(arg), (tuple_arity = arityval(*tuple)) < 1) || is_not_small(tuple[1])) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Invalid distribution message: %.200T", arg); - erts_send_error_to_logger_nogl(dsbufp); - goto data_error; + goto invalid_message; } token_size = 0; switch (type = unsigned_val(tuple[1])) { case DOP_LINK: + if (tuple_arity != 3) { + goto invalid_message; + } from = tuple[2]; to = tuple[3]; /* local proc to link to */ if (is_not_pid(from) || is_not_pid(to)) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - PURIFY_MSG("data error"); - erts_dsprintf(dsbufp, - "Invalid DOP_LINK distribution message: %.200T", - arg); - erts_send_error_to_logger_nogl(dsbufp); - goto data_error; + goto invalid_message; } rp = erts_pid2proc_opt(NULL, 0, @@ -1064,8 +1059,14 @@ int erts_net_message(Port *prt, case DOP_UNLINK: { ErtsDistLinkData dld; + if (tuple_arity != 3) { + goto invalid_message; + } from = tuple[2]; to = tuple[3]; + if (is_not_pid(from) || is_not_pid(to)) { + goto invalid_message; + } rp = erts_pid2proc_opt(NULL, 0, to, ERTS_PROC_LOCK_LINK, @@ -1092,11 +1093,19 @@ int erts_net_message(Port *prt, /* A remote process wants to monitor us, we get: {DOP_MONITOR_P, Remote pid, local pid or name, ref} */ Eterm name; + + if (tuple_arity != 4) { + goto invalid_message; + } watcher = tuple[2]; watched = tuple[3]; /* local proc to monitor */ ref = tuple[4]; + if (is_not_ref(ref)) { + goto invalid_message; + } + if (is_atom(watched)) { name = watched; rp = erts_whereis_process(NULL, 0, @@ -1138,10 +1147,17 @@ int erts_net_message(Port *prt, We get {DOP_DEMONITOR_P, Remote pid, Local pid or name, ref}, We need only the ref of course */ + if (tuple_arity != 4) { + goto invalid_message; + } /* watcher = tuple[2]; */ /* watched = tuple[3]; May be an atom in case of monitor name */ ref = tuple[4]; + if(is_not_ref(ref)) { + goto invalid_message; + } + erts_smp_de_links_lock(dep); mon = erts_remove_monitor(&(dep->monitors),ref); erts_smp_de_links_unlock(dep); @@ -1166,10 +1182,11 @@ int erts_net_message(Port *prt, erts_destroy_monitor(mon); break; - case DOP_NODE_LINK: /* XXX never sent ?? */ - break; - case DOP_REG_SEND_TT: + if (tuple_arity != 5) { + goto invalid_message; + } + token_size = size_object(tuple[5]); /* Fall through ... */ case DOP_REG_SEND: @@ -1180,12 +1197,19 @@ int erts_net_message(Port *prt, * There is intentionally no testing of the cookie (it is always '') * from R9B and onwards. */ + if (type != DOP_REG_SEND_TT && tuple_arity != 4) { + goto invalid_message; + } + #ifdef ERTS_DIST_MSG_DBG dist_msg_dbg(&ede, "MSG", buf, orig_len); #endif from = tuple[2]; to = tuple[4]; + if (is_not_pid(from) || is_not_atom(to)){ + goto invalid_message; + } rp = erts_whereis_process(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); if (rp) { Uint xsize = (type == DOP_REG_SEND @@ -1217,6 +1241,10 @@ int erts_net_message(Port *prt, break; case DOP_SEND_TT: + if (tuple_arity != 4) { + goto invalid_message; + } + token_size = size_object(tuple[4]); /* Fall through ... */ case DOP_SEND: @@ -1227,8 +1255,13 @@ int erts_net_message(Port *prt, #ifdef ERTS_DIST_MSG_DBG dist_msg_dbg(&ede, "MSG", buf, orig_len); #endif - + if (type != DOP_SEND_TT && tuple_arity != 3) { + goto invalid_message; + } to = tuple[3]; + if (is_not_pid(to)) { + goto invalid_message; + } rp = erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); if (rp) { Uint xsize = type == DOP_SEND ? 0 : ERTS_HEAP_FRAG_SIZE(token_size); @@ -1266,11 +1299,19 @@ int erts_net_message(Port *prt, Eterm sysname; ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_MSG_SEND|ERTS_PROC_LOCK_LINK; + if (tuple_arity != 5) { + goto invalid_message; + } + /* watched = tuple[2]; */ /* remote proc which died */ /* watcher = tuple[3]; */ ref = tuple[4]; reason = tuple[5]; + if(is_not_ref(ref)) { + goto invalid_message; + } + erts_smp_de_links_lock(dep); sysname = dep->sysname; mon = erts_remove_monitor(&(dep->monitors), ref); @@ -1317,24 +1358,25 @@ int erts_net_message(Port *prt, ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND; /* 'from', which 'to' is linked to, died */ if (type == DOP_EXIT) { - from = tuple[2]; - to = tuple[3]; - reason = tuple[4]; - token = NIL; + if (tuple_arity != 4) { + goto invalid_message; + } + + from = tuple[2]; + to = tuple[3]; + reason = tuple[4]; + token = NIL; } else { - from = tuple[2]; - to = tuple[3]; - token = tuple[4]; - reason = tuple[5]; + if (tuple_arity != 5) { + goto invalid_message; + } + from = tuple[2]; + to = tuple[3]; + token = tuple[4]; + reason = tuple[5]; } - if (is_not_internal_pid(to)) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - PURIFY_MSG("data error"); - erts_dsprintf(dsbufp, - "Invalid DOP_EXIT distribution message: %.200T", - arg); - erts_send_error_to_logger_nogl(dsbufp); - goto data_error; + if (is_not_pid(from) || is_not_internal_pid(to)) { + goto invalid_message; } rp = erts_pid2proc(NULL, 0, to, rp_locks); @@ -1381,15 +1423,24 @@ int erts_net_message(Port *prt, ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; /* 'from' is send an exit signal to 'to' */ if (type == DOP_EXIT2) { - from = tuple[2]; - to = tuple[3]; - reason = tuple[4]; - token = NIL; + if (tuple_arity != 4) { + goto invalid_message; + } + from = tuple[2]; + to = tuple[3]; + reason = tuple[4]; + token = NIL; } else { - from = tuple[2]; - to = tuple[3]; - token = tuple[4]; - reason = tuple[5]; + if (tuple_arity != 5) { + goto invalid_message; + } + from = tuple[2]; + to = tuple[3]; + token = tuple[4]; + reason = tuple[5]; + } + if (is_not_pid(from) || is_not_internal_pid(to)) { + goto invalid_message; } rp = erts_pid2proc_opt(NULL, 0, to, rp_locks, ERTS_P2P_FLG_SMP_INC_REFC); @@ -1408,10 +1459,14 @@ int erts_net_message(Port *prt, break; } case DOP_GROUP_LEADER: + if (tuple_arity != 3) { + goto invalid_message; + } from = tuple[2]; /* Group leader */ to = tuple[3]; /* new member */ - if (is_not_pid(from)) - break; + if (is_not_pid(from) || is_not_pid(to)) { + goto invalid_message; + } rp = erts_pid2proc(NULL, 0, to, ERTS_PROC_LOCK_MAIN); if (!rp) @@ -1420,16 +1475,8 @@ int erts_net_message(Port *prt, erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); break; - default: { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, - "Illegal value in distribution dispatch switch: " - "%.200T", - arg); - erts_send_error_to_logger_nogl(dsbufp); - PURIFY_MSG("data error"); - goto data_error; - } + default: + goto invalid_message; } erts_cleanup_offheap(&off_heap); @@ -1441,8 +1488,14 @@ int erts_net_message(Port *prt, UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); ERTS_SMP_CHK_NO_PROC_LOCKS; return 0; - + invalid_message: + { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Invalid distribution message: %.200T", arg); + erts_send_error_to_logger_nogl(dsbufp); + } data_error: + PURIFY_MSG("data error"); erts_cleanup_offheap(&off_heap); #ifndef HYBRID /* FIND ME! */ if (ctl != ctl_default) { diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index 9ccc3e5ba9..695a4fc3fe 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -52,7 +52,7 @@ #define DOP_SEND 2 #define DOP_EXIT 3 #define DOP_UNLINK 4 -#define DOP_NODE_LINK 5 +/* Ancient DOP_NODE_LINK (5) was here, can be reused */ #define DOP_REG_SEND 6 #define DOP_GROUP_LEADER 7 #define DOP_EXIT2 8 @@ -69,7 +69,6 @@ /* distribution trap functions */ extern Export* dsend2_trap; extern Export* dsend3_trap; -/*extern Export* dsend_nosuspend_trap;*/ extern Export* dlink_trap; extern Export* dunlink_trap; extern Export* dmonitor_node_trap; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 7793f60f4f..e85e2d7e3f 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1568,7 +1568,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) Eterm atoms[sizeof(size)/sizeof(Uint)]; Uint *uintps[sizeof(size)/sizeof(Uint)]; Eterm euints[sizeof(size)/sizeof(Uint)]; - int need_atom; int want_tot_or_sys; int length; Eterm res = THE_NON_VALUE; @@ -1756,7 +1755,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) /* Calculate values needed... */ want_tot_or_sys = want.total || want.system; - need_atom = ERTS_MEM_NEED_ALL_ALCU || want.atom; if (ERTS_MEM_NEED_ALL_ALCU) { size.total = 0; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 408ffd12f7..b7b9c6a133 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -263,6 +263,8 @@ type XPORTS_LIST SHORT_LIVED SYSTEM extra_port_list type PROC_LCK_WTR LONG_LIVED SYSTEM proc_lock_waiter type PROC_LCK_QS LONG_LIVED SYSTEM proc_lock_queues type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing +type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q +type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work +endif # diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 88d2c06246..6f8a7436d5 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -555,10 +555,11 @@ fmt_int(byte *buf, Uint sz, Eterm val, Uint size, Uint flags) { unsigned long offs; - ASSERT(size != 0); offs = BIT_OFFSET(size); if (is_small(val)) { Sint v = signed_val(val); + + ASSERT(size != 0); /* Tested by caller */ if (flags & BSF_LITTLE) { /* Little endian */ sz--; COPY_VAL(buf,1,v,sz); @@ -578,6 +579,9 @@ fmt_int(byte *buf, Uint sz, Eterm val, Uint size, Uint flags) ErtsDigit* dp = big_v(val); int n = MIN(sz,ds); + if (size == 0) { + return 0; + } if (flags & BSF_LITTLE) { sz -= n; /* pad with this amount */ if (sign) { @@ -729,15 +733,13 @@ erts_new_bs_put_integer(ERL_BITS_PROTO_3(Eterm arg, Uint num_bits, unsigned flag Uint b; byte *iptr; - if (num_bits == 0) { - return 1; - } - bit_offset = BIT_OFFSET(bin_offset); if (is_small(arg)) { Uint rbits = 8 - bit_offset; - if (bit_offset + num_bits <= 8) { + if (num_bits == 0) { + return 1; + } else if (bit_offset + num_bits <= 8) { /* * All bits are in the same byte. */ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 65565cf3c7..3173d3510e 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -219,47 +219,68 @@ Export ets_select_continue_exp; * Static traps */ static Export ets_delete_continue_exp; - -static ERTS_INLINE DbTable* db_ref(DbTable* tb, db_lock_kind_t kind) -{ - if (tb != NULL && kind != LCK_READ) { - erts_refc_inc(&tb->common.ref, 2); - } - return tb; -} - -static ERTS_INLINE DbTable* db_unref(DbTable* tb, db_lock_kind_t kind) + +static void +free_dbtable(DbTable* tb) { - if (kind != LCK_READ && !erts_refc_dectest(&tb->common.ref, 0)) { #ifdef HARDDEBUG if (erts_smp_atomic_read(&tb->common.memory_size) != sizeof(DbTable)) { - erts_fprintf(stderr, "ets: db_unref memory remain=%ld fix=%x\n", - erts_smp_atomic_read(&tb->common.memory_size)-sizeof(DbTable), + erts_fprintf(stderr, "ets: free_dbtable memory remain=%ld fix=%x\n", + erts_smp_atomic_read(&tb->common.memory_size)-sizeof(DbTable), tb->common.fixations); } - erts_fprintf(stderr, "ets: db_unref(%T) deleted!!!\r\n", + erts_fprintf(stderr, "ets: free_dbtable(%T) deleted!!!\r\n", tb->common.id); - erts_fprintf(stderr, "ets: db_unref: meta_pid_to_tab common.memory_size = %ld\n", + erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_tab common.memory_size = %ld\n", erts_smp_atomic_read(&meta_pid_to_tab->common.memory_size)); print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_tab); - erts_fprintf(stderr, "ets: db_unref: meta_pid_to_fixed_tab common.memory_size = %ld\n", + erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_fixed_tab common.memory_size = %ld\n", erts_smp_atomic_read(&meta_pid_to_fixed_tab->common.memory_size)); print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_fixed_tab); - #endif #ifdef ERTS_SMP erts_smp_rwmtx_destroy(&tb->common.rwlock); erts_smp_mtx_destroy(&tb->common.fixlock); #endif ASSERT(is_immed(tb->common.heir_data)); - erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); + erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); - return NULL; - } - return tb; +} + +#ifdef ERTS_SMP +static void +chk_free_dbtable(void *vtb) +{ + DbTable * tb = (DbTable *) vtb; + ERTS_THR_MEMORY_BARRIER; + if (erts_refc_dectest(&tb->common.ref, 0) == 0) + free_dbtable(tb); +} +#endif + +static void schedule_free_dbtable(DbTable* tb) +{ + /* + * NON-SMP case: Caller is *not* allowed to access the *tb + * structure after this function has returned! + * SMP case: Caller is allowed to access the *tb structure + * until the bif has returned (we typically + * need to unlock the table lock after this + * function has returned). + */ +#ifdef ERTS_SMP + int scheds = erts_get_max_no_executing_schedulers(); + ASSERT(scheds >= 1); + ASSERT(erts_refc_read(&tb->common.ref, 0) == 0); + erts_refc_init(&tb->common.ref, scheds); + ERTS_THR_MEMORY_BARRIER; + erts_smp_schedule_misc_aux_work(0, scheds, chk_free_dbtable, tb); +#else + free_dbtable(tb); +#endif } static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock, @@ -270,8 +291,6 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock, if (use_frequent_read_lock) rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; #endif - erts_refc_init(&tb->common.ref, 1); - erts_refc_init(&tb->common.fixref, 0); #ifdef ERTS_SMP erts_smp_rwmtx_init_opt_x(&tb->common.rwlock, &rwmtx_opt, rwname, tb->common.the_name); @@ -280,7 +299,7 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock, #endif } -static ERTS_INLINE void db_lock_take_over_ref(DbTable* tb, db_lock_kind_t kind) +static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind) { #ifdef ERTS_SMP ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); @@ -308,16 +327,13 @@ static ERTS_INLINE void db_lock_take_over_ref(DbTable* tb, db_lock_kind_t kind) #endif } -static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind) -{ - (void) db_ref(tb, kind); -#ifdef ERTS_SMP - db_lock_take_over_ref(tb, kind); -#endif -} - static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) { + /* + * In NON-SMP case tb may refer to an already deallocated + * DbTable structure. That is, ONLY the SMP case is allowed + * to follow the tb pointer! + */ #ifdef ERTS_SMP ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); @@ -344,7 +360,6 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) } } #endif - (void) db_unref(tb, kind); /* May delete table... */ } @@ -371,6 +386,13 @@ DbTable* db_get_table_aux(Process *p, DbTable *tb = NULL; erts_smp_rwmtx_t *mtl = NULL; + /* + * IMPORTANT: Only scheduler threads are allowed + * to access tables. Memory management + * depend on it. + */ + ASSERT(erts_get_scheduler_data()); + if (is_small(id)) { Uint slot = unsigned_val(id) & meta_main_tab_slot_mask; if (!meta_already_locked) { @@ -384,12 +406,8 @@ DbTable* db_get_table_aux(Process *p, || erts_lc_rwmtx_is_rwlocked(test_mtl)); } #endif - if (slot < db_max_tabs && IS_SLOT_ALIVE(slot)) { - /* SMP: inc to prevent race, between unlock of meta_main_tab_lock - * and the table locking outside the meta_main_tab_lock - */ - tb = db_ref(meta_main_tab[slot].u.tb, kind); - } + if (slot < db_max_tabs && IS_SLOT_ALIVE(slot)) + tb = meta_main_tab[slot].u.tb; } else if (is_atom(id)) { struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&mtl); @@ -403,16 +421,15 @@ DbTable* db_get_table_aux(Process *p, if (bucket->pu.tb != NULL) { if (is_atom(bucket->u.name_atom)) { /* single */ - if (bucket->u.name_atom == id) { - tb = db_ref(bucket->pu.tb, kind); - } + if (bucket->u.name_atom == id) + tb = bucket->pu.tb; } else { /* multi */ Uint cnt = unsigned_val(bucket->u.mcnt); Uint i; for (i=0; i<cnt; i++) { if (bucket->pu.mvec[i].u.name_atom == id) { - tb = db_ref(bucket->pu.mvec[i].pu.tb, kind); + tb = bucket->pu.mvec[i].pu.tb; break; } } @@ -420,7 +437,7 @@ DbTable* db_get_table_aux(Process *p, } } if (tb) { - db_lock_take_over_ref(tb, kind); + db_lock(tb, kind); if (tb->common.id != id || ((tb->common.status & what) == 0 && p->id != tb->common.owner)) { db_unlock(tb, kind); @@ -594,11 +611,11 @@ done: */ static ERTS_INLINE void local_fix_table(DbTable* tb) { - erts_refc_inc(&tb->common.fixref, 1); + erts_refc_inc(&tb->common.ref, 1); } static ERTS_INLINE void local_unfix_table(DbTable* tb) { - if (erts_refc_dectest(&tb->common.fixref, 0) == 0) { + if (erts_refc_dectest(&tb->common.ref, 0) == 0) { ASSERT(IS_HASH_TABLE(tb->common.status)); db_unfix_table_hash(&(tb->hash)); } @@ -1414,6 +1431,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.type = status & ERTS_ETS_TABLE_TYPES; /* Note, 'type' is *read only* from now on... */ #endif + erts_refc_init(&tb->common.ref, 0); db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ), "db_tab", "db_tab_fix"); tb->common.keypos = keypos; @@ -1436,8 +1454,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) "** Too many db tables **\n"); free_heir_data(tb); tb->common.meth->db_free_table(tb); - erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); - ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); + free_dbtable(tb); BIF_ERROR(BIF_P, SYSTEM_LIMIT); } @@ -1471,9 +1488,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) free_slot(slot); erts_smp_rwmtx_rwunlock(mmtl); - db_lock_take_over_ref(tb,LCK_WRITE); + db_lock(tb,LCK_WRITE); free_heir_data(tb); tb->common.meth->db_free_table(tb); + schedule_free_dbtable(tb); db_unlock(tb,LCK_WRITE); BIF_ERROR(BIF_P, BADARG); } @@ -2845,8 +2863,7 @@ void init_db(void) meta_pid_to_tab->common.meth = &db_hash; meta_pid_to_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_tab->common.ref, 1); - erts_refc_init(&meta_pid_to_tab->common.fixref, 0); + erts_refc_init(&meta_pid_to_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/ @@ -2878,8 +2895,7 @@ void init_db(void) meta_pid_to_fixed_tab->common.meth = &db_hash; meta_pid_to_fixed_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 1); - erts_refc_init(&meta_pid_to_fixed_tab->common.fixref, 0); + erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/ @@ -3037,12 +3053,10 @@ retry: to_pid, to_locks, ERTS_P2P_FLG_TRY_LOCK); if (to_proc == ERTS_PROC_LOCK_BUSY) { - db_ref(tb, LCK_NONE); /* while unlocked */ db_unlock(tb,LCK_WRITE); to_proc = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, to_pid, to_locks); db_lock(tb,LCK_WRITE); - tb = db_unref(tb, LCK_NONE); ASSERT(tb != NULL); if (tb->common.owner != p->id) { @@ -3153,13 +3167,13 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix); erts_smp_rwmtx_rlock(mmtl); if (!IS_SLOT_FREE(ix)) { - tb = db_ref(GET_ANY_SLOT_TAB(ix), LCK_WRITE); + tb = GET_ANY_SLOT_TAB(ix); ASSERT(tb); } erts_smp_rwmtx_runlock(mmtl); if (tb) { int do_yield; - db_lock_take_over_ref(tb, LCK_WRITE); + db_lock(tb, LCK_WRITE); /* Ownership may have changed since we looked up the table. */ if (tb->common.owner != pid) { @@ -3241,7 +3255,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix); erts_smp_rwmtx_rlock(mmtl); if (IS_SLOT_ALIVE(ix)) { - tb = db_ref(meta_main_tab[ix].u.tb, LCK_WRITE_REC); + tb = meta_main_tab[ix].u.tb; ASSERT(tb); } erts_smp_rwmtx_runlock(mmtl); @@ -3249,7 +3263,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) int reds; DbFixation** pp; - db_lock_take_over_ref(tb, LCK_WRITE_REC); + db_lock(tb, LCK_WRITE_REC); #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif @@ -3260,7 +3274,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) if ((*pp)->pid == pid) { DbFixation* fix = *pp; erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.fixref,diff,0); + erts_refc_add(&tb->common.ref,diff,0); *pp = fix->next; erts_db_free(ERTS_ALC_T_DB_FIXATION, tb, fix, sizeof(DbFixation)); @@ -3335,7 +3349,7 @@ static void fix_table_locked(Process* p, DbTable* tb) #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif - erts_refc_inc(&tb->common.fixref,1); + erts_refc_inc(&tb->common.ref,1); fix = tb->common.fixations; if (fix == NULL) { get_now(&(tb->common.megasec), @@ -3389,7 +3403,7 @@ static void unfix_table_locked(Process* p, DbTable* tb, for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) { if ((*pp)->pid == p->id) { DbFixation* fix = *pp; - erts_refc_dec(&tb->common.fixref,0); + erts_refc_dec(&tb->common.ref,0); --(fix->counter); ASSERT(fix->counter >= 0); if (fix->counter > 0) { @@ -3419,7 +3433,6 @@ unlocked: #ifdef ERTS_SMP if (*kind_p == LCK_READ && tb->common.is_thread_safe) { /* Must have write lock while purging pseudo-deleted (OTP-8166) */ - db_ref(tb, LCK_WRITE); /* LCK_WRITE need it, but not LCK_READ */ erts_smp_rwmtx_runlock(&tb->common.rwlock); erts_smp_rwmtx_rwlock(&tb->common.rwlock); *kind_p = LCK_WRITE; @@ -3438,6 +3451,8 @@ static void free_fixations_locked(DbTable *tb) fix = tb->common.fixations; while (fix != NULL) { + erts_aint_t diff = -((erts_aint_t) fix->counter); + erts_refc_add(&tb->common.ref,diff,0); next_fix = fix->next; db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); db_erase_bag_exact2(meta_pid_to_fixed_tab, @@ -3561,10 +3576,6 @@ static int free_table_cont(Process *p, mmtl = get_meta_main_tab_lock(tb->common.slot); #ifdef ERTS_SMP if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) { - /* - * We keep our increased refc over this op in order to - * prevent the table from disapearing. - */ erts_smp_rwmtx_rwunlock(&tb->common.rwlock); erts_smp_rwmtx_rwlock(mmtl); erts_smp_rwmtx_rwlock(&tb->common.rwlock); @@ -3579,7 +3590,7 @@ static int free_table_cont(Process *p, make_small(tb->common.slot)); db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); } - db_unref(tb, LCK_NONE); + schedule_free_dbtable(tb); BUMP_REDS(p, 100); return 0; } diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 10ba755e80..58ad39d772 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -206,8 +206,7 @@ typedef struct db_fixation { */ typedef struct db_table_common { - erts_refc_t ref; - erts_refc_t fixref; /* fixation counter */ + erts_refc_t ref; /* fixation counter and delete counter */ #ifdef ERTS_SMP erts_smp_rwmtx_t rwlock; /* rw lock on table */ erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */ @@ -253,7 +252,7 @@ typedef struct db_table_common { (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) #define IS_TREE_TABLE(Status) (!!((Status) & \ DB_ORDERED_SET)) -#define NFIXED(T) (erts_refc_read(&(T)->common.fixref,0)) +#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0)) #define IS_FIXED(T) (NFIXED(T) != 0) Eterm erts_ets_copy_object(Eterm, Process*); diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 7a6aaa6bbe..0185baee6b 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -177,6 +177,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "async_id", NULL }, { "pix_lock", "address" }, { "run_queues_lists", NULL }, + { "misc_aux_work_queue", "index" }, + { "misc_aux_work_pre_alloc_lock", "address" }, { "sched_stat", NULL }, { "run_queue_sleep_list", "address" }, #endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index bf553ae88a..ddfc27a93f 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -590,6 +590,122 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags) } } +typedef struct erts_misc_aux_work_t_ erts_misc_aux_work_t; +struct erts_misc_aux_work_t_ { + erts_misc_aux_work_t *next; + void (*func)(void *); + void *arg; +}; + +typedef struct { + erts_smp_mtx_t mtx; + erts_misc_aux_work_t *first; + erts_misc_aux_work_t *last; +} erts_misc_aux_work_q_t; + +typedef union { + erts_misc_aux_work_q_t data; + char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_misc_aux_work_q_t))]; +} erts_algnd_misc_aux_work_q_t; + +static erts_algnd_misc_aux_work_q_t *misc_aux_work_queues; + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_aux_work, + erts_misc_aux_work_t, + 200, + ERTS_ALC_T_MISC_AUX_WORK) + +static void +init_misc_aux_work(void) +{ + int ix; + + init_misc_aux_work_alloc(); + + misc_aux_work_queues = erts_alloc(ERTS_ALC_T_MISC_AUX_WORK_Q, + (sizeof(erts_algnd_misc_aux_work_q_t) + *(erts_no_schedulers+1))); + if ((((UWord) misc_aux_work_queues) & ERTS_CACHE_LINE_MASK) != 0) + misc_aux_work_queues = ((erts_algnd_misc_aux_work_q_t *) + ((((UWord) misc_aux_work_queues) + & ~ERTS_CACHE_LINE_MASK) + + ERTS_CACHE_LINE_SIZE)); + + for (ix = 0; ix < erts_no_schedulers; ix++) { + erts_smp_mtx_init_x(&misc_aux_work_queues[ix].data.mtx, + "misc_aux_work_queue", + make_small(ix + 1)); + misc_aux_work_queues[ix].data.first = NULL; + misc_aux_work_queues[ix].data.last = NULL; + } +} + +static void +handle_misc_aux_work(ErtsSchedulerData *esdp) +{ + int ix = (int) esdp->no - 1; + erts_misc_aux_work_t *mawp; + + erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx); + mawp = misc_aux_work_queues[ix].data.first; + misc_aux_work_queues[ix].data.first = NULL; + misc_aux_work_queues[ix].data.last = NULL; + erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx); + + while (mawp) { + erts_misc_aux_work_t *free_mawp; + mawp->func(mawp->arg); + free_mawp = mawp; + mawp = mawp->next; + misc_aux_work_free(free_mawp); + } +} + +void +erts_smp_schedule_misc_aux_work(int ignore_self, + int max_sched, + void (*func)(void *), + void *arg) +{ + int ix, ignore_ix = -1; + + if (ignore_self) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp) + ignore_ix = (int) esdp->no - 1; + } + + ASSERT(0 <= max_sched && max_sched <= erts_no_schedulers); + + for (ix = 0; ix < max_sched; ix++) { + erts_aint32_t aux_work; + erts_misc_aux_work_t *mawp; + ErtsSchedulerSleepInfo *ssi; + if (ix == ignore_ix) + continue; + + mawp = misc_aux_work_alloc(); + + mawp->func = func; + mawp->arg = arg; + mawp->next = NULL; + + erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx); + if (!misc_aux_work_queues[ix].data.last) + misc_aux_work_queues[ix].data.first = mawp; + else + misc_aux_work_queues[ix].data.last->next = mawp; + misc_aux_work_queues[ix].data.last = mawp; + erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx); + + ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); + aux_work = erts_smp_atomic32_bor(&ssi->aux_work, + ERTS_SSI_AUX_WORK_MISC); + if ((aux_work & ERTS_SSI_AUX_WORK_MISC) == 0) + erts_sched_poke(ssi); + } +} + #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN void erts_smp_notify_check_children_needed(void) @@ -615,6 +731,12 @@ blockable_aux_work(ErtsSchedulerData *esdp, erts_aint32_t aux_work) { if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) { + if (aux_work & ERTS_SSI_AUX_WORK_MISC) { + aux_work = erts_smp_atomic32_band(&ssi->aux_work, + ~ERTS_SSI_AUX_WORK_MISC); + aux_work &= ~ERTS_SSI_AUX_WORK_MISC; + handle_misc_aux_work(esdp); + } #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) { aux_work = erts_smp_atomic32_band(&ssi->aux_work, @@ -2612,6 +2734,8 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) erts_smp_atomic32_init(&doing_sys_schedule, 0); + init_misc_aux_work(); + #else /* !ERTS_SMP */ { ErtsSchedulerData *esdp; @@ -2739,6 +2863,19 @@ resume_process(Process *p) p->rstatus = P_FREE; } +int +erts_get_max_no_executing_schedulers(void) +{ +#ifdef ERTS_SMP + if (erts_smp_atomic32_read(&schdlr_sspnd.changing)) + return (int) erts_no_schedulers; + ERTS_THR_MEMORY_BARRIER; + return (int) erts_smp_atomic32_read(&schdlr_sspnd.active); +#else + return 1; +#endif +} + #ifdef ERTS_SMP static void diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 8e32121a68..d927415f37 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -236,16 +236,14 @@ typedef enum { | ERTS_SSI_FLG_WAITING \ | ERTS_SSI_FLG_SUSPENDED) - -#if !defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK) \ - && defined(ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN) #define ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK -#endif #define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 0) +#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 1) #define ERTS_SSI_BLOCKABLE_AUX_WORK_MASK \ - (ERTS_SSI_AUX_WORK_CHECK_CHILDREN) + (ERTS_SSI_AUX_WORK_CHECK_CHILDREN \ + | ERTS_SSI_AUX_WORK_MISC) #define ERTS_SSI_NONBLOCKABLE_AUX_WORK_MASK \ (0) @@ -1034,6 +1032,7 @@ int erts_sched_set_wakeup_limit(char *str); #ifdef DEBUG void erts_dbg_multi_scheduling_return_trap(Process *, Eterm); #endif +int erts_get_max_no_executing_schedulers(void); #ifdef ERTS_SMP ErtsSchedSuspendResult erts_schedulers_state(Uint *, Uint *, Uint *, int); @@ -1048,6 +1047,11 @@ int erts_is_multi_scheduling_blocked(void); Eterm erts_multi_scheduling_blockers(Process *); void erts_start_schedulers(void); void erts_smp_notify_check_children_needed(void); +void +erts_smp_schedule_misc_aux_work(int ignore_self, + int max_sched, + void (*func)(void *), + void *arg); #endif void erts_sched_notify_check_cpu_bind(void); Uint erts_active_schedulers(void); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index b8e4473141..815cc1beae 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -193,7 +193,7 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #endif #define _is_aligned(x) (((Uint)(x) & 0x3) == 0) #define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED) -_ET_DECLARE_CHECKED(Eterm,make_boxed,Eterm*); +_ET_DECLARE_CHECKED(Eterm,make_boxed,Eterm*) #define make_boxed(x) _ET_APPLY(make_boxed,(x)) #if 1 #define _is_not_boxed(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_BOXED)) @@ -204,12 +204,12 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm) #define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED) #endif #define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED))) -_ET_DECLARE_CHECKED(Eterm*,boxed_val,Eterm); +_ET_DECLARE_CHECKED(Eterm*,boxed_val,Eterm) #define boxed_val(x) _ET_APPLY(boxed_val,(x)) /* cons cell ("list") access methods */ #define _unchecked_make_list(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_LIST) -_ET_DECLARE_CHECKED(Eterm,make_list,Eterm*); +_ET_DECLARE_CHECKED(Eterm,make_list,Eterm*) #define make_list(x) _ET_APPLY(make_list,(x)) #if 1 #define _unchecked_is_not_list(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_LIST)) @@ -226,7 +226,7 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm) #define _list_precond(x) (is_list(x)) #endif #define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST)) -_ET_DECLARE_CHECKED(Eterm*,list_val,Eterm); +_ET_DECLARE_CHECKED(Eterm*,list_val,Eterm) #define list_val(x) _ET_APPLY(list_val,(x)) #define CONS(hp, car, cdr) \ @@ -995,14 +995,14 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #endif #define _unchecked_make_cp(x) ((Eterm) COMPRESS_POINTER(x)) -_ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*); +_ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*) #define make_cp(x) _ET_APPLY(make_cp,(x)) #define is_not_CP(x) ((x) & _CPMASK) #define is_CP(x) (!is_not_CP(x)) #define _unchecked_cp_val(x) ((BeamInstr*) EXPAND_POINTER(x)) -_ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm); +_ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm) #define cp_val(x) _ET_APPLY(cp_val,(x)) #define make_catch(x) (((x) << _TAG_IMMED2_SIZE) | _TAG_IMMED2_CATCH) diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 1382d1dfe4..818bc6334e 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -4945,39 +4945,45 @@ static int inet_ctl_getifaddrs(inet_descriptor* desc_p, *buf_p++ = '\0'; *buf_p++ = INET_IFOPT_FLAGS; put_int32(IFGET_FLAGS(ifa_p->ifa_flags), buf_p); buf_p += 4; - if (ifa_p->ifa_addr->sa_family == AF_INET + if (ifa_p->ifa_addr) { + if (ifa_p->ifa_addr->sa_family == AF_INET #if defined(AF_INET6) - || ifa_p->ifa_addr->sa_family == AF_INET6 + || ifa_p->ifa_addr->sa_family == AF_INET6 #endif - ) { - SOCKADDR_TO_BUF(INET_IFOPT_ADDR, ifa_p->ifa_addr); - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_NETMASK, ifa_p->ifa_netmask); - if (ifa_p->ifa_flags & IFF_POINTOPOINT) { - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_DSTADDR, ifa_p->ifa_dstaddr); - } else if (ifa_p->ifa_flags & IFF_BROADCAST) { - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_BROADADDR, ifa_p->ifa_broadaddr); + ) { + SOCKADDR_TO_BUF(INET_IFOPT_ADDR, ifa_p->ifa_addr); + if (ifa_p->ifa_netmask) { + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_NETMASK, ifa_p->ifa_netmask); + } + if (ifa_p->ifa_dstaddr && + (ifa_p->ifa_flags & IFF_POINTOPOINT)) { + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_DSTADDR, ifa_p->ifa_dstaddr); + } else if (ifa_p->ifa_broadaddr && + (ifa_p->ifa_flags & IFF_BROADCAST)) { + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_BROADADDR, ifa_p->ifa_broadaddr); + } } - } #if defined(AF_LINK) || defined(AF_PACKET) - else if ( + else if ( #if defined(AF_LINK) - ifa_p->ifa_addr->sa_family == AF_LINK + ifa_p->ifa_addr->sa_family == AF_LINK #else - 0 + 0 #endif #if defined(AF_PACKET) - || ifa_p->ifa_addr->sa_family == AF_PACKET + || ifa_p->ifa_addr->sa_family == AF_PACKET #endif - ) { - char *bp = buf_p; - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_HWADDR, ifa_p->ifa_addr); - if (buf_p - bp < 4) buf_p = bp; /* Empty hwaddr */ - } + ) { + char *bp = buf_p; + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_HWADDR, ifa_p->ifa_addr); + if (buf_p - bp < 4) buf_p = bp; /* Empty hwaddr */ + } #endif + } BUF_ENSURE(1); *buf_p++ = '\0'; } diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 6297ccb8bc..4b3934657c 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -620,7 +620,7 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ if (IS_DOT_OR_DOTDOT(dirp->d_name)) continue; buffer[0] = '\0'; - strncat(buffer, dirp->d_name, size-1); + strncat(buffer, dirp->d_name, (*size)-1); *size = strlen(dirp->d_name); return 1; } diff --git a/erts/emulator/drivers/win32/win_con.c b/erts/emulator/drivers/win32/win_con.c index 2202ca655f..14f7941643 100644 --- a/erts/emulator/drivers/win32/win_con.c +++ b/erts/emulator/drivers/win32/win_con.c @@ -704,6 +704,18 @@ FrameWndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam) } write_inbuf(&c, 1); return 0; + case WM_MOUSEWHEEL: + { + int delta = GET_WHEEL_DELTA_WPARAM(wParam); + if (delta < 0) { + PostMessage(hClientWnd, WM_VSCROLL, MAKELONG(SB_THUMBTRACK, + (iVscrollPos + 5)),0); + } else { + WORD pos = ((iVscrollPos - 5) < 0) ? 0 : (iVscrollPos - 5); + PostMessage(hClientWnd, WM_VSCROLL, MAKELONG(SB_THUMBTRACK,pos),0); + } + return 0; + } case WM_CHAR: c = (TCHAR)wParam; write_inbuf(&c,1); diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 3d9b51d278..138a19a626 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,7 +27,7 @@ mem_leak/1, coerce_to_float/1, bjorn/1, huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, - otp_7422/1]). + otp_7422/1, zero_width/1]). -include("test_server.hrl"). @@ -36,7 +36,7 @@ all(suite) -> not_used, in_guard, mem_leak, coerce_to_float, bjorn, huge_float_field, huge_binary, system_limit, badarg, copy_writable_binary, kostis, dynamic, bs_add, - otp_7422]. + otp_7422, zero_width]. big(1) -> 57285702734876389752897683. @@ -786,5 +786,20 @@ otp_7422_bin(N) when N < 512 -> end), otp_7422_bin(N+1); otp_7422_bin(_) -> ok. + +zero_width(Config) when is_list(Config) -> + ?line Z = id(0), + Small = id(42), + Big = id(1 bsl 128), + ?line <<>> = <<Small:Z>>, + ?line <<>> = <<Small:0>>, + ?line <<>> = <<Big:Z>>, + ?line <<>> = <<Big:0>>, + + ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + + ok. id(I) -> I. diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 79252d0593..f26455e6da 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -39,6 +39,7 @@ atom_roundtrip/1, atom_roundtrip_r12b/1, contended_atom_cache_entry/1, + bad_dist_structure/1, bad_dist_ext/1, bad_dist_ext_receive/1, bad_dist_ext_process_info/1, @@ -61,6 +62,7 @@ all(suite) -> [ stop_dist, trap_bif, dist_auto_connect, dist_parallel_send, atom_roundtrip, atom_roundtrip_r12b, contended_atom_cache_entry, + bad_dist_structure, bad_dist_ext ]. @@ -174,7 +176,7 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) -> ?line {ok, NodeRecv} = start_node(bulk_receiver), ?line Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]), ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), - ?line Size = Terms*size(Bin), + %%?line Size = Terms*size(Bin), %% SLF LEFT OFF HERE. %% When the caller uses small hunks, like 4k via @@ -187,7 +189,7 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) -> ?line {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)), ?line _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]), - ?line {Elapsed, {TermsN, SizeN}, MonitorCount} = + ?line {Elapsed, {_TermsN, SizeN}, MonitorCount} = receive {sendersender, BigRes} -> BigRes end, @@ -227,7 +229,7 @@ sendersender3(To, _Bin, 0, SendDone, MonitorCount) -> ok end, receive - {monitor, _Pid, _Type, _Info} = M -> + {monitor, _Pid, _Type, _Info} -> sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1) after 0 -> if SendDone -> @@ -522,7 +524,7 @@ sink1() -> lost_exit(doc) -> "Test that EXIT and DOWN messages send to another node are not lost if " - "if the distribution port is busy."; + "the distribution port is busy."; lost_exit(Config) when is_list(Config) -> ?line {ok, Node} = start_node(lost_exit), @@ -1143,8 +1145,7 @@ contended_atom_cache_entry(Config) when is_list(Config) -> ?line {ok, SNode} = start_node(Config), ?line {ok, RNode} = start_node(Config), ?line Success = make_ref(), - ?line Mstr - = spawn_link( + ?line spawn_link( SNode, fun () -> erts_debug:set_internal_state(available_internal_state, @@ -1201,13 +1202,13 @@ contended_atom_cache_entry(Config) when is_list(Config) -> ?line stop_node(RNode), ?line ok. -send_ref_atom(To, Ref, Atom, 0) -> +send_ref_atom(_To, _Ref, _Atom, 0) -> ok; send_ref_atom(To, Ref, Atom, N) -> To ! {Ref, Atom}, send_ref_atom(To, Ref, Atom, N-1). -receive_ref_atom(Ref, Atom, 0) -> +receive_ref_atom(_Ref, _Atom, 0) -> ok; receive_ref_atom(Ref, Atom, N) -> receive @@ -1242,7 +1243,7 @@ unwanted_cixs() -> nodes()). -get_conflicting_atoms(CIX, 0) -> +get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> {A, B, C} = now(), @@ -1256,6 +1257,186 @@ get_conflicting_atoms(CIX, N) -> get_conflicting_atoms(CIX, N) end. +-define(COOKIE, ''). +-define(DOP_LINK, 1). +-define(DOP_SEND, 2). +-define(DOP_EXIT, 3). +-define(DOP_UNLINK, 4). +-define(DOP_REG_SEND, 6). +-define(DOP_GROUP_LEADER, 7). +-define(DOP_EXIT2, 8). + +-define(DOP_SEND_TT, 12). +-define(DOP_EXIT_TT, 13). +-define(DOP_REG_SEND_TT, 16). +-define(DOP_EXIT2_TT, 18). + +-define(DOP_MONITOR_P, 19). +-define(DOP_DEMONITOR_P, 20). +-define(DOP_MONITOR_P_EXIT, 21). + +start_monitor(Offender,P) -> + ?line Parent = self(), + ?line Q = spawn(Offender, + fun () -> + Ref = erlang:monitor(process,P), + Parent ! {self(),ref,Ref}, + receive + just_stay_alive -> ok + end + end), + ?line Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, + io:format("Ref is ~p~n",[Ref]), + ok. +start_link(Offender,P) -> + ?line Parent = self(), + ?line Q = spawn(Offender, + fun () -> + process_flag(trap_exit,true), + link(P), + Parent ! {self(),ref,P}, + receive + just_stay_alive -> ok + end + end), + ?line Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, + io:format("Ref is ~p~n",[Ref]), + ok. + +bad_dist_structure(suite) -> + []; +bad_dist_structure(doc) -> + ["Test dist messages with valid structure (binary to term ok) but malformed" + "control content"]; +bad_dist_structure(Config) when is_list(Config) -> + %process_flag(trap_exit,true), + ODog = ?config(watchdog, Config), + ?t:timetrap_cancel(ODog), + Dog = ?t:timetrap(?t:seconds(15)), + + ?line {ok, Offender} = start_node(bad_dist_structure_offender), + ?line {ok, Victim} = start_node(bad_dist_structure_victim), + ?line start_node_monitors([Offender,Victim]), + ?line Parent = self(), + ?line P = spawn(Victim, + fun () -> + process_flag(trap_exit,true), + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_struct_check_msgs([one, + two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + ?line receive {P, started} -> ok end, + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + ?line start_monitor(Offender,P), + ?line P ! one, + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_LINK},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line P ! two, + ?line P ! check_msgs, + ?line receive + {P, messages_checked} -> ok + after 5000 -> + exit(victim_is_dead) + end, + + ?line {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line unlink(P), + ?line P ! done, + ?line stop_node(Offender), + ?line stop_node(Victim), + ?t:timetrap_cancel(Dog), + ok. bad_dist_ext(doc) -> []; bad_dist_ext(suite) -> @@ -1483,6 +1664,22 @@ bad_dist_ext_connection_id(Config) when is_list(Config) -> ?line stop_node(Victim). +bad_dist_struct_check_msgs([]) -> + receive + Msg -> + exit({unexpected_message, Msg}) + after 0 -> + ok + end; +bad_dist_struct_check_msgs([M|Ms]) -> + receive + {'EXIT',_,_} = EM -> + io:format("Ignoring exit message: ~p~n",[EM]), + bad_dist_struct_check_msgs([M|Ms]); + Msg -> + M = Msg, + bad_dist_struct_check_msgs(Ms) + end. bad_dist_ext_check_msgs([]) -> receive Msg -> @@ -1497,24 +1694,6 @@ bad_dist_ext_check_msgs([M|Ms]) -> bad_dist_ext_check_msgs(Ms) end. --define(COOKIE, ''). --define(DOP_LINK, 1). --define(DOP_SEND, 2). --define(DOP_EXIT, 3). --define(DOP_UNLINK, 4). --define(DOP_NODE_LINK, 5). --define(DOP_REG_SEND, 6). --define(DOP_GROUP_LEADER, 7). --define(DOP_EXIT2, 8). - --define(DOP_SEND_TT, 12). --define(DOP_EXIT_TT, 13). --define(DOP_REG_SEND_TT, 16). --define(DOP_EXIT2_TT, 18). - --define(DOP_MONITOR_P, 19). --define(DOP_DEMONITOR_P, 20). --define(DOP_MONITOR_P_EXIT, 21). dport_reg_send(Node, Name, Msg) -> DPrt = case dport(Node) of @@ -1546,6 +1725,39 @@ dport_send(To, Msg) -> ?COOKIE, To}), dmsg_ext(Msg)]). +send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) -> + send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]). +send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> + Parent = self(), + Done = make_ref(), + spawn(Offender, + fun () -> + Node = node(Victim), + pong = net_adm:ping(Node), + DPrt = dport(Node), + Bad1 = case WhereToPutSelf of + 0 -> + Bad; + N when N > 0 -> + setelement(N,Bad,self()) + end, + DData = [dmsg_hdr(), + dmsg_ext(Bad1)] ++ + case PayLoad of + [] -> []; + _Other -> [dmsg_ext(PayLoad)] + end, + port_command(DPrt, DData), + Parent ! {DData,Done} + end), + receive + {WhatSent,Done} -> + io:format("Offender sent ~p~n",[WhatSent]), + ok + after 5000 -> + exit(unable_to_send) + end. + %% send_bad_msgs(): %% Send a valid distribution header and control message @@ -1629,10 +1841,10 @@ dmsg_bad_hdr() -> 255]. % 255 atom references -dmsg_fake_hdr1() -> - A = <<"fake header atom 1">>, - [131, % Version Magic - $D, 1, 16#8, 0, size(A), A]. % Fake header +%% dmsg_fake_hdr1() -> +%% A = <<"fake header atom 1">>, +%% [131, % Version Magic +%% $D, 1, 16#8, 0, size(A), A]. % Fake header dmsg_fake_hdr2() -> A1 = <<"fake header atom 1">>, @@ -1817,7 +2029,7 @@ flush_node_changes() -> node_monitor_loop(Master) -> receive - {nodeup, Node, InfoList} = Msg -> + {nodeup, Node, _InfoList} = Msg -> Master ! {nodeup, node(), Node}, ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), node_monitor_loop(Master); @@ -1854,9 +2066,9 @@ verify_no_down(A, B) -> ok end. -verify_down(A, B) -> - receive {nodedown, A, B, _} -> ok end, - receive {nodedown, B, A, _} -> ok end. +%% verify_down(A, B) -> +%% receive {nodedown, A, B, _} -> ok end, +%% receive {nodedown, B, A, _} -> ok end. verify_down(A, ReasonA, B, ReasonB) -> receive @@ -1876,11 +2088,11 @@ from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); from(_, []) -> []. -fun_spawn(Fun) -> - fun_spawn(Fun, []). +%% fun_spawn(Fun) -> +%% fun_spawn(Fun, []). -fun_spawn(Fun, Args) -> - spawn_link(erlang, apply, [Fun, Args]). +%% fun_spawn(Fun, Args) -> +%% spawn_link(erlang, apply, [Fun, Args]). long_or_short() -> diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index 542c8dffbe..11a7a61586 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1050,7 +1050,6 @@ stop_node(Node) -> -define(DOP_SEND, 2). -define(DOP_EXIT, 3). -define(DOP_UNLINK, 4). --define(DOP_NODE_LINK, 5). -define(DOP_REG_SEND, 6). -define(DOP_GROUP_LEADER, 7). -define(DOP_EXIT2, 8). diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index fbe4d8617e..3b33a08cf7 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -147,6 +147,7 @@ attributes([]) -> []. include_attribute(type) -> false; include_attribute(spec) -> false; include_attribute(opaque) -> false; +include_attribute(export_type) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index f68472d2fc..c45615d670 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1406,9 +1406,13 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) -> ArgV1 = mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), ArgV2 = mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), DstV = mk_fun_var(DstFun, Args), - Disj = mk_disj_constraint_list([mk_constraint(Arg1, sub, True), - mk_constraint(Arg2, sub, True), - mk_constraint(Dst, sub, False)]), + F = fun(A) -> + try [mk_constraint(A, sub, True)] + catch throw:error -> [] + end + end, + Constrs = F(Arg1) ++ F(Arg2), + Disj = mk_disj_constraint_list([mk_constraint(Dst, sub, False)|Constrs]), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2), diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index 466d84bb99..0c72ab977a 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -84,7 +84,7 @@ #define ERL_SEND 2 #define ERL_EXIT 3 #define ERL_UNLINK 4 -#define ERL_NODE_LINK 5 + #define ERL_REG_SEND 6 #define ERL_GROUP_LEADER 7 #define ERL_EXIT2 8 diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 99ccba0686..53b0e0426b 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -938,7 +938,7 @@ int ei_do_receive_msg(int fd, int staticbuffer_p, return ERL_ERROR; } x->index = x->buffsz; - switch (msg->msgtype) { /* FIXME are these all? */ + switch (msg->msgtype) { /* FIXME does not handle trace tokens and monitors */ case ERL_SEND: case ERL_REG_SEND: case ERL_LINK: @@ -946,7 +946,6 @@ int ei_do_receive_msg(int fd, int staticbuffer_p, case ERL_GROUP_LEADER: case ERL_EXIT: case ERL_EXIT2: - case ERL_NODE_LINK: return ERL_MSG; default: diff --git a/lib/erl_interface/src/connect/eirecv.c b/lib/erl_interface/src/connect/eirecv.c index 7d72ddeeae..86852f947d 100644 --- a/lib/erl_interface/src/connect/eirecv.c +++ b/lib/erl_interface/src/connect/eirecv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2010. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -196,10 +196,6 @@ ei_recv_internal (int fd, ei_trace(1,&msg->token); /* turn on tracing */ break; - case ERL_NODE_LINK: /* { NODE_LINK } */ - if (ei_tracelevel >= 4) show_this_msg = 1; - break; - default: /* unknown type, just put any remaining bytes into buffer */ break; diff --git a/lib/erl_interface/src/misc/show_msg.c b/lib/erl_interface/src/misc/show_msg.c index 14bea5e01f..194296798b 100644 --- a/lib/erl_interface/src/misc/show_msg.c +++ b/lib/erl_interface/src/misc/show_msg.c @@ -181,11 +181,6 @@ int ei_show_sendmsg(FILE *stream, const char *header, const char *msgbuf) mbuf = header; break; - case ERL_NODE_LINK: - /* nothing to do */ - mbuf = header; - break; - default: break; } @@ -241,10 +236,6 @@ static void show_msg(FILE *stream, int direction, const erlang_msg *msg, show_pid(stream,&msg->to); break; - case ERL_NODE_LINK: - fprintf(stream,"NODE_LINK"); - break; - case ERL_REG_SEND: fprintf(stream,"REG_SEND From: "); show_pid(stream,&msg->from); diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index ed5bf03804..fc80dde5b5 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -48,6 +48,7 @@ t_boolean/0, t_byte/0, t_char/0, + t_charlist/0, t_cons/0, t_cons/2, t_cons_hd/1, @@ -124,7 +125,8 @@ t_tuple/1, t_tuple_args/1, t_tuple_size/1, - t_tuple_subtypes/1 + t_tuple_subtypes/1, + t_unicode_string/0 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -3799,7 +3801,7 @@ arg_types(erlang, now, 0) -> arg_types(erlang, open_port, 2) -> [t_sup(t_atom(), t_sup([t_tuple([t_atom('spawn'), t_string()]), t_tuple([t_atom('spawn_driver'), t_string()]), - t_tuple([t_atom('spawn_executable'), t_string()]), + t_tuple([t_atom('spawn_executable'), t_sup(t_unicode_string(),t_binary())]), t_tuple([t_atom('fd'), t_integer(), t_integer()])])), t_list(t_sup(t_sup([t_atom('stream'), t_atom('exit_status'), @@ -3815,8 +3817,8 @@ arg_types(erlang, open_port, 2) -> t_tuple([t_atom('line'), t_integer()]), t_tuple([t_atom('cd'), t_string()]), t_tuple([t_atom('env'), t_list(t_tuple(2))]), % XXX: More - t_tuple([t_atom('args'), t_list(t_string())]), - t_tuple([t_atom('arg0'), t_string()])])))]; + t_tuple([t_atom('args'), t_list(t_sup(t_unicode_string(),t_binary()))]), + t_tuple([t_atom('arg0'),t_sup(t_unicode_string(),t_binary())])])))]; arg_types(erlang, phash, 2) -> [t_any(), t_pos_integer()]; arg_types(erlang, phash2, 1) -> @@ -4517,11 +4519,11 @@ arg_types(os, timestamp, 0) -> arg_types(re, compile, 1) -> [t_iodata()]; arg_types(re, compile, 2) -> - [t_iodata(), t_list(t_re_compile_option())]; + [t_sup(t_iodata(), t_charlist()), t_list(t_re_compile_option())]; arg_types(re, run, 2) -> - [t_iodata(), t_re_RE()]; + [t_sup(t_iodata(), t_charlist()), t_re_RE()]; arg_types(re, run, 3) -> - [t_iodata(), t_re_RE(), t_list(t_re_run_option())]; + [t_sup(t_iodata(), t_charlist()), t_re_RE(), t_list(t_re_run_option())]; %%------- string -------------------------------------------------------------- arg_types(string, chars, 2) -> [t_char(), t_non_neg_integer()]; @@ -4940,10 +4942,11 @@ t_matchres() -> %% From the 'ets' documentation %%----------------------------- %% Option = Type | Access | named_table | {keypos,Pos} -%% | {heir,pid(),HeirData} | {heir,none} -%% | {write_concurrency,boolean()} +%% | {heir,pid(),HeirData} | {heir,none} | Tweaks %% Type = set | ordered_set | bag | duplicate_bag %% Access = public | protected | private +%% Tweaks = {write_concurrency,boolean()} +%% | {read_concurrency,boolean()} | compressed %% Pos = integer() %% HeirData = term() t_ets_new_options() -> @@ -4955,10 +4958,12 @@ t_ets_new_options() -> t_atom('protected'), t_atom('private'), t_atom('named_table'), + t_tuple([t_atom('keypos'), t_integer()]), t_tuple([t_atom('heir'), t_pid(), t_any()]), t_tuple([t_atom('heir'), t_atom('none')]), - t_tuple([t_atom('keypos'), t_integer()]), - t_tuple([t_atom('write_concurrency'), t_boolean()])])). + t_tuple([t_atom('write_concurrency'), t_boolean()]), + t_tuple([t_atom('read_concurrency'), t_boolean()]), + t_atom('compressed')])). t_ets_info_items() -> t_sup([t_atom('fixed'), @@ -4978,8 +4983,7 @@ t_ets_info_items() -> %% ===================================================================== t_prim_file_name() -> - t_sup([t_string(), - t_binary()]). + t_sup(t_unicode_string(), t_binary()). %% ===================================================================== %% These are used for the built-in functions of 'gen_tcp' @@ -5136,13 +5140,14 @@ t_re_MP() -> %% it's supposed to be an opaque data type t_tuple([t_atom('re_pattern'), t_integer(), t_integer(), t_binary()]). t_re_RE() -> - t_sup(t_re_MP(), t_iodata()). + t_sup([t_re_MP(), t_iodata(), t_charlist()]). t_re_compile_option() -> - t_sup([t_atoms(['anchored', 'caseless', 'dollar_endonly', 'dotall', - 'extended', 'firstline', 'multiline', 'no_auto_capture', - 'dupnames', 'ungreedy']), - t_tuple([t_atom('newline'), t_re_NLSpec()])]). + t_sup([t_atoms(['unicode', 'anchored', 'caseless', 'dollar_endonly', + 'dotall', 'extended', 'firstline', 'multiline', + 'no_auto_capture', 'dupnames', 'ungreedy']), + t_tuple([t_atom('newline'), t_re_NLSpec()]), + t_atoms(['bsr_anycrlf', 'bsr_unicode'])]). t_re_run_option() -> t_sup([t_atoms(['anchored', 'global', 'notbol', 'noteol', 'notempty']), @@ -5159,7 +5164,7 @@ t_re_Type() -> t_atoms(['index', 'list', 'binary']). t_re_NLSpec() -> - t_atoms(['cr', 'crlf', 'lf', 'anycrlf']). + t_atoms(['cr', 'crlf', 'lf', 'anycrlf', 'any']). t_re_ValueSpec() -> t_sup(t_atoms(['all', 'all_but_first', 'first', 'none']), t_re_ValueList()). diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 1ed85af172..080d6936b2 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -62,6 +62,7 @@ t_boolean/0, t_byte/0, t_char/0, + t_charlist/0, t_collect_vars/1, t_cons/0, t_cons/2, @@ -195,6 +196,7 @@ t_tuple_size/1, t_tuple_sizes/1, t_tuple_subtypes/1, + t_unicode_string/0, t_unify/2, t_unify/3, t_unit/0, @@ -1455,6 +1457,26 @@ t_is_tuple(_) -> false. %% Non-primitive types, including some handy syntactic sugar types %% +-spec t_unicode_string() -> erl_type(). + +t_unicode_string() -> + t_list(t_unicode_char()). + +-spec t_charlist() -> erl_type(). + +t_charlist() -> + t_charlist(1). + +-spec t_charlist(non_neg_integer()) -> erl_type(). + +t_charlist(N) when N > 0 -> + t_maybe_improper_list(t_sup([t_unicode_char(), + t_unicode_binary(), + t_charlist(N-1)]), + t_sup(t_unicode_binary(), t_nil())); +t_charlist(0) -> + t_maybe_improper_list(t_any(), t_sup(t_unicode_binary(), t_nil())). + -spec t_constant() -> erl_type(). t_constant() -> @@ -1549,6 +1571,16 @@ t_parameterized_module() -> t_timeout() -> t_sup(t_non_neg_integer(), t_atom('infinity')). +-spec t_unicode_binary() -> erl_type(). + +t_unicode_binary() -> + t_binary(). % with characters encoded in UTF-8 coding standard + +-spec t_unicode_char() -> erl_type(). + +t_unicode_char() -> + t_integer(). % representing a valid unicode codepoint + %%----------------------------------------------------------------------------- %% Some built-in opaque types %% @@ -2825,7 +2857,7 @@ t_subtract(?list(Contents1, Termination1, Size1) = T, true -> case {Size1, Size2} of {?nonempty_qual, ?unknown_qual} -> ?none; - {?unknown_qual, ?nonempty_qual} -> Termination1; + {?unknown_qual, ?nonempty_qual} -> ?nil; {S, S} -> ?none end; false -> diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index 6684547572..5f6c31069c 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <section> + <title>IC 4.2.26</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + Partial support for recursive structs and unions. Only available + for the erl_corba backend and requires that Light IFR is used. + I.e. the IC option {light_ifr, true} and that Orber is configured + in such a way that Light IFR is activated. Recursive TypeCode is + currently not supported.</p> + <p> + Own Id: OTP-8868 Aux Id: seq11633</p> + </item> + </list> + </section> + </section> + + <section> <title>IC 4.2.25</title> <section> diff --git a/lib/ic/src/ic_forms.erl b/lib/ic/src/ic_forms.erl index 7409ddeb7b..fc46a2ed40 100644 --- a/lib/ic/src/ic_forms.erl +++ b/lib/ic/src/ic_forms.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -65,6 +65,7 @@ get_line(X) when is_record(X, scoped_id) -> X#scoped_id.line; get_line(X) when is_record(X, module) -> get_line(X#module.id); get_line(X) when is_record(X, interface) -> get_line(X#interface.id); get_line(X) when is_record(X, forward) -> get_line(X#forward.id); +get_line(X) when is_record(X, constr_forward) -> get_line(X#constr_forward.id); get_line(X) when is_record(X, const) -> get_line(X#const.id); get_line(X) when is_record(X, typedef) -> get_line(X#typedef.id); get_line(X) when is_record(X, struct) -> get_line(X#struct.id); @@ -114,6 +115,7 @@ get_line(_) -> -1. get_id2(X) when is_record(X, module) -> get_id(X#module.id); get_id2(X) when is_record(X, interface) -> get_id(X#interface.id); get_id2(X) when is_record(X, forward) -> get_id(X#forward.id); +get_id2(X) when is_record(X, constr_forward) -> get_id(X#constr_forward.id); get_id2(X) when is_record(X, const) -> get_id(X#const.id); get_id2(X) when is_record(X, typedef) -> get_id(hd(X#typedef.id)); get_id2(X) when is_record(X, struct) -> get_id(X#struct.id); @@ -156,6 +158,7 @@ get_type(X) when is_record(X, param) -> X#param.type. %% Temporary place get_tk(X) when is_record(X, interface) -> X#interface.tk; get_tk(X) when is_record(X, forward) -> X#forward.tk; +get_tk(X) when is_record(X, constr_forward) -> X#constr_forward.tk; get_tk(X) when is_record(X, const) -> X#const.tk; get_tk(X) when is_record(X, type_dcl) -> X#type_dcl.tk; get_tk(X) when is_record(X, typedef) -> X#typedef.tk; @@ -228,6 +231,7 @@ clean_up_scope([N|Ns],Found) -> get_type_code2(_, _, X) when is_record(X, interface) -> X#interface.tk; get_type_code2(_, _, X) when is_record(X, forward) -> X#forward.tk; +get_type_code2(_, _, X) when is_record(X, constr_forward) -> X#constr_forward.tk; get_type_code2(_, _, X) when is_record(X, const) -> X#const.tk; get_type_code2(_, _, X) when is_record(X, type_dcl) -> X#type_dcl.tk; get_type_code2(_, _, X) when is_record(X, typedef) -> diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl index 9165e3b03b..45cb64c9c8 100644 --- a/lib/ic/src/ic_pragma.erl +++ b/lib/ic/src/ic_pragma.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -60,7 +60,7 @@ pragma_reg(G,X) -> init_pragma_status(S), registerOptions(G,S), pragma_reg_all(G, S, [], X), - denote_specific_code_opts(G), %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + denote_specific_code_opts(G), case get_pragma_compilation_status(S) of true -> %% Remove ugly pragmas from form @@ -132,6 +132,7 @@ applyCodeOpt(G) -> %% This removes all pragma records from the form. %% When debugged, it can be enbodied in pragma_reg_all. +cleanup(undefined,C) -> C; cleanup([],C) -> C; cleanup([X|Xs],CSF) -> cleanup(Xs, CSF++cleanup(X)). @@ -279,7 +280,12 @@ pragma_reg(G, S, N, X) when is_record(X, union) -> pragma_reg(G, S, N, X) when is_record(X, struct) -> mk_ref(G,[get_id2(X) | N],struct_ref), mk_file_data(G,X,N,struct), - pragma_reg_all(G, S, N, X#struct.body); + case X#struct.body of + undefined -> + ok; + _ -> + pragma_reg_all(G, S, N, X#struct.body) + end; pragma_reg(G, _S, N, X) when is_record(X, attr) -> XX = #id_of{type=X}, diff --git a/lib/ic/src/ic_symtab.erl b/lib/ic/src/ic_symtab.erl index 889c75e3a2..d710154a5d 100644 --- a/lib/ic/src/ic_symtab.erl +++ b/lib/ic/src/ic_symtab.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -69,6 +69,8 @@ store(G, N, X) -> ets:insert(G#genobj.symtab, {Name, X}); {ok, Y} when is_record(Y, forward) -> ets:insert(G#genobj.symtab, {Name, X}); + {ok, Y} when is_record(Y, constr_forward) -> + ets:insert(G#genobj.symtab, {Name, X}); {ok, _Y} -> ic_error:error(G, {multiply_defined, X}) end. diff --git a/lib/ic/src/icforms.hrl b/lib/ic/src/icforms.hrl index d1869e6330..1b394a11b4 100644 --- a/lib/ic/src/icforms.hrl +++ b/lib/ic/src/icforms.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,6 +34,7 @@ -record(module, {id, body}). -record(interface, {id, inherit, body, inherit_body, tk}). -record(forward, {id, tk}). +-record(constr_forward, {id, tk}). -record(const, {type, id, val, tk}). -record(type_dcl, {type, tk}). -record(typedef, {type, id, tk}). diff --git a/lib/ic/src/icparse.yrl b/lib/ic/src/icparse.yrl index 25b0f452e7..d0dd6cde4c 100644 --- a/lib/ic/src/icparse.yrl +++ b/lib/ic/src/icparse.yrl @@ -1,21 +1,20 @@ -%%<copyright> -%% <year>1997-2007</year> -%% <holder>Ericsson AB, All Rights Reserved</holder> -%%</copyright> -%%<legalnotice> +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% -%% The Initial Developer of the Original Code is Ericsson AB. -%%</legalnotice> +%% +%% %CopyrightEnd% %% %%------------------------------------------------------------ %% Yecc spec for IDL @@ -150,6 +149,7 @@ Nonterminals 'ZorM_<integer_literal>' '<fixed_pt_type>' '<fixed_pt_const_type>' + '<constr_forward_decl>' . @@ -473,6 +473,7 @@ OE_preproc -> '#' '<integer_literal>' '<string_literal>' '<type_dcl>' -> '<struct_type>' : '$1' . '<type_dcl>' -> '<union_type>' : '$1' . '<type_dcl>' -> '<enum_type>' : '$1' . +'<type_dcl>' -> '<constr_forward_decl>' : '$1' . %% (28) NIY multiple declarators (FIXED) '<type_declarator>' -> '<type_spec>' '<declarators>' @@ -832,6 +833,9 @@ OE_preproc -> '#' '<integer_literal>' '<string_literal>' '<fixed_pt_type>' -> 'fixed' '<' '<positive_int_const>' ',' '<positive_int_const>' '>' : #fixed{digits='$3',scale='$5'} . +%% (99) +'<constr_forward_decl>' -> 'struct' '<identifier>' : #constr_forward{id='$2', tk=tk_struct} . +'<constr_forward_decl>' -> 'union' '<identifier>' : #constr_forward{id='$2', tk=tk_union} . %% Added clause 'ZorM_<string_literal>' -> '$empty' : [] . diff --git a/lib/ic/src/ictype.erl b/lib/ic/src/ictype.erl index 4704191bee..9e20801464 100644 --- a/lib/ic/src/ictype.erl +++ b/lib/ic/src/ictype.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -407,6 +407,18 @@ check(G, S, N, X) when is_record(X, forward) -> tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}), X; +check(G, S, N, #constr_forward{tk = tk_struct} = X) -> + ?STDDBG, + ID = ic_forms:get_id2(X), + Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), + tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ID, Module}), + X; +check(G, S, N, #constr_forward{tk = tk_union} = X) -> + ?STDDBG, + ID = ic_forms:get_id2(X), + Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), + tktab_add(G, S, N, X, {tk_union, ictk:get_IR_ID(G, N, X), ID, [], [], Module}), + X; check(G, S, N, X) when is_record(X, const) -> ?STDDBG, @@ -427,21 +439,6 @@ check(G, S, N, X) when is_record(X, const) -> end end; -check(G, S, N, X) when is_record(X, const) -> - ?STDDBG, - case tk_base(G, S, N, ic_forms:get_type(X)) of - Err when element(1, Err) == error -> X; - TK -> - check_const_tk(G, S, N, X, TK), - case iceval:eval_const(G, S, N, TK, X#const.val) of - Err when element(1, Err) == error -> X; - Val -> - V = iceval:get_val(Val), - tktab_add(G, S, N, X, TK, V), - X#const{val=V, tk=TK} - end - end; - check(G, S, N, X) when is_record(X, except) -> ?STDDBG, TK = tk(G, S, N, X), @@ -795,9 +792,15 @@ tktab_add_id(G, S, N, X, Id, TK, Aux) -> Name = [Id | N], UName = mk_uppercase(Name), case ets:lookup(S, Name) of - [{_, forward, _, _}] when is_record(X, interface) -> ok; - [XX] when is_record(X, forward) andalso element(2, XX)==interface -> ok; - [_] -> ic_error:error(G, {multiply_defined, X}); + [{_, forward, _, _}] when is_record(X, interface) -> + ok; + [{_, constr_forward, _, _}] when is_record(X, union) orelse + is_record(X, struct) -> + ok; + [XX] when is_record(X, forward) andalso element(2, XX)==interface -> + ok; + [_] -> + ic_error:error(G, {multiply_defined, X}); [] -> case ets:lookup(S, UName) of [] -> ok; diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 074d0b3d39..6d6c7fa625 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.2.25 +IC_VSN = 4.2.26 diff --git a/lib/inets/doc/src/http_server.xml b/lib/inets/doc/src/http_server.xml index 68dfd1add0..47ed9cd229 100644 --- a/lib/inets/doc/src/http_server.xml +++ b/lib/inets/doc/src/http_server.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> @@ -766,7 +766,7 @@ http://your.server.org/eval?httpd_example:print(atom_to_list(apply(erlang,halt,[ <code> -module(mnesia_test). -export([start/0,load_data/0]). --include("mod_auth.hrl"). +-include_lib("mod_auth.hrl"). first_start() -> mnesia:create_schema([node()]), diff --git a/lib/inets/include/mod_auth.hrl b/lib/inets/include/mod_auth.hrl new file mode 100644 index 0000000000..cf931e681a --- /dev/null +++ b/lib/inets/include/mod_auth.hrl @@ -0,0 +1,33 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-ifndef(mod_auth_hrl). +-define(mod_auth_hrl, true). + +-record(httpd_user, + {username, + password, + user_data}). + +-record(httpd_group, + {name, + userlist}). + +-endif. % -ifdef(mod_auth_hrl). diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index bdd8c5ee3c..55cc68dede 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -82,9 +82,7 @@ MODULES = \ mod_security \ mod_security_server -INCLUDE = ../../include - -HRL_FILES = $(INCLUDE)/httpd.hrl httpd_internal.hrl mod_auth.hrl +HRL_FILES = httpd.hrl httpd_internal.hrl mod_auth.hrl ERL_FILES = $(MODULES:%=%.erl) @@ -100,7 +98,6 @@ include ../inets_app/inets.mk ERL_COMPILE_FLAGS += \ $(INETS_FLAGS) \ $(INETS_ERL_COMPILE_FLAGS) \ - -I$(INCLUDE) \ -I../inets_app \ -I../http_lib \ diff --git a/lib/inets/src/http_server/httpd.hrl b/lib/inets/src/http_server/httpd.hrl new file mode 100644 index 0000000000..4eba833e2c --- /dev/null +++ b/lib/inets/src/http_server/httpd.hrl @@ -0,0 +1,27 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% This is a simple wrapper for code that has not been updated to +%% handle the move of this file to the include dir. + +-ifndef(src_httpd_hrl). +-define(src_httpd_hrl, true). + +-include_lib("inets/include/httpd.hrl"). + +-endif. % -ifdef(src_httpd_hrl). diff --git a/lib/inets/src/http_server/mod_auth.hrl b/lib/inets/src/http_server/mod_auth.hrl index 9b316cecc4..674e6d1652 100644 --- a/lib/inets/src/http_server/mod_auth.hrl +++ b/lib/inets/src/http_server/mod_auth.hrl @@ -1,29 +1,27 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% -%% %CopyrightEnd% %% +%% %CopyrightEnd% %% +%% This is a simple wrapper for code that has not been updated to +%% handle the move of this file to the include dir. + +-ifndef(src_mod_auth_hrl). +-define(src_mod_auth_hrl, true). --record(httpd_user, - {username, - password, - user_data}). +-include_lib("inets/include/mod_auth.hrl"). --record(httpd_group, - {name, - userlist}). - +-endif. % -ifdef(src_mod_auth_hrl). diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 4632ff3b68..20e22917e2 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -47,7 +47,9 @@ MODULES = \ inets_sup \ inets_regexp -HRL_FILES = inets_internal.hrl +INTERNAL_HRL_FILES = inets_internal.hrl +EXTERNAL_HRL_FILES = ../../include/httpd.hrl \ + ../../include/mod_auth.hrl ERL_FILES = $(MODULES:%=%.erl) @@ -74,8 +76,7 @@ include inets.mk ERL_COMPILE_FLAGS += \ $(INETS_FLAGS) \ - $(INETS_ERL_COMPILE_FLAGS) \ - -I../../include + $(INETS_ERL_COMPILE_FLAGS) # ---------------------------------------------------- @@ -110,7 +111,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/src $(INSTALL_DIR) $(RELSYSDIR)/src/inets_app - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/inets_app + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/inets_app + $(INSTALL_DIR) $(RELSYSDIR)/include + $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(RELSYSDIR)/include $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index f462290a99..67737ee552 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.5.1 +INETS_VSN = 5.5.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java index ab0b299bf9..9ba6a4a0ab 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * Copyright Ericsson AB 2000-2010. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -68,7 +68,6 @@ public abstract class AbstractConnection extends Thread { protected static final int sendTag = 2; protected static final int exitTag = 3; protected static final int unlinkTag = 4; - protected static final int nodeLinkTag = 5; protected static final int regSendTag = 6; protected static final int groupLeaderTag = 7; protected static final int exit2Tag = 8; @@ -697,7 +696,6 @@ public abstract class AbstractConnection extends Thread { // absolutely no idea what to do with these, so we ignore // them... case groupLeaderTag: // { GROUPLEADER, FromPid, ToPid} - case nodeLinkTag: // { NODELINK } // (just show trace) if (traceLevel >= ctrlThreshold) { System.out.println("<- " + headerType(head) + " " @@ -880,9 +878,6 @@ public abstract class AbstractConnection extends Thread { case unlinkTag: return "UNLINK"; - case nodeLinkTag: - return "NODELINK"; - case regSendTag: return "REG_SEND"; diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java index 80d8a5ccae..6f507bf4bb 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * Copyright Ericsson AB 2000-2010. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -54,7 +54,6 @@ public class OtpMsg { public static final int sendTag = 2; public static final int exitTag = 3; public static final int unlinkTag = 4; - /* public static final int nodeLinkTag = 5; */ public static final int regSendTag = 6; /* public static final int groupLeaderTag = 7; */ public static final int exit2Tag = 8; diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index fea4df8539..fbafbcd9b7 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -507,8 +507,16 @@ check_very_icky(Mod) -> end, ?line {NumOK,NumNOK} = filelib:fold_files(".",".*",true,fun(_F,{N,M}) when is_list(_F) -> io:format("~ts~n",[_F]),{N+1,M}; (_F,{N,M}) -> io:format("~p~n",[_F]),{N,M+1} end,{0,0}), ?line ok = filelib:fold_files(".",[1076,1089,1072,124,46,42],true,fun(_F,_) -> ok end,false), - ?line SF3 = unicode:characters_to_binary("���subfil3",file:native_name_encoding()), - ?line Sorted = lists:sort([SF3,<<"���subfil2">>]), + ?line SF3 = unicode:characters_to_binary("���subfil3", + file:native_name_encoding()), + ?line SF2 = case treat_icky(<<"���subfil2">>) of + LF2 when is_list(LF2) -> + unicode:characters_to_binary(LF2, + file:native_name_encoding()); + BF2 -> + BF2 + end, + ?line Sorted = lists:sort([SF3,SF2]), ?line Sorted = lists:sort(filelib:wildcard("*",<<"���subdir2">>)), ok catch diff --git a/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml b/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml index a97ad65f0e..964ae3e92d 100644 --- a/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml +++ b/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -445,7 +445,19 @@ void op(in myEnum a);</cell> <section> <title>Struct Data Type</title> <p>A <c>struct</c> may have Basic, Template, Scoped Names and Constructed - types as members.</p> + types as members. By using forward declaration we can define a recursive struct:</p> + <code type="none"><![CDATA[ +struct myStruct; // Forward declaration +typedef sequence<myStruct> myStructSeq; +struct myStruct { + myStructSeq chain; +}; + +// Deprecated definition (anonymous) not supported by IC +struct myStruct { + sequence<myStruct> chain; +}; + ]]></code> </section> <section> @@ -510,6 +522,25 @@ union LongUnion2 switch(long) { default: boolean DefaultValue; }; </code> + <p>In the same way as structs, unions can be recursive if forward + declaration is used (anonymous types is deprecated and not supported):</p> + <code type="none"><![CDATA[ +// Forward declaration +union myUnion; +typedef sequence<myUnion>myUnionSeq; +union myUnion switch (long) { + case 1 : myUnionSeq chain; + default: boolean DefaultValue; +}; + ]]></code> + + <note> + <p>Recursive types (union and struct) require Light IFR. I.e. the + IC option {light_ifr, true} is used and that Orber is configured in such a way that + Light IFR is activated. Recursive TypeCode is currently not supported, which is + why these cannot be encapsulated in an any data type.</p> + </note> + </section> <warning> <p>Every field in, for example, a struct must be initiated. Otherwise @@ -890,7 +921,7 @@ attribute long RWAttribute; object internal state with its object reference. The object internal state is an Erlang term which has a format defined by the user.</p> <note> - <p>It is is not always the case that the internal state will be the first parameter, as stubs can use their own object reference as the first parameter (see the IC documentation).</p> + <p>It is not always the case that the internal state will be the first parameter, as stubs can use their own object reference as the first parameter (see the IC documentation).</p> </note> <p>A function call will invoke an operation. The first parameter of the function should be the object reference and then diff --git a/lib/orber/doc/src/notes.xml b/lib/orber/doc/src/notes.xml index 6eda16a517..ba16682f0b 100644 --- a/lib/orber/doc/src/notes.xml +++ b/lib/orber/doc/src/notes.xml @@ -33,6 +33,36 @@ </header> <section> + <title>Orber 3.6.19</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + Partial support for recursive structs and unions. + Only available for the erl_corba backend and requires + that Light IFR is used. I.e. the IC option {light_ifr, true} + and that Orber is configured in such a way that Light IFR + is activated. Recursive TypeCode is currently not supported.</p> + <p> + Own Id: OTP-8868 Aux Id: seq11633</p> + </item> + </list> + </section> + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The SSL option {ssl_imp, old} was not used if ssl_generation was + set to 2. Only R14B was affected by this.</p> + <p>Own Id: OTP-8994 Aux Id: seq11747</p> + </item> + </list> + </section> + </section> + + <section> <title>Orber 3.6.18</title> <section> <title>Fixed Bugs and Malfunctions</title> diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl index 9d30098940..36ef6ce02f 100644 --- a/lib/orber/src/cdr_decode.erl +++ b/lib/orber/src/cdr_decode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -898,9 +898,13 @@ dec_sequence_struct(Version, Message, N, TypeCodeList, Len, ByteOrder, Buff, C, {Seq, Rest2, Len2, NewC2} = dec_sequence_struct(Version, Rest1, N - 1, TypeCodeList, Len1, ByteOrder, Buff, NewC, Name), {[list_to_tuple([Name |Struct]) | Seq], Rest2, Len2, NewC2}. -dec_sequence_union(_, Message, 0, _DiscrTC, _Default, _ElementList, Len, _ByteOrder, _Buff, C, _Name) -> + + +dec_sequence_union(_, Message, 0, _DiscrTC, _Default, _ElementList, + Len, _ByteOrder, _Buff, C, _Name) -> {[], Message, Len, C}; -dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList, Len, ByteOrder, Buff, C, Name) -> +dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList, + Len, ByteOrder, Buff, C, Name) when is_list(ElementList) -> {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Message, Len, ByteOrder, Buff, C), Result = dec_union(Version, stringify_enum(DiscrTC, Label), ElementList, Default, @@ -916,7 +920,20 @@ dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList, Len, Byte DiscrTC, Default, ElementList, Len2, ByteOrder, Buff, NewC3, Name), - {[{Name, Label, Value} | Seq], Rest3, Len3, NewC4}. + {[{Name, Label, Value} | Seq], Rest3, Len3, NewC4}; +dec_sequence_union(Version, Message, N, _DiscrTC, _Default, Module, + Len, ByteOrder, Buff, C, Name) when is_atom(Module) -> + case catch Module:tc() of + {tk_union, _, _, DiscrTC, Default, ElementList} -> + dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList, + Len, ByteOrder, Buff, C, Name); + What -> + orber:dbg("[~p] ~p:dec_sequence_union(~p). Union module doesn't exist or incorrect.", + [?LINE, ?MODULE, What], ?DEBUG_LEVEL), + corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) + end. + + %% A special case; when something is encapsulated (i.e. sent as octet-sequence) %% we sometimes don not want the result to be converted to a list. @@ -993,14 +1010,16 @@ dec_wstring(Version, Message, Len, ByteOrder, Buff, C) -> %% Func: dec_union/9 %%----------------------------------------------------------------- %% ## NEW IIOP 1.2 ## -dec_union(Version, ?SYSTEM_TYPE, Name, DiscrTC, Default, ElementList, Bytes, Len, ByteOrder, Buff, C) -> +dec_union(Version, ?SYSTEM_TYPE, Name, DiscrTC, Default, ElementList, Bytes, + Len, ByteOrder, Buff, C) -> {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Bytes, Len, ByteOrder, Buff, C), {Value, Rest2, Len2, NewC3} = dec_union(Version, Label, ElementList, Default, Rest1, Len1, ByteOrder, Buff, NewC), {{Name, Label, Value}, Rest2, Len2, NewC3}; -dec_union(Version, IFRId, _, DiscrTC, Default, ElementList, Bytes, Len, ByteOrder, Buff, C) -> +dec_union(Version, IFRId, _, DiscrTC, Default, ElementList, Bytes, Len, + ByteOrder, Buff, C) when is_list(ElementList) -> {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Bytes, Len, ByteOrder, Buff, C), Result = dec_union(Version, stringify_enum(DiscrTC, Label), ElementList, Default, Rest1, Len1, ByteOrder, Buff, NewC), @@ -1012,7 +1031,20 @@ dec_union(Version, IFRId, _, DiscrTC, Default, ElementList, Bytes, Len, ByteOrde X end, Name = ifrid_to_name(IFRId, ?IFR_UnionDef), - {{Name, Label, Value}, Rest2, Len2, NewC3}. + {{Name, Label, Value}, Rest2, Len2, NewC3}; +dec_union(Version, IFRId, _, _DiscrTC, _Default, Module, Bytes, Len, + ByteOrder, Buff, C) when is_atom(Module) -> + case catch Module:tc() of + {tk_union, _, Name, DiscrTC, Default, ElementList} -> + dec_union(Version, IFRId, Name, DiscrTC, Default, ElementList, Bytes, Len, + ByteOrder, Buff, C); + What -> + orber:dbg("[~p] ~p:dec_union(~p). Union module doesn't exist or incorrect.", + [?LINE, ?MODULE, What], ?DEBUG_LEVEL), + corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) + end. + + dec_union(_, _, [], Default, Message, Len, _, _Buff, C) when Default < 0 -> {undefined, Message, Len, C}; @@ -1047,7 +1079,16 @@ dec_struct1(_, [], Message, Len, _ByteOrder, _, C) -> dec_struct1(Version, [{_ElemName, ElemType} | TypeCodeList], Message, Len, ByteOrder, Buff, C) -> {Element, Rest, Len1, NewC} = dec_type(ElemType, Version, Message, Len, ByteOrder, Buff, C), {Struct, Rest1, Len2, NewC2} = dec_struct1(Version, TypeCodeList, Rest, Len1, ByteOrder, Buff, NewC), - {[Element |Struct], Rest1, Len2, NewC2}. + {[Element |Struct], Rest1, Len2, NewC2}; +dec_struct1(Version, Module, Message, Len, ByteOrder, Buff, C) -> + case catch Module:tc() of + {tk_struct, _, _, TypeCodeList} -> + dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C); + What -> + orber:dbg("[~p] ~p:dec_struct1(~p). Struct module doesn't exist or incorrect.", + [?LINE, ?MODULE, What], ?DEBUG_LEVEL), + corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) + end. ifrid_to_name([], Type) -> orber:dbg("[~p] ~p:ifrid_to_name([], ~p). No Id supplied.", @@ -1232,7 +1273,9 @@ get_user_exception_type(TypeId) -> %%----------------------------------------------------------------- dec_type_code(Version, Message, Len, ByteOrder, Buff, C) -> {TypeNo, Message1, Len1, NewC} = dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C), - dec_type_code(TypeNo, Version, Message1, Len1, ByteOrder, Buff, NewC). + TC = dec_type_code(TypeNo, Version, Message1, Len1, ByteOrder, Buff, NewC), + erase(orber_indirection), + TC. %%----------------------------------------------------------------- %% Func: dec_type_code/5 @@ -1441,13 +1484,22 @@ dec_type_code(33, Version, Message, Len, ByteOrder, Buff, C) -> {"name", {'tk_string', 0}}]}, Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex), {{'tk_local_interface', RepId, Name}, Message1, Len1, NewC}; -dec_type_code(16#ffffffff, Version, Message, Len, ByteOrder, Buff, C) -> %% placeholder +dec_type_code(16#ffffffff, Version, Message, Len, ByteOrder, Buff, C) -> {Indirection, Message1, Len1, NewC} = dec_type('tk_long', Version, Message, Len, ByteOrder, Buff, C), Position = C+Indirection, - <<_:Position/binary, SubBuff/binary>> = Buff, - {TC, _, _, _} = dec_type_code(Version, SubBuff, Position, ByteOrder, Buff, Position), - {TC, Message1, Len1, NewC}; + case put(orber_indirection, Position) of + Position -> +%% {{'none', Indirection}, Message1, Len1, NewC}; + %% Recursive TypeCode. Break the loop. + orber:dbg("[~p] cdr_decode:dec_type_code(~p); Recursive TC not supported.", + [?LINE,Position], ?DEBUG_LEVEL), + corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO}); + _ -> + <<_:Position/binary, SubBuff/binary>> = Buff, + {TC, _, _, _} = dec_type_code(Version, SubBuff, Position, ByteOrder, Buff, Position), + {TC, Message1, Len1, NewC} + end; dec_type_code(Type, _, _, _, _, _, _) -> orber:dbg("[~p] cdr_decode:dec_type_code(~p); No match.", [?LINE, Type], ?DEBUG_LEVEL), diff --git a/lib/orber/src/cdr_encode.erl b/lib/orber/src/cdr_encode.erl index 3ecb8833f5..eaf3c5b7dc 100644 --- a/lib/orber/src/cdr_encode.erl +++ b/lib/orber/src/cdr_encode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -815,11 +815,21 @@ enc_wstring(Env, String, MaxLength, Bytes, Len) -> %%----------------------------------------------------------------- %% Func: enc_union/5 %%----------------------------------------------------------------- -enc_union(Env, {_, Label, Value}, DiscrTC, Default, TypeCodeList, Bytes, Len) -> +enc_union(Env, {_, Label, Value}, DiscrTC, Default, TypeCodeList, + Bytes, Len) when is_list(TypeCodeList) -> {ByteSequence, Len1} = enc_type(DiscrTC, Env, Label, Bytes, Len), Label2 = stringify_enum(DiscrTC,Label), enc_union2(Env, {Label2, Value},TypeCodeList, Default, - ByteSequence, Len1, undefined). + ByteSequence, Len1, undefined); +enc_union(Env, Value, _DiscrTC, _Default, Module, Bytes, Len) when is_atom(Module) -> + case catch Module:tc() of + {tk_union, _, _, DiscrTC, Default, ElementList} -> + enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len); + What -> + orber:dbg("[~p] ~p:enc_union(~p). Union module doesn't exist or incorrect.", + [?LINE, ?MODULE, What], ?DEBUG_LEVEL), + corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) + end. enc_union2(_Env, _What, [], Default, Bytes, Len, _) when Default < 0 -> {Bytes, Len}; @@ -840,9 +850,19 @@ stringify_enum(_, Label) -> %%----------------------------------------------------------------- %% Func: enc_struct/4 %%----------------------------------------------------------------- -enc_struct(Env, Struct, TypeCodeList, Bytes, Len) -> +enc_struct(Env, Struct, TypeCodeList, Bytes, Len) when is_list(TypeCodeList) -> [_Name | StructList] = tuple_to_list(Struct), - enc_struct1(Env, StructList, TypeCodeList, Bytes, Len). + enc_struct1(Env, StructList, TypeCodeList, Bytes, Len); +enc_struct(Env, Struct, Module, Bytes, Len) -> + [Module | StructList] = tuple_to_list(Struct), + case catch Module:tc() of + {tk_struct, _, _, TypeCodeList} -> + enc_struct1(Env, StructList, TypeCodeList, Bytes, Len); + What -> + orber:dbg("[~p] ~p:enc_struct([], ~p). Struct module doesn't exist or incorrect.", + [?LINE, ?MODULE, What], ?DEBUG_LEVEL), + corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) + end. enc_struct1(_Env, [], [], Bytes, Len) -> {Bytes, Len}; diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl index af6df01b7d..84ed193ebb 100644 --- a/lib/orber/src/orber_socket.erl +++ b/lib/orber/src/orber_socket.erl @@ -496,27 +496,17 @@ check_port(Port, _, _) -> %%----------------------------------------------------------------- %% Check Options. -%% We need this as a work-around since the SSL-app doesn't allow us -%% to pass 'inet' as an option. Also needed for R9B :-( check_options(normal, Options, _Generation) -> - case orber:ip_version() of - inet -> - Options; - inet6 -> - %% Necessary for R9B. Should be [orber:ip_version()|Options]; - [inet6|Options] - end; + [orber:ip_version()|Options]; check_options(ssl, Options, Generation) -> case orber:ip_version() of inet when Generation > 2 -> [{ssl_imp, new}|Options]; inet -> - Options; + [{ssl_imp, old}|Options]; inet6 when Generation > 2 -> [{ssl_imp, new}, inet6|Options]; inet6 -> - %% Will fail until SSL supports this option. - %% Note, we want this happen! - [inet6|Options] + [{ssl_imp, old}, inet6|Options] end. diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index 4601e84d2c..5495735318 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -120,7 +120,11 @@ GEN_MOD_TEST_SERVER = \ orber_test_server_uni \ orber_test_server_uni_d \ orber_test_timeout_server \ - orber_parent_inherrit + orber_parent_inherrit \ + orber_test_server_rec_struct \ + orber_test_server_rec_struct_seq \ + orber_test_server_rec_union \ + orber_test_server_rec_union_seq GEN_HRL_TEST_SERVER = \ oe_orber_test_server.hrl \ diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index a694dc58c4..b95cf4b0ec 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -1280,6 +1280,22 @@ test_coding(Obj, Local) -> ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server: testing_iiop_server_marshal(Obj, "string")), + + RecS = #orber_test_server_rec_struct{chain = [#orber_test_server_rec_struct{chain = []}]}, + ?match(RecS, orber_test_server:testing_iiop_rec_struct(Obj, RecS)), + + RecU = #orber_test_server_rec_union{label = 'RecursiveType', + value = [#orber_test_server_rec_union{label = 'RecursiveType', + value = []}]}, + ?match(RecU, orber_test_server:testing_iiop_rec_union(Obj, RecU)), + +%% RecA1 = #any{typecode = unsupported, value = RecS}, +%% RecA2 = #any{typecode = unsupported, value = RecU}, +%% ?match(RecA1, +%% orber_test_server:testing_iiop_rec_any(Obj, RecA1)), +%% ?match(RecA2, +%% orber_test_server:testing_iiop_rec_any(Obj, RecA2)), + ok. %%--------------- Testing Post- & Pre-cond ------------------- diff --git a/lib/orber/test/orber_test_server.idl b/lib/orber/test/orber_test_server.idl index a88211c941..438c10e19b 100644 --- a/lib/orber/test/orber_test_server.idl +++ b/lib/orber/test/orber_test_server.idl @@ -28,7 +28,7 @@ module orber_parent { }; module orber_test { - + // interface server interface server : orber_parent::inherrit { typedef string array[2]; @@ -89,6 +89,23 @@ module orber_test { const fixed52 fixed52negconst2 = -123.00d; const fixed52 fixed52negconst3 = -023.00d; + struct rec_struct; // Forward declaration + typedef sequence<rec_struct> rec_struct_seq; + struct rec_struct { + rec_struct_seq chain; + }; + + + union rec_union; // Forward declaration + typedef sequence<rec_union>rec_union_seq; + + enum MyEnum {RecursiveType, NameType}; + + union rec_union switch (MyEnum) { + case RecursiveType : rec_union_seq chain; + case NameType : string aName; + }; + void stop_normal(); void stop_brutal(); @@ -123,6 +140,12 @@ module orber_test { void testing_iiop_context(); void testing_iiop_server_marshal(inout StrLength6 Str); + // Recursive types + any testing_iiop_rec_any(in any RecType); + rec_struct testing_iiop_rec_struct(in rec_struct RecS); + rec_union testing_iiop_rec_union(in rec_union RecU); + + oneway void testing_iiop_oneway_delay(in long Time); void testing_iiop_twoway_delay(in long Time); diff --git a/lib/orber/test/orber_test_server_impl.erl b/lib/orber/test/orber_test_server_impl.erl index 35296cb619..10a9caf242 100644 --- a/lib/orber/test/orber_test_server_impl.erl +++ b/lib/orber/test/orber_test_server_impl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -55,6 +55,9 @@ testing_iiop_void/2, testing_iiop_context/2, testing_iiop_server_marshal/3, + testing_iiop_rec_any/3, + testing_iiop_rec_struct/3, + testing_iiop_rec_union/3, relay_call/3, relay_cast/3, %% Testing pseudo calls. @@ -197,6 +200,16 @@ testing_iiop_context(_Self, State) -> testing_iiop_server_marshal(_Self, State, _String) -> {reply, {ok, false}, State}. +testing_iiop_rec_any(_Self, State, RAny) -> + {reply, RAny, State}. + +testing_iiop_rec_struct(_Self, State, RecS) -> + {reply, RecS, State}. + +testing_iiop_rec_union(_Self, State, RecU) -> + {reply, RecU, State}. + + testing_iiop_oneway_delay(_Self, State, Time) -> timer:sleep(Time), {noreply, State}. diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 584a52ab84..b0c5a253a2 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1 +1 @@ -ORBER_VSN = 3.6.18 +ORBER_VSN = 3.6.19 diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 313f1e59c9..2ccbc5348c 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -31,7 +31,31 @@ <p>This document describes the changes made to the SSL application. </p> - <section><title>SSL 4.1.1</title> + <section><title>SSL 4.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The ssl application caches certificate files, it will now + invalidate cache entries if the diskfile is changed.</p> + <p> + Own Id: OTP-8965 Aux Id: seq11739 </p> + </item> + <item> + <p> + Now runs the terminate function before returning from the + call made by ssl:close/1, as before the caller of + ssl:close/1 could get problems with the reuseaddr option.</p> + <p> + Own Id: OTP-8992</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 4.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 51c5289bd2..a9c07ec87c 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,10 +1,12 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.1", [{restart_application, ssl}]}, {"4.1", [{restart_application, ssl}]}, {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.1", [{restart_application, ssl}]}, {"4.1", [{restart_application, ssl}]}, {"4.0.1", [{restart_application, ssl}]} ]}. diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl index 2a5a7f3394..f34459de37 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_certificate_db.erl @@ -27,7 +27,9 @@ -export([create/0, remove/1, add_trusted_certs/3, remove_trusted_certs/2, lookup_trusted_cert/3, issuer_candidate/1, - lookup_cached_certs/1, cache_pem_file/3]). + lookup_cached_certs/1, cache_pem_file/4, uncache_pem_file/2, lookup/2]). + +-type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. %%==================================================================== %% Internal application API @@ -98,17 +100,35 @@ add_trusted_certs(Pid, File, [CertsDb, FileToRefDb, PidToFileDb]) -> insert(Pid, File, PidToFileDb), {ok, Ref}. %%-------------------------------------------------------------------- --spec cache_pem_file(pid(), string(), certdb_ref()) -> term(). +-spec cache_pem_file(pid(), string(), time(), certdb_ref()) -> term(). %% %% Description: Cache file as binary in DB %%-------------------------------------------------------------------- -cache_pem_file(Pid, File, [CertsDb, _FileToRefDb, PidToFileDb]) -> +cache_pem_file(Pid, File, Time, [CertsDb, _FileToRefDb, PidToFileDb]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), - insert({file, File}, Content, CertsDb), + insert({file, File}, {Time, Content}, CertsDb), insert(Pid, File, PidToFileDb), {ok, Content}. +%-------------------------------------------------------------------- +-spec uncache_pem_file(string(), certdb_ref()) -> no_return(). +%% +%% Description: If a cached file is no longer valid (changed on disk) +%% we must terminate the connections using the old file content, and +%% when those processes are finish the cache will be cleaned. It is +%% a rare but possible case a new ssl client/server is started with +%% a filename with the same name as previously started client/server +%% but with different content. +%% -------------------------------------------------------------------- +uncache_pem_file(File, [_CertsDb, _FileToRefDb, PidToFileDb]) -> + [Pids] = select(PidToFileDb, [{{'$1', File},[],['$$']}]), + lists:foreach(fun(Pid) -> + exit(Pid, shutdown) + end, Pids). + + + %%-------------------------------------------------------------------- -spec remove_trusted_certs(pid(), certdb_ref()) -> term(). @@ -174,6 +194,22 @@ issuer_candidate(PrevCandidateKey) -> end. %%-------------------------------------------------------------------- +-spec lookup(term(), term()) -> term() | undefined. +%% +%% Description: Looks up an element in a certificat <Db>. +%%-------------------------------------------------------------------- +lookup(Key, Db) -> + case ets:lookup(Db, Key) of + [] -> + undefined; + Contents -> + Pick = fun({_, Data}) -> Data; + ({_,_,Data}) -> Data + end, + [Pick(Data) || Data <- Contents] + end. + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- certificate_db_name() -> @@ -191,16 +227,8 @@ ref_count(Key, Db,N) -> delete(Key, Db) -> _ = ets:delete(Db, Key). -lookup(Key, Db) -> - case ets:lookup(Db, Key) of - [] -> - undefined; - Contents -> - Pick = fun({_, Data}) -> Data; - ({_,_,Data}) -> Data - end, - [Pick(Data) || Data <- Contents] - end. +select(Db, MatchSpec)-> + ets:select(Db, MatchSpec). remove_certs(Ref, CertsDb) -> ets:match_delete(CertsDb, {{Ref, '_', '_'}, '_'}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6c9ac65b64..675e5e44bd 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -70,7 +70,7 @@ %% {{md5_hash, sha_hash}, {prev_md5, prev_sha}} (binary()) tls_handshake_hashes, % see above tls_cipher_texts, % list() received but not deciphered yet - own_cert, % binary() + own_cert, % binary() | undefined session, % #session{} from ssl_handshake.hrl session_cache, % session_cache_cb, % @@ -90,7 +90,8 @@ log_alert, % boolean() renegotiation, % {boolean(), From | internal | peer} recv_during_renegotiation, %boolean() - send_queue % queue() + send_queue, % queue() + terminated = false % }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, @@ -304,8 +305,10 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, try ssl_init(SSLOpts0, Role) of {ok, Ref, CacheRef, OwnCert, Key, DHParams} -> + Session = State0#state.session, State = State0#state{tls_handshake_hashes = Hashes0, own_cert = OwnCert, + session = Session#session{own_certificate = OwnCert}, cert_db_ref = Ref, session_cache = CacheRef, private_key = Key, @@ -331,6 +334,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, %%-------------------------------------------------------------------- hello(start, #state{host = Host, port = Port, role = client, ssl_options = SslOpts, + own_cert = Cert, transport_cb = Transport, socket = Socket, connection_states = ConnectionStates, renegotiation = {Renegotiation, _}} @@ -338,7 +342,7 @@ hello(start, #state{host = Host, port = Port, role = client, Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates, - SslOpts, Renegotiation), + SslOpts, Renegotiation, Cert), Version = Hello#client_hello.client_version, Hashes0 = ssl_handshake:init_hashes(), @@ -678,6 +682,7 @@ cipher(Msg, State) -> %%-------------------------------------------------------------------- connection(#hello_request{}, #state{host = Host, port = Port, socket = Socket, + own_cert = Cert, ssl_options = SslOpts, negotiated_version = Version, transport_cb = Transport, @@ -686,7 +691,7 @@ connection(#hello_request{}, #state{host = Host, port = Port, tls_handshake_hashes = Hashes0} = State0) -> Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0, - SslOpts, Renegotiation), + SslOpts, Renegotiation, Cert), {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(Hello, Version, ConnectionStates0, Hashes0), @@ -777,8 +782,12 @@ handle_sync_event(start, _, connection, State) -> handle_sync_event(start, From, StateName, State) -> {next_state, StateName, State#state{from = From}}; -handle_sync_event(close, _, _StateName, State) -> - {stop, normal, ok, State}; +handle_sync_event(close, _, StateName, State) -> + %% Run terminate before returning + %% so that the reuseaddr inet-option will work + %% as intended. + (catch terminate(user_close, StateName, State)), + {stop, normal, ok, State#state{terminated = true}}; handle_sync_event({shutdown, How0}, _, StateName, #state{transport_cb = Transport, @@ -966,6 +975,11 @@ handle_info(Msg, StateName, State) -> %% necessary cleaning up. When it returns, the gen_fsm terminates with %% Reason. The return value is ignored. %%-------------------------------------------------------------------- +terminate(_, _, #state{terminated = true}) -> + %% Happens when user closes the connection using ssl:close/1 + %% we want to guarantee that Transport:close has been called + %% when ssl:close/1 returns. + ok; terminate(Reason, connection, #state{negotiated_version = Version, connection_states = ConnectionStates, transport_cb = Transport, @@ -975,14 +989,14 @@ terminate(Reason, connection, #state{negotiated_version = Version, notify_renegotiater(Renegotiate), BinAlert = terminate_alert(Reason, Version, ConnectionStates), Transport:send(Socket, BinAlert), - workaround_transport_delivery_problems(Socket, Transport), + workaround_transport_delivery_problems(Socket, Transport, Reason), Transport:close(Socket); -terminate(_Reason, _StateName, #state{transport_cb = Transport, +terminate(Reason, _StateName, #state{transport_cb = Transport, socket = Socket, send_queue = SendQueue, renegotiation = Renegotiate}) -> notify_senders(SendQueue), notify_renegotiater(Renegotiate), - workaround_transport_delivery_problems(Socket, Transport), + workaround_transport_delivery_problems(Socket, Transport, Reason), Transport:close(Socket). %%-------------------------------------------------------------------- @@ -2185,7 +2199,8 @@ notify_renegotiater({true, From}) when not is_atom(From) -> notify_renegotiater(_) -> ok. -terminate_alert(Reason, Version, ConnectionStates) when Reason == normal; Reason == shutdown -> +terminate_alert(Reason, Version, ConnectionStates) when Reason == normal; Reason == shutdown; + Reason == user_close -> {BinAlert, _} = encode_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Version, ConnectionStates), BinAlert; @@ -2194,10 +2209,13 @@ terminate_alert(_, Version, ConnectionStates) -> Version, ConnectionStates), BinAlert. -workaround_transport_delivery_problems(Socket, Transport) -> +workaround_transport_delivery_problems(_,_, user_close) -> + ok; +workaround_transport_delivery_problems(Socket, Transport, _) -> %% Standard trick to try to make sure all %% data sent to to tcp port is really sent - %% before tcp port is closed. + %% before tcp port is closed so that the peer will + %% get a correct error message. inet:setopts(Socket, [{active, false}]), Transport:shutdown(Socket, write), Transport:recv(Socket, 0). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index c7a1c4965d..125c28b373 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -30,7 +30,7 @@ -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([master_secret/4, client_hello/5, server_hello/4, hello/4, +-export([master_secret/4, client_hello/6, server_hello/4, hello/4, hello_request/0, certify/6, certificate/3, client_certificate_verify/5, certificate_verify/5, certificate_request/2, key_exchange/2, server_key_exchange_hash/2, @@ -49,13 +49,13 @@ %%==================================================================== %%-------------------------------------------------------------------- -spec client_hello(host(), port_num(), #connection_states{}, - #ssl_options{}, boolean()) -> #client_hello{}. + #ssl_options{}, boolean(), der_cert()) -> #client_hello{}. %% %% Description: Creates a client hello message. %%-------------------------------------------------------------------- client_hello(Host, Port, ConnectionStates, #ssl_options{versions = Versions, ciphers = UserSuites} - = SslOpts, Renegotiation) -> + = SslOpts, Renegotiation, OwnCert) -> Fun = fun(Version) -> ssl_record:protocol_version(Version) @@ -65,7 +65,7 @@ client_hello(Host, Port, ConnectionStates, #ssl_options{versions = Versions, SecParams = Pending#connection_state.security_parameters, Ciphers = available_suites(UserSuites, Version), - Id = ssl_manager:client_session_id(Host, Port, SslOpts), + Id = ssl_manager:client_session_id(Host, Port, SslOpts, OwnCert), #client_hello{session_id = Id, client_version = Version, @@ -571,7 +571,7 @@ select_session(Hello, Port, Session, Version, #ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) -> SuggestedSessionId = Hello#client_hello.session_id, SessionId = ssl_manager:server_session_id(Port, SuggestedSessionId, - SslOpts), + SslOpts, Cert), Suites = available_suites(Cert, UserSuites, Version), case ssl_session:is_new(SuggestedSessionId, SessionId) of diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 68a7802ef2..8ae4d2332e 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -36,6 +36,7 @@ -record(session, { session_id, peer_certificate, + own_certificate, compression_method, cipher_suite, master_secret, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 3b02d96562..f845b1ecc0 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -29,8 +29,8 @@ %% Internal application API -export([start_link/1, connection_init/2, cache_pem_file/1, - lookup_trusted_cert/3, issuer_candidate/1, client_session_id/3, - server_session_id/3, + lookup_trusted_cert/3, issuer_candidate/1, client_session_id/4, + server_session_id/4, register_session/2, register_session/3, invalidate_session/2, invalidate_session/3]). @@ -43,6 +43,7 @@ -include("ssl_handshake.hrl"). -include("ssl_internal.hrl"). +-include_lib("kernel/include/file.hrl"). -record(state, { session_cache, @@ -76,16 +77,17 @@ start_link(Opts) -> connection_init(Trustedcerts, Role) -> call({connection_init, Trustedcerts, Role}). %%-------------------------------------------------------------------- --spec cache_pem_file(string()) -> {ok, term()}. +-spec cache_pem_file(string()) -> {ok, term()} | {error, reason()}. %% -%% Description: Cach a pem file and +%% Description: Cach a pem file and return its content. %%-------------------------------------------------------------------- -cache_pem_file(File) -> - case ssl_certificate_db:lookup_cached_certs(File) of - [{_,Content}] -> - {ok, Content}; - [] -> - call({cache_pem, File}) +cache_pem_file(File) -> + try file:read_file_info(File) of + {ok, #file_info{mtime = LastWrite}} -> + cache_pem_file(File, LastWrite) + catch + _:Reason -> + {error, Reason} end. %%-------------------------------------------------------------------- -spec lookup_trusted_cert(reference(), serialnumber(), issuer()) -> @@ -106,20 +108,21 @@ lookup_trusted_cert(Ref, SerialNumber, Issuer) -> issuer_candidate(PrevCandidateKey) -> ssl_certificate_db:issuer_candidate(PrevCandidateKey). %%-------------------------------------------------------------------- --spec client_session_id(host(), port_num(), #ssl_options{}) -> session_id(). +-spec client_session_id(host(), port_num(), #ssl_options{}, + der_cert() | undefined) -> session_id(). %% %% Description: Select a session id for the client. %%-------------------------------------------------------------------- -client_session_id(Host, Port, SslOpts) -> - call({client_session_id, Host, Port, SslOpts}). +client_session_id(Host, Port, SslOpts, OwnCert) -> + call({client_session_id, Host, Port, SslOpts, OwnCert}). %%-------------------------------------------------------------------- --spec server_session_id(host(), port_num(), #ssl_options{}) -> session_id(). +-spec server_session_id(host(), port_num(), #ssl_options{}, der_cert()) -> session_id(). %% %% Description: Select a session id for the server. %%-------------------------------------------------------------------- -server_session_id(Port, SuggestedSessionId, SslOpts) -> - call({server_session_id, Port, SuggestedSessionId, SslOpts}). +server_session_id(Port, SuggestedSessionId, SslOpts, OwnCert) -> + call({server_session_id, Port, SuggestedSessionId, SslOpts, OwnCert}). %%-------------------------------------------------------------------- -spec register_session(port_num(), #session{}) -> ok. @@ -201,28 +204,35 @@ handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, end, {reply, Result, State}; -handle_call({{client_session_id, Host, Port, SslOpts}, _}, _, +handle_call({{client_session_id, Host, Port, SslOpts, OwnCert}, _}, _, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> - Id = ssl_session:id({Host, Port, SslOpts}, Cache, CacheCb), + Id = ssl_session:id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), {reply, Id, State}; -handle_call({{server_session_id, Port, SuggestedSessionId, SslOpts}, _}, +handle_call({{server_session_id, Port, SuggestedSessionId, SslOpts, OwnCert}, _}, _, #state{session_cache_cb = CacheCb, session_cache = Cache, session_lifetime = LifeTime} = State) -> Id = ssl_session:id(Port, SuggestedSessionId, SslOpts, - Cache, CacheCb, LifeTime), + Cache, CacheCb, LifeTime, OwnCert), {reply, Id, State}; -handle_call({{cache_pem, File},Pid}, _, State = #state{certificate_db = Db}) -> - try ssl_certificate_db:cache_pem_file(Pid,File,Db) of +handle_call({{cache_pem, File, LastWrite}, Pid}, _, + #state{certificate_db = Db} = State) -> + try ssl_certificate_db:cache_pem_file(Pid, File, LastWrite, Db) of Result -> {reply, Result, State} catch _:Reason -> {reply, {error, Reason}, State} - end. + end; +handle_call({{recache_pem, File, LastWrite}, Pid}, From, + #state{certificate_db = Db} = State) -> + ssl_certificate_db:uncache_pem_file(File, Db), + cast({recache_pem, File, LastWrite, Pid, From}), + {noreply, State}. + %%-------------------------------------------------------------------- -spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. %% Possible return values not used now. @@ -259,7 +269,21 @@ handle_cast({invalidate_session, Port, #session{session_id = ID}}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> CacheCb:delete(Cache, {Port, ID}), - {noreply, State}. + {noreply, State}; + +handle_cast({recache_pem, File, LastWrite, Pid, From}, + #state{certificate_db = [_, FileToRefDb, _]} = State0) -> + case ssl_certificate_db:lookup(File, FileToRefDb) of + undefined -> + {reply, Msg, State} = handle_call({{cache_pem, File, LastWrite}, Pid}, From, State0), + gen_server:reply(From, Msg), + {noreply, State}; + _ -> %% Send message to self letting cleanup messages be handled + %% first so that no reference to the old version of file + %% exists when we cache the new one. + cast({recache_pem, File, LastWrite, Pid, From}), + {noreply, State0} + end. %%-------------------------------------------------------------------- -spec handle_info(msg(), #state{}) -> {noreply, #state{}}. @@ -286,12 +310,14 @@ handle_info({'EXIT', _, _}, State) -> handle_info({'DOWN', _Ref, _Type, _Pid, ecacertfile}, State) -> {noreply, State}; +handle_info({'DOWN', _Ref, _Type, Pid, shutdown}, State) -> + handle_info({remove_trusted_certs, Pid}, State); handle_info({'DOWN', _Ref, _Type, Pid, _Reason}, State) -> erlang:send_after(?CERTIFICATE_CACHE_CLEANUP, self(), {remove_trusted_certs, Pid}), {noreply, State}; handle_info({remove_trusted_certs, Pid}, - State = #state{certificate_db = Db}) -> + #state{certificate_db = Db} = State) -> ssl_certificate_db:remove_trusted_certs(Pid, Db), {noreply, State}; @@ -362,3 +388,16 @@ session_validation({{{Host, Port}, _}, Session}, LifeTime) -> session_validation({{Port, _}, Session}, LifeTime) -> validate_session(Port, Session, LifeTime), LifeTime. + +cache_pem_file(File, LastWrite) -> + case ssl_certificate_db:lookup_cached_certs(File) of + [{_, {Mtime, Content}}] -> + case LastWrite of + Mtime -> + {ok, Content}; + _ -> + call({recache_pem, File, LastWrite}) + end; + [] -> + call({cache_pem, File, LastWrite}) + end. diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index 25e7445180..dc4b7a711c 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -28,7 +28,7 @@ -include("ssl_internal.hrl"). %% Internal application API --export([is_new/2, id/3, id/6, valid_session/2]). +-export([is_new/2, id/4, id/7, valid_session/2]). -define(GEN_UNIQUE_ID_MAX_TRIES, 10). @@ -48,13 +48,14 @@ is_new(_ClientSuggestion, _ServerDecision) -> true. %%-------------------------------------------------------------------- --spec id({host(), port_num(), #ssl_options{}}, cache_ref(), atom()) -> binary(). +-spec id({host(), port_num(), #ssl_options{}}, cache_ref(), atom(), + undefined | binary()) -> binary(). %% %% Description: Should be called by the client side to get an id %% for the client hello message. %%-------------------------------------------------------------------- -id(ClientInfo, Cache, CacheCb) -> - case select_session(ClientInfo, Cache, CacheCb) of +id(ClientInfo, Cache, CacheCb, OwnCert) -> + case select_session(ClientInfo, Cache, CacheCb, OwnCert) of no_session -> <<>>; SessionId -> @@ -63,19 +64,19 @@ id(ClientInfo, Cache, CacheCb) -> %%-------------------------------------------------------------------- -spec id(port_num(), binary(), #ssl_options{}, cache_ref(), - atom(), seconds()) -> binary(). + atom(), seconds(), binary()) -> binary(). %% %% Description: Should be called by the server side to get an id %% for the server hello message. %%-------------------------------------------------------------------- -id(Port, <<>>, _, Cache, CacheCb, _) -> +id(Port, <<>>, _, Cache, CacheCb, _, _) -> new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb); id(Port, SuggestedSessionId, #ssl_options{reuse_sessions = ReuseEnabled, reuse_session = ReuseFun}, - Cache, CacheCb, SecondLifeTime) -> + Cache, CacheCb, SecondLifeTime, OwnCert) -> case is_resumable(SuggestedSessionId, Port, ReuseEnabled, - ReuseFun, Cache, CacheCb, SecondLifeTime) of + ReuseFun, Cache, CacheCb, SecondLifeTime, OwnCert) of true -> SuggestedSessionId; false -> @@ -93,19 +94,20 @@ valid_session(#session{time_stamp = TimeStamp}, LifeTime) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -select_session({HostIP, Port, SslOpts}, Cache, CacheCb) -> +select_session({HostIP, Port, SslOpts}, Cache, CacheCb, OwnCert) -> Sessions = CacheCb:select_session(Cache, {HostIP, Port}), - select_session(Sessions, SslOpts). + select_session(Sessions, SslOpts, OwnCert). -select_session([], _) -> +select_session([], _, _) -> no_session; select_session(Sessions, #ssl_options{ciphers = Ciphers, - reuse_sessions = ReuseSession}) -> + reuse_sessions = ReuseSession}, OwnCert) -> IsResumable = fun(Session) -> ReuseSession andalso (Session#session.is_resumable) andalso lists:member(Session#session.cipher_suite, Ciphers) + andalso (OwnCert == Session#session.own_certificate) end, case [Id || [Id, Session] <- Sessions, IsResumable(Session)] of [] -> @@ -140,14 +142,16 @@ new_id(Port, Tries, Cache, CacheCb) -> end. is_resumable(SuggestedSessionId, Port, ReuseEnabled, ReuseFun, Cache, - CacheCb, SecondLifeTime) -> + CacheCb, SecondLifeTime, OwnCert) -> case CacheCb:lookup(Cache, {Port, SuggestedSessionId}) of #session{cipher_suite = CipherSuite, + own_certificate = SessionOwnCert, compression_method = Compression, is_resumable = Is_resumable, peer_certificate = PeerCert} = Session -> ReuseEnabled andalso Is_resumable + andalso (OwnCert == SessionOwnCert) andalso valid_session(Session, SecondLifeTime) andalso ReuseFun(SuggestedSessionId, PeerCert, Compression, CipherSuite); diff --git a/lib/ssl/src/ssl_ssl3.erl b/lib/ssl/src/ssl_ssl3.erl index c49f9f1e6d..f2926b2d2f 100644 --- a/lib/ssl/src/ssl_ssl3.erl +++ b/lib/ssl/src/ssl_ssl3.erl @@ -102,11 +102,6 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, Length, Fragment) -> %% hash(MAC_write_secret + pad_1 + seq_num + %% SSLCompressed.type + SSLCompressed.length + %% SSLCompressed.fragment)); - case Method of - ?NULL -> ok; - _ -> - ok - end, Mac = mac_hash(Method, Mac_write_secret, [<<?UINT64(Seq_num), ?BYTE(Type), ?UINT16(Length)>>, Fragment]), diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/ssl_tls1.erl index 3784483e9c..5f9850c386 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/ssl_tls1.erl @@ -128,11 +128,6 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, %% HMAC_hash(MAC_write_secret, seq_num + TLSCompressed.type + %% TLSCompressed.version + TLSCompressed.length + %% TLSCompressed.fragment)); - case Method of - ?NULL -> ok; - _ -> - ok - end, Mac = hmac_hash(Method, Mac_write_secret, [<<?UINT64(Seq_num), ?BYTE(Type), ?BYTE(Major), ?BYTE(Minor), ?UINT16(Length)>>, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8f9554f3ce..962d2d8cf0 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -27,6 +27,7 @@ -include("test_server.hrl"). -include("test_server_line.hrl"). -include_lib("public_key/include/public_key.hrl"). + -include("ssl_alert.hrl"). -define('24H_in_sec', 86400). @@ -125,6 +126,9 @@ init_per_testcase(empty_protocol_versions, Config) -> ssl:start(), Config; +init_per_testcase(different_ca_peer_sign, Config0) -> + ssl_test_lib:make_mix_cert(Config0); + init_per_testcase(_TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = test_server:timetrap(?TIMEOUT), @@ -205,7 +209,10 @@ all(suite) -> invalid_signature_client, invalid_signature_server, cert_expired, client_with_cert_cipher_suites_handshake, unknown_server_ca_fail, der_input, unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, - unknown_server_ca_accept_backwardscompatibilty + unknown_server_ca_accept_backwardscompatibilty, + %different_ca_peer_sign, + no_reuses_session_server_restart_new_cert, + no_reuses_session_server_restart_new_cert_file, reuseaddr ]. %% Test cases starts here. @@ -321,7 +328,6 @@ basic_test(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). - %%-------------------------------------------------------------------- controlling_process(doc) -> @@ -521,9 +527,7 @@ client_closes_socket(Config) when is_list(Config) -> _Client = spawn_link(Connect), - ssl_test_lib:check_result(Server, {error,closed}), - - ssl_test_lib:close(Server). + ssl_test_lib:check_result(Server, {error,closed}). %%-------------------------------------------------------------------- @@ -738,7 +742,6 @@ socket_options(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), - ssl_test_lib:close(Client), {ok, Listen} = ssl:listen(0, ServerOpts), {ok,[{mode,list}]} = ssl:getopts(Listen, [mode]), @@ -841,6 +844,7 @@ send_recv(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- send_close(doc) -> [""]; @@ -867,8 +871,7 @@ send_close(Config) when is_list(Config) -> ok = ssl:send(SslS, "Hello world"), {ok,<<"Hello world">>} = ssl:recv(SslS, 11), gen_tcp:close(TcpS), - {error, _} = ssl:send(SslS, "Hello world"), - ssl_test_lib:close(Server). + {error, _} = ssl:send(SslS, "Hello world"). %%-------------------------------------------------------------------- close_transport_accept(doc) -> @@ -1043,8 +1046,7 @@ tcp_connect(Config) when is_list(Config) -> {Server, {error, Error}} -> test_server:format("Error ~p", [Error]) end - end, - ssl_test_lib:close(Server). + end. dummy(_Socket) -> @@ -1149,13 +1151,13 @@ ecertfile(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -ecacertfile(doc) -> +ecacertfile(doc) -> ["Test what happens with an invalid cacert file"]; -ecacertfile(suite) -> +ecacertfile(suite) -> []; -ecacertfile(Config) when is_list(Config) -> +ecacertfile(Config) when is_list(Config) -> ClientOpts = [{reuseaddr, true}|?config(client_opts, Config)], ServerBadOpts = [{reuseaddr, true}|?config(server_bad_ca, Config)], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1532,7 +1534,7 @@ erlang_cipher_suite(Suite) -> Suite. cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> - process_flag(trap_exit, true), + %% process_flag(trap_exit, true), test_server:format("Testing CipherSuite ~p~n", [CipherSuite]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1556,16 +1558,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok), ssl_test_lib:close(Server), - receive - {'EXIT', Server, normal} -> - ok - end, ssl_test_lib:close(Client), - receive - {'EXIT', Client, normal} -> - ok - end, - process_flag(trap_exit, false), + case Result of ok -> []; @@ -1607,7 +1601,6 @@ reuse_session(suite) -> []; reuse_session(Config) when is_list(Config) -> - process_flag(trap_exit, true), ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1615,13 +1608,13 @@ reuse_session(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, session_info_result, []}}, - {options, ServerOpts}]), + {mfa, {?MODULE, session_info_result, []}}, + {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {mfa, {ssl_test_lib, no_result, []}}, + {mfa, {ssl_test_lib, no_result, []}}, {from, self()}, {options, ClientOpts}]), SessionInfo = receive @@ -1629,16 +1622,16 @@ reuse_session(Config) when is_list(Config) -> Info end, - Server ! listen, + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, %% Make sure session is registered test_server:sleep(?SLEEP), Client1 = - ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {?MODULE, session_info_result, []}}, + {from, self()}, {options, ClientOpts}]), receive {Client1, SessionInfo} -> ok; @@ -1648,10 +1641,10 @@ reuse_session(Config) when is_list(Config) -> test_server:fail(session_not_reused) end, - Server ! listen, + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, Client2 = - ssl_test_lib:start_client([{node, ClientNode}, + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {mfa, {?MODULE, session_info_result, []}}, {from, self()}, {options, [{reuse_sessions, false} @@ -1665,10 +1658,6 @@ reuse_session(Config) when is_list(Config) -> end, ssl_test_lib:close(Server), - ssl_test_lib:close(Client0), - ssl_test_lib:close(Client1), - ssl_test_lib:close(Client2), - Server1 = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -1680,7 +1669,7 @@ reuse_session(Config) when is_list(Config) -> Client3 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port1}, {host, Hostname}, - {mfa, {?MODULE, session_info_result, []}}, + {mfa, {ssl_test_lib, no_result, []}}, {from, self()}, {options, ClientOpts}]), SessionInfo1 = @@ -1689,7 +1678,7 @@ reuse_session(Config) when is_list(Config) -> Info1 end, - Server1 ! listen, + Server1 ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, %% Make sure session is registered test_server:sleep(?SLEEP), @@ -1705,14 +1694,16 @@ reuse_session(Config) when is_list(Config) -> test_server:fail( session_reused_when_session_reuse_disabled_by_server); {Client4, _Other} -> + test_server:format("OTHER: ~p ~n", [_Other]), ok end, - + ssl_test_lib:close(Server1), + ssl_test_lib:close(Client0), + ssl_test_lib:close(Client1), + ssl_test_lib:close(Client2), ssl_test_lib:close(Client3), - ssl_test_lib:close(Client4), - process_flag(trap_exit, false). - + ssl_test_lib:close(Client4). session_info_result(Socket) -> ssl:session_info(Socket). @@ -1725,7 +1716,6 @@ reuse_session_expired(suite) -> []; reuse_session_expired(Config) when is_list(Config) -> - process_flag(trap_exit, true), ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1746,8 +1736,8 @@ reuse_session_expired(Config) when is_list(Config) -> {Server, Info} -> Info end, - - Server ! listen, + + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, %% Make sure session is registered test_server:sleep(?SLEEP), @@ -1767,7 +1757,7 @@ reuse_session_expired(Config) when is_list(Config) -> end, Server ! listen, - + %% Make sure session is unregistered due to expiration test_server:sleep((?EXPIRE+1) * 1000), @@ -1782,12 +1772,12 @@ reuse_session_expired(Config) when is_list(Config) -> {Client2, _} -> ok end, - + process_flag(trap_exit, false), ssl_test_lib:close(Server), ssl_test_lib:close(Client0), ssl_test_lib:close(Client1), - ssl_test_lib:close(Client2), - process_flag(trap_exit, false). + ssl_test_lib:close(Client2). + %%-------------------------------------------------------------------- server_does_not_want_to_reuse_session(doc) -> ["Test reuse of sessions (short handshake)"]; @@ -1820,10 +1810,11 @@ server_does_not_want_to_reuse_session(Config) when is_list(Config) -> Info end, - Server ! listen, + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, %% Make sure session is registered test_server:sleep(?SLEEP), + ssl_test_lib:close(Client0), Client1 = ssl_test_lib:start_client([{node, ClientNode}, @@ -1836,11 +1827,9 @@ server_does_not_want_to_reuse_session(Config) when is_list(Config) -> {Client1, _Other} -> ok end, - + ssl_test_lib:close(Server), - ssl_test_lib:close(Client0), - ssl_test_lib:close(Client1), - process_flag(trap_exit, false). + ssl_test_lib:close(Client1). %%-------------------------------------------------------------------- @@ -2007,6 +1996,7 @@ server_verify_none_active_once(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). + %%-------------------------------------------------------------------- server_verify_client_once_passive(doc) -> @@ -2034,7 +2024,7 @@ server_verify_client_once_passive(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client0, ok), ssl_test_lib:close(Client0), - Server ! listen, + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2072,7 +2062,7 @@ server_verify_client_once_active(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client0, ok), ssl_test_lib:close(Client0), - Server ! listen, + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2083,7 +2073,6 @@ server_verify_client_once_active(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client1). - %%-------------------------------------------------------------------- server_verify_client_once_active_once(doc) -> @@ -2111,18 +2100,17 @@ server_verify_client_once_active_once(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client0, ok), ssl_test_lib:close(Client0), - Server ! listen, - + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, result_ok, []}}, - {options, [{active, once} | ClientOpts]}]), + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, result_ok, []}}, + {options, [{active, once} | ClientOpts]}]), ssl_test_lib:check_result(Client1, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client1). - + %%-------------------------------------------------------------------- server_verify_no_cacerts(doc) -> @@ -2130,9 +2118,8 @@ server_verify_no_cacerts(doc) -> server_verify_no_cacerts(suite) -> []; - server_verify_no_cacerts(Config) when is_list(Config) -> - ServerOpts = ServerOpts = ?config(server_opts, Config), + ServerOpts = ?config(server_opts, Config), {_, ServerNode, _} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, @@ -2293,8 +2280,6 @@ client_verify_none_active_once(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). - - %%-------------------------------------------------------------------- client_renegotiate(doc) -> ["Test ssl:renegotiate/1 on client."]; @@ -2303,7 +2288,6 @@ client_renegotiate(suite) -> []; client_renegotiate(Config) when is_list(Config) -> - process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -2326,11 +2310,9 @@ client_renegotiate(Config) when is_list(Config) -> {options, [{reuse_sessions, false} | ClientOpts]}]), ssl_test_lib:check_result(Client, ok, Server, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - process_flag(trap_exit, false), - ok. + ssl_test_lib:close(Client). + %%-------------------------------------------------------------------- server_renegotiate(doc) -> ["Test ssl:renegotiate/1 on server."]; @@ -2339,7 +2321,6 @@ server_renegotiate(suite) -> []; server_renegotiate(Config) when is_list(Config) -> - process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -2362,8 +2343,7 @@ server_renegotiate(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ok. + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- client_renegotiate_reused_session(doc) -> @@ -2373,7 +2353,6 @@ client_renegotiate_reused_session(suite) -> []; client_renegotiate_reused_session(Config) when is_list(Config) -> - process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -2396,11 +2375,8 @@ client_renegotiate_reused_session(Config) when is_list(Config) -> {options, [{reuse_sessions, true} | ClientOpts]}]), ssl_test_lib:check_result(Client, ok, Server, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - process_flag(trap_exit, false), - ok. + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- server_renegotiate_reused_session(doc) -> ["Test ssl:renegotiate/1 on server when the ssl session will be reused."]; @@ -2409,7 +2385,6 @@ server_renegotiate_reused_session(suite) -> []; server_renegotiate_reused_session(Config) when is_list(Config) -> - process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -2432,9 +2407,7 @@ server_renegotiate_reused_session(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ok. - + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- client_no_wrap_sequence_number(doc) -> ["Test that erlang client will renegotiate session when", @@ -2446,7 +2419,6 @@ client_no_wrap_sequence_number(suite) -> []; client_no_wrap_sequence_number(Config) when is_list(Config) -> - process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -2471,11 +2443,8 @@ client_no_wrap_sequence_number(Config) when is_list(Config) -> {renegotiate_at, N} | ClientOpts]}]), ssl_test_lib:check_result(Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - process_flag(trap_exit, false), - ok. + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- server_no_wrap_sequence_number(doc) -> ["Test that erlang server will renegotiate session when", @@ -2487,7 +2456,6 @@ server_no_wrap_sequence_number(suite) -> []; server_no_wrap_sequence_number(Config) when is_list(Config) -> - process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -2511,9 +2479,7 @@ server_no_wrap_sequence_number(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok), ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ok. - + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- extended_key_usage(doc) -> ["Test cert that has a critical extended_key_usage extension"]; @@ -2885,9 +2851,7 @@ unknown_server_ca_fail(Config) when is_list(Config) -> | ClientOpts]}]), ssl_test_lib:check_result(Server, {error,"unknown ca"}, - Client, {error, "unknown ca"}), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). + Client, {error, "unknown ca"}). %%-------------------------------------------------------------------- unknown_server_ca_accept_verify_none(doc) -> @@ -3052,12 +3016,205 @@ der_input_opts(Opts) -> {Cert, {rsa, Key}, CaCerts, DHParams}. %%-------------------------------------------------------------------- +%% different_ca_peer_sign(doc) -> +%% ["Check that a CA can have a different signature algorithm than the peer cert."]; + +%% different_ca_peer_sign(suite) -> +%% []; + +%% different_ca_peer_sign(Config) when is_list(Config) -> +%% ClientOpts = ?config(client_mix_opts, Config), +%% ServerOpts = ?config(server_mix_verify_opts, Config), + +%% {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), +%% Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, +%% {from, self()}, +%% {mfa, {?MODULE, send_recv_result_active_once, []}}, +%% {options, [{active, once}, +%% {verify, verify_peer} | ServerOpts]}]), +%% Port = ssl_test_lib:inet_port(Server), + +%% Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, +%% {host, Hostname}, +%% {from, self()}, +%% {mfa, {?MODULE, +%% send_recv_result_active_once, +%% []}}, +%% {options, [{active, once}, +%% {verify, verify_peer} +%% | ClientOpts]}]), + +%% ssl_test_lib:check_result(Server, ok, Client, ok), +%% ssl_test_lib:close(Server), +%% ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- +no_reuses_session_server_restart_new_cert(doc) -> + ["Check that a session is not reused if the server is restarted with a new cert."]; + +no_reuses_session_server_restart_new_cert(suite) -> + []; + +no_reuses_session_server_restart_new_cert(Config) when is_list(Config) -> + + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + DsaServerOpts = ?config(server_dsa_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, session_info_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client0 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + SessionInfo = + receive + {Server, Info} -> + Info + end, + + %% Make sure session is registered + test_server:sleep(?SLEEP), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client0), + + Server1 = + ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, DsaServerOpts}]), + + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {?MODULE, session_info_result, []}}, + {from, self()}, {options, ClientOpts}]), + receive + {Client1, SessionInfo} -> + test_server:fail(session_reused_when_server_has_new_cert); + {Client1, _Other} -> + ok + end, + ssl_test_lib:close(Server1), + ssl_test_lib:close(Client1). + +%%-------------------------------------------------------------------- +no_reuses_session_server_restart_new_cert_file(doc) -> + ["Check that a session is not reused if a server is restarted with a new " + "cert contained in a file with the same name as the old cert."]; + +no_reuses_session_server_restart_new_cert_file(suite) -> + []; + +no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + DsaServerOpts = ?config(server_dsa_opts, Config), + PrivDir = ?config(priv_dir, Config), + + NewServerOpts = new_config(PrivDir, ServerOpts), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, session_info_result, []}}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client0 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + SessionInfo = + receive + {Server, Info} -> + Info + end, + + %% Make sure session is registered and we get + %% new file time stamp when calling new_config! + test_server:sleep(?SLEEP* 2), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client0), + + NewServerOpts = new_config(PrivDir, DsaServerOpts), + + Server1 = + ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, NewServerOpts}]), + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {?MODULE, session_info_result, []}}, + {from, self()}, {options, ClientOpts}]), + receive + {Client1, SessionInfo} -> + test_server:fail(session_reused_when_server_has_new_cert); + {Client1, _Other} -> + ok + end, + ssl_test_lib:close(Server1), + ssl_test_lib:close(Client1). + +%%-------------------------------------------------------------------- +reuseaddr(doc) -> + [""]; + +reuseaddr(suite) -> + []; + +reuseaddr(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, [{active, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, [{active, false} | ClientOpts]}]), + test_server:sleep(?SLEEP), + ssl_test_lib:close(Server), + + Server1 = + ssl_test_lib:start_server([{node, ServerNode}, {port, Port}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{active, false} | ServerOpts]}]), + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{active, false} | ClientOpts]}]), + + ssl_test_lib:check_result(Server1, ok, Client1, ok), + ssl_test_lib:close(Server1), + ssl_test_lib:close(Client1). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- erlang_ssl_receive(Socket, Data) -> receive {ssl, Socket, Data} -> - io:format("Received ~p~n",[Data]), + test_server:format("Received ~p~n",[Data]), ok; Other -> test_server:fail({unexpected_message, Other}) @@ -3087,7 +3244,6 @@ send_recv_result_active_once(Socket) -> result_ok(_Socket) -> ok. - renegotiate(Socket, Data) -> test_server:format("Renegotiating ~n", []), Result = ssl:renegotiate(Socket), @@ -3104,3 +3260,24 @@ renegotiate_reuse_session(Socket, Data) -> %% Make sure session is registerd test_server:sleep(?SLEEP), renegotiate(Socket, Data). + + +new_config(PrivDir, ServerOpts0) -> + CaCertFile = proplists:get_value(cacertfile, ServerOpts0), + CertFile = proplists:get_value(certfile, ServerOpts0), + KeyFile = proplists:get_value(keyfile, ServerOpts0), + NewCaCertFile = filename:join(PrivDir, "new_ca.pem"), + NewCertFile = filename:join(PrivDir, "new_cert.pem"), + NewKeyFile = filename:join(PrivDir, "new_key.pem"), + file:copy(CaCertFile, NewCaCertFile), + file:copy(CertFile, NewCertFile), + file:copy(KeyFile, NewKeyFile), + ServerOpts1 = proplists:delete(cacertfile, ServerOpts0), + ServerOpts2 = proplists:delete(certfile, ServerOpts1), + ServerOpts = proplists:delete(keyfile, ServerOpts2), + + {ok, PEM} = file:read_file(NewCaCertFile), + test_server:format("CA file content: ~p~n", [public_key:pem_decode(PEM)]), + + [{cacertfile, NewCaCertFile}, {certfile, NewCertFile}, + {keyfile, NewKeyFile} | ServerOpts]. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index e1e8214ed6..f6ccbe85e3 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -81,14 +81,20 @@ run_server(ListenSocket, Opts) -> no_result_msg -> ok; Msg -> - test_server:format("Msg: ~p ~n", [Msg]), + test_server:format("Server Msg: ~p ~n", [Msg]), Pid ! {self(), Msg} end, - receive + receive listen -> run_server(ListenSocket, Opts); + {listen, MFA} -> + run_server(ListenSocket, [MFA | proplists:delete(mfa, Opts)]); close -> - ok = rpc:call(Node, ssl, close, [AcceptSocket]) + test_server:format("Server closing ~p ~n", [self()]), + Result = rpc:call(Node, ssl, close, [AcceptSocket], 500), + test_server:format("Result ~p ~n", [Result]); + {ssl_closed, _} -> + ok end. %%% To enable to test with s_client -reconnect @@ -151,19 +157,30 @@ run_client(Opts) -> no_result_msg -> ok; Msg -> + test_server:format("Client Msg: ~p ~n", [Msg]), Pid ! {self(), Msg} end, - receive + receive close -> - ok = rpc:call(Node, ssl, close, [Socket]) + test_server:format("Client closing~n", []), + rpc:call(Node, ssl, close, [Socket]); + {ssl_closed, Socket} -> + ok end; {error, Reason} -> - test_server:format("Client: connection failed: ~p ~n", [Reason]), + test_server:format("Client: connection failed: ~p ~n", [Reason]), Pid ! {self(), {error, Reason}} end. close(Pid) -> - Pid ! close. + test_server:format("Close ~p ~n", [Pid]), + Monitor = erlang:monitor(process, Pid), + Pid ! close, + receive + {'DOWN', Monitor, process, Pid, Reason} -> + erlang:demonitor(Monitor), + test_server:format("Pid: ~p down due to:~p ~n", [Pid, Reason]) + end. check_result(Server, ServerMsg, Client, ClientMsg) -> receive @@ -208,47 +225,27 @@ check_result(Pid, Msg) -> test_server:fail(Reason) end. -check_result_ignore_renegotiation_reject(Pid, Msg) -> - receive - {Pid, fail_session_fatal_alert_during_renegotiation} -> - test_server:comment("Server rejected old renegotiation"), - ok; - {ssl_error, _, esslconnect} -> - test_server:comment("Server rejected old renegotiation"), - ok; - {Pid, Msg} -> - ok; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Pid,Msg); - Unexpected -> - Reason = {{expected, {Pid, Msg}}, - {got, Unexpected}}, - test_server:fail(Reason) - end. - - wait_for_result(Server, ServerMsg, Client, ClientMsg) -> receive {Server, ServerMsg} -> receive {Client, ClientMsg} -> - ok; - Unexpected -> - Unexpected + ok + %% Unexpected -> + %% Unexpected end; {Client, ClientMsg} -> receive {Server, ServerMsg} -> - ok; - Unexpected -> - Unexpected + ok + %% Unexpected -> + %% Unexpected end; {Port, {data,Debug}} when is_port(Port) -> io:format("openssl ~s~n",[Debug]), - wait_for_result(Server, ServerMsg, Client, ClientMsg); - Unexpected -> - Unexpected + wait_for_result(Server, ServerMsg, Client, ClientMsg) + %% Unexpected -> + %% Unexpected end. @@ -258,9 +255,9 @@ wait_for_result(Pid, Msg) -> ok; {Port, {data,Debug}} when is_port(Port) -> io:format("openssl ~s~n",[Debug]), - wait_for_result(Pid,Msg); - Unexpected -> - Unexpected + wait_for_result(Pid,Msg) + %% Unexpected -> + %% Unexpected end. cert_options(Config) -> @@ -327,8 +324,8 @@ cert_options(Config) -> make_dsa_cert(Config) -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_dsa_cert_files("server", Config), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_dsa_cert_files("client", Config), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, dsa, ""), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, dsa, ""), [{server_dsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -342,22 +339,41 @@ make_dsa_cert(Config) -> | Config]. - -make_dsa_cert_files(RoleStr, Config) -> - CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, dsa}]), - {Cert, CertKey} = erl_make_certs:make_cert([{key, dsa}, {issuer, CaInfo}]), +make_mix_cert(Config) -> + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, + rsa, "mix"), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, + rsa, "mix"), + [{server_mix_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ServerCaCertFile}, + {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, + {server_mix_verify_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ClientCaCertFile}, + {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, + {verify, verify_peer}]}, + {client_mix_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ClientCaCertFile}, + {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} + | Config]. + +make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix) -> + Alg1Str = atom_to_list(Alg1), + Alg2Str = atom_to_list(Alg2), + CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}]), + {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo}]), CaCertFile = filename:join([?config(priv_dir, Config), - RoleStr, "dsa_cacerts.pem"]), + RoleStr, Prefix ++ Alg1Str ++ "_cacerts.pem"]), CertFile = filename:join([?config(priv_dir, Config), - RoleStr, "dsa_cert.pem"]), + RoleStr, Prefix ++ Alg2Str ++ "_cert.pem"]), KeyFile = filename:join([?config(priv_dir, Config), - RoleStr, "dsa_key.pem"]), + RoleStr, Prefix ++ Alg2Str ++ "_key.pem"]), der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]), der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]), der_to_pem(KeyFile, [CertKey]), {CaCertFile, CertFile, KeyFile}. + start_upgrade_server(Args) -> Result = spawn_link(?MODULE, run_upgrade_server, [Args]), receive @@ -395,10 +411,12 @@ run_upgrade_server(Opts) -> end, {Module, Function, Args} = proplists:get_value(mfa, Opts), Msg = rpc:call(Node, Module, Function, [SslAcceptSocket | Args]), + test_server:format("Upgrade Server Msg: ~p ~n", [Msg]), Pid ! {self(), Msg}, receive close -> - ok = rpc:call(Node, ssl, close, [SslAcceptSocket]) + test_server:format("Upgrade Server closing~n", []), + rpc:call(Node, ssl, close, [SslAcceptSocket]) end catch error:{badmatch, Error} -> Pid ! {self(), Error} @@ -428,10 +446,12 @@ run_upgrade_client(Opts) -> test_server:format("apply(~p, ~p, ~p)~n", [Module, Function, [SslSocket | Args]]), Msg = rpc:call(Node, Module, Function, [SslSocket | Args]), + test_server:format("Upgrade Client Msg: ~p ~n", [Msg]), Pid ! {self(), Msg}, receive close -> - ok = rpc:call(Node, ssl, close, [SslSocket]) + test_server:format("Upgrade Client closing~n", []), + rpc:call(Node, ssl, close, [SslSocket]) end. start_upgrade_server_error(Args) -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index afedeaf099..46ad0c17b6 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1164,10 +1164,6 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> close_port(OpenSslPort), %% Clean close down! ssl_test_lib:close(Client), - receive - {'EXIT', Client, normal} -> - ok - end, Return = case Result of ok -> diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index ee692adb3b..b1ae0db7e7 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1,2 +1,2 @@ -SSL_VSN = 4.1.1 +SSL_VSN = 4.1.2 diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 99e454f593..7cb02afb11 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -570,9 +570,7 @@ parse_beam(S, File, HeaderSz, CheckOnly) -> forms_or_bin = Bin} end; {error, beam_lib, Reason} when is_tuple(Reason) -> - fatal(element(1, Reason)); - {error, beam_lib, Reason} -> - fatal(Reason) + fatal(element(1, Reason)) end. parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index e38b8957f2..24abf1e977 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -165,8 +165,6 @@ basename1([$/|[]], Tail, DirSep2) -> basename1([], Tail, DirSep2); basename1([$/|Rest], _Tail, DirSep2) -> basename1(Rest, [], DirSep2); -basename1([[_|_]=List|Rest], Tail, DirSep2) -> - basename1(List++Rest, Tail, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> @@ -280,8 +278,6 @@ dirname(Name0) -> Name = flatten(Name0), dirname(Name, [], [], separators()). -dirname([[_|_]=List|Rest], Dir, File, Seps) -> - dirname(List++Rest, Dir, File, Seps); dirname([$/|Rest], Dir, File, Seps) -> dirname(Rest, File++Dir, [$/], Seps); dirname([DirSep|Rest], Dir, File, {DirSep,_}=Seps) when is_integer(DirSep) -> @@ -346,8 +342,6 @@ extension(Name) when is_binary(Name) -> [] end, case binary:matches(Name,[<<".">>]) of - nomatch -> % Bug in binary workaround :( - <<>>; [] -> <<>>; List -> @@ -479,6 +473,12 @@ maybe_remove_dirsep(Name, _) -> %% by a previous call to join/{1,2}. -spec append(file:filename(), file:name()) -> file:filename(). +append(Dir, Name) when is_binary(Dir), is_binary(Name) -> + <<Dir/binary,$/:8,Name/binary>>; +append(Dir, Name) when is_binary(Dir) -> + append(Dir,filename_string_to_binary(Name)); +append(Dir, Name) when is_binary(Name) -> + append(filename_string_to_binary(Dir),Name); append(Dir, Name) -> Dir ++ [$/|Name]. @@ -685,8 +685,6 @@ split([$/|Rest], Comp, Components, OsType) -> split(Rest, [], [lists:reverse(Comp)|Components], OsType); split([Char|Rest], Comp, Components, OsType) when is_integer(Char) -> split(Rest, [Char|Comp], Components, OsType); -split([List|Rest], Comp, Components, OsType) when is_list(List) -> - split(List++Rest, Comp, Components, OsType); split([], [], Components, _OsType) -> lists:reverse(Components); split([], Comp, Components, OsType) -> diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index 296a6b3d23..9642de17b4 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -208,29 +208,25 @@ replace(Subject,RE,Replacement,Options) -> process_repl_params(Options,iodata,false), FlatSubject = to_binary(Subject, Unicode), FlatReplacement = to_binary(Replacement, Unicode), - case do_replace(FlatSubject,Subject,RE,FlatReplacement,NewOpt) of - {error,_Err} -> - throw(badre); - IoList -> - case Convert of - iodata -> - IoList; - binary -> - case Unicode of - false -> - iolist_to_binary(IoList); - true -> - unicode:characters_to_binary(IoList,unicode) - end; - list -> - case Unicode of - false -> - binary_to_list(iolist_to_binary(IoList)); - true -> - unicode:characters_to_list(IoList,unicode) - end - end - end + IoList = do_replace(FlatSubject,Subject,RE,FlatReplacement,NewOpt), + case Convert of + iodata -> + IoList; + binary -> + case Unicode of + false -> + iolist_to_binary(IoList); + true -> + unicode:characters_to_binary(IoList,unicode) + end; + list -> + case Unicode of + false -> + binary_to_list(iolist_to_binary(IoList)); + true -> + unicode:characters_to_list(IoList,unicode) + end + end catch throw:badopt -> erlang:error(badarg,[Subject,RE,Replacement,Options]); diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c60a558fa1..254ce0095d 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,8 @@ otp_8133/1, funs/1, try_catch/1, - eval_expr_5/1]). + eval_expr_5/1, + zero_width/1]). %% %% Define to run outside of test server @@ -76,7 +77,8 @@ all(suite) -> [guard_1, guard_2, match_pattern, string_plusplus, pattern_expr, match_bin, guard_3, guard_4, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, - otp_6787, otp_6977, otp_7550, otp_8133, funs, try_catch, eval_expr_5]. + otp_6787, otp_6977, otp_7550, otp_8133, funs, try_catch, eval_expr_5, + zero_width]. guard_1(doc) -> ["(OTP-2405)"]; @@ -1326,6 +1328,14 @@ eval_expr_5(Config) when is_list(Config) -> ok end. +zero_width(Config) when is_list(Config) -> + ?line check(fun() -> + {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + ok + end, "begin {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), " + "ok end.", ok), + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 620848003c..4e789790f6 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -5325,7 +5325,25 @@ my_tab_to_list(_Ts,'$end_of_table', Acc) -> lists:reverse(Acc); my_tab_to_list(Ts,Key, Acc) -> my_tab_to_list(Ts,ets:next(Ts,Key),[ets:lookup(Ts, Key)| Acc]). +wait_for_all_schedulers_online_to_execute() -> + PMs = lists:map(fun (Sched) -> + spawn_opt(fun () -> ok end, + [monitor, {scheduler, Sched}]) + end, + lists:seq(1,erlang:system_info(schedulers_online))), + lists:foreach(fun ({P, M}) -> + receive + {'DOWN', M, process, P, _} -> ok + end + end, + PMs), + ok. + etsmem() -> + %% Wait until it is guaranteed that all already scheduled + %% deallocations of DbTable structures have completed. + wait_for_all_schedulers_online_to_execute(), + AllTabs = lists:map(fun(T) -> {T,ets:info(T,name),ets:info(T,size), ets:info(T,memory),ets:info(T,type)} end, ets:all()), |