diff options
247 files changed, 10658 insertions, 7850 deletions
diff --git a/.gitignore b/.gitignore index 065c499708..46a47febcb 100644 --- a/.gitignore +++ b/.gitignore @@ -322,6 +322,7 @@ JAVADOC-GENERATED /system/doc/top/PR.template /system/doc/top/erlresolvelinks.js /system/doc/programming_examples/funs.xml +/system/doc/system_principles/create_target.xml /system/doc/tutorial/c_port.xml /system/doc/tutorial/c_portdriver.xml /system/doc/tutorial/cnode.xml diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex b177adb455..2f0f423f16 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differnew file mode 100644 index 0000000000..296e6c4671 --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 211c56424e..fd3aa7eee5 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex d145fbd380..b228900c41 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 5bdfcefb87..4485b9e1e8 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex cd01c579bf..3162c166fb 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 253e348b62..3cdbaee1bf 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/erts/configure.in b/erts/configure.in index 4174439d76..50f8908f7a 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1589,6 +1589,7 @@ AC_CHECK_SIZEOF(void *) AC_CHECK_SIZEOF(long long) AC_CHECK_SIZEOF(size_t) AC_CHECK_SIZEOF(off_t) +AC_CHECK_SIZEOF(time_t) BITS64= @@ -1697,7 +1698,9 @@ case $host_os in AC_CHECK_FUNCS([sendfile]) ;; solaris*) - AC_SEARCH_LIBS(sendfile, sendfile, AC_DEFINE(HAVE_SENDFILE, 1)) + AC_SEARCH_LIBS(sendfilev, sendfile, + AC_DEFINE([HAVE_SENDFILEV],[1], + [Define to 1 if you have the `sendfilev' function.])) ;; win32) LIBS="$LIBS -lmswsock" diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 9fb718e60f..cfbc38f176 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -679,7 +679,7 @@ <tag><c>ts</c></tag> <item> <p><c>thread_spread</c> - Thread refers to hardware threads - (e.g. Intels hyper-threads). Schedulers with low scheduler + (e.g. Intel's hyper-threads). Schedulers with low scheduler identifiers, will be bound to the first hardware thread of each core, then schedulers with higher scheduler identifiers will be bound to the second hardware thread of each core, @@ -794,7 +794,7 @@ <item><c><![CDATA[<IdDefs> = <LogicalIds><ThreadIds><CoreIds><ProcessorIds><NodeIds> | <LogicalIds><ThreadIds><CoreIds><NodeIds><ProcessorIds>]]></c></item> <item><c><![CDATA[CpuTopology = <IdDefs>:<IdDefs> | <IdDefs>]]></c></item> </list> - <p>Set a user defined CPU topolgy. The user defined + <p>Set a user defined CPU topology. The user defined CPU topology will override any automatically detected CPU topology. The CPU topology is used when <seealso marker="#+sbt">binding schedulers to logical diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 8daa67aa87..5fc6508aad 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -136,9 +136,7 @@ ok then retrieved by calling <seealso marker="#enif_priv_data">enif_priv_data</seealso>.</p> <p>There is no way to explicitly unload a NIF library. A library will be automatically unloaded when the module code that it belongs to is purged - by the code server. A NIF library will also be unloaded if it is replaced - by another version of the library by a second call to - <c>erlang:load_nif/2</c> from the same module code.</p> + by the code server.</p> </description> <section> <title>FUNCTIONALITY</title> @@ -308,21 +306,9 @@ ok initialization is needed.</p> </item> - <tag><marker id="reload"/>int (*reload)(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)</tag> - <item><p><c>reload</c> is called when the NIF library is loaded - and there is already a previously loaded library for this - module code.</p> - <p>Works the same as <c>load</c>. The only difference is that - <c>*priv_data</c> already contains the value set by the - previous call to <c>load</c> or <c>reload</c>.</p> - <p>The library will fail to load if <c>reload</c> returns - anything other than 0 or if <c>reload</c> is NULL.</p> - </item> - <tag><marker id="upgrade"/>int (*upgrade)(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)</tag> <item><p><c>upgrade</c> is called when the NIF library is loaded - and there is no previously loaded library for this module - code, BUT there is old code of this module with a loaded NIF library.</p> + and there is old code of this module with a loaded NIF library.</p> <p>Works the same as <c>load</c>. The only difference is that <c>*old_priv_data</c> already contains the value set by the last call to <c>load</c> or <c>reload</c> for the old module @@ -339,6 +325,23 @@ ok called for a replaced library as a consequence of <c>reload</c>.</p> </item> + <tag><marker id="reload"/>int (*reload)(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)</tag> + <note><p>The reload mechanism is <em>deprecated</em>. It was only intended + as a development feature. Do not use it as an upgrade method for + live production systems. It might be removed in future releases. Be sure + to pass <c>reload</c> as <c>NULL</c> to <seealso marker="#ERL_NIF_INIT">ERL_NIF_INIT</seealso> + to disable it when not used.</p> + </note> + <item><p><c>reload</c> is called when the NIF library is loaded + and there is already a previously loaded library for this + module code.</p> + <p>Works the same as <c>load</c>. The only difference is that + <c>*priv_data</c> already contains the value set by the + previous call to <c>load</c> or <c>reload</c>.</p> + <p>The library will fail to load if <c>reload</c> returns + anything other than 0 or if <c>reload</c> is NULL.</p> + </item> + </taglist> </section> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 42a4e6a999..a603d5c2b8 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -724,9 +724,12 @@ false</pre> size limit.</p> </item> <tag><c>{line_length, integer()}</c></tag> - <item><p>Applies only to line oriented protocols - (<c>line</c>, <c>http</c>). Lines longer than this - will be truncated.</p> + <item><p>For packet type <c>line</c>, truncate lines longer + than the indicated length.</p> + <p>Option <c>line_length</c> also applies to <c>http*</c> + packet types as an alias for option <c>packet_size</c> in the + case when <c>packet_size</c> itself is not set. This usage is + only intended for backward compatibility.</p> </item> </taglist> <pre> @@ -2866,7 +2869,7 @@ os_prompt%</pre> <p>For external programs, the <c>PATH</c> is searched (or an equivalent method is used to find programs, depending on operating system). This is done by invoking - the shell och certain platforms. The first space + the shell on certain platforms. The first space separated token of the command will be considered as the name of the executable (or driver). This (among other things) makes this option unsuitable for running diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 3b5ee5391c..ec5e7d9b74 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -212,8 +212,8 @@ <p>Apart from the ordinary allocators described above a number of pre-allocators are used for some specific data types. These pre-allocators pre-allocate a fixed amount of memory for certain data - types when the run-time system starts. As long as there are available - pre-allocated memory, it will be used. When no pre-allocated memory is + types when the run-time system starts. As long as pre-allocated memory + is available, it will be used. When no pre-allocated memory is available, memory will be allocated in ordinary allocators. These pre-allocators are typically much faster than the ordinary allocators, but can only satisfy a limited amount of requests.</p> @@ -436,10 +436,10 @@ in "the <c>alloc_util</c> framework" section.</item> <tag><marker id="M_t"><c><![CDATA[+M<S>t true|false]]></c></marker></tag> <item> - Multiple, thread specific instances of the allocator. + <p>Multiple, thread specific instances of the allocator. This option will only have any effect on the runtime system with SMP support. Default behaviour on the runtime system with - SMP support: + SMP support:</p> <taglist> <tag><c>ll_alloc</c></tag> <item><c>1</c> instance.</item> @@ -448,9 +448,9 @@ a lock-free instance of its own and other threads will use a common instance.</item> </taglist> - It was previously (before ERTS version 5.9) possible to configure + <p>It was previously (before ERTS version 5.9) possible to configure a smaller amount of thread specific instances than schedulers. - This is, however, not possible any more. + This is, however, not possible any more.</p> </item> </taglist> <p>Currently the following flags are available for configuration of diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e6fbdc0d45..dd788df6e4 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -956,7 +956,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, Eterm retval; int i; - if ((retval = beam_make_current_old(c_p, c_p_locks, module)) < 0) { + if ((retval = beam_make_current_old(c_p, c_p_locks, module)) != NIL) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 26f1b4facb..55f4798892 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -3385,6 +3385,61 @@ BIF_RETTYPE universaltime_to_localtime_1(BIF_ALIST_1) BIF_RET(TUPLE2(hp, res1, res2)); } +/* convert calendar:universaltime_to_seconds/1 */ + +BIF_RETTYPE universaltime_to_posixtime_1(BIF_ALIST_1) +{ + Sint year, month, day; + Sint hour, minute, second; + + Sint64 seconds = 0; + Eterm *hp; + Uint hsz = 0; + + if (!time_to_parts(BIF_ARG_1, &year, &month, &day, + &hour, &minute, &second)) + BIF_ERROR(BIF_P, BADARG); + + if (!univ_to_seconds(year, month, day, hour, minute, second, &seconds)) { + BIF_ERROR(BIF_P, BADARG); + } + + erts_bld_sint64(NULL, &hsz, seconds); + hp = HAlloc(BIF_P, hsz); + BIF_RET(erts_bld_sint64(&hp, NULL, seconds)); +} + +/* convert calendar:seconds_to_universaltime/1 */ + +BIF_RETTYPE posixtime_to_universaltime_1(BIF_ALIST_1) +{ + Sint year, month, day; + Sint hour, minute, second; + Eterm res1, res2; + Eterm* hp; + + Sint64 time = 0; + + if (!term_to_Sint64(BIF_ARG_1, &time)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (!seconds_to_univ(time, &year, &month, &day, + &hour, &minute, &second)) { + BIF_ERROR(BIF_P, BADARG); + } + + hp = HAlloc(BIF_P, 4+4+3); + res1 = TUPLE3(hp,make_small(year),make_small(month), + make_small(day)); + hp += 4; + res2 = TUPLE3(hp,make_small(hour),make_small(minute), + make_small(second)); + hp += 4; + BIF_RET(TUPLE2(hp, res1, res2)); +} + + /**********************************************************************/ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 987008c937..8cc568b16c 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -806,6 +806,12 @@ bif file:native_name_encoding/0 # bif erlang:check_old_code/1 + +# +# New in R15B +# +bif erlang:universaltime_to_posixtime/1 +bif erlang:posixtime_to_universaltime/1 # # Obsolete # diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 1379f8645a..1e75afe6f6 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -2877,8 +2877,9 @@ reply_alloc_info(void *vair) ainfo); ainfo = erts_bld_tuple(hpp, szp, 2, erts_bld_atom(hpp, szp, - "otps"), + "options"), ainfo); + ainfo = erts_bld_cons(hpp, szp,ainfo,NIL); } ainfo = erts_bld_tuple(hpp, szp, 3, alloc_atom, diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index af386c9197..c32938bdff 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -3014,9 +3014,7 @@ info_options(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.low, allctr->mseg_opt.low_mem ? am_true : am_false); #endif add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false); - add_2tup(hpp, szp, &res, am.t, (allctr->t - ? bld_uint(hpp, szp, (Uint) allctr->t) - : am_false)); + add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false)); add_2tup(hpp, szp, &res, am.e, am_true); } diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index 2dc7237f7c..8bca9ae582 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -304,8 +304,9 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, switch (erts_thr_q_inspect(q, 1)) { case ERTS_THR_Q_DIRTY: break; + case ERTS_THR_Q_NEED_THR_PRGR: #ifdef ERTS_SMP - case ERTS_THR_Q_NEED_THR_PRGR: { + { ErtsThrPrgrVal prgr = erts_thr_q_need_thr_progress(q); erts_thr_progress_wakeup(NULL, prgr); /* @@ -522,8 +523,8 @@ int erts_async_ready_clean(void *varq, void *val) switch (cstate) { case ERTS_THR_Q_DIRTY: return ERTS_ASYNC_READY_DIRTY; -#ifdef ERTS_SMP case ERTS_THR_Q_NEED_THR_PRGR: +#ifdef ERTS_SMP *((ErtsThrPrgrVal *) val) = erts_thr_q_need_thr_progress(&arq->thr_q); return ERTS_ASYNC_READY_NEED_THR_PRGR; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 143f631f58..58a09986d2 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1507,6 +1507,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) Eterm ret = am_ok; int veto; struct erl_module_nif* lib = NULL; + int reload_warning = 0; len = list_length(BIF_ARG_1); if (len < 0) { @@ -1646,6 +1647,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) else { mod->nif->entry = NULL; /* to prevent 'unload' callback */ erts_unload_nif(mod->nif); + reload_warning = 1; } } else { @@ -1714,6 +1716,15 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_free(ERTS_ALC_T_TMP, lib_name); + + if (reload_warning) { + erts_dsprintf_buf_t* dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Repeated calls to erlang:load_nif from module '%T'.\n\n" + "The NIF reload mechanism is deprecated and must not " + "be used in production systems.\n", mod_atom); + erts_send_warning_to_logger(BIF_P->group_leader, dsbufp); + } BIF_RET(ret); } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ec4b1dcd98..b8c6b64fc0 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -769,8 +769,8 @@ misc_aux_work_clean(ErtsThrQ_t *q, case ERTS_THR_Q_DIRTY: set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC); return aux_work | ERTS_SSI_AUX_WORK_MISC; -#ifdef ERTS_SMP case ERTS_THR_Q_NEED_THR_PRGR: +#ifdef ERTS_SMP set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR); erts_thr_progress_wakeup(awdp->esdp, erts_thr_q_need_thr_progress(q)); @@ -909,7 +909,7 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp, #ifdef ERTS_SMP if (awdp->async_ready.need_thr_prgr - && !erts_thr_progress_has_reached(awdp->misc.thr_prgr)) { + && !erts_thr_progress_has_reached(awdp->async_ready.thr_prgr)) { return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; } @@ -928,6 +928,7 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp, erts_thr_progress_wakeup(awdp->esdp, awdp->async_ready.thr_prgr); awdp->async_ready.need_thr_prgr = 1; + return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; #endif default: return aux_work; diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c index 9ac4cd4b8e..efb8c635d7 100644 --- a/erts/emulator/beam/erl_thr_queue.c +++ b/erts/emulator/beam/erl_thr_queue.c @@ -449,32 +449,44 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify) if (inext == (erts_aint_t) &q->tail.data.marker) { q->head.head.ptr->next.ptr = &q->tail.data.marker; q->head.head.ptr = &q->tail.data.marker; -#ifdef ERTS_SMP - if (!q->head.next.thr_progress_reached) - return ERTS_THR_Q_NEED_THR_PRGR; -#else - if (do_notify) - q->head.notify(q->head.arg); -#endif - return ERTS_THR_Q_DIRTY; + goto check_thr_progress; } } } + + if (q->q.finalizing) { + ilast = erts_atomic_read_nob(&q->tail.data.last); + if (q->head.first == ((ErtsThrQElement_t *) ilast) + && ((ErtsThrQElement_t *) ilast) == &q->tail.data.marker + && q->head.first == &q->tail.data.marker) { + destroy(q); + } + else { + goto dirty; + } + } return ERTS_THR_Q_CLEAN; } - if (q->head.first != q->head.unref_end) { - if (do_notify) - q->head.notify(q->head.arg); - return ERTS_THR_Q_DIRTY; - } + if (q->head.first != q->head.unref_end) + goto dirty; + +check_thr_progress: #ifdef ERTS_SMP - if (!q->head.next.thr_progress_reached) - return ERTS_THR_Q_NEED_THR_PRGR; + if (q->head.next.thr_progress_reached) #endif + { + int um_refc_ix = q->head.next.um_refc_ix; + if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0) { + dirty: + if (do_notify) + q->head.notify(q->head.arg); + return ERTS_THR_Q_DIRTY; + } + } - return ERTS_THR_Q_CLEAN; /* Waiting for unmanaged threads to complete... */ + return ERTS_THR_Q_NEED_THR_PRGR; } #endif @@ -492,7 +504,9 @@ erts_thr_q_clean(ErtsThrQ_t *q) ErtsThrQCleanState_t erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty) { -#ifdef USE_THREADS +#ifndef USE_THREADS + return ERTS_THR_Q_CLEAN; +#else if (ensure_empty) { erts_aint_t inext; inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc); @@ -523,11 +537,15 @@ erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty) return ERTS_THR_Q_DIRTY; #ifdef ERTS_SMP - if (!q->head.next.thr_progress_reached) - return ERTS_THR_Q_NEED_THR_PRGR; + if (q->head.next.thr_progress_reached) #endif + { + int um_refc_ix = q->head.next.um_refc_ix; + if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0) + return ERTS_THR_Q_DIRTY; + } + return ERTS_THR_Q_NEED_THR_PRGR; #endif - return ERTS_THR_Q_CLEAN; } static void diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h index 407c23f5eb..edcf2c3823 100644 --- a/erts/emulator/beam/erl_thr_queue.h +++ b/erts/emulator/beam/erl_thr_queue.h @@ -96,9 +96,7 @@ typedef struct { typedef enum { ERTS_THR_Q_CLEAN, -#ifdef ERTS_SMP ERTS_THR_Q_NEED_THR_PRGR, -#endif ERTS_THR_Q_DIRTY, } ErtsThrQCleanState_t; diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 7a09d30ff6..6c6e193818 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -20,7 +20,11 @@ #ifndef ERL_TIME_H__ #define ERL_TIME_H__ -extern erts_smp_atomic_t do_time; /* set at clock interrupt */ +#define ERTS_SHORT_TIME_T_MAX ERTS_AINT32_T_MAX +#define ERTS_SHORT_TIME_T_MIN ERTS_AINT32_T_MIN +typedef erts_aint32_t erts_short_time_t; + +extern erts_smp_atomic32_t do_time; /* set at clock interrupt */ extern SysTimeval erts_first_emu_time; /* @@ -71,22 +75,32 @@ void erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer); void erts_init_time(void); void erts_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint); void erts_cancel_timer(ErlTimer*); -void erts_bump_timer(erts_aint_t); +void erts_bump_timer(erts_short_time_t); Uint erts_timer_wheel_memory_size(void); Uint erts_time_left(ErlTimer *); -erts_aint_t erts_next_time(void); +erts_short_time_t erts_next_time(void); #ifdef DEBUG void erts_p_slpq(void); #endif -ERTS_GLB_INLINE erts_aint_t erts_do_time_read_and_reset(void); -ERTS_GLB_INLINE void erts_do_time_add(long); +ERTS_GLB_INLINE erts_short_time_t erts_do_time_read_and_reset(void); +ERTS_GLB_INLINE void erts_do_time_add(erts_short_time_t); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE erts_aint_t erts_do_time_read_and_reset(void) { return erts_smp_atomic_xchg_acqb(&do_time, 0L); } -ERTS_GLB_INLINE void erts_do_time_add(long elapsed) { erts_smp_atomic_add_relb(&do_time, elapsed); } +ERTS_GLB_INLINE erts_short_time_t erts_do_time_read_and_reset(void) +{ + erts_short_time_t time = erts_smp_atomic32_xchg_acqb(&do_time, 0); + if (time < 0) + erl_exit(ERTS_ABORT_EXIT, "Internal time management error\n"); + return time; +} + +ERTS_GLB_INLINE void erts_do_time_add(erts_short_time_t elapsed) +{ + erts_smp_atomic32_add_relb(&do_time, elapsed); +} #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ @@ -105,7 +119,7 @@ void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec); #endif void erts_get_timeval(SysTimeval *tv); -long erts_get_time(void); +erts_time_t erts_get_time(void); void erts_get_emu_time(SysTimeval *); ERTS_GLB_INLINE int erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p); diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 4d1e1c8a59..f782e2f0b1 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -371,7 +371,7 @@ static void init_erts_deliver_time(const SysTimeval *inittv) static void do_erts_deliver_time(const SysTimeval *current) { SysTimeval cur_time; - long elapsed; + erts_time_t elapsed; /* calculate and deliver appropriate number of ticks */ cur_time = *current; @@ -385,7 +385,10 @@ static void do_erts_deliver_time(const SysTimeval *current) this by simply pretend as if the time stood still. :) */ if (elapsed > 0) { - erts_do_time_add(elapsed); + + ASSERT(elapsed < ((erts_time_t) ERTS_SHORT_TIME_T_MAX)); + + erts_do_time_add((erts_short_time_t) elapsed); last_delivered = cur_time; } } @@ -491,7 +494,7 @@ get_time(int *hour, int *minute, int *second) the_clock = time((time_t *)0); #ifdef HAVE_LOCALTIME_R - localtime_r(&the_clock, (tm = &tmbuf)); + tm = localtime_r(&the_clock, &tmbuf); #else tm = localtime(&the_clock); #endif @@ -513,7 +516,7 @@ get_date(int *year, int *month, int *day) the_clock = time((time_t *)0); #ifdef HAVE_LOCALTIME_R - localtime_r(&the_clock, (tm = &tmbuf)); + tm = localtime_r(&the_clock, &tmbuf); #else tm = localtime(&the_clock); #endif @@ -583,7 +586,44 @@ static const int mdays[14] = {0, 31, 28, 31, 30, 31, 30, (((y) % 100) != 0)) || \ (((y) % 400) == 0)) -#define BASEYEAR 1970 +/* This is the earliest year we are sure to be able to handle + on all platforms w/o problems */ +#define BASEYEAR 1902 + +/* A more "clever" mktime + * return 1, if successful + * return -1, if not successful + */ + +static int erl_mktime(time_t *c, struct tm *tm) { + time_t clock; + + clock = mktime(tm); + + if (clock != -1) { + *c = clock; + return 1; + } + + /* in rare occasions mktime returns -1 + * when a correct value has been entered + * + * decrease seconds with one second + * if the result is -2, epochs should be -1 + */ + + tm->tm_sec = tm->tm_sec - 1; + clock = mktime(tm); + tm->tm_sec = tm->tm_sec + 1; + + *c = -1; + + if (clock == -2) { + return 1; + } + + return -1; +} /* * gregday @@ -592,10 +632,10 @@ static const int mdays[14] = {0, 31, 28, 31, 30, 31, 30, * greater of equal to 1600 , and month [1-12] and day [1-31] * are within range. Otherwise it returns -1. */ -static int long gregday(int year, int month, int day) +static time_t gregday(int year, int month, int day) { - int long ndays = 0; - int gyear, pyear, m; + Sint ndays = 0; + Sint gyear, pyear, m; /* number of days in previous years */ gyear = year - 1600; @@ -610,10 +650,72 @@ static int long gregday(int year, int month, int day) if (is_leap_year(year) && (month > 2)) ndays++; ndays += day - 1; - return ndays - 135140; /* 135140 = Jan 1, 1970 */ + return (time_t) (ndays - 135140); /* 135140 = Jan 1, 1970 */ +} + +#define SECONDS_PER_MINUTE (60) +#define SECONDS_PER_HOUR (60 * SECONDS_PER_MINUTE) +#define SECONDS_PER_DAY (24 * SECONDS_PER_HOUR) + +int seconds_to_univ(Sint64 time, Sint *year, Sint *month, Sint *day, + Sint *hour, Sint *minute, Sint *second) { + + Sint y,mi; + Sint days = time / SECONDS_PER_DAY; + Sint secs = time % SECONDS_PER_DAY; + Sint tmp; + + if (secs < 0) { + days--; + secs += SECONDS_PER_DAY; + } + + tmp = secs % SECONDS_PER_HOUR; + + *hour = secs / SECONDS_PER_HOUR; + *minute = tmp / SECONDS_PER_MINUTE; + *second = tmp % SECONDS_PER_MINUTE; + + days += 719468; + y = (10000*((Sint64)days) + 14780) / 3652425; + tmp = days - (365 * y + y/4 - y/100 + y/400); + + if (tmp < 0) { + y--; + tmp = days - (365*y + y/4 - y/100 + y/400); + } + mi = (100 * tmp + 52)/3060; + *month = (mi + 2) % 12 + 1; + *year = y + (mi + 2) / 12; + *day = tmp - (mi * 306 + 5)/10 + 1; + + return 1; } +int univ_to_seconds(Sint year, Sint month, Sint day, Sint hour, Sint minute, Sint second, Sint64 *time) { + Sint days; + + if (!(IN_RANGE(1600, year, INT_MAX - 1) && + IN_RANGE(1, month, 12) && + IN_RANGE(1, day, (mdays[month] + + (month == 2 + && (year % 4 == 0) + && (year % 100 != 0 || year % 400 == 0)))) && + IN_RANGE(0, hour, 23) && + IN_RANGE(0, minute, 59) && + IN_RANGE(0, second, 59))) { + return 0; + } + + days = gregday(year, month, day); + *time = SECONDS_PER_DAY; + *time *= days; /* don't try overflow it, it hurts */ + *time += SECONDS_PER_HOUR * hour; + *time += SECONDS_PER_MINUTE * minute; + *time += second; + return 1; +} int local_to_univ(Sint *year, Sint *month, Sint *day, @@ -644,15 +746,18 @@ local_to_univ(Sint *year, Sint *month, Sint *day, t.tm_min = *minute; t.tm_sec = *second; t.tm_isdst = isdst; - the_clock = mktime(&t); - if (the_clock == -1) { + + /* the nature of mktime makes this a bit interesting, + * up to four mktime calls could happen here + */ + + if (erl_mktime(&the_clock, &t) < 0) { if (isdst) { /* If this is a timezone without DST and the OS (correctly) refuses to give us a DST time, we simulate the Linux/Solaris behaviour of giving the same data as if is_dst was not set. */ t.tm_isdst = 0; - the_clock = mktime(&t); - if (the_clock == -1) { + if (erl_mktime(&the_clock, &t)) { /* Failed anyway, something else is bad - will be a badarg */ return 0; } @@ -662,10 +767,13 @@ local_to_univ(Sint *year, Sint *month, Sint *day, } } #ifdef HAVE_GMTIME_R - gmtime_r(&the_clock, (tm = &tmbuf)); + tm = gmtime_r(&the_clock, &tmbuf); #else tm = gmtime(&the_clock); #endif + if (!tm) { + return 0; + } *year = tm->tm_year + 1900; *month = tm->tm_mon +1; *day = tm->tm_mday; @@ -719,17 +827,20 @@ univ_to_local(Sint *year, Sint *month, Sint *day, #endif #ifdef HAVE_LOCALTIME_R - localtime_r(&the_clock, (tm = &tmbuf)); + tm = localtime_r(&the_clock, &tmbuf); #else tm = localtime(&the_clock); #endif - *year = tm->tm_year + 1900; - *month = tm->tm_mon +1; - *day = tm->tm_mday; - *hour = tm->tm_hour; - *minute = tm->tm_min; - *second = tm->tm_sec; - return 1; + if (tm) { + *year = tm->tm_year + 1900; + *month = tm->tm_mon +1; + *day = tm->tm_mday; + *hour = tm->tm_hour; + *minute = tm->tm_min; + *second = tm->tm_sec; + return 1; + } + return 0; } @@ -798,13 +909,14 @@ void erts_deliver_time(void) { void erts_time_remaining(SysTimeval *rem_time) { - int ticks; + erts_time_t ticks; SysTimeval cur_time; - long elapsed; + erts_time_t elapsed; /* erts_next_time() returns no of ticks to next timeout or -1 if none */ - if ((ticks = erts_next_time()) == -1) { + ticks = (erts_time_t) erts_next_time(); + if (ticks == (erts_time_t) -1) { /* timer queue empty */ /* this will cause at most 100000000 ticks */ rem_time->tv_sec = 100000; @@ -839,7 +951,7 @@ void erts_get_timeval(SysTimeval *tv) erts_smp_mtx_unlock(&erts_timeofday_mtx); } -long +erts_time_t erts_get_time(void) { SysTimeval sys_tv; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index c2cc03509e..759621d3c2 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -644,7 +644,6 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ name, opts); erts_unblock_fpe(fpe_was_unmasked); port->caller = NIL; - erts_unblock_fpe(fpe_was_unmasked); if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(port, am_out, am_start); } diff --git a/erts/emulator/beam/packet_parser.c b/erts/emulator/beam/packet_parser.c index a66d60aa22..4d4b6ea196 100644 --- a/erts/emulator/beam/packet_parser.c +++ b/erts/emulator/beam/packet_parser.c @@ -301,7 +301,11 @@ int packet_get_length(enum PacketParseType htype, /* TCP_PB_LINE_LF: [Data ... \n] */ const char* ptr2; if ((ptr2 = memchr(ptr, '\n', n)) == NULL) { - if (n >= trunc_len && trunc_len!=0) { /* buffer full */ + if (n > max_plen && max_plen != 0) { /* packet full */ + DEBUGF((" => packet full (no NL)=%d\r\n", n)); + goto error; + } + else if (n >= trunc_len && trunc_len!=0) { /* buffer full */ DEBUGF((" => line buffer full (no NL)=%d\r\n", n)); return trunc_len; } @@ -309,6 +313,10 @@ int packet_get_length(enum PacketParseType htype, } else { int len = (ptr2 - ptr) + 1; /* including newline */ + if (len > max_plen && max_plen!=0) { + DEBUGF((" => packet_size %d exceeded\r\n", max_plen)); + goto error; + } if (len > trunc_len && trunc_len!=0) { DEBUGF((" => truncated line=%d\r\n", trunc_len)); return trunc_len; @@ -397,33 +405,50 @@ int packet_get_length(enum PacketParseType htype, const char* ptr1 = ptr; int len = plen; + if (!max_plen) { + /* This is for backward compatibility with old user of decode_packet + * that might use option 'line_length' to limit accepted length of + * http lines. + */ + max_plen = trunc_len; + } + while (1) { const char* ptr2 = memchr(ptr1, '\n', len); if (ptr2 == NULL) { - if (n >= trunc_len && trunc_len!=0) { /* buffer full */ - plen = trunc_len; - goto done; + if (max_plen != 0) { + if (n >= max_plen) /* packet full */ + goto error; } goto more; } else { plen = (ptr2 - ptr) + 1; - - if (*statep == 0) + + if (*statep == 0) { + if (max_plen != 0 && plen > max_plen) + goto error; goto done; - + } + if (plen < n) { if (SP(ptr2+1) && plen>2) { /* header field value continue on next line */ ptr1 = ptr2+1; len = n - plen; } - else + else { + if (max_plen != 0 && plen > max_plen) + goto error; goto done; + } } - else + else { + if (max_plen != 0 && plen > max_plen) + goto error; goto more; + } } } } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index d8cd22a177..6b4b382caa 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -636,10 +636,11 @@ extern char *erts_sys_ddll_error(int code); /* * System interfaces for startup. */ +#include "erl_time.h" void erts_sys_schedule_interrupt(int set); #ifdef ERTS_SMP -void erts_sys_schedule_interrupt_timed(int set, long msec); +void erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec); void erts_sys_main_thread(void); #endif @@ -666,7 +667,14 @@ void get_localtime(int *year, int *month, int *day, int *hour, int *minute, int *second); void get_universaltime(int *year, int *month, int *day, int *hour, int *minute, int *second); -int univ_to_local(Sint *year, Sint *month, Sint *day, +int seconds_to_univ(Sint64 seconds, + Sint *year, Sint *month, Sint *day, + Sint *hour, Sint *minute, Sint *second); +int univ_to_seconds(Sint year, Sint month, Sint day, + Sint hour, Sint minute, Sint second, + Sint64* seconds); +int univ_to_local( + Sint *year, Sint *month, Sint *day, Sint *hour, Sint *minute, Sint *second); int local_to_univ(Sint *year, Sint *month, Sint *day, Sint *hour, Sint *minute, Sint *second, int isdst); diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index db9a24e0a3..932d157cd8 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -107,20 +107,31 @@ static ErlTimer *tiw_min_ptr; /* Actual interval time chosen by sys_init_time() */ static int itime; /* Constant after init */ -erts_smp_atomic_t do_time; /* set at clock interrupt */ -static ERTS_INLINE erts_aint_t do_time_read(void) { return erts_smp_atomic_read_acqb(&do_time); } -static ERTS_INLINE erts_aint_t do_time_update(void) { return do_time_read(); } -static ERTS_INLINE void do_time_init(void) { erts_smp_atomic_init_nob(&do_time, 0L); } +erts_smp_atomic32_t do_time; /* set at clock interrupt */ +static ERTS_INLINE erts_short_time_t do_time_read(void) +{ + return erts_smp_atomic32_read_acqb(&do_time); +} + +static ERTS_INLINE erts_short_time_t do_time_update(void) +{ + return do_time_read(); +} + +static ERTS_INLINE void do_time_init(void) +{ + erts_smp_atomic32_init_nob(&do_time, 0); +} /* get the time (in units of itime) to the next timeout, or -1 if there are no timeouts */ -static erts_aint_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ +static erts_short_time_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ { int i, tm, nto; - unsigned int min; + Uint32 min; ErlTimer* p; - erts_aint_t dt; + erts_short_time_t dt; if (tiw_nto == 0) return -1; /* no timeouts in wheel */ @@ -133,7 +144,7 @@ static erts_aint_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ /* start going through wheel to find next timeout */ tm = nto = 0; - min = (unsigned int) -1; /* max unsigned int */ + min = (Uint32) -1; /* max Uint32 */ i = tiw_pos; do { p = tiw[i]; @@ -162,7 +173,11 @@ static erts_aint_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ i = (i + 1) % TIW_SIZE; } while (i != tiw_pos); dt = do_time_read(); - return ((min >= dt) ? (min - dt) : 0); + if (min <= (Uint32) dt) + return 0; + if ((min - (Uint32) dt) > (Uint32) ERTS_SHORT_TIME_T_MAX) + return ERTS_SHORT_TIME_T_MAX; + return (erts_short_time_t) (min - (Uint32) dt); } static void remove_timer(ErlTimer *p) { @@ -191,9 +206,9 @@ static void remove_timer(ErlTimer *p) { } /* Private export to erl_time_sup.c */ -erts_aint_t erts_next_time(void) +erts_short_time_t erts_next_time(void) { - erts_aint_t ret; + erts_short_time_t ret; erts_smp_mtx_lock(&tiw_lock); (void)do_time_update(); @@ -202,7 +217,7 @@ erts_aint_t erts_next_time(void) return ret; } -static ERTS_INLINE void bump_timer_internal(erts_aint_t dt) /* PRE: tiw_lock is write-locked */ +static ERTS_INLINE void bump_timer_internal(erts_short_time_t dt) /* PRE: tiw_lock is write-locked */ { Uint keep_pos; Uint count; @@ -273,7 +288,7 @@ static ERTS_INLINE void bump_timer_internal(erts_aint_t dt) /* PRE: tiw_lock is } } -void erts_bump_timer(erts_aint_t dt) /* dt is value from do_time */ +void erts_bump_timer(erts_short_time_t dt) /* dt is value from do_time */ { erts_smp_mtx_lock(&tiw_lock); bump_timer_internal(dt); @@ -378,8 +393,8 @@ erts_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, insert_timer(p, t); erts_smp_mtx_unlock(&tiw_lock); #if defined(ERTS_SMP) - if (t <= (Uint) LONG_MAX) - erts_sys_schedule_interrupt_timed(1, (long) t); + if (t <= (Uint) ERTS_SHORT_TIME_T_MAX) + erts_sys_schedule_interrupt_timed(1, (erts_short_time_t) t); #endif } @@ -419,7 +434,7 @@ Uint erts_time_left(ErlTimer *p) { Uint left; - erts_aint_t dt; + erts_short_time_t dt; erts_smp_mtx_lock(&tiw_lock); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index df03f5e42c..4105f194a9 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2661,6 +2661,7 @@ tailrecur_ne: #endif #define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2)) #define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1)) +#define BIG_ARITY_FLOAT_MAX (1024 / D_EXP) /* arity of max float as a bignum */ b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { @@ -2693,16 +2694,24 @@ tailrecur_ne: } #endif // ERTS_SIZEOF_ETERM == 8 break; + case FLOAT_BIG: + { + Wterm tmp = aw; + aw = bw; + bw = tmp; + }/* fall through */ case BIG_FLOAT: GET_DOUBLE(bw, f2); if ((f2.fd < (double) (MAX_SMALL + 1)) && (f2.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint j = big_sign(aw) ? -1 : 1; - } else if ((pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) { + } else if (big_arity(aw) > BIG_ARITY_FLOAT_MAX + || pow(2.0,(big_arity(aw)-1)*D_EXP) > fabs(f2.fd)) { // If bignum size shows that it is bigger than the abs float j = big_sign(aw) ? -1 : 1; - } else if ((pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) { + } else if (big_arity(aw) < BIG_ARITY_FLOAT_MAX + && (pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) { // If bignum size shows that it is smaller than the abs float j = f2.fd < 0 ? 1 : -1; } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { @@ -2716,6 +2725,9 @@ tailrecur_ne: big = double_to_big(f2.fd, big_buf); j = big_comp(aw, big); } + if (_NUMBER_CODE(a_tag, b_tag) == FLOAT_BIG) { + j = -j; + } break; case FLOAT_SMALL: GET_DOUBLE(aw, f1); @@ -2740,29 +2752,6 @@ tailrecur_ne: } #endif // ERTS_SIZEOF_ETERM == 8 break; - case FLOAT_BIG: - GET_DOUBLE(aw, f1); - if ((f1.fd < (double) (MAX_SMALL + 1)) - && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint - j = big_sign(bw) ? 1 : -1; - } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) { - // If bignum size shows that it is bigger than the abs float - j = big_sign(bw) ? 1 : -1; - } else if ((pow(2.0,(big_arity(bw))*D_EXP)-1.0) < fabs(f1.fd)) { - // If bignum size shows that it is smaller than the abs float - j = f1.fd < 0 ? -1 : 1; - } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { - // Float is within the no loss limit - if (big_to_double(bw, &f2.fd) < 0) { - j = big_sign(bw) ? 1 : -1; - } else { - j = float_comp(f1.fd, f2.fd); - } - } else { - big = double_to_big(f1.fd, big_buf); - j = big_comp(big, bw); - } - break; default: j = b_tag - a_tag; } diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 5c52b99348..d9282dbb12 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -104,6 +104,7 @@ #ifndef WANT_NONBLOCKING #define WANT_NONBLOCKING #endif + #include "sys.h" #include "erl_driver.h" @@ -147,6 +148,22 @@ static ErlDrvSysInfo sys_info; #define MUTEX_UNLOCK(m) #endif + +/** + * On DARWIN sendfile can deadlock with close if called in + * different threads. So until Apple fixes so that sendfile + * is not buggy we disable usage of the async pool for + * DARWIN. The testcase t_sendfile_crashduring reproduces + * this error when using +A 10. + */ +#if !defined(DARWIN) +#define USE_THRDS_FOR_SENDFILE (sys_info.async_threads > 0) +#else +#define USE_THRDS_FOR_SENDFILE 0 +#endif /* !DARWIN */ + + + #if 0 /* Experimental, for forcing all file operations to use the same thread. */ static unsigned file_fixed_key = 1; @@ -734,6 +751,15 @@ file_stop(ErlDrvData e) TRACE_C('p'); +#ifdef HAVE_SENDFILE + if (desc->sendfile_state == sending && !USE_THRDS_FOR_SENDFILE) { + driver_select(desc->port,(ErlDrvEvent)(long)desc->d->c.sendfile.out_fd, + ERL_DRV_WRITE|ERL_DRV_USE,0); + } else if (desc->sendfile_state == sending) { + SET_NONBLOCKING(desc->d->c.sendfile.out_fd); + } +#endif /* HAVE_SENDFILE */ + if (desc->fd != FILE_FD_INVALID) { do_close(desc->flags, desc->fd); desc->fd = FILE_FD_INVALID; @@ -799,7 +825,16 @@ static void reply_Uint_posix_error(file_descriptor *desc, Uint num, driver_output2(desc->port, response, t-response, NULL, 0); } +static void reply_string_error(file_descriptor *desc, char* str) { + char response[256]; /* Response buffer. */ + char* s; + char* t; + response[0] = FILE_RESP_ERROR; + for (s = str, t = response+1; *s; s++, t++) + *t = tolower(*s); + driver_output2(desc->port, response, t-response, NULL, 0); +} static int reply_error(file_descriptor *desc, Efile_error *errInfo) /* The error codes. */ @@ -1744,7 +1779,7 @@ static void invoke_sendfile(void *data) d->c.sendfile.written += nbytes; if (result == 1) { - if (sys_info.async_threads != 0) { + if (USE_THRDS_FOR_SENDFILE) { d->result_ok = 0; } else if (d->c.sendfile.nbytes == 0 && nbytes != 0) { d->result_ok = 1; @@ -2120,24 +2155,25 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) if (d->result_ok) { resbuf[0] = FILE_RESP_INFO; - put_int32(d->info.size_high, &resbuf[1 + (0 * 4)]); - put_int32(d->info.size_low, &resbuf[1 + (1 * 4)]); - put_int32(d->info.type, &resbuf[1 + (2 * 4)]); - - PUT_TIME(d->info.accessTime, resbuf + 1 + 3*4); - PUT_TIME(d->info.modifyTime, resbuf + 1 + 9*4); - PUT_TIME(d->info.cTime, resbuf + 1 + 15*4); - - put_int32(d->info.mode, &resbuf[1 + (21 * 4)]); - put_int32(d->info.links, &resbuf[1 + (22 * 4)]); - put_int32(d->info.major_device, &resbuf[1 + (23 * 4)]); - put_int32(d->info.minor_device, &resbuf[1 + (24 * 4)]); - put_int32(d->info.inode, &resbuf[1 + (25 * 4)]); - put_int32(d->info.uid, &resbuf[1 + (26 * 4)]); - put_int32(d->info.gid, &resbuf[1 + (27 * 4)]); - put_int32(d->info.access, &resbuf[1 + (28 * 4)]); - -#define RESULT_SIZE (1 + (29 * 4)) + put_int32(d->info.size_high, &resbuf[1 + ( 0 * 4)]); + put_int32(d->info.size_low, &resbuf[1 + ( 1 * 4)]); + put_int32(d->info.type, &resbuf[1 + ( 2 * 4)]); + + /* Note 64 bit indexing in resbuf here */ + put_int64(d->info.accessTime, &resbuf[1 + ( 3 * 4)]); + put_int64(d->info.modifyTime, &resbuf[1 + ( 5 * 4)]); + put_int64(d->info.cTime, &resbuf[1 + ( 7 * 4)]); + + put_int32(d->info.mode, &resbuf[1 + ( 9 * 4)]); + put_int32(d->info.links, &resbuf[1 + (10 * 4)]); + put_int32(d->info.major_device, &resbuf[1 + (11 * 4)]); + put_int32(d->info.minor_device, &resbuf[1 + (12 * 4)]); + put_int32(d->info.inode, &resbuf[1 + (13 * 4)]); + put_int32(d->info.uid, &resbuf[1 + (14 * 4)]); + put_int32(d->info.gid, &resbuf[1 + (15 * 4)]); + put_int32(d->info.access, &resbuf[1 + (16 * 4)]); + +#define RESULT_SIZE (1 + (17 * 4)) TRACE_C('R'); driver_output2(desc->port, resbuf, RESULT_SIZE, NULL, 0); #undef RESULT_SIZE @@ -2208,8 +2244,13 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) case FILE_SENDFILE: if (d->result_ok == -1) { desc->sendfile_state = not_sending; - reply_error(desc, &d->errInfo); - if (sys_info.async_threads != 0) { + if (d->errInfo.posix_errno == ECONNRESET || + d->errInfo.posix_errno == ENOTCONN || + d->errInfo.posix_errno == EPIPE) + reply_string_error(desc,"closed"); + else + reply_error(desc, &d->errInfo); + if (USE_THRDS_FOR_SENDFILE) { SET_NONBLOCKING(d->c.sendfile.out_fd); free_sendfile(data); } else { @@ -2220,7 +2261,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) } else if (d->result_ok == 0) { desc->sendfile_state = not_sending; reply_Sint64(desc, d->c.sendfile.written); - if (sys_info.async_threads != 0) { + if (USE_THRDS_FOR_SENDFILE) { SET_NONBLOCKING(d->c.sendfile.out_fd); free_sendfile(data); } else { @@ -2485,15 +2526,16 @@ file_output(ErlDrvData e, char* buf, int count) case FILE_WRITE_INFO: { d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 - + FILENAME_BYTELEN(buf+21*4) + FILENAME_CHARSIZE); + + FILENAME_BYTELEN(buf + 9*4) + FILENAME_CHARSIZE); - d->info.mode = get_int32(buf + 0 * 4); - d->info.uid = get_int32(buf + 1 * 4); - d->info.gid = get_int32(buf + 2 * 4); - GET_TIME(d->info.accessTime, buf + 3 * 4); - GET_TIME(d->info.modifyTime, buf + 9 * 4); - GET_TIME(d->info.cTime, buf + 15 * 4); - FILENAME_COPY(d->b, buf+21*4); + d->info.mode = get_int32(buf + 0 * 4); + d->info.uid = get_int32(buf + 1 * 4); + d->info.gid = get_int32(buf + 2 * 4); + d->info.accessTime = (time_t)((Sint64)get_int64(buf + 3 * 4)); + d->info.modifyTime = (time_t)((Sint64)get_int64(buf + 5 * 4)); + d->info.cTime = (time_t)((Sint64)get_int64(buf + 7 * 4)); + + FILENAME_COPY(d->b, buf + 9*4); d->command = command; d->invoke = invoke_write_info; d->free = free_data; @@ -3425,7 +3467,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->c.sendfile.nbytes = nbytes; - if (sys_info.async_threads != 0) { + if (USE_THRDS_FOR_SENDFILE) { SET_BLOCKING(d->c.sendfile.out_fd); } diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index 349ab0e17b..be1faa13f5 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -67,6 +67,11 @@ #define FILENAMES_16BIT 1 #endif +// We use sendfilev if it exist on solaris +#if !defined(HAVE_SENDFILE) && defined(HAVE_SENDFILEV) +#define HAVE_SENDFILE +#endif + /* * An handle to an open directory. To be cast to the correct type * in the system-dependent directory functions. @@ -85,14 +90,15 @@ typedef struct _Efile_error { /* * This structure contains date and time. */ -typedef struct _Efile_time { - unsigned year; /* (4 digits). */ - unsigned month; /* (1..12). */ - unsigned day; /* (1..31). */ - unsigned hour; /* (0..23). */ - unsigned minute; /* (0..59). */ - unsigned second; /* (0..59). */ -} Efile_time; + +//typedef struct _Efile_time { +// unsigned year; /* (4 digits). */ +// unsigned month; /* (1..12). */ +// unsigned day; /* (1..31). */ +// unsigned hour; /* (0..23). */ +// unsigned minute; /* (0..59). */ +// unsigned second; /* (0..59). */ +//} Efile_time; /* @@ -111,9 +117,9 @@ typedef struct _Efile_info { Uint32 inode; /* Inode number. */ Uint32 uid; /* User id of owner. */ Uint32 gid; /* Group id of owner. */ - Efile_time accessTime; /* Last time the file was accessed. */ - Efile_time modifyTime; /* Last time the file was modified. */ - Efile_time cTime; /* Creation time (Windows) or last + time_t accessTime; /* Last time the file was accessed. */ + time_t modifyTime; /* Last time the file was modified. */ + time_t cTime; /* Creation time (Windows) or last * inode change (Unix). */ } Efile_info; @@ -121,7 +127,7 @@ typedef struct _Efile_info { #ifdef HAVE_SENDFILE /* - * Described the structure of header/trailers for sendfile + * Describes the structure of headers/trailers for sendfile */ struct t_sendfile_hdtl { SysIOVec *headers; diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index e0d869f328..ee5ebdf646 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -516,7 +516,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) driver_select(port, e, mode | (on?ERL_DRV_USE:0), on) #define sock_select(d, flags, onoff) do { \ - ASSERT(!onoff || !(d)->is_ignored); \ + ASSERT(!(d)->is_ignored); \ (d)->event_mask = (onoff) ? \ ((d)->event_mask | (flags)) : \ ((d)->event_mask & ~(flags)); \ @@ -539,6 +539,13 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) (((unsigned char*) (s))[1] << 8) | \ (((unsigned char*) (s))[0])) + +#ifdef VALGRIND +# include <valgrind/memcheck.h> +#else +# define VALGRIND_MAKE_MEM_DEFINED(ptr,size) +#endif + /*---------------------------------------------------------------------------- ** Interface constants. ** @@ -943,9 +950,9 @@ typedef struct { double send_avg; /* average packet size sent */ subs_list empty_out_q_subs; /* Empty out queue subscribers */ - int is_ignored; /* if a fd is ignored by from the inet_drv, - this should be set to true when the fd is used - outside of inet_drv. */ + int is_ignored; /* if a fd is ignored by the inet_drv. + This flag should be set to true when + the fd is used outside of inet_drv. */ } inet_descriptor; @@ -3809,7 +3816,13 @@ static void desc_close(inet_descriptor* desc) desc->forced_events = 0; desc->send_would_block = 0; #endif - driver_select(desc->port, (ErlDrvEvent)(long)desc->event, ERL_DRV_USE, 0); + // We should close the fd here, but the other driver might still + // be selecting on it. + if (!desc->is_ignored) + driver_select(desc->port,(ErlDrvEvent)(long)desc->event, + ERL_DRV_USE, 0); + else + inet_stop_select((ErlDrvEvent)(long)desc->event,NULL); desc->event = INVALID_EVENT; /* closed by stop_select callback */ desc->s = INVALID_SOCKET; desc->event_mask = 0; @@ -6189,7 +6202,7 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len) proto = IPPROTO_SCTP; type = SCTP_DELAYED_ACK_TIME; arg_ptr = (char*) (&arg.av); - arg_sz = sizeof ( arg.es); + arg_sz = sizeof ( arg.av); break; } # endif @@ -7725,8 +7738,8 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len, return ctl_error(EINVAL, rbuf, rsize); if (*buf == 1 && !desc->is_ignored) { - desc->is_ignored = INET_IGNORE_READ; sock_select(desc, (FD_READ|FD_WRITE|FD_CLOSE|ERL_DRV_USE_NO_CALLBACK), 0); + desc->is_ignored = INET_IGNORE_READ; } else if (*buf == 0 && desc->is_ignored) { int flags = (FD_READ|FD_CLOSE|((desc->is_ignored & INET_IGNORE_WRITE)?FD_WRITE:0)); desc->is_ignored = INET_IGNORE_NONE; @@ -8729,8 +8742,15 @@ static int tcp_remain(tcp_descriptor* desc, int* len) else if (tlen == 0) { /* need unknown more */ *len = 0; if (nsz == 0) { - if (nfill == n) - goto error; + if (nfill == n) { + if (desc->inet.psize != 0 && desc->inet.psize > nfill) { + if (tcp_expand_buffer(desc, desc->inet.psize) < 0) + return -1; + return desc->inet.psize; + } + else + goto error; + } DEBUGF((" => restart more=%d\r\n", nfill - n)); return nfill - n; } @@ -10238,6 +10258,7 @@ static void packet_inet_command(ErlDrvData e, char* buf, int len) cmsg.hdr.cmsg_level = IPPROTO_SCTP; cmsg.hdr.cmsg_type = SCTP_SNDRCV; cmsg.hdr.cmsg_len = CMSG_LEN(sizeof(*sri)); + VALGRIND_MAKE_MEM_DEFINED(&cmsg, (char*)sri - (char*)&cmsg); /*suppress padding as "uninitialised bytes"*/ data_len = (buf + len) - ptr; /* The whole msg. diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 72911641d3..9160e2aed2 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -816,7 +816,6 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, char* name, int info_for_link) { struct stat statbuf; /* Information about the file */ - struct tm *timep; /* Broken-apart filetime. */ int result; #ifdef VXWORKS @@ -883,40 +882,17 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, else pInfo->type = FT_OTHER; -#if defined(HAVE_LOCALTIME_R) || defined(VXWORKS) - { - /* Use the reentrant version of localtime() */ - static struct tm local_tm; -#define localtime(a) (localtime_r((a), &local_tm), &local_tm) -#endif - - -#define GET_TIME(dst, src) \ - timep = localtime(&statbuf.src); \ - (dst).year = timep->tm_year+1900; \ - (dst).month = timep->tm_mon+1; \ - (dst).day = timep->tm_mday; \ - (dst).hour = timep->tm_hour; \ - (dst).minute = timep->tm_min; \ - (dst).second = timep->tm_sec - - GET_TIME(pInfo->accessTime, st_atime); - GET_TIME(pInfo->modifyTime, st_mtime); - GET_TIME(pInfo->cTime, st_ctime); - -#undef GET_TIME - -#if defined(HAVE_LOCALTIME_R) || defined(VXWORKS) - } -#endif + pInfo->accessTime = statbuf.st_atime; + pInfo->modifyTime = statbuf.st_mtime; + pInfo->cTime = statbuf.st_ctime; - pInfo->mode = statbuf.st_mode; - pInfo->links = statbuf.st_nlink; + pInfo->mode = statbuf.st_mode; + pInfo->links = statbuf.st_nlink; pInfo->major_device = statbuf.st_dev; pInfo->minor_device = statbuf.st_rdev; - pInfo->inode = statbuf.st_ino; - pInfo->uid = statbuf.st_uid; - pInfo->gid = statbuf.st_gid; + pInfo->inode = statbuf.st_ino; + pInfo->uid = statbuf.st_uid; + pInfo->gid = statbuf.st_gid; return 1; } @@ -924,6 +900,8 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, int efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) { + struct utimbuf tval; + CHECK_PATHLEN(name, errInfo); #ifdef VXWORKS @@ -976,38 +954,18 @@ efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) #endif /* !VXWORKS */ - if (pInfo->accessTime.year != -1 && pInfo->modifyTime.year != -1) { - struct utimbuf tval; - struct tm timebuf; - -#define MKTIME(tb, ts) \ - timebuf.tm_year = ts.year-1900; \ - timebuf.tm_mon = ts.month-1; \ - timebuf.tm_mday = ts.day; \ - timebuf.tm_hour = ts.hour; \ - timebuf.tm_min = ts.minute; \ - timebuf.tm_sec = ts.second; \ - timebuf.tm_isdst = -1; \ - if ((tb = mktime(&timebuf)) == (time_t) -1) { \ - errno = EINVAL; \ - return check_error(-1, errInfo); \ - } + tval.actime = pInfo->accessTime; + tval.modtime = pInfo->modifyTime; - MKTIME(tval.actime, pInfo->accessTime); - MKTIME(tval.modtime, pInfo->modifyTime); -#undef MKTIME - #ifdef VXWORKS - /* VxWorks' utime doesn't work when the file is a nfs mounted - * one, don't report error if utime fails. - */ - utime(name, &tval); - return 1; + /* VxWorks' utime doesn't work when the file is a nfs mounted + * one, don't report error if utime fails. + */ + utime(name, &tval); + return 1; #else - return check_error(utime(name, &tval), errInfo); + return check_error(utime(name, &tval), errInfo); #endif - } - return 1; } @@ -1469,6 +1427,9 @@ efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, } #ifdef HAVE_SENDFILE + +// For some reason the maximum size_t cannot be used as the max size +// 3GB seems to work on all platforms #define SENDFILE_CHUNK_SIZE ((1 << 30) -1) /* @@ -1477,7 +1438,13 @@ efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, * we have to emulate some things in linux and play with variables on * bsd/darwin. * - * It could be possible to implement header/trailer in sendfile, though + * All of the calls will split a command which tries to send more than + * SENDFILE_CHUNK_SIZE of data at once. + * + * On platforms where *nbytes of 0 does not mean the entire file, this is + * simulated. + * + * It could be possible to implement header/trailer in sendfile. Though * you would have to emulate it in linux and on BSD/Darwin some complex * calculations have to be made when using a non blocking socket to figure * out how much of the header/file/trailer was sent in each command. @@ -1488,10 +1455,10 @@ efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd, off_t *offset, Uint64 *nbytes, struct t_sendfile_hdtl* hdtl) { Uint64 written = 0; -#if defined(__linux__) || (defined(__sun) && defined(__SVR4)) +#if defined(__linux__) ssize_t retval; do { - // check if *nbytes is 0 or greater than the largest size_t + // check if *nbytes is 0 or greater than chunk size if (*nbytes == 0 || *nbytes > SENDFILE_CHUNK_SIZE) retval = sendfile(out_fd, in_fd, offset, SENDFILE_CHUNK_SIZE); else @@ -1503,11 +1470,34 @@ efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd, } while (retval != -1 && retval == SENDFILE_CHUNK_SIZE); *nbytes = written; return check_error(retval == -1 ? -1 : 0, errInfo); +#elif defined(__sun) && defined(__SVR4) && defined(HAVE_SENDFILEV) + ssize_t retval; + size_t len; + sendfilevec_t fdrec; + fdrec.sfv_fd = in_fd; + fdrec.sfv_flag = 0; + do { + fdrec.sfv_off = *offset; + len = 0; + // check if *nbytes is 0 or greater than chunk size + if (*nbytes == 0 || *nbytes > SENDFILE_CHUNK_SIZE) + fdrec.sfv_len = SENDFILE_CHUNK_SIZE; + else + fdrec.sfv_len = *nbytes; + retval = sendfilev(out_fd, &fdrec, 1, &len); + if (retval != -1 || errno == EAGAIN || errno == EINTR) { + *offset += len; + *nbytes -= len; + written += len; + } + } while (len == SENDFILE_CHUNK_SIZE); + *nbytes = written; + return check_error(retval == -1 ? -1 : 0, errInfo); #elif defined(DARWIN) int retval; off_t len; do { - // check if *nbytes is 0 or greater than the largest off_t + // check if *nbytes is 0 or greater than chunk size if(*nbytes > SENDFILE_CHUNK_SIZE) len = SENDFILE_CHUNK_SIZE; else diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 0bc701c4cb..0d3d334154 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -45,6 +45,26 @@ #define INVALID_FILE_ATTRIBUTES ((DWORD) 0xFFFFFFFF) #endif +#define TICKS_PER_SECOND (10000000ULL) +#define EPOCH_DIFFERENCE (11644473600LL) + +#define FILETIME_TO_EPOCH(epoch, ft) \ + do { \ + ULARGE_INTEGER ull; \ + ull.LowPart = (ft).dwLowDateTime; \ + ull.HighPart = (ft).dwHighDateTime; \ + (epoch) = ((ull.QuadPart / TICKS_PER_SECOND) - EPOCH_DIFFERENCE); \ + } while(0) + +#define EPOCH_TO_FILETIME(ft, epoch) \ + do { \ + ULARGE_INTEGER ull; \ + ull.QuadPart = (((epoch) + EPOCH_DIFFERENCE) * TICKS_PER_SECOND); \ + (ft).dwLowDateTime = ull.LowPart; \ + (ft).dwHighDateTime = ull.HighPart; \ + } while(0) + + static int check_error(int result, Efile_error* errInfo); static int set_error(Efile_error* errInfo); static int is_root_unc_name(const WCHAR *path); @@ -864,14 +884,7 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, findbuf.cFileName[0] = L'\0'; pInfo->links = 1; - pInfo->modifyTime.year = 1980; - pInfo->modifyTime.month = 1; - pInfo->modifyTime.day = 1; - pInfo->modifyTime.hour = 0; - pInfo->modifyTime.minute = 0; - pInfo->modifyTime.second = 0; - - pInfo->accessTime = pInfo->modifyTime; + pInfo->cTime = pInfo->accessTime = pInfo->modifyTime = 0; } else { SYSTEMTIME SystemTime; FILETIME LocalFTime; @@ -905,34 +918,21 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, } } -#define GET_TIME(dst, src) \ -if (!FileTimeToLocalFileTime(&findbuf.src, &LocalFTime) || \ - !FileTimeToSystemTime(&LocalFTime, &SystemTime)) { \ - return set_error(errInfo); \ -} \ -(dst).year = SystemTime.wYear; \ -(dst).month = SystemTime.wMonth; \ -(dst).day = SystemTime.wDay; \ -(dst).hour = SystemTime.wHour; \ -(dst).minute = SystemTime.wMinute; \ -(dst).second = SystemTime.wSecond; - - GET_TIME(pInfo->modifyTime, ftLastWriteTime); + FILETIME_TO_EPOCH(pInfo->modifyTime, findbuf.ftLastWriteTime); if (findbuf.ftLastAccessTime.dwLowDateTime == 0 && findbuf.ftLastAccessTime.dwHighDateTime == 0) { pInfo->accessTime = pInfo->modifyTime; } else { - GET_TIME(pInfo->accessTime, ftLastAccessTime); + FILETIME_TO_EPOCH(pInfo->accessTime, findbuf.ftLastAccessTime); } if (findbuf.ftCreationTime.dwLowDateTime == 0 && findbuf.ftCreationTime.dwHighDateTime == 0) { pInfo->cTime = pInfo->modifyTime; } else { - GET_TIME(pInfo->cTime, ftCreationTime); + FILETIME_TO_EPOCH(pInfo->cTime ,findbuf.ftCreationTime); } -#undef GET_TIME FindClose(findhandle); } @@ -968,17 +968,12 @@ efile_write_info(Efile_error* errInfo, char* name) { SYSTEMTIME timebuf; - FILETIME LocalFileTime; FILETIME ModifyFileTime; FILETIME AccessFileTime; FILETIME CreationFileTime; HANDLE fd; - FILETIME* mtime = NULL; - FILETIME* atime = NULL; - FILETIME* ctime = NULL; DWORD attr; DWORD tempAttr; - BOOL modifyTime = FALSE; WCHAR *wname = (WCHAR *) name; /* @@ -1003,57 +998,36 @@ efile_write_info(Efile_error* errInfo, * Construct all file times. */ -#define MKTIME(tb, ts, ptr) \ - timebuf.wYear = ts.year; \ - timebuf.wMonth = ts.month; \ - timebuf.wDay = ts.day; \ - timebuf.wHour = ts.hour; \ - timebuf.wMinute = ts.minute; \ - timebuf.wSecond = ts.second; \ - timebuf.wMilliseconds = 0; \ - if (ts.year != -1) { \ - modifyTime = TRUE; \ - ptr = &tb; \ - if (!SystemTimeToFileTime(&timebuf, &LocalFileTime ) || \ - !LocalFileTimeToFileTime(&LocalFileTime, &tb)) { \ - errno = EINVAL; \ - return check_error(-1, errInfo); \ - } \ - } - - MKTIME(ModifyFileTime, pInfo->modifyTime, mtime); - MKTIME(AccessFileTime, pInfo->accessTime, atime); - MKTIME(CreationFileTime, pInfo->cTime, ctime); -#undef MKTIME + EPOCH_TO_FILETIME(ModifyFileTime, pInfo->modifyTime); + EPOCH_TO_FILETIME(AccessFileTime, pInfo->accessTime); + EPOCH_TO_FILETIME(CreationFileTime, pInfo->cTime); /* * If necessary, set the file times. */ - if (modifyTime) { - /* - * If the has read only access, we must temporarily turn on - * write access (this is necessary for native filesystems, - * but not for NFS filesystems). - */ + /* + * If the has read only access, we must temporarily turn on + * write access (this is necessary for native filesystems, + * but not for NFS filesystems). + */ - if (tempAttr & FILE_ATTRIBUTE_READONLY) { - tempAttr &= ~FILE_ATTRIBUTE_READONLY; - if (!SetFileAttributesW(wname, tempAttr)) { - return set_error(errInfo); - } + if (tempAttr & FILE_ATTRIBUTE_READONLY) { + tempAttr &= ~FILE_ATTRIBUTE_READONLY; + if (!SetFileAttributesW(wname, tempAttr)) { + return set_error(errInfo); } + } - fd = CreateFileW(wname, GENERIC_READ|GENERIC_WRITE, - FILE_SHARE_READ | FILE_SHARE_WRITE, - NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); - if (fd != INVALID_HANDLE_VALUE) { - BOOL result = SetFileTime(fd, ctime, atime, mtime); - if (!result) { - return set_error(errInfo); - } - CloseHandle(fd); + fd = CreateFileW(wname, GENERIC_READ|GENERIC_WRITE, + FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + if (fd != INVALID_HANDLE_VALUE) { + BOOL result = SetFileTime(fd, &CreationFileTime, &AccessFileTime, &ModifyFileTime); + if (!result) { + return set_error(errInfo); } + CloseHandle(fd); } /* diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 4d75883fc5..6a3ce5608f 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -337,14 +337,22 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * stack: to this end hipe_${ARCH}_glue.S stores the BIF's * arity in p->hipe.narity. * - * If the BIF emptied the stack (typically hibernate), p->hipe.nsp is - * NULL and there is no need to get rid of stacked parameters. + * If the BIF emptied the stack (typically hibernate), p->hipe.nstack + * is NULL and there is no need to get rid of stacked parameters. */ unsigned int i, is_recursive = 0; - if (p->hipe.nsp != NULL) { + if (p->hipe.nstack != NULL) { + ASSERT(p->hipe.nsp != NULL); is_recursive = hipe_trap_from_native_is_recursive(p); } + else { + /* Some architectures (risc) need this re-reset of nsp as the + * BIF wrapper do not detect stack change and causes an obsolete + * stack pointer to be saved in p->hipe.nsp before return to us. + */ + p->hipe.nsp = NULL; + } /* Schedule next process if current process was hibernated or is waiting for messages */ diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 2005450c36..23a4bf1b04 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -1134,7 +1134,8 @@ ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set) } void -ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set, long msec) +ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set, + erts_short_time_t msec) { ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, msec); } diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index 7cc1658062..edab7947ba 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -46,8 +46,8 @@ void erts_check_io_async_sig_interrupt_nkp(void); #endif void erts_check_io_interrupt_kp(int); void erts_check_io_interrupt_nkp(int); -void erts_check_io_interrupt_timed_kp(int, long); -void erts_check_io_interrupt_timed_nkp(int, long); +void erts_check_io_interrupt_timed_kp(int, erts_short_time_t); +void erts_check_io_interrupt_timed_nkp(int, erts_short_time_t); void erts_check_io_kp(int); void erts_check_io_nkp(int); void erts_init_check_io_kp(void); @@ -64,7 +64,7 @@ int erts_check_io_max_files(void); void erts_check_io_async_sig_interrupt(void); #endif void erts_check_io_interrupt(int); -void erts_check_io_interrupt_timed(int, long); +void erts_check_io_interrupt_timed(int, erts_short_time_t); void erts_check_io(int); void erts_init_check_io(void); diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 80db2055a2..b6cb271f17 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -2171,7 +2171,7 @@ ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet ps) void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, int set, - long msec) + erts_short_time_t msec) { #if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) if (!set) diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index e0296c6a33..8dde619105 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -223,7 +223,7 @@ void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet, int); void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet, int, - long); + erts_short_time_t); ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet, ErtsSysFdType, ErtsPollEvents, diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 9a5ed9f5bc..c8fcec8547 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -146,6 +146,7 @@ typedef void *GETENV_STATE; /* ** For the erl_timer_sup module. */ +typedef time_t erts_time_t; typedef struct timeval SysTimeval; diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index c6b63350e5..52477467b3 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -265,7 +265,7 @@ struct { int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData); void (*check_io_as_interrupt)(void); void (*check_io_interrupt)(int); - void (*check_io_interrupt_tmd)(int, long); + void (*check_io_interrupt_tmd)(int, erts_short_time_t); void (*check_io)(int); Uint (*size)(void); Eterm (*info)(void *); @@ -371,7 +371,7 @@ erts_sys_schedule_interrupt(int set) #ifdef ERTS_SMP void -erts_sys_schedule_interrupt_timed(int set, long msec) +erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec) { ERTS_CHK_IO_INTR_TMD(set, msec); } diff --git a/erts/emulator/sys/vxworks/erl_vxworks_sys.h b/erts/emulator/sys/vxworks/erl_vxworks_sys.h index ae46403600..69d9ca3478 100644 --- a/erts/emulator/sys/vxworks/erl_vxworks_sys.h +++ b/erts/emulator/sys/vxworks/erl_vxworks_sys.h @@ -158,6 +158,7 @@ typedef struct _vxworks_tms { typedef long long SysHrTime; +typedef time_t erts_time_t; typedef struct timeval SysTimeval; extern int sys_init_hrtime(void); diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index ab4ef05118..7a1d129cd5 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -442,8 +442,8 @@ poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp) if (erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN) return (DWORD) 0; - if (timeout > ERTS_AINT32_T_MAX) /* Also prevents DWORD overflow */ - timeout = ERTS_AINT32_T_MAX; + if (timeout > ((time_t) ERTS_AINT32_T_MAX)) + timeout = ERTS_AINT32_T_MAX; /* Also prevents DWORD overflow */ erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); return (DWORD) timeout; @@ -1012,7 +1012,7 @@ void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */) void erts_poll_interrupt_timed(ErtsPollSet ps, int set /* bool */, - long msec) + erts_short_time_t msec) { HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,msec)); if (!set) diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index d770691026..e8453205ea 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -117,9 +117,30 @@ int erts_check_io_debug(void); #define SYS_CLK_TCK 1000 #define SYS_CLOCK_RESOLUTION 1 +#if SIZEOF_TIME_T != 8 +# error "Unexpected sizeof(time_t)" +#endif + +/* + * gcc uses a 4 byte time_t and vc++ uses an 8 byte time_t. + * Types seen in beam_emu.c *need* to have the same size + * as in the rest of the system... + */ +typedef __int64 erts_time_t; + +struct tm *sys_localtime_r(time_t *epochs, struct tm *ptm); +struct tm *sys_gmtime_r(time_t *epochs, struct tm *ptm); +time_t sys_mktime( struct tm *ptm); + +#define localtime_r sys_localtime_r +#define HAVE_LOCALTIME_R 1 +#define gmtime_r sys_gmtime_r +#define HAVE_GMTIME_R +#define mktime sys_mktime + typedef struct { - long tv_sec; - long tv_usec; + erts_time_t tv_sec; + erts_time_t tv_usec; } SysTimeval; typedef struct { diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index a49fa8ca34..a701747b78 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -3290,7 +3290,7 @@ erts_sys_schedule_interrupt(int set) #ifdef ERTS_SMP void -erts_sys_schedule_interrupt_timed(int set, long msec) +erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec) { erts_check_io_interrupt_timed(set, msec); } diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index fc868507cb..6362c1a06d 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -35,28 +35,336 @@ /******************* Routines for time measurement *********************/ #define EPOCH_JULIAN_DIFF LL_LITERAL(11644473600) +#define TICKS_PER_SECOND LL_LITERAL(10000000) +#define SECONDS_PER_DAY LL_LITERAL(86400) +#define ULI_TO_FILETIME(ft,ull) \ + do { \ + (ft).dwLowDateTime = (ull).LowPart; \ + (ft).dwHighDateTime = (ull).HighPart; \ + } while (0) + +#define FILETIME_TO_ULI(ull,ft) \ + do { \ + (ull).LowPart = (ft).dwLowDateTime; \ + (ull).HighPart = (ft).dwHighDateTime; \ + } while (0) + + +#define EPOCH_TO_FILETIME(ft, epoch) \ + do { \ + ULARGE_INTEGER ull; \ + ull.QuadPart = (((epoch) + EPOCH_JULIAN_DIFF) * TICKS_PER_SECOND); \ + ULI_TO_FILETIME(ft,ull); \ + } while(0) + +#define FILETIME_TO_EPOCH(epoch, ft) \ + do { \ + ULARGE_INTEGER ull; \ + FILETIME_TO_ULI(ull,ft); \ + (epoch) = ((ull.QuadPart / TICKS_PER_SECOND) - EPOCH_JULIAN_DIFF); \ + } while(0) + static SysHrTime wrap = 0; static DWORD last_tick_count = 0; +/* Getting timezone information is a heavy operation, so we want to do this + only once */ + +static TIME_ZONE_INFORMATION static_tzi; +static int have_static_tzi = 0; + +static int days_in_month[2][13] = { + {0,31,28,31,30,31,30,31,31,30,31,30,31}, + {0,31,29,31,30,31,30,31,31,30,31,30,31}}; + int sys_init_time(void) { + if(GetTimeZoneInformation(&static_tzi) && + static_tzi.StandardDate.wMonth != 0 && + static_tzi.DaylightDate.wMonth != 0) { + have_static_tzi = 1; + } return 1; } +/* Returns a switchtimes for DST as UTC filetimes given data from a + TIME_ZONE_INFORMATION, see sys_localtime_r for usage. */ +static void +get_dst_switchtime(DWORD year, + SYSTEMTIME dstinfo, LONG bias, + FILETIME *utc_switchtime) +{ + DWORD occu; + DWORD weekday,wday_1st; + DWORD day, days_in; + FILETIME tmp,tmp2; + ULARGE_INTEGER ull; + int leap_year = 0; + if (dstinfo.wYear != 0) { + /* A year specific transition, in which case the data in the structure + is already properly set for a specific year. Compare year + with parameter and see if they correspond, in that case generate a + filetime directly, otherwise set the filetime to 0 */ + if (year != dstinfo.wYear) { + utc_switchtime->dwLowDateTime = utc_switchtime->dwHighDateTime = 0; + return; + } + } else { + occu = dstinfo.wDay; + weekday = dstinfo.wDayOfWeek; + + dstinfo.wDayOfWeek = 0; + dstinfo.wDay = 1; + dstinfo.wYear = year; + + SystemTimeToFileTime(&dstinfo,&tmp); + ull.LowPart = tmp.dwLowDateTime; + ull.HighPart = tmp.dwHighDateTime; + + ull.QuadPart /= (TICKS_PER_SECOND*SECONDS_PER_DAY); /* Julian Day */ + wday_1st = (DWORD) ((ull.QuadPart + LL_LITERAL(1)) % LL_LITERAL(7)); + day = (weekday >= wday_1st) ? + weekday - wday_1st + 1 : + weekday - wday_1st + 8; + --occu; + if (((dstinfo.wYear % 4) == 0 && (dstinfo.wYear % 100) > 0) || + ((dstinfo.wYear % 400) == 0)) { + leap_year = 1; + } + days_in = days_in_month[leap_year][dstinfo.wMonth]; + while (occu > 0 && (day + 7 <= days_in)) { + --occu; + day += 7; + } + dstinfo.wDay = day; + } + SystemTimeToFileTime(&dstinfo,&tmp); + /* correct for bias */ + ull.LowPart = tmp.dwLowDateTime; + ull.HighPart = tmp.dwHighDateTime; + ull.QuadPart += (((LONGLONG) bias) * LL_LITERAL(60) * TICKS_PER_SECOND); + utc_switchtime->dwLowDateTime = ull.LowPart; + utc_switchtime->dwHighDateTime = ull.HighPart; + return; +} + +/* This function gives approximately the correct year from a FILETIME + Around the actual new year, it may return the wrong value, but that's OK + as DST never switches around new year. */ +static DWORD +approx_year(FILETIME ft) +{ + ULARGE_INTEGER ull; + FILETIME_TO_ULI(ull,ft); + ull.QuadPart /= LL_LITERAL(1000); + ull.QuadPart /= SECONDS_PER_DAY; + ull.QuadPart /= LL_LITERAL(3652425); + ull.QuadPart += 1601; + return (DWORD) ull.QuadPart; +} + +struct tm * +sys_localtime_r(time_t *epochs, struct tm *ptm) +{ + FILETIME ft,lft; + SYSTEMTIME st; + + if ((((*epochs) + EPOCH_JULIAN_DIFF) * TICKS_PER_SECOND) < 0LL) { + fprintf(stderr,"1\r\n"); fflush(stderr); + return NULL; + } + + EPOCH_TO_FILETIME(ft,*epochs); + ptm->tm_isdst = 0; + if (have_static_tzi) { + FILETIME dst_start, dst_stop; + ULARGE_INTEGER ull; + DWORD year = approx_year(ft); + get_dst_switchtime(year,static_tzi.DaylightDate, + static_tzi.Bias+static_tzi.StandardBias,&dst_start); + get_dst_switchtime(year,static_tzi.StandardDate, + static_tzi.Bias+static_tzi.StandardBias+ + static_tzi.DaylightBias, + &dst_stop); + FILETIME_TO_ULI(ull,ft); + + if (CompareFileTime(&ft,&dst_start) >= 0 && + CompareFileTime(&ft,&dst_stop) < 0) { + ull.QuadPart -= + ((LONGLONG) static_tzi.Bias+static_tzi.StandardBias+ + static_tzi.DaylightBias) * + LL_LITERAL(60) * TICKS_PER_SECOND; + ptm->tm_isdst = 1; + } else { + ull.QuadPart -= + ((LONGLONG) static_tzi.Bias+static_tzi.StandardBias) + * LL_LITERAL(60) * TICKS_PER_SECOND; + } + ULI_TO_FILETIME(ft,ull); + } else { + if (!FileTimeToLocalFileTime(&ft,&lft)) { + return NULL; + } + ft = lft; + } + + if (!FileTimeToSystemTime(&ft,&st)) { + return NULL; + } + + ptm->tm_year = (int) st.wYear - 1900; + ptm->tm_mon = (int) st.wMonth - 1; + ptm->tm_mday = (int) st.wDay; + ptm->tm_hour = (int) st.wHour; + ptm->tm_min = (int) st.wMinute; + ptm->tm_sec = (int) st.wSecond; + ptm->tm_wday = (int) st.wDayOfWeek; + { + int yday = ptm->tm_mday - 1; + int m = ptm->tm_mon; + int leap_year = 0; + if (((st.wYear % 4) == 0 && (st.wYear % 100) > 0) || + ((st.wYear % 400) == 0)) { + leap_year = 1; + } + while (m > 0) { + yday +=days_in_month[leap_year][m]; + --m; + } + ptm->tm_yday = yday; + } + return ptm; +} + +struct tm * +sys_gmtime_r(time_t *epochs, struct tm *ptm) +{ + FILETIME ft; + SYSTEMTIME st; + + if ((((*epochs) + EPOCH_JULIAN_DIFF) * TICKS_PER_SECOND) < 0LL) { + return NULL; + } + + EPOCH_TO_FILETIME(ft,*epochs); + + if (!FileTimeToSystemTime(&ft,&st)) { + return NULL; + } + + ptm->tm_year = (int) st.wYear - 1900; + ptm->tm_mon = (int) st.wMonth - 1; + ptm->tm_mday = (int) st.wDay; + ptm->tm_hour = (int) st.wHour; + ptm->tm_min = (int) st.wMinute; + ptm->tm_sec = (int) st.wSecond; + ptm->tm_wday = (int) st.wDayOfWeek; + ptm->tm_isdst = 0; + { + int yday = ptm->tm_mday - 1; + int m = ptm->tm_mon; + int leap_year = 0; + if (((st.wYear % 4) == 0 && (st.wYear % 100) > 0) || + ((st.wYear % 400) == 0)) { + leap_year = 1; + } + while (m > 0) { + yday +=days_in_month[leap_year][m]; + --m; + } + ptm->tm_yday = yday; + } + + return ptm; +} + +time_t +sys_mktime(struct tm *ptm) +{ + FILETIME ft; + SYSTEMTIME st; + int dst = 0; + time_t epochs; + + memset(&st,0,sizeof(st)); + /* Convert relevant parts of truct tm to SYSTEMTIME */ + st.wYear = (USHORT) (ptm->tm_year + 1900); + st.wMonth = (USHORT) (ptm->tm_mon + 1); + st.wDay = (USHORT) ptm->tm_mday; + st.wHour = (USHORT) ptm->tm_hour; + st.wMinute = (USHORT) ptm->tm_min; + st.wSecond = (USHORT) ptm->tm_sec; + + SystemTimeToFileTime(&st,&ft); + + /* ft is now some kind of local file time, but it may be wrong depending + on what is in the tm_dst field. We need to manually convert it to + UTC before turning it into epochs */ + + if (have_static_tzi) { + FILETIME dst_start, dst_stop; + ULARGE_INTEGER ull_start,ull_stop,ull_ft; + + FILETIME_TO_ULI(ull_ft,ft); + + /* Correct everything except DST */ + ull_ft.QuadPart += (static_tzi.Bias+static_tzi.StandardBias) + * LL_LITERAL(60) * TICKS_PER_SECOND; + + /* Determine if DST is active */ + if (ptm->tm_isdst >= 0) { + dst = ptm->tm_isdst; + } else if (static_tzi.DaylightDate.wMonth != 0){ + /* This is how windows mktime does it, meaning it does not + take nonexisting local times into account */ + get_dst_switchtime(st.wYear,static_tzi.DaylightDate, + static_tzi.Bias+static_tzi.StandardBias, + &dst_start); + get_dst_switchtime(st.wYear,static_tzi.StandardDate, + static_tzi.Bias+static_tzi.StandardBias+ + static_tzi.DaylightBias, + &dst_stop); + FILETIME_TO_ULI(ull_start,dst_start); + FILETIME_TO_ULI(ull_stop,dst_stop); + if ((ull_ft.QuadPart >= ull_start.QuadPart) && + (ull_ft.QuadPart < ull_stop.QuadPart)) { + /* We are in DST */ + dst = 1; + } + } + /* Correct for DST */ + if (dst) { + ull_ft.QuadPart += static_tzi.DaylightBias * + LL_LITERAL(60) * TICKS_PER_SECOND; + } + epochs = ((ull_ft.QuadPart / TICKS_PER_SECOND) - EPOCH_JULIAN_DIFF); + } else { + /* No DST, life is easy... */ + FILETIME lft; + LocalFileTimeToFileTime(&ft,&lft); + FILETIME_TO_EPOCH(epochs,lft); + } + /* Normalize the struct tm */ + sys_localtime_r(&epochs,ptm); + return epochs; +} + void sys_gettimeofday(SysTimeval *tv) { SYSTEMTIME t; FILETIME ft; - LONGLONG lft; + ULARGE_INTEGER ull; GetSystemTime(&t); SystemTimeToFileTime(&t, &ft); - memcpy(&lft, &ft, sizeof(lft)); - tv->tv_usec = (long) ((lft / LL_LITERAL(10)) % LL_LITERAL(1000000)); - tv->tv_sec = (long) ((lft / LL_LITERAL(10000000)) - EPOCH_JULIAN_DIFF); + FILETIME_TO_ULI(ull,ft); + tv->tv_usec = (long) ((ull.QuadPart / LL_LITERAL(10)) % + LL_LITERAL(1000000)); + tv->tv_sec = (long) ((ull.QuadPart / LL_LITERAL(10000000)) - + EPOCH_JULIAN_DIFF); } SysHrTime @@ -91,9 +399,3 @@ sys_times(SysTimes *buffer) { buffer->tms_stime = (clock_t) (system & LL_LITERAL(0x7FFFFFFF)); return kernel_ticks; } - - - - - - diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 2f9b01cc92..25ce94096f 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -20,7 +20,7 @@ -module(code_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - new_binary_types/1, + versions/1,new_binary_types/1, t_check_process_code/1,t_check_old_code/1, t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, @@ -33,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [new_binary_types, t_check_process_code, + [versions, new_binary_types, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, constant_pools, constant_refc_binaries, false_dependency, @@ -56,6 +56,60 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +%% Make sure that only two versions of a module can be loaded. +versions(Config) when is_list(Config) -> + V1 = compile_version(1, Config), + V2 = compile_version(2, Config), + V3 = compile_version(3, Config), + + {ok,P1,1} = load_version(V1, 1), + {ok,P2,2} = load_version(V2, 2), + {error,not_purged} = load_version(V2, 2), + {error,not_purged} = load_version(V3, 3), + + 1 = check_version(P1), + 2 = check_version(P2), + 2 = versions:version(), + + %% Kill processes, unload code. + P1 ! P2 ! done, + _ = monitor(process, P1), + _ = monitor(process, P2), + receive + {'DOWN',_,process,P1,normal} -> ok + end, + receive + {'DOWN',_,process,P2,normal} -> ok + end, + true = erlang:purge_module(versions), + true = erlang:delete_module(versions), + true = erlang:purge_module(versions), + ok. + +compile_version(Version, Config) -> + Data = ?config(data_dir, Config), + File = filename:join(Data, "versions"), + {ok,versions,Bin} = compile:file(File, [{d,'VERSION',Version}, + binary,report]), + Bin. + +load_version(Code, Ver) -> + case erlang:load_module(versions, Code) of + {module,versions} -> + Pid = spawn_link(versions, loop, []), + Ver = versions:version(), + Ver = check_version(Pid), + {ok,Pid,Ver}; + Error -> + Error + end. + +check_version(Pid) -> + Pid ! {self(),version}, + receive + {Pid,version,Version} -> + Version + end. new_binary_types(Config) when is_list(Config) -> ?line Data = ?config(data_dir, Config), diff --git a/erts/emulator/test/code_SUITE_data/versions.erl b/erts/emulator/test/code_SUITE_data/versions.erl new file mode 100644 index 0000000000..7a6fd8847d --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/versions.erl @@ -0,0 +1,33 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(versions). +-export([loop/0,version/0]). + +loop() -> + receive + {Pid,version} -> + Pid ! {self(),version,version()}, + loop(); + done -> + ok + end. + +version() -> + ?VERSION. diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index c0499554eb..4acbe8c6e0 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -26,12 +26,14 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1]). + basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1, + otp_9389/1, otp_9389_line/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [basic, packet_size, neg, http, line, ssl, otp_8536]. + [basic, packet_size, neg, http, line, ssl, otp_8536, + otp_9389, otp_9389_line]. groups() -> []. @@ -251,6 +253,28 @@ packet_size(Config) when is_list(Config) -> ?line {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>) end, lists:seq(-10,-1)), + + %% Test OTP-9389, long HTTP header lines. + Opts = [{packet_size, 128}], + Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", + string:chars($Y, 64), "\r\n\r\n"]), + <<Pkt1:50/binary, Pkt2/binary>> = Pkt, + ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = + erlang:decode_packet(http, Pkt1, Opts), + ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = + erlang:decode_packet(httph, Rest1, Opts), + ?line {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), + ?line {ok, {http_header,_,"Link",_,_}, _} = + erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), + + Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", + string:chars($Y, 129), "\r\n\r\n"]), + ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = + erlang:decode_packet(http, Pkt3, Opts), + ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = + erlang:decode_packet(httph, Rest3, Opts), + ?line {error, invalid} = erlang:decode_packet(httph, Rest4, Opts), + ok. @@ -557,3 +581,35 @@ decode_pkt(Type,Bin,Opts) -> %%io:format(" -> ~p\n",[Res]), Res. +otp_9389(doc) -> ["Verify line_length works correctly for HTTP headers"]; +otp_9389(suite) -> []; +otp_9389(Config) when is_list(Config) -> + Opts = [{packet_size, 16384}, {line_length, 3000}], + Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", + string:chars($X, 8192), + "\r\nContent-Length: 0\r\n\r\n"]), + <<Pkt1:5000/binary, Pkt2/binary>> = Pkt, + {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = + erlang:decode_packet(http, Pkt1, Opts), + {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = + erlang:decode_packet(httph, Rest1, Opts), + {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), + {ok, {http_header,_,"Link",_,Link}, Rest3} = + erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), + true = (length(Link) > 8000), + {ok, {http_header,_,'Content-Length',_,"0"}, <<"\r\n">>} = + erlang:decode_packet(httph, Rest3, Opts), + ok. + +otp_9389_line(doc) -> ["Verify packet_size works correctly for line mode"]; +otp_9389_line(suite) -> []; +otp_9389_line(Config) when is_list(Config) -> + Opts = [{packet_size, 20}], + Line1 = <<"0123456789012345678\n">>, + Line2 = <<"0123456789\n">>, + Line3 = <<"01234567890123456789\n">>, + Pkt = list_to_binary([Line1, Line2, Line3]), + ?line {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts), + ?line {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts), + ?line {error, invalid} = erlang:decode_packet(line, Rest2, Opts), + ok. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index c07dbc5871..d64ec2e97b 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1796,7 +1796,7 @@ driver_select_use0(Config) -> thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> case {erlang:system_info(threads), - mseg_inst_info(0), + erlang:system_info({allocator,mseg_alloc}), driver_alloc_sbct()} of {_, false, _} -> ?line {skipped, "No mseg_alloc"}; @@ -2185,6 +2185,14 @@ wait_deallocations() -> end. driver_alloc_size() -> + case erlang:system_info(smp_support) of + true -> + ok; + false -> + %% driver_alloc also used by elements in lock-free queues, + %% give these some time to be deallocated... + receive after 100 -> ok end + end, wait_deallocations(), case erlang:system_info({allocator_sizes, driver_alloc}) of false -> diff --git a/erts/emulator/test/driver_SUITE_data/monitor_drv.c b/erts/emulator/test/driver_SUITE_data/monitor_drv.c index 1da6a56a72..ffb6ae9085 100644 --- a/erts/emulator/test/driver_SUITE_data/monitor_drv.c +++ b/erts/emulator/test/driver_SUITE_data/monitor_drv.c @@ -21,6 +21,7 @@ #include "erl_driver.h" static ErlDrvData monitor_drv_start(ErlDrvPort, char *); +static void monitor_drv_stop(ErlDrvData data); static int monitor_drv_control(ErlDrvData, unsigned int, char *, int, char **, int); static void handle_monitor(ErlDrvData drv_data, ErlDrvMonitor *monitor); @@ -50,7 +51,7 @@ typedef struct { static ErlDrvEntry monitor_drv_entry = { NULL /* init */, monitor_drv_start, - NULL /* stop */, + monitor_drv_stop, NULL /* output */, NULL /* ready_input */, NULL /* ready_output */, diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c index 622a62ebea..40637c946c 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c @@ -175,7 +175,7 @@ fail: driver_free(ttd[t].blocks[b]); } } - + driver_free(td); return ERL_DRV_ERROR_GENERAL; } diff --git a/erts/emulator/test/driver_SUITE_data/timer_drv.c b/erts/emulator/test/driver_SUITE_data/timer_drv.c index b96a95dd4c..3ea37fa079 100644 --- a/erts/emulator/test/driver_SUITE_data/timer_drv.c +++ b/erts/emulator/test/driver_SUITE_data/timer_drv.c @@ -22,7 +22,9 @@ static ErlDrvPort erlang_port; static ErlDrvData timer_start(ErlDrvPort, char*); -static void timer_stop(ErlDrvData), timer_read(ErlDrvData, char*, int), timer(ErlDrvData); +static void timer_stop(ErlDrvData); +static void timer_read(ErlDrvData, char*, int); +static void timer(ErlDrvData); static ErlDrvEntry timer_driver_entry = { diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index 879d2f61dd..024c3456a8 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -122,7 +122,7 @@ long_rwlock(Config) when is_list(Config) -> %% A very short run time is expected, since %% threads in the test mostly wait ?t:format("RunTime=~p~n", [RunTime]), - ?line true = RunTime < 100, + ?line true = RunTime < 400, ?line RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.", case LLRes of ok -> @@ -281,7 +281,7 @@ hammer_sched_rwlock_test(FreqRead, LockCheck, Blocking, WaitLocked, WaitUnlocked _ -> {_, RunTime} = statistics(runtime), ?t:format("RunTime=~p~n", [RunTime]), - ?line true = RunTime < 500, + ?line true = RunTime < 700, {comment, "Run-time during test was " ++ integer_to_list(RunTime) diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index debb54579b..8931562828 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -55,7 +55,7 @@ scheduler_suspend/1, reader_groups/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(10)). +-define(DEFAULT_TIMEOUT, ?t:minutes(15)). -define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)). @@ -519,16 +519,18 @@ bound_loop(NS, N, M, Sched) -> bindings(Node, BindType) -> Parent = self(), Ref = make_ref(), - spawn_link(Node, - fun () -> - enable_internal_state(), - Res = (catch erts_debug:get_internal_state( - {fake_scheduler_bindings, BindType})), - Parent ! {Ref, Res} - end), + Pid = spawn_link(Node, + fun () -> + enable_internal_state(), + Res = (catch erts_debug:get_internal_state( + {fake_scheduler_bindings, + BindType})), + Parent ! {Ref, Res} + end), receive {Ref, Res} -> ?t:format("~p: ~p~n", [BindType, Res]), + unlink(Pid), Res end. @@ -1684,7 +1686,7 @@ do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) -> EndWait = now(), BalanceWait = timer:now_diff(EndWait,StartWait) div 1000, erlang:display({balance_wait, BalanceWait}), - Timeout = ?DEFAULT_TIMEOUT - ?t:seconds(10) - BalanceWait, + Timeout = ?DEFAULT_TIMEOUT - ?t:minutes(4) - BalanceWait, Res = case Timeout < ?MIN_SCHEDULER_TEST_TIMEOUT of true -> stop_work(Low, Normal, High, Max), diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index 634df367ca..e073eab596 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -160,8 +160,7 @@ recv_trace(Config) when is_list(Config) -> ?line {messages,Messages} = process_info(Tracer, messages), [{trace,Parent,'receive',a}, {trace,Parent,'receive',{trace_delivered,_,_}}, - {trace,Parent,'receive',c}, - {trace,Parent,'receive',{trace_delivered,_,_}}] = Messages, + {trace,Parent,'receive',c}|_] = Messages, ?line unlink(Tracer), exit(Tracer, kill), ?line unlink(Sender), exit(Sender, kill), diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index bd48a0a7db..4d12e3449c 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -32,6 +32,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, univ_to_local/1, local_to_univ/1, bad_univ_to_local/1, bad_local_to_univ/1, + univ_to_seconds/1, seconds_to_univ/1, consistency/1, now_unique/1, now_update/1, timestamp/1]). @@ -59,7 +60,9 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [univ_to_local, local_to_univ, local_to_univ_utc, - bad_univ_to_local, bad_local_to_univ, consistency, + bad_univ_to_local, bad_local_to_univ, + univ_to_seconds, seconds_to_univ, + consistency, {group, now}, timestamp]. groups() -> @@ -162,6 +165,30 @@ bad_test_local_to_univ([Local|Rest]) -> bad_test_local_to_univ([]) -> ok. + +%% Test universaltime to seconds conversions +univ_to_seconds(Config) when is_list(Config) -> + test_univ_to_seconds(ok_utc_seconds()). + +test_univ_to_seconds([{Datetime, Seconds}|DSs]) -> + io:format("universaltime = ~p -> seconds = ~p", [Datetime, Seconds]), + Seconds = erlang:universaltime_to_posixtime(Datetime), + test_univ_to_seconds(DSs); +test_univ_to_seconds([]) -> + ok. + +%% Test seconds to universaltime conversions +seconds_to_univ(Config) when is_list(Config) -> + test_seconds_to_univ(ok_utc_seconds()). + +test_seconds_to_univ([{Datetime, Seconds}|DSs]) -> + io:format("universaltime = ~p <- seconds = ~p", [Datetime, Seconds]), + Datetime = erlang:posixtime_to_universaltime(Seconds), + test_seconds_to_univ(DSs); +test_seconds_to_univ([]) -> + ok. + + %% Test that the the different time functions return %% consistent results. (See the test case for assumptions %% and limitations.) @@ -453,6 +480,32 @@ dst_dates() -> {1998, 06, 3}, {1999, 06, 4}]. +%% exakt utc {date(), time()} which corresponds to the same seconds since 1 jan 1970 +%% negative seconds are ok +%% generated with date --date='1979-05-28 12:30:35 UTC' +%s +ok_utc_seconds() -> [ + { {{1970, 1, 1},{ 0, 0, 0}}, 0 }, + { {{1970, 1, 1},{ 0, 0, 1}}, 1 }, + { {{1969,12,31},{23,59,59}}, -1 }, + { {{1920,12,31},{23,59,59}}, -1546300801 }, + { {{1600,02,19},{15,14,08}}, -11671807552 }, + { {{1979,05,28},{12,30,35}}, 296742635 }, + { {{1999,12,31},{23,59,59}}, 946684799 }, + { {{2000, 1, 1},{ 0, 0, 0}}, 946684800 }, + { {{2000, 1, 1},{ 0, 0, 1}}, 946684801 }, + + { {{2038, 1,19},{03,14,07}}, 2147483647 }, % Sint32 full - 1 + { {{2038, 1,19},{03,14,08}}, 2147483648 }, % Sint32 full + { {{2038, 1,19},{03,14,09}}, 2147483649 }, % Sint32 full + 1 + + { {{2106, 2, 7},{ 6,28,14}}, 4294967294 }, % Uint32 full 0xFFFFFFFF - 1 + { {{2106, 2, 7},{ 6,28,15}}, 4294967295 }, % Uint32 full 0xFFFFFFFF + { {{2106, 2, 7},{ 6,28,16}}, 4294967296 }, % Uint32 full 0xFFFFFFFF + 1 + { {{2012,12, 6},{16,28,08}}, 1354811288 }, + { {{2412,12, 6},{16,28,08}}, 13977592088 } + ]. + + %% The following dates should not be near the end or beginning of %% a month, because they will be used to test when the dates are %% different in UTC and local time. diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex ad1d7031a3..bc5631f3dd 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 7e1a5d1fdb..b6c49d5c0c 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 35defde692..14a7a2bf20 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -129,7 +129,7 @@ start(Id, Pgm0, Hosts) -> {error,Reason} end. -%% Hosts must be a list on form ['1.2.3.4' ...] +%% Hosts must be a list of form ['1.2.3.4' ...] start_it("inet", Id, Pid, Hosts) -> process_flag(trap_exit, true), ?dbg(inet, {Id,Pid,Hosts}), diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 7316e0be99..36cbe329e8 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -45,13 +45,13 @@ rename/2, rename/3, make_dir/1, make_dir/2, del_dir/1, del_dir/2, - read_file_info/1, read_file_info/2, + read_file_info/1, read_file_info/2, read_file_info/3, altname/1, altname/2, - write_file_info/2, write_file_info/3, + write_file_info/2, write_file_info/3, write_file_info/4, make_link/2, make_link/3, make_symlink/2, make_symlink/3, read_link/1, read_link/2, - read_link_info/1, read_link_info/2, + read_link_info/1, read_link_info/2, read_link_info/3, list_dir/1, list_dir/2]). %% How to start and stop the ?DRV port. -export([start/0, stop/1]). @@ -725,16 +725,33 @@ del_dir_int(Port, Dir) -> -%% read_file_info/{1,2} +%% read_file_info/{1,2,3} read_file_info(File) -> - read_file_info_int({?DRV, [binary]}, File). + read_file_info_int({?DRV, [binary]}, File, local). read_file_info(Port, File) when is_port(Port) -> - read_file_info_int(Port, File). + read_file_info_int(Port, File, local); +read_file_info(File, Opts) -> + read_file_info_int({?DRV, [binary]}, File, plgv(time, Opts, local)). + +read_file_info(Port, File, Opts) when is_port(Port) -> + read_file_info_int(Port, File, plgv(time, Opts, local)). + +read_file_info_int(Port, File, TimeType) -> + try + case drv_command(Port, [?FILE_FSTAT, pathname(File)]) of + {ok, FI} -> {ok, FI#file_info{ + ctime = from_seconds(FI#file_info.ctime, TimeType), + mtime = from_seconds(FI#file_info.mtime, TimeType), + atime = from_seconds(FI#file_info.atime, TimeType) + }}; + Error -> Error + end + catch + error:_ -> {error, badarg} + end. -read_file_info_int(Port, File) -> - drv_command(Port, [?FILE_FSTAT, pathname(File)]). %% altname/{1,2} @@ -747,38 +764,61 @@ altname(Port, File) when is_port(Port) -> altname_int(Port, File) -> drv_command(Port, [?FILE_ALTNAME, pathname(File)]). -%% write_file_info/{2,3} +%% write_file_info/{2,3,4} write_file_info(File, Info) -> - write_file_info_int({?DRV, [binary]}, File, Info). + write_file_info_int({?DRV, [binary]}, File, Info, local). write_file_info(Port, File, Info) when is_port(Port) -> - write_file_info_int(Port, File, Info). + write_file_info_int(Port, File, Info, local); +write_file_info(File, Info, Opts) -> + write_file_info_int({?DRV, [binary]}, File, Info, plgv(time, Opts, local)). + +write_file_info(Port, File, Info, Opts) when is_port(Port) -> + write_file_info_int(Port, File, Info, plgv(time, Opts, local)). -write_file_info_int(Port, - File, +write_file_info_int(Port, File, #file_info{mode=Mode, uid=Uid, gid=Gid, atime=Atime0, mtime=Mtime0, - ctime=Ctime}) -> - {Atime, Mtime} = - case {Atime0, Mtime0} of - {undefined, Mtime0} -> {erlang:localtime(), Mtime0}; - {Atime0, undefined} -> {Atime0, Atime0}; - Complete -> Complete - end, - drv_command(Port, [?FILE_WRITE_INFO, - int_to_bytes(Mode), - int_to_bytes(Uid), - int_to_bytes(Gid), - date_to_bytes(Atime), - date_to_bytes(Mtime), - date_to_bytes(Ctime), - pathname(File)]). + ctime=Ctime0}, + TimeType) -> + + % Atime and/or Mtime might be undefined + % - use localtime() for atime, if atime is undefined + % - use atime as mtime if mtime is undefined + % - use mtime as ctime if ctime is undefined + + try + Atime = file_info_validate_atime(Atime0, TimeType), + Mtime = file_info_validate_mtime(Mtime0, Atime), + Ctime = file_info_validate_ctime(Ctime0, Mtime), + + drv_command(Port, [?FILE_WRITE_INFO, + int_to_int32bytes(Mode), + int_to_int32bytes(Uid), + int_to_int32bytes(Gid), + int_to_int64bytes(to_seconds(Atime, TimeType)), + int_to_int64bytes(to_seconds(Mtime, TimeType)), + int_to_int64bytes(to_seconds(Ctime, TimeType)), + pathname(File)]) + catch + error:_ -> {error, badarg} + end. +file_info_validate_atime(Atime, _) when Atime =/= undefined -> Atime; +file_info_validate_atime(undefined, local) -> erlang:localtime(); +file_info_validate_atime(undefined, universal) -> erlang:universaltime(); +file_info_validate_atime(undefined, posix) -> erlang:universaltime_to_posixtime(erlang:universaltime()). + +file_info_validate_mtime(undefined, Atime) -> Atime; +file_info_validate_mtime(Mtime, _) -> Mtime. + +file_info_validate_ctime(undefined, Mtime) -> Mtime; +file_info_validate_ctime(Ctime, _) -> Ctime. %% make_link/{2,3} @@ -822,16 +862,32 @@ read_link_int(Port, Link) -> %% read_link_info/{2,3} read_link_info(Link) -> - read_link_info_int({?DRV, [binary]}, Link). + read_link_info_int({?DRV, [binary]}, Link, local). read_link_info(Port, Link) when is_port(Port) -> - read_link_info_int(Port, Link). + read_link_info_int(Port, Link, local); -read_link_info_int(Port, Link) -> - drv_command(Port, [?FILE_LSTAT, pathname(Link)]). +read_link_info(Link, Opts) -> + read_link_info_int({?DRV, [binary]}, Link, plgv(time, Opts, local)). +read_link_info(Port, Link, Opts) when is_port(Port) -> + read_link_info_int(Port, Link, plgv(time, Opts, local)). +read_link_info_int(Port, Link, TimeType) -> + try + case drv_command(Port, [?FILE_LSTAT, pathname(Link)]) of + {ok, FI} -> {ok, FI#file_info{ + ctime = from_seconds(FI#file_info.ctime, TimeType), + mtime = from_seconds(FI#file_info.mtime, TimeType), + atime = from_seconds(FI#file_info.atime, TimeType) + }}; + Error -> Error + end + catch + error:_ -> {error, badarg} + end. + %% list_dir/{1,2} list_dir(Dir) -> @@ -1075,7 +1131,7 @@ translate_response(?FILE_RESP_DATA, List) -> {_N, _Data} = ND = get_uint64(List), {ok, ND}; translate_response(?FILE_RESP_INFO, List) when is_list(List) -> - {ok, transform_info_ints(get_uint32s(List))}; + {ok, transform_info(List)}; translate_response(?FILE_RESP_NUMERR, L0) -> {N, L1} = get_uint64(L0), {error, {N, list_to_atom(L1)}}; @@ -1129,27 +1185,37 @@ translate_response(?FILE_RESP_ALL_DATA, Data) -> translate_response(X, Data) -> {error, {bad_response_from_port, [X | Data]}}. -transform_info_ints(Ints) -> - [HighSize, LowSize, Type|Tail0] = Ints, - Size = HighSize * 16#100000000 + LowSize, - [Ay, Am, Ad, Ah, Ami, As|Tail1] = Tail0, - [My, Mm, Md, Mh, Mmi, Ms|Tail2] = Tail1, - [Cy, Cm, Cd, Ch, Cmi, Cs|Tail3] = Tail2, - [Mode, Links, Major, Minor, Inode, Uid, Gid, Access] = Tail3, +transform_info([ + Hsize1, Hsize2, Hsize3, Hsize4, + Lsize1, Lsize2, Lsize3, Lsize4, + Type1, Type2, Type3, Type4, + Atime1, Atime2, Atime3, Atime4, Atime5, Atime6, Atime7, Atime8, + Mtime1, Mtime2, Mtime3, Mtime4, Mtime5, Mtime6, Mtime7, Mtime8, + Ctime1, Ctime2, Ctime3, Ctime4, Ctime5, Ctime6, Ctime7, Ctime8, + Mode1, Mode2, Mode3, Mode4, + Links1, Links2, Links3, Links4, + Major1, Major2, Major3, Major4, + Minor1, Minor2, Minor3, Minor4, + Inode1, Inode2, Inode3, Inode4, + Uid1, Uid2, Uid3, Uid4, + Gid1, Gid2, Gid3, Gid4, + Access1,Access2,Access3,Access4]) -> #file_info { - size = Size, - type = file_type(Type), - access = file_access(Access), - atime = {{Ay, Am, Ad}, {Ah, Ami, As}}, - mtime = {{My, Mm, Md}, {Mh, Mmi, Ms}}, - ctime = {{Cy, Cm, Cd}, {Ch, Cmi, Cs}}, - mode = Mode, - links = Links, - major_device = Major, - minor_device = Minor, - inode = Inode, - uid = Uid, - gid = Gid}. + size = uint32(Hsize1,Hsize2,Hsize3,Hsize4)*16#100000000 + uint32(Lsize1,Lsize2,Lsize3,Lsize4), + type = file_type(uint32(Type1,Type2,Type3,Type4)), + access = file_access(uint32(Access1,Access2,Access3,Access4)), + atime = sint64(Atime1, Atime2, Atime3, Atime4, Atime5, Atime6, Atime7, Atime8), + mtime = sint64(Mtime1, Mtime2, Mtime3, Mtime4, Mtime5, Mtime6, Mtime7, Mtime8), + ctime = sint64(Ctime1, Ctime2, Ctime3, Ctime4, Ctime5, Ctime6, Ctime7, Ctime8), + mode = uint32(Mode1,Mode2,Mode3,Mode4), + links = uint32(Links1,Links2,Links3,Links4), + major_device = uint32(Major1,Major2,Major3,Major4), + minor_device = uint32(Minor1,Minor2,Minor3,Minor4), + inode = uint32(Inode1,Inode2,Inode3,Inode4), + uid = uint32(Uid1,Uid2,Uid3,Uid4), + gid = uint32(Gid1,Gid2,Gid3,Gid4) + }. + file_type(1) -> device; file_type(2) -> directory; @@ -1162,24 +1228,22 @@ file_access(1) -> write; file_access(2) -> read; file_access(3) -> read_write. -int_to_bytes(Int) when is_integer(Int) -> +int_to_int32bytes(Int) when is_integer(Int) -> <<Int:32>>; -int_to_bytes(undefined) -> +int_to_int32bytes(undefined) -> <<-1:32>>. -date_to_bytes(undefined) -> - <<-1:32, -1:32, -1:32, -1:32, -1:32, -1:32>>; -date_to_bytes({{Y, Mon, D}, {H, Min, S}}) -> - <<Y:32, Mon:32, D:32, H:32, Min:32, S:32>>. +int_to_int64bytes(Int) when is_integer(Int) -> + <<Int:64/signed>>. -%% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) -> -%% (uint32(Y1) bsl 32) bor uint32(Y2). -%% uint64(X1, X2, X3, X4, X5, X6, X7, X8) -> -%% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8). +sint64(I1,I2,I3,I4,I5,I6,I7,I8) when I1 > 127 -> + ((I1 bsl 56) bor (I2 bsl 48) bor (I3 bsl 40) bor (I4 bsl 32) bor + (I5 bsl 24) bor (I6 bsl 16) bor (I7 bsl 8) bor I8) - (1 bsl 64); +sint64(I1,I2,I3,I4,I5,I6,I7,I8) -> + ((I1 bsl 56) bor (I2 bsl 48) bor (I3 bsl 40) bor (I4 bsl 32) bor + (I5 bsl 24) bor (I6 bsl 16) bor (I7 bsl 8) bor I8). -%% uint32([X1,X2,X3,X4]) -> -%% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. uint32(X1,X2,X3,X4) -> (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. @@ -1192,11 +1256,6 @@ get_uint64(L0) -> get_uint32([X1,X2,X3,X4|List]) -> {(((((X1 bsl 8) bor X2) bsl 8) bor X3) bsl 8) bor X4, List}. -get_uint32s([X1,X2,X3,X4|Tail]) -> - [uint32(X1,X2,X3,X4) | get_uint32s(Tail)]; -get_uint32s([]) -> []. - - %% Binary mode transform_ldata(<<0:32, 0:32>>) -> @@ -1275,3 +1334,28 @@ reverse(L, T) -> lists:reverse(L, T). % in list_to_binary, which is caught and generates the {error,badarg} return pathname(File) -> (catch prim_file:internal_name2native(File)). + + +%% proplist:get_value/3 +plgv(K, [{K, V}|_], _) -> V; +plgv(K, [_|KVs], D) -> plgv(K, KVs, D); +plgv(_, [], D) -> D. + +%% +%% We don't actually want this here +%% We want to use posix time in all prim but erl_prim_loader makes that tricky +%% It is probably needed to redo the whole erl_prim_loader + +from_seconds(Seconds, posix) when is_integer(Seconds) -> + Seconds; +from_seconds(Seconds, universal) when is_integer(Seconds) -> + erlang:posixtime_to_universaltime(Seconds); +from_seconds(Seconds, local) when is_integer(Seconds) -> + erlang:universaltime_to_localtime(erlang:posixtime_to_universaltime(Seconds)). + +to_seconds(Seconds, posix) when is_integer(Seconds) -> + Seconds; +to_seconds({_,_} = Datetime, universal) -> + erlang:universaltime_to_posixtime(Datetime); +to_seconds({_,_} = Datetime, local) -> + erlang:universaltime_to_posixtime(erlang:localtime_to_universaltime(Datetime)). diff --git a/erts/preloaded/src/prim_zip.erl b/erts/preloaded/src/prim_zip.erl index 392a9feb45..d29f17ae56 100644 --- a/erts/preloaded/src/prim_zip.erl +++ b/erts/preloaded/src/prim_zip.erl @@ -432,7 +432,7 @@ binary_io({file_info, B}, _) -> is_binary(B) -> {regular, byte_size(B)}; B =:= directory -> {directory, 0} end, - Now = calendar:local_time(), + Now = erlang:localtime(), #file_info{size = Size, type = Type, access = read_write, atime = Now, mtime = Now, ctime = Now, mode = 0, links = 1, major_device = 0, diff --git a/erts/test/erl_print_SUITE_data/Makefile.src b/erts/test/erl_print_SUITE_data/Makefile.src index 109d55e572..9164c672dc 100644 --- a/erts/test/erl_print_SUITE_data/Makefile.src +++ b/erts/test/erl_print_SUITE_data/Makefile.src @@ -27,7 +27,7 @@ EPTF_CFLAGS = -Wall $(CFLAGS) @DEFS@ -I@erts_lib_include_internal@ -I@erts_lib_i EPTF_LIBS = $(LIBS) -L@erts_lib_internal_path@ -lerts_internal@type_marker@ EPTT_CFLAGS = -DTHREAD_SAFE $(ETHR_DEFS) $(EPTF_CFLAGS) -EPTT_LIBS = $(LIBS) -L@erts_lib_internal_path@ -lerts_internal_r@type_marker@ $(ETHR_LIBS) +EPTT_LIBS = -L@erts_lib_internal_path@ -lerts_internal_r@type_marker@ $(ETHR_LIBS) $(LIBS) GCC = .@DS@gccifier -CC"$(CC)" diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl index 4206bebfe7..80f988b0aa 100644 --- a/erts/test/ethread_SUITE.erl +++ b/erts/test/ethread_SUITE.erl @@ -174,7 +174,15 @@ detached_thread(doc) -> detached_thread(suite) -> []; detached_thread(Config) -> - run_case(Config, "detached_thread", ""). + case {os:type(), os:version()} of + {{unix,darwin}, {9, _, _}} -> + %% For some reason pthread_create() crashes when more + %% threads cannot be created, instead of returning an + %% error code on our MacOS X Leopard machine... + {skipped, "MacOS X Leopard cannot cope with this test..."}; + _ -> + run_case(Config, "detached_thread", "") + end. max_threads(doc) -> ["Tests maximum number of threads."]; diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index d61fbbddcf..79cd91221f 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -94,15 +94,16 @@ undefined_functions(Config) when is_list(Config) -> case Undef of [] -> ok; _ -> + Fd = open_log(Config, "undefined_functions"), foreach(fun ({MFA1,MFA2}) -> io:format("~s calls undefined ~s", + [format_mfa(MFA1),format_mfa(MFA2)]), + io:format(Fd, "~s ~s\n", [format_mfa(MFA1),format_mfa(MFA2)]) end, Undef), + close_log(Fd), ?line ?t:fail({length(Undef),undefined_functions_in_otp}) - - end, - - ok. + end. hipe_filter(Undef) -> case erlang:system_info(hipe_architecture) of @@ -211,7 +212,10 @@ deprecated_not_in_obsolete(Config) when is_list(Config) -> _ -> io:put_chars("The following functions have -deprecated() attributes,\n" "but are not listed in otp_internal:obsolete/3.\n"), - ?line print_mfas(L), + ?line print_mfas(group_leader(), L), + Fd = open_log(Config, "deprecated_not_obsolete"), + print_mfas(Fd, L), + close_log(Fd), ?line ?t:fail({length(L),deprecated_but_not_obsolete}) end. @@ -232,11 +236,13 @@ obsolete_but_not_deprecated(Config) when is_list(Config) -> io:put_chars("The following functions are listed " "in otp_internal:obsolete/3,\n" "but don't have -deprecated() attributes.\n"), - ?line print_mfas(L), + ?line print_mfas(group_leader(), L), + Fd = open_log(Config, "obsolete_not_deprecated"), + print_mfas(Fd, L), + close_log(Fd), ?line ?t:fail({length(L),obsolete_but_not_deprecated}) end. - call_to_deprecated(Config) when is_list(Config) -> Server = ?config(xref_server, Config), ?line {ok,DeprecatedCalls} = xref:q(Server, "strict(E || DF)"), @@ -302,10 +308,20 @@ strong_components(Config) when is_list(Config) -> %%% -print_mfas([MFA|T]) -> - io:format("~s\n", [format_mfa(MFA)]), - print_mfas(T); -print_mfas([]) -> ok. +print_mfas(Fd, [MFA|T]) -> + io:format(Fd, "~s\n", [format_mfa(MFA)]), + print_mfas(Fd, T); +print_mfas(_, []) -> ok. format_mfa({M,F,A}) -> lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). + +open_log(Config, Name) -> + PrivDir = ?config(priv_dir, Config), + RunDir = filename:dirname(filename:dirname(PrivDir)), + Path = filename:join(RunDir, "system_"++Name++".log"), + {ok,Fd} = file:open(Path, [write]), + Fd. + +close_log(Fd) -> + ok = file:close(Fd). diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index bac0c4eaa8..8505ee8469 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -108,9 +108,10 @@ </section> <section> - <title>CTH Priority</title> + <title>CTH Execution order</title> <p>By default each CTH installed will be executed in the order which - they are installed. This is not always wanted so common_test allows + they are installed for init calls, and then reversed for end calls. + This is not always wanted so common_test allows the user to specify a priority for each hook. The priority can either be specified in the CTH <seealso marker="ct_hooks#Module:init-2">init/2 </seealso> function or when installing the hook. The priority given at diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 0897675591..ee0162c5e3 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1274,6 +1274,10 @@ report(What,Data) -> tests_done -> ok; tc_start -> + %% Data = {{Suite,Func},LogFileName} + ct_event:sync_notify(#event{name=tc_logfile, + node=node(), + data=Data}), ok; tc_done -> {_Suite,Case,Result} = Data, diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index ffafc582cf..c42adbbdd9 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -178,8 +178,9 @@ call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, call(Fun, Config, Meta) -> maybe_lock(), Hooks = get_hooks(), - Res = call(get_new_hooks(Config, Fun) ++ - [{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks], + Calls = get_new_hooks(Config, Fun) ++ + [{HookId,Fun} || #ct_hook_config{id = HookId} <- Hooks], + Res = call(resort(Calls,Hooks,Meta), remove(?config_name,Config), Meta, Hooks), maybe_unlock(), Res. @@ -205,7 +206,7 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> {Hooks ++ [NewHook], [{NewId, call_init}, {NewId,NextFun} | Rest]} end, - call(resort(NewRest,NewHooks), Config, Meta, NewHooks) + call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks) catch Error:Reason -> Trace = erlang:get_stacktrace(), ct_logs:log("Suite Hook","Failed to start a CTH: ~p:~p", @@ -221,7 +222,7 @@ call([{HookId, Fun} | Rest], Config, Meta, Hooks) -> {NewConf, NewHook} = Fun(Hook, Config, Meta), NewCalls = get_new_hooks(NewConf, Fun), NewHooks = lists:keyreplace(HookId, #ct_hook_config.id, Hooks, NewHook), - call(resort(NewCalls ++ Rest,NewHooks), %% Resort if call_init changed prio + call(resort(NewCalls ++ Rest,NewHooks,Meta), %% Resort if call_init changed prio remove(?config_name, NewConf), Meta, terminate_if_scope_ends(HookId, Meta, NewHooks)) catch throw:{error_in_cth_call,Reason} -> @@ -308,6 +309,18 @@ get_hooks() -> %% call_id < call_init < ctfirst < Priority 1 < .. < Priority N < ctlast %% If Hook Priority is equal, check when it has been installed and %% sort on that instead. +%% If we are doing a cleanup call i.e. {post,pre}_end_per_*, all priorities +%% are reversed. Probably want to make this sorting algorithm pluginable +%% as some point... +resort(Calls,Hooks,[F|_R]) when F == post_end_per_testcase; + F == pre_end_per_group; + F == post_end_per_group; + F == pre_end_per_suite; + F == post_end_per_suite -> + lists:reverse(resort(Calls,Hooks)); +resort(Calls,Hooks,_Meta) -> + resort(Calls,Hooks). + resort(Calls, Hooks) -> lists:sort( fun({_,_,_},_) -> diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 5c99f0f9f7..2c519f08b5 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -1046,29 +1046,34 @@ test_events(prio_cth) -> [900],[900,900],[500,900],[1000],[1200,1050], [1100],[1200]]) ++ GenPost(post_end_per_testcase, - [[1100,100],[600,200],[600,600],[600],[700],[800], - [900],[900,900],[500,900],[1000],[1200,1050], - [1100],[1200]]) ++ + lists:reverse( + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]])) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++ GenPre(pre_end_per_group, - [[1100,100],[600,200],[600,600],[600],[700],[800], - [900],[900,900],[500,900],[1000],[1200,1050], - [1100],[1200]]) ++ + lists:reverse( + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]])) ++ GenPost(post_end_per_group, - [[1100,100],[600,200],[600,600],[600],[700],[800], - [900],[900,900],[500,900],[1000],[1200,1050], - [1100],[1200]]) ++ + lists:reverse( + [[1100,100],[600,200],[600,600],[600],[700],[800], + [900],[900,900],[500,900],[1000],[1200,1050], + [1100],[1200]])) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,{end_per_group,'_',[]},ok}}], {?eh,tc_start,{ct_cth_prio_SUITE,end_per_suite}}] ++ GenPre(pre_end_per_suite, - [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], - [1200,1050],[1100],[1200]]) ++ + lists:reverse( + [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], + [1200,1050],[1100],[1200]])) ++ GenPost(post_end_per_suite, - [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], - [1200,1050],[1100],[1200]]) ++ + lists:reverse( + [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], + [1200,1050],[1100],[1200]])) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 1238d113e1..7a237608ad 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -59,6 +59,7 @@ MODULES = \ beam_opcodes \ beam_peep \ beam_receive \ + beam_split \ beam_trim \ beam_type \ beam_utils \ diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 9f81a6ab43..5f12a98f09 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -131,10 +131,9 @@ -import(lists, [mapfoldl/3,reverse/1]). module({Mod,Exp,Attr,Fs0,_}, _Opts) -> - Fs1 = [split_blocks(F) || F <- Fs0], - {Fs2,Lc1} = beam_clean:clean_labels(Fs1), - {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs2), - %%{Fs,Lc} = {Fs2,Lc1}, + {Fs1,Lc1} = beam_clean:clean_labels(Fs0), + {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1), + %%{Fs,Lc} = {Fs1,Lc1}, {ok,{Mod,Exp,Attr,Fs,Lc}}. function({function,Name,Arity,CLabel,Is0}, Lc0) -> @@ -160,64 +159,6 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> erlang:raise(Class, Error, Stack) end. -%% We must split the basic block when we encounter instructions with labels, -%% such as catches and BIFs. All labels must be visible outside the blocks. - -split_blocks({function,Name,Arity,CLabel,Is0}) -> - Is = split_blocks(Is0, []), - {function,Name,Arity,CLabel,Is}. - -split_blocks([{block,Bl}|Is], Acc0) -> - Acc = split_block(Bl, [], Acc0), - split_blocks(Is, Acc); -split_blocks([I|Is], Acc) -> - split_blocks(Is, [I|Acc]); -split_blocks([], Acc) -> reverse(Acc). - -split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> - %% is_record/3 must be translated by beam_clean; therefore, - %% it must be outside of any block. - split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]); -split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> - split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]); -split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) - when Lbl =/= 0 -> - split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); -split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> - split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); -split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> - split_block(Is, [], [Line|make_block(Bl, Acc)]); -split_block([I|Is], Bl, Acc) -> - split_block(Is, [I|Bl], Acc); -split_block([], Bl, Acc) -> make_block(Bl, Acc). - -make_block([], Acc) -> Acc; -make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) -> - %% If the last instruction in the block is a comparison or boolean operator - %% (such as '=:='), move it out of the block to facilitate further - %% optimizations. - Arity = length(Ss), - case erl_internal:comp_op(Op, Arity) orelse - erl_internal:new_type_test(Op, Arity) orelse - erl_internal:bool_op(Op, Arity) of - false -> - [{block,reverse(Bl0)}|Acc]; - true -> - I = {bif,Op,Fail,Ss,D}, - case Bl =:= [] of - true -> [I|Acc]; - false -> [I,{block,reverse(Bl)}|Acc] - end - end; -make_block([{set,[Dst],[Src],move}|Bl], Acc) -> - %% Make optimization of {move,Src,Dst}, {jump,...} possible. - I = {move,Src,Dst}, - case Bl =:= [] of - true -> [I|Acc]; - false -> [I,{block,reverse(Bl)}|Acc] - end; -make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc]. - %% 'move' instructions outside of blocks may thwart the jump optimizer. %% Move them back into the block. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl new file mode 100644 index 0000000000..cacaaebffe --- /dev/null +++ b/lib/compiler/src/beam_split.erl @@ -0,0 +1,85 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_split). +-export([module/2]). + +-import(lists, [reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [split_blocks(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +%% We must split the basic block when we encounter instructions with labels, +%% such as catches and BIFs. All labels must be visible outside the blocks. + +split_blocks({function,Name,Arity,CLabel,Is0}) -> + Is = split_blocks(Is0, []), + {function,Name,Arity,CLabel,Is}. + +split_blocks([{block,Bl}|Is], Acc0) -> + Acc = split_block(Bl, [], Acc0), + split_blocks(Is, Acc); +split_blocks([I|Is], Acc) -> + split_blocks(Is, [I|Acc]); +split_blocks([], Acc) -> reverse(Acc). + +split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> + %% is_record/3 must be translated by beam_clean; therefore, + %% it must be outside of any block. + split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]); +split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> + split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]); +split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) + when Lbl =/= 0 -> + split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); +split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> + split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); +split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> + split_block(Is, [], [Line|make_block(Bl, Acc)]); +split_block([I|Is], Bl, Acc) -> + split_block(Is, [I|Bl], Acc); +split_block([], Bl, Acc) -> make_block(Bl, Acc). + +make_block([], Acc) -> Acc; +make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) -> + %% If the last instruction in the block is a comparison or boolean operator + %% (such as '=:='), move it out of the block to facilitate further + %% optimizations. + Arity = length(Ss), + case erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity) orelse + erl_internal:bool_op(Op, Arity) of + false -> + [{block,reverse(Bl0)}|Acc]; + true -> + I = {bif,Op,Fail,Ss,D}, + case Bl =:= [] of + true -> [I|Acc]; + false -> [I,{block,reverse(Bl)}|Acc] + end + end; +make_block([{set,[Dst],[Src],move}|Bl], Acc) -> + %% Make optimization of {move,Src,Dst}, {jump,...} possible. + I = {move,Src,Dst}, + case Bl =:= [] of + true -> [I|Acc]; + false -> [I,{block,reverse(Bl)}|Acc] + end; +make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc]. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index fe3b1680d9..95f12df40d 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -670,10 +670,20 @@ valfun_4({get_tuple_element,Src,I,Dst}, Vst) -> valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> %% If source and destination registers are the same, match state %% is OK as input. - _ = get_move_term_type(Ctx, Vst0), + CtxType = get_move_term_type(Ctx, Vst0), verify_live(Live, Vst0), Vst1 = prune_x_regs(Live, Vst0), - Vst = branch_state(Fail, Vst1), + BranchVst = case CtxType of + {match_context,_,_} -> + %% The failure branch will never be taken when Ctx + %% is a match context. Therefore, the type for Ctx + %% at the failure label must not be match_context + %% (or we could reject legal code). + set_type_reg(term, Ctx, Vst1); + _ -> + Vst1 + end, + Vst = branch_state(Fail, BranchVst), set_type_reg(bsm_match_state(NeedSlots), Ctx, Vst); valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> assert_term(Src, Vst0), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 8815cfb26f..a17a10046e 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -633,7 +633,9 @@ asm_passes() -> {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, {iff,dtype,{listing,"type"}}, - {pass,beam_dead}, %Must always run since it splits blocks. + {pass,beam_split}, + {iff,dsplit,{listing,"split"}}, + {unless,no_dead,{pass,beam_dead}}, {iff,ddead,{listing,"dead"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 4ac879c9a4..efa25fe039 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -34,6 +34,7 @@ beam_opcodes, beam_peep, beam_receive, + beam_split, beam_trim, beam_type, beam_utils, diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 086fba2649..2e17d3fde6 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -33,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), [attribute, bsdecode, bsdes, barnes2, decode1, smith, - itracer, pseudoknot, lists, really_inlined, otp_7223, + itracer, pseudoknot, comma_splitter, lists, really_inlined, otp_7223, coverage]. groups() -> @@ -78,6 +78,7 @@ attribute(Config) when is_list(Config) -> ?comp(smith). ?comp(itracer). ?comp(pseudoknot). +?comp(comma_splitter). try_inline(Mod, Config) -> ?line Src = filename:join(?config(data_dir, Config), atom_to_list(Mod)), diff --git a/lib/compiler/test/inline_SUITE_data/comma_splitter.erl b/lib/compiler/test/inline_SUITE_data/comma_splitter.erl new file mode 100644 index 0000000000..eaa89e0edc --- /dev/null +++ b/lib/compiler/test/inline_SUITE_data/comma_splitter.erl @@ -0,0 +1,18 @@ +-module(comma_splitter). +-export([?MODULE/0]). + +?MODULE() -> + {<<"def">>,<<"cba">>} = split_at_comma(<<"abc, def">>, <<>>), + ok. + +strip_leading_ws(<<N, Rest/binary>>) when N =< $\s -> + strip_leading_ws(Rest); +strip_leading_ws(B) -> + B. + +split_at_comma(<<>>, Accu) -> + {<<>>, Accu}; +split_at_comma(<<$,, Rest/binary>>, Accu) -> + {strip_leading_ws(Rest), Accu}; +split_at_comma(<<C, Rest/binary>>, Accu) -> + split_at_comma(Rest, <<C, Accu/binary>>). diff --git a/lib/configure.in.src b/lib/configure.in.src index 792a7f932a..609bb62308 100644 --- a/lib/configure.in.src +++ b/lib/configure.in.src @@ -17,7 +17,7 @@ dnl dnl %CopyrightEnd% dnl -dnl Turn of caching +dnl Turn off caching define([AC_CACHE_LOAD], )dnl define([AC_CACHE_SAVE], )dnl diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl index e94c307ef8..79a234bd28 100644 --- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl +++ b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl @@ -131,10 +131,10 @@ end_per_testcase(_Case, Config) -> ok. init_per_suite(Config) -> - case code:which(crypto) of - Res when is_atom(Res) -> + case crypto_works() of + false -> {skip,"Could not start crypto!"}; - _Else -> + true -> orber:jump_start(), cosProperty:install(), cosProperty:start(), @@ -165,6 +165,15 @@ init_per_suite(Config) -> end end. +crypto_works() -> + try crypto:start() of + {error,{already_started,crypto}} -> true; + ok -> true + catch + error:_ -> + false + end. + end_per_suite(Config) -> ssl:stop(), crypto:stop(), diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 802c1991de..4dc62421d2 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -53,6 +53,17 @@ #include <openssl/evp.h> #include <openssl/hmac.h> +#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA256) && defined(NID_sha256) +# define HAVE_SHA256 +#endif +#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA384) && defined(NID_sha384)\ + && !defined(OPENSSL_NO_SHA512) /* disabled like this in my sha.h (?) */ +# define HAVE_SHA384 +#endif +#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA512) && defined(NID_sha512) +# define HAVE_SHA512 +#endif + #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -124,6 +135,14 @@ static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -148,7 +167,7 @@ static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NI static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rsa_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -201,6 +220,14 @@ static ErlNifFunc nif_funcs[] = { {"sha_init", 0, sha_init}, {"sha_update", 2, sha_update}, {"sha_final", 1, sha_final}, + {"sha256_nif", 1, sha256_nif}, + {"sha256_init_nif", 0, sha256_init_nif}, + {"sha256_update_nif", 2, sha256_update_nif}, + {"sha256_final_nif", 1, sha256_final_nif}, + {"sha512_nif", 1, sha512_nif}, + {"sha512_init_nif", 0, sha512_init_nif}, + {"sha512_update_nif", 2, sha512_update_nif}, + {"sha512_final_nif", 1, sha512_final_nif}, {"md4", 1, md4}, {"md4_init", 0, md4_init}, {"md4_update", 2, md4_update}, @@ -228,7 +255,7 @@ static ErlNifFunc nif_funcs[] = { {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 3, mod_exp_nif}, {"dss_verify", 4, dss_verify}, - {"rsa_verify", 4, rsa_verify}, + {"rsa_verify_nif", 4, rsa_verify_nif}, {"aes_cbc_crypt", 4, aes_cbc_crypt}, {"exor", 2, exor}, {"rc4_encrypt", 2, rc4_encrypt}, @@ -260,6 +287,9 @@ ERL_NIF_INIT(crypto,nif_funcs,load,reload,upgrade,unload) #define SHA_CTX_LEN (sizeof(SHA_CTX)) #define SHA_LEN 20 #define SHA_LEN_96 12 +#define SHA256_LEN (256/8) +#define SHA384_LEN (384/8) +#define SHA512_LEN (512/8) #define HMAC_INT_LEN 64 #define HMAC_IPAD 0x36 @@ -270,6 +300,9 @@ static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ static ERL_NIF_TERM atom_true; static ERL_NIF_TERM atom_false; static ERL_NIF_TERM atom_sha; +static ERL_NIF_TERM atom_sha256; +static ERL_NIF_TERM atom_sha384; +static ERL_NIF_TERM atom_sha512; static ERL_NIF_TERM atom_md5; static ERL_NIF_TERM atom_ripemd160; static ERL_NIF_TERM atom_error; @@ -286,6 +319,7 @@ static ERL_NIF_TERM atom_not_suitable_generator; static ERL_NIF_TERM atom_check_failed; static ERL_NIF_TERM atom_unknown; static ERL_NIF_TERM atom_none; +static ERL_NIF_TERM atom_notsup; static int is_ok_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) @@ -340,6 +374,9 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_true = enif_make_atom(env,"true"); atom_false = enif_make_atom(env,"false"); atom_sha = enif_make_atom(env,"sha"); + atom_sha256 = enif_make_atom(env,"sha256"); + atom_sha384 = enif_make_atom(env,"sha384"); + atom_sha512 = enif_make_atom(env,"sha512"); atom_md5 = enif_make_atom(env,"md5"); atom_ripemd160 = enif_make_atom(env,"ripemd160"); atom_error = enif_make_atom(env,"error"); @@ -355,6 +392,7 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_check_failed = enif_make_atom(env,"check_failed"); atom_unknown = enif_make_atom(env,"unknown"); atom_none = enif_make_atom(env,"none"); + atom_notsup = enif_make_atom(env,"notsup"); *priv_data = NULL; library_refc++; @@ -519,6 +557,129 @@ static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return ret; } +static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data) */ +#ifdef HAVE_SHA256 + ErlNifBinary ibin; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { + return enif_make_badarg(env); + } + SHA256((unsigned char *) ibin.data, ibin.size, + enif_make_new_binary(env,SHA256_LEN, &ret)); + return ret; +#else + return atom_notsup; +#endif +} +static ERL_NIF_TERM sha256_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ +#ifdef HAVE_SHA256 + ERL_NIF_TERM ret; + SHA256_Init((SHA256_CTX *) enif_make_new_binary(env, sizeof(SHA256_CTX), &ret)); + return ret; +#else + return atom_notsup; +#endif +} +static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ +#ifdef HAVE_SHA256 + SHA256_CTX* new_ctx; + ErlNifBinary ctx_bin, data_bin; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX) + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); + memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); + SHA256_Update(new_ctx, data_bin.data, data_bin.size); + return ret; +#else + return atom_notsup; +#endif +} +static ERL_NIF_TERM sha256_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) */ +#ifdef HAVE_SHA256 + ErlNifBinary ctx_bin; + SHA256_CTX ctx_clone; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA256_CTX)) { + return enif_make_badarg(env); + } + memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA256_CTX)); /* writable */ + SHA256_Final(enif_make_new_binary(env, SHA256_LEN, &ret), &ctx_clone); + return ret; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data) */ +#ifdef HAVE_SHA512 + ErlNifBinary ibin; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { + return enif_make_badarg(env); + } + SHA512((unsigned char *) ibin.data, ibin.size, + enif_make_new_binary(env,SHA512_LEN, &ret)); + return ret; +#else + return atom_notsup; +#endif +} +static ERL_NIF_TERM sha512_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ +#ifdef HAVE_SHA512 + ERL_NIF_TERM ret; + SHA512_Init((SHA512_CTX *) enif_make_new_binary(env, sizeof(SHA512_CTX), &ret)); + return ret; +#else + return atom_notsup; +#endif +} +static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ +#ifdef HAVE_SHA512 + SHA512_CTX* new_ctx; + ErlNifBinary ctx_bin, data_bin; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX) + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); + memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); + SHA512_Update(new_ctx, data_bin.data, data_bin.size); + return ret; +#else + return atom_notsup; +#endif +} +static ERL_NIF_TERM sha512_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) */ +#ifdef HAVE_SHA512 + ErlNifBinary ctx_bin; + SHA512_CTX ctx_clone; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != sizeof(SHA512_CTX)) { + return enif_make_badarg(env); + } + memcpy(&ctx_clone, ctx_bin.data, sizeof(SHA512_CTX)); /* writable */ + SHA512_Final(enif_make_new_binary(env, SHA512_LEN, &ret), &ctx_clone); + return ret; +#else + return atom_notsup; +#endif +} + + static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data) */ ErlNifBinary ibin; @@ -1095,17 +1256,14 @@ static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv return(i > 0) ? atom_true : atom_false; } -static ERL_NIF_TERM rsa_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Data, Signature, Key=[E,N]) */ ErlNifBinary data_bin, sign_bin; - unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + unsigned char hmacbuf[SHA512_LEN]; ERL_NIF_TERM head, tail, ret; - int i, is_sha; + int i; RSA* rsa = RSA_new(); - - if (argv[0] == atom_sha) is_sha = 1; - else if (argv[0] == atom_md5) is_sha = 0; - else goto badarg; + const ERL_NIF_TERM type = argv[0]; if (!inspect_mpint(env, argv[1], &data_bin) || !inspect_mpint(env, argv[2], &sign_bin) @@ -1114,22 +1272,57 @@ static ERL_NIF_TERM rsa_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_mpint(env, head, &rsa->n) || !enif_is_empty_list(env, tail)) { - badarg: + ret = enif_make_badarg(env); } else { - if (is_sha) { + if (type == atom_sha) { SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); i = RSA_verify(NID_sha1, hmacbuf, SHA_DIGEST_LENGTH, sign_bin.data+4, sign_bin.size-4, rsa); } - else { + else if (type == atom_sha256) { + #ifdef HAVE_SHA256 + SHA256(data_bin.data+4, data_bin.size-4, hmacbuf); + i = RSA_verify(NID_sha256, hmacbuf, SHA256_LEN, + sign_bin.data+4, sign_bin.size-4, rsa); + #else + ret = atom_notsup; + goto done; + #endif + } + else if (type == atom_sha384) { + #ifdef HAVE_SHA384 + SHA384(data_bin.data+4, data_bin.size-4, hmacbuf); + i = RSA_verify(NID_sha384, hmacbuf, SHA384_LEN, + sign_bin.data+4, sign_bin.size-4, rsa); + #else + ret = atom_notsup; + goto done; + #endif + } + else if (type == atom_sha512) { + #ifdef HAVE_SHA512 + SHA512(data_bin.data+4, data_bin.size-4, hmacbuf); + i = RSA_verify(NID_sha512, hmacbuf, SHA512_LEN, + sign_bin.data+4, sign_bin.size-4, rsa); + #else + ret = atom_notsup; + goto done; + #endif + } + else if (type == atom_md5) { MD5(data_bin.data+4, data_bin.size-4, hmacbuf); i = RSA_verify(NID_md5, hmacbuf, MD5_DIGEST_LENGTH, sign_bin.data+4, sign_bin.size-4, rsa); } + else { + ret = enif_make_badarg(env); + goto done; + } ret = (i==1 ? atom_true : atom_false); - } + } +done: RSA_free(rsa); return ret; } diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 48243fd693..8cb893cd1c 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -896,7 +896,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <v>Key = [E, N]</v> <v>E, N = Mpint</v> <d>Where <c>E</c> is the public exponent and <c>N</c> is public modulus.</d> - <v>DigestType = md5 | sha</v> + <v>DigestType = md5 | sha | sha256 | sha384 | sha512</v> <d> The default <c>DigestType</c> is sha.</d> <v>Mpint = binary()</v> </type> @@ -905,6 +905,8 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> and verifies that the digest matches the RSA signature using the signer's public key <c>Key</c>. </p> + <p>May throw exception <c>notsup</c> in case the chosen <c>DigestType</c> + is not supported by the underlying OpenSSL implementation.</p> </desc> </func> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 0714cb686d..d7aac27825 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -25,8 +25,8 @@ -export([md4/1, md4_init/0, md4_update/2, md4_final/1]). -export([md5/1, md5_init/0, md5_update/2, md5_final/1]). -export([sha/1, sha_init/0, sha_update/2, sha_final/1]). -%-export([sha256/1, sha256_init/0, sha256_update/2, sha256_final/1]). -%-export([sha512/1, sha512_init/0, sha512_update/2, sha512_final/1]). +-export([sha256/1, sha256_init/0, sha256_update/2, sha256_final/1]). +-export([sha512/1, sha512_init/0, sha512_update/2, sha512_final/1]). -export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac/3, sha_mac_96/2]). -export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]). @@ -64,8 +64,8 @@ -define(FUNC_LIST, [md4, md4_init, md4_update, md4_final, md5, md5_init, md5_update, md5_final, sha, sha_init, sha_update, sha_final, -%% sha256, sha256_init, sha256_update, sha256_final, -%% sha512, sha512_init, sha512_update, sha512_final, + sha256, sha256_init, sha256_update, sha256_final, + sha512, sha512_init, sha512_update, sha512_final, md5_mac, md5_mac_96, sha_mac, sha_mac_96, sha_mac_init, sha_mac_update, sha_mac_final, @@ -95,7 +95,7 @@ aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt, info_lib]). --type rsa_digest_type() :: 'md5' | 'sha'. +-type rsa_digest_type() :: 'md5' | 'sha' | 'sha256' | 'sha384' | 'sha512'. -type dss_digest_type() :: 'none' | 'sha'. -type crypto_integer() :: binary() | integer(). @@ -219,6 +219,73 @@ sha_init() -> ?nif_stub. sha_update(_Context, _Data) -> ?nif_stub. sha_final(_Context) -> ?nif_stub. +% +%% SHA256 +%% +-spec sha256(iodata()) -> binary(). +-spec sha256_init() -> binary(). +-spec sha256_update(binary(), iodata()) -> binary(). +-spec sha256_final(binary()) -> binary(). + +sha256(Data) -> + case sha256_nif(Data) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. +sha256_init() -> + case sha256_init_nif() of + notsup -> erlang:error(notsup); + Bin -> Bin + end. +sha256_update(Context, Data) -> + case sha256_update_nif(Context, Data) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. +sha256_final(Context) -> + case sha256_final_nif(Context) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. + +sha256_nif(_Data) -> ?nif_stub. +sha256_init_nif() -> ?nif_stub. +sha256_update_nif(_Context, _Data) -> ?nif_stub. +sha256_final_nif(_Context) -> ?nif_stub. + +% +%% SHA512 +%% +-spec sha512(iodata()) -> binary(). +-spec sha512_init() -> binary(). +-spec sha512_update(binary(), iodata()) -> binary(). +-spec sha512_final(binary()) -> binary(). + +sha512(Data) -> + case sha512_nif(Data) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. +sha512_init() -> + case sha512_init_nif() of + notsup -> erlang:error(notsup); + Bin -> Bin + end. +sha512_update(Context, Data) -> + case sha512_update_nif(Context, Data) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. +sha512_final(Context) -> + case sha512_final_nif(Context) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. + +sha512_nif(_Data) -> ?nif_stub. +sha512_init_nif() -> ?nif_stub. +sha512_update_nif(_Context, _Data) -> ?nif_stub. +sha512_final_nif(_Context) -> ?nif_stub. %% %% MESSAGE AUTHENTICATION CODES @@ -522,8 +589,14 @@ dss_verify(_Type,_Data,_Signature,_Key) -> ?nif_stub. % Key = [E,N] E=PublicExponent N=PublicModulus rsa_verify(Data,Signature,Key) -> - rsa_verify(sha, Data,Signature,Key). -rsa_verify(_Type,_Data,_Signature,_Key) -> ?nif_stub. + rsa_verify_nif(sha, Data,Signature,Key). +rsa_verify(Type, Data, Signature, Key) -> + case rsa_verify_nif(Type, Data, Signature, Key) of + notsup -> erlang:error(notsup); + Bool -> Bool + end. + +rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. %% diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 86acdc27df..627c966dfb 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -68,30 +68,29 @@ rc4_test/1, rc4_stream_test/1, blowfish_cfb64/1, - smp/1, - cleanup/1]). + smp/1]). -export([hexstr2bin/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [link_test, md5, md5_update, md4, md4_update, md5_mac, - md5_mac_io, sha, sha_update, - hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, - %% sha256, sha256_update, sha512,sha512_update, - des_cbc, des_cfb, des3_cbc, des3_cfb, rc2_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb, - des_cbc, rc2_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, - rand_uniform_test, strong_rand_test, - rsa_verify_test, dsa_verify_test, rsa_sign_test, - dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, - rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, - smp]. - -groups() -> - []. + [link_test, {group, info}]. + +groups() -> + [{info, [sequence],[info, {group, rest}]}, + {rest, [], + [md5, md5_update, md4, md4_update, md5_mac, + md5_mac_io, sha, sha_update, + hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, + hmac_update_md5_io, hmac_update_md5, + des_cbc, aes_cfb, aes_cbc, + aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, + rand_uniform_test, strong_rand_test, + rsa_verify_test, dsa_verify_test, rsa_sign_test, + dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, + rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, + smp]}]. init_per_suite(Config) -> Config. @@ -105,11 +104,15 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(info, Config) -> + Config; init_per_testcase(_Name,Config) -> io:format("init_per_testcase\n"), ?line crypto:start(), Config. +end_per_testcase(info, Config) -> + Config; end_per_testcase(_Name,Config) -> io:format("end_per_testcase\n"), ?line crypto:stop(), @@ -197,13 +200,6 @@ info(Config) when is_list(Config) -> ?line crypto:stop() end. -cleanup(doc) -> - ["Cleanup (dummy)."]; -cleanup(suite) -> - []; -cleanup(Config) when is_list(Config) -> - Config. - %% %% md5(doc) -> diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 56eb46d78a..900ddf28c5 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -144,15 +144,20 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], 'error' -> Acc1; {ok, {{File, Line}, Contract}} -> Acc10 = Acc1, - SpecReturnType = dialyzer_contracts:get_contract_return(Contract), - SpecArgTypes = dialyzer_contracts:get_contract_args(Contract), + SpecReturnType0 = dialyzer_contracts:get_contract_return(Contract), + SpecArgTypes0 = dialyzer_contracts:get_contract_args(Contract), + SpecReturnType = erl_types:subst_all_vars_to_any(SpecReturnType0), + SpecArgTypes = + [erl_types:subst_all_vars_to_any(ArgT0) || ArgT0 <- SpecArgTypes0], Acc11 = case erl_types:t_is_subtype(SpecReturnType, CbReturnType) of true -> Acc10; - false -> [{callback_spec_type_mismatch, - [File, Line, Behaviour, Function, Arity, - erl_types:t_to_string(SpecReturnType, Records), - erl_types:t_to_string(CbReturnType, Records)]}|Acc10] + false -> + ExtraType = erl_types:t_subtract(SpecReturnType, CbReturnType), + [{callback_spec_type_mismatch, + [File, Line, Behaviour, Function, Arity, + erl_types:t_to_string(ExtraType, Records), + erl_types:t_to_string(CbReturnType, Records)]}|Acc10] end, Acc12 = case erl_types:any_none( diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 732bd4ac84..04a0db890f 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -29,10 +29,6 @@ -module(dialyzer_cl). -%% Avoid warning for local function error/1 clashing with autoimported BIF. --compile({no_auto_import,[error/1]}). -%% Avoid warning for local function error/2 clashing with autoimported BIF. --compile({no_auto_import,[error/2]}). -export([start/1]). -include("dialyzer.hrl"). @@ -88,7 +84,7 @@ init_opts_for_build(Opts) -> Plts -> Msg = io_lib:format("Could not build multiple PLT files: ~s\n", [format_plts(Plts)]), - error(Msg) + cl_error(Msg) end; false -> Opts#options{init_plts = []} end. @@ -110,7 +106,7 @@ init_opts_for_add(Opts) -> Plts -> Msg = io_lib:format("Could not add to multiple PLT files: ~s\n", [format_plts(Plts)]), - error(Msg) + cl_error(Msg) end; false -> case Opts#options.init_plts =:= [] of @@ -134,11 +130,12 @@ check_plt_aux([_] = Plt, Opts) -> report_check(Opts2), plt_common(Opts2, [], []); check_plt_aux([Plt|Plts], Opts) -> - Opts1 = Opts#options{init_plts = [Plt]}, - Opts2 = init_opts_for_check(Opts1), - report_check(Opts2), - plt_common(Opts2, [], []), - check_plt_aux(Plts, Opts). + case check_plt_aux([Plt], Opts) of + {?RET_NOTHING_SUSPICIOUS, []} -> check_plt_aux(Plts, Opts); + {?RET_DISCREPANCIES, Warns} -> + {_RET, MoreWarns} = check_plt_aux(Plts, Opts), + {?RET_DISCREPANCIES, Warns ++ MoreWarns} + end. init_opts_for_check(Opts) -> InitPlt = @@ -175,7 +172,7 @@ init_opts_for_remove(Opts) -> Plts -> Msg = io_lib:format("Could not remove from multiple PLT files: ~s\n", [format_plts(Plts)]), - error(Msg) + cl_error(Msg) end; false -> case Opts#options.init_plts =:= [] of @@ -193,7 +190,7 @@ plt_common(#options{init_plts = [InitPlt]} = Opts, RemoveFiles, AddFiles) -> none -> ok; OutPlt -> {ok, Binary} = file:read_file(InitPlt), - file:write_file(OutPlt, Binary) + ok = file:write_file(OutPlt, Binary) end, case Opts#options.report_mode of quiet -> ok; @@ -221,19 +218,19 @@ plt_common(#options{init_plts = [InitPlt]} = Opts, RemoveFiles, AddFiles) -> {error, no_such_file} -> Msg = io_lib:format("Could not find the PLT: ~s\n~s", [InitPlt, default_plt_error_msg()]), - error(Msg); + cl_error(Msg); {error, not_valid} -> Msg = io_lib:format("The file: ~s is not a valid PLT file\n~s", [InitPlt, default_plt_error_msg()]), - error(Msg); + cl_error(Msg); {error, read_error} -> Msg = io_lib:format("Could not read the PLT: ~s\n~s", [InitPlt, default_plt_error_msg()]), - error(Msg); + cl_error(Msg); {error, {no_file_to_remove, F}} -> Msg = io_lib:format("Could not remove the file ~s from the PLT: ~s\n", [F, InitPlt]), - error(Msg) + cl_error(Msg) end. default_plt_error_msg() -> @@ -426,7 +423,7 @@ assert_writable(PltFile) -> true -> ok; false -> Msg = io_lib:format(" The PLT file ~s is not writable", [PltFile]), - error(Msg) + cl_error(Msg) end. check_if_writable(PltFile) -> @@ -550,7 +547,7 @@ init_output(State0, #options{output_file = OutFile, {error, Reason} -> Msg = io_lib:format("Could not open output file ~p, Reason: ~p\n", [OutFile, Reason]), - error(State, lists:flatten(Msg)) + cl_error(State, lists:flatten(Msg)) end end. @@ -596,10 +593,10 @@ cl_loop(State, LogCache) -> cl_loop(NewState, LogCache); {'EXIT', BackendPid, {error, Reason}} -> Msg = failed_anal_msg(Reason, LogCache), - error(State, Msg); + cl_error(State, Msg); {'EXIT', BackendPid, Reason} when Reason =/= 'normal' -> Msg = failed_anal_msg(io_lib:format("~P", [Reason, 12]), LogCache), - error(State, Msg); + cl_error(State, Msg); _Other -> %% io:format("Received ~p\n", [_Other]), cl_loop(State, LogCache) @@ -632,14 +629,14 @@ store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> St#cl_state{unknown_behaviours = Beh ++ Behs}. --spec error(string()) -> no_return(). +-spec cl_error(string()) -> no_return(). -error(Msg) -> +cl_error(Msg) -> throw({dialyzer_error, Msg}). --spec error(#cl_state{}, string()) -> no_return(). +-spec cl_error(#cl_state{}, string()) -> no_return(). -error(State, Msg) -> +cl_error(State, Msg) -> case State#cl_state.output of standard_io -> ok; Outfile -> io:format(Outfile, "\n~s\n", [Msg]) diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 92868b6878..4268814859 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2046,8 +2046,7 @@ lookup_type(Key, Map) -> %% case cerl:is_literal(Key) of %% true -> t_from_term(cerl:concrete(Key)); %% false -> - Subst = t_subst(Key, Map), - t_sup(Subst, Subst). + t_subst(Key, Map). %% end. mk_var(Var) -> diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs index da498c225d..33d135048e 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs @@ -1,5 +1,5 @@ my_callbacks_wrong.erl:26: The return type #state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::'undefined' | pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour -my_callbacks_wrong.erl:30: The return type {'noreply',#state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} | {'reply',#state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour +my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::'undefined' | pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour my_callbacks_wrong.erl:39: The specified type for the 2nd argument of callback_call/3 (atom()) is not a supertype of pid(), which is expected type for this argument in the callback of the my_behaviour behaviour diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec b/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec new file mode 100644 index 0000000000..5284e412f0 --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec @@ -0,0 +1,6 @@ + +vars_in_beh_spec.erl:3: Undefined callback function handle_call/3 (behaviour 'gen_server') +vars_in_beh_spec.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server') +vars_in_beh_spec.erl:3: Undefined callback function handle_info/2 (behaviour 'gen_server') +vars_in_beh_spec.erl:3: Undefined callback function init/1 (behaviour 'gen_server') +vars_in_beh_spec.erl:3: Undefined callback function terminate/2 (behaviour 'gen_server') diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/vars_in_beh_spec.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/vars_in_beh_spec.erl new file mode 100644 index 0000000000..dc75b30d0e --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/vars_in_beh_spec.erl @@ -0,0 +1,10 @@ +-module(vars_in_beh_spec). + +-behaviour(gen_server). + +-export([code_change/3]). + +-spec code_change(_, State, _) -> {ok, State}. + +code_change(_, State, _) -> + {ok, State}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl new file mode 100644 index 0000000000..1743d81493 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl @@ -0,0 +1,7 @@ +-module(maybe_improper). + +-export([s/1]). + +-spec s(maybe_improper_list(X,Y)) -> {[X], maybe_improper_list(X,Y)}. +s(A) -> + lists:split(2,A). diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index c0e83ea1a4..a72ba2d75c 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -73,24 +73,30 @@ gen(Args) -> end. compile(#argv{file = File, options = Opts} = A) -> - try - Spec = diameter_spec_util:parse(File, Opts), - maybe_output(A, Spec, Opts, spec), %% the spec file - maybe_output(A, Spec, Opts, erl), %% the erl file - maybe_output(A, Spec, Opts, hrl), %% The hrl file - 0 + try diameter_dict_util:parse({path, File}, Opts) of + {ok, Spec} -> + maybe_output(A, Spec, Opts, spec), %% the spec file + maybe_output(A, Spec, Opts, erl), %% the erl file + maybe_output(A, Spec, Opts, hrl), %% The hrl file + 0; + {error, Reason} -> + error_msg(diameter_dict_util:format_error(Reason), []), + 1 catch error: Reason -> - error_msg({"ERROR: ~p~n ~p", [Reason, erlang:get_stacktrace()]}), + error_msg("ERROR: ~p~n ~p", [Reason, erlang:get_stacktrace()]), 2 end. maybe_output(#argv{file = File, output = Output}, Spec, Opts, Mode) -> lists:member(Mode, Output) - andalso diameter_codegen:from_spec(File, Spec, Opts, Mode). + andalso diameter_codegen:from_dict(File, Spec, Opts, Mode). error_msg({Fmt, Args}) -> - io:format(standard_error, Fmt ++ "~n", Args). + error_msg(Fmt, Args). + +error_msg(Fmt, Args) -> + io:format(standard_error, "** " ++ Fmt ++ "~n", Args). norm({_,_} = T) -> T; diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 2d8edb1301..93e2603c10 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -107,7 +107,9 @@ belonging to the application.</p> <marker id="application_module"/> </item> -<tag><c>application_module() = Mod | [Mod | ExtraArgs]</c></tag> +<tag><c>application_module() = Mod + | [Mod | ExtraArgs] + | #diameter_callback{}</c></tag> <item> <code> Mod = atom() @@ -125,6 +127,14 @@ specified to <seealso marker="#call">call/4</seealso>, in which case the call-specific arguments are appended to any specified with the callback module.</p> +<p> +Specifying a <c>#diameter_callback{}</c> record allows individual +functions to be configured in place of the usual <seealso +marker="diameter_app">diameter_app(3)</seealso> callbacks, with +default implementations provided by module <c>diameter_callback</c> +unless otherwise specified. +See that module for details.</p> + <marker id="application_opt"/> </item> diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index e7c530f1b8..cc638dbc18 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -36,7 +36,7 @@ under the License. <!-- ===================================================================== --> <file>diameter_dict</file> -<filesummary>Dictionary inteface of the diameter application.</filesummary> +<filesummary>Dictionary interface of the diameter application.</filesummary> <description> <p> @@ -44,9 +44,9 @@ A diameter service as configured with <seealso marker="diameter#start_service">diameter:start_service/2</seealso> specifies one or more supported Diameter applications. Each Diameter application specifies a dictionary module that knows how -to encode and decode its messages and AVP's. +to encode and decode its messages and AVPs. The dictionary module is in turn generated from a file that defines -these messages and AVP's. +these messages and AVPs. The format of such a file is defined in <seealso marker="#FILE_FORMAT">FILE FORMAT</seealso> below. Users add support for their specific applications by creating @@ -56,7 +56,7 @@ resulting dictionaries modules on a service.</p> <p> The codec generation also results in a hrl file that defines records -for the messages and grouped AVP's defined for the application, these +for the messages and grouped AVPs defined for the application, these records being what a user of the diameter application sends and receives. (Modulo other available formats as discussed in <seealso marker="diameter_app">diameter_app(3)</seealso>.) @@ -74,14 +74,14 @@ corresponding to applications defined in section 2.4 of RFC 3588: application with application identifier 0, <c>diameter_gen_accounting</c> for the Diameter Base Accounting application with application identifier 3 and -<c>diameter_gen_relay</c>the Relay application with application +<c>diameter_gen_relay</c> the Relay application with application identifier 0xFFFFFFFF. The Common Message and Relay applications are the only applications that diameter itself has any specific knowledge of. The Common Message application is used for messages that diameter itself handles: CER/CEA, DWR/DWA and DPR/DPA. The Relay application is given special treatment with regard to -encode/decode since the messages and AVP's it handles are not specifically +encode/decode since the messages and AVPs it handles are not specifically defined.</p> <marker id="FILE_FORMAT"/> @@ -94,18 +94,16 @@ defined.</p> <p> A dictionary file consists of distinct sections. -Each section starts with a line consisting of a tag -followed by zero or more arguments. -Each section ends at the the start of the next section or end of file. +Each section starts with a tag followed by zero or more arguments +and ends at the the start of the next section or end of file. Tags consist of an ampersand character followed by a keyword and are separated from their arguments by whitespace. -Whitespace within a section separates individual tokens but its -quantity is insignificant.</p> +Whitespace separates individual tokens but is otherwise insignificant.</p> <p> The tags, their arguments and the contents of each corresponding section are as follows. -Each section can occur at most once unless otherwise specified. +Each section can occur multiple times unless otherwise specified. The order in which sections are specified is unimportant.</p> <taglist> @@ -115,7 +113,8 @@ The order in which sections are specified is unimportant.</p> <p> Defines the integer Number as the Diameter Application Id of the application in question. -Required if the dictionary defines <c>@messages</c>. +Can occur at most once and is required if the dictionary defines +<c>@messages</c>. The section has empty content.</p> <p> @@ -136,16 +135,13 @@ Example:</p> <item> <p> Defines the name of the generated dictionary module. -The section has empty content. -Mod must match the regular expression '^[a-zA-Z0-9][-_a-zA-Z0-9]*$'; -that is, contains only alphanumerics, hyphens and underscores begin with an -alphanumeric.</p> +Can occur at most once and defaults to the name of the dictionary file +minus any extension if unspecified. +The section has empty content.</p> <p> -A name is optional and defaults to the name of the dictionary file -minus any extension. -Note that a generated module must have a unique name an not colide -with another module in the system.</p> +Note that a dictionary module should have a unique name so as not collide +with existing modules in the system.</p> <p> Example:</p> @@ -159,22 +155,22 @@ Example:</p> <tag><c>@prefix Name</c></tag> <item> <p> -Defines Name as the prefix to be added to record and constant names in -the generated dictionary module and hrl. -The section has empty content. -Name must be of the same form as a @name.</p> +Defines Name as the prefix to be added to record and constant names +(followed by a <c>'_'</c> character) in the generated dictionary +module and hrl. +Can occur at most once. +The section has empty content.</p> <p> -A prefix is optional but can -be used to disambiguate record and constant names -resulting from similarly named messages and AVP's in different -Diameter applications.</p> +A prefix is optional but can be be used to disambiguate between record +and constant names resulting from similarly named messages and AVPs in +different Diameter applications.</p> <p> Example:</p> <code> -@prefix etsi_e2_ +@prefix etsi_e2 </code> </item> @@ -182,10 +178,12 @@ Example:</p> <tag><c>@vendor Number Name</c></tag> <item> <p> -Defines the integer Number as the the default Vendor-ID of AVP's for +Defines the integer Number as the the default Vendor-Id of AVPs for which the V flag is set. Name documents the owner of the application but is otherwise unused. +Can occur at most once and is required if an AVP sets the V flag and +is not otherwise assigned a Vendor-Id. The section has empty content.</p> <p> @@ -200,10 +198,9 @@ Example:</p> <tag><c>@avp_vendor_id Number</c></tag> <item> <p> -Defines the integer Number as the Vendor-ID of the AVP's listed in the +Defines the integer Number as the Vendor-Id of the AVPs listed in the section content, overriding the <c>@vendor</c> default. -The section content consists of AVP names. -Can occur zero or more times (with different values of Number).</p> +The section content consists of AVP names.</p> <p> Example:</p> @@ -221,13 +218,27 @@ Region-Set <tag><c>@inherits Mod</c></tag> <item> <p> -Defines the name of a generated dictionary module containing AVP -definitions referenced by the dictionary but not defined by it. -The section content is empty.</p> +Defines the name of a dictionary module containing AVP +definitions that should be imported into the current dictionary. +The section content consists of the names of those AVPs whose +definitions should be imported from the dictionary, an empty list +causing all to be imported. +Any listed AVPs must not be defined in the current dictionary and +it is an error to inherit the same AVP from more than one +dictionary.</p> <p> -Can occur 0 or more times (with different values of Mod) but all -dictionaries should typically inherit RFC3588 AVPs from +Note that an inherited AVP that sets the V flag takes its Vendor-Id +from either <c>@avp_vendor_id</c> in the inheriting dictionary or +<c>@vendor</c> in the inherited dictionary. +In particular, <c>@avp_vendor_id</c> in the inherited dictionary is +ignored. +Inheriting from a dictionary that specifies the required <c>@vendor</c> +is equivalent to using <c>@avp_vendor_id</c> with a copy of the +dictionary's definitions but the former makes for easier reuse.</p> + +<p> +All dictionaries should typically inherit RFC3588 AVPs from <c>diameter_gen_base_rfc3588</c>.</p> <p> @@ -248,13 +259,11 @@ The section consists of definitions of the form</p> <p><c>Name Code Type Flags</c></p> <p> -where Code is the integer AVP code, Flags is a string of V, -M and P characters indicating the flags to be -set on an outgoing AVP or a single - (minus) character if none are to -be set. -Type identifies either an AVP Data Format as defined in <seealso -marker="#DATA_TYPES">DATA TYPES</seealso> below or a -type as defined by a <c>@custom_types</c> tag.</p> +where Code is the integer AVP code, Type identifies an AVP Data Format +as defined in <seealso marker="#DATA_TYPES">DATA TYPES</seealso> below, +and Flags is a string of V, M and P characters indicating the flags to be +set on an outgoing AVP or a single <c>'-'</c> (minus) character if +none are to be set.</p> <p> Example:</p> @@ -262,8 +271,8 @@ Example:</p> <code> @avp_types -Location-Information 350 Grouped VM -Requested-Information 353 Enumerated V +Location-Information 350 Grouped MV +Requested-Information 353 Enumerated V </code> <p> @@ -276,21 +285,36 @@ to 0 as mandated by the current draft standard.</p> <tag><c>@custom_types Mod</c></tag> <item> <p> -Defines AVPs for which module Mod provides encode/decode. -The section contents consists of type names. -For each AVP Name defined with custom type Type, Mod should export the -function Name/3 with arguments encode|decode, Type and Data, -the latter being the term to be encoded/decoded. -The function returns the encoded/decoded value.</p> +Specifies AVPs for which module Mod provides encode/decode functions. +The section contents consists of AVP names. +For each such name, <c>Mod:Name(encode|decode, Type, Data)</c> is +expected to provide encode/decode for values of the AVP, where Name is +the name of the AVP, Type is it's type as declared in the +<c>@avp_types</c> section of the dictionary and Data is the value to +encode/decode.</p> + +<p> +Example:</p> + +<code> +@custom_types rfc4005_avps + +Framed-IP-Address +</code> +</item> +<tag><c>@codecs Mod</c></tag> +<item> <p> -Can occur 0 or more times (with different values of Mod).</p> +Like <c>@custom_types</c> but requires the specified module to export +<c>Mod:Type(encode|decode, Name, Data)</c> rather than +<c>Mod:Name(encode|decode, Type, Data)</c>.</p> <p> Example:</p> <code> -@custom_types rfc4005_types +@codecs rfc4005_avps Framed-IP-Address </code> @@ -360,6 +384,10 @@ SIP-Deregistration-Reason ::= < AVP Header: 383 > [ SIP-Reason-Info ] * [ AVP ] </code> + +<p> +Specifying a Vendor-Id in the definition of a grouped AVP is +equivalent to specifying it with <c>@avp_vendor_id</c>.</p> </item> <tag><c>@enum Name</c></tag> @@ -371,11 +399,9 @@ Integer values can be prefixed with 0x to be interpreted as hexidecimal.</p> <p> -Can occur 0 or more times (with different values of Name). -The AVP in question can be defined in an inherited dictionary in order -to introduce additional values. -An AVP so extended must be referenced by in a <c>@messages</c> or -<c>@grouped</c> section.</p> +Note that the AVP in question can be defined in an inherited +dictionary in order to introduce additional values to an enumeration +otherwise defined in another dictionary.</p> <p> Example:</p> @@ -390,11 +416,18 @@ REMOVE_SIP_SERVER 3 </code> </item> +<tag><c>@end</c></tag> +<item> +<p> +Causes parsing of the dictionary to terminate: +any remaining content is ignored.</p> +</item> + </taglist> <p> Comments can be included in a dictionary file using semicolon: -text from a semicolon to end of line is ignored.</p> +characters from a semicolon to end of line are ignored.</p> <marker id="MESSAGE_RECORDS"/> </section> diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index 0fa7fd406f..4273262015 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -107,6 +107,21 @@ transport = sctp, %% | tcp, protocol = diameter}). %% | radius | 'tacacs+' +%% A diameter_callback record can be specified as an application +%% module in order to selectively receive callbacks or alter their +%% form. +-record(diameter_callback, + {peer_up, + peer_down, + pick_peer, + prepare_request, + prepare_retransmit, + handle_request, + handle_answer, + handle_error, + default, + extra = []}). + %% The diameter service and diameter_apps records are only passed %% through the transport interface when starting a transport process, %% although typically a transport implementation will (and probably diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index eea2aa894d..2ec016ecbc 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -54,14 +54,16 @@ VPATH = .:base:compiler:transport:gen include modules.mk +# Modules generated from dictionary specifications. DICT_MODULES = $(DICTS:%=gen/diameter_gen_%) DICT_ERLS = $(DICT_MODULES:%=%.erl) DICT_HRLS = $(DICT_MODULES:%=%.hrl) # Modules to build before compiling dictionaries. -COMPILER_MODULES = $(filter compiler/%, $(CT_MODULES)) +COMPILER_MODULES = $(notdir $(filter compiler/%, $(CT_MODULES))) \ + $(DICT_YRL) -# All handwritten modules. +# All handwritten modules from which a depend.mk is generated. MODULES = \ $(RT_MODULES) \ $(CT_MODULES) @@ -74,11 +76,12 @@ APP_MODULES = \ # Modules for which to build beams. TARGET_MODULES = \ $(APP_MODULES) \ - $(CT_MODULES) + $(CT_MODULES) \ + $(DICT_YRL:%=gen/%) # What to build for the 'opt' target. TARGET_FILES = \ - $(patsubst %,$(EBIN)/%.$(EMULATOR),$(notdir $(TARGET_MODULES))) \ + $(patsubst %, $(EBIN)/%.$(EMULATOR), $(notdir $(TARGET_MODULES))) \ $(APP_TARGET) \ $(APPUP_TARGET) @@ -125,6 +128,10 @@ opt: $(TARGET_FILES) debug: @$(MAKE) TYPE=debug opt +# The dictionary parser. +gen/$(DICT_YRL).erl: compiler/$(DICT_YRL).yrl + $(ERLC) -Werror -o $(@D) $< + # Generate the app file. $(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ @@ -146,6 +153,8 @@ info: @echo ======================================== @$(call list,DICTS) @echo + @$(call list,DICT_YRL) + @echo @$(call list,RT_MODULES) @echo @$(call list,CT_MODULES) @@ -164,7 +173,7 @@ info: @echo ======================================== clean: - rm -f $(TARGET_FILES) $(DICT_ERLS) $(DICT_HRLS) + rm -f $(TARGET_FILES) gen/* rm -f depend.mk # ---------------------------------------------------- @@ -192,8 +201,9 @@ release_spec: opt $(MAKE) $(TARGET_DIRS:%/=release_src_%) $(TARGET_DIRS:%/=release_src_%): release_src_%: - $(INSTALL_DATA) $(filter $*/%,$(TARGET_MODULES:%=%.erl) \ - $(INTERNAL_HRLS)) \ + $(INSTALL_DATA) $(filter $*/%, $(TARGET_MODULES:%=%.erl) \ + $(INTERNAL_HRLS)) \ + $(filter $*/%, compiler/$(DICT_YRL).yrl) \ $(RELSYSDIR)/src/$* release_docs_spec: @@ -207,7 +217,7 @@ gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ - $(COMPILER_MODULES:compiler/%=$(EBIN)/%.$(EMULATOR)) + $(COMPILER_MODULES:%=$(EBIN)/%.$(EMULATOR)) $(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \ $(INCDIR)/diameter.hrl \ @@ -224,11 +234,13 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile -include depend.mk -.PRECIOUS: $(DICT_ERLS) $(DICT_HRLS) .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) +# Keep intermediate files. +.SECONDARY: $(DICT_ERLS) $(DICT_HRLS) gen/$(DICT_YRL:%=%.erl) + # ---------------------------------------------------- # Targets using secondary expansion (make >= 3.81) # ---------------------------------------------------- @@ -237,4 +249,6 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile # Make beams from a subdirectory. $(TARGET_DIRS:%/=%): \ - $$(patsubst $$@/%,$(EBIN)/%.$(EMULATOR),$$(filter $$@/%,$(TARGET_MODULES))) + $$(patsubst $$@/%, \ + $(EBIN)/%.$(EMULATOR), \ + $$(filter $$@/%, $(TARGET_MODULES) compiler/$(DICT_YRL))) diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index 2f721421d8..336f0c1f2d 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -38,17 +38,47 @@ service_info/2]). %% Start/stop the application. In a "real" application this should -%% typically be a consequence of specifying diameter in a release file -%% rather than by calling start/stop explicitly. +%% typically be a consequence of a release file rather than by calling +%% start/stop explicitly. -export([start/0, stop/0]). +-export_type([evaluable/0, + app_alias/0, + service_name/0, + capability/0, + peer_filter/0, + service_opt/0, + application_opt/0, + app_module/0, + transport_ref/0, + transport_opt/0, + transport_pred/0, + call_opt/0]). + +-export_type(['OctetString'/0, + 'Integer32'/0, + 'Integer64'/0, + 'Unsigned32'/0, + 'Unsigned64'/0, + 'Float32'/0, + 'Float64'/0, + 'Grouped'/0, + 'Address'/0, + 'Time'/0, + 'UTF8String'/0, + 'DiameterIdentity'/0, + 'DiameterURI'/0, + 'Enumerated'/0, + 'IPFilterRule'/0, + 'QoSFilterRule'/0]). + +-include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_types.hrl"). -%%% -------------------------------------------------------------------------- -%%% start/0 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% start/0 +%% --------------------------------------------------------------------------- -spec start() -> ok @@ -57,9 +87,9 @@ start() -> application:start(?APPLICATION). -%%% -------------------------------------------------------------------------- -%%% stop/0 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% stop/0 +%% --------------------------------------------------------------------------- -spec stop() -> ok @@ -68,9 +98,9 @@ start() -> stop() -> application:stop(?APPLICATION). -%%% -------------------------------------------------------------------------- -%%% start_service/2 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% start_service/2 +%% --------------------------------------------------------------------------- -spec start_service(service_name(), [service_opt()]) -> ok @@ -80,9 +110,9 @@ start_service(SvcName, Opts) when is_list(Opts) -> diameter_config:start_service(SvcName, Opts). -%%% -------------------------------------------------------------------------- -%%% stop_service/1 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% stop_service/1 +%% --------------------------------------------------------------------------- -spec stop_service(service_name()) -> ok @@ -91,9 +121,9 @@ start_service(SvcName, Opts) stop_service(SvcName) -> diameter_config:stop_service(SvcName). -%%% -------------------------------------------------------------------------- -%%% services/0 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% services/0 +%% --------------------------------------------------------------------------- -spec services() -> [service_name()]. @@ -101,9 +131,9 @@ stop_service(SvcName) -> services() -> [Name || {Name, _} <- diameter_service:services()]. -%%% -------------------------------------------------------------------------- -%%% service_info/2 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% service_info/2 +%% --------------------------------------------------------------------------- -spec service_info(service_name(), atom() | [atom()]) -> any(). @@ -111,9 +141,9 @@ services() -> service_info(SvcName, Option) -> diameter_service:info(SvcName, Option). -%%% -------------------------------------------------------------------------- -%%% add_transport/3 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% add_transport/3 +%% --------------------------------------------------------------------------- -spec add_transport(service_name(), {listen|connect, [transport_opt()]}) -> {ok, transport_ref()} @@ -123,9 +153,9 @@ add_transport(SvcName, {T, Opts} = Cfg) when is_list(Opts), (T == connect orelse T == listen) -> diameter_config:add_transport(SvcName, Cfg). -%%% -------------------------------------------------------------------------- -%%% remove_transport/2 -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% remove_transport/2 +%% --------------------------------------------------------------------------- -spec remove_transport(service_name(), transport_pred()) -> ok | {error, term()}. @@ -133,12 +163,9 @@ add_transport(SvcName, {T, Opts} = Cfg) remove_transport(SvcName, Pred) -> diameter_config:remove_transport(SvcName, Pred). -%%% -------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% -%%% Description: Subscribe to #diameter_event{} messages for the specified -%%% service. -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% subscribe/1 +%% --------------------------------------------------------------------------- -spec subscribe(service_name()) -> true. @@ -146,9 +173,9 @@ remove_transport(SvcName, Pred) -> subscribe(SvcName) -> diameter_service:subscribe(SvcName). -%%% -------------------------------------------------------------------------- -%%% # unsubscribe(SvcName) -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% unsubscribe/1 +%% --------------------------------------------------------------------------- -spec unsubscribe(service_name()) -> true. @@ -156,9 +183,9 @@ subscribe(SvcName) -> unsubscribe(SvcName) -> diameter_service:unsubscribe(SvcName). -%%% ---------------------------------------------------------- -%%% # session_id/1 -%%% ---------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% session_id/1 +%% --------------------------------------------------------------------------- -spec session_id('DiameterIdentity'()) -> 'OctetString'(). @@ -166,9 +193,9 @@ unsubscribe(SvcName) -> session_id(Ident) -> diameter_session:session_id(Ident). -%%% ---------------------------------------------------------- -%%% # origin_state_id/0 -%%% ---------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% origin_state_id/0 +%% --------------------------------------------------------------------------- -spec origin_state_id() -> 'Unsigned32'(). @@ -176,9 +203,9 @@ session_id(Ident) -> origin_state_id() -> diameter_session:origin_state_id(). -%%% -------------------------------------------------------------------------- -%%% # call/[34] -%%% -------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% call/3,4 +%% --------------------------------------------------------------------------- -spec call(service_name(), app_alias(), any(), [call_opt()]) -> any(). @@ -188,3 +215,125 @@ call(SvcName, App, Message, Options) -> call(SvcName, App, Message) -> call(SvcName, App, Message, []). + +%% =========================================================================== + +%% Diameter basic types + +-type 'OctetString'() :: iolist(). +-type 'Integer32'() :: -2147483647..2147483647. +-type 'Integer64'() :: -9223372036854775807..9223372036854775807. +-type 'Unsigned32'() :: 0..4294967295. +-type 'Unsigned64'() :: 0..18446744073709551615. +-type 'Float32'() :: '-infinity' | float() | infinity. +-type 'Float64'() :: '-infinity' | float() | infinity. +-type 'Grouped'() :: list() | tuple(). + +%% Diameter derived types + +-type 'Address'() + :: inet:ip_address() + | string(). + +-type 'Time'() :: {{integer(), 1..12, 1..31}, + {0..23, 0..59, 0..59}}. +-type 'UTF8String'() :: iolist(). +-type 'DiameterIdentity'() :: 'OctetString'(). +-type 'DiameterURI'() :: 'OctetString'(). +-type 'Enumerated'() :: 'Integer32'(). +-type 'IPFilterRule'() :: 'OctetString'(). +-type 'QoSFilterRule'() :: 'OctetString'(). + +%% The handle to a service. + +-type service_name() + :: any(). + +%% Capabilities options/avps on start_service/2 and/or add_transport/2 + +-type capability() + :: {'Origin-Host', 'DiameterIdentity'()} + | {'Origin-Realm', 'DiameterIdentity'()} + | {'Host-IP-Address', ['Address'()]} + | {'Vendor-Id', 'Unsigned32'()} + | {'Product-Name', 'UTF8String'()} + | {'Supported-Vendor-Id', ['Unsigned32'()]} + | {'Auth-Application-Id', ['Unsigned32'()]} + | {'Vendor-Specific-Application-Id', ['Grouped'()]} + | {'Firmware-Revision', 'Unsigned32'()}. + +%% Filters for call/4 + +-type peer_filter() + :: none + | host + | realm + | {host, any|'DiameterIdentity'()} + | {realm, any|'DiameterIdentity'()} + | {eval, evaluable()} + | {neg, peer_filter()} + | {all, [peer_filter()]} + | {any, [peer_filter()]}. + +-type evaluable() + :: {module(), atom(), list()} + | fun() + | maybe_improper_list(evaluable(), list()). + +%% Options passed to start_service/2 + +-type service_opt() + :: capability() + | {application, [application_opt()]}. + +-type application_opt() + :: {alias, app_alias()} + | {dictionary, module()} + | {module, app_module()} + | {state, any()} + | {call_mutates_state, boolean()} + | {answer_errors, callback|report|discard}. + +-type app_alias() + :: any(). + +-type app_module() + :: module() + | maybe_improper_list(module(), list()) + | #diameter_callback{}. + +%% Identifier returned by add_transport/2 + +-type transport_ref() + :: reference(). + +%% Options passed to add_transport/2 + +-type transport_opt() + :: {transport_module, atom()} + | {transport_config, any()} + | {applications, [app_alias()]} + | {capabilities, [capability()]} + | {capabilities_cb, evaluable()} + | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} + | {reconnect_timer, 'Unsigned32'()} + | {private, any()}. + +%% Predicate passed to remove_transport/2 + +-type transport_pred() + :: fun((reference(), connect|listen, list()) -> boolean()) + | fun((reference(), list()) -> boolean()) + | fun((list()) -> boolean()) + | reference() + | list() + | {connect|listen, transport_pred()} + | {atom(), atom(), list()}. + +%% Options passed to call/4 + +-type call_opt() + :: {extra, list()} + | {filter, peer_filter()} + | {timeout, 'Unsigned32'()} + | detach. diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl index 6d5c8cdca1..90431099b0 100644 --- a/lib/diameter/src/base/diameter_callback.erl +++ b/lib/diameter/src/base/diameter_callback.erl @@ -18,11 +18,58 @@ %% %% -%% A minimal application callback module. +%% A diameter callback module that can redirect selected callbacks, +%% providing reasonable default implementations otherwise. +%% +%% To order alternate callbacks, configure a #diameter_callback record +%% as the Diameter application callback in question. The record has +%% one field for each callback function as well as 'default' and +%% 'extra' fields. A function-specific field can be set to a +%% diameter:evaluable() in order to redirect the callback +%% corresponding to that field, or to 'false' to request the default +%% callback implemented in this module. If neither of these fields are +%% set then the 'default' field determines the form of the callback: a +%% module name results in the usual callback as if the module had been +%% configured directly as the callback module, a diameter_evaluable() +%% in a callback applied to the atom-valued callback name and argument +%% list. For all callbacks not to this module, the 'extra' field is a +%% list of additional arguments, following arguments supplied by +%% diameter but preceeding those of the diameter:evaluable() being +%% applied. +%% +%% For example, the following config to diameter:start_service/2, in +%% an 'application' tuple, would result in only a mymod:peer_down/3 +%% callback, this module implementing the remaining callbacks. +%% +%% {module, #diameter_callback{peer_down = {mymod, down, []}}} +%% +%% Equivalently, this can also be specified with a [Mod | Args] +%% field/value list as follows. +%% +%% {module, [diameter_callback, {peer_down, {mymod, down, []}}]} +%% +%% The following would result in this module suppying peer_up and +%% peer_down callback, others taking place in module mymod. +%% +%% {module, #diameter_callback{peer_up = false, +%% peer_down = false, +%% default = mymod}} +%% +%% The following would result in all callbacks taking place as +%% calls to mymod:diameter/2. +%% +%% {module, #diameter_callback{default = {mymod, diameter, []}}} +%% +%% The following are equivalent and result in all callbacks being +%% provided by this module. +%% +%% {module, #diameter_callback{}} +%% {module, diameter_callback} %% -module(diameter_callback). +%% Default callbacks when no aleternate is specified. -export([peer_up/3, peer_down/3, pick_peer/4, @@ -32,6 +79,16 @@ handle_answer/4, handle_error/4]). +%% Callbacks taking a #diameter_callback record. +-export([peer_up/4, + peer_down/4, + pick_peer/5, + prepare_request/4, + prepare_retransmit/4, + handle_request/4, + handle_answer/5, + handle_error/5]). + -include_lib("diameter/include/diameter.hrl"). %%% ---------------------------------------------------------- @@ -41,51 +98,137 @@ peer_up(_Svc, _Peer, State) -> State. +peer_up(Svc, Peer, State, D) -> + cb(peer_up, + [Svc, Peer, State], + D#diameter_callback.peer_up, + D). + %%% ---------------------------------------------------------- %%% # peer_down/3 %%% ---------------------------------------------------------- -peer_down(_SvcName, _Peer, State) -> +peer_down(_Svc, _Peer, State) -> State. +peer_down(Svc, Peer, State, D) -> + cb(peer_down, + [Svc, Peer, State], + D#diameter_callback.peer_down, + D). + %%% ---------------------------------------------------------- %%% # pick_peer/4 %%% ---------------------------------------------------------- -pick_peer([Peer|_], _, _SvcName, _State) -> - {ok, Peer}. +pick_peer([Peer|_], _, _Svc, _State) -> + {ok, Peer}; +pick_peer([], _, _Svc, _State) -> + false. + +pick_peer(PeersL, PeersR, Svc, State, D) -> + cb(pick_peer, + [PeersL, PeersR, Svc, State], + D#diameter_callback.pick_peer, + D). %%% ---------------------------------------------------------- %%% # prepare_request/3 %%% ---------------------------------------------------------- -prepare_request(Pkt, _SvcName, _Peer) -> +prepare_request(Pkt, _Svc, _Peer) -> {send, Pkt}. +prepare_request(Pkt, Svc, Peer, D) -> + cb(prepare_request, + [Pkt, Svc, Peer], + D#diameter_callback.prepare_request, + D). + %%% ---------------------------------------------------------- %%% # prepare_retransmit/3 %%% ---------------------------------------------------------- -prepare_retransmit(Pkt, _SvcName, _Peer) -> +prepare_retransmit(Pkt, _Svc, _Peer) -> {send, Pkt}. +prepare_retransmit(Pkt, Svc, Peer, D) -> + cb(prepare_retransmit, + [Pkt, Svc, Peer], + D#diameter_callback.prepare_retransmit, + D). + %%% ---------------------------------------------------------- %%% # handle_request/3 %%% ---------------------------------------------------------- -handle_request(_Pkt, _SvcName, _Peer) -> +handle_request(_Pkt, _Svc, _Peer) -> {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED +handle_request(Pkt, Svc, Peer, D) -> + cb(handle_request, + [Pkt, Svc, Peer], + D#diameter_callback.handle_request, + D). + %%% ---------------------------------------------------------- %%% # handle_answer/4 %%% ---------------------------------------------------------- -handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> - Ans. +handle_answer(#diameter_packet{msg = Ans, errors = []}, _Req, _Svc, _Peer) -> + Ans; +handle_answer(#diameter_packet{msg = Ans, errors = Es}, _Req, _Svc, _Peer) -> + [Ans | Es]. + +handle_answer(Pkt, Req, Svc, Peer, D) -> + cb(handle_answer, + [Pkt, Req, Svc, Peer], + D#diameter_callback.handle_answer, + D). %%% --------------------------------------------------------------------------- %%% # handle_error/4 %%% --------------------------------------------------------------------------- -handle_error(Reason, _Req, _SvcName, _Peer) -> +handle_error(Reason, _Req, _Svc, _Peer) -> {error, Reason}. + +handle_error(Reason, Req, Svc, Peer, D) -> + cb(handle_error, + [Reason, Req, Svc, Peer], + D#diameter_callback.handle_error, + D). + +%% =========================================================================== + +%% cb/4 + +%% Unspecified callback: use default field to determine something +%% appropriate. +cb(CB, Args, undefined, D) -> + cb(CB, Args, D); + +%% Explicitly requested default. +cb(CB, Args, false, _) -> + apply(?MODULE, CB, Args); + +%% A specified callback. +cb(_, Args, F, #diameter_callback{extra = X}) -> + diameter_lib:eval([[F|X] | Args]). + +%% cb/3 + +%% No user-supplied default: call ours. +cb(CB, Args, #diameter_callback{default = undefined}) -> + apply(?MODULE, CB, Args); + +%% Default is a module name: make the usual callback. +cb(CB, Args, #diameter_callback{default = M, + extra = X}) + when is_atom(M) -> + apply(M, CB, Args ++ X); + +%% Default is something else: apply if to callback name and arguments. +cb(CB, Args, #diameter_callback{default = F, + extra = X}) -> + diameter_lib:eval([F, CB, Args | X]). diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 842a9e6103..6c4d60ee9b 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -54,7 +54,6 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_types.hrl"). -include("diameter_gen_base_rfc3588.hrl"). -define(SUCCESS, 2001). %% DIAMETER_SUCCESS @@ -75,13 +74,17 @@ build_CER(Caps) -> try_it([fun bCER/1, Caps]). -spec recv_CER(#diameter_base_CER{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}). + -> tried({[diameter:'Unsigned32'()], + #diameter_caps{}, + #diameter_base_CEA{}}). recv_CER(CER, Svc) -> try_it([fun rCER/2, CER, Svc]). -spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). + -> tried({[diameter:'Unsigned32'()], + [diameter:'Unsigned32'()], + #diameter_caps{}}). recv_CEA(CEA, Svc) -> try_it([fun rCEA/2, CEA, Svc]). diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index a6b48fe65b..9253af0de2 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -605,6 +605,13 @@ app_acc({application, Opts}, Acc) -> app_acc(_, Acc) -> Acc. +init_mod(#diameter_callback{} = R) -> + init_mod([diameter_callback, R]); +init_mod([diameter_callback, #diameter_callback{}] = L) -> + L; +init_mod([diameter_callback = M | L]) + when is_list(L) -> + [M, init_cb(L)]; init_mod(M) when is_atom(M) -> [M]; @@ -614,6 +621,14 @@ init_mod([M|_] = L) init_mod(M) -> ?THROW({module, M}). +init_cb(List) -> + Fields = record_info(fields, diameter_callback), + Defaults = lists:zip(Fields, tl(tuple_to_list(#diameter_callback{}))), + Values = [V || F <- Fields, + D <- [proplists:get_value(F, Defaults)], + V <- [proplists:get_value(F, List, D)]], + #diameter_callback{} = list_to_tuple([diameter_callback | Values]). + init_mutable(M) when M == true; M == false -> diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index fae5d763dc..99644814d2 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -46,7 +46,6 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_types.hrl"). -include("diameter_gen_base_rfc3588.hrl"). -define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). @@ -78,7 +77,8 @@ parent :: pid(), transport :: pid(), service :: #diameter_service{}, - dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}). + dpr = false :: false | {diameter:'Unsigned32'(), + diameter:'Unsigned32'()}}). %% | hop by hop and end to end identifiers %% There are non-3588 states possible as a consequence of 5.6.1 of the diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 7adcf1c265..0893956f97 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -64,7 +64,6 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_types.hrl"). -define(STATE_UP, up). -define(STATE_DOWN, down). @@ -117,7 +116,7 @@ {pid :: match(pid()), type :: match(connect | accept), ref :: match(reference()), %% key into diameter_config - options :: match([transport_opt()]), %% as passed to start_transport + options :: match([diameter:transport_opt()]),%% from start_transport op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP), started = now(), %% at process start conn = false :: match(boolean() | pid())}). @@ -126,7 +125,7 @@ %% Record representing a peer_fsm process. -record(conn, {pid :: pid(), - apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias} + apps :: [{0..16#FFFFFFFF, diameter:app_alias()}], %% {Id, Alias} caps :: #diameter_caps{}, started = now(), %% at process start peer :: pid()}). %% key into peerT @@ -137,16 +136,16 @@ handler :: match(pid()), %% request process transport :: match(pid()), %% peer process caps :: match(#diameter_caps{}), - app :: match(app_alias()), %% #diameter_app.alias + app :: match(diameter:app_alias()), %% #diameter_app.alias dictionary :: match(module()), %% #diameter_app.dictionary - module :: match(nonempty_improper_list(module(), list())), + module :: match([module() | list()]), %% #diameter_app.module - filter :: match(peer_filter()), + filter :: match(diameter:peer_filter()), packet :: match(#diameter_packet{})}). %% Record call/4 options are parsed into. -record(options, - {filter = none :: peer_filter(), + {filter = none :: diameter:peer_filter(), extra = [] :: list(), timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, detach = false :: boolean()}). @@ -647,11 +646,6 @@ mod_state(Alias) -> mod_state(Alias, ModS) -> put({?MODULE, mod_state, Alias}, ModS). -%% have_transport/2 - -have_transport(SvcName, Ref) -> - [] /= diameter_config:have_transport(SvcName, Ref). - %%% --------------------------------------------------------------------------- %%% # shutdown/2 %%% --------------------------------------------------------------------------- @@ -1131,7 +1125,7 @@ start_tc(Tc, T, _) -> %% tc_timeout/2 tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) -> - tc(have_transport(SvcName, Ref), T, S). + tc(diameter_config:have_transport(SvcName, Ref), T, S). tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} = S) -> @@ -1159,7 +1153,7 @@ close(Pid, #state{service_name = SvcName, options = Opts} = fetch(PeerT, Pid), - c(Pid, have_transport(SvcName, Ref), Opts). + c(Pid, diameter_config:have_transport(SvcName, Ref), Opts). %% Tell watchdog to (maybe) die later ... c(Pid, true, Opts) -> @@ -1490,7 +1484,7 @@ pd([], _) -> send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) when node() == node(TPid) -> %% Store the outgoing request before sending to avoid a race with - %% reply reception. + %% reply reception. TRef = store_request(TPid, Bin, Req, Timeout), send(TPid, Pkt), TRef; @@ -1946,7 +1940,7 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = Es, when [] == Es; is_record(hd(Msg), diameter_header) -> Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers + incr(send, Pkt, TPid), %% count result codes in sent answers send(TPid, Pkt#diameter_packet{transport_data = TD}); %% Or not: set Result-Code and Failed-AVP AVP's. @@ -2218,12 +2212,11 @@ a(#diameter_packet{errors = []} SvcName, AE, #request{transport = TPid, - dictionary = Dict, caps = Caps, packet = P} = Req) -> try - incr(in, Pkt, Dict, TPid) + incr(in, Pkt, TPid) of _ -> cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]) @@ -2254,18 +2247,17 @@ e(Pkt, SvcName, discard, Req) -> %% Increment a stats counter for an incoming or outgoing message. %% TODO: fix -incr(_, #diameter_packet{msg = undefined}, _, _) -> +incr(_, #diameter_packet{msg = undefined}, _) -> ok; -incr(Dir, Pkt, Dict, TPid) +incr(Dir, Pkt, TPid) when is_pid(TPid) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, msg = Rec} = Pkt, - D = choose(E, ?BASE, Dict), - RC = int(get_avp_value(D, 'Result-Code', Rec)), + RC = int(get_avp_value(?BASE, 'Result-Code', Rec)), PE = is_protocol_error(RC), %% Check that the E bit is set only for 3xxx result codes. @@ -2273,7 +2265,7 @@ incr(Dir, Pkt, Dict, TPid) orelse (E andalso PE) orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), - Ctr = rc_counter(D, Rec, RC), + Ctr = rc_counter(Rec, RC), is_tuple(Ctr) andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). @@ -2291,11 +2283,11 @@ incr(TPid, Counter) -> %% Maintain statistics assuming one or the other, not both, which is %% surely the intent of the RFC. -rc_counter(_, _, RC) +rc_counter(_, RC) when is_integer(RC) -> {'Result-Code', RC}; -rc_counter(D, Rec, _) -> - rcc(get_avp_value(D, 'Experimental-Result', Rec)). +rc_counter(Rec, _) -> + rcc(get_avp_value(?BASE, 'Experimental-Result', Rec)). %% Outgoing answers may be in any of the forms messages can be sent %% in. Incoming messages will be records. We're assuming here that the @@ -2355,8 +2347,8 @@ rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> false; %% TODO: Not what we should do. %% ... or not. -rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) -> - find_transport(get_destination(Msg, D), Req, S). +rt(#request{packet = #diameter_packet{msg = Msg}} = Req, S) -> + find_transport(get_destination(Msg), Req, S). %%% --------------------------------------------------------------------------- %%% # report_status/5 @@ -2468,12 +2460,12 @@ find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> find_transport(#diameter_app{} = App, Msg, Opts, S) -> ft(App, Msg, Opts, S). -ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) -> +ft(#diameter_app{module = Mod} = App, Msg, Opts, S) -> #options{filter = Filter, extra = Xtra} = Opts, pick_peer(App#diameter_app{module = Mod ++ Xtra}, - get_destination(Msg, D), + get_destination(Msg), Filter, S); ft(false = No, _, _, _) -> @@ -2509,11 +2501,11 @@ find_transport([_,_] = RH, Filter, S). -%% get_destination/2 +%% get_destination/1 -get_destination(Msg, Dict) -> - [str(get_avp_value(Dict, 'Destination-Realm', Msg)), - str(get_avp_value(Dict, 'Destination-Host', Msg))]. +get_destination(Msg) -> + [str(get_avp_value(?BASE, 'Destination-Realm', Msg)), + str(get_avp_value(?BASE, 'Destination-Host', Msg))]. %% This is not entirely correct. The avp could have an arity 1, in %% which case an empty list is a DiameterIdentity of length 0 rather diff --git a/lib/diameter/src/base/diameter_session.erl b/lib/diameter/src/base/diameter_session.erl index bb91e97f39..4c468f207c 100644 --- a/lib/diameter/src/base/diameter_session.erl +++ b/lib/diameter/src/base/diameter_session.erl @@ -26,8 +26,6 @@ %% towards diameter_sup -export([init/0]). --include("diameter_types.hrl"). - -define(INT64, 16#FFFFFFFFFFFFFFFF). -define(INT32, 16#FFFFFFFF). @@ -73,7 +71,7 @@ %% consumed (see Section 6.2) SHOULD be silently discarded. -spec sequence() - -> 'Unsigned32'(). + -> diameter:'Unsigned32'(). sequence() -> Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT32, _SetVal = 0}, @@ -97,7 +95,7 @@ sequence() -> %% counter retained in non-volatile memory across restarts. -spec origin_state_id() - -> 'Unsigned32'(). + -> diameter:'Unsigned32'(). origin_state_id() -> ets:lookup_element(diameter_sequence, origin_state_id, 2). @@ -130,8 +128,8 @@ origin_state_id() -> %% <optional value> is implementation specific but may include a modem's %% device Id, a layer 2 address, timestamp, etc. --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). +-spec session_id(diameter:'DiameterIdentity'()) + -> diameter:'OctetString'(). %% Note that Session-Id has type UTF8String and that any OctetString %% is a UTF8String. diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl index 6b1b1b8d39..9ae289034c 100644 --- a/lib/diameter/src/base/diameter_types.erl +++ b/lib/diameter/src/base/diameter_types.erl @@ -42,8 +42,23 @@ 'IPFilterRule'/2, 'QoSFilterRule'/2]). +%% Functions taking the AVP name in question as second parameter. +-export(['OctetString'/3, + 'Integer32'/3, + 'Integer64'/3, + 'Unsigned32'/3, + 'Unsigned64'/3, + 'Float32'/3, + 'Float64'/3, + 'Address'/3, + 'Time'/3, + 'UTF8String'/3, + 'DiameterIdentity'/3, + 'DiameterURI'/3, + 'IPFilterRule'/3, + 'QoSFilterRule'/3]). + -include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). -define(UINT(N,X), ((0 =< X) andalso (X < 1 bsl N))). -define(SINT(N,X), ((-1*(1 bsl (N-1)) < X) andalso (X < 1 bsl (N-1)))). @@ -433,6 +448,50 @@ uenc([C | Rest], Acc) -> 'Time'(encode, zero) -> <<0:32>>. +%% ------------------------------------------------------------------------- + +'OctetString'(M, _, Data) -> + 'OctetString'(M, Data). + +'Integer32'(M, _, Data) -> + 'Integer32'(M, Data). + +'Integer64'(M, _, Data) -> + 'Integer64'(M, Data). + +'Unsigned32'(M, _, Data) -> + 'Unsigned32'(M, Data). + +'Unsigned64'(M, _, Data) -> + 'Unsigned64'(M, Data). + +'Float32'(M, _, Data) -> + 'Float32'(M, Data). + +'Float64'(M, _, Data) -> + 'Float64'(M, Data). + +'Address'(M, _, Data) -> + 'Address'(M, Data). + +'Time'(M, _, Data) -> + 'Time'(M, Data). + +'UTF8String'(M, _, Data) -> + 'UTF8String'(M, Data). + +'DiameterIdentity'(M, _, Data) -> + 'DiameterIdentity'(M, Data). + +'DiameterURI'(M, _, Data) -> + 'DiameterURI'(M, Data). + +'IPFilterRule'(M, _, Data) -> + 'IPFilterRule'(M, Data). + +'QoSFilterRule'(M, _, Data) -> + 'QoSFilterRule'(M, Data). + %% =========================================================================== %% =========================================================================== diff --git a/lib/diameter/src/base/diameter_types.hrl b/lib/diameter/src/base/diameter_types.hrl deleted file mode 100644 index 02bf8a74dd..0000000000 --- a/lib/diameter/src/base/diameter_types.hrl +++ /dev/null @@ -1,139 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. 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% -%% - -%% -%% Types for function specifications, primarily in diameter.erl. This -%% has nothing specifically to do with diameter_types.erl. -%% - --type evaluable() - :: {module(), atom(), list()} - | fun() - | nonempty_improper_list(evaluable(), list()). %% [evaluable() | Args] - --type app_alias() - :: any(). - --type service_name() - :: any(). - -%% Diameter basic types - --type 'OctetString'() :: iolist(). --type 'Integer32'() :: -2147483647..2147483647. --type 'Integer64'() :: -9223372036854775807..9223372036854775807. --type 'Unsigned32'() :: 0..4294967295. --type 'Unsigned64'() :: 0..18446744073709551615. --type 'Float32'() :: '-infinity' | float() | infinity. --type 'Float64'() :: '-infinity' | float() | infinity. --type 'Grouped'() :: list() | tuple(). - -%% Diameter derived types - --type 'Address'() - :: inet:ip_address() - | string(). - --type 'Time'() :: {{integer(), 1..12, 1..31}, - {0..23, 0..59, 0..59}}. --type 'UTF8String'() :: iolist(). --type 'DiameterIdentity'() :: 'OctetString'(). --type 'DiameterURI'() :: 'OctetString'(). --type 'Enumerated'() :: 'Integer32'(). --type 'IPFilterRule'() :: 'OctetString'(). --type 'QoSFilterRule'() :: 'OctetString'(). - -%% Capabilities options/avps on start_service/2 and/or add_transport/2 - --type capability() - :: {'Origin-Host', 'DiameterIdentity'()} - | {'Origin-Realm', 'DiameterIdentity'()} - | {'Host-IP-Address', ['Address'()]} - | {'Vendor-Id', 'Unsigned32'()} - | {'Product-Name', 'UTF8String'()} - | {'Supported-Vendor-Id', ['Unsigned32'()]} - | {'Auth-Application-Id', ['Unsigned32'()]} - | {'Vendor-Specific-Application-Id', ['Grouped'()]} - | {'Firmware-Revision', 'Unsigned32'()}. - -%% Filters for call/4 - --type peer_filter() - :: none - | host - | realm - | {host, any|'DiameterIdentity'()} - | {realm, any|'DiameterIdentity'()} - | {eval, evaluable()} - | {neg, peer_filter()} - | {all, [peer_filter()]} - | {any, [peer_filter()]}. - -%% Options passed to start_service/2 - --type service_opt() - :: capability() - | {application, [application_opt()]}. - --type application_opt() - :: {alias, app_alias()} - | {dictionary, module()} - | {module, app_module()} - | {state, any()} - | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. - --type app_module() - :: module() - | nonempty_improper_list(module(), list()). %% list with module() head - -%% Identifier returned by add_transport/2 - --type transport_ref() - :: reference(). - -%% Options passed to add_transport/2 - --type transport_opt() - :: {transport_module, atom()} - | {transport_config, any()} - | {applications, [app_alias()]} - | {capabilities, [capability()]} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} - | {reconnect_timer, 'Unsigned32'()} - | {private, any()}. - -%% Predicate passed to remove_transport/2 - --type transport_pred() - :: fun((reference(), connect|listen, list()) -> boolean()) - | fun((reference(), list()) -> boolean()) - | fun((list()) -> boolean()) - | reference() - | list() - | {connect|listen, transport_pred()} - | {atom(), atom(), list()}. - -%% Options passed to call/4 - --type call_opt() - :: {extra, list()} - | {filter, peer_filter()} - | {timeout, 'Unsigned32'()} - | detach. diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 0fd4a0b301..6763e06140 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -20,17 +20,18 @@ -module(diameter_codegen). %% -%% This module generates .erl and .hrl files for encode/decode -%% modules from the orddict parsed from a .dia (aka spec) file by -%% dis_spec_util. The generated code is very simple (one-liners), the -%% generated functions being called by code included from dis_gen.hrl -%% in order to encode/decode messages and AVPs. The orddict itself is -%% returned by dict/0 in the generated module and dis_spec_util calls -%% this function when importing spec files. (That is, beam has to be -%% compiled from an imported spec file before it can be imported.) +%% This module generates erl/hrl files for encode/decode modules +%% from the orddict parsed from a dictionary file (.dia) by +%% diameter_dict_util. The generated code is simple (one-liners), +%% the generated functions being called by code included iin the +%% generated modules from diameter_gen.hrl. The orddict itself is +%% returned by dict/0 in the generated module and diameter_dict_util +%% calls this function when importing dictionaries as a consequence +%% of @inherits sections. That is, @inherits introduces a dependency +%% on the beam file of another dictionary. %% --export([from_spec/4]). +-export([from_dict/4]). %% Internal exports (for test). -export([file/1, @@ -38,17 +39,23 @@ file/3]). -include("diameter_forms.hrl"). +-include("diameter_vsn.hrl"). -%% Generated functions that could have no generated clauses will have -%% a trailing ?UNEXPECTED clause that should never execute. --define(UNEXPECTED(N), {?clause, [?VAR('_') || _ <- lists:seq(1,N)], - [], - [?APPLY(erlang, - error, - [?TERM({unexpected, getr(module)})])]}). +-define(S, atom_to_list). +-define(A, list_to_atom). +-define(Atom(T), ?ATOM(?A(T))). -from_spec(File, Spec, Opts, Mode) -> +%% =========================================================================== + +-spec from_dict(File, Spec, Opts, Mode) + -> ok + when File :: string(), + Spec :: orddict:orddict(), + Opts :: list(), + Mode :: spec | erl | hrl. + +from_dict(File, Spec, Opts, Mode) -> Outdir = proplists:get_value(outdir, Opts, "."), putr(verbose, lists:member(verbose, Opts)), putr(debug, lists:member(debug, Opts)), @@ -73,7 +80,7 @@ getr(Key) -> %% =========================================================================== %% =========================================================================== -%% Generate from parsed spec in a file. +%% Generate from parsed dictionary in a file. file(F) -> file(F, spec). @@ -83,14 +90,11 @@ file(F, Mode) -> file(F, Outdir, Mode) -> {ok, [Spec]} = file:consult(F), - from_spec(F, Spec, Outdir, Mode). + from_dict(F, Spec, Outdir, Mode). %% =========================================================================== %% =========================================================================== -choose(true, X, _) -> X; -choose(false, _, X) -> X. - get_value(Key, Plist) -> proplists:get_value(Key, Plist, []). @@ -108,27 +112,21 @@ w(Path, Spec, Fmt) -> codegen(File, Spec, Outdir, Mode) -> Mod = mod(File, orddict:find(name, Spec)), Path = filename:join(Outdir, Mod), %% minus extension - gen(Mode, Spec, Mod, Path), + gen(Mode, Spec, ?A(Mod), Path), ok. mod(File, error) -> filename:rootname(filename:basename(File)); mod(_, {ok, Mod}) -> - atom_to_list(Mod). + Mod. gen(spec, Spec, _Mod, Path) -> - write(Path ++ ".spec", Spec); + write(Path ++ ".spec", [?VERSION | Spec]); gen(hrl, Spec, Mod, Path) -> gen_hrl(Path ++ ".hrl", Mod, Spec); -gen(erl = Mode, Spec, Mod, Path) - when is_list(Mod) -> - gen(Mode, Spec, list_to_atom(Mod), Path); - gen(erl, Spec, Mod, Path) -> - putr(module, Mod), %% used by ?UNEXPECTED. - Forms = [{?attribute, module, Mod}, {?attribute, compile, [{parse_transform, diameter_exprecs}]}, {?attribute, compile, [nowarn_unused_function]}, @@ -224,16 +222,16 @@ a_record(Prefix, ProjF, L) -> lists:map(fun(T) -> a_record(ProjF(T), Prefix) end, L). a_record({Nm, Avps}, Prefix) -> - Name = list_to_atom(Prefix ++ atom_to_list(Nm)), + Name = list_to_atom(Prefix ++ Nm), Fields = lists:map(fun field/1, Avps), {?attribute, record, {Name, Fields}}. field(Avp) -> {Name, Arity} = avp_info(Avp), if 1 == Arity -> - {?record_field, ?ATOM(Name)}; + {?record_field, ?Atom(Name)}; true -> - {?record_field, ?ATOM(Name), ?NIL} + {?record_field, ?Atom(Name), ?NIL} end. %%% ------------------------------------------------------------------------ @@ -256,25 +254,33 @@ c_id({ok, Id}) -> {?clause, [], [], [?INTEGER(Id)]}; c_id(error) -> - ?UNEXPECTED(0). + ?BADARG(0). %%% ------------------------------------------------------------------------ %%% # vendor_id/0 %%% ------------------------------------------------------------------------ f_vendor_id(Spec) -> - {Id, _} = orddict:fetch(vendor, Spec), {?function, vendor_id, 0, - [{?clause, [], [], [?INTEGER(Id)]}]}. + [{?clause, [], [], [b_vendor_id(orddict:find(vendor, Spec))]}]}. + +b_vendor_id({ok, {Id, _}}) -> + ?INTEGER(Id); +b_vendor_id(error) -> + ?APPLY(erlang, error, [?TERM(undefined)]). %%% ------------------------------------------------------------------------ %%% # vendor_name/0 %%% ------------------------------------------------------------------------ f_vendor_name(Spec) -> - {_, Name} = orddict:fetch(vendor, Spec), {?function, vendor_name, 0, - [{?clause, [], [], [?ATOM(Name)]}]}. + [{?clause, [], [], [b_vendor_name(orddict:find(vendor, Spec))]}]}. + +b_vendor_name({ok, {_, Name}}) -> + ?Atom(Name); +b_vendor_name(error) -> + ?APPLY(erlang, error, [?TERM(undefined)]). %%% ------------------------------------------------------------------------ %%% # msg_name/1 @@ -287,22 +293,18 @@ f_msg_name(Spec) -> %% DIAMETER_COMMAND_UNSUPPORTED should be replied. msg_name(Spec) -> - lists:flatmap(fun c_msg_name/1, - proplists:get_value(command_codes, Spec, [])) + lists:flatmap(fun c_msg_name/1, proplists:get_value(command_codes, + Spec, + [])) ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?ATOM('')]}]. c_msg_name({Code, Req, Ans}) -> [{?clause, [?INTEGER(Code), ?ATOM(true)], [], - [?ATOM(mname(Req))]}, + [?Atom(Req)]}, {?clause, [?INTEGER(Code), ?ATOM(false)], [], - [?ATOM(mname(Ans))]}]. - -mname({N, _Abbr}) -> - N; -mname(N) -> - N. + [?Atom(Ans)]}]. %%% ------------------------------------------------------------------------ %%% # msg2rec/1 @@ -313,30 +315,11 @@ f_msg2rec(Spec) -> msg2rec(Spec) -> Pre = prefix(Spec), - Dict = dict:from_list(lists:flatmap(fun msgs/1, - get_value(command_codes, Spec))), - lists:flatmap(fun(T) -> msg2rec(T, Dict, Pre) end, - get_value(messages, Spec)) - ++ [?UNEXPECTED(1)]. - -msgs({_Code, Req, Ans}) -> - [{mname(Req), Req}, {mname(Ans), Ans}]. - -msg2rec({N,_,_,_,_}, Dict, Pre) -> - c_msg2rec(fetch_names(N, Dict), Pre). - -fetch_names(Name, Dict) -> - case dict:find(Name, Dict) of - {ok, N} -> - N; - error -> - Name - end. + lists:map(fun(T) -> c_msg2rec(T, Pre) end, get_value(messages, Spec)) + ++ [?BADARG(1)]. -c_msg2rec({N,A}, Pre) -> - [c_name2rec(N, N, Pre), c_name2rec(A, N, Pre)]; -c_msg2rec(N, Pre) -> - [c_name2rec(N, N, Pre)]. +c_msg2rec({N,_,_,_,_}, Pre) -> + c_name2rec(N, Pre). %%% ------------------------------------------------------------------------ %%% # rec2msg/1 @@ -348,10 +331,10 @@ f_rec2msg(Spec) -> rec2msg(Spec) -> Pre = prefix(Spec), lists:map(fun(T) -> c_rec2msg(T, Pre) end, get_value(messages, Spec)) - ++ [?UNEXPECTED(1)]. + ++ [?BADARG(1)]. c_rec2msg({N,_,_,_,_}, Pre) -> - {?clause, [?ATOM(rec_name(N, Pre))], [], [?ATOM(N)]}. + {?clause, [?Atom(rec_name(N, Pre))], [], [?Atom(N)]}. %%% ------------------------------------------------------------------------ %%% # name2rec/1 @@ -364,11 +347,11 @@ name2rec(Spec) -> Pre = prefix(Spec), Groups = get_value(grouped, Spec) ++ lists:flatmap(fun avps/1, get_value(import_groups, Spec)), - lists:map(fun({N,_,_,_}) -> c_name2rec(N, N, Pre) end, Groups) + lists:map(fun({N,_,_,_}) -> c_name2rec(N, Pre) end, Groups) ++ [{?clause, [?VAR('T')], [], [?CALL(msg2rec, [?VAR('T')])]}]. -c_name2rec(Name, Rname, Pre) -> - {?clause, [?ATOM(Name)], [], [?ATOM(rec_name(Rname, Pre))]}. +c_name2rec(Name, Pre) -> + {?clause, [?Atom(Name)], [], [?Atom(rec_name(Name, Pre))]}. avps({_Mod, Avps}) -> Avps. @@ -390,32 +373,47 @@ f_avp_name(Spec) -> %% allocated by IANA (see Section 11.1). avp_name(Spec) -> - Avps = get_value(avp_types, Spec) - ++ lists:flatmap(fun avps/1, get_value(import_avps, Spec)), - {Vid, _} = orddict:fetch(vendor, Spec), - Vs = lists:flatmap(fun({V,Ns}) -> [{N,V} || N <- Ns] end, - get_value(avp_vendor_id, Spec)), + Avps = get_value(avp_types, Spec), + Imported = get_value(import_avps, Spec), + Vid = orddict:find(vendor, Spec), + Vs = vendor_id_map(Spec), - lists:map(fun(T) -> c_avp_name(T, Vid, Vs) end, Avps) + lists:map(fun(T) -> c_avp_name(T, Vs, Vid) end, Avps) + ++ lists:flatmap(fun(T) -> c_imported_avp_name(T, Vs) end, Imported) ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?ATOM('AVP')]}]. -c_avp_name({Name, Code, Type, Flags, _Encr}, Vid, Vs) -> - c_avp_name({Name, Type}, - Code, - lists:member('V', Flags), - Vid, - proplists:get_value(Name, Vs)). +c_avp_name({Name, Code, Type, Flags}, Vs, Vid) -> + c_avp_name_(?TERM({?A(Name), ?A(Type)}), + ?INTEGER(Code), + vid(Name, Flags, Vs, Vid)). -c_avp_name(T, Code, false, _, undefined = U) -> - {?clause, [?INTEGER(Code), ?ATOM(U)], +%% Note that an imported AVP's vendor id is determined by +%% avp_vendor_id in the inheriting module and vendor in the inherited +%% module. In particular, avp_vendor_id in the inherited module is +%% ignored so can't just call Mod:avp_header/1 to retrieve the vendor +%% id. A vendor id specified in @grouped is equivalent to one +%% specified as avp_vendor_id. + +c_imported_avp_name({Mod, Avps}, Vs) -> + lists:map(fun(A) -> c_avp_name(A, Vs, {module, Mod}) end, Avps). + +c_avp_name_(T, Code, undefined = U) -> + {?clause, [Code, ?ATOM(U)], [], - [?TERM(T)]}; + [T]}; -c_avp_name(T, Code, true, Vid, V) - when is_integer(Vid) -> - {?clause, [?INTEGER(Code), ?INTEGER(choose(V == undefined, Vid, V))], +c_avp_name_(T, Code, Vid) -> + {?clause, [Code, ?INTEGER(Vid)], [], - [?TERM(T)]}. + [T]}. + +vendor_id_map(Spec) -> + lists:flatmap(fun({V,Ns}) -> [{N,V} || N <- Ns] end, + get_value(avp_vendor_id, Spec)) + ++ lists:flatmap(fun({_,_,[],_}) -> []; + ({N,_,[V],_}) -> [{N,V}] + end, + get_value(grouped, Spec)). %%% ------------------------------------------------------------------------ %%% # avp_arity/2 @@ -445,60 +443,75 @@ c_avp_arity(Name, Avps) -> c_arity(Name, Avp) -> {AvpName, Arity} = avp_info(Avp), - {?clause, [?ATOM(Name), ?ATOM(AvpName)], [], [?TERM(Arity)]}. + {?clause, [?Atom(Name), ?Atom(AvpName)], [], [?TERM(Arity)]}. %%% ------------------------------------------------------------------------ %%% # avp/3 %%% ------------------------------------------------------------------------ f_avp(Spec) -> - {?function, avp, 3, avp(Spec) ++ [?UNEXPECTED(3)]}. + {?function, avp, 3, avp(Spec) ++ [?BADARG(3)]}. avp(Spec) -> - Native = get_value(avp_types, Spec), - Custom = get_value(custom_types, Spec), - Imported = get_value(import_avps, Spec), - Enums = get_value(enums, Spec), - avp([{N,T} || {N,_,T,_,_} <- Native], Imported, Custom, Enums). + Native = get_value(avp_types, Spec), + CustomMods = get_value(custom_types, Spec), + TypeMods = get_value(codecs, Spec), + Imported = get_value(import_avps, Spec), + Enums = get_value(enum, Spec), -avp(Native, Imported, Custom, Enums) -> - Dict = orddict:from_list(Native), + Custom = lists:map(fun({M,As}) -> {M, custom_types, As} end, + CustomMods) + ++ lists:map(fun({M,As}) -> {M, codecs, As} end, + TypeMods), + avp(types(Native), Imported, Custom, Enums). + +types(Avps) -> + lists:map(fun({N,_,T,_}) -> {N,T} end, Avps). - report(native, Dict), +avp(Native, Imported, Custom, Enums) -> + report(native, Native), report(imported, Imported), report(custom, Custom), - CustomNames = lists:flatmap(fun({_,Ns}) -> Ns end, Custom), + TypeDict = lists:foldl(fun({N,_,T,_}, D) -> orddict:store(N,T,D) end, + orddict:from_list(Native), + lists:flatmap(fun avps/1, Imported)), + + CustomNames = lists:flatmap(fun({_,_,Ns}) -> Ns end, Custom), lists:map(fun c_base_avp/1, - lists:filter(fun({N,_}) -> - false == lists:member(N, CustomNames) - end, + lists:filter(fun({N,_}) -> not_in(CustomNames, N) end, Native)) - ++ lists:flatmap(fun(I) -> cs_imported_avp(I, Enums) end, Imported) - ++ lists:flatmap(fun(C) -> cs_custom_avp(C, Dict) end, Custom). + ++ lists:flatmap(fun(I) -> cs_imported_avp(I, Enums, CustomNames) end, + Imported) + ++ lists:flatmap(fun(C) -> cs_custom_avp(C, TypeDict) end, Custom). + +not_in(List, X) -> + not lists:member(X, List). c_base_avp({AvpName, T}) -> - {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], + {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName)], [], - [base_avp(AvpName, T)]}. + [b_base_avp(AvpName, T)]}. -base_avp(AvpName, 'Enumerated') -> - ?CALL(enumerated_avp, [?VAR('T'), ?ATOM(AvpName), ?VAR('Data')]); +b_base_avp(AvpName, "Enumerated") -> + ?CALL(enumerated_avp, [?VAR('T'), ?Atom(AvpName), ?VAR('Data')]); -base_avp(AvpName, 'Grouped') -> - ?CALL(grouped_avp, [?VAR('T'), ?ATOM(AvpName), ?VAR('Data')]); +b_base_avp(AvpName, "Grouped") -> + ?CALL(grouped_avp, [?VAR('T'), ?Atom(AvpName), ?VAR('Data')]); -base_avp(_, Type) -> - ?APPLY(diameter_types, Type, [?VAR('T'), ?VAR('Data')]). +b_base_avp(_, Type) -> + ?APPLY(diameter_types, ?A(Type), [?VAR('T'), ?VAR('Data')]). -cs_imported_avp({Mod, Avps}, Enums) -> - lists:map(fun(A) -> imported_avp(Mod, A, Enums) end, Avps). +cs_imported_avp({Mod, Avps}, Enums, CustomNames) -> + lists:map(fun(A) -> imported_avp(Mod, A, Enums) end, + lists:filter(fun({N,_,_,_}) -> not_in(CustomNames, N) end, + Avps)). -imported_avp(_Mod, {AvpName, _, 'Grouped' = T, _, _}, _) -> +imported_avp(_Mod, {AvpName, _, "Grouped" = T, _}, _) -> c_base_avp({AvpName, T}); -imported_avp(Mod, {AvpName, _, 'Enumerated' = T, _, _}, Enums) -> +imported_avp(Mod, {AvpName, _, "Enumerated" = T, _}, Enums) -> case lists:keymember(AvpName, 1, Enums) of true -> c_base_avp({AvpName, T}); @@ -506,34 +519,40 @@ imported_avp(Mod, {AvpName, _, 'Enumerated' = T, _, _}, Enums) -> c_imported_avp(Mod, AvpName) end; -imported_avp(Mod, {AvpName, _, _, _, _}, _) -> +imported_avp(Mod, {AvpName, _, _, _}, _) -> c_imported_avp(Mod, AvpName). c_imported_avp(Mod, AvpName) -> - {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], + {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName)], [], [?APPLY(Mod, avp, [?VAR('T'), ?VAR('Data'), - ?ATOM(AvpName)])]}. + ?Atom(AvpName)])]}. -cs_custom_avp({Mod, Avps}, Dict) -> - lists:map(fun(N) -> c_custom_avp(Mod, N, orddict:fetch(N, Dict)) end, +cs_custom_avp({Mod, Key, Avps}, Dict) -> + lists:map(fun(N) -> c_custom_avp(Mod, Key, N, orddict:fetch(N, Dict)) end, Avps). -c_custom_avp(Mod, AvpName, Type) -> - {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], +c_custom_avp(Mod, Key, AvpName, Type) -> + {F,A} = custom(Key, AvpName, Type), + {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName)], [], - [?APPLY(Mod, AvpName, [?VAR('T'), ?ATOM(Type), ?VAR('Data')])]}. + [?APPLY(?A(Mod), ?A(F), [?VAR('T'), ?Atom(A), ?VAR('Data')])]}. + +custom(custom_types, AvpName, Type) -> + {AvpName, Type}; +custom(codecs, AvpName, Type) -> + {Type, AvpName}. %%% ------------------------------------------------------------------------ %%% # enumerated_avp/3 %%% ------------------------------------------------------------------------ f_enumerated_avp(Spec) -> - {?function, enumerated_avp, 3, enumerated_avp(Spec) ++ [?UNEXPECTED(3)]}. + {?function, enumerated_avp, 3, enumerated_avp(Spec) ++ [?BADARG(3)]}. enumerated_avp(Spec) -> - Enums = get_value(enums, Spec), + Enums = get_value(enum, Spec), lists:flatmap(fun cs_enumerated_avp/1, Enums) ++ lists:flatmap(fun({M,Es}) -> enumerated_avp(M, Es, Enums) end, get_value(import_enums, Spec)). @@ -554,11 +573,11 @@ cs_enumerated_avp(false, _, _) -> cs_enumerated_avp({AvpName, Values}) -> lists:flatmap(fun(V) -> c_enumerated_avp(AvpName, V) end, Values). -c_enumerated_avp(AvpName, {I,_}) -> - [{?clause, [?ATOM(decode), ?ATOM(AvpName), ?TERM(<<I:32/integer>>)], +c_enumerated_avp(AvpName, {_,I}) -> + [{?clause, [?ATOM(decode), ?Atom(AvpName), ?TERM(<<I:32/integer>>)], [], [?TERM(I)]}, - {?clause, [?ATOM(encode), ?ATOM(AvpName), ?INTEGER(I)], + {?clause, [?ATOM(encode), ?Atom(AvpName), ?INTEGER(I)], [], [?TERM(<<I:32/integer>>)]}]. @@ -567,7 +586,7 @@ c_enumerated_avp(AvpName, {I,_}) -> %%% ------------------------------------------------------------------------ f_msg_header(Spec) -> - {?function, msg_header, 1, msg_header(Spec) ++ [?UNEXPECTED(1)]}. + {?function, msg_header, 1, msg_header(Spec) ++ [?BADARG(1)]}. msg_header(Spec) -> msg_header(get_value(messages, Spec), Spec). @@ -582,7 +601,7 @@ msg_header(Msgs, Spec) -> %% Note that any application id in the message header spec is ignored. c_msg_header(Name, Code, Flags, ApplId) -> - {?clause, [?ATOM(Name)], + {?clause, [?Atom(Name)], [], [?TERM({Code, encode_msg_flags(Flags), ApplId})]}. @@ -598,50 +617,61 @@ emf('ERR', N) -> N bor 2#00100000. %%% ------------------------------------------------------------------------ f_avp_header(Spec) -> - {?function, avp_header, 1, avp_header(Spec) ++ [?UNEXPECTED(1)]}. + {?function, avp_header, 1, avp_header(Spec) ++ [?BADARG(1)]}. avp_header(Spec) -> Native = get_value(avp_types, Spec), Imported = get_value(import_avps, Spec), - {Vid, _} = orddict:fetch(vendor, Spec), - Vs = lists:flatmap(fun({V,Ns}) -> [{N,V} || N <- Ns] end, - get_value(avp_vendor_id, Spec)), + Vid = orddict:find(vendor, Spec), + Vs = vendor_id_map(Spec), - lists:flatmap(fun(A) -> c_avp_header({Vid, Vs}, A) end, + lists:flatmap(fun(A) -> c_avp_header(A, Vs, Vid) end, Native ++ Imported). -c_avp_header({Vid, Vs}, {Name, Code, _Type, Flags, _Encr}) -> - [{?clause, [?ATOM(Name)], +c_avp_header({Name, Code, _Type, Flags}, Vs, Vid) -> + [{?clause, [?Atom(Name)], [], [?TERM({Code, encode_avp_flags(Flags), vid(Name, Flags, Vs, Vid)})]}]; -c_avp_header({_, Vs}, {Mod, Avps}) -> - lists:map(fun(A) -> c_avp_header(Vs, Mod, A) end, Avps). +c_avp_header({Mod, Avps}, Vs, _Vid) -> + lists:map(fun(A) -> c_imported_avp_header(A, Mod, Vs) end, Avps). -c_avp_header(Vs, Mod, {Name, _, _, Flags, _}) -> - Apply = ?APPLY(Mod, avp_header, [?ATOM(Name)]), - {?clause, [?ATOM(Name)], +%% Note that avp_vendor_id in the inherited dictionary is ignored. The +%% value must be changed in the inheriting dictionary. This is +%% consistent with the semantics of avp_name/2. + +c_imported_avp_header({Name, _Code, _Type, _Flags}, Mod, Vs) -> + Apply = ?APPLY(Mod, avp_header, [?Atom(Name)]), + {?clause, [?Atom(Name)], [], [case proplists:get_value(Name, Vs) of undefined -> Apply; Vid -> - true = lists:member('V', Flags), %% sanity check ?CALL(setelement, [?INTEGER(3), Apply, ?INTEGER(Vid)]) end]}. encode_avp_flags(Fs) -> lists:foldl(fun eaf/2, 0, Fs). -eaf('V', F) -> 2#10000000 bor F; -eaf('M', F) -> 2#01000000 bor F; -eaf('P', F) -> 2#00100000 bor F. +eaf($V, F) -> 2#10000000 bor F; +eaf($M, F) -> 2#01000000 bor F; +eaf($P, F) -> 2#00100000 bor F. vid(Name, Flags, Vs, Vid) -> - v(lists:member('V', Flags), Name, Vs, Vid). + v(lists:member($V, Flags), Name, Vs, Vid). + +v(true = T, Name, Vs, {module, Mod}) -> + v(T, Name, Vs, {ok, {Mod:vendor_id(), Mod:vendor_name()}}); v(true, Name, Vs, Vid) -> - proplists:get_value(Name, Vs, Vid); + case proplists:get_value(Name, Vs) of + undefined -> + {ok, {Id, _}} = Vid, + Id; + Id -> + Id + end; v(false, _, _, _) -> undefined. @@ -656,19 +686,19 @@ empty_value(Spec) -> Imported = lists:flatmap(fun avps/1, get_value(import_enums, Spec)), Groups = get_value(grouped, Spec) ++ lists:flatmap(fun avps/1, get_value(import_groups, Spec)), - Enums = [T || {N,_} = T <- get_value(enums, Spec), + Enums = [T || {N,_} = T <- get_value(enum, Spec), not lists:keymember(N, 1, Imported)] ++ Imported, lists:map(fun c_empty_value/1, Groups ++ Enums) ++ [{?clause, [?VAR('Name')], [], [?CALL(empty, [?VAR('Name')])]}]. c_empty_value({Name, _, _, _}) -> - {?clause, [?ATOM(Name)], + {?clause, [?Atom(Name)], [], - [?CALL(empty_group, [?ATOM(Name)])]}; + [?CALL(empty_group, [?Atom(Name)])]}; c_empty_value({Name, _}) -> - {?clause, [?ATOM(Name)], + {?clause, [?Atom(Name)], [], [?TERM(<<0:32/integer>>)]}. @@ -678,7 +708,7 @@ c_empty_value({Name, _}) -> f_dict(Spec) -> {?function, dict, 0, - [{?clause, [], [], [?TERM(Spec)]}]}. + [{?clause, [], [], [?TERM([?VERSION | Spec])]}]}. %%% ------------------------------------------------------------------------ %%% # gen_hrl/3 @@ -706,10 +736,10 @@ gen_hrl(Path, Mod, Spec) -> write("ENUM Macros", Fd, - m_enums(PREFIX, false, get_value(enums, Spec))), + m_enums(PREFIX, false, get_value(enum, Spec))), write("DEFINE Macros", Fd, - m_enums(PREFIX, false, get_value(defines, Spec))), + m_enums(PREFIX, false, get_value(define, Spec))), lists:foreach(fun({M,Es}) -> write("ENUM Macros from " ++ atom_to_list(M), @@ -751,8 +781,8 @@ m_enums(Prefix, Wrap, Enums) -> m_enum(Prefix, B, {Name, Values}) -> P = Prefix ++ to_upper(Name) ++ "_", - lists:map(fun({I,A}) -> - N = ["'", P, to_upper(z(atom_to_list(A))), "'"], + lists:map(fun({A,I}) -> + N = ["'", P, to_upper(z(A)), "'"], wrap(B, N, ["-define(", N, ", ", integer_to_list(I), ").\n"]) @@ -794,15 +824,15 @@ header() -> "%%\n\n"). hrl_header(Name) -> - header() ++ "-hrl_name('" ++ Name ++ ".hrl').\n". + header() ++ "-hrl_name('" ++ ?S(Name) ++ ".hrl').\n". %% avp_info/1 avp_info(Entry) -> %% {Name, Arity} case Entry of - {'<',A,'>'} -> {A, 1}; - {A} -> {A, 1}; - [A] -> {A, {0,1}}; + {{A}} -> {A, 1}; + {A} -> {A, 1}; + [A] -> {A, {0,1}}; {Q,T} -> {A,_} = avp_info(T), {A, arity(Q)} @@ -818,10 +848,10 @@ arity(T) -> T. prefix(Spec) -> case orddict:find(prefix, Spec) of {ok, P} -> - atom_to_list(P) ++ "_"; + P ++ "_"; error -> "" end. rec_name(Name, Prefix) -> - list_to_atom(Prefix ++ atom_to_list(Name)). + Prefix ++ Name. diff --git a/lib/diameter/src/compiler/diameter_dict_parser.yrl b/lib/diameter/src/compiler/diameter_dict_parser.yrl new file mode 100644 index 0000000000..6fd4cedd23 --- /dev/null +++ b/lib/diameter/src/compiler/diameter_dict_parser.yrl @@ -0,0 +1,324 @@ +%% -*- erlang -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% +%% A grammar for dictionary specification. +%% + +Nonterminals + application_id avp avp_code avp_def avp_defs avp_flags avp_header + avp_header_tok avp_name avp_names avp_ref avp_spec avp_type + avp_vendor avps bit bits command_def command_id diameter_name + dictionary enum_def enum_defs group_def group_defs header header_tok + ident idents message_defs module qual section sections. + +Terminals + avp_types avp_vendor_id codecs custom_types define enum grouped + id inherits messages name prefix vendor + number word + '{' '}' '<' '>' '[' ']' '*' '::=' ':' ',' '-' + code + 'answer-message' + 'AVP' 'AVP-Header' + 'Diameter' 'Diameter-Header' 'Header' + 'REQ' 'PXY' 'ERR'. + +Rootsymbol dictionary. + +Endsymbol '$end'. + +%% =========================================================================== + +dictionary -> sections : '$1'. + +sections -> '$empty' : []. +sections -> section sections : ['$1' | '$2']. + +section -> name ident : ['$1', '$2']. +section -> prefix ident : ['$1', '$2']. +section -> id number : ['$1', '$2']. +section -> vendor number ident : ['$1', '$2', '$3']. +section -> inherits module avp_names : ['$1', '$2' | '$3']. +section -> avp_types avp_defs : ['$1' | '$2']. +section -> avp_vendor_id number avp_names : ['$1', '$2' | '$3']. +section -> custom_types module avp_names : ['$1', '$2' | '$3']. +section -> codecs module avp_names : ['$1', '$2' | '$3']. +section -> messages message_defs : ['$1' | '$2']. +section -> grouped group_defs : ['$1' | '$2']. +section -> enum ident enum_defs : ['$1', '$2' | '$3']. +section -> define ident enum_defs : ['$1', '$2' | '$3']. + +%% ===================================== + +module -> ident : '$1'. + +avp_names -> idents : '$1'. %% Note: not 'AVP' + +avp_defs -> '$empty' : []. +avp_defs -> avp_def avp_defs : ['$1' | '$2']. + +avp_def -> ident number avp_type avp_flags : ['$1', '$2', '$3', '$4']. + +avp_type -> ident : '$1'. + +idents -> '$empty' : []. +idents -> ident idents : ['$1' | '$2']. + +avp_flags -> '-' : + {_, Lineno} = '$1', + {word, Lineno, ""}. +avp_flags -> ident : + '$1'. +%% Could support lowercase here if there's a use for distinguishing +%% between Must and Should in the future in deciding whether or not +%% to set a flag. + +ident -> word : '$1'. + +%% Don't bother mapping reserved words to make these usable in this +%% context. That an AVP can't be named Diameter-Header is probably no +%% great loss, and that it can't be named AVP may even save someone +%% from themselves. (Temporarily at least.) + +group_defs -> '$empty' : []. +group_defs -> group_def group_defs : ['$1' | '$2']. + +message_defs -> '$empty' : []. +message_defs -> command_def message_defs : ['$1' | '$2']. + +enum_defs -> '$empty' : []. +enum_defs -> enum_def enum_defs : ['$1' | '$2']. + +enum_def -> ident number : ['$1', '$2']. + +%% ===================================== +%% 3.2. Command Code ABNF specification +%% +%% Every Command Code defined MUST include a corresponding ABNF +%% specification, which is used to define the AVPs that MUST or MAY be +%% present when sending the message. The following format is used in +%% the definition: + +%% command-def = <command-name> "::=" diameter-message +%% +%% command-name = diameter-name +%% +%% diameter-name = ALPHA *(ALPHA / DIGIT / "-") +%% +%% diameter-message = header [ *fixed] [ *required] [ *optional] + +%% answer-message is a special case. +command_def -> 'answer-message' '::=' '<' header_tok ':' code + ',' 'ERR' '[' 'PXY' ']' '>' + avps + : ['$1', false | '$13']. + +command_def -> diameter_name '::=' header avps + : ['$1', '$3' | '$4']. +%% Ensure the order fixed/required/optional by semantic checks rather +%% than grammatically since the latter requires more lookahead: don't +%% know until after a leading qual which of the three it is that's +%% being parsed. + +diameter_name -> ident : '$1'. + +%% header = "<" "Diameter Header:" command-id +%% [r-bit] [p-bit] [e-bit] [application-id] ">" +%% +%% command-id = 1*DIGIT +%% ; The Command Code assigned to the command +%% +%% r-bit = ", REQ" +%% ; If present, the 'R' bit in the Command +%% ; Flags is set, indicating that the message +%% ; is a request, as opposed to an answer. +%% +%% p-bit = ", PXY" +%% ; If present, the 'P' bit in the Command +%% ; Flags is set, indicating that the message +%% ; is proxiable. +%% +%% e-bit = ", ERR" +%% ; If present, the 'E' bit in the Command +%% ; Flags is set, indicating that the answer +%% ; message contains a Result-Code AVP in +%% ; the "protocol error" class. +%% +%% application-id = 1*DIGIT + +header -> '<' header_tok ':' command_id bits application_id '>' + : ['$4', '$5', '$6']. + +command_id -> number : '$1'. + +%% Accept both the form of the base definition and the typo (fixed in +%% 3588bis) of the grammar. +header_tok -> 'Diameter' 'Header'. +header_tok -> 'Diameter-Header'. + +bits -> '$empty' : []. +bits -> ',' bit bits : ['$2' | '$3']. + +%% ERR only makes sense for answer-message so don't allow it here +%% (despite 3588). +bit -> 'REQ' : '$1'. +bit -> 'PXY' : '$1'. + +application_id -> '$empty' : false. +application_id -> number : '$1'. + +%% fixed = [qual] "<" avp-spec ">" +%% ; Defines the fixed position of an AVP +%% +%% required = [qual] "{" avp-spec "}" +%% ; The AVP MUST be present and can appear +%% ; anywhere in the message. +%% +%% optional = [qual] "[" avp-name "]" +%% ; The avp-name in the 'optional' rule cannot +%% ; evaluate to any AVP Name which is included +%% ; in a fixed or required rule. The AVP can +%% ; appear anywhere in the message. +%% ; +%% ; NOTE: "[" and "]" have a slightly different +%% ; meaning than in ABNF (RFC 5234]). These braces +%% ; cannot be used to express optional fixed rules +%% ; (such as an optional ICV at the end). To do this, +%% ; the convention is '0*1fixed'. + +avps -> '$empty' : []. +avps -> avp avps : ['$1' | '$2']. + +avp -> avp_ref : [false | '$1']. +avp -> qual avp_ref : ['$1' | '$2']. + +avp_ref -> '<' avp_spec '>' : [$<, '$2']. +avp_ref -> '{' avp_name '}' : [${, '$2']. +avp_ref -> '[' avp_name ']' : [$[, '$2']. +%% Note that required can be an avp_name, not just avp_spec. 'AVP' +%% is specified as required by Failed-AVP for example. + +%% qual = [min] "*" [max] +%% ; See ABNF conventions, RFC 5234 Section 4. +%% ; The absence of any qualifiers depends on +%% ; whether it precedes a fixed, required, or +%% ; optional rule. If a fixed or required rule has +%% ; no qualifier, then exactly one such AVP MUST +%% ; be present. If an optional rule has no +%% ; qualifier, then 0 or 1 such AVP may be +%% ; present. If an optional rule has a qualifier, +%% ; then the value of min MUST be 0 if present. +%% +%% min = 1*DIGIT +%% ; The minimum number of times the element may +%% ; be present. If absent, the default value is zero +%% ; for fixed and optional rules and one for required +%% ; rules. The value MUST be at least one for for +%% ; required rules. +%% +%% max = 1*DIGIT +%% ; The maximum number of times the element may +%% ; be present. If absent, the default value is +%% ; infinity. A value of zero implies the AVP MUST +%% ; NOT be present. + +qual -> number '*' number : {'$1', '$3'}. +qual -> number '*' : {'$1', true}. +qual -> '*' number : {true, '$2'}. +qual -> '*' : true. + +%% avp-spec = diameter-name +%% ; The avp-spec has to be an AVP Name, defined +%% ; in the base or extended Diameter +%% ; specifications. + +avp_spec -> diameter_name : '$1'. + +%% avp-name = avp-spec / "AVP" +%% ; The string "AVP" stands for *any* arbitrary AVP +%% ; Name, not otherwise listed in that command code +%% ; definition. Addition this AVP is recommended for +%% ; all command ABNFs to allow for extensibility. + +avp_name -> 'AVP' : '$1'. +avp_name -> avp_spec : '$1'. + +%% The following is a definition of a fictitious command code: +%% +%% Example-Request ::= < Diameter Header: 9999999, REQ, PXY > +%% { User-Name } +%% * { Origin-Host } +%% * [ AVP ] + +%% ===================================== +%% 4.4. Grouped AVP Values +%% +%% The Diameter protocol allows AVP values of type 'Grouped'. This +%% implies that the Data field is actually a sequence of AVPs. It is +%% possible to include an AVP with a Grouped type within a Grouped type, +%% that is, to nest them. AVPs within an AVP of type Grouped have the +%% same padding requirements as non-Grouped AVPs, as defined in Section +%% 4. +%% +%% The AVP Code numbering space of all AVPs included in a Grouped AVP is +%% the same as for non-grouped AVPs. Receivers of a Grouped AVP that +%% does not have the 'M' (mandatory) bit set and one or more of the +%% encapsulated AVPs within the group has the 'M' (mandatory) bit set +%% MAY simply be ignored if the Grouped AVP itself is unrecognized. The +%% rule applies even if the encapsulated AVP with its 'M' (mandatory) +%% bit set is further encapsulated within other sub-groups; i.e. other +%% Grouped AVPs embedded within the Grouped AVP. +%% +%% Every Grouped AVP defined MUST include a corresponding grammar, using +%% ABNF [RFC5234] (with modifications), as defined below. + +%% grouped-avp-def = <name> "::=" avp +%% +%% name-fmt = ALPHA *(ALPHA / DIGIT / "-") +%% +%% name = name-fmt +%% ; The name has to be the name of an AVP, +%% ; defined in the base or extended Diameter +%% ; specifications. +%% +%% avp = header [ *fixed] [ *required] [ *optional] + +group_def -> ident '::=' avp_header avps : ['$1', '$3' | '$4']. + +%% header = "<" "AVP-Header:" avpcode [vendor] ">" +%% +%% avpcode = 1*DIGIT +%% ; The AVP Code assigned to the Grouped AVP +%% +%% vendor = 1*DIGIT +%% ; The Vendor-ID assigned to the Grouped AVP. +%% ; If absent, the default value of zero is +%% ; used. + +avp_header -> '<' avp_header_tok ':' avp_code avp_vendor '>' + : ['$4', '$5']. + +avp_header_tok -> 'AVP-Header'. +avp_header_tok -> 'AVP' 'Header'. + +avp_code -> number : '$1'. + +avp_vendor -> '$empty' : false. +avp_vendor -> number : '$1'. diff --git a/lib/diameter/src/compiler/diameter_dict_scanner.erl b/lib/diameter/src/compiler/diameter_dict_scanner.erl new file mode 100644 index 0000000000..45189376fb --- /dev/null +++ b/lib/diameter/src/compiler/diameter_dict_scanner.erl @@ -0,0 +1,276 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_dict_scanner). + +%% +%% A scanner for dictionary files of the form expected by yecc. +%% + +-export([scan/1, + format_error/1]). + +-export([is_name/1]). + +%% ----------------------------------------------------------- +%% # scan/1 +%% ----------------------------------------------------------- + +-spec scan(string() | binary()) + -> {ok, [Token]} + | {error, {string(), string(), Lineno}} + when Token :: {word, Lineno, string()} + | {number, Lineno, non_neg_integer()} + | {Symbol, Lineno}, + Lineno :: pos_integer(), + Symbol :: '{' | '}' | '<' | '>' | '[' | ']' + | '*' | '::=' | ':' | ',' | '-' + | avp_types + | avp_vendor_id + | codecs + | custom_types + | define + | grouped + | id + | inherits + | messages + | name + | prefix + | vendor + | '$end' + | code + | 'answer-message' + | 'AVP' + | 'AVP-Header' + | 'Diameter' + | 'Diameter-Header' + | 'Header' + | 'REQ' + | 'PXY' + | 'ERR'. + +scan(B) + when is_binary(B) -> + scan(binary_to_list(B)); +scan(S) -> + scan(S, {1, []}). + +scan(S, {Lineno, Acc}) -> + case split(S) of + '$end' = E -> + {ok, lists:reverse([{E, Lineno} | Acc])}; + {Tok, Rest} -> + scan(Rest, acc(Tok, Lineno, Acc)); + Reason when is_list(Reason) -> + {error, {Reason, S, Lineno}} + end. + +%% format_error/1 + +format_error({Reason, Input, Lineno}) -> + io_lib:format("~s at line ~p: ~s", + [Reason, Lineno, head(Input, [], 20, true)]). + +%% is_name/1 + +is_name([H|T]) -> + is_alphanum(H) andalso lists:all(fun is_name_ch/1, T). + +%% =========================================================================== + +head(Str, Acc, N, _) + when [] == Str; + 0 == N; + $\r == hd(Str); + $\n == hd(Str) -> + lists:reverse(Acc); +head([C|Rest], Acc, N, true = T) %% skip leading whitespace + when C == $\s; + C == $\t; + C == $\f; + C == $\v -> + head(Rest, Acc, N, T); +head([C|Rest], Acc, N, _) -> + head(Rest, [C|Acc], N-1, false). + +acc(endline, Lineno, Acc) -> + {Lineno + 1, Acc}; +acc(T, Lineno, Acc) -> + {Lineno, [tok(T, Lineno) | Acc]}. + +tok({Cat, Sym}, Lineno) -> + {Cat, Lineno, Sym}; +tok(Sym, Lineno) -> + {Sym, Lineno}. + +%% # split/1 +%% +%% Output: {Token, Rest} | atom() + +%% Finito. +split("") -> + '$end'; + +%% Skip comments. This precludes using semicolon for any other purpose. +split([$;|T]) -> + split(lists:dropwhile(fun(C) -> not is_eol_ch(C) end, T)); + +%% Beginning of a section. +split([$@|T]) -> + {Name, Rest} = lists:splitwith(fun is_name_ch/1, T), + case section(Name) of + false -> + "Unknown section"; + 'end' -> + '$end'; + A -> + {A, Rest} + end; + +split("::=" ++ T) -> + {'::=', T}; + +split([H|T]) + when H == ${; H == $}; + H == $<; H == $>; + H == $[; H == $]; + H == $*; H == $:; H == $,; H == $- -> + {list_to_atom([H]), T}; + +%% RFC 3588 requires various names to begin with a letter but 3GPP (for +%% one) abuses this. (eg 3GPP-Charging-Id in TS32.299.) +split([H|_] = L) when $0 =< H, H =< $9 -> + {P, Rest} = splitwith(fun is_name_ch/1, L), + Tok = try + {number, read_int(P)} + catch + error:_ -> + word(P) + end, + {Tok, Rest}; + +split([H|_] = L) when $a =< H, H =< $z; + $A =< H, H =< $Z -> + {P, Rest} = splitwith(fun is_name_ch/1, L), + {word(P), Rest}; + +split([$'|T]) -> + case lists:splitwith(fun(C) -> not lists:member(C, "'\r\n") end, T) of + {[_|_] = A, [$'|Rest]} -> + {{word, A}, Rest}; + {[], [$'|_]} -> + "Empty string"; + _ -> %% not terminated on same line + "Unterminated string" + end; + +%% Line ending of various forms. +split([$\r,$\n|T]) -> + {endline, T}; +split([C|T]) + when C == $\r; + C == $\n -> + {endline, T}; + +%% Ignore whitespace. +split([C|T]) + when C == $\s; + C == $\t; + C == $\f; + C == $\v -> + split(T); + +split(_) -> + "Unexpected character". + +%% word/1 + +%% Reserved words significant in parsing ... +word(S) + when S == "answer-message"; + S == "code"; + S == "AVP"; + S == "AVP-Header"; + S == "Diameter"; + S == "Diameter-Header"; + S == "Header"; + S == "REQ"; + S == "PXY"; + S == "ERR" -> + list_to_atom(S); + +%% ... or not. +word(S) -> + {word, S}. + +%% section/1 + +section(N) + when N == "avp_types"; + N == "avp_vendor_id"; + N == "codecs"; + N == "custom_types"; + N == "define"; + N == "end"; + N == "enum"; + N == "grouped"; + N == "id"; + N == "inherits"; + N == "messages"; + N == "name"; + N == "prefix"; + N == "vendor" -> + list_to_atom(N); +section(_) -> + false. + +%% read_int/1 + +read_int([$0,X|S]) + when X == $X; + X == $x -> + {ok, [N], []} = io_lib:fread("~16u", S), + N; + +read_int(S) -> + list_to_integer(S). + +%% splitwith/3 + +splitwith(Fun, [H|T]) -> + {SH, ST} = lists:splitwith(Fun, T), + {[H|SH], ST}. + +is_eol_ch(C) -> + C == $\n orelse C == $\r. + +is_name_ch(C) -> + is_alphanum(C) orelse C == $- orelse C == $_. + +is_alphanum(C) -> + is_lower(C) orelse is_upper(C) orelse is_digit(C). + +is_lower(C) -> + $a =< C andalso C =< $z. + +is_upper(C) -> + $A =< C andalso C =< $Z. + +is_digit(C) -> + $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/compiler/diameter_dict_util.erl b/lib/diameter/src/compiler/diameter_dict_util.erl new file mode 100644 index 0000000000..2207925e49 --- /dev/null +++ b/lib/diameter/src/compiler/diameter_dict_util.erl @@ -0,0 +1,1302 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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 module turns a dictionary file into the orddict that +%% diameter_codegen.erl in turn morphs into .erl and .hrl files for +%% encode and decode of Diameter messages and AVPs. +%% + +-module(diameter_dict_util). + +-export([parse/2, + format_error/1, + format/1]). + +-include("diameter_vsn.hrl"). + +-define(RETURN(T), throw({T, ?MODULE, ?LINE})). +-define(RETURN(T, Args), ?RETURN({T, Args})). + +-define(A, list_to_atom). +-define(L, atom_to_list). +-define(I, integer_to_list). +-define(F, io_lib:format). + +%% =========================================================================== +%% parse/2 +%% =========================================================================== + +-spec parse(File, Opts) + -> {ok, orddict:orddict()} + | {error, term()} + when File :: {path, string()} + | iolist() + | binary(), + Opts :: list(). + +parse(File, Opts) -> + putr(verbose, lists:member(verbose, Opts)), + try + {ok, do_parse(File, Opts)} + catch + {Reason, ?MODULE, _Line} -> + {error, Reason} + after + eraser(verbose) + end. + +%% =========================================================================== +%% format_error/1 +%% =========================================================================== + +format_error({read, Reason}) -> + file:format_error(Reason); +format_error({scan, Reason}) -> + diameter_dict_scanner:format_error(Reason); +format_error({parse, {Line, _Mod, Reason}}) -> + lists:flatten(["Line ", ?I(Line), ", ", Reason]); + +format_error(T) -> + {Fmt, As} = fmt(T), + lists:flatten(io_lib:format(Fmt, As)). + +fmt({avp_code_already_defined = E, [Code, false, Name, Line, L]}) -> + {fmt(E), [Code, "", Name, Line, L]}; +fmt({avp_code_already_defined = E, [Code, Vid, Name, Line, L]}) -> + {fmt(E), [Code, ?F("/~p", [Vid]), Name, Line, L]}; + +fmt({uint32_out_of_range = E, [id | T]}) -> + {fmt(E), ["@id", "application identifier" | T]}; +fmt({uint32_out_of_range = E, [K | T]}) + when K == vendor; + K == avp_vendor_id -> + {fmt(E), [?F("@~p", [K]), "vendor id" | T]}; +fmt({uint32_out_of_range = E, [K, Name | T]}) + when K == enum; + K == define -> + {fmt(E), [?F("@~p ~s", [K, Name]), "value" | T]}; +fmt({uint32_out_of_range = E, [avp_types, Name | T]}) -> + {fmt(E), ["AVP " ++ Name, "AVP code" | T]}; +fmt({uint32_out_of_range = E, [grouped, Name | T]}) -> + {fmt(E), ["Grouped AVP " ++ Name | T]}; +fmt({uint32_out_of_range = E, [messages, Name | T]}) -> + {fmt(E), ["Message " ++ Name, "command code" | T]}; + +fmt({Reason, As}) -> + {fmt(Reason), As}; + +fmt(avp_code_already_defined) -> + "AVP ~p~s (~s) at line ~p already defined at line ~p"; + +fmt(uint32_out_of_range) -> + "~s specifies ~s ~p at line ~p that is out of range for a value of " + "Diameter type Unsigned32"; + +fmt(imported_avp_already_defined) -> + "AVP ~s imported by @inherits ~p at line ~p defined at line ~p"; +fmt(duplicate_import) -> + "AVP ~s is imported by more than one @inherits, both at line ~p " + "and at line ~p"; + +fmt(duplicate_section) -> + "Section @~s at line ~p already declared at line ~p"; + +fmt(already_declared) -> + "Section @~p ~s at line ~p already declared at line ~p"; + +fmt(inherited_avp_already_defined) -> + "AVP ~s inherited at line ~p defined in @avp_types at line ~p"; +fmt(avp_already_defined) -> + "AVP ~s at line ~p already in @~p at line ~p"; +fmt(key_already_defined) -> + "Value for ~s:~s in @~p at line ~p already provided at line ~p"; + +fmt(messages_without_id) -> + "@messages at line ~p but @id not declared"; + +fmt(avp_name_already_defined) -> + "AVP ~s at line ~p already defined at line ~p"; +fmt(avp_has_unknown_type) -> + "AVP ~s at line ~p defined with unknown type ~s"; +fmt(avp_has_invalid_flag) -> + "AVP ~s at line ~p specifies invalid flag ~c"; +fmt(avp_has_duplicate_flag) -> + "AVP ~s at line ~p specifies duplicate flag ~c"; +fmt(avp_has_vendor_id) -> + "AVP ~s at line ~p does not specify V flag " + "but is assigned vendor id ~p at line ~p"; +fmt(avp_has_no_vendor) -> + "AVP ~s at line ~p specifies V flag " + "but neither @vendor_avp_id nor @vendor supplies a value"; + +fmt(group_already_defined) -> + "Group ~s at line ~p already defined at line ~p"; +fmt(grouped_avp_code_mismatch) -> + "AVP ~s at line ~p has with code ~p " + "but @avp_types specifies ~p at line ~p"; +fmt(grouped_avp_has_wrong_type) -> + "Grouped AVP ~s at line ~p defined with type ~s at line ~p"; +fmt(grouped_avp_not_defined) -> + "Grouped AVP ~s on line ~p not defined in @avp_types"; +fmt(grouped_vendor_id_without_flag) -> + "Grouped AVP ~s at line ~p has vendor id " + "but definition at line ~p does not specify V flag"; +fmt(grouped_vendor_id_mismatch) -> + "Grouped AVP ~s at line ~p has vendor id ~p " + "but ~p specified at line ~p"; + +fmt(message_name_already_defined) -> + "Message ~s at line ~p already defined at line ~p"; +fmt(message_code_already_defined) -> + "~s message with code ~p at line ~p already defined at line ~p"; +fmt(message_has_duplicate_flag) -> + "Message ~s has duplicate flag ~s at line ~p"; +fmt(message_application_id_mismatch) -> + "Message ~s has application id ~p at line ~p " + "but @id specifies ~p at line ~p"; + +fmt(invalid_avp_order) -> + "AVP reference ~c~s~c at line ~p breaks fixed/required/optional order"; +fmt(invalid_qualifier) -> + "Qualifier ~p*~p at line ~p has Min > Max"; +fmt(avp_already_referenced) -> + "AVP ~s at line ~p already referenced at line ~p"; + +fmt(message_missing) -> + "~s message at line ~p but no ~s message is defined"; + +fmt(requested_avp_not_found) -> + "@inherit ~s at line ~p requests AVP ~s at line ~p " + "but module does not define that AVP"; + +fmt(enumerated_avp_has_wrong_local_type) -> + "Enumerated AVP ~s in @enum at line ~p defined with type ~s at line ~p"; +fmt(enumerated_avp_has_wrong_inherited_type) -> + "Enumerated AVP ~s in @enum at line ~p " + "inherited with type ~s from module ~s at line ~p"; +fmt(enumerated_avp_not_defined) -> + "Enumerated AVP ~s in @enum at line ~p neither defined nor inherited"; + +fmt(avp_not_defined) -> + "AVP ~s referenced at line ~p neither defined nor inherited"; + +fmt(recompile) -> + "Module ~p appears to have been compiler with an incompatible " + "version of the dictionary compiler and must be recompiled"; +fmt(not_loaded) -> + "Module ~p is not on the code path or could not be loaded"; +fmt(no_dict) -> + "Module ~p does not appear to be a diameter dictionary". + +%% =========================================================================== +%% format/1 +%% +%% Turn dict/0 output back into a dictionary file (with line ending = $\n). + +-spec format(Dict) + -> iolist() + when Dict :: orddict:orddict(). + +-define(KEYS, [id, name, prefix, vendor, + inherits, codecs, custom_types, + avp_types, + messages, + grouped, + enum, define]). + +format(Dict) -> + Io = orddict:fold(fun io/3, [], Dict), + [S || {_,S} <- lists:sort(fun keysort/2, Io)]. + +keysort({A,_}, {B,_}) -> + [HA, HB] = [H || K <- [A,B], + H <- [lists:takewhile(fun(X) -> X /= K end, ?KEYS)]], + HA < HB. + +%% =========================================================================== + +-define(INDENT, " "). +-define(SP, " "). +-define(NL, $\n). + +%% io/3 + +io(K, _, Acc) + when K == command_codes; + K == import_avps; + K == import_groups; + K == import_enums -> + Acc; + +io(Key, Body, Acc) -> + [{Key, io(Key, Body)} | Acc]. + +%% io/2 + +io(K, Id) + when K == id; + K == name; + K == prefix -> + [?NL, section(K), ?SP, tok(Id)]; + +io(vendor = K, {Id, Name}) -> + [?NL, section(K) | [[?SP, tok(X)] || X <- [Id, Name]]]; + +io(avp_types = K, Body) -> + [?NL, ?NL, section(K), ?NL, [body(K,A) || A <- Body]]; + +io(K, Body) + when K == messages; + K == grouped -> + [?NL, ?NL, section(K), [body(K,A) || A <- Body]]; + +io(K, Body) + when K == avp_vendor_id; + K == inherits; + K == custom_types; + K == codecs; + K == enum; + K == define -> + [[?NL, pairs(K, T)] || T <- Body]. + +pairs(K, {Id, Avps}) -> + [?NL, section(K), ?SP, tok(Id), ?NL, [[?NL, body(K, A)] || A <- Avps]]. + +body(K, AvpName) + when K == avp_vendor_id; + K == inherits; + K == custom_types; + K == codecs -> + [?INDENT, word(AvpName)]; + +body(K, {Name, N}) + when K == enum; + K == define -> + [?INDENT, word(Name), ?SP, ?I(N)]; + +body(avp_types = K, {Name, Code, Type, ""}) -> + body(K, {Name, Code, Type, "-"}); +body(avp_types, {Name, Code, Type, Flags}) -> + [?NL, ?INDENT, word(Name), + [[?SP, ?SP, S] || S <- [?I(Code), Type, Flags]]]; + +body(messages, {"answer-message", _, _, [], Avps}) -> + [?NL, ?NL, ?INDENT, + "answer-message ::= < Diameter Header: code, ERR [PXY] >", + f_avps(Avps)]; +body(messages, {Name, Code, Flags, ApplId, Avps}) -> + [?NL, ?NL, ?INDENT, word(Name), " ::= ", header(Code, Flags, ApplId), + f_avps(Avps)]; + +body(grouped, {Name, Code, Vid, Avps}) -> + [?NL, ?NL, ?INDENT, word(Name), " ::= ", avp_header(Code, Vid), + f_avps(Avps)]. + +header(Code, Flags, ApplId) -> + ["< Diameter Header: ", + ?I(Code), + [[", ", ?L(F)] || F <- Flags], + [[" ", ?I(N)] || N <- ApplId], + " >"]. + +avp_header(Code, Vid) -> + ["< AVP Header: ", + ?I(Code), + [[" ", ?I(V)] || V <- Vid], + " >"]. + +f_avps(L) -> + [[?NL, ?INDENT, ?INDENT, f_avp(A)] || A <- L]. + +f_avp({Q, A}) -> + f_avp(f_qual(Q), f_delim(A)); +f_avp(A) -> + f_avp("", f_delim(A)). + +f_delim({{A}}) -> + [$<, word(A), $>]; +f_delim({A}) -> + [${, word(A), $}]; +f_delim([A]) -> + [$[, word(A), $]]. + +f_avp(Q, Avp) -> + Len = length(lists:flatten([Q])), + [io_lib:format("~*s", [-1*max(Len+1, 6) , Q]), Avp]. + +f_qual('*') -> + "*"; +f_qual({'*', N}) -> + [$*, ?I(N)]; +f_qual({N, '*'}) -> + [?I(N), $*]; +f_qual({M,N}) -> + [?I(M), $*, ?I(N)]. + +section(Key) -> + ["@", ?L(Key)]. + +tok(N) + when is_integer(N) -> + ?I(N); +tok(N) -> + word(N). + +word(Str) -> + word(diameter_dict_scanner:is_name(Str), Str). + +word(true, Str) -> + Str; +word(false, Str) -> + [$', Str, $']. + +%% =========================================================================== + +do_parse(File, Opts) -> + Bin = do([fun read/1, File], read), + Toks = do([fun diameter_dict_scanner:scan/1, Bin], scan), + Tree = do([fun diameter_dict_parser:parse/1, Toks], parse), + make_dict(Tree, Opts). + +do([F|A], E) -> + case apply(F,A) of + {ok, T} -> + T; + {error, Reason} -> + ?RETURN({E, Reason}) + end. + +read({path, Path}) -> + file:read_file(Path); +read(File) -> + {ok, iolist_to_binary([File])}. + +make_dict(Parse, Opts) -> + make_orddict(pass4(pass3(pass2(pass1(reset(make_dict(Parse), + Opts))), + Opts))). + +%% make_orddict/1 + +make_orddict(Dict) -> + dict:fold(fun mo/3, + orddict:from_list([{K,[]} || K <- [avp_types, + messages, + grouped, + inherits, + custom_types, + codecs, + avp_vendor_id, + enum, + define]]), + Dict). + +mo(K, Sects, Dict) + when is_atom(K) -> + orddict:store(K, make(K, Sects), Dict); + +mo(_, _, Dict) -> + Dict. + +make(K, [[_Line, {_, _, X}]]) + when K == id; + K == name; + K == prefix -> + X; + +make(vendor, [[_Line, {_, _, Id}, {_, _, Name}]]) -> + {Id, Name}; + +make(K, T) + when K == command_codes; + K == import_avps; + K == import_groups; + K == import_enums -> + T; + +make(K, Sects) -> + post(K, foldl(fun([_L|B], A) -> make(K,B,A) end, + [], + Sects)). + +post(avp_types, L) -> + lists:sort(L); + +post(K, L) + when K == grouped; + K == messages; + K == enum; + K == define -> + lists:reverse(L); + +post(_, L) -> + L. + +make(K, [{_,_,Name} | Body], Acc) + when K == enum; + K == define; + K == avp_vendor_id; + K == custom_types; + K == inherits; + K == codecs -> + [{Name, mk(K, Body)} | Acc]; + +make(K, Body, Acc) -> + foldl(fun(T,A) -> [mk(K, T) | A] end, Acc, Body). + +mk(avp_types, [{_,_,Name}, {_,_,Code}, {_,_,Type}, {_,_,Flags}]) -> + {Name, Code, type(Type), Flags}; + +mk(messages, [{'answer-message' = A, _}, false | Avps]) -> + {?L(A), -1, ['ERR', 'PXY'], [], make_body(Avps)}; + +mk(messages, [{_,_,Name}, [{_,_,Code}, Flags, ApplId] | Avps]) -> + {Name, + Code, + lists:map(fun({F,_}) -> F end, Flags), + opt(ApplId), + make_body(Avps)}; + +mk(grouped, [{_,_,Name}, [{_,_,Code}, Vid] | Avps]) -> + {Name, Code, opt(Vid), make_body(Avps)}; + +mk(K, Body) + when K == enum; + K == define -> + lists:map(fun([{_,_,Name}, {_,_,Value}]) -> {Name, Value} end, Body); + +mk(K, Avps) + when K == avp_vendor_id; + K == custom_types; + K == inherits; + K == codecs -> + lists:map(fun({_,_,N}) -> N end, Avps). + +opt(false) -> + []; +opt({_,_,X}) -> + [X]. + +make_body(Avps) -> + lists:map(fun avp/1, Avps). + +avp([false, D, Avp]) -> + avp(D, Avp); +avp([Q, D, Avp]) -> + {qual(Q), avp(D, Avp)}. + +avp(D, {'AVP', _}) -> + delim(D, "AVP"); +avp(D, {_, _, Name}) -> + delim(D, Name). + +delim($<, N) -> + {{N}}; +delim(${, N) -> + {N}; +delim($[, N) -> + [N]. + +qual({true, {_,_,N}}) -> + {'*', N}; +qual({{_,_,N}, true}) -> + {N, '*'}; +qual({{_,_,N},{_,_,M}}) -> + {N, M}; +qual(true) -> + '*'. + +%% Optional reports when running verbosely. +report(What, [F | A]) + when is_function(F) -> + report(What, apply(F, A)); +report(What, Data) -> + report(getr(verbose), What, Data). + +report(true, Tag, Data) -> + io:format("##~n## ~p ~p~n", [Tag, Data]); +report(false, _, _) -> + ok. + +%% ------------------------------------------------------------------------ +%% make_dict/1 +%% +%% Turn a parsed dictionary into an dict. + +make_dict(Parse) -> + foldl(fun(T,A) -> + report(section, T), + section(T,A) + end, + dict:new(), + Parse). + +section([{T, L} | Rest], Dict) + when T == name; + T == prefix; + T == id; + T == vendor -> + case find(T, Dict) of + [] -> + dict:store(T, [[L | Rest]], Dict); + [[Line | _]] -> + ?RETURN(duplicate_section, [T, L, Line]) + end; + +section([{T, L} | Rest], Dict) + when T == avp_types; + T == messages; + T == grouped; + T == inherits; + T == custom_types; + T == codecs; + T == avp_vendor_id; + T == enum; + T == define -> + dict:append(T, [L | Rest], Dict). + +%% =========================================================================== +%% reset/2 +%% +%% Reset sections from options. + +reset(Dict, Opts) -> + foldl([fun reset/3, Opts], Dict, [name, prefix, inherits]). + +reset(K, Dict, Opts) -> + foldl(fun opt/2, Dict, [T || {A,_} = T <- Opts, A == K]). + +opt({inherits = Key, "-"}, Dict) -> + dict:erase(Key, Dict); +opt({inherits = Key, Mod}, Dict) -> + dict:append(Key, [0, {word, 0, Mod}], Dict); +opt({Key, Val}, Dict) -> + dict:store(Key, [0, {word, 0, Val}], Dict); +opt(_, Dict) -> + Dict. + +%% =========================================================================== +%% pass1/1 +%% +%% Explode sections into additional dictionary entries plus semantic +%% checks. + +pass1(Dict) -> + true = no_messages_without_id(Dict), + + foldl(fun(K,D) -> foldl([fun p1/3, K], D, find(K,D)) end, + Dict, + [id, + vendor, + avp_types, %% must precede inherits, grouped, enum + avp_vendor_id, + custom_types, + codecs, + inherits, + grouped, + messages, + enum, + define]). + +%% Multiple sections are allowed as long as their bodies don't +%% overlap. (Except enum/define.) + +p1([_Line, N], Dict, id = K) -> + true = is_uint32(N, [K]), + Dict; + +p1([_Line, Id, _Name], Dict, vendor = K) -> + true = is_uint32(Id, [K]), + Dict; + +p1([_Line, X | Body], Dict, K) + when K == avp_vendor_id; + K == custom_types; + K == codecs; + K == inherits -> + foldl([fun explode/4, X, K], Dict, Body); + +p1([_Line, X | Body], Dict, K) + when K == define; + K == enum -> + {_, L, Name} = X, + foldl([fun explode2/4, X, K], + store_new({K, Name}, + [L, Body], + Dict, + [K, Name, L], + already_declared), + Body); + +p1([_Line | Body], Dict, K) + when K == avp_types; + K == grouped; + K == messages -> + foldl([fun explode/3, K], Dict, Body). + +no_messages_without_id(Dict) -> + case find(messages, Dict) of + [] -> + true; + [[Line | _] | _] -> + [] /= find(id, Dict) orelse ?RETURN(messages_without_id, [Line]) + end. + +%% Note that the AVP's in avp_vendor_id, custom_types, codecs and +%% enum can all be inherited, as can the AVP content of messages and +%% grouped AVP's. Check that the referenced AVP's exist after +%% importing definitions. + +%% explode/4 +%% +%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()] +%% {custom_types|codecs|inherits, AvpName} -> [Lineno, Mod::string()] + +explode({_, Line, AvpName}, Dict, {_, _, X} = T, K) -> + true = K /= avp_vendor_id orelse is_uint32(T, [K]), + true = K /= inherits orelse avp_not_local(AvpName, Line, Dict), + + store_new({key(K), AvpName}, + [Line, X], + Dict, + [AvpName, Line, K], + avp_already_defined). + +%% explode2/4 + +%% {define, {Name, Key}} -> [Lineno, Value::integer(), enum|define] + +explode2([{_, Line, Key}, {_, _, Value} = T], Dict, {_, _, Name}, K) -> + true = is_uint32(T, [K, Name]), + + store_new({key(K), {Name, Key}}, + [Line, Value, K], + Dict, + [Name, Key, K, Line], + key_already_defined). + +%% key/1 +%% +%% Conflate keys that are equivalent as far as uniqueness of +%% definition goes. + +key(K) + when K == enum; + K == define -> + define; +key(K) + when K == custom_types; + K == codecs -> + custom; +key(K) -> + K. + +%% explode/3 + +%% {avp_types, AvpName} -> [Line | Toks] +%% {avp_types, {Code, IsReq}} -> [Line, AvpName] +%% +%% where AvpName = string() +%% Code = integer() +%% IsReq = boolean() + +explode([{_, Line, Name} | Toks], Dict0, avp_types = K) -> + %% Each AVP can be defined only once. + Dict = store_new({K, Name}, + [Line | Toks], + Dict0, + [Name, Line], + avp_name_already_defined), + + [{number, _, _Code} = C, {word, _, Type}, {word, _, _Flags}] = Toks, + + true = avp_type_known(Type, Name, Line), + true = is_uint32(C, [K, Name]), + + Dict; + +%% {grouped, Name} -> [Line, HeaderTok | AvpToks] +%% {grouped, {Name, AvpName}} -> [Line, Qual, Delim] +%% +%% where Name = string() +%% AvpName = string() +%% Qual = {Q, Q} | boolean() +%% Q = true | NumberTok +%% Delim = $< | ${ | $[ + +explode([{_, Line, Name}, Header | Avps], Dict0, grouped = K) -> + Dict = store_new({K, Name}, + [Line, Header | Avps], + Dict0, + [Name, Line], + group_already_defined), + + [{_,_, Code} = C, Vid] = Header, + {DefLine, {_, _, Flags}} = grouped_flags(Name, Code, Dict0, Line), + V = lists:member($V, Flags), + + true = is_uint32(C, [K, Name, "AVP code"]), + true = is_uint32(Vid, [K, Name, "vendor id"]), + false = vendor_id_mismatch(Vid, V, Name, Dict0, Line, DefLine), + + explode_avps(Avps, Dict, K, Name); + +%% {messages, Name} -> [Line, HeaderTok | AvpToks] +%% {messages, {Code, IsReq}} -> [Line, NameTok] +%% {messages, Code} -> [[Line, NameTok, IsReq]] +%% {messages, {Name, Flag}} -> [Line] +%% {messages, {Name, AvpName}} -> [Line, Qual, Delim] +%% +%% where Name = string() +%% Code = integer() +%% IsReq = boolean() +%% Flag = 'REQ' | 'PXY' +%% AvpName = string() +%% Qual = true | {Q,Q} +%% Q = true | NumberTok +%% Delim = $< | ${ | ${ + +explode([{'answer-message' = A, Line}, false = H | Avps], + Dict0, + messages = K) -> + Name = ?L(A), + Dict1 = store_new({K, Name}, + [Line, H, Avps], + Dict0, + [Name, Line], + message_name_already_defined), + + explode_avps(Avps, Dict1, K, Name); + +explode([{_, Line, MsgName} = M, Header | Avps], + Dict0, + messages = K) -> + %% There can be at most one message with a given name. + Dict1 = store_new({K, MsgName}, + [Line, Header | Avps], + Dict0, + [MsgName, Line], + message_name_already_defined), + + [{_, _, Code} = C, Bits, ApplId] = Header, + + %% Don't check any application id since it's required to be + %% the same as @id. + true = is_uint32(C, [K, MsgName]), + + %% An application id specified as part of the message definition + %% has to agree with @id. The former is parsed just because RFC + %% 3588 specifies it. + false = application_id_mismatch(ApplId, Dict1, MsgName), + + IsReq = lists:keymember('REQ', 1, Bits), + + %% For each command code, there can be at most one request and + %% one answer. + Dict2 = store_new({K, {Code, IsReq}}, + [Line, M], + Dict1, + [choose(IsReq, "Request", "Answer"), Code, Line], + message_code_already_defined), + + %% For each message, each flag can occur at most once. + Dict3 = foldl(fun({F,L},D) -> + store_new({K, {MsgName, F}}, + [L], + D, + [MsgName, ?L(F)], + message_has_duplicate_flag) + end, + Dict2, + Bits), + + dict:append({K, Code}, + [Line, M, IsReq], + explode_avps(Avps, Dict3, K, MsgName)). + +%% explode_avps/4 +%% +%% Ensure required AVP order and sane qualifiers. Can't check for AVP +%% names until after they've been imported. +%% +%% RFC 3588 allows a trailing fixed while 3588bis doesn't. Parse the +%% former. + +explode_avps(Avps, Dict, Key, Name) -> + xa("<{[<", Avps, Dict, Key, Name). + +xa(_, [], Dict, _, _) -> + Dict; + +xa(Ds, [[Qual, D, {'AVP', Line}] | Avps], Dict, Key, Name) -> + xa(Ds, [[Qual, D, {word, Line, "AVP"}] | Avps], Dict, Key, Name); + +xa([], [[_Qual, D, {_, Line, Name}] | _], _, _, _) -> + ?RETURN(invalid_avp_order, [D, Name, close(D), Line]); + +xa([D|_], [[{{_, Line, Min}, {_, _, Max}}, D, _] | _], _, _, _) + when Min > Max -> + ?RETURN(invalid_qualifier, [Min, Max, Line]); + +xa([D|_] = Ds, [[Qual, D, {_, Line, AvpName}] | Avps], Dict, Key, Name) -> + xa(Ds, + Avps, + store_new({Key, {Name, AvpName}}, + [Line, Qual, D], + Dict, + [Name, Line], + avp_already_referenced), + Key, + Name); + +xa([_|Ds], Avps, Dict, Key, Name) -> + xa(Ds, Avps, Dict, Key, Name). + +close($<) -> $>; +close(${) -> $}; +close($[) -> $]. + +%% is_uint32/2 + +is_uint32(false, _) -> + true; +is_uint32({Line, _, N}, Args) -> + N < 1 bsl 32 orelse ?RETURN(uint32_out_of_range, Args ++ [N, Line]). +%% Can't call diameter_types here since it may not exist yet. + +%% application_id_mismatch/3 + +application_id_mismatch({number, Line, Id}, Dict, MsgName) -> + [[_, {_, L, I}]] = dict:fetch(id, Dict), + + I /= Id andalso ?RETURN(message_application_id_mismatch, + [MsgName, Id, Line, I, L]); + +application_id_mismatch(false = No, _, _) -> + No. + +%% avp_not_local/3 + +avp_not_local(Name, Line, Dict) -> + A = find({avp_types, Name}, Dict), + + [] == A orelse ?RETURN(inherited_avp_already_defined, + [Name, Line, hd(A)]). + +%% avp_type_known/3 + +avp_type_known(Type, Name, Line) -> + false /= type(Type) + orelse ?RETURN(avp_has_unknown_type, [Name, Line, Type]). + +%% vendor_id_mismatch/6 +%% +%% Require a vendor id specified on a group to match any specified +%% in @avp_vendor_id. Note that both locations for the value are +%% equivalent, both in the value being attributed to a locally +%% defined AVP and ignored when imported from another dictionary. + +vendor_id_mismatch({_,_,_}, false, Name, _, Line, DefLine) -> + ?RETURN(grouped_vendor_id_without_flag, [Name, Line, DefLine]); + +vendor_id_mismatch({_, _, I}, true, Name, Dict, Line, _) -> + case vendor_id(Name, Dict) of + {avp_vendor_id, L, N} -> + I /= N andalso + ?RETURN(grouped_vendor_id_mismatch, [Name, Line, I, N, L]); + _ -> + false + end; + +vendor_id_mismatch(_, _, _, _, _, _) -> + false. + +%% grouped_flags/4 + +grouped_flags(Name, Code, Dict, Line) -> + case find({avp_types, Name}, Dict) of + [L, {_, _, Code}, {_, _, "Grouped"}, Flags] -> + {L, Flags}; + [_, {_, L, C}, {_, _, "Grouped"}, _Flags] -> + ?RETURN(grouped_avp_code_mismatch, [Name, Line, Code, C, L]); + [_, _Code, {_, L, T}, _] -> + ?RETURN(grouped_avp_has_wrong_type, [Name, Line, T, L]); + [] -> + ?RETURN(grouped_avp_not_defined, [Name, Line]) + end. + +%% vendor_id/2 + +%% Look for a vendor id in @avp_vendor_id, then @vendor. +vendor_id(Name, Dict) -> + case find({avp_vendor_id, Name}, Dict) of + [Line, Id] when is_integer(Id) -> + {avp_vendor_id, Line, Id}; + [] -> + vendor(Dict) + end. + +vendor(Dict) -> + case find(vendor, Dict) of + [[_Line, {_, _, Id}, {_, _, _}]] -> + {vendor, Id}; + [] -> + false + end. + +%% find/2 + +find(Key, Dict) -> + case dict:find(Key, Dict) of + {ok, L} when is_list(L) -> + L; + error -> + [] + end. + +%% store_new/5 + +store_new(Key, Value, Dict, Args, Err) -> + case dict:find(Key, Dict) of + {ok, [L | _]} -> + ?RETURN(Err, Args ++ [L]); + error -> + dict:store(Key, Value, Dict) + end. + +%% type/1 + +type("DiamIdent") -> + "DiameterIdentity"; +type("DiamURI") -> + "DiameterURI"; +type(T) + when T == "OctetString"; + T == "Integer32"; + T == "Integer64"; + T == "Unsigned32"; + T == "Unsigned64"; + T == "Float32"; + T == "Float64"; + T == "Grouped"; + T == "Enumerated"; + T == "Address"; + T == "Time"; + T == "UTF8String"; + T == "DiameterIdentity"; + T == "DiameterURI"; + T == "IPFilterRule"; + T == "QoSFilterRule" -> + T; +type(_) -> + false. + +%% =========================================================================== +%% pass2/1 +%% +%% More explosion, but that requires the previous pass to write its +%% entries. + +pass2(Dict) -> + foldl(fun(K,D) -> foldl([fun p2/3, K], D, find(K,D)) end, + Dict, + [avp_types]). + +p2([_Line | Body], Dict, avp_types) -> + foldl(fun explode_avps/2, Dict, Body); + +p2([], Dict, _) -> + Dict. + +explode_avps([{_, Line, Name} | Toks], Dict) -> + [{number, _, Code}, {word, _, _Type}, {word, _, Flags}] = Toks, + + true = avp_flags_valid(Flags, Name, Line), + + Vid = avp_vendor_id(Flags, Name, Line, Dict), + + %% An AVP is uniquely defined by its AVP code and vendor id (if any). + %% Ensure there are no duplicate. + store_new({avp_types, {Code, Vid}}, + [Line, Name], + Dict, + [Code, Vid, Name, Line], + avp_code_already_defined). + +%% avp_flags_valid/3 + +avp_flags_valid(Flags, Name, Line) -> + Bad = lists:filter(fun(C) -> not lists:member(C, "MVP") end, Flags), + [] == Bad + orelse ?RETURN(avp_has_invalid_flag, [Name, Line, hd(Bad)]), + + Dup = Flags -- "MVP", + [] == Dup + orelse ?RETURN(avp_has_duplicate_flag, [Name, Line, hd(Dup)]). + +%% avp_vendor_id/4 + +avp_vendor_id(Flags, Name, Line, Dict) -> + V = lists:member($V, Flags), + + case vendor_id(Name, Dict) of + {avp_vendor_id, _, I} when V -> + I; + {avp_vendor_id, L, I} -> + ?RETURN(avp_has_vendor_id, [Name, Line, I, L]); + {vendor, I} when V -> + I; + false when V -> + ?RETURN(avp_has_no_vendor, [Name, Line]); + _ -> + false + end. + +%% =========================================================================== +%% pass3/2 +%% +%% Import AVPs. + +pass3(Dict, Opts) -> + import_enums(import_groups(import_avps(insert_codes(Dict), Opts))). + +%% insert_codes/1 +%% +%% command_codes -> [{Code, ReqNameTok, AnsNameTok}] + +insert_codes(Dict) -> + dict:store(command_codes, + dict:fold(fun make_code/3, [], Dict), + Dict). + +make_code({messages, Code}, Names, Acc) + when is_integer(Code) -> + [mk_code(Code, Names) | Acc]; +make_code(_, _, Acc) -> + Acc. + +mk_code(Code, [[_, _, false] = Ans, [_, _, true] = Req]) -> + mk_code(Code, [Req, Ans]); + +mk_code(Code, [[_, {_,_,Req}, true], [_, {_,_,Ans}, false]]) -> + {Code, Req, Ans}; + +mk_code(_Code, [[Line, _Name, IsReq]]) -> + ?RETURN(message_missing, [choose(IsReq, "Request", "Answer"), + Line, + choose(IsReq, "answer", "request")]). + +%% import_avps/2 + +import_avps(Dict, Opts) -> + Import = inherit(Dict, Opts), + report(imported, Import), + + %% pass4/1 tests that all referenced AVP's are either defined + %% or imported. + + dict:store(import_avps, + lists:map(fun({M, _, As}) -> {M, [A || {_,A} <- As]} end, + lists:reverse(Import)), + foldl(fun explode_imports/2, Dict, Import)). + +explode_imports({Mod, Line, Avps}, Dict) -> + foldl([fun xi/4, Mod, Line], Dict, Avps). + +xi({L, {Name, _Code, _Type, _Flags} = A}, Dict, Mod, Line) -> + store_new({avp_types, Name}, + [0, Mod, Line, L, A], + store_new({import, Name}, + [Line], + Dict, + [Name, Line], + duplicate_import), + [Name, Mod, Line], + imported_avp_already_defined). + +%% import_groups/1 +%% import_enums/1 +%% +%% For each inherited module, store the content of imported AVP's of +%% type grouped/enumerated in a new key. + +import_groups(Dict) -> + dict:store(import_groups, import(grouped, Dict), Dict). + +import_enums(Dict) -> + dict:store(import_enums, import(enum, Dict), Dict). + +import(Key, Dict) -> + flatmap([fun import_key/2, Key], dict:fetch(import_avps, Dict)). + +import_key({Mod, Avps}, Key) -> + As = lists:flatmap(fun(T) -> + N = element(1,T), + choose(lists:keymember(N, 1, Avps), [T], []) + end, + orddict:fetch(Key, dict(Mod))), + if As == [] -> + []; + true -> + [{Mod, As}] + end. + +%% ------------------------------------------------------------------------ +%% inherit/2 +%% +%% Return a {Mod, Line, [{Lineno, Avp}]} list, where Mod is a module +%% name, Line points to the corresponding @inherit and each Avp is +%% from Mod:dict(). Lineno is 0 if the import is implicit. + +inherit(Dict, Opts) -> + code:add_pathsa([D || {include, D} <- Opts]), + foldl(fun inherit_avps/2, [], find(inherits, Dict)). +%% Note that the module order of the returned lists is reversed +%% relative to @inherits. + +inherit_avps([Line, {_,_,M} | Names], Acc) -> + Mod = ?A(M), + report(inherit_from, Mod), + case find_avps(Names, avps_from_module(Mod)) of + {_, [{_, L, N} | _]} -> + ?RETURN(requested_avp_not_found, [Mod, Line, N, L]); + {Found, []} -> + [{Mod, Line, lists:sort(Found)} | Acc] + end. + +%% Import everything not defined locally ... +find_avps([], Avps) -> + {[{0, A} || A <- Avps], []}; + +%% ... or specified AVPs. +find_avps(Names, Avps) -> + foldl(fun acc_avp/2, {[], Names}, Avps). + +acc_avp({Name, _Code, _Type, _Flags} = A, {Found, Not} = Acc) -> + case lists:keyfind(Name, 3, Not) of + {_, Line, Name} -> + {[{Line, A} | Found], lists:keydelete(Name, 3, Not)}; + false -> + Acc + end. + +%% avps_from_module/2 + +avps_from_module(Mod) -> + orddict:fetch(avp_types, dict(Mod)). + +dict(Mod) -> + try Mod:dict() of + [?VERSION | Dict] -> + Dict; + _ -> + ?RETURN(recompile, [Mod]) + catch + error: _ -> + ?RETURN(choose(false == code:is_loaded(Mod), + not_loaded, + no_dict), + [Mod]) + end. + +%% =========================================================================== +%% pass4/1 +%% +%% Sanity checks. + +pass4(Dict) -> + dict:fold(fun(K, V, _) -> p4(K, V, Dict) end, ok, Dict), + Dict. + +%% Ensure enum AVP's have type Enumerated. +p4({enum, Name}, [Line | _], Dict) + when is_list(Name) -> + true = is_enumerated_avp(Name, Dict, Line); + +%% Ensure all referenced AVP's are either defined locally or imported. +p4({K, {Name, AvpName}}, [Line | _], Dict) + when (K == grouped orelse K == messages), + is_list(Name), + is_list(AvpName), + AvpName /= "AVP" -> + true = avp_is_defined(AvpName, Dict, Line); + +%% Ditto. +p4({K, AvpName}, [Line | _], Dict) + when K == avp_vendor_id; + K == custom_types; + K == codecs -> + true = avp_is_defined(AvpName, Dict, Line); + +p4(_, _, _) -> + ok. + +%% has_enumerated_type/3 + +is_enumerated_avp(Name, Dict, Line) -> + case find({avp_types, Name}, Dict) of + [_Line, _Code, {_, _, "Enumerated"}, _Flags] -> %% local + true; + [_Line, _Code, {_, L, T}, _] -> + ?RETURN(enumerated_avp_has_wrong_local_type, + [Name, Line, T, L]); + [0, _, _, _, {_Name, _Code, "Enumerated", _Flags}] -> %% inherited + true; + [0, Mod, LM, LA, {_Name, _Code, Type, _Flags}] -> + ?RETURN(enumerated_avp_has_wrong_inherited_type, + [Name, Line, Type, Mod, choose(0 == LA, LM, LA)]); + [] -> + ?RETURN(enumerated_avp_not_defined, [Name, Line]) + end. + +avp_is_defined(Name, Dict, Line) -> + case find({avp_types, Name}, Dict) of + [_Line, _Code, _Type, _Flags] -> %% local + true; + [0, _, _, _, {Name, _Code, _Type, _Flags}] -> %% inherited + true; + [] -> + ?RETURN(avp_not_defined, [Name, Line]) + end. + +%% =========================================================================== + +putr(Key, Value) -> + put({?MODULE, Key}, Value). + +getr(Key) -> + get({?MODULE, Key}). + +eraser(Key) -> + erase({?MODULE, Key}). + +choose(true, X, _) -> X; +choose(false, _, X) -> X. + +foldl(F, Acc, List) -> + lists:foldl(fun(T,A) -> eval([F,T,A]) end, Acc, List). + +flatmap(F, List) -> + lists:flatmap(fun(T) -> eval([F,T]) end, List). + +eval([[F|X] | A]) -> + eval([F | A ++ X]); +eval([F|A]) -> + apply(F,A). diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl index 5e120d6f44..191f53f29d 100644 --- a/lib/diameter/src/compiler/diameter_exprecs.erl +++ b/lib/diameter/src/compiler/diameter_exprecs.erl @@ -96,41 +96,15 @@ -export([parse_transform/2]). -%% Form tag with line number. --define(F(T), T, ?LINE). -%% Yes, that's right. The replacement is to the first unmatched ')'. - --define(attribute, ?F(attribute)). --define(clause, ?F(clause)). --define(function, ?F(function)). --define(call, ?F(call)). --define('fun', ?F('fun')). --define(generate, ?F(generate)). --define(lc, ?F(lc)). --define(match, ?F(match)). --define(remote, ?F(remote)). --define(record, ?F(record)). --define(record_field, ?F(record_field)). --define(record_index, ?F(record_index)). --define(tuple, ?F(tuple)). - --define(ATOM(T), {atom, ?LINE, T}). --define(VAR(V), {var, ?LINE, V}). - --define(CALL(F,A), {?call, ?ATOM(F), A}). --define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). +-include("diameter_forms.hrl"). %% parse_transform/2 parse_transform(Forms, _Options) -> Rs = [R || {attribute, _, record, R} <- Forms], - case lists:append([E || {attribute, _, export_records, E} <- Forms]) of - [] -> - Forms; - Es -> - {H,T} = lists:splitwith(fun is_head/1, Forms), - H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T - end. + Es = lists:append([E || {attribute, _, export_records, E} <- Forms]), + {H,T} = lists:splitwith(fun is_head/1, Forms), + H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T. is_head(T) -> not lists:member(element(1,T), [function, eof]). @@ -200,7 +174,7 @@ fname(Op, Rname) -> '#info-/2'(Exports) -> {?function, fname(info), 2, - lists:map(fun 'info-'/1, Exports)}. + lists:map(fun 'info-'/1, Exports) ++ [?BADARG(2)]}. 'info-'(R) -> {?clause, [?ATOM(R), ?VAR('Info')], @@ -209,7 +183,7 @@ fname(Op, Rname) -> '#new-/1'(Exports) -> {?function, fname(new), 1, - lists:map(fun 'new-'/1, Exports)}. + lists:map(fun 'new-'/1, Exports) ++ [?BADARG(1)]}. 'new-'(R) -> {?clause, [?ATOM(R)], @@ -218,7 +192,7 @@ fname(Op, Rname) -> '#new-/2'(Exports) -> {?function, fname(new), 2, - lists:map(fun 'new--'/1, Exports)}. + lists:map(fun 'new--'/1, Exports) ++ [?BADARG(2)]}. 'new--'(R) -> {?clause, [?ATOM(R), ?VAR('Vals')], @@ -227,7 +201,7 @@ fname(Op, Rname) -> '#get-/2'(Exports) -> {?function, fname(get), 2, - lists:map(fun 'get-'/1, Exports)}. + lists:map(fun 'get-'/1, Exports) ++ [?BADARG(2)]}. 'get-'(R) -> {?clause, [?VAR('Attrs'), @@ -237,7 +211,7 @@ fname(Op, Rname) -> '#set-/2'(Exports) -> {?function, fname(set), 2, - lists:map(fun 'set-'/1, Exports)}. + lists:map(fun 'set-'/1, Exports) ++ [?BADARG(2)]}. 'set-'(R) -> {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}], diff --git a/lib/diameter/src/compiler/diameter_forms.hrl b/lib/diameter/src/compiler/diameter_forms.hrl index d93131df34..4cd86c32aa 100644 --- a/lib/diameter/src/compiler/diameter_forms.hrl +++ b/lib/diameter/src/compiler/diameter_forms.hrl @@ -21,6 +21,13 @@ %% Macros used when building abstract code. %% +%% Generated functions that could have no generated clauses will have +%% a trailing ?BADARG clause that should never execute as called +%% by diameter. +-define(BADARG(N), {?clause, [?VAR('_') || _ <- lists:seq(1,N)], + [], + [?APPLY(erlang, error, [?ATOM(badarg)])]}). + %% Form tag with line number. -define(F(T), T, ?LINE). %% Yes, that's right. The replacement is to the first unmatched ')'. diff --git a/lib/diameter/src/compiler/diameter_make.erl b/lib/diameter/src/compiler/diameter_make.erl index 5380ee56ca..16e30c1ffb 100644 --- a/lib/diameter/src/compiler/diameter_make.erl +++ b/lib/diameter/src/compiler/diameter_make.erl @@ -20,59 +20,113 @@ %% %% Module alternative to diameterc for dictionary compilation. %% -%% Eg. 1> diameter_make:dict("mydict.dia"). +%% Eg. 1> diameter_make:codec("mydict.dia"). %% -%% $ erl -noshell \ +%% $ erl -noinput \ %% -boot start_clean \ -%% -s diameter_make dict mydict.dia \ +%% -eval 'ok = diameter_make:codec("mydict.dia")' \ %% -s init stop %% -module(diameter_make). --export([dict/1, +-export([codec/1, + codec/2, + dict/1, dict/2, - spec/1, - spec/2]). + format/1, + reformat/1]). --type opt() :: {outdir|include|name|prefix|inherits, string()} +-export_type([opt/0]). + +-type opt() :: {include|outdir|name|prefix|inherits, string()} | verbose | debug. -%% dict/1-2 +%% =========================================================================== + +%% codec/1-2 +%% +%% Parse a dictionary file and generate a codec module. + +-spec codec(Path, [opt()]) + -> ok + | {error, Reason} + when Path :: string(), + Reason :: string(). + +codec(File, Opts) -> + case dict(File, Opts) of + {ok, Dict} -> + make(File, + Opts, + Dict, + [spec || _ <- [1], lists:member(debug, Opts)] ++ [erl, hrl]); + {error, _} = E -> + E + end. + +codec(File) -> + codec(File, []). + +%% dict/2 +%% +%% Parse a dictionary file and return the orddict that a codec module +%% returns from dict/0. -spec dict(string(), [opt()]) - -> ok. + -> {ok, orddict:orddict()} + | {error, string()}. -dict(File, Opts) -> - make(File, - Opts, - spec(File, Opts), - [spec || _ <- [1], lists:member(debug, Opts)] ++ [erl, hrl]). +dict(Path, Opts) -> + case diameter_dict_util:parse({path, Path}, Opts) of + {ok, _} = Ok -> + Ok; + {error = E, Reason} -> + {E, diameter_dict_util:format_error(Reason)} + end. dict(File) -> dict(File, []). -%% spec/2 +%% format/1 +%% +%% Turn an orddict returned by dict/1-2 back into a dictionary file +%% in the form of an iolist(). + +-spec format(orddict:orddict()) + -> iolist(). + +format(Dict) -> + diameter_dict_util:format(Dict). --spec spec(string(), [opt()]) - -> orddict:orddict(). +%% reformat/1 +%% +%% Parse a dictionary file and return its formatted equivalent. -spec(File, Opts) -> - diameter_spec_util:parse(File, Opts). +-spec reformat(File) + -> {ok, iolist()} + | {error, Reason} + when File :: string(), + Reason :: string(). -spec(File) -> - spec(File, []). +reformat(File) -> + case dict(File) of + {ok, Dict} -> + {ok, format(Dict)}; + {error, _} = No -> + No + end. %% =========================================================================== make(_, _, _, []) -> ok; -make(File, Opts, Spec, [Mode | Rest]) -> - try diameter_codegen:from_spec(File, Spec, Opts, Mode) of - ok -> - make(File, Opts, Spec, Rest) +make(File, Opts, Dict, [Mode | Rest]) -> + try + ok = diameter_codegen:from_dict(File, Dict, Opts, Mode), + make(File, Opts, Dict, Rest) catch error: Reason -> - {error, {Reason, Mode, erlang:get_stacktrace()}} + erlang:error({Reason, Mode, erlang:get_stacktrace()}) end. diff --git a/lib/diameter/src/compiler/diameter_spec_scan.erl b/lib/diameter/src/compiler/diameter_spec_scan.erl deleted file mode 100644 index bc0448882a..0000000000 --- a/lib/diameter/src/compiler/diameter_spec_scan.erl +++ /dev/null @@ -1,157 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_spec_scan). - -%% -%% Functions used by the spec file parser in diameter_spec_util. -%% - --export([split/1, - split/2, - parse/1]). - -%%% ----------------------------------------------------------- -%%% # parse/1 -%%% -%%% Output: list of Token -%%% -%%% Token = '{' | '}' | '<' | '>' | '[' | ']' -%%% | '*' | '::=' | ':' | ',' | '-' -%%% | {name, string()} -%%% | {tag, atom()} -%%% | {number, integer() >= 0} -%%% -%%% Tokenize a string. Fails if the string does not parse. -%%% ----------------------------------------------------------- - -parse(S) -> - parse(S, []). - -%% parse/2 - -parse(S, Acc) -> - acc(split(S), Acc). - -acc({T, Rest}, Acc) -> - parse(Rest, [T | Acc]); -acc("", Acc) -> - lists:reverse(Acc). - -%%% ----------------------------------------------------------- -%%% # split/2 -%%% -%%% Output: {list() of Token, Rest} -%%% -%%% Extract a specified number of tokens from a string. Returns a list -%%% of length less than the specified number if there are less than -%%% this number of tokens to be parsed. -%%% ----------------------------------------------------------- - -split(Str, N) - when N >= 0 -> - split(N, Str, []). - -split(0, Str, Acc) -> - {lists:reverse(Acc), Str}; - -split(N, Str, Acc) -> - case split(Str) of - {T, Rest} -> - split(N-1, Rest, [T|Acc]); - "" = Rest -> - {lists:reverse(Acc), Rest} - end. - -%%% ----------------------------------------------------------- -%%% # split/1 -%%% -%%% Output: {Token, Rest} | "" -%%% -%%% Extract the next token from a string. -%%% ----------------------------------------------------------- - -split("" = Rest) -> - Rest; - -split("::=" ++ T) -> - {'::=', T}; - -split([H|T]) - when H == ${; H == $}; - H == $<; H == $>; - H == $[; H == $]; - H == $*; H == $:; H == $,; H == $- -> - {list_to_atom([H]), T}; - -split([H|T]) when $A =< H, H =< $Z; - $0 =< H, H =< $9 -> - {P, Rest} = splitwith(fun is_name_ch/1, [H], T), - Tok = try - {number, read_int(P)} - catch - error:_ -> - {name, P} - end, - {Tok, Rest}; - -split([H|T]) when $a =< H, H =< $z -> - {P, Rest} = splitwith(fun is_name_ch/1, [H], T), - {{tag, list_to_atom(P)}, Rest}; - -split([H|T]) when H == $\t; - H == $\s; - H == $\n -> - split(T). - -%% read_int/1 - -read_int([$0,X|S]) - when X == $X; - X == $x -> - {ok, [N], []} = io_lib:fread("~16u", S), - N; - -read_int(S) -> - list_to_integer(S). - -%% splitwith/3 - -splitwith(Fun, Acc, S) -> - split([] /= S andalso Fun(hd(S)), Fun, Acc, S). - -split(true, Fun, Acc, [H|T]) -> - splitwith(Fun, [H|Acc], T); -split(false, _, Acc, S) -> - {lists:reverse(Acc), S}. - -is_name_ch(C) -> - is_alphanum(C) orelse C == $- orelse C == $_. - -is_alphanum(C) -> - is_lower(C) orelse is_upper(C) orelse is_digit(C). - -is_lower(C) -> - $a =< C andalso C =< $z. - -is_upper(C) -> - $A =< C andalso C =< $Z. - -is_digit(C) -> - $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl deleted file mode 100644 index 62536bf06d..0000000000 --- a/lib/diameter/src/compiler/diameter_spec_util.erl +++ /dev/null @@ -1,1089 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. 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 module turns a .dia (aka spec) file into the orddict that -%% diameter_codegen.erl in turn morphs into .erl and .hrl files for -%% encode and decode of Diameter messages and AVPs. -%% - --module(diameter_spec_util). - --export([parse/2]). - --define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). --define(ATOM, list_to_atom). - -%% parse/1 -%% -%% Output: orddict() - -parse(Path, Opts) -> - put({?MODULE, verbose}, lists:member(verbose, Opts)), - {ok, B} = file:read_file(Path), - Chunks = chunk(B), - Spec = reset(make_spec(Chunks), Opts, [name, prefix, inherits]), - true = groups_defined(Spec), %% sanity checks - true = customs_defined(Spec), %% - Full = import_enums(import_groups(import_avps(insert_codes(Spec), Opts))), - true = enums_defined(Full), %% sanity checks - true = v_flags_set(Spec), - Full. - -reset(Spec, Opts, Keys) -> - lists:foldl(fun(K,S) -> - reset([{A,?ATOM(V)} || {A,V} <- Opts, A == K], S) - end, - Spec, - Keys). - -reset(L, Spec) - when is_list(L) -> - lists:foldl(fun reset/2, Spec, L); - -reset({inherits = Key, '-'}, Spec) -> - orddict:erase(Key, Spec); -reset({inherits = Key, Dict}, Spec) -> - orddict:append(Key, Dict, Spec); -reset({Key, Atom}, Spec) -> - orddict:store(Key, Atom, Spec); -reset(_, Spec) -> - Spec. - -%% Optional reports when running verbosely. -report(What, Data) -> - report(get({?MODULE, verbose}), What, Data). - -report(true, Tag, Data) -> - io:format("##~n## ~p ~p~n", [Tag, Data]); -report(false, _, _) -> - ok. - -%% chunk/1 - -chunk(B) -> - chunkify(normalize(binary_to_list(B))). - -%% normalize/1 -%% -%% Replace CR NL by NL, multiple NL by one, tab by space, and strip -%% comments and leading/trailing space from each line. Precludes -%% semicolons being used for any other purpose than comments. - -normalize(Str) -> - nh(Str, []). - -nh([], Acc) -> - lists:reverse(Acc); - -%% Trim leading whitespace. -nh(Str, Acc) -> - nb(trim(Str), Acc). - -%% tab -> space -nb([$\t|Rest], Acc) -> - nb(Rest, [$\s|Acc]); - -%% CR NL -> NL -nb([$\r,$\n|Rest], Acc) -> - nt(Rest, Acc); - -%% Gobble multiple newlines before starting over again. -nb([$\n|Rest], Acc) -> - nt(Rest, Acc); - -%% Comment. -nb([$;|Rest], Acc) -> - nb(lists:dropwhile(fun(C) -> C /= $\n end, Rest), Acc); - -%% Just an ordinary character. Boring ... -nb([C|Rest], Acc) -> - nb(Rest, [C|Acc]); - -nb([] = Str, Acc) -> - nt(Str, Acc). - -%% Discard a subsequent newline. -nt(T, [$\n|_] = Acc) -> - nh(T, trim(Acc)); - -%% Trim whitespace from the end of the line before continuing. -nt(T, Acc) -> - nh(T, [$\n|trim(Acc)]). - -trim(S) -> - lists:dropwhile(fun(C) -> lists:member(C, "\s\t") end, S). - -%% chunkify/1 -%% -%% Split the spec file into pieces delimited by lines starting with -%% @Tag. Returns a list of {Tag, Args, Chunk} where Chunk is the -%% string extending to the next delimiter. Note that leading -%% whitespace has already been stripped. - -chunkify(Str) -> - %% Drop characters to the start of the first chunk. - {_, Rest} = split_chunk([$\n|Str]), - chunkify(Rest, []). - -chunkify([], Acc) -> - lists:reverse(Acc); - -chunkify(Rest, Acc) -> - {H,T} = split_chunk(Rest), - chunkify(T, [split_tag(H) | Acc]). - -split_chunk(Str) -> - split_chunk(Str, []). - -split_chunk([] = Rest, Acc) -> - {lists:reverse(Acc), Rest}; -split_chunk([$@|Rest], [$\n|_] = Acc) -> - {lists:reverse(Acc), Rest}; -split_chunk([C|Rest], Acc) -> - split_chunk(Rest, [C|Acc]). - -%% Expect a tag and its arguments on a single line. -split_tag(Str) -> - {L, Rest} = get_until($\n, Str), - [{tag, Tag} | Toks] = diameter_spec_scan:parse(L), - {Tag, Toks, trim(Rest)}. - -get_until(EndT, L) -> - {H, [EndT | T]} = lists:splitwith(fun(C) -> C =/= EndT end, L), - {H,T}. - -%% ------------------------------------------------------------------------ -%% make_spec/1 -%% -%% Turn chunks into spec. - -make_spec(Chunks) -> - lists:foldl(fun(T,A) -> report(chunk, T), chunk(T,A) end, - orddict:new(), - Chunks). - -chunk({T, [X], []}, Dict) - when T == name; - T == prefix -> - store(T, atomize(X), Dict); - -chunk({id = T, [{number, I}], []}, Dict) -> - store(T, I, Dict); - -chunk({vendor = T, [{number, I}, N], []}, Dict) -> - store(T, {I, atomize(N)}, Dict); - -%% inherits -> [{Mod, [AvpName, ...]}, ...] -chunk({inherits = T, [_,_|_] = Args, []}, Acc) -> - Mods = [atomize(A) || A <- Args], - append_list(T, [{M,[]} || M <- Mods], Acc); -chunk({inherits = T, [Mod], Body}, Acc) -> - append(T, {atomize(Mod), parse_avp_names(Body)}, Acc); - -%% avp_types -> [{AvpName, Code, Type, Flags, Encr}, ...] -chunk({avp_types = T, [], Body}, Acc) -> - store(T, parse_avp_types(Body), Acc); - -%% custom_types -> [{Mod, [AvpName, ...]}, ...] -chunk({custom_types = T, [Mod], Body}, Dict) -> - [_|_] = Avps = parse_avp_names(Body), - append(T, {atomize(Mod), Avps}, Dict); - -%% messages -> [{MsgName, Code, Type, Appl, Avps}, ...] -chunk({messages = T, [], Body}, Acc) -> - store(T, parse_messages(Body), Acc); - -%% grouped -> [{AvpName, Code, Vendor, Avps}, ...] -chunk({grouped = T, [], Body}, Acc) -> - store(T, parse_groups(Body), Acc); - -%% avp_vendor_id -> [{Id, [AvpName, ...]}, ...] -chunk({avp_vendor_id = T, [{number, I}], Body}, Dict) -> - [_|_] = Names = parse_avp_names(Body), - append(T, {I, Names}, Dict); - -%% enums -> [{AvpName, [{Value, Name}, ...]}, ...] -chunk({enum, [N], Str}, Dict) -> - append(enums, {atomize(N), parse_enums(Str)}, Dict); - -%% defines -> [{DefineName, [{Value, Name}, ...]}, ...] -chunk({define, [N], Str}, Dict) -> - append(defines, {atomize(N), parse_enums(Str)}, Dict); -chunk({result_code, [_] = N, Str}, Dict) -> %% backwards compatibility - chunk({define, N, Str}, Dict); - -%% commands -> [{Name, Abbrev}, ...] -chunk({commands = T, [], Body}, Dict) -> - store(T, parse_commands(Body), Dict); - -chunk(T, _) -> - ?ERROR({unknown_tag, T}). - -store(Key, Value, Dict) -> - error == orddict:find(Key, Dict) orelse ?ERROR({duplicate, Key}), - orddict:store(Key, Value, Dict). -append(Key, Value, Dict) -> - orddict:append(Key, Value, Dict). -append_list(Key, Values, Dict) -> - orddict:append_list(Key, Values, Dict). - -atomize({tag, T}) -> - T; -atomize({name, T}) -> - ?ATOM(T). - -get_value(Keys, Spec) - when is_list(Keys) -> - [get_value(K, Spec) || K <- Keys]; -get_value(Key, Spec) -> - proplists:get_value(Key, Spec, []). - -%% ------------------------------------------------------------------------ -%% enums_defined/1 -%% groups_defined/1 -%% customs_defined/1 -%% -%% Ensure that every local enum/grouped/custom is defined as an avp -%% with an appropriate type. - -enums_defined(Spec) -> - Avps = get_value(avp_types, Spec), - Import = get_value(import_enums, Spec), - lists:all(fun({N,_}) -> - true = enum_defined(N, Avps, Import) - end, - get_value(enums, Spec)). - -enum_defined(Name, Avps, Import) -> - case lists:keyfind(Name, 1, Avps) of - {Name, _, 'Enumerated', _, _} -> - true; - {Name, _, T, _, _} -> - ?ERROR({avp_has_wrong_type, Name, 'Enumerated', T}); - false -> - lists:any(fun({_,Is}) -> lists:keymember(Name, 1, Is) end, Import) - orelse ?ERROR({avp_not_defined, Name, 'Enumerated'}) - end. -%% Note that an AVP is imported only if referenced by a message or -%% grouped AVP, so the final branch will fail if an enum definition is -%% extended without this being the case. - -groups_defined(Spec) -> - Avps = get_value(avp_types, Spec), - lists:all(fun({N,_,_,_}) -> true = group_defined(N, Avps) end, - get_value(grouped, Spec)). - -group_defined(Name, Avps) -> - case lists:keyfind(Name, 1, Avps) of - {Name, _, 'Grouped', _, _} -> - true; - {Name, _, T, _, _} -> - ?ERROR({avp_has_wrong_type, Name, 'Grouped', T}); - false -> - ?ERROR({avp_not_defined, Name, 'Grouped'}) - end. - -customs_defined(Spec) -> - Avps = get_value(avp_types, Spec), - lists:all(fun(A) -> true = custom_defined(A, Avps) end, - lists:flatmap(fun last/1, get_value(custom_types, Spec))). - -custom_defined(Name, Avps) -> - case lists:keyfind(Name, 1, Avps) of - {Name, _, T, _, _} when T == 'Grouped'; - T == 'Enumerated' -> - ?ERROR({avp_has_invalid_custom_type, Name, T}); - {Name, _, _, _, _} -> - true; - false -> - ?ERROR({avp_not_defined, Name}) - end. - -last({_,Xs}) -> Xs. - -%% ------------------------------------------------------------------------ -%% v_flags_set/1 - -v_flags_set(Spec) -> - Avps = get_value(avp_types, Spec) - ++ lists:flatmap(fun last/1, get_value(import_avps, Spec)), - Vs = lists:flatmap(fun last/1, get_value(avp_vendor_id, Spec)), - - lists:all(fun(N) -> vset(N, Avps) end, Vs). - -vset(Name, Avps) -> - A = lists:keyfind(Name, 1, Avps), - false == A andalso ?ERROR({avp_not_defined, Name}), - {Name, _Code, _Type, Flags, _Encr} = A, - lists:member('V', Flags) orelse ?ERROR({v_flag_not_set, A}). - -%% ------------------------------------------------------------------------ -%% insert_codes/1 - -insert_codes(Spec) -> - [Msgs, Cmds] = get_value([messages, commands], Spec), - - %% Code -> [{Name, Flags}, ...] - Dict = lists:foldl(fun({N,C,Fs,_,_}, D) -> dict:append(C,{N,Fs},D) end, - dict:new(), - Msgs), - - %% list() of {Code, {ReqName, ReqAbbr}, {AnsName, AnsAbbr}} - %% If the name and abbreviation are the same then the 2-tuples - %% are replaced by the common atom()-valued name. - Codes = dict:fold(fun(C,Ns,A) -> [make_code(C, Ns, Cmds) | A] end, - [], - dict:erase(-1, Dict)), %% answer-message - - orddict:store(command_codes, Codes, Spec). - -make_code(Code, [_,_] = Ns, Cmds) -> - {Req, Ans} = make_names(Ns, lists:map(fun({_,Fs}) -> - lists:member('REQ', Fs) - end, - Ns)), - {Code, abbrev(Req, Cmds), abbrev(Ans, Cmds)}; - -make_code(Code, Cs, _) -> - ?ERROR({missing_request_or_answer, Code, Cs}). - -%% 3.3. Diameter Command Naming Conventions -%% -%% Diameter command names typically includes one or more English words -%% followed by the verb Request or Answer. Each English word is -%% delimited by a hyphen. A three-letter acronym for both the request -%% and answer is also normally provided. - -make_names([{Rname,_},{Aname,_}], [true, false]) -> - {Rname, Aname}; -make_names([{Aname,_},{Rname,_}], [false, true]) -> - {Rname, Aname}; -make_names([_,_] = Names, _) -> - ?ERROR({inconsistent_command_flags, Names}). - -abbrev(Name, Cmds) -> - case abbr(Name, get_value(Name, Cmds)) of - Name -> - Name; - Abbr -> - {Name, Abbr} - end. - -%% No explicit abbreviation: construct. -abbr(Name, []) -> - ?ATOM(abbr(string:tokens(atom_to_list(Name), "-"))); - -%% Abbreviation was specified. -abbr(_Name, Abbr) -> - Abbr. - -%% No hyphens: already abbreviated. -abbr([Abbr]) -> - Abbr; - -%% XX-Request/Answer ==> XXR/XXA -abbr([[_,_] = P, T]) - when T == "Request"; - T == "Answer" -> - P ++ [hd(T)]; - -%% XXX-...-YYY-Request/Answer ==> X...YR/X...YA -abbr([_,_|_] = L) -> - lists:map(fun erlang:hd/1, L). - -%% ------------------------------------------------------------------------ -%% import_avps/2 - -import_avps(Spec, Options) -> - Msgs = get_value(messages, Spec), - Groups = get_value(grouped, Spec), - - %% Messages and groups require AVP's referenced by them. - NeededAvps - = ordsets:from_list(lists:flatmap(fun({_,_,_,_,As}) -> - [avp_name(A) || A <- As] - end, - Msgs) - ++ lists:flatmap(fun({_,_,_,As}) -> - [avp_name(A) || A <- As] - end, - Groups)), - MissingAvps = missing_avps(NeededAvps, Spec), - - report(needed, NeededAvps), - report(missing, MissingAvps), - - Import = inherit(get_value(inherits, Spec), Options), - - report(imported, Import), - - ImportedAvps = lists:map(fun({N,_,_,_,_}) -> N end, - lists:flatmap(fun last/1, Import)), - - Unknown = MissingAvps -- ImportedAvps, - - [] == Unknown orelse ?ERROR({undefined_avps, Unknown}), - - orddict:store(import_avps, Import, orddict:erase(inherits, Spec)). - -%% missing_avps/2 -%% -%% Given a list of AVP names and parsed spec, return the list of -%% AVP's that aren't defined in this spec. - -missing_avps(NeededNames, Spec) -> - Avps = get_value(avp_types, Spec), - Groups = lists:map(fun({N,_,_,As}) -> - {N, [avp_name(A) || A <- As]} - end, - get_value(grouped, Spec)), - Names = ordsets:from_list(['AVP' | lists:map(fun({N,_,_,_,_}) -> N end, - Avps)]), - missing_avps(NeededNames, [], {Names, Groups}). - -avp_name({'<',A,'>'}) -> A; -avp_name({A}) -> A; -avp_name([A]) -> A; -avp_name({_, A}) -> avp_name(A). - -missing_avps(NeededNames, MissingNames, {Names, _} = T) -> - missing(ordsets:filter(fun(N) -> lists:member(N, NeededNames) end, Names), - ordsets:union(NeededNames, MissingNames), - T). - -%% Nothing found locally. -missing([], MissingNames, _) -> - MissingNames; - -%% Or not. Keep looking for for the AVP's needed by the found AVP's of -%% type Grouped. -missing(FoundNames, MissingNames, {_, Groups} = T) -> - NeededNames = lists:flatmap(fun({N,As}) -> - choose(lists:member(N, FoundNames), As, []) - end, - Groups), - missing_avps(ordsets:from_list(NeededNames), - ordsets:subtract(MissingNames, FoundNames), - T). - -%% inherit/2 - -inherit(Inherits, Options) -> - Dirs = [D || {include, D} <- Options] ++ ["."], - lists:foldl(fun(T,A) -> find_avps(T, A, Dirs) end, [], Inherits). - -find_avps({Mod, AvpNames}, Acc, Path) -> - report(inherit_from, Mod), - Avps = avps_from_beam(find_beam(Mod, Path), Mod), %% could be empty - [{Mod, lists:sort(find_avps(AvpNames, Avps))} | Acc]. - -find_avps([], Avps) -> - Avps; -find_avps(Names, Avps) -> - lists:filter(fun({N,_,_,_,_}) -> lists:member(N, Names) end, Avps). - -%% find_beam/2 - -find_beam(Mod, Dirs) - when is_atom(Mod) -> - find_beam(atom_to_list(Mod), Dirs); -find_beam(Mod, Dirs) -> - Beam = Mod ++ code:objfile_extension(), - case try_path(Dirs, Beam) of - {value, Path} -> - Path; - false -> - ?ERROR({beam_not_on_path, Beam, Dirs}) - end. - -try_path([D|Ds], Fname) -> - Path = filename:join(D, Fname), - case file:read_file_info(Path) of - {ok, _} -> - {value, Path}; - _ -> - try_path(Ds, Fname) - end; -try_path([], _) -> - false. - -%% avps_from_beam/2 - -avps_from_beam(Path, Mod) -> - report(beam, Path), - ok = load_module(code:is_loaded(Mod), Mod, Path), - orddict:fetch(avp_types, Mod:dict()). - -load_module(false, Mod, Path) -> - R = filename:rootname(Path, code:objfile_extension()), - {module, Mod} = code:load_abs(R), - ok; -load_module({file, _}, _, _) -> - ok. - -choose(true, X, _) -> X; -choose(false, _, X) -> X. - -%% ------------------------------------------------------------------------ -%% import_groups/1 -%% import_enums/1 -%% -%% For each inherited module, store the content of imported AVP's of -%% type grouped/enumerated in a new key. - -import_groups(Spec) -> - orddict:store(import_groups, import(grouped, Spec), Spec). - -import_enums(Spec) -> - orddict:store(import_enums, import(enums, Spec), Spec). - -import(Key, Spec) -> - lists:flatmap(fun(T) -> import_key(Key, T) end, - get_value(import_avps, Spec)). - -import_key(Key, {Mod, Avps}) -> - Imports = lists:flatmap(fun(T) -> - choose(lists:keymember(element(1,T), - 1, - Avps), - [T], - []) - end, - get_value(Key, Mod:dict())), - if Imports == [] -> - []; - true -> - [{Mod, Imports}] - end. - -%% ------------------------------------------------------------------------ -%% parse_enums/1 -%% -%% Enums are specified either as the integer value followed by the -%% name or vice-versa. In the former case the name of the enum is -%% taken to be the string up to the end of line, which may contain -%% whitespace. In the latter case the integer may be parenthesized, -%% specified in hex and followed by an inline comment. This is -%% historical and will likely be changed to require a precise input -%% format. -%% -%% Output: list() of {integer(), atom()} - -parse_enums(Str) -> - lists:flatmap(fun(L) -> parse_enum(trim(L)) end, string:tokens(Str, "\n")). - -parse_enum([]) -> - []; - -parse_enum(Str) -> - REs = [{"^(0[xX][0-9A-Fa-f]+|[0-9]+)\s+(.*?)\s*$", 1, 2}, - {"^(.+?)\s+(0[xX][0-9A-Fa-f]+|[0-9]+)(\s+.*)?$", 2, 1}, - {"^(.+?)\s+\\((0[xX][0-9A-Fa-f]+|[0-9]+)\\)(\s+.*)?$", 2, 1}], - parse_enum(Str, REs). - -parse_enum(Str, REs) -> - try lists:foreach(fun(R) -> enum(Str, R) end, REs) of - ok -> - ?ERROR({bad_enum, Str}) - catch - throw: {enum, T} -> - [T] - end. - -enum(Str, {Re, I, N}) -> - case re:run(Str, Re, [{capture, all_but_first, list}]) of - {match, Vs} -> - T = list_to_tuple(Vs), - throw({enum, {to_int(element(I,T)), ?ATOM(element(N,T))}}); - nomatch -> - ok - end. - -to_int([$0,X|Hex]) - when X == $x; - X == $X -> - {ok, [I], _} = io_lib:fread("~#", "16#" ++ Hex), - I; -to_int(I) -> - list_to_integer(I). - -%% ------------------------------------------------------------------------ -%% parse_messages/1 -%% -%% Parse according to the ABNF for message specifications in 3.2 of -%% RFC 3588 (shown below). We require all message and AVP names to -%% start with a digit or uppercase character, except for the base -%% answer-message, which is treated as a special case. Allowing names -%% that start with a digit is more than the RFC specifies but the name -%% doesn't affect what's sent over the wire. (Certains 3GPP standards -%% use names starting with a digit. eg 3GPP-Charging-Id in TS32.299.) - -%% -%% Sadly, not even the RFC follows this grammar. In particular, except -%% in the example in 3.2, it wraps each command-name in angle brackets -%% ('<' '>') which makes parsing a sequence of specifications require -%% lookahead: after 'optional' avps have been parsed, it's not clear -%% whether a '<' is a 'fixed' or whether it's the start of a -%% subsequent message until we see whether or not '::=' follows the -%% closing '>'. Require the grammar as specified. -%% -%% Output: list of {Name, Code, Flags, ApplId, Avps} -%% -%% Name = atom() -%% Code = integer() -%% Flags = integer() -%% ApplId = [] | [integer()] -%% Avps = see parse_avps/1 - -parse_messages(Str) -> - p_cmd(trim(Str), []). - -%% command-def = command-name "::=" diameter-message -%% -%% command-name = diameter-name -%% -%% diameter-name = ALPHA *(ALPHA / DIGIT / "-") -%% -%% diameter-message = header [ *fixed] [ *required] [ *optional] -%% [ *fixed] -%% -%% header = "<" Diameter-Header:" command-id -%% [r-bit] [p-bit] [e-bit] [application-id]">" -%% -%% The header spec (and example that follows it) is slightly mangled -%% and, given the examples in the RFC should as follows: -%% -%% header = "<" "Diameter Header:" command-id -%% [r-bit] [p-bit] [e-bit] [application-id]">" -%% -%% This is what's required/parsed below, modulo whitespace. This is -%% also what's specified in the current draft standard at -%% http://ftp.ietf.org/drafts/wg/dime. -%% -%% Note that the grammar specifies the order fixed, required, -%% optional. In practise there seems to be little difference between -%% the latter two since qualifiers can be used to change the -%% semantics. For example 1*[XXX] and *1{YYY} specify 1 or more of the -%% optional avp XXX and 0 or 1 of the required avp YYY, making the -%% iotional avp required and the required avp optional. The current -%% draft addresses this somewhat by requiring that min for a qualifier -%% on an optional avp must be 0 if present. It doesn't say anything -%% about required avps however, so specifying a min of 0 would still -%% be possible. The draft also does away with the trailing *fixed. -%% -%% What will be parsed here will treat required and optional -%% interchangeably. That is. only require that required/optional -%% follow and preceed fixed, not that optional avps must follow -%% required ones. We already have several specs for which this parsing -%% is necessary and there seems to be no harm in accepting it. - -p_cmd("", Acc) -> - lists:reverse(Acc); - -p_cmd(Str, Acc) -> - {Next, Rest} = split_def(Str), - report(command, Next), - p_cmd(Rest, [p_cmd(Next) | Acc]). - -p_cmd("answer-message" ++ Str) -> - p_header([{name, 'answer-message'} | diameter_spec_scan:parse(Str)]); - -p_cmd(Str) -> - p_header(diameter_spec_scan:parse(Str)). - -%% p_header/1 - -p_header(['<', {name, _} = N, '>' | Toks]) -> - p_header([N | Toks]); - -p_header([{name, 'answer-message' = N}, '::=', - '<', {name, "Diameter"}, {name, "Header"}, ':', {tag, code}, - ',', {name, "ERR"}, '[', {name, "PXY"}, ']', '>' - | Toks]) -> - {N, -1, ['ERR', 'PXY'], [], parse_avps(Toks)}; - -p_header([{name, Name}, '::=', - '<', {name, "Diameter"}, {name, "Header"}, ':', {number, Code} - | Toks]) -> - {Flags, Rest} = p_flags(Toks), - {ApplId, [C|_] = R} = p_appl(Rest), - '>' == C orelse ?ERROR({invalid_flag, {Name, Code, Flags, ApplId}, R}), - {?ATOM(Name), Code, Flags, ApplId, parse_avps(tl(R))}; - -p_header(Toks) -> - ?ERROR({invalid_header, Toks}). - -%% application-id = 1*DIGIT -%% -%% command-id = 1*DIGIT -%% ; The Command Code assigned to the command -%% -%% r-bit = ", REQ" -%% ; If present, the 'R' bit in the Command -%% ; Flags is set, indicating that the message -%% ; is a request, as opposed to an answer. -%% -%% p-bit = ", PXY" -%% ; If present, the 'P' bit in the Command -%% ; Flags is set, indicating that the message -%% ; is proxiable. -%% -%% e-bit = ", ERR" -%% ; If present, the 'E' bit in the Command -%% ; Flags is set, indicating that the answer -%% ; message contains a Result-Code AVP in -%% ; the "protocol error" class. - -p_flags(Toks) -> - lists:foldl(fun p_flags/2, {[], Toks}, ["REQ", "PXY", "ERR"]). - -p_flags(N, {Acc, [',', {name, N} | Toks]}) -> - {[?ATOM(N) | Acc], Toks}; - -p_flags(_, T) -> - T. - -%% The RFC doesn't specify ',' before application-id but this seems a -%% bit inconsistent. Accept a comma if it exists. -p_appl([',', {number, I} | Toks]) -> - {[I], Toks}; -p_appl([{number, I} | Toks]) -> - {[I], Toks}; -p_appl(Toks) -> - {[], Toks}. - -%% parse_avps/1 -%% -%% Output: list() of Avp | {Qual, Avp} -%% -%% Qual = '*' | {Min, '*'} | {'*', Max} | {Min, Max} -%% Avp = {'<', Name, '>'} | {Name} | [Name] -%% -%% Min, Max = integer() >= 0 - -parse_avps(Toks) -> - p_avps(Toks, ['<', '|', '<'], []). -%% The list corresponds to the delimiters expected at the front, middle -%% and back of the avp specification, '|' representing '{' and '['. - -%% fixed = [qual] "<" avp-spec ">" -%% ; Defines the fixed position of an AVP -%% -%% required = [qual] "{" avp-spec "}" -%% ; The AVP MUST be present and can appear -%% ; anywhere in the message. -%% -%% optional = [qual] "[" avp-name "]" -%% ; The avp-name in the 'optional' rule cannot -%% ; evaluate to any AVP Name which is included -%% ; in a fixed or required rule. The AVP can -%% ; appear anywhere in the message. -%% -%% qual = [min] "*" [max] -%% ; See ABNF conventions, RFC 2234 Section 6.6. -%% ; The absence of any qualifiers depends on whether -%% ; it precedes a fixed, required, or optional -%% ; rule. If a fixed or required rule has no -%% ; qualifier, then exactly one such AVP MUST -%% ; be present. If an optional rule has no -%% ; qualifier, then 0 or 1 such AVP may be -%% ; present. -%% ; -%% ; NOTE: "[" and "]" have a different meaning -%% ; than in ABNF (see the optional rule, above). -%% ; These braces cannot be used to express -%% ; optional fixed rules (such as an optional -%% ; ICV at the end). To do this, the convention -%% ; is '0*1fixed'. -%% -%% min = 1*DIGIT -%% ; The minimum number of times the element may -%% ; be present. The default value is zero. -%% -%% max = 1*DIGIT -%% ; The maximum number of times the element may -%% ; be present. The default value is infinity. A -%% ; value of zero implies the AVP MUST NOT be -%% ; present. -%% -%% avp-spec = diameter-name -%% ; The avp-spec has to be an AVP Name, defined -%% ; in the base or extended Diameter -%% ; specifications. -%% -%% avp-name = avp-spec / "AVP" -%% ; The string "AVP" stands for *any* arbitrary -%% ; AVP Name, which does not conflict with the -%% ; required or fixed position AVPs defined in -%% ; the command code definition. -%% - -p_avps([], _, Acc) -> - lists:reverse(Acc); - -p_avps(Toks, Delim, Acc) -> - {Qual, Rest} = p_qual(Toks), - {Avp, R, D} = p_avp(Rest, Delim), - T = if Qual == false -> - Avp; - true -> - {Qual, Avp} - end, - p_avps(R, D, [T | Acc]). - -p_qual([{number, Min}, '*', {number, Max} | Toks]) -> - {{Min, Max}, Toks}; -p_qual([{number, Min}, '*' = Max | Toks]) -> - {{Min, Max}, Toks}; -p_qual(['*' = Min, {number, Max} | Toks]) -> - {{Min, Max}, Toks}; -p_qual(['*' = Q | Toks]) -> - {Q, Toks}; -p_qual(Toks) -> - {false, Toks}. - -p_avp([B, {name, Name}, E | Toks], [_|_] = Delim) -> - {avp(B, ?ATOM(Name), E), - Toks, - delim(choose(B == '<', B, '|'), Delim)}; -p_avp(Toks, Delim) -> - ?ERROR({invalid_avp, Toks, Delim}). - -avp('<' = B, Name, '>' = E) -> - {B, Name, E}; -avp('{', Name, '}') -> - {Name}; -avp('[', Name, ']') -> - [Name]; -avp(B, Name, E) -> - ?ERROR({invalid_avp, B, Name, E}). - -delim(B, D) -> - if B == hd(D) -> D; true -> tl(D) end. - -%% split_def/1 -%% -%% Strip one command definition off head of a string. - -split_def(Str) -> - sdh(Str, []). - -%% Look for the "::=" starting off the definition. -sdh("", _) -> - ?ERROR({missing, '::='}); -sdh("::=" ++ Rest, Acc) -> - sdb(Rest, [$=,$:,$:|Acc]); -sdh([C|Rest], Acc) -> - sdh(Rest, [C|Acc]). - -%% Look for the "::=" starting off the following definition. -sdb("::=" ++ _ = Rest, Acc) -> - sdt(trim(Acc), Rest); -sdb("" = Rest, Acc) -> - sd(Acc, Rest); -sdb([C|Rest], Acc) -> - sdb(Rest, [C|Acc]). - -%% Put name characters of the subsequent specification back into Rest. -sdt([C|Acc], Rest) - when C /= $\n, C /= $\s -> - sdt(Acc, [C|Rest]); - -sdt(Acc, Rest) -> - sd(Acc, Rest). - -sd(Acc, Rest) -> - {trim(lists:reverse(Acc)), Rest}. -%% Note that Rest is already trimmed of leading space. - -%% ------------------------------------------------------------------------ -%% parse_groups/1 -%% -%% Parse according to the ABNF for message specifications in 4.4 of -%% RFC 3588 (shown below). Again, allow names starting with a digit -%% and also require "AVP Header" without "-" since this is what -%% the RFC uses in all examples. -%% -%% Output: list of {Name, Code, Vendor, Avps} -%% -%% Name = atom() -%% Code = integer() -%% Vendor = [] | [integer()] -%% Avps = see parse_avps/1 - -parse_groups(Str) -> - p_group(trim(Str), []). - -%% grouped-avp-def = name "::=" avp -%% -%% name-fmt = ALPHA *(ALPHA / DIGIT / "-") -%% -%% name = name-fmt -%% ; The name has to be the name of an AVP, -%% ; defined in the base or extended Diameter -%% ; specifications. -%% -%% avp = header [ *fixed] [ *required] [ *optional] -%% [ *fixed] -%% -%% header = "<" "AVP-Header:" avpcode [vendor] ">" -%% -%% avpcode = 1*DIGIT -%% ; The AVP Code assigned to the Grouped AVP -%% -%% vendor = 1*DIGIT -%% ; The Vendor-ID assigned to the Grouped AVP. -%% ; If absent, the default value of zero is -%% ; used. - -p_group("", Acc) -> - lists:reverse(Acc); - -p_group(Str, Acc) -> - {Next, Rest} = split_def(Str), - report(group, Next), - p_group(Rest, [p_group(diameter_spec_scan:parse(Next)) | Acc]). - -p_group([{name, Name}, '::=', '<', {name, "AVP"}, {name, "Header"}, - ':', {number, Code} - | Toks]) -> - {Id, [C|_] = R} = p_vendor(Toks), - C == '>' orelse ?ERROR({invalid_group_header, R}), - {?ATOM(Name), Code, Id, parse_avps(tl(R))}; - -p_group(Toks) -> - ?ERROR({invalid_group, Toks}). - -p_vendor([{number, I} | Toks]) -> - {[I], Toks}; -p_vendor(Toks) -> - {[], Toks}. - -%% ------------------------------------------------------------------------ -%% parse_avp_names/1 - -parse_avp_names(Str) -> - [p_name(N) || N <- diameter_spec_scan:parse(Str)]. - -p_name({name, N}) -> - ?ATOM(N); -p_name(T) -> - ?ERROR({invalid_avp_name, T}). - -%% ------------------------------------------------------------------------ -%% parse_avp_types/1 -%% -%% Output: list() of {Name, Code, Type, Flags, Encr} - -parse_avp_types(Str) -> - p_avp_types(Str, []). - -p_avp_types(Str, Acc) -> - p_type(diameter_spec_scan:split(Str, 3), Acc). - -p_type({[],[]}, Acc) -> - lists:reverse(Acc); - -p_type({[{name, Name}, {number, Code}, {name, Type}], Str}, Acc) -> - {Flags, Encr, Rest} = try - p_avp_flags(trim(Str), []) - catch - throw: {?MODULE, Reason} -> - ?ERROR({invalid_avp_type, Reason}) - end, - p_avp_types(Rest, [{?ATOM(Name), Code, ?ATOM(type(Type)), Flags, Encr} - | Acc]); - -p_type(T, _) -> - ?ERROR({invalid_avp_type, T}). - -p_avp_flags([C|Str], Acc) - when C == $M; - C == $P; - C == $V -> - p_avp_flags(Str, [?ATOM([C]) | Acc]); -%% Could support lowercase here if there's a use for distinguishing -%% between Must and Should in the future in deciding whether or not -%% to set a flag. - -p_avp_flags([$-|Str], Acc) -> - %% Require encr on same line as flags if specified. - {H,T} = lists:splitwith(fun(C) -> C /= $\n end, Str), - - {[{name, [$X|X]} | Toks], Rest} = diameter_spec_scan:split([$X|H], 2), - - "" == X orelse throw({?MODULE, {invalid_avp_flag, Str}}), - - Encr = case Toks of - [] -> - "-"; - [{_, E}] -> - (E == "Y" orelse E == "N") - orelse throw({?MODULE, {invalid_encr, E}}), - E - end, - - Flags = ordsets:from_list(lists:reverse(Acc)), - - {Flags, ?ATOM(Encr), Rest ++ T}; - -p_avp_flags(Str, Acc) -> - p_avp_flags([$-|Str], Acc). - -type("DiamIdent") -> "DiameterIdentity"; %% RFC 3588 -type("DiamURI") -> "DiameterURI"; %% RFC 3588 -type("IPFltrRule") -> "IPFilterRule"; %% RFC 4005 -type("QoSFltrRule") -> "QoSFilterRule"; %% RFC 4005 -type(N) - when N == "OctetString"; - N == "Integer32"; - N == "Integer64"; - N == "Unsigned32"; - N == "Unsigned64"; - N == "Float32"; - N == "Float64"; - N == "Grouped"; - N == "Enumerated"; - N == "Address"; - N == "Time"; - N == "UTF8String"; - N == "DiameterIdentity"; - N == "DiameterURI"; - N == "IPFilterRule"; - N == "QoSFilterRule" -> - N; -type(N) -> - ?ERROR({invalid_avp_type, N}). - -%% ------------------------------------------------------------------------ -%% parse_commands/1 - -parse_commands(Str) -> - p_abbr(diameter_spec_scan:parse(Str), []). - - p_abbr([{name, Name}, {name, Abbrev} | Toks], Acc) - when length(Abbrev) < length(Name) -> - p_abbr(Toks, [{?ATOM(Name), ?ATOM(Abbrev)} | Acc]); - -p_abbr([], Acc) -> - lists:reverse(Acc); - -p_abbr(T, _) -> - ?ERROR({invalid_command, T}). diff --git a/lib/diameter/src/compiler/diameter_vsn.hrl b/lib/diameter/src/compiler/diameter_vsn.hrl new file mode 100644 index 0000000000..024d047adc --- /dev/null +++ b/lib/diameter/src/compiler/diameter_vsn.hrl @@ -0,0 +1,22 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% The version of the format of the return value of dict/0 in +%% generated dictionary modules. +-define(VERSION, 1). diff --git a/lib/diameter/src/dict/base_rfc3588.dia b/lib/diameter/src/dict/base_rfc3588.dia index f7a0b717cd..acd7fffd00 100644 --- a/lib/diameter/src/dict/base_rfc3588.dia +++ b/lib/diameter/src/dict/base_rfc3588.dia @@ -136,14 +136,14 @@ [ Origin-State-Id ] answer-message ::= < Diameter Header: code, ERR [PXY] > - 0*1 < Session-Id > - { Origin-Host } - { Origin-Realm } - { Result-Code } - [ Origin-State-Id ] - [ Error-Reporting-Host ] - [ Proxy-Info ] - * [ AVP ] + 0*1 < Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Reporting-Host ] + [ Proxy-Info ] + * [ AVP ] RAR ::= < Diameter Header: 258, REQ, PXY > < Session-Id > @@ -312,14 +312,14 @@ @enum Termination-Cause - DIAMETER_LOGOUT 1 - DIAMETER_SERVICE_NOT_PROVIDED 2 - DIAMETER_BAD_ANSWER 3 - DIAMETER_ADMINISTRATIVE 4 - DIAMETER_LINK_BROKEN 5 - DIAMETER_AUTH_EXPIRED 6 - DIAMETER_USER_MOVED 7 - DIAMETER_SESSION_TIMEOUT 8 + LOGOUT 1 + SERVICE_NOT_PROVIDED 2 + BAD_ANSWER 3 + ADMINISTRATIVE 4 + LINK_BROKEN 5 + AUTH_EXPIRED 6 + USER_MOVED 7 + SESSION_TIMEOUT 8 @enum Session-Server-Failover @@ -343,14 +343,53 @@ @define Result-Code -;; 7.1.1. Informational + ;; 7.1.1. Informational + MULTI_ROUND_AUTH 1001 + + ;; 7.1.2. Success + SUCCESS 2001 + LIMITED_SUCCESS 2002 + + ;; 7.1.3. Protocol Errors + COMMAND_UNSUPPORTED 3001 + UNABLE_TO_DELIVER 3002 + REALM_NOT_SERVED 3003 + TOO_BUSY 3004 + LOOP_DETECTED 3005 + REDIRECT_INDICATION 3006 + APPLICATION_UNSUPPORTED 3007 + INVALID_HDR_BITS 3008 + INVALID_AVP_BITS 3009 + UNKNOWN_PEER 3010 + + ;; 7.1.4. Transient Failures + AUTHENTICATION_REJECTED 4001 + OUT_OF_SPACE 4002 + ELECTION_LOST 4003 + + ;; 7.1.5. Permanent Failures + AVP_UNSUPPORTED 5001 + UNKNOWN_SESSION_ID 5002 + AUTHORIZATION_REJECTED 5003 + INVALID_AVP_VALUE 5004 + MISSING_AVP 5005 + RESOURCES_EXCEEDED 5006 + CONTRADICTING_AVPS 5007 + AVP_NOT_ALLOWED 5008 + AVP_OCCURS_TOO_MANY_TIMES 5009 + NO_COMMON_APPLICATION 5010 + UNSUPPORTED_VERSION 5011 + UNABLE_TO_COMPLY 5012 + INVALID_BIT_IN_HEADER 5013 + INVALID_AVP_LENGTH 5014 + INVALID_MESSAGE_LENGTH 5015 + INVALID_AVP_BIT_COMBO 5016 + NO_COMMON_SECURITY 5017 + + ;; With a prefix for backwards compatibility. DIAMETER_MULTI_ROUND_AUTH 1001 - -;; 7.1.2. Success DIAMETER_SUCCESS 2001 DIAMETER_LIMITED_SUCCESS 2002 - -;; 7.1.3. Protocol Errors DIAMETER_COMMAND_UNSUPPORTED 3001 DIAMETER_UNABLE_TO_DELIVER 3002 DIAMETER_REALM_NOT_SERVED 3003 @@ -361,13 +400,9 @@ DIAMETER_INVALID_HDR_BITS 3008 DIAMETER_INVALID_AVP_BITS 3009 DIAMETER_UNKNOWN_PEER 3010 - -;; 7.1.4. Transient Failures DIAMETER_AUTHENTICATION_REJECTED 4001 DIAMETER_OUT_OF_SPACE 4002 - ELECTION_LOST 4003 - -;; 7.1.5. Permanent Failures + DIAMETER_ELECTION_LOST 4003 DIAMETER_AVP_UNSUPPORTED 5001 DIAMETER_UNKNOWN_SESSION_ID 5002 DIAMETER_AUTHORIZATION_REJECTED 5003 @@ -412,3 +447,15 @@ ;; E2E-Sequence ::= <AVP Header: 300 > 2* { AVP } + +;; Backwards compatibility. +@define Termination-Cause + + DIAMETER_LOGOUT 1 + DIAMETER_SERVICE_NOT_PROVIDED 2 + DIAMETER_BAD_ANSWER 3 + DIAMETER_ADMINISTRATIVE 4 + DIAMETER_LINK_BROKEN 5 + DIAMETER_AUTH_EXPIRED 6 + DIAMETER_USER_MOVED 7 + DIAMETER_SESSION_TIMEOUT 8 diff --git a/lib/diameter/src/dict/relay.dia b/lib/diameter/src/dict/relay.dia index c22293209b..294014b093 100644 --- a/lib/diameter/src/dict/relay.dia +++ b/lib/diameter/src/dict/relay.dia @@ -21,5 +21,3 @@ @name diameter_gen_relay @prefix diameter_relay @vendor 0 IETF - -@inherits diameter_gen_base_rfc3588 diff --git a/lib/diameter/src/gen/.gitignore b/lib/diameter/src/gen/.gitignore index d490642eb7..3f32313f56 100644 --- a/lib/diameter/src/gen/.gitignore +++ b/lib/diameter/src/gen/.gitignore @@ -1,2 +1,2 @@ - +/diameter_dict_parser.erl /diameter_gen*rl diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index c7cbe598af..c5d448b2ff 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -24,10 +24,15 @@ DICTS = \ base_accounting \ relay +# The yecc grammar for the dictionary parser. +DICT_YRL = \ + diameter_dict_parser + # Handwritten (runtime) modules included in the app file. RT_MODULES = \ base/diameter \ base/diameter_app \ + base/diameter_callback \ base/diameter_capx \ base/diameter_config \ base/diameter_codec \ @@ -57,13 +62,12 @@ RT_MODULES = \ # Handwritten (compile time) modules not included in the app file. CT_MODULES = \ - base/diameter_callback \ base/diameter_dbg \ base/diameter_info \ compiler/diameter_codegen \ compiler/diameter_exprecs \ - compiler/diameter_spec_scan \ - compiler/diameter_spec_util \ + compiler/diameter_dict_scanner \ + compiler/diameter_dict_util \ compiler/diameter_make # Released hrl files in ../include intended for public consumption. @@ -74,8 +78,8 @@ EXTERNAL_HRLS = \ # Released hrl files intended for private use. INTERNAL_HRLS = \ base/diameter_internal.hrl \ - base/diameter_types.hrl \ - compiler/diameter_forms.hrl + compiler/diameter_forms.hrl \ + compiler/diameter_vsn.hrl # Released files relative to ../bin. BINS = \ diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 7f53a4ddd4..808f2cd30d 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -41,6 +41,18 @@ -define(A, list_to_atom). +%% Modules not in the app and that should not have dependencies on it +%% for build reasons. +-define(COMPILER_MODULES, [diameter_codegen, + diameter_dict_scanner, + diameter_dict_parser, + diameter_dict_util, + diameter_exprecs, + diameter_make]). + +-define(HELP_MODULES, [diameter_dbg, + diameter_info]). + %% =========================================================================== suite() -> @@ -93,14 +105,8 @@ vsn(Config) -> modules(Config) -> Mods = fetch(modules, fetch(app, Config)), Installed = code_mods(), - Help = [diameter_callback, - diameter_codegen, - diameter_dbg, - diameter_exprecs, - diameter_info, - diameter_make, - diameter_spec_scan, - diameter_spec_util], + Help = lists:sort(?HELP_MODULES ++ ?COMPILER_MODULES), + {[], Help} = {Mods -- Installed, lists:sort(Installed -- Mods)}. code_mods() -> @@ -167,14 +173,12 @@ xref(Config) -> %% stop xref from complaining about calls to module erlang, which %% was previously in kernel. Erts isn't an application however, in %% the sense that there's no .app file, and isn't listed in - %% applications. Seems less than ideal. Also, diameter_tcp does - %% call ssl despite ssl not being listed as a dependency in the - %% app file since ssl is only required for TLS security: it's up - %% to a client who wants TLS it to start ssl. + %% applications. ok = lists:foreach(fun(A) -> add_application(XRef, A) end, [?APP, erts | fetch(applications, App)]), {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), + {ok, Called} = xref:analyze(XRef, {module_call, ?COMPILER_MODULES}), xref:stop(XRef), @@ -183,7 +187,21 @@ xref(Config) -> lists:member(F, Mods) andalso {F,T} /= {diameter_tcp, ssl} end, - Undefs). + Undefs), + %% diameter_tcp does call ssl despite the latter not being listed + %% as a dependency in the app file since ssl is only required for + %% TLS security: it's up to a client who wants TLS it to start + %% ssl. + + [] = lists:filter(fun is_bad_dependency/1, Called). + +%% It's not strictly necessary that diameter compiler modules not +%% depend on other diameter modules but it's a simple source of build +%% errors if not encoded in the makefile (hence the test) so guard +%% against it. +is_bad_dependency(Mod) -> + lists:prefix("diameter", atom_to_list(Mod)) + andalso not lists:member(Mod, ?COMPILER_MODULES). add_application(XRef, App) -> add_application(XRef, App, code:lib_dir(App)). diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index 8046ca4c04..fbd38067a8 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -30,6 +30,9 @@ -define(BASE, diameter_gen_base_rfc3588). -define(BOOL, [true, false]). +-define(A, list_to_atom). +-define(S, atom_to_list). + %% =========================================================================== %% Interface. @@ -42,7 +45,7 @@ gen(Mod) -> command_codes, avp_types, grouped, - enums, + enum, import_avps, import_groups, import_enums]]). @@ -133,7 +136,7 @@ types() -> gen(M, T) -> [] = run(lists:map(fun(X) -> {?MODULE, [gen, M, T, X]} end, - fetch(T, M:dict()))). + fetch(T, dict(M)))). fetch(T, Spec) -> case orddict:find(T, Spec) of @@ -143,6 +146,10 @@ fetch(T, Spec) -> [] end. +gen(M, messages = T, {Name, Code, Flags, ApplId, Avps}) + when is_list(Name) -> + gen(M, T, {?A(Name), Code, Flags, ApplId, Avps}); + gen(M, messages, {Name, Code, Flags, _, _}) -> Rname = M:msg2rec(Name), Name = M:rec2msg(Rname), @@ -156,22 +163,16 @@ gen(M, messages, {Name, Code, Flags, _, _}) -> end, [] = arity(M, Name, Rname); -gen(M, command_codes = T, {Code, {Req, Abbr}, Ans}) -> - Rname = M:msg2rec(Req), - Rname = M:msg2rec(Abbr), - gen(M, T, {Code, Req, Ans}); - -gen(M, command_codes = T, {Code, Req, {Ans, Abbr}}) -> - Rname = M:msg2rec(Ans), - Rname = M:msg2rec(Abbr), - gen(M, T, {Code, Req, Ans}); - gen(M, command_codes, {Code, Req, Ans}) -> - Msgs = orddict:fetch(messages, M:dict()), + Msgs = orddict:fetch(messages, dict(M)), {_, Code, _, _, _} = lists:keyfind(Req, 1, Msgs), {_, Code, _, _, _} = lists:keyfind(Ans, 1, Msgs); -gen(M, avp_types, {Name, Code, Type, _Flags, _Encr}) -> +gen(M, avp_types = T, {Name, Code, Type, Flags}) + when is_list(Name) -> + gen(M, T, {?A(Name), Code, ?A(Type), Flags}); + +gen(M, avp_types, {Name, Code, Type, _Flags}) -> {Code, Flags, VendorId} = M:avp_header(Name), 0 = Flags band 2#00011111, V = undefined /= VendorId, @@ -181,11 +182,19 @@ gen(M, avp_types, {Name, Code, Type, _Flags, _Encr}) -> B = z(B), [] = avp_decode(M, Type, Name); +gen(M, grouped = T, {Name, Code, Vid, Avps}) + when is_list(Name) -> + gen(M, T, {?A(Name), Code, Vid, Avps}); + gen(M, grouped, {Name, _, _, _}) -> Rname = M:name2rec(Name), [] = arity(M, Name, Rname); -gen(M, enums, {Name, ED}) -> +gen(M, enum = T, {Name, ED}) + when is_list(Name) -> + gen(M, T, {?A(Name), lists:map(fun({E,D}) -> {?A(E), D} end, ED)}); + +gen(M, enum, {Name, ED}) -> [] = run([{?MODULE, [enum, M, Name, T]} || T <- ED]); gen(M, Tag, {_Mod, L}) -> @@ -253,17 +262,17 @@ arity(M, Name, AvpName, Rec) -> %% enum/3 -enum(M, Name, {E,_}) -> +enum(M, Name, {_,E}) -> B = <<E:32/integer>>, B = M:avp(encode, E, Name), E = M:avp(decode, B, Name). retag(import_avps) -> avp_types; retag(import_groups) -> grouped; -retag(import_enums) -> enums; +retag(import_enums) -> enum; retag(avp_types) -> import_avps; -retag(enums) -> import_enums. +retag(enum) -> import_enums. %% =========================================================================== @@ -370,8 +379,8 @@ values('Time') -> %% wrapped as for values/1. values('Enumerated', Name, Mod) -> - {_Name, Vals} = lists:keyfind(Name, 1, types(enums, Mod)), - lists:map(fun({N,_}) -> N end, Vals); + {_Name, Vals} = lists:keyfind(?S(Name), 1, types(enum, Mod)), + lists:map(fun({_,N}) -> N end, Vals); values('Grouped', Name, Mod) -> Rname = Mod:name2rec(Name), @@ -400,8 +409,8 @@ values('AVP', _) -> values(Name, Mod) -> Avps = types(avp_types, Mod), - {Name, _Code, Type, _Flags, _Encr} = lists:keyfind(Name, 1, Avps), - b(values(Type, Name, Mod)). + {_Name, _Code, Type, _Flags} = lists:keyfind(?S(Name), 1, Avps), + b(values(?A(Type), Name, Mod)). %% group/5 %% @@ -467,7 +476,7 @@ types(T, Mod) -> types(T, retag(T), Mod). types(T, IT, Mod) -> - Dict = Mod:dict(), + Dict = dict(Mod), fetch(T, Dict) ++ lists:flatmap(fun({_,As}) -> As end, fetch(IT, Dict)). %% random/[12] @@ -498,3 +507,8 @@ flatten({_, {{badmatch, [{_, {{badmatch, _}, _}} | _] = L}, _}}) -> L; flatten(T) -> [T]. + +%% dict/1 + +dict(Mod) -> + tl(Mod:dict()). diff --git a/lib/diameter/test/diameter_compiler_SUITE.erl b/lib/diameter/test/diameter_compiler_SUITE.erl new file mode 100644 index 0000000000..cc4b1ddac5 --- /dev/null +++ b/lib/diameter/test/diameter_compiler_SUITE.erl @@ -0,0 +1,272 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% +%% Tests of the dictionary file compiler. +%% + +-module(diameter_compiler_SUITE). +-compile({no_auto_import, [error/2]}). + +-export([suite/0, + all/0, + init_per_suite/1, + end_per_suite/1]). + +%% testcases +-export([format/1, + replace/1, replace/2]). + +-export([dict/0]). %% fake dictionary module + +-define(base, "base_rfc3588.dia"). +-define(util, diameter_util). +-define(S, atom_to_list). + +%% =========================================================================== + +%% RE/Replacement (in the sense of re:replace/4) pairs for morphing +%% base_rfc3588.dia. The key is 'ok' or the the expected error as +%% returned in the first element of the error tuple returned by +%% diameter_dict_util:parse/2. +-define(REPLACE, + [{scan, + "@id 0", + "@id \\&"}, + {scan, + "@name ", + "&'"}, + {parse, + "@id 0", + "@id @id"}, + {avp_code_already_defined, + "480", + "485"}, + {uint32_out_of_range, + "@id 0", + "@id 4294967296"}, + {uint32_out_of_range, + "@vendor 0", + "@vendor 4294967296"}, + {uint32_out_of_range, + [{"^ *Failed-AVP .*$", "&V"}, + {"@avp_types", "@avp_vendor_id 4294967296 Failed-AVP\n&"}]}, + {imported_avp_already_defined, + "@avp_types", + "@inherits diameter_gen_base_rfc3588 &"}, + {duplicate_import, + [{"@avp_types", "@inherits diameter_gen_base_rfc3588 Class\n&"}, + {"@avp_types", "@inherits diameter_gen_base_rfc3588\n&"}, + {"^@avp_types[^@]*", ""}, + {"^@enum[^&]*", ""}]}, + {duplicate_section, + "@prefix", + "@name"}, + {already_declared, + "@enum Termination-Cause", + "& XXX 0\n &"}, + {already_declared, + "@define Result-Code", + "& XXX 1000 &"}, + {inherited_avp_already_defined, + "@id", + "@inherits nomod Origin-Host &"}, + {avp_already_defined, + "@avp_types", + "@inherits m XXX\nXXX\n&"}, + {avp_already_defined, + "@avp_types", + "@inherits mod1 XXX\n@inherits mod2 XXX\n&"}, + {key_already_defined, + "DIAMETER_SUCCESS", + "& 2001\n&"}, + {messages_without_id, + "@id 0", + ""}, + {avp_name_already_defined, + "Class", + "& 666 Time M\n&"}, + {avp_has_unknown_type, + "Enumerated", + "Enum"}, + {avp_has_invalid_flag, + " -", + " X"}, + {avp_has_duplicate_flag, + " -", + " MM"}, + {avp_has_vendor_id, + "@avp_types", + "@avp_vendor_id 667 Class\n&"}, + {avp_has_no_vendor, + [{"^ *Class .*$", "&V"}, + {"@vendor .*", ""}]}, + {group_already_defined, + "@grouped", + "& Failed-AVP ::= < AVP Header: 279 > " "{AVP}\n&"}, + {grouped_avp_code_mismatch, + "(Failed-AVP ::= [^0-9]*27)9", + "&8"}, + {grouped_avp_has_wrong_type, + "(Failed-AVP *279 *)Grouped", + "\\1Time"}, + {grouped_avp_not_defined, + "Failed-AVP *.*", + ""}, + {grouped_vendor_id_without_flag, + "(Failed-AVP .*)>", + "\\1 668>"}, + {grouped_vendor_id_mismatch, + [{"(Failed-AVP .*)>", "\\1 17>"}, + {"^ *Failed-AVP .*$", "&V"}, + {"@avp_types", "@avp_vendor_id 18 Failed-AVP\n&"}]}, + {ok, + [{"(Failed-AVP .*)>", "\\1 17>"}, + {"^ *Failed-AVP .*$", "&V"}]}, + {message_name_already_defined, + "CEA ::= .*:", + "& 257 > {Result-Code}\n&"}, + {message_code_already_defined, + "CEA( ::= .*)", + "XXX\\1 {Result-Code}\n&"}, + {message_has_duplicate_flag, + "(CER ::=.*)>", + "\\1, REQ>"}, + {message_application_id_mismatch, + "(CER ::=.*)>", + "\\1 1>"}, + {invalid_avp_order, + "CEA ::=", + "{Result-Code} &"}, + {invalid_qualifier, + "CEA ::=.*", + "& 3*2"}, + {avp_already_referenced, + "CER ::=.*", + "& {Origin-Host}"}, + {message_missing, + "CER ::=", + "XXR ::= < Diameter-Header: 666, REQ > {Origin-Host} &"}, + {requested_avp_not_found, + [{"@id", "@inherits diameter_gen_base_rfc3588 XXX &"}, + {"CEA ::=", "<XXX> &"}]}, + {requested_avp_not_found, + [{"@id", "@inherits diameter_gen_base_rfc3588 'X X X' &"}, + {"CEA ::=", "<'X X X'> &"}]}, + {enumerated_avp_has_wrong_local_type, + "Enumerated", + "Time"}, + {enumerated_avp_not_defined, + [{"{ Disconnect-Cause }", ""}, + {"^ *Disconnect-Cause .*", ""}]}, + {avp_not_defined, + "CEA ::=", + "<XXX> &"}, + {not_loaded, + [{"@avp_types", "@inherits nomod XXX &"}, + {"CEA ::=", "<XXX> &"}]}, + {recompile, + [{"@avp_types", "@inherits " ++ ?S(?MODULE) ++ " XXX &"}, + {"CEA ::=", "<XXX> &"}]}, + {no_dict, + [{"@avp_types", "@inherits diameter XXX &"}, + {"CEA ::=", "<XXX> &"}]}, + {ok, + "@avp_types", + "@end & bad syntax"}, + {parse, + "@avp_types", + "& bad syntax"}, + {ok, + [{"@avp_types", "& 3XXX 666 Time M 'X X X' 667 Time -"}, + {"^ *Class .*", "@avp_types"}, + {"^ *Failed-AVP ", "@avp_types &"}, + {"@grouped", "&&"}, + {"^ *Failed-AVP ::=", "@grouped &"}, + {"CEA ::=", "<'Class'> &"}, + {"@avp_types", "@inherits diameter_gen_base_rfc3588 Class\n&"}, + {"@avp_types", "@custom_types mymod " + "Product-Name Firmware-Revision\n" + "@codecs mymod " + "Origin-Host Origin-Realm\n&"}]}]). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 5}}]. + +all() -> + [format, + replace]. + +%% Error handling testcases will make an erroneous dictionary out of +%% the base dictionary and check that the expected error results. +%% ?REPLACE encodes the modifications and expected error. +init_per_suite(Config) -> + Path = filename:join([code:lib_dir(diameter, src), "dict", ?base]), + {ok, Bin} = file:read_file(Path), + [{base, Bin} | Config]. + +end_per_suite(_Config) -> + ok. + +%% =========================================================================== +%% testcases + +%% Ensure that parse o format is the identity map. +format(Config) -> + Bin = proplists:get_value(base, Config), + {ok, Dict} = diameter_dict_util:parse(Bin, []), + {ok, D} = diameter_dict_util:parse(diameter_dict_util:format(Dict), []), + {Dict, Dict} = {Dict, D}. + +%% replace/1 + +replace(Config) -> + Bin = proplists:get_value(base, Config), + [] = ?util:run([{?MODULE, [replace, E, Bin]} || E <- ?REPLACE]). + +replace({E, RE, Repl}, Bin) -> + replace({E, [{RE, Repl}]}, Bin); + +replace({E, Mods}, Bin) -> + B = iolist_to_binary(lists:foldl(fun re/2, Bin, Mods)), + case {E, diameter_dict_util:parse(B, [{include, here()}]), Mods} of + {ok, {ok, Dict}, _} -> + Dict; + {_, {error, {E,_} = T}, _} -> + S = diameter_dict_util:format_error(T), + true = nochar($", S, E), + true = nochar($', S, E), + S + end. + +re({RE, Repl}, Bin) -> + re:replace(Bin, RE, Repl, [multiline]). + +%% =========================================================================== + +nochar(Char, Str, Err) -> + Err == parse orelse not lists:member(Char, Str) orelse Str. + +here() -> + filename:dirname(code:which(?MODULE)). + +dict() -> + [0 | orddict:new()]. diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index f4d62f94c6..429b6328e6 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -48,18 +48,13 @@ stop/1]). %% diameter callbacks --export([peer_up/3, - peer_down/3, - pick_peer/4, +-export([pick_peer/4, prepare_request/3, - prepare_retransmit/3, handle_answer/4, - handle_error/4, handle_request/3]). -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --include("diameter_ct.hrl"). %% =========================================================================== @@ -91,7 +86,12 @@ {'Acct-Application-Id', [Dict:id()]}, {application, [{alias, ?APP_ALIAS}, {dictionary, Dict}, - {module, ?MODULE}, + {module, #diameter_callback + {peer_up = false, + peer_down = false, + handle_error = false, + prepare_retransmit = false, + default = ?MODULE}}, {answer_errors, callback}]}]). -define(SUCCESS, 2001). @@ -181,16 +181,6 @@ set([H|T], Vs) -> %% =========================================================================== %% diameter callbacks -%% peer_up/3 - -peer_up(_SvcName, _Peer, State) -> - State. - -%% peer_down/3 - -peer_down(_SvcName, _Peer, State) -> - State. - %% pick_peer/4 %% Choose a server other than SERVER3 or SERVER5 if possible. @@ -219,22 +209,12 @@ prepare(#diameter_packet{msg = Req}, Caps) -> {'Origin-Host', OH}, {'Origin-Realm', OR}]). -%% prepare_retransmit/3 - -prepare_retransmit(Pkt, ?CLIENT, _Peer) -> - {send, Pkt}. - %% handle_answer/4 handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> #diameter_packet{msg = Rec, errors = []} = Pkt, Rec. -%% handle_error/4 - -handle_error(Reason, _Req, ?CLIENT, _Peer) -> - {error, Reason}. - %% handle_request/3 %% Only SERVER3 actually answers. diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index 40cbdf805a..c0351f8cf2 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -55,18 +55,14 @@ stop/1]). %% diameter callbacks --export([peer_up/3, - peer_down/3, - pick_peer/4, +-export([pick_peer/4, prepare_request/3, prepare_retransmit/3, handle_answer/4, - handle_error/4, handle_request/3]). -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --include("diameter_ct.hrl"). %% =========================================================================== @@ -102,7 +98,10 @@ {'Acct-Application-Id', [Dict:id()]}, {application, [{alias, ?APP_ALIAS}, {dictionary, Dict}, - {module, ?MODULE}, + {module, #diameter_callback{peer_up = false, + peer_down = false, + handle_error = false, + default = ?MODULE}}, {answer_errors, callback}]}]). -define(SUCCESS, 2001). @@ -256,16 +255,6 @@ set([H|T], Vs) -> %% =========================================================================== %% diameter callbacks -%% peer_up/3 - -peer_up(_SvcName, _Peer, State) -> - State. - -%% peer_down/3 - -peer_down(_SvcName, _Peer, State) -> - State. - %% pick_peer/4 pick_peer([Peer | _], _, Svc, _State) @@ -309,11 +298,6 @@ handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> #diameter_packet{msg = Rec, errors = []} = Pkt, Rec. -%% handle_error/4 - -handle_error(Reason, _Req, _Svc, _Peer) -> - {error, Reason}. - %% handle_request/3 handle_request(Pkt, OH, {_Ref, #diameter_caps{origin_host = {OH,_}} = Caps}) diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 127e3435dc..a325ca33eb 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -58,18 +58,13 @@ stop_ssl/1]). %% diameter callbacks --export([peer_up/3, - peer_down/3, - pick_peer/4, - prepare_request/3, +-export([prepare_request/3, prepare_retransmit/3, handle_answer/4, - handle_error/4, handle_request/3]). -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --include("diameter_ct.hrl"). %% =========================================================================== @@ -105,7 +100,11 @@ {'Auth-Application-Id', [Dict:id()]}, {application, [{alias, ?APP_ALIAS}, {dictionary, Dict}, - {module, ?MODULE}, + {module, #diameter_callback{peer_up = false, + peer_down = false, + pick_peer = false, + handle_error = false, + default = ?MODULE}}, {answer_errors, callback}]}]). %% Config for diameter:add_transport/2. In the listening case, listen @@ -152,16 +151,22 @@ init_per_group(_, Config) -> end_per_group(_, _) -> ok. +%% Shouldn't really have to know about crypto here but 'ok' from +%% ssl:start() isn't enough to guarantee that TLS is available. init_per_suite(Config) -> - case os:find_executable("openssl") of - false -> - {skip, no_openssl}; - _ -> - Config + try + false /= os:find_executable("openssl") + orelse throw({?MODULE, no_openssl}), + ok == crypto:start() + orelse throw({?MODULE, no_crypto}), + Config + catch + {?MODULE, E} -> + {skip, E} end. end_per_suite(_Config) -> - ok. + crypto:stop(). %% Testcases to run when services are started and connections %% established. @@ -246,21 +251,6 @@ send5(_Config) -> %% =========================================================================== %% diameter callbacks -%% peer_up/3 - -peer_up(_SvcName, _Peer, State) -> - State. - -%% peer_down/3 - -peer_down(_SvcName, _Peer, State) -> - State. - -%% pick_peer/4 - -pick_peer([Peer], _, ?CLIENT, _State) -> - {ok, Peer}. - %% prepare_request/3 prepare_request(#diameter_packet{msg = Req}, @@ -285,11 +275,6 @@ handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> #diameter_packet{msg = Rec, errors = []} = Pkt, Rec. -%% handle_error/4 - -handle_error(Reason, _Req, ?CLIENT, _Peer) -> - {error, Reason}. - %% handle_request/3 handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}}, diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 55c5fc7c54..78131b4ec4 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -89,7 +89,6 @@ -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). --include("diameter_ct.hrl"). %% =========================================================================== diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index c22adc3334..df7161fd1e 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -46,7 +46,6 @@ -include_lib("kernel/include/inet_sctp.hrl"). -include("diameter.hrl"). --include("diameter_ct.hrl"). -define(util, diameter_util). @@ -180,7 +179,8 @@ have_sctp() -> {ok, Sock} -> gen_sctp:close(Sock), true; - {error, eprotonosupport} -> %% fail on any other reason + {error, E} when E == eprotonosupport; + E == esocktnosupport -> %% fail on any other reason false catch error: badarg -> diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index f88258c232..54978d820c 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -24,6 +24,7 @@ MODULES = \ diameter_ct \ diameter_util \ diameter_enum \ + diameter_compiler_SUITE \ diameter_codec_SUITE \ diameter_codec_test \ diameter_app_SUITE \ diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index b1d3ba2241..0c240798cc 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 0.11 +DIAMETER_VSN = 1.0 PRE_VSN = APP_VSN = "$(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)" diff --git a/lib/erl_docgen/doc/src/Makefile b/lib/erl_docgen/doc/src/Makefile index a546d8da33..ff50c12895 100644 --- a/lib/erl_docgen/doc/src/Makefile +++ b/lib/erl_docgen/doc/src/Makefile @@ -44,6 +44,7 @@ XML_PART_FILES = \ XML_CHAPTER_FILES = \ overview.xml \ + doc-build.xml \ user_guide_dtds.xml \ refman_dtds.xml \ notes.xml \ diff --git a/lib/erl_docgen/doc/src/doc-build.xml b/lib/erl_docgen/doc/src/doc-build.xml new file mode 100644 index 0000000000..08410a1539 --- /dev/null +++ b/lib/erl_docgen/doc/src/doc-build.xml @@ -0,0 +1,188 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1997</year><year>2011</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + <title>How to Build OTP like documentation</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>doc-build.xml</file> + </header> + + <section> + <title>Utilities to prepare XML files</title> + <section> + <title>Create XML files from code</title> + <p> + If there are EDoc comments in a module, the escript <c>xml_from_edoc.escript</c> + can be used to generate an XML file according to the <c>erlref</c> DTD + for this module. + </p> + <p> + Example: + </p> + <code> + + 1> escript $(ERL_TOP)/lib/erl_docgen/priv/bin/xml_from_edoc.escript ex1.erl + </code> + </section> + <section> + <title>Include code in XML</title> + <p>If there are OTP DTD <i>codeinclude</i> tags in the source XML file, the escript + <c>codeline_preprocessing.escript</c> can be used to include the code and produce + an XML file according to the OTP DTDs. + </p> + <p> + Example: + </p> + <code> + + 1> escript $(ERL_TOP)/lib/erl_docgen/priv/bin/codeline_preprocessing.escript ex1.xmlsrc ex1.xml + </code> + </section> + </section> + + <section> + <title>Use xsltproc to generate different output formats</title> + + <section> + <title>Parameters used in all the the XSL transformations</title> + <p> + These parameters to <c>xsltproc</c> are used for all the supported output formats. + </p> + <taglist> + <tag><c>docgen</c></tag> + <item> + Path to erl_docgen's top directory. + </item> + <tag><c>gendate</c></tag> + <item> + The date string that will be used in the documentation. + </item> + <tag><c>appname</c></tag> + <item> + The name of the application.> + </item> + <tag><c>appver</c></tag> + <item> + The version of the application. + </item> + </taglist> + </section> + + <section> + <title>Generate HTML output</title> + <p> + When generating HTML one also needs these three pramaters to <c>xsltproc</c>. + </p> + <taglist> + <tag><c>outdir</c></tag> + <item> + Output directory for the produced html files. + </item> + <tag><c>topdocdir</c></tag> + <item> + If one builds a standalone documentation for an application this should be set to ".". + </item> + <tag><c>pdfdir</c></tag> + <item> + Relative path from the html directory to where the pdf file are placed. + </item> + </taglist> + <p> + Example: + </p> + <code> + + 1> xsltproc --noout --stringparam outdir /tmp/myhtmldoc \ + --stringparam docgen $(ERL_TOP)/lib/erl_docgen \ + --stringparam topdocdir . \ + --stringparam pdfdir "$(PDFDIR)" \ + --xinclude \ + --stringparam gendate "December 5 2011" \ + --stringparam appname MyApp \ + --stringparam appver 0.1 \ + -path $ERL_TOP/lib/erl_docgen/priv/dtd \ + -path $ERL_TOP/lib/erl_docgen/priv/dtd_html_entities \ + $ERL_TOP/lib/erl_docgen/priv/xsl/db_html.xsl mybook.xml + </code> + </section> + + <section> + <title>Generate PDF</title> + <p> + The generation of the PDF file is done in two steps. First is <c>xsltproc</c> used to generate a <c>.fo</c> file + which is used as input to the <c>fop</c> command to produce th PDF file. + </p> + <p> + Example: + </p> + <code> + + 1> xsltproc --output MyApp.fo \ + --stringparam docgen $ERL_TOP/lib/erl_docgen \ + --stringparam gendate "December 5 2011" \ + --stringparam appname MyApp \ + --stringparam appver 0.1 \ + --xinclude \ + -path $ERL_TOP/lib/erl_docgen/priv/dtd \ + -path $ERL_TOP/lib/erl_docgen/priv/dtd_html_entities \ + $ERL_TOP/lib/erl_docgen/priv/xsl/db_pdf.xsl mybook.xml + + + 2> fop -fo MyApp.fo -pdf MyApp.pdf + </code> + </section> + + <section> + <title>Generate man pages</title> + <p> + Unix man pages can be generated with <c>xsltproc</c> from XML files written according to + the different OTP ref type DTDs. + </p> + <p> + Example: + </p> + <code> + + 1> xsltproc --output my_module.3\ + --stringparam docgen $ERL_TOP/lib/erl_docgen \ + --stringparam gendate "December 5 2011" \ + --stringparam appname MyApp \ + --stringparam appver 0.1 \ + --xinclude -path $ERL_TOP/lib/erl_docgen/priv/dtd \ + -path $ERL_TOP/lib/erl_docgen/priv/dtd_man_entities \ + $ERL_TOP/lib/erl_docgen/priv/xsl/db_man.xsl my_refpage.xml + </code> + </section> + + <section> + <title>Upcomming changes</title> + <p> + The output from the <c>erl_docgen</c> documentation build process is now just the OTP style. + But in a near future we will for example add the possibility to change logo, color in the PDF and + style sheet for the HTML. + </p> + </section> + + </section> +</chapter> diff --git a/lib/erl_docgen/doc/src/overview.xml b/lib/erl_docgen/doc/src/overview.xml index f0f97d8d45..2a420c53d9 100644 --- a/lib/erl_docgen/doc/src/overview.xml +++ b/lib/erl_docgen/doc/src/overview.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -20,7 +20,7 @@ under the License. </legalnotice> - <title>Overview</title> + <title>Overview OTP DTDs</title> <prepared></prepared> <docno></docno> <date></date> @@ -42,7 +42,7 @@ A collection of chapters (<seealso marker="user_guide_dtds#chapterDTD">chapter</seealso>). </p> - </item> + </item> <tag><em>Reference Manual</em></tag> <item> @@ -72,23 +72,16 @@ the <c>application</c> or <c>part</c> DTD to write other types of documentation for the application.</p> - </section> - - <section> - <title>Structure of Generated HTML</title> - <p>The generated HTML corresponding to a <c>part</c> or - <c>application</c> document is split into a left frame and a right - frame. The left frame contains information about the document - and links to the included files, that is chapters or manual pages. - The right frame is used to display either the front page for - the document, or the selected chapter/manual page.</p> + <p>The structure of the different documents and the meaning of the + tags are explained. There are numerous examples of documentation + source code.</p> - <p>The left frame also contains links to a bibliography and a - glossary, which are automatically generated.</p> + <p>For readability and simplicity, the examples have been kept as + short as possible. For an example of what the generated HTML + will look like, it is recommended to look at the documentation of + an OTP application.</p> - <p>In the case of an <c>application</c> document, the left frame - also contains a link to an automatically generated index.</p> </section> <section> @@ -108,48 +101,5 @@ tags, for example a highlighted word within a paragraph.</p> </section> - <section> - <title>About This Document</title> - - <p>In this User's Guide, the structure of the different documents - and the meaning of the tags are explained. There are numerous - examples of documentation source code.</p> - - <p>For readability and simplicity, the examples have been kept as - short as possible. For an example of what the generated HTML - will look like, it is recommended to look at the documentation of - an OTP application.</p> - <list> - <item>This User's Guides are written using the <c>part</c> and - <c>chapter</c> DTDs.</item> - - <item>The Reference Manuals are written using - the <c>application</c>, <c>appref</c> and <c>erlref</c> DTDs. - </item> - </list> - </section> - - <section> - <title>Usage</title> - - <list type="ordered"> - <item> - <p>Create the relevant XML files.</p> - - <p>If there are EDoc comments in a module, the escript - <!-- seealso marker="xml_from_edoc">xml_from_edoc</seealso --> - <c>xml_from_edoc</c> - can be used to generate an XML file according to - the <c>erlref</c> DTD for this module.</p> - </item> - - <!-- item> - <p>The XML files can be validated using - <seealso marker="docb_xml_check#validate/1">docb_xml_check:validate/1</seealso>. - </p> - </item --> - - </list> - </section> </chapter> diff --git a/lib/erl_docgen/doc/src/part.xml b/lib/erl_docgen/doc/src/part.xml index 4594778a2f..26d660df08 100644 --- a/lib/erl_docgen/doc/src/part.xml +++ b/lib/erl_docgen/doc/src/part.xml @@ -27,10 +27,11 @@ <rev></rev> </header> <description> - <p><em>Erl_Docgen</em> provides functionality for generating HTML/PDF + <p><em>Erl_Docgen</em> provides functionality for generating HTML/PDF/man documentation for Erlang modules and Erlang/OTP applications from XML source code and/or EDoc comments in Erlang source code.</p> </description> + <xi:include href="doc-build.xml"/> <xi:include href="overview.xml"/> <xi:include href="user_guide_dtds.xml"/> <xi:include href="refman_dtds.xml"/> diff --git a/lib/erl_docgen/info b/lib/erl_docgen/info index 4dc2a02bfb..31c7eb911a 100644 --- a/lib/erl_docgen/info +++ b/lib/erl_docgen/info @@ -1,3 +1,2 @@ group: doc Documentation Applications short: A utility used to produce the OTP documentation. - diff --git a/lib/erl_docgen/priv/xsl/db_eix.xsl b/lib/erl_docgen/priv/xsl/db_eix.xsl index 55540317f6..249e6950f7 100644 --- a/lib/erl_docgen/priv/xsl/db_eix.xsl +++ b/lib/erl_docgen/priv/xsl/db_eix.xsl @@ -328,7 +328,7 @@ <xsl:choose> <xsl:when test="string-length($tmp1) > 0 or starts-with($string, $start)"> <xsl:variable name="tmp2"> - <xsl:value-of select="substring-after($string, $end)"/> + <xsl:value-of select="substring-after(substring-after($string, $start), $end)"/> </xsl:variable> <xsl:variable name="retstring"> <xsl:call-template name="remove-paren"> diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index a9052f29e5..bdef7bfd3d 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -2184,7 +2184,7 @@ <xsl:choose> <xsl:when test="string-length($tmp1) > 0 or starts-with($string, $start)"> <xsl:variable name="tmp2"> - <xsl:value-of select="substring-after($string, $end)"/> + <xsl:value-of select="substring-after(substring-after($string, $start), $end)"/> </xsl:variable> <xsl:variable name="retstring"> <xsl:call-template name="remove-paren"> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index 48a7a026c1..4ed4fa14c4 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -1680,7 +1680,7 @@ <xsl:choose> <xsl:when test="string-length($tmp1) > 0 or starts-with($string, $start)"> <xsl:variable name="tmp2"> - <xsl:value-of select="substring-after($string, $end)"/> + <xsl:value-of select="substring-after(substring-after($string, $start), $end)"/> </xsl:variable> <xsl:variable name="retstring"> <xsl:call-template name="remove-paren"> diff --git a/lib/erl_interface/src/legacy/global_names.c b/lib/erl_interface/src/legacy/global_names.c index 7333d94931..db1c3e6296 100644 --- a/lib/erl_interface/src/legacy/global_names.c +++ b/lib/erl_interface/src/legacy/global_names.c @@ -94,7 +94,7 @@ char **erl_global_names(int fd, int *count) if (!(names = malloc((arity * sizeof(char**)) + (size-index)))) return NULL; /* arity pointers first, followed by s */ - s = (char *)(names+arity+1); + s = (char *)(names+arity); if (count) *count = 0; for (i=0; i<arity; i++) { diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 6f0141b0ca..cee399e861 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1321,6 +1321,9 @@ type(erlang, resume_process, 1, Xs) -> fun (_) -> t_any() end); %% TODO: overapproximation -- fix this type(erlang, round, 1, Xs) -> strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end); +type(erlang, posixtime_to_universaltime, 1, Xs) -> + strict(arg_types(erlang, posixtime_to_universaltime, 1), Xs, + fun(_) -> t_tuple([t_date(), t_time()]) end); type(erlang, self, 0, _) -> t_pid(); type(erlang, send, 2, Xs) -> type(erlang, '!', 2, Xs); % alias type(erlang, send, 3, Xs) -> @@ -1717,6 +1720,9 @@ type(erlang, universaltime, 0, _) -> type(erlang, universaltime_to_localtime, 1, Xs) -> strict(arg_types(erlang, universaltime_to_localtime, 1), Xs, fun ([T]) -> T end); +type(erlang, universaltime_to_posixtime, 1, Xs) -> + strict(arg_types(erlang, universaltime_to_posixtime,1), Xs, + fun(_) -> t_integer() end); type(erlang, unlink, 1, Xs) -> strict(arg_types(erlang, unlink, 1), Xs, fun (_) -> t_atom('true') end); type(erlang, unregister, 1, Xs) -> @@ -3776,6 +3782,8 @@ arg_types(erlang, resume_process, 1) -> [t_pid()]; % intended for debugging only arg_types(erlang, round, 1) -> [t_number()]; +arg_types(erlang, posixtime_to_universaltime, 1) -> + [t_integer()]; arg_types(erlang, self, 0) -> []; arg_types(erlang, send, 2) -> @@ -3942,6 +3950,8 @@ arg_types(erlang, universaltime, 0) -> []; arg_types(erlang, universaltime_to_localtime, 1) -> [t_tuple([t_date(), t_time()])]; +arg_types(erlang, universaltime_to_posixtime, 1) -> + [t_tuple([t_date(), t_time()])]; arg_types(erlang, unlink, 1) -> [t_sup(t_pid(), t_port())]; arg_types(erlang, unregister, 1) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 0ff827ac37..387690df43 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2533,29 +2533,26 @@ findfirst(N1, N2, U1, B1, U2, B2) -> t_subst(T, Dict) -> case t_has_var(T) of - true -> t_subst(T, Dict, fun(X) -> X end); + true -> t_subst_aux(T, Dict); false -> T end. -spec subst_all_vars_to_any(erl_type()) -> erl_type(). subst_all_vars_to_any(T) -> - case t_has_var(T) of - true -> t_subst(T, dict:new(), fun(_) -> ?any end); - false -> T - end. + t_subst(T, dict:new()). -t_subst(?var(Id) = V, Dict, Fun) -> +t_subst_aux(?var(Id), Dict) -> case dict:find(Id, Dict) of - error -> Fun(V); + error -> ?any; {ok, Type} -> Type end; -t_subst(?list(Contents, Termination, Size), Dict, Fun) -> - case t_subst(Contents, Dict, Fun) of +t_subst_aux(?list(Contents, Termination, Size), Dict) -> + case t_subst_aux(Contents, Dict) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. - case t_subst(Termination, Dict, Fun) of + case t_subst_aux(Termination, Dict) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> @@ -2563,17 +2560,17 @@ t_subst(?list(Contents, Termination, Size), Dict, Fun) -> ?list(NewContents, NewTermination, Size) end end; -t_subst(?function(Domain, Range), Dict, Fun) -> - ?function(t_subst(Domain, Dict, Fun), t_subst(Range, Dict, Fun)); -t_subst(?product(Types), Dict, Fun) -> - ?product([t_subst(T, Dict, Fun) || T <- Types]); -t_subst(?tuple(?any, ?any, ?any) = T, _Dict, _Fun) -> +t_subst_aux(?function(Domain, Range), Dict) -> + ?function(t_subst_aux(Domain, Dict), t_subst_aux(Range, Dict)); +t_subst_aux(?product(Types), Dict) -> + ?product([t_subst_aux(T, Dict) || T <- Types]); +t_subst_aux(?tuple(?any, ?any, ?any) = T, _Dict) -> T; -t_subst(?tuple(Elements, _Arity, _Tag), Dict, Fun) -> - t_tuple([t_subst(E, Dict, Fun) || E <- Elements]); -t_subst(?tuple_set(_) = TS, Dict, Fun) -> - t_sup([t_subst(T, Dict, Fun) || T <- t_tuple_subtypes(TS)]); -t_subst(T, _Dict, _Fun) -> +t_subst_aux(?tuple(Elements, _Arity, _Tag), Dict) -> + t_tuple([t_subst_aux(E, Dict) || E <- Elements]); +t_subst_aux(?tuple_set(_) = TS, Dict) -> + t_sup([t_subst_aux(T, Dict) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(T, _Dict) -> T. %%----------------------------------------------------------------------------- diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl index 4925b2927b..ca3abf8cc6 100644 --- a/lib/hipe/opt/hipe_schedule.erl +++ b/lib/hipe/opt/hipe_schedule.erl @@ -797,7 +797,7 @@ dep_arc(N, Lat, M, {Dag,Preds}) -> %% Returns : A dependence graph sorted by To. %% Description : A new arc that is added is sorted in the right place, and if %% there is already an arc between nodes A and B, the one with -%% the greatest latency is choosen. +%% the greatest latency is chosen. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add_arc(Lat,To, []) -> {[{Lat, To}], added}; add_arc(Lat1, To, [{Lat2, To} | Arcs]) -> diff --git a/lib/hipe/tools/hipe_profile.erl b/lib/hipe/tools/hipe_profile.erl index 7566acb8f4..1284b64f13 100644 --- a/lib/hipe/tools/hipe_profile.erl +++ b/lib/hipe/tools/hipe_profile.erl @@ -89,7 +89,7 @@ calls() -> %% F(), %% %% Get result. %% R = res(), -%% %% Turn of profiling. +%% %% Turn off profiling. %% prof_off(), %% R. diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 730efb729f..48a2089605 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -408,6 +408,8 @@ apply(Module, Function, [ReplyInfo | Args]) <p>Defaults to the <c>pid()</c> of the process calling the request function (<c>self()</c>). </p> + + <marker id="ipv6_host_with_brackets"></marker> </item> <tag><c><![CDATA[ipv6_host_with_brackets]]></c></tag> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index c9944964e4..369762d0c6 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -50,6 +50,21 @@ <p>Own Id: OTP-9545</p> </item> + <item> + <p>[httpc] Wrong Host header in IPv6 HTTP requests. + When a URI with a IPv6 host is parsed, the brackets that encapsulates + the address part is removed. This value is then supplied as the host + header. This can cause problems with some servers. + A workaround for this is to use headers_as_is and provide the host + header with the requst call. + To solve this a new option has been added, + <seealso marker="httpc#ipv6_host_with_brackets">ipv6_host_with_brackets</seealso>. + This option specifies if the host value of the host header shall + include the brackets or not. By default, it does not (as before). + </p> + <p>Own Id: OTP-9628</p> + </item> + </list> </section> diff --git a/lib/inets/src/http_server/mod_responsecontrol.erl b/lib/inets/src/http_server/mod_responsecontrol.erl index 989f45db20..6af5f6211e 100644 --- a/lib/inets/src/http_server/mod_responsecontrol.erl +++ b/lib/inets/src/http_server/mod_responsecontrol.erl @@ -211,7 +211,7 @@ compare_etags(Tag,Etags) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% -%% Control if the file is modificated %% +%% Control if the file is modified %% %% %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index 6b89711924..ee687511a3 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -229,10 +229,10 @@ <c>-code_path_choice Choice</c>. If the flag is set to <c>relaxed</c>, the code server will instead choose a suitable directory depending on the actual file structure. If there exists a regular - application ebin directory,situation it will be choosen. But if it does - not exist, the ebin directory in the archive is choosen if it + application ebin directory,situation it will be chosen. But if it does + not exist, the ebin directory in the archive is chosen if it exists. If neither of them exists the original directory will be - choosen.</p> + chosen.</p> <p>The command line flag <c>-code_path_choice Choice</c> does also affect how <c>init</c> interprets the <c>boot script</c>. The diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index c6a1f25dd9..772eff13cc 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -150,6 +150,9 @@ <name name="mode"/> </datatype> <datatype> + <name name="file_info_option"/> + </datatype> + <datatype> <name name="sendfile_option"/> </datatype> </datatypes> @@ -412,7 +415,7 @@ <name>file_info(Filename) -> {ok, FileInfo} | {error, Reason}</name> <fsummary>Get information about a file (deprecated)</fsummary> <desc> - <p>This function is obsolete. Use <c>read_file_info/1</c> + <p>This function is obsolete. Use <c>read_file_info/1,2</c> instead.</p> </desc> </func> @@ -539,7 +542,7 @@ <desc> <p>Makes a hard link from <c><anno>Existing</anno></c> to <c><anno>New</anno></c>, on - platforms that support links (Unix). This function returns + platforms that support links (Unix and Windows). This function returns <c>ok</c> if the link was successfully created, or <c>{error, <anno>Reason</anno>}</c>. On platforms that do not support links, <c>{error,enotsup}</c> is returned.</p> @@ -566,11 +569,12 @@ <name name="make_symlink" arity="2"/> <fsummary>Make a symbolic link to a file or directory</fsummary> <desc> - <p>This function creates a symbolic link <c><anno>Name2</anno></c> to - the file or directory <c><anno>Name1</anno></c>, on platforms that - support - symbolic links (most Unix systems). <c><anno>Name1</anno></c> need not - exist. This function returns <c>ok</c> if the link was + <p>This function creates a symbolic link <c><anno>New</anno></c> to + the file or directory <c><anno>Existing</anno></c>, on platforms that + support symbolic links (most Unix systems and Windows beginning with + Vista). + <c><anno>Existing</anno></c> need not exist. + This function returns <c>ok</c> if the link was successfully created, or <c>{error, <anno>Reason</anno>}</c>. On platforms that do not support symbolic links, <c>{error, enotsup}</c> @@ -580,11 +584,11 @@ <tag><c>eacces</c></tag> <item> <p>Missing read or write permissions for the parent directories - of <c><anno>Name1</anno></c> or <c><anno>Name2</anno></c>.</p> + of <c><anno>Existing</anno></c> or <c><anno>New</anno></c>.</p> </item> <tag><c>eexist</c></tag> <item> - <p><c><anno>Name2</anno></c> already exists.</p> + <p><c><anno>New</anno></c> already exists.</p> </item> <tag><c>enotsup</c></tag> <item> @@ -1188,6 +1192,7 @@ </func> <func> <name name="read_file_info" arity="1"/> + <name name="read_file_info" arity="2"/> <fsummary>Get information about a file</fsummary> <desc> <p>Retrieves information about a file. Returns @@ -1199,6 +1204,20 @@ from which the function is called:</p> <code type="none"> -include_lib("kernel/include/file.hrl").</code> + <p>The time type returned in <c>atime</c>, <c>mtime</c> and <c>ctime</c> + is dependent on the time type set in <c>Opts :: {time, Type}</c>. + Type <c>local</c> will return local time, <c>universal</c> will + return universal time and <c>posix</c> will return seconds since + or before unix time epoch which is 1970-01-01 00:00 UTC. + Default is <c>{time, local}</c>. + </p> + <note> + <p> + Since file times is stored in posix time on most OS it is + faster to query file information with the <c>posix</c> option. + </p> + </note> + <p>The record <c>file_info</c> contains the following fields.</p> <taglist> <tag><c>size = integer()</c></tag> @@ -1213,15 +1232,15 @@ <item> <p>The current system access to the file.</p> </item> - <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso> | integer() </c></tag> <item> - <p>The last (local) time the file was read.</p> + <p>The last time the file was read.</p> </item> - <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso> | integer() </c></tag> <item> - <p>The last (local) time the file was written.</p> + <p>The last time the file was written.</p> </item> - <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso> | integer() </c></tag> <item> <p>The interpretation of this time field depends on the operating system. On Unix, it is the last time @@ -1377,9 +1396,11 @@ </func> <func> <name name="read_link_info" arity="1"/> + <name name="read_link_info" arity="2"/> <fsummary>Get information about a link or file</fsummary> <desc> - <p>This function works like <c>read_file_info/1</c>, except that + <p>This function works like + <seealso marker="#read_file_info/2">read_file_info/1,2</seealso> except that if <c><anno>Name</anno></c> is a symbolic link, information about the link will be returned in the <c>file_info</c> record and the <c>type</c> field of the record will be set to @@ -1690,6 +1711,7 @@ </func> <func> <name name="write_file_info" arity="2"/> + <name name="write_file_info" arity="3"/> <fsummary>Change information about a file</fsummary> <desc> <p>Change file information. Returns <c>ok</c> if successful, @@ -1700,18 +1722,25 @@ from which the function is called:</p> <code type="none"> -include_lib("kernel/include/file.hrl").</code> + <p>The time type set in <c>atime</c>, <c>mtime</c> and <c>ctime</c> + is dependent on the time type set in <c>Opts :: {time, Type}</c>. + Type <c>local</c> will interpret the time set as local, <c>universal</c> will + interpret it as universal time and <c>posix</c> must be seconds since + or before unix time epoch which is 1970-01-01 00:00 UTC. + Default is <c>{time, local}</c>. + </p> <p>The following fields are used from the record, if they are given.</p> <taglist> - <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>atime = <seealso marker="#type-date_time">date_time()</seealso> | integer()</c></tag> <item> - <p>The last (local) time the file was read.</p> + <p>The last time the file was read.</p> </item> - <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>mtime = <seealso marker="#type-date_time">date_time()</seealso> | integer()</c></tag> <item> - <p>The last (local) time the file was written.</p> + <p>The last time the file was written.</p> </item> - <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso></c></tag> + <tag><c>ctime = <seealso marker="#type-date_time">date_time()</seealso> | integer()</c></tag> <item> <p>On Unix, any value give for this field will be ignored (the "ctime" for the file will be set to the current diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index 418bfae4b8..579b7f1f74 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -270,7 +270,7 @@ it is bound to.</p> <p>For type <c>seqpacket</c> sockets (the default) <c><anno>IsServer</anno></c> must be <c>true</c> or <c>false</c>. - In the contrast to TCP, in SCTP there is no listening queue length. + In contrast to TCP, in SCTP there is no listening queue length. If <c><anno>IsServer</anno></c> is <c>true</c> the socket accepts new associations, i.e. it will become an SCTP server socket.</p> <p>For type <c>stream</c> sockets <anno>Backlog</anno> defines diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index fad5af85bb..1a05b4ba99 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -573,6 +573,10 @@ fe80::204:acff:fe17:bf38 is longer than the max allowed length, the packet is considered invalid. The same happens if the packet header is too big for the socket receive buffer.</p> + <p>For line oriented protocols (<c>line</c>,<c>http*</c>), + option <c>packet_size</c> also guarantees that lines up to the + indicated length are accepted and not considered invalid due + to internal buffer limitations.</p> </item> <tag><c>{read_packets, Integer}</c>(UDP sockets)</tag> <item> diff --git a/lib/kernel/include/file.hrl b/lib/kernel/include/file.hrl index 3889bce393..ef42987a3d 100644 --- a/lib/kernel/include/file.hrl +++ b/lib/kernel/include/file.hrl @@ -25,10 +25,11 @@ {size :: non_neg_integer(), % Size of file in bytes. type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink', access :: 'read' | 'write' | 'read_write' | 'none', - atime :: file:date_time(), % The local time the file was last read: - % {{Year, Mon, Day}, {Hour, Min, Sec}}. - mtime :: file:date_time(), % The local time the file was last written. - ctime :: file:date_time(), % The interpretation of this time field + atime :: file:date_time() | integer(), % The local time the file was last read: + % {{Year, Mon, Day}, {Hour, Min, Sec}}. + % atime, ctime, mtime may also be unix epochs() + mtime :: file:date_time() | integer(), % The local time the file was last written. + ctime :: file:date_time() | integer(), % The interpretation of this time field % is dependent on operating system. % On Unix it is the last time the file % or the inode was changed. On Windows, diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index caac4d926c..c299fb085c 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -59,7 +59,7 @@ -callback start(StartType :: normal | {takeover, node()} | {failover, node()}, StartArgs :: term()) -> - {ok, pid()} | {ok, pid(), State :: term()} | {error, Reason :: term}. + {'ok', pid()} | {'ok', pid(), State :: term()} | {'error', Reason :: term()}. -callback stop(State :: term()) -> term(). diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index d6bc23be6d..fb9415d440 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -64,7 +64,7 @@ %%-define(PROFILE(C), C). -define(PROFILE(C), void). --compile({inline,[{log_loop,4},{log_end_sync,2},{replies,2},{rflat,1}]}). +-compile({inline,[{log_loop,5},{log_end_sync,2},{replies,2},{rflat,1}]}). %%%---------------------------------------------------------------------- %%% Contract type specifications @@ -685,7 +685,7 @@ handle({From, {log, B}}, S) -> L when L#log.mode =:= read_only -> reply(From, {error, {read_only_mode, L#log.name}}, S); L when L#log.status =:= ok, L#log.format =:= internal -> - log_loop(S, From, [B], []); + log_loop(S, From, [B], [], iolist_size(B)); L when L#log.status =:= ok, L#log.format =:= external -> reply(From, {error, {format_external, L#log.name}}, S); L when L#log.status =:= {blocked, false} -> @@ -700,7 +700,7 @@ handle({From, {blog, B}}, S) -> L when L#log.mode =:= read_only -> reply(From, {error, {read_only_mode, L#log.name}}, S); L when L#log.status =:= ok -> - log_loop(S, From, [B], []); + log_loop(S, From, [B], [], iolist_size(B)); L when L#log.status =:= {blocked, false} -> reply(From, {error, {blocked_log, L#log.name}}, S); L when L#log.blocked_by =:= From -> @@ -714,7 +714,7 @@ handle({alog, B}, S) -> notify_owners({read_only,B}), loop(S); L when L#log.status =:= ok, L#log.format =:= internal -> - log_loop(S, [], [B], []); + log_loop(S, [], [B], [], iolist_size(B)); L when L#log.status =:= ok -> notify_owners({format_external, B}), loop(S); @@ -730,7 +730,7 @@ handle({balog, B}, S) -> notify_owners({read_only,B}), loop(S); L when L#log.status =:= ok -> - log_loop(S, [], [B], []); + log_loop(S, [], [B], [], iolist_size(B)); L when L#log.status =:= {blocked, false} -> notify_owners({blocked_log, B}), loop(S); @@ -1029,38 +1029,42 @@ handle(_, S) -> loop(S). sync_loop(From, S) -> - log_loop(S, [], [], From). + log_loop(S, [], [], From, 0). + +-define(MAX_LOOK_AHEAD, 64*1024). %% Inlined. -log_loop(S, Pids, _Bins, _Sync) when S#state.cache_error =/= ok -> +log_loop(S, Pids, _Bins, _Sync, _Sz) when S#state.cache_error =/= ok -> loop(cache_error(S, Pids)); -log_loop(S, Pids, Bins, Sync) when S#state.messages =:= [] -> +log_loop(#state{messages = []}=S, Pids, Bins, Sync, Sz) + when Sz > ?MAX_LOOK_AHEAD -> + loop(log_end(S, Pids, Bins, Sync)); +log_loop(#state{messages = []}=S, Pids, Bins, Sync, Sz) -> receive Message -> - log_loop(Message, Pids, Bins, Sync, S, get(log)) + log_loop(Message, Pids, Bins, Sync, Sz, S, get(log)) after 0 -> loop(log_end(S, Pids, Bins, Sync)) end; -log_loop(S, Pids, Bins, Sync) -> +log_loop(S, Pids, Bins, Sync, Sz) -> [M | Ms] = S#state.messages, S1 = S#state{messages = Ms}, - log_loop(M, Pids, Bins, Sync, S1, get(log)). + log_loop(M, Pids, Bins, Sync, Sz, S1, get(log)). %% Items logged after the last sync request found are sync:ed as well. -log_loop({alog,B}, Pids, Bins, Sync, S, L) when L#log.format =:= internal -> +log_loop({alog,B}, Pids, Bins, Sync, Sz, S, #log{format = internal}) -> %% {alog, _} allowed for the internal format only. - log_loop(S, Pids, [B | Bins], Sync); -log_loop({balog, B}, Pids, Bins, Sync, S, _L) -> - log_loop(S, Pids, [B | Bins], Sync); -log_loop({From, {log, B}}, Pids, Bins, Sync, S, L) - when L#log.format =:= internal -> + log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({balog, B}, Pids, Bins, Sync, Sz, S, _L) -> + log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({From, {log, B}}, Pids, Bins, Sync, Sz, S, #log{format = internal}) -> %% {log, _} allowed for the internal format only. - log_loop(S, [From | Pids], [B | Bins], Sync); -log_loop({From, {blog, B}}, Pids, Bins, Sync, S, _L) -> - log_loop(S, [From | Pids], [B | Bins], Sync); -log_loop({From, sync}, Pids, Bins, Sync, S, _L) -> - log_loop(S, Pids, Bins, [From | Sync]); -log_loop(Message, Pids, Bins, Sync, S, _L) -> + log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({From, {blog, B}}, Pids, Bins, Sync, Sz, S, _L) -> + log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({From, sync}, Pids, Bins, Sync, Sz, S, _L) -> + log_loop(S, Pids, Bins, [From | Sync], Sz); +log_loop(Message, Pids, Bins, Sync, _Sz, S, _L) -> NS = log_end(S, Pids, Bins, Sync), handle(Message, NS). diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 0b0f91d86a..4028dd4f0b 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -28,9 +28,11 @@ %% File system and metadata. -export([get_cwd/0, get_cwd/1, set_cwd/1, delete/1, rename/2, make_dir/1, del_dir/1, list_dir/1, - read_file_info/1, write_file_info/2, + read_file_info/1, read_file_info/2, + write_file_info/2, write_file_info/3, altname/1, - read_link_info/1, read_link/1, + read_link_info/1, read_link_info/2, + read_link/1, make_link/2, make_symlink/2, read_file/1, write_file/2, write_file/3]). %% Specialized @@ -107,6 +109,10 @@ -type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | 'will_need' | 'dont_need'. -type sendfile_option() :: {chunk_size, non_neg_integer()}. +-type file_info_option() :: {'time', 'local'} | {'time', 'universal'} + | {'time', 'posix'}. + + %%%----------------------------------------------------------------- %%% General functions @@ -214,6 +220,15 @@ del_dir(Name) -> read_file_info(Name) -> check_and_call(read_file_info, [file_name(Name)]). +-spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when + Filename :: name(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +read_file_info(Name, Opts) when is_list(Opts) -> + check_and_call(read_file_info, [file_name(Name), Opts]). + -spec altname(Name :: name()) -> any(). altname(Name) -> @@ -227,6 +242,16 @@ altname(Name) -> read_link_info(Name) -> check_and_call(read_link_info, [file_name(Name)]). +-spec read_link_info(Name, Opts) -> {ok, FileInfo} | {error, Reason} when + Name :: name(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +read_link_info(Name, Opts) when is_list(Opts) -> + check_and_call(read_link_info, [file_name(Name),Opts]). + + -spec read_link(Name) -> {ok, Filename} | {error, Reason} when Name :: name(), Filename :: filename(), @@ -243,6 +268,15 @@ read_link(Name) -> write_file_info(Name, Info = #file_info{}) -> check_and_call(write_file_info, [file_name(Name), Info]). +-spec write_file_info(Filename, FileInfo, Opts) -> ok | {error, Reason} when + Filename :: name(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> + check_and_call(write_file_info, [file_name(Name), Info, Opts]). + -spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when Dir :: name(), Filenames :: [filename()], @@ -267,9 +301,9 @@ read_file(Name) -> make_link(Old, New) -> check_and_call(make_link, [file_name(Old), file_name(New)]). --spec make_symlink(Name1, Name2) -> ok | {error, Reason} when - Name1 :: name(), - Name2 :: name(), +-spec make_symlink(Existing, New) -> ok | {error, Reason} when + Existing :: name(), + New :: name(), Reason :: posix() | badarg. make_symlink(Old, New) -> @@ -1103,8 +1137,9 @@ change_group(Name, GroupId) Mtime :: date_time(), Reason :: posix() | badarg. -change_time(Name, Time) - when is_tuple(Time) -> +change_time(Name, {{Y, M, D}, {H, Min, Sec}}=Time) + when is_integer(Y), is_integer(M), is_integer(D), + is_integer(H), is_integer(Min), is_integer(Sec)-> write_file_info(Name, #file_info{mtime=Time}). -spec change_time(Filename, Atime, Mtime) -> ok | {error, Reason} when @@ -1113,8 +1148,12 @@ change_time(Name, Time) Mtime :: date_time(), Reason :: posix() | badarg. -change_time(Name, Atime, Mtime) - when is_tuple(Atime), is_tuple(Mtime) -> +change_time(Name, {{AY, AM, AD}, {AH, AMin, ASec}}=Atime, + {{MY, MM, MD}, {MH, MMin, MSec}}=Mtime) + when is_integer(AY), is_integer(AM), is_integer(AD), + is_integer(AH), is_integer(AMin), is_integer(ASec), + is_integer(MY), is_integer(MM), is_integer(MD), + is_integer(MH), is_integer(MMin), is_integer(MSec)-> write_file_info(Name, #file_info{atime=Atime, mtime=Mtime}). %% @@ -1124,7 +1163,8 @@ change_time(Name, Atime, Mtime) -define(MAX_CHUNK_SIZE, (1 bsl 20)*20). %% 20 MB, has to fit in primary memory -spec sendfile(RawFile, Socket, Offset, Bytes, Opts) -> - {'ok', non_neg_integer()} | {'error', inet:posix() | badarg | not_owner} when + {'ok', non_neg_integer()} | {'error', inet:posix() | + closed | badarg | not_owner} when RawFile :: file:fd(), Socket :: inet:socket(), Offset :: non_neg_integer(), @@ -1149,7 +1189,8 @@ sendfile(File, Sock, Offset, Bytes, Opts) -> %% sendfile/2 -spec sendfile(Filename, Socket) -> - {'ok', non_neg_integer()} | {'error', inet:posix() | badarg | not_owner} + {'ok', non_neg_integer()} | {'error', inet:posix() | + closed | badarg | not_owner} when Filename :: file:name(), Socket :: inet:socket(). sendfile(Filename, Sock) -> diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 64c61ba3ac..81f9efcf39 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -147,15 +147,24 @@ handle_call({get_cwd, Name}, _From, Handle) -> handle_call({read_file_info, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle}; +handle_call({read_file_info, Name, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:read_file_info(Handle, Name, Opts), Handle}; + handle_call({altname, Name}, _From, Handle) -> {reply, ?PRIM_FILE:altname(Handle, Name), Handle}; handle_call({write_file_info, Name, Info}, _From, Handle) -> {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle}; +handle_call({write_file_info, Name, Info, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, Opts), Handle}; + handle_call({read_link_info, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle}; +handle_call({read_link_info, Name, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_info(Handle, Name, Opts), Handle}; + handle_call({read_link, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl index fffaaf4c45..5bbaeb02ad 100644 --- a/lib/kernel/test/gen_tcp_echo_SUITE.erl +++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl @@ -167,8 +167,12 @@ echo_test_1(SockOpts, EchoFun, Config0) -> [{type, {cdr, little}}|Config]), ?line case lists:keymember(packet_size, 1, SockOpts) of false -> - ?line echo_packet([{packet, line}|SockOpts], - EchoFun, Config); + % This is cheating, we should test that packet_size + % also works for line and http. + echo_packet([{packet, line}|SockOpts], EchoFun, Config), + echo_packet([{packet, http}|SockOpts], EchoFun, Config), + echo_packet([{packet, http_bin}|SockOpts], EchoFun, Config); + true -> ok end, ?line echo_packet([{packet, tpkt}|SockOpts], EchoFun, Config), @@ -183,9 +187,6 @@ echo_test_1(SockOpts, EchoFun, Config0) -> [{type, {asn1, short, LongTag}}|Config]), ?line echo_packet([{packet, asn1}|SockOpts], EchoFun, [{type, {asn1, long, LongTag}}|Config]), - - ?line echo_packet([{packet, http}|SockOpts], EchoFun, Config), - ?line echo_packet([{packet, http_bin}|SockOpts], EchoFun, Config), ok. echo_packet(SockOpts, EchoFun, Opts) -> diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index b1ef8826d5..3da4b07c05 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -40,7 +40,8 @@ accept_timeouts_in_order3/1,accept_timeouts_mixed/1, killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1, several_accepts_in_one_go/1,active_once_closed/1, send_timeout/1, send_timeout_active/1, - otp_7731/1, zombie_sockets/1, otp_7816/1, otp_8102/1]). + otp_7731/1, zombie_sockets/1, otp_7816/1, otp_8102/1, + otp_9389/1]). %% Internal exports. -export([sender/3, not_owner/1, passive_sockets_server/2, priority_server/1, @@ -72,7 +73,7 @@ all() -> killing_acceptor, killing_multi_acceptors, killing_multi_acceptors2, several_accepts_in_one_go, active_once_closed, send_timeout, send_timeout_active, otp_7731, - zombie_sockets, otp_7816, otp_8102]. + zombie_sockets, otp_7816, otp_8102, otp_9389]. groups() -> []. @@ -1030,6 +1031,7 @@ busy_send_loop(Server, Client, N) -> {Server,send} -> ?line busy_send_2(Server, Client, N+1) after 10000 -> + %% If this happens, see busy_send_srv ?t:fail({timeout,{server,not_send,flush([])}}) end end. @@ -1049,7 +1051,9 @@ busy_send_2(Server, Client, _N) -> busy_send_srv(L, Master, Msg) -> %% Server - %% + %% Sometimes this accept does not return, do not really know why + %% but is causes the timeout error in busy_send_loop to be + %% triggered. Only happens on OS X Leopard?!? {ok,Socket} = gen_tcp:accept(L), busy_send_srv_loop(Socket, Master, Msg). @@ -2479,4 +2483,63 @@ otp_8102_do(LSocket, PortNum, {Bin,PType}) -> io:format("Got error msg, ok.\n",[]), gen_tcp:close(SSocket), gen_tcp:close(RSocket). - + +otp_9389(doc) -> ["Verify packet_size handles long HTTP header lines"]; +otp_9389(suite) -> []; +otp_9389(Config) when is_list(Config) -> + ?line {ok, LS} = gen_tcp:listen(0, []), + ?line {ok, {_, PortNum}} = inet:sockname(LS), + io:format("Listening on ~w with port number ~p\n", [LS, PortNum]), + OrigLinkHdr = "/" ++ string:chars($S, 8192), + _Server = spawn_link( + fun() -> + ?line {ok, S} = gen_tcp:accept(LS), + ?line ok = inet:setopts(S, [{packet_size, 16384}]), + ?line ok = otp_9389_loop(S, OrigLinkHdr), + ?line ok = gen_tcp:close(S) + end), + ?line {ok, S} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}]), + Req = "GET / HTTP/1.1\r\n" + ++ "Host: localhost\r\n" + ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", + ?line ok = gen_tcp:send(S, Req), + ?line ok = inet:setopts(S, [{packet, http}]), + ?line {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), + ?line ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), + ?line {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), + ?line {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), + ?line true = (LinkHdr == OrigLinkHdr), + ok = gen_tcp:close(S), + ok = gen_tcp:close(LS), + ok. + +otp_9389_loop(S, OrigLinkHdr) -> + ?line ok = inet:setopts(S, [{active,once},{packet,http}]), + receive + {http, S, {http_request, 'GET', _, _}} -> + ?line ok = otp_9389_loop(S, OrigLinkHdr, undefined) + after + 3000 -> + ?line error({timeout,request_line}) + end. +otp_9389_loop(S, OrigLinkHdr, ok) -> + ?line Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ + "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", + ?line ok = gen_tcp:send(S, Resp); +otp_9389_loop(S, OrigLinkHdr, State) -> + ?line ok = inet:setopts(S, [{active,once}, {packet,httph}]), + receive + {http, S, http_eoh} -> + ?line otp_9389_loop(S, OrigLinkHdr, ok); + {http, S, {http_header, _, "Link", _, LinkHdr}} -> + ?line LinkHdr = OrigLinkHdr, + ?line otp_9389_loop(S, OrigLinkHdr, State); + {http, S, {http_header, _, _Hdr, _, _Val}} -> + ?line otp_9389_loop(S, OrigLinkHdr, State); + {http, S, {http_error, Err}} -> + ?line error({error, Err}) + after + 3000 -> + ?line error({timeout,header}) + end. diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 15b0ed5718..f3ba28e4f9 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -88,7 +88,7 @@ init_per_testcase(Func, Config) -> inet_db:ins_alt_ns(IP, Port); _ -> ok end, - Dog = test_server:timetrap(test_server:seconds(10)), + Dog = test_server:timetrap(test_server:seconds(20)), [{nameserver,NsSpec},{res_lookup,Lookup},{watchdog,Dog}|Config] catch SkipReason -> @@ -303,7 +303,7 @@ basic(Config) when is_list(Config) -> {ok,Msg2} = inet_dns:decode(Bin2), %% %% lookup - [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]}]), + [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]},verbose]), %% %% gethostbyname {ok,#hostent{h_addr_list=[IP]}} = inet_res:gethostbyname(Name), @@ -410,7 +410,7 @@ edns0(Config) when is_list(Config) -> false = inet_db:res_option(edns), % ASSERT true = inet_db:res_option(udp_payload_size) >= 1280, % ASSERT %% These will fall back to TCP - MXs = lists:sort(inet_res:lookup(Domain, in, mx, [{nameservers,[NS]}])), + MXs = lists:sort(inet_res:lookup(Domain, in, mx, [{nameservers,[NS]},verbose])), %% {ok,#hostent{h_addr_list=As}} = inet_res:getbyname(Domain++".", mx), MXs = lists:sort(As), diff --git a/lib/kernel/test/inet_res_SUITE_data/run-named b/lib/kernel/test/inet_res_SUITE_data/run-named index 39e7b1d5aa..eeca680ab5 100755 --- a/lib/kernel/test/inet_res_SUITE_data/run-named +++ b/lib/kernel/test/inet_res_SUITE_data/run-named @@ -163,7 +163,7 @@ echo "Command: $NAMED $NAMED_FG -c $CONF_FILE" NAMED_PID=$! trap "kill -TERM $NAMED_PID >/dev/null 2>&1; wait $NAMED_PID >/dev/null 2>&1" \ 0 1 2 3 15 -sleep 2 # Give name server time to load its zone files +sleep 5 # Give name server time to load its zone files if [ -f "$EXIT_FILE" ]; then ERROR="`cat "$EXIT_FILE"`" (exit "$ERROR")& error "$NAMED returned $ERROR on start" diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 00eda6292f..ccf26ee034 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -32,7 +32,10 @@ file_info_basic_directory_a/1, file_info_basic_directory_b/1, file_info_bad_a/1, file_info_bad_b/1, file_info_times_a/1, file_info_times_b/1, - file_write_file_info_a/1, file_write_file_info_b/1]). + file_write_file_info_a/1, file_write_file_info_b/1, + file_read_file_info_opts/1, file_write_file_info_opts/1, + file_write_read_file_info_opts/1 + ]). -export([rename_a/1, rename_b/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1, exclusive/1]). @@ -90,7 +93,10 @@ groups() -> file_info_basic_directory_a, file_info_basic_directory_b, file_info_bad_a, file_info_bad_b, file_info_times_a, file_info_times_b, - file_write_file_info_a, file_write_file_info_b]}, + file_write_file_info_a, file_write_file_info_b, + file_read_file_info_opts, file_write_file_info_opts, + file_write_read_file_info_opts + ]}, {errors, [], [e_delete, e_rename, e_make_dir, e_del_dir]}, {compression, [], @@ -1074,6 +1080,104 @@ file_write_file_info(Config, Handle, Suffix) -> ?line test_server:timetrap_cancel(Dog), ok. +%% Test the write_file_info/3 function. + +file_write_file_info_opts(suite) -> []; +file_write_file_info_opts(doc) -> []; +file_write_file_info_opts(Config) when is_list(Config) -> + {ok, Handle} = ?PRIM_FILE:start(), + Dog = test_server:timetrap(test_server:seconds(10)), + RootDir = get_good_directory(Config), + test_server:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_write_file_info_opts"), + ok = ?PRIM_FILE:write_file(Name, "hello_opts"), + + lists:foreach(fun + ({FI, Opts}) -> + ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) + end, [ + {#file_info{ mode=8#600, atime = Time, mtime = Time, ctime = Time}, Opts} || + Opts <- [[{time, posix}]], + Time <- [ 0,1,-1,100,-100,1000,-1000,10000,-10000 ] + ]), + + % REM: determine date range dependent on time_t = Uint32 | Sint32 | Sint64 + % Determine time_t on os:type()? + lists:foreach(fun + ({FI, Opts}) -> + ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts]) + end, [ + {#file_info{ mode=8#400, atime = Time, mtime = Time, ctime = Time}, Opts} || + Opts <- [[{time, universal}],[{time, local}]], + Time <- [ + {{1970,1,1},{0,0,0}}, + {{1970,1,1},{0,0,1}}, + {{1969,12,31},{23,59,59}}, + {{1908,2,3},{23,59,59}}, + {{2012,2,3},{23,59,59}}, + {{2037,2,3},{23,59,59}}, + erlang:localtime() + ]]), + ok = ?PRIM_FILE:stop(Handle), + test_server:timetrap_cancel(Dog), + ok. + +file_read_file_info_opts(suite) -> []; +file_read_file_info_opts(doc) -> []; +file_read_file_info_opts(Config) when is_list(Config) -> + {ok, Handle} = ?PRIM_FILE:start(), + Dog = test_server:timetrap(test_server:seconds(10)), + RootDir = get_good_directory(Config), + test_server:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_read_file_info_opts"), + ok = ?PRIM_FILE:write_file(Name, "hello_opts"), + + lists:foreach(fun + (Opts) -> + {ok,_} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]) + end, [[{time, Type}] || Type <- [local, universal, posix]]), + ok = ?PRIM_FILE:stop(Handle), + test_server:timetrap_cancel(Dog), + ok. + +%% Test the write and read back *_file_info/3 functions. + +file_write_read_file_info_opts(suite) -> []; +file_write_read_file_info_opts(doc) -> []; +file_write_read_file_info_opts(Config) when is_list(Config) -> + {ok, Handle} = ?PRIM_FILE:start(), + Dog = test_server:timetrap(test_server:seconds(10)), + RootDir = get_good_directory(Config), + test_server:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_read_write_file_info_opts"), + ok = ?PRIM_FILE:write_file(Name, "hello_opts2"), + + ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, local}]), + ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, universal}]), + ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]), + ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]), + ok = file_write_read_file_info_opts(Handle, Name, 1, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, -1, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, 300000, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, -300000, [{time, posix}]), + ok = file_write_read_file_info_opts(Handle, Name, 0, [{time, posix}]), + + ok = ?PRIM_FILE:stop(Handle), + test_server:timetrap_cancel(Dog), + ok. + +file_write_read_file_info_opts(Handle, Name, Mtime, Opts) -> + {ok, FI} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]), + FI2 = FI#file_info{ mtime = Mtime }, + ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI2, Opts]), + {ok, FI2} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]), + ok. + + + %% Returns a directory on a file system that has correct file times. get_good_directory(Config) -> diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index 04af16a6b9..6d0848ee05 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -33,6 +33,8 @@ all() -> ,t_sendfile_recvafter ,t_sendfile_sendduring ,t_sendfile_recvduring + ,t_sendfile_closeduring + ,t_sendfile_crashduring ]. init_per_suite(Config) -> @@ -99,7 +101,7 @@ t_sendfile_big(Config) when is_list(Config) -> Size end, - ok = sendfile_send("localhost", Send, 0). + ok = sendfile_send({127,0,0,1}, Send, 0). t_sendfile_partial(Config) -> Filename = proplists:get_value(small_file, Config), @@ -185,14 +187,14 @@ t_sendfile_sendduring(Config) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), spawn_link(fun() -> - timer:sleep(10), + timer:sleep(50), ok = gen_tcp:send(Sock, <<2>>) end), {ok, Size} = file:sendfile(Filename, Sock), Size+1 end, - ok = sendfile_send("localhost", Send, 0). + ok = sendfile_send({127,0,0,1}, Send, 0). t_sendfile_recvduring(Config) -> Filename = proplists:get_value(big_file, Config), @@ -201,7 +203,7 @@ t_sendfile_recvduring(Config) -> {ok, #file_info{size = Size}} = file:read_file_info(Filename), spawn_link(fun() -> - timer:sleep(10), + timer:sleep(50), ok = gen_tcp:send(Sock, <<1>>), {ok,<<1>>} = gen_tcp:recv(Sock, 1) end), @@ -210,21 +212,83 @@ t_sendfile_recvduring(Config) -> Size+1 end, - ok = sendfile_send("localhost", Send, 0). + ok = sendfile_send({127,0,0,1}, Send, 0). -%% TODO: consolidate tests and reduce code +t_sendfile_closeduring(Config) -> + Filename = proplists:get_value(big_file, Config), + + Send = fun(Sock,SFServPid) -> + spawn_link(fun() -> + timer:sleep(50), + SFServPid ! stop + end), + case erlang:system_info(thread_pool_size) of + 0 -> + {error, closed} = file:sendfile(Filename, Sock); + _Else -> + %% This can return how much has been sent or + %% {error,closed} depending on OS. + %% How much is sent impossible to know as + %% the socket was closed mid sendfile + case file:sendfile(Filename, Sock) of + {error, closed} -> + ok; + {ok, Size} when is_integer(Size) -> + ok + end + end, + -1 + end, + + ok = sendfile_send({127,0,0,1}, Send, 0). + +t_sendfile_crashduring(Config) -> + Filename = proplists:get_value(big_file, Config), + + error_logger:add_report_handler(?MODULE,[self()]), + + Send = fun(Sock) -> + spawn_link(fun() -> + timer:sleep(50), + exit(die) + end), + {error, closed} = file:sendfile(Filename, Sock), + -1 + end, + process_flag(trap_exit,true), + spawn_link(fun() -> + ok = sendfile_send({127,0,0,1}, Send, 0) + end), + receive + {stolen,Reason} -> + process_flag(trap_exit,false), + ct:fail(Reason) + after 200 -> + receive + {'EXIT',_,Reason} -> + process_flag(trap_exit,false), + die = Reason + end + end. + +%% Generic sendfile server code sendfile_send(Send) -> - sendfile_send("localhost",Send). + sendfile_send({127,0,0,1},Send). sendfile_send(Host, Send) -> sendfile_send(Host, Send, []). sendfile_send(Host, Send, Orig) -> - spawn_link(?MODULE, sendfile_server, [self(), Orig]), + SFServer = spawn_link(?MODULE, sendfile_server, [self(), Orig]), receive {server, Port} -> {ok, Sock} = gen_tcp:connect(Host, Port, [binary,{packet,0}, {active,false}]), - Data = Send(Sock), + Data = case proplists:get_value(arity,erlang:fun_info(Send)) of + 1 -> + Send(Sock); + 2 -> + Send(Sock, SFServer) + end, ok = gen_tcp:close(Sock), receive {ok, Bin} -> @@ -245,9 +309,11 @@ sendfile_server(ClientPid, Orig) -> gen_tcp:send(Sock, <<1>>). -define(SENDFILE_TIMEOUT, 10000). -%% f(),{ok, S} = gen_tcp:connect("localhost",7890,[binary]),file:sendfile("/ldisk/lukas/otp/sendfiletest.dat",S). sendfile_do_recv(Sock, Bs) -> receive + stop when Bs /= 0,is_integer(Bs) -> + gen_tcp:close(Sock), + {ok, -1}; {tcp, Sock, B} -> case binary:match(B,<<1>>) of nomatch when is_list(Bs) -> @@ -276,3 +342,14 @@ sendfile_file_info(File) -> {ok, #file_info{size = Size}} = file:read_file_info(File), {ok, Data} = file:read_file(File), {Size, Data}. + + +%% Error handler + +init([Proc]) -> {ok,Proc}. + +handle_event({error,noproc,{emulator,Format,Args}}, Proc) -> + Proc ! {stolen,lists:flatten(io_lib:format(Format,Args))}, + {ok,Proc}; +handle_event(_, Proc) -> + {ok,Proc}. diff --git a/lib/megaco/doc/src/megaco_run.xml b/lib/megaco/doc/src/megaco_run.xml index 9ed589b079..ca46983288 100644 --- a/lib/megaco/doc/src/megaco_run.xml +++ b/lib/megaco/doc/src/megaco_run.xml @@ -317,7 +317,7 @@ "in storage" (indicated by the transaction id) it is assumed to be a resend and everything stored is sent. This could happen if the values of the <c><![CDATA[trans_timer]]></c> and the - <c><![CDATA[request_timer]]></c> is not properly choosen.</p> + <c><![CDATA[request_timer]]></c> is not properly chosen.</p> </section> <section> diff --git a/lib/megaco/include/megaco_message_prev3a.hrl b/lib/megaco/include/megaco_message_prev3a.hrl index 7b7a60fdae..3e73f94761 100644 --- a/lib/megaco/include/megaco_message_prev3a.hrl +++ b/lib/megaco/include/megaco_message_prev3a.hrl @@ -563,7 +563,7 @@ %% This is the actual ASN.1 type and it is as this it will -%% be represented if the encoding config [native] is choosen. +%% be represented if the encoding config [native] is chosen. %% %% String of at least 1 character and at most 67 characters (ASN.1). %% %% 64 characters for name, 1 for "/", 2 for version to match ABNF %% -record('ServiceChangeProfile', diff --git a/lib/megaco/include/megaco_message_prev3b.hrl b/lib/megaco/include/megaco_message_prev3b.hrl index cfabb29941..b4bde2bb7e 100644 --- a/lib/megaco/include/megaco_message_prev3b.hrl +++ b/lib/megaco/include/megaco_message_prev3b.hrl @@ -563,7 +563,7 @@ %% This is the actual ASN.1 type and it is as this it will -%% be represented if the encoding config [native] is choosen. +%% be represented if the encoding config [native] is chosen. %% %% String of at least 1 character and at most 67 characters (ASN.1). %% %% 64 characters for name, 1 for "/", 2 for version to match ABNF %% -record('ServiceChangeProfile', diff --git a/lib/megaco/include/megaco_message_prev3c.hrl b/lib/megaco/include/megaco_message_prev3c.hrl index 32024c9a02..90612f66c8 100644 --- a/lib/megaco/include/megaco_message_prev3c.hrl +++ b/lib/megaco/include/megaco_message_prev3c.hrl @@ -748,7 +748,7 @@ %% This is the actual ASN.1 type and it is as this it will -%% be represented if the encoding config [native] is choosen. +%% be represented if the encoding config [native] is chosen. %% %% String of at least 1 character and at most 67 characters (ASN.1). %% %% 64 characters for name, 1 for "/", 2 for version to match ABNF %% -record('ServiceChangeProfile', diff --git a/lib/megaco/include/megaco_message_v1.hrl b/lib/megaco/include/megaco_message_v1.hrl index ba50b50c80..f196c26713 100644 --- a/lib/megaco/include/megaco_message_v1.hrl +++ b/lib/megaco/include/megaco_message_v1.hrl @@ -404,7 +404,7 @@ }). % with extension mark %% This is the actual ASN.1 type and it is as this it will -%% be represented if the encoding config [native] is choosen. +%% be represented if the encoding config [native] is chosen. % %% String of at least 1 character and at most 67 characters (ASN.1). % %% 64 characters for name, 1 for "/", 2 for version to match ABNF % -record('ServiceChangeProfile', diff --git a/lib/megaco/include/megaco_message_v2.hrl b/lib/megaco/include/megaco_message_v2.hrl index 6190ea7ac4..af79c4dc92 100644 --- a/lib/megaco/include/megaco_message_v2.hrl +++ b/lib/megaco/include/megaco_message_v2.hrl @@ -525,7 +525,7 @@ %% This is the actual ASN.1 type and it is as this it will -%% be represented if the encoding config [native] is choosen. +%% be represented if the encoding config [native] is chosen. %% %% String of at least 1 character and at most 67 characters (ASN.1). %% %% 64 characters for name, 1 for "/", 2 for version to match ABNF %% -record('ServiceChangeProfile', diff --git a/lib/megaco/include/megaco_message_v3.hrl b/lib/megaco/include/megaco_message_v3.hrl index 7a1bc80571..466cfa6856 100644 --- a/lib/megaco/include/megaco_message_v3.hrl +++ b/lib/megaco/include/megaco_message_v3.hrl @@ -743,7 +743,7 @@ %% This is the actual ASN.1 type and it is as this it will -%% be represented if the encoding config [native] is choosen. +%% be represented if the encoding config [native] is chosen. %% %% String of at least 1 character and at most 67 characters (ASN.1). %% %% 64 characters for name, 1 for "/", 2 for version to match ABNF %% -record('ServiceChangeProfile', diff --git a/lib/megaco/src/engine/megaco_digit_map.erl b/lib/megaco/src/engine/megaco_digit_map.erl index de28686d6d..a904bd565a 100644 --- a/lib/megaco/src/engine/megaco_digit_map.erl +++ b/lib/megaco/src/engine/megaco_digit_map.erl @@ -362,7 +362,7 @@ collect(Event, State, Timers, STL, Letters) -> "~n Timers2: ~p" "~n Letters2: ~p", [State2, Timers2, Letters2]), MaxWait = choose_timer(State2, Event, Timers2), - ?d("collect -> Timer choosen: " + ?d("collect -> Timer chosen: " "~n MaxWait: ~p", [MaxWait]), receive {?MODULE, _FromPid, Event2} -> @@ -737,7 +737,7 @@ compute_cont([Next | Cont] = All, Mode, GlobalMode, State, STL) -> "~n Mode: ~p" "~n GlobalMode: ~p", [Next, Mode, GlobalMode]), case Next of - %% Retain long timer if that has already been choosen + %% Retain long timer if that has already been chosen use_short_timer when GlobalMode =:= use_long_timer -> compute_cont(Cont, Mode, GlobalMode, State, STL); use_short_timer -> diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 19ec70118f..20133cb6cb 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -813,6 +813,21 @@ mnesia:change_table_copy_type(person, node(), disc_copies) </p> </item> <item> + <p><c>{storage_properties, [{Backend, Properties}]</c>. + Forwards additional properties to the backend storage. + <c>Backend</c> can currently be <c>ets</c> or <c>dets</c> and + <c>Properties</c> is a list of options sent to the backend storage + during table creation. <c>Properties</c> may not contain properties + already used by mnesia such as <c>type</c> or <c>named_table</c>. + </p> + <p>For example:</p> + <code type="none"> +mnesia:create_table(table, [{ram_copies, [node()]}, {disc_only_copies, nodes()}, + {storage_properties, + [{ets, [compressed]}, {dets, [{auto_save, 5000}]} ]}]) + </code> + </item> + <item> <p><c>{type, Type}</c>, where <c>Type</c> must be either of the atoms <c>set</c>, <c>ordered_set</c> or <c>bag</c>. The default value is <c>set</c>. In a diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src index e0954ad206..304a15242f 100644 --- a/lib/mnesia/src/mnesia.appup.src +++ b/lib/mnesia/src/mnesia.appup.src @@ -1,14 +1,16 @@ %% -*- erlang -*- {"%VSN%", [ - {"4.5", [{restart_application, mnesia}]}, + {"4.5.1", [{restart_application, mnesia}]}, + {"4.5", [{restart_application, mnesia}]}, {"4.4.19", [{restart_application, mnesia}]}, {"4.4.18", [{restart_application, mnesia}]}, {"4.4.17", [{restart_application, mnesia}]}, {"4.4.16", [{restart_application, mnesia}]} ], [ - {"4.5", [{restart_application, mnesia}]}, + {"4.5.1", [{restart_application, mnesia}]}, + {"4.5", [{restart_application, mnesia}]}, {"4.4.19", [{restart_application, mnesia}]}, {"4.4.18", [{restart_application, mnesia}]}, {"4.4.17", [{restart_application, mnesia}]}, diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index 2375b72d59..2855792646 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -70,6 +70,7 @@ attributes = [key, val], % [Atom] user_properties = [], % [Record] frag_properties = [], % [{Key, Val] + storage_properties = [], % [{Key, Val] cookie = ?unique_cookie, % Term version = {{2, 0}, []}}). % {{Integer, Integer}, [Node]} diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 6a561394d5..836510a80d 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -279,11 +279,8 @@ rec_tabs([], _, _, Init) -> unlink(Init), ok. -%% New function that does exactly what get_cstructs() used to do. -%% When this function is called, we know that the calling node knows -%% how to convert cstructs on the receiving end (should they differ). get_remote_cstructs() -> - call(get_cstructs). + get_cstructs(). %% Sigh not forward compatible always check version %% Old function kept for backwards compatibility; converts cstructs before sending. get_cstructs() -> diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl index f8d7664156..9e7e1ad1c6 100644 --- a/lib/mnesia/src/mnesia_dumper.erl +++ b/lib/mnesia/src/mnesia_dumper.erl @@ -604,15 +604,19 @@ insert_op(Tid, _, {op, restore_recreate, TabDef}, InPlace, InitBy) -> mnesia_checkpoint:tm_del_copy(Tab, node()) end end, + StorageProps = Cs#cstruct.storage_properties, + %% And create new ones.. if (InitBy == startup) or (Storage == unknown) -> ignore; Storage == ram_copies -> - Args = [{keypos, 2}, public, named_table, Type], + EtsProps = proplists:get_value(ets, StorageProps, []), + Args = [{keypos, 2}, public, named_table, Type | EtsProps], mnesia_monitor:mktab(Tab, Args); Storage == disc_copies -> - Args = [{keypos, 2}, public, named_table, Type], + EtsProps = proplists:get_value(ets, StorageProps, []), + Args = [{keypos, 2}, public, named_table, Type | EtsProps], mnesia_monitor:mktab(Tab, Args), File = mnesia_lib:tab2dcd(Tab), FArg = [{file, File}, {name, {mnesia,create}}, @@ -622,10 +626,12 @@ insert_op(Tid, _, {op, restore_recreate, TabDef}, InPlace, InitBy) -> Storage == disc_only_copies -> File = mnesia_lib:tab2dat(Tab), file:delete(File), + DetsProps = proplists:get_value(dets, StorageProps, []), Args = [{file, mnesia_lib:tab2dat(Tab)}, {type, mnesia_lib:disk_type(Tab, Type)}, {keypos, 2}, - {repair, mnesia_monitor:get_env(auto_repair)}], + {repair, mnesia_monitor:get_env(auto_repair)} + | DetsProps ], mnesia_monitor:open_dets(Tab, Args) end, insert_op(Tid, ignore, {op, create_table, TabDef}, InPlace, InitBy); @@ -635,6 +641,7 @@ insert_op(Tid, _, {op, create_table, TabDef}, InPlace, InitBy) -> insert_cstruct(Tid, Cs, false, InPlace, InitBy), Tab = Cs#cstruct.name, Storage = mnesia_lib:cs_to_storage_type(node(), Cs), + StorageProps = Cs#cstruct.storage_properties, case InitBy of startup -> case Storage of @@ -656,10 +663,13 @@ insert_op(Tid, _, {op, create_table, TabDef}, InPlace, InitBy) -> mnesia_log:unsafe_close_log(temp) end; _ -> + DetsProps = proplists:get_value(dets, StorageProps, []), + Args = [{file, mnesia_lib:tab2dat(Tab)}, {type, mnesia_lib:disk_type(Tab, Cs#cstruct.type)}, {keypos, 2}, - {repair, mnesia_monitor:get_env(auto_repair)}], + {repair, mnesia_monitor:get_env(auto_repair)} + | DetsProps ], case mnesia_monitor:open_dets(Tab, Args) of {ok, _} -> mnesia_monitor:unsafe_close_dets(Tab); @@ -671,7 +681,7 @@ insert_op(Tid, _, {op, create_table, TabDef}, InPlace, InitBy) -> Copies = mnesia_lib:copy_holders(Cs), Active = mnesia_lib:intersect(Copies, val({current, db_nodes})), [mnesia_controller:add_active_replica(Tab, N, Cs) || N <- Active], - + case Storage of unknown -> mnesia_lib:unset({Tab, create_table}), @@ -944,11 +954,14 @@ open_files(Tab, Storage, UpdateInPlace, InitBy) Bool = open_disc_copies(Tab, InitBy), Bool; _ -> + Props = val({Tab, storage_properties}), + DetsProps = proplists:get_value(dets, Props, []), Fname = prepare_open(Tab, UpdateInPlace), Args = [{file, Fname}, {keypos, 2}, {repair, mnesia_monitor:get_env(auto_repair)}, - {type, mnesia_lib:disk_type(Tab, Type)}], + {type, mnesia_lib:disk_type(Tab, Type)} + | DetsProps], {ok, _} = mnesia_monitor:open_dets(Tab, Args), put({?MODULE, Tab}, {opened_dumper, dat}), true diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index c4b22814a8..e443b54016 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -61,9 +61,11 @@ do_get_disc_copy2(Tab, _Reason, Storage, _Type) when Storage == unknown -> do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> %% NOW we create the actual table Repair = mnesia_monitor:get_env(auto_repair), - Args = [{keypos, 2}, public, named_table, Type], + StorageProps = val({Tab, storage_properties}), + EtsOpts = proplists:get_value(ets, StorageProps, []), + Args = [{keypos, 2}, public, named_table, Type | EtsOpts], case Reason of - {dumper, _} -> %% Resources allready allocated + {dumper, _} -> %% Resources already allocated ignore; _ -> mnesia_monitor:mktab(Tab, Args), @@ -82,7 +84,9 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies -> {loaded, ok}; do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == ram_copies -> - Args = [{keypos, 2}, public, named_table, Type], + StorageProps = val({Tab, storage_properties}), + EtsOpts = proplists:get_value(ets, StorageProps, []), + Args = [{keypos, 2}, public, named_table, Type | EtsOpts], case Reason of {dumper, _} -> %% Resources allready allocated ignore; @@ -115,10 +119,14 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == ram_copies -> {loaded, ok}; do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies -> + StorageProps = val({Tab, storage_properties}), + DetsOpts = proplists:get_value(dets, StorageProps, []), + Args = [{file, mnesia_lib:tab2dat(Tab)}, {type, mnesia_lib:disk_type(Tab, Type)}, {keypos, 2}, - {repair, mnesia_monitor:get_env(auto_repair)}], + {repair, mnesia_monitor:get_env(auto_repair)} + | DetsOpts], case Reason of {dumper, _} -> mnesia_index:init_index(Tab, Storage), @@ -349,17 +357,21 @@ do_init_table(Tab,Storage,Cs,SenderPid, end. create_table(Tab, TabSize, Storage, Cs) -> + StorageProps = val({Tab, storage_properties}), if Storage == disc_only_copies -> mnesia_lib:lock_table(Tab), Tmp = mnesia_lib:tab2tmp(Tab), Size = lists:max([TabSize, 256]), + DetsOpts = lists:keydelete(estimated_no_objects, 1, + proplists:get_value(dets, StorageProps, [])), Args = [{file, Tmp}, {keypos, 2}, %% {ram_file, true}, {estimated_no_objects, Size}, {repair, mnesia_monitor:get_env(auto_repair)}, - {type, mnesia_lib:disk_type(Tab, Cs#cstruct.type)}], + {type, mnesia_lib:disk_type(Tab, Cs#cstruct.type)} + | DetsOpts], file:delete(Tmp), case mnesia_lib:dets_sync_open(Tab, Args) of {ok, _} -> @@ -370,7 +382,8 @@ create_table(Tab, TabSize, Storage, Cs) -> Else end; (Storage == ram_copies) or (Storage == disc_copies) -> - Args = [{keypos, 2}, public, named_table, Cs#cstruct.type], + EtsOpts = proplists:get_value(ets, StorageProps, []), + Args = [{keypos, 2}, public, named_table, Cs#cstruct.type | EtsOpts], case mnesia_monitor:unsafe_mktab(Tab, Args) of Tab -> {Storage, Tab}; @@ -516,10 +529,13 @@ handle_last({disc_only_copies, Tab}, Type, nobin) -> Dat = mnesia_lib:tab2dat(Tab), case file:rename(Tmp, Dat) of ok -> + StorageProps = val({Tab, storage_properties}), + DetsOpts = proplists:get_value(dets, StorageProps, []), + Args = [{file, mnesia_lib:tab2dat(Tab)}, {type, mnesia_lib:disk_type(Tab, Type)}, {keypos, 2}, - {repair, mnesia_monitor:get_env(auto_repair)}], + {repair, mnesia_monitor:get_env(auto_repair)} | DetsOpts], mnesia_monitor:open_dets(Tab, Args), ok; {error, Reason} -> diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 8cb2e92c08..c08bbc879f 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -80,9 +80,9 @@ going_down = [], tm_started = false, early_connects = [], connecting, mq = []}). --define(current_protocol_version, {8,0}). +-define(current_protocol_version, {8,1}). --define(previous_protocol_version, {7,6}). +-define(previous_protocol_version, {8,0}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -188,7 +188,7 @@ protocol_version() -> %% A sorted list of acceptable protocols the %% preferred protocols are first in the list acceptable_protocol_versions() -> - [protocol_version(), ?previous_protocol_version]. + [protocol_version(), ?previous_protocol_version, {7,6}]. needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of @@ -417,6 +417,8 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) case hd(Protocols) of ?previous_protocol_version -> accept_protocol(Mon, MyVersion, ?previous_protocol_version, From, State); + {7,6} -> + accept_protocol(Mon, MyVersion, {7,6}, From, State); _ -> verbose("Connection with ~p rejected. " "version = ~p, protocols = ~p, " diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 179e15197e..6e43052fb0 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -188,6 +188,7 @@ do_set_schema(Tab, Cs) -> [set({Tab, user_property, element(1, P)}, P) || P <- Cs#cstruct.user_properties], set({Tab, frag_properties}, Cs#cstruct.frag_properties), mnesia_frag:set_frag_hash(Tab, Cs#cstruct.frag_properties), + set({Tab, storage_properties}, Cs#cstruct.storage_properties), set({Tab, attributes}, Cs#cstruct.attributes), Arity = length(Cs#cstruct.attributes) + 1, set({Tab, arity}, Arity), @@ -644,6 +645,14 @@ cs2list(Cs) when is_record(Cs, cstruct) -> rec2list(Tags, Tags, 2, Cs); cs2list(CreateList) when is_list(CreateList) -> CreateList; +%% 4.6 +cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> + Tags = [name,type,ram_copies,disc_copies,disc_only_copies, + load_order,access_mode,majority,index,snmp,local_content, + record_name,attributes, + user_properties,frag_properties,storage_properties, + cookie,version], + rec2list(Tags, Tags, 2, Cs); %% 4.4.19 cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> Tags = [name,type,ram_copies,disc_copies,disc_only_copies, @@ -674,8 +683,17 @@ cs2list(ver4_4_19, Cs) -> load_order,access_mode,majority,index,snmp,local_content, record_name,attributes,user_properties,frag_properties, cookie,version], + rec2list(Tags, Orig, 2, Cs); +cs2list(ver4_6, Cs) -> + Orig = record_info(fields, cstruct), + Tags = [name,type,ram_copies,disc_copies,disc_only_copies, + load_order,access_mode,majority,index,snmp,local_content, + record_name,attributes, + user_properties,frag_properties,storage_properties, + cookie,version], rec2list(Tags, Orig, 2, Cs). + rec2list([Tag | Tags], [Tag | Orig], Pos, Rec) -> Val = element(Pos, Rec), [{Tag, Val} | rec2list(Tags, Orig, Pos + 1, Rec)]; @@ -728,6 +746,29 @@ list2cs(List) when is_list(List) -> Frag = pick(Name, frag_properties, List, []), verify({alt, [nil, list]}, mnesia_lib:etype(Frag), {badarg, Name, {frag_properties, Frag}}), + + BEProps = pick(Name, storage_properties, List, []), + verify({alt, [nil, list]}, mnesia_lib:etype(Ix), + {badarg, Name, {storage_properties, BEProps}}), + CheckProp = fun(Opt, Opts) when is_atom(Opt) -> + lists:member(Opt, Opts) + andalso mnesia:abort({badarg, Name, Opt}); + (Tuple, Opts) when is_tuple(Tuple) -> + lists:member(element(1,Tuple), Opts) + andalso mnesia:abort({badarg, Name, Tuple}); + (What,_) -> + mnesia:abort({badarg, Name, What}) + end, + BadEtsOpts = [set, ordered_set, bag, duplicate_bag, + public, private, protected, + keypos, named_table], + EtsOpts = proplists:get_value(ets, BEProps, []), + is_list(EtsOpts) orelse mnesia:abort({badarg, Name, {ets, EtsOpts}}), + [CheckProp(Prop, BadEtsOpts) || Prop <- EtsOpts], + BadDetsOpts = [type, keypos, repair, access, file], + DetsOpts = proplists:get_value(dets, BEProps, []), + is_list(DetsOpts) orelse mnesia:abort({badarg, Name, {dets, DetsOpts}}), + [CheckProp(Prop, BadDetsOpts) || Prop <- DetsOpts], #cstruct{name = Name, ram_copies = Rc, disc_copies = Dc, @@ -743,6 +784,7 @@ list2cs(List) when is_list(List) -> attributes = Attrs, user_properties = lists:sort(UserProps), frag_properties = lists:sort(Frag), + storage_properties = lists:sort(BEProps), cookie = Cookie, version = Version}. @@ -1881,18 +1923,18 @@ prepare_op(Tid, {op, create_table, TabDef}, _WaitFor) -> mnesia:abort(UseDirReason); ram_copies -> mnesia_lib:set({Tab, create_table},true), - create_ram_table(Tab, Cs#cstruct.type), + create_ram_table(Tab, Cs), insert_cstruct(Tid, Cs, false), {true, optional}; disc_copies -> mnesia_lib:set({Tab, create_table},true), - create_ram_table(Tab, Cs#cstruct.type), + create_ram_table(Tab, Cs), create_disc_table(Tab), insert_cstruct(Tid, Cs, false), {true, optional}; disc_only_copies -> mnesia_lib:set({Tab, create_table},true), - create_disc_only_table(Tab,Cs#cstruct.type), + create_disc_only_table(Tab,Cs), insert_cstruct(Tid, Cs, false), {true, optional}; unknown -> %% No replica on this node @@ -2044,7 +2086,7 @@ prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) mnesia_dumper:raw_named_dump_table(Tab, dmp); FromS == disc_only_copies -> Type = Cs#cstruct.type, - create_ram_table(Tab, Type), + create_ram_table(Tab, Cs), Datname = mnesia_lib:tab2dat(Tab), Repair = mnesia_monitor:get_env(auto_repair), case mnesia_lib:dets_to_ets(Tab, Tab, Datname, Type, Repair, no) of @@ -2132,8 +2174,9 @@ prepare_op(_Tid, {op, merge_schema, TabDef}, _WaitFor) -> prepare_op(_Tid, _Op, _WaitFor) -> {true, optional}. -create_ram_table(Tab, Type) -> - Args = [{keypos, 2}, public, named_table, Type], +create_ram_table(Tab, #cstruct{type=Type, storage_properties=Props}) -> + EtsOpts = proplists:get_value(ets, Props, []), + Args = [{keypos, 2}, public, named_table, Type | EtsOpts], case mnesia_monitor:unsafe_mktab(Tab, Args) of Tab -> ok; @@ -2141,6 +2184,7 @@ create_ram_table(Tab, Type) -> Err = "Failed to create ets table", mnesia:abort({system_limit, Tab, {Err,Reason}}) end. + create_disc_table(Tab) -> File = mnesia_lib:tab2dcd(Tab), file:delete(File), @@ -2154,13 +2198,15 @@ create_disc_table(Tab) -> Err = "Failed to create disc table", mnesia:abort({system_limit, Tab, {Err,Reason}}) end. -create_disc_only_table(Tab,Type) -> +create_disc_only_table(Tab, #cstruct{type=Type, storage_properties=Props}) -> File = mnesia_lib:tab2dat(Tab), file:delete(File), + DetsOpts = proplists:get_value(dets, Props, []), Args = [{file, mnesia_lib:tab2dat(Tab)}, {type, mnesia_lib:disk_type(Tab, Type)}, {keypos, 2}, - {repair, mnesia_monitor:get_env(auto_repair)}], + {repair, mnesia_monitor:get_env(auto_repair)} + | DetsOpts], case mnesia_monitor:unsafe_open_dets(Tab, Args) of {ok, _} -> ok; @@ -2688,17 +2734,17 @@ restore_schema([{schema, Tab, List} | Schema], R) -> R2 = R#r{tables = [{Tab, undefined, Snmp, RecName} | R#r.tables]}, restore_schema(Schema, R2); recreate_tables -> - case ?catch_val({Tab, cstruct}) of - {'EXIT', _} -> - TidTs = {_Mod, Tid, Ts} = get(mnesia_activity_state), - RunningNodes = val({current, db_nodes}), - Nodes = mnesia_lib:intersect(mnesia_lib:cs_to_nodes(list2cs(List)), - RunningNodes), - mnesia_locker:wlock_no_exist(Tid, Ts#tidstore.store, Tab, Nodes), - TidTs; - _ -> - TidTs = get_tid_ts_and_lock(Tab, write) - end, + TidTs = case ?catch_val({Tab, cstruct}) of + {'EXIT', _} -> + TTs = {_Mod, Tid, Ts} = get(mnesia_activity_state), + RunningNodes = val({current, db_nodes}), + Nodes = mnesia_lib:intersect(mnesia_lib:cs_to_nodes(list2cs(List)), + RunningNodes), + mnesia_locker:wlock_no_exist(Tid, Ts#tidstore.store, Tab, Nodes), + TTs; + _ -> + get_tid_ts_and_lock(Tab, write) + end, NC = {cookie, ?unique_cookie}, List2 = lists:keyreplace(cookie, 1, List, NC), Where = where_to_commit(Tab, List2), @@ -2839,15 +2885,15 @@ do_merge_schema(LockTabs0) -> end. fetch_cstructs(Node) -> - case mnesia_monitor:needs_protocol_conversion(Node) of - true -> + case need_old_cstructs([Node]) of + false -> + rpc:call(Node, mnesia_controller, get_remote_cstructs, []); + _Ver -> case rpc:call(Node, mnesia_controller, get_cstructs, []) of {cstructs, Cs0, RR} -> {cstructs, [list2cs(cs2list(Cs)) || Cs <- Cs0], RR}; Err -> Err - end; - false -> - rpc:call(Node, mnesia_controller, get_remote_cstructs, []) + end end. need_old_cstructs() -> @@ -2868,7 +2914,9 @@ need_old_cstructs(Nodes) -> Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> ver4_4_18; % Without majority Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - ver4_4_19 % With majority + ver4_4_19; % With majority + Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> + ver4_6 % With storage_properties end end. diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index c1918071a1..64b61288ef 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -37,7 +37,8 @@ end_per_testcase(Func, Conf) -> all() -> [system_info, table_info, error_description, db_node_lifecycle, evil_delete_db_node, start_and_stop, - checkpoint, table_lifecycle, add_copy_conflict, + checkpoint, table_lifecycle, storage_options, + add_copy_conflict, add_copy_when_going_down, replica_management, schema_availability, local_content, {group, table_access_modifications}, replica_location, @@ -462,7 +463,7 @@ table_lifecycle(Config) when is_list(Config) -> ?match({atomic, ok}, mnesia:create_table([{name, already_exists}, {ram_copies, [Node1]}])), ?match({aborted, Reason23 } when element(1, Reason23) ==already_exists, - mnesia:create_table([{name, already_exists}, + mnesia:create_table([{name, already_exists}, {ram_copies, [Node1]}])), ?match({aborted, Reason21 } when element(1, Reason21) == bad_type, mnesia:create_table([{name, bad_node}, {ram_copies, ["foo"]}])), @@ -520,12 +521,57 @@ table_lifecycle(Config) when is_list(Config) -> ?match({atomic, ok}, mnesia:create_table([{name, create_with_index}, {index, [3]}, {ram_copies, [Node1]}])), - ets:new(ets_table, [named_table]), + ets:new(ets_table, [named_table]), ?match({aborted, _}, mnesia:create_table(ets_table, [{ram_copies, Nodes}])), + ?match({aborted, _}, mnesia:create_table(ets_table, [{ram_copies, [Node1]}])), + ets:delete(ets_table), + ?match({atomic, ok}, mnesia:create_table(ets_table, [{ram_copies, [Node1]}])), + ?match(Node1, rpc:call(Node1, mnesia_lib, val, [{ets_table,where_to_read}])), + ?match(Node1, rpc:call(Node2, mnesia_lib, val, [{ets_table,where_to_read}])), + ?match({atomic, ok}, mnesia:change_table_copy_type(ets_table, Node1, disc_only_copies)), + ?match(Node1, rpc:call(Node2, mnesia_lib, val, [{ets_table,where_to_read}])), + + ?verify_mnesia(Nodes, []). + + +storage_options(suite) -> []; +storage_options(Config) when is_list(Config) -> + [N1,N2,N3] = Nodes = ?acquire_nodes(3, Config), + + ?match({aborted,_}, mnesia:create_table(a, [{storage_properties, [{ets,foobar}]}])), + ?match({aborted,_}, mnesia:create_table(a, [{storage_properties, [{ets,[foobar]}]}])), + ?match({aborted,_}, mnesia:create_table(a, [{storage_properties, [{ets,[duplicate_bag]}]}])), + ?match({aborted,_}, mnesia:create_table(a, [{storage_properties, [{dets,[{type,bag}]}]}])), + + ?match({atomic, ok}, mnesia:create_table(a, [{ram_copies, [N1]}, + {disc_only_copies, [N2]}, + {storage_properties, + [{ets,[compressed]}, + {dets, [{auto_save, 5000}]} ]}])), + ?match(true, ets:info(a, compressed)), + ?match(5000, rpc:call(N2, dets, info, [a, auto_save])), + ?match(ok, mnesia:dirty_write({a,1,1})), + ?match([{a,1,1}], mnesia:dirty_read({a,1})), + mnesia:dump_log(), + W2C1 = [{N2, disc_only_copies}, {N1, ram_copies}], + ?match(W2C1, lists:sort(rpc:call(N2, mnesia_lib, val, [{a, where_to_commit}]))), + ?match(W2C1, lists:sort(rpc:call(N3, mnesia_lib, val, [{a, where_to_commit}]))), + ?match({atomic,ok}, mnesia:change_table_copy_type(a, N1, disc_only_copies)), + W2C2 = [{N2, disc_only_copies}, {N1, disc_only_copies}], + ?match(W2C2, lists:sort(rpc:call(N2, mnesia_lib, val, [{a, where_to_commit}]))), + ?match(W2C2, lists:sort(rpc:call(N3, mnesia_lib, val, [{a, where_to_commit}]))), + ?match(undefined, ets:info(a, compressed)), + ?match(5000, dets:info(a, auto_save)), + ?match({atomic,ok}, mnesia:change_table_copy_type(a, N1, disc_copies)), + ?match(true, ets:info(a, compressed)), ?verify_mnesia(Nodes, []). + + + + add_copy_conflict(suite) -> []; add_copy_conflict(doc) -> ["Verify that OTP-5065 doesn't happen again, whitebox testing"]; diff --git a/lib/orber/doc/src/ch_install.xml b/lib/orber/doc/src/ch_install.xml index dde4bf4006..de9c0e3a9d 100644 --- a/lib/orber/doc/src/ch_install.xml +++ b/lib/orber/doc/src/ch_install.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -394,84 +394,16 @@ nodeB@hostB> orber:start(). <cell align="left" valign="middle">The same as <c>iiop_ssl_port</c></cell> </row> <row> - <cell align="left" valign="middle">ssl_server_cacertfile</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_server_certfile</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_server_verify</cell> - <cell align="left" valign="middle">0 | 1 | 2</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_server_depth</cell> - <cell align="left" valign="middle">integer()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_server_password</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_server_keyfile</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_server_ciphers</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> + <cell align="left" valign="middle">ssl_server_options</cell> + <cell align="left" valign="middle">list()</cell> + <cell align="left" valign="middle">See the <seealso marker="ssl:ssl">SSL</seealso> application + for valid options.</cell> </row> <row> - <cell align="left" valign="middle">ssl_server_cachetimeout</cell> - <cell align="left" valign="middle">integer() | infinity</cell> - <cell align="left" valign="middle">infinity</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_cacertfile</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_certfile</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_verify</cell> - <cell align="left" valign="middle">0 | 1 | 2</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_depth</cell> - <cell align="left" valign="middle">integer()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_password</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_keyfile</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_ciphers</cell> - <cell align="left" valign="middle">string()</cell> - <cell align="left" valign="middle">-</cell> - </row> - <row> - <cell align="left" valign="middle">ssl_client_cachetimeout</cell> - <cell align="left" valign="middle">integer() | infinity</cell> - <cell align="left" valign="middle">infinity</cell> + <cell align="left" valign="middle">ssl_client_options</cell> + <cell align="left" valign="middle">list()</cell> + <cell align="left" valign="middle">See the <seealso marker="ssl:ssl">SSL</seealso> application + for valid options.</cell> </row> <row> <cell align="left" valign="middle">iiop_ssl_out_keepalive</cell> @@ -698,40 +630,10 @@ nodeB@hostB> orber:start(). <item>If set, the value must be an integer greater than zero or <c>{local, DefaultNATPort, [{Port, NATPort}]}</c>. See also <seealso marker="ch_install#firewall">Firewall Configuration</seealso>.</item> - <tag><em>ssl_server_cacertfile</em></tag> + <tag><em>ssl_server_options</em></tag> <item>the file path to a server side CA certificate.</item> - <tag><em>ssl_server_certfile</em></tag> - <item>The path to a file containing a chain of PEM encoded certificates.</item> - <tag><em>ssl_server_verify</em></tag> - <item>The type of verification used by SSL during authentication of the - other peer for incoming calls.</item> - <tag><em>ssl_server_depth</em></tag> - <item>The SSL verification depth for outgoing calls.</item> - <tag><em>ssl_server_password</em></tag> - <item>The server side key string.</item> - <tag><em>ssl_server_keyfile</em></tag> - <item>The file path to a server side key.</item> - <tag><em>ssl_server_ciphers</em></tag> - <item>The server side cipher string.</item> - <tag><em>ssl_server_cachetimeout</em></tag> - <item>The server side cache timeout.</item> - <tag><em>ssl_client_cacertfile</em></tag> - <item>The file path to a client side CA certificate.</item> - <tag><em>ssl_client_certfile</em></tag> + <tag><em>ssl_client_options</em></tag> <item>The path to a file containing a chain of PEM encoded certificates.</item> - <tag><em>ssl_client_verify</em></tag> - <item>The type of verification used by SSL during authentication of the - other peer for outgoing calls.</item> - <tag><em>ssl_client_depth</em></tag> - <item>The SSL verification depth for incoming calls.</item> - <tag><em>ssl_client_password</em></tag> - <item>The client side key string.</item> - <tag><em>ssl_client_keyfile</em></tag> - <item>The file path to a client side key.</item> - <tag><em>ssl_client_ciphers</em></tag> - <item>The client side cipher string.</item> - <tag><em>ssl_client_cachetimeout</em></tag> - <item>The client side cache timeout.</item> <tag><em>iiop_ssl_out_keepalive</em></tag> <item>Enables periodic transmission on a connected socket, when no other data is being exchanged. If the other end does not respond, the diff --git a/lib/orber/doc/src/ch_security.xml b/lib/orber/doc/src/ch_security.xml index 938025a629..a25a8a5052 100644 --- a/lib/orber/doc/src/ch_security.xml +++ b/lib/orber/doc/src/ch_security.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>1999</year><year>2009</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -55,40 +55,15 @@ <section> <title>Configurations when Orber is Used on the Server Side</title> - <p>The following three configuration variables can be used to configure Orber's SSL - behavior on the server side.</p> + <p>There is a variable to conficure Orber's SSL behavior on the server side.</p> <list type="bulleted"> - <item><em>ssl_server_certfile</em> - which is a path to a file containing a - chain of PEM encoded certificates for the Orber domain as server.</item> - <item><em>ssl_server_cacertfile</em> - which is a path to a file containing - a chain of PEM encoded certificates for the Orber domain as server.</item> - <item><em>ssl_server_verify</em> - which specifies type of verification: - 0 = do not verify peer; 1 = verify peer, verify client once, - 2 = verify peer, verify client once, fail if no peer certificate. - The default value is 0.</item> - <item><em>ssl_server_depth</em> - which specifies verification depth, i.e. - how far in a chain of certificates the verification process shall - proceed before the verification is considered successful. The default - value is 1. </item> - <item><em>ssl_server_keyfile</em> - which is a path to a file containing a - PEM encoded key for the Orber domain as server.</item> - <item><em>ssl_server_password</em> - only used if the private keyfile is - password protected.</item> - <item><em>ssl_server_ciphers</em> - which is string of ciphers as a colon - separated list of ciphers.</item> - <item><em>ssl_server_cachetimeout</em> - which is the session cache timeout - in seconds.</item> + <item><em>ssl_server_options</em> - which is a list of options to ssl. + See the <seealso marker="ssl:ssl">SSL</seealso> application for further + descriptions on these options.</item> </list> - <p>There also exist a number of API functions for accessing the values of these variables:</p> + <p>There also exist an API function for accessing the value of this variable:</p> <list type="bulleted"> - <item>orber:ssl_server_certfile/0</item> - <item>orber:ssl_server_cacertfile/0</item> - <item>orber:ssl_server_verify/0</item> - <item>orber:ssl_server_depth/0</item> - <item>orber:ssl_server_keyfile/0</item> - <item>orber:ssl_server_password/0</item> - <item>orber:ssl_server_ciphers/0</item> - <item>orber:ssl_server_cachetimeout/0</item> + <item>orber:ssl_server_options/0</item> </list> </section> @@ -97,50 +72,22 @@ <p>When the Orber enabled application is the client side in the secure connection the different configurations can be set per client process instead and not for the whole domain as for incoming calls.</p> - <p>One can use configuration variables to set default values for the domain but they can be changed - per client process. Below is the list of client configuration variables.</p> + <p>There is a variable to set default values for the domain but they can be changed + per client process.</p> <list type="bulleted"> - <item><em>ssl_client_certfile</em> - which is a path to a file containing a - chain of PEM encoded certificates used in outgoing calls in the current - process.</item> - <item><em>ssl_client_cacertfile</em> - which is a path to a file containing a - chain of PEM encoded CA certificates used in outgoing calls in the - current process.</item> - <item><em>ssl_client_verify</em> - which specifies type of verification: - 0 = do not verify peer; 1 = verify peer, verify client once, - 2 = verify peer, verify client once, fail if no peer certificate. - The default value is 0.</item> - <item><em>ssl_client_depth</em> - which specifies verification depth, i.e. - how far in a chain of certificates the verification process shall proceed - before the verification is considered successful. The default value is 1. </item> - <item><em>ssl_client_keyfile</em> - which is a path to a file containing a - PEM encoded key when Orber act as client side ORB.</item> - <item><em>ssl_client_password</em> - only used if the private keyfile is - password protected.</item> - <item><em>ssl_client_ciphers</em> - which is string of ciphers as a colon - separated list of ciphers.</item> - <item><em>ssl_client_cachetimeout</em> - which is the session cache timeout - in seconds.</item> + <item><em>ssl_client_options</em> - which is a list of options to ssl. + See the <seealso marker="ssl:ssl">SSL</seealso> application for further + descriptions on these options.</item> </list> - <p>There also exist a number of API functions for accessing and changing the values of this - variables in the client processes.</p> - <p>Access functions:</p> + <p>There also exist two API functions for accessing and changing the values of this + variable in the client processes.</p> + <p>Access function:</p> <list type="bulleted"> - <item>orber:ssl_client_certfile/0</item> - <item>orber:ssl_client_cacertfile/0</item> - <item>orber:ssl_client_verify/0</item> - <item>orber:ssl_client_depth/0</item> - <item>orber:ssl_client_keyfile/0</item> - <item>orber:ssl_client_password/0</item> - <item>orber:ssl_client_ciphers/0</item> - <item>orber:ssl_client_cachetimeout/0</item> + <item>orber:ssl_client_options/0</item> </list> - <p>Modify functions:</p> + <p>Modify function:</p> <list type="bulleted"> - <item>orber:set_ssl_client_certfile/1</item> - <item>orber:set_ssl_client_cacertfile/1</item> - <item>orber:set_ssl_client_verify/1</item> - <item>orber:set_ssl_client_depth/1</item> + <item>orber:set_ssl_client_options/1</item> </list> </section> </section> diff --git a/lib/orber/doc/src/corba.xml b/lib/orber/doc/src/corba.xml index cae0e09b0b..08ec555f94 100644 --- a/lib/orber/doc/src/corba.xml +++ b/lib/orber/doc/src/corba.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -221,8 +221,7 @@ Example: <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>Object = #objref</v> </type> @@ -287,8 +286,7 @@ Example: <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>Object = #objref</v> </type> @@ -319,8 +317,7 @@ Example: <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>ObjectId = string()</v> </type> @@ -360,8 +357,7 @@ Example: <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>Object = #objref</v> </type> diff --git a/lib/orber/doc/src/corba_object.xml b/lib/orber/doc/src/corba_object.xml index e0f9a9f503..ef440f1a2d 100644 --- a/lib/orber/doc/src/corba_object.xml +++ b/lib/orber/doc/src/corba_object.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> @@ -75,8 +75,7 @@ <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>Return = boolean() | {'EXCEPTION', E}</v> </type> @@ -117,8 +116,7 @@ <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>Return = boolean() | {'EXCEPTION', E}</v> </type> @@ -149,8 +147,7 @@ <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v> <v>Interface = string()</v> <v>Options = [{Key, Value}]</v> - <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile | - ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v> + <v>Key = ssl_client_options</v> <v>Value = allowed value associated with the given key</v> <v>Return = boolean() | {'EXCEPTION', E}</v> </type> diff --git a/lib/orber/doc/src/orber.xml b/lib/orber/doc/src/orber.xml index 5e38e4cf9f..35e9f57008 100644 --- a/lib/orber/doc/src/orber.xml +++ b/lib/orber/doc/src/orber.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -356,7 +356,7 @@ <v>Type = normal | ssl</v> <v>Port = integer() > 0</v> <v>ConfigurationParameters = [{Key, Value}]</v> - <v>Key = flags | iiop_in_connection_timeout | iiop_max_fragments | iiop_max_in_requests | interceptors | iiop_port | iiop_ssl_port</v> + <v>Key = flags | iiop_in_connection_timeout | iiop_max_fragments | iiop_max_in_requests | interceptors | iiop_port | iiop_ssl_port | ssl_server_options</v> <v>Value = as described in the User's Guide</v> <v>Result = {ok, Ref} | {error, Reason} | {'EXCEPTION', #'BAD_PARAM'{}}</v> <v>Ref = #Ref</v> @@ -378,7 +378,7 @@ counterparts (See the <seealso marker="ch_install#config">Configuration</seealso> chapter in the User's Guide). - But the following parameters there are a few restrictions:</p> + But for the following parameters there are a few restrictions:</p> <list type="bulleted"> <item><em>flags</em> - currently it is only possible to override the global setting for the <c>Use Current Interface in IOR</c> and @@ -450,92 +450,32 @@ </desc> </func> <func> - <name>ssl_server_certfile() -> string()</name> - <fsummary>Display the path to the server certificate</fsummary> + <name>ssl_server_options() -> list()</name> + <fsummary>Display the SSL server options</fsummary> <desc> - <p>This function returns a path to a file containing a chain of PEM encoded - certificates for the Orber domain as server. + <p>This function returns the list of SSL options set for the Orber domain as server. This is configured by setting the application variable - <em>ssl_server_certfile</em>.</p> + <em>ssl_server_options</em>.</p> </desc> </func> <func> - <name>ssl_client_certfile() -> string()</name> - <fsummary>Display the path to the client certificate</fsummary> + <name>ssl_client_options() -> list()</name> + <fsummary>Display the SSL client options</fsummary> <desc> - <p>This function returns a path to a file containing a chain of PEM encoded - certificates used in outgoing calls in the current process. + <p>This function returns the list of SSL options used in outgoing calls in the current process. The default value is configured by setting the application variable - <em>ssl_client_certfile</em>.</p> + <em>ssl_client_options</em>.</p> </desc> </func> <func> - <name>set_ssl_client_certfile(Path) -> ok</name> - <fsummary>Set the value of the client certificate</fsummary> + <name>set_ssl_client_options(Options) -> ok</name> + <fsummary>Set the SSL options for the client</fsummary> <type> - <v>Path = string()</v> + <v>Options = list()</v> </type> <desc> - <p>This function takes a path to a file containing a chain of PEM encoded - certificates as parameter and sets it for the current process.</p> - </desc> - </func> - <func> - <name>ssl_server_verify() -> 0 | 1 | 2</name> - <fsummary>Display the SSL verification type for incoming calls</fsummary> - <desc> - <p>This function returns the type of verification used by SSL during authentication of the other - peer for incoming calls. - It is configured by setting the application variable - <em>ssl_server_verify</em>.</p> - </desc> - </func> - <func> - <name>ssl_client_verify() -> 0 | 1 | 2</name> - <fsummary>Display the SSL verification type for outgoing calls</fsummary> - <desc> - <p>This function returns the type of verification used by SSL during authentication of the other - peer for outgoing calls. - The default value is configured by setting the application variable - <em>ssl_client_verify</em>.</p> - </desc> - </func> - <func> - <name>set_ssl_client_verify(Value) -> ok</name> - <fsummary>Set the value of the SSL verification type for outgoing calls</fsummary> - <type> - <v>Value = 0 | 1 | 2</v> - </type> - <desc> - <p>This function sets the SSL verification type for the other peer of outgoing calls.</p> - </desc> - </func> - <func> - <name>ssl_server_depth() -> int()</name> - <fsummary>Display the SSL verification depth for incoming calls</fsummary> - <desc> - <p>This function returns the SSL verification depth for incoming calls. - It is configured by setting the application variable - <em>ssl_server_depth</em>.</p> - </desc> - </func> - <func> - <name>ssl_client_depth() -> int()</name> - <fsummary>Display the SSL verification depth for outgoing calls</fsummary> - <desc> - <p>This function returns the SSL verification depth for outgoing calls. - The default value is configured by setting the application variable - <em>ssl_client_depth</em>.</p> - </desc> - </func> - <func> - <name>set_ssl_client_depth(Depth) -> ok</name> - <fsummary>Sets the value of the SSL verification depth for outgoing calls</fsummary> - <type> - <v>Depth = int()</v> - </type> - <desc> - <p>This function sets the SSL verification depth for the other peer of outgoing calls.</p> + <p>This function takes a list of SSL options as parameter and sets + it for the current process.</p> </desc> </func> <func> diff --git a/lib/orber/src/orber.erl b/lib/orber/src/orber.erl index 386c07d227..5ab240e046 100644 --- a/lib/orber/src/orber.erl +++ b/lib/orber/src/orber.erl @@ -36,6 +36,7 @@ -export([start/0, start/1, stop/0, install/1, install/2, orber_nodes/0, iiop_port/0, domain/0, iiop_ssl_port/0, iiop_out_ports/0, iiop_out_ports_random/0, iiop_out_ports_attempts/0, + ssl_server_options/0, ssl_client_options/0, set_ssl_client_options/1, ssl_server_certfile/0, ssl_client_certfile/0, set_ssl_client_certfile/1, ssl_server_verify/0, ssl_client_verify/0, set_ssl_client_verify/1, ssl_server_depth/0, ssl_client_depth/0, set_ssl_client_depth/1, @@ -524,6 +525,15 @@ iiop_ssl_port() -> nat_iiop_ssl_port() -> orber_env:nat_iiop_ssl_port(). +ssl_server_options() -> + orber_env:ssl_server_options(). + +ssl_client_options() -> + orber_env:ssl_client_options(). + +set_ssl_client_options(Value) -> + orber_env:set_ssl_client_options(Value). + ssl_server_certfile() -> orber_env:ssl_server_certfile(). diff --git a/lib/orber/src/orber_env.erl b/lib/orber/src/orber_env.erl index d80edb4ee0..b96c4ea7de 100644 --- a/lib/orber/src/orber_env.erl +++ b/lib/orber/src/orber_env.erl @@ -20,7 +20,7 @@ %% %%----------------------------------------------------------------- %% File: orber_env.erl -%% +%% %% Description: %% Handling environment parameters for Orber. %% @@ -49,20 +49,22 @@ iiop_max_in_connections/0, iiop_backlog/0, objectkeys_gc_time/0, get_ORBInitRef/0, get_ORBDefaultInitRef/0, get_interceptors/0, get_local_interceptors/0, get_cached_interceptors/0, - set_interceptors/1, is_lightweight/0, get_lightweight_nodes/0, secure/0, + set_interceptors/1, is_lightweight/0, get_lightweight_nodes/0, secure/0, iiop_ssl_backlog/0, iiop_ssl_port/0, nat_iiop_ssl_port/0, nat_iiop_ssl_port/1, + ssl_server_options/0, ssl_client_options/0, set_ssl_client_options/1, ssl_server_certfile/0, ssl_client_certfile/0, set_ssl_client_certfile/1, ssl_server_verify/0, ssl_client_verify/0, set_ssl_client_verify/1, ssl_server_depth/0, ssl_client_depth/0, set_ssl_client_depth/1, - ssl_server_cacertfile/0, ssl_client_cacertfile/0, + ssl_server_cacertfile/0, ssl_client_cacertfile/0, set_ssl_client_cacertfile/1, ssl_client_password/0, ssl_server_password/0, ssl_client_keyfile/0, ssl_server_keyfile/0, ssl_client_ciphers/0, ssl_server_ciphers/0, ssl_client_cachetimeout/0, - ssl_server_cachetimeout/0, get_flags/0, typechecking/0, + ssl_server_cachetimeout/0, + get_flags/0, typechecking/0, exclude_codeset_ctx/0, exclude_codeset_component/0, partial_security/0, use_CSIv2/0, use_FT/0, ip_version/0, light_ifr/0, bidir_context/0, get_debug_level/0, getaddrstr/2, addr2str/1, iiop_packet_size/0, - iiop_ssl_ip_address_local/0, ip_address_local/0, iiop_in_keepalive/0, + iiop_ssl_ip_address_local/0, ip_address_local/0, iiop_in_keepalive/0, iiop_out_keepalive/0, iiop_ssl_in_keepalive/0, iiop_ssl_out_keepalive/0, iiop_ssl_accept_timeout/0, ssl_generation/0]). @@ -87,38 +89,39 @@ [flags, iiop_port, nat_iiop_port, iiop_out_ports, domain, ip_address, nat_ip_address, giop_version, iiop_timeout, iiop_connection_timeout, iiop_setup_connection_timeout, iiop_in_connection_timeout, iiop_acl, - iiop_max_fragments, iiop_max_in_requests, iiop_max_in_connections, + iiop_max_fragments, iiop_max_in_requests, iiop_max_in_connections, iiop_backlog, objectkeys_gc_time, orbInitRef, orbDefaultInitRef, interceptors, local_interceptors, lightweight, ip_address_local, - secure, iiop_ssl_ip_address_local, iiop_ssl_backlog, - iiop_ssl_port, nat_iiop_ssl_port, ssl_server_certfile, - ssl_client_certfile, ssl_server_verify, ssl_client_verify, ssl_server_depth, - ssl_client_depth, ssl_server_cacertfile, ssl_client_cacertfile, - ssl_client_password, ssl_server_password, ssl_client_keyfile, - ssl_server_keyfile, ssl_client_ciphers, ssl_server_ciphers, + secure, iiop_ssl_ip_address_local, iiop_ssl_backlog, + iiop_ssl_port, nat_iiop_ssl_port, ssl_server_certfile, + ssl_client_certfile, ssl_server_verify, ssl_client_verify, ssl_server_depth, + ssl_client_depth, ssl_server_cacertfile, ssl_client_cacertfile, + ssl_client_password, ssl_server_password, ssl_client_keyfile, + ssl_server_keyfile, ssl_client_ciphers, ssl_server_ciphers, ssl_client_cachetimeout, ssl_server_cachetimeout, orber_debug_level, iiop_packet_size, iiop_in_keepalive, iiop_out_keepalive, - iiop_ssl_in_keepalive, iiop_ssl_out_keepalive, iiop_ssl_accept_timeout]). + iiop_ssl_in_keepalive, iiop_ssl_out_keepalive, iiop_ssl_accept_timeout, + ssl_server_options, ssl_client_options]). %% The 'flags' parameter must be first in the list. %-define(ENV_KEYS, -% [{flags, ?ORB_ENV_INIT_FLAGS}, {iiop_port, 4001}, nat_iiop_port, -% {iiop_out_ports, 0}, {domain, "ORBER"}, ip_address, nat_ip_address, -% {giop_version, {1, 1}}, {iiop_timeout, infinity}, -% {iiop_connection_timeout, infinity}, {iiop_setup_connection_timeout, infinity}, +% [{flags, ?ORB_ENV_INIT_FLAGS}, {iiop_port, 4001}, nat_iiop_port, +% {iiop_out_ports, 0}, {domain, "ORBER"}, ip_address, nat_ip_address, +% {giop_version, {1, 1}}, {iiop_timeout, infinity}, +% {iiop_connection_timeout, infinity}, {iiop_setup_connection_timeout, infinity}, % {iiop_in_connection_timeout, infinity}, {iiop_acl, []}, -% {iiop_max_fragments, infinity}, {iiop_max_in_requests, infinity}, -% {iiop_max_in_connections, infinity}, {iiop_backlog, 5}, -% {objectkeys_gc_time, infinity}, +% {iiop_max_fragments, infinity}, {iiop_max_in_requests, infinity}, +% {iiop_max_in_connections, infinity}, {iiop_backlog, 5}, +% {objectkeys_gc_time, infinity}, % {orbInitRef, undefined}, {orbDefaultInitRef, undefined}, % {interceptors, false}, {local_interceptors, false}, {lightweight, false}, -% {secure, no}, {iiop_ssl_backlog, 5}, {iiop_ssl_port, 4002}, +% {secure, no}, {iiop_ssl_backlog, 5}, {iiop_ssl_port, 4002}, % nat_iiop_ssl_port, {ssl_server_certfile, []}, {ssl_client_certfile, []}, -% {ssl_server_verify, 0}, {ssl_client_verify, 0}, {ssl_server_depth, 1}, -% {ssl_client_depth, 1}, {ssl_server_cacertfile, []}, +% {ssl_server_verify, 0}, {ssl_client_verify, 0}, {ssl_server_depth, 1}, +% {ssl_client_depth, 1}, {ssl_server_cacertfile, []}, % {ssl_client_cacertfile, []}, {ssl_client_password, []}, -% {ssl_server_password, []}, {ssl_client_keyfile, []}, -% {ssl_server_keyfile, []}, {ssl_client_ciphers, []}, +% {ssl_server_password, []}, {ssl_client_keyfile, []}, +% {ssl_server_keyfile, []}, {ssl_client_ciphers, []}, % {ssl_server_ciphers, []}, {ssl_client_cachetimeout, infinity}, % {ssl_server_cachetimeout, infinity}, {orber_debug_level, 0}]). @@ -129,33 +132,33 @@ %%----------------------------------------------------------------- %% External functions -%%----------------------------------------------------------------- %%----------------------------------------------------------------- -%% function : -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%%----------------------------------------------------------------- +%% function : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- start(Opts) -> gen_server:start_link({local, orber_env}, ?MODULE, Opts, []). %%----------------------------------------------------------------- %% function : get_keys -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- get_keys() -> ?ENV_KEYS. %%----------------------------------------------------------------- %% function : get_env -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- get_env(Key) when is_atom(Key) -> case catch ets:lookup(?ENV_DB, Key) of @@ -164,13 +167,13 @@ get_env(Key) when is_atom(Key) -> _ -> undefined end. - + %%----------------------------------------------------------------- %% function : get_env -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- set_env(Key, Value) when is_atom(Key) -> case catch ets:insert(?ENV_DB, #parameters{key = Key, value = Value}) of @@ -179,20 +182,20 @@ set_env(Key, Value) when is_atom(Key) -> _ -> undefined end. - + %%----------------------------------------------------------------- %% function : info %% Arguments: IoDervice - info_msg | string | io | {io, Dev} -%% Returns : -%% Exception: -%% Effect : +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- info() -> info(info_msg). info(IoDevice) -> - Info = + Info = case orber_tb:is_running() of true -> Info1 = create_main_info(), @@ -211,7 +214,7 @@ info(IoDevice) -> string -> Info; io -> - io:format("~s", [Info]); + io:format("~s", [Info]); {io, Dev} -> io:format(Dev, "~s", [Info]); _ -> @@ -220,14 +223,14 @@ info(IoDevice) -> create_main_info() -> {Major, Minor} = giop_version(), - [io_lib:format("======= Orber Execution Environment ======~n" + [io_lib:format("======= Orber Execution Environment ======~n" "Orber version.................: ~s~n" "Orber domain..................: ~s~n" "IIOP port number..............: ~p~n" "IIOP NAT port number..........: ~p~n" "Interface(s)..................: ~p~n" "Interface(s) NAT..............: ~p~n" - "Local Interface (default).....: ~p~n" + "Local Interface (default).....: ~p~n" "Nodes in domain...............: ~p~n" "GIOP version (default)........: ~p.~p~n" "IIOP out timeout..............: ~p msec~n" @@ -254,18 +257,18 @@ create_main_info() -> "Debug Level...................: ~p~n" "orbInitRef....................: ~p~n" "orbDefaultInitRef.............: ~p~n", - [?ORBVSN, domain(), iiop_port(), nat_iiop_port(), host(), + [?ORBVSN, domain(), iiop_port(), nat_iiop_port(), host(), nat_host(), ip_address_local(), orber:orber_nodes(), Major, Minor, - iiop_timeout(), iiop_connection_timeout(), + iiop_timeout(), iiop_connection_timeout(), iiop_setup_connection_timeout(), iiop_out_ports(), iiop_out_ports_attempts(), iiop_out_ports_random(), - orber:iiop_connections(out), orber:iiop_connections_pending(), - iiop_out_keepalive(), orber:iiop_connections(in), - iiop_in_connection_timeout(), iiop_in_keepalive(), - iiop_max_fragments(), iiop_max_in_requests(), + orber:iiop_connections(out), orber:iiop_connections_pending(), + iiop_out_keepalive(), orber:iiop_connections(in), + iiop_in_connection_timeout(), iiop_in_keepalive(), + iiop_max_fragments(), iiop_max_in_requests(), iiop_max_in_connections(), iiop_backlog(), iiop_acl(), - iiop_packet_size(), objectkeys_gc_time(), get_interceptors(), + iiop_packet_size(), objectkeys_gc_time(), get_interceptors(), get_local_interceptors(), get_debug_level(), get_ORBInitRef(), get_ORBDefaultInitRef()])]. @@ -277,7 +280,7 @@ create_flag_info(Info) -> FlagData = check_flags(?ORB_ENV_FLAGS, Flags, []), [Info, "System Flags Set..............: \n", FlagData, "\n"] end. - + check_flags([], _, Acc) -> Acc; check_flags([{Flag, Txt}|T], Flags, Acc) when ?ORB_FLAG_TEST(Flags, Flag) -> @@ -289,7 +292,7 @@ check_flags([_|T], Flags, Acc) -> create_security_info(no, Info) -> lists:flatten([Info, "=========================================\n"]); create_security_info(ssl, Info) -> - lists:flatten([Info, + lists:flatten([Info, io_lib:format("ORB security..................: ssl~n" "SSL generation................: ~p~n" "SSL IIOP in keepalive.........: ~p~n" @@ -316,26 +319,26 @@ create_security_info(ssl, Info) -> "SSL client ciphers............: ~p~n" "SSL client cachetimeout.......: ~p~n" "=========================================~n", - [ssl_generation(), iiop_ssl_port(), + [ssl_generation(), iiop_ssl_port(), iiop_ssl_in_keepalive(), iiop_ssl_out_keepalive(), - nat_iiop_ssl_port(), iiop_ssl_accept_timeout(), + nat_iiop_ssl_port(), iiop_ssl_accept_timeout(), iiop_ssl_backlog(), iiop_ssl_ip_address_local(), ssl_server_certfile(), ssl_server_verify(), - ssl_server_depth(), ssl_server_cacertfile(), - ssl_server_keyfile(), ssl_server_password(), + ssl_server_depth(), ssl_server_cacertfile(), + ssl_server_keyfile(), ssl_server_password(), ssl_server_ciphers(), ssl_server_cachetimeout(), - ssl_client_certfile(), ssl_client_verify(), - ssl_client_depth(), ssl_client_cacertfile(), + ssl_client_certfile(), ssl_client_verify(), + ssl_client_depth(), ssl_client_cacertfile(), ssl_client_keyfile(), ssl_client_password(), ssl_client_ciphers(), ssl_client_cachetimeout()])]). %%----------------------------------------------------------------- %% function : iiop_acl -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- iiop_acl() -> case application:get_env(orber, iiop_acl) of @@ -352,7 +355,7 @@ iiop_packet_size() -> _ -> infinity end. - + iiop_port() -> case application:get_env(orber, iiop_port) of @@ -368,7 +371,7 @@ nat_iiop_port() -> Port; {ok, {local, Default, _NATList}} -> Default; - _ -> + _ -> iiop_port() end. @@ -378,7 +381,7 @@ nat_iiop_port(LocalPort) -> Port; {ok, {local, Default, NATList}} -> orber_tb:keysearch(LocalPort, NATList, Default); - _ -> + _ -> iiop_port() end. @@ -407,9 +410,9 @@ iiop_out_ports_attempts() -> _ -> 1 end. - -domain() -> + +domain() -> case application:get_env(orber, domain) of {ok, Domain} when is_list(Domain) -> Domain; @@ -449,7 +452,7 @@ nat_host([Host]) -> {ok,{multiple, [I|_] = IList}} when is_list(I) -> IList; {ok,{local, Default, NATList}} -> - [orber_tb:keysearch(Host, NATList, Default)]; + [orber_tb:keysearch(Host, NATList, Default)]; _ -> host() end. @@ -462,7 +465,7 @@ host() -> {ok,{multiple, [I|_] = IList}} when is_list(I) -> IList; %% IPv4. For IPv6 we only accept a string, but we must support this format - %% for IPv4 + %% for IPv4 {ok, {A1, A2, A3, A4}} when is_integer(A1+A2+A3+A4) -> [integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3) ++ "." ++ integer_to_list(A4)]; @@ -489,7 +492,7 @@ ip_address_local() -> _ -> [] end. - + ip_address() -> ip_address(ip_version()). @@ -526,7 +529,7 @@ addr2str({A1, A2, A3, A4, A5, A6, A7, A8}) -> int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++ int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++ int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8). - + int16_to_hex(0) -> [$0]; @@ -613,7 +616,7 @@ iiop_max_fragments() -> _ -> infinity end. - + iiop_max_in_requests() -> case application:get_env(orber, iiop_max_in_requests) of {ok, Max} when is_integer(Max) andalso Max > 0 -> @@ -653,7 +656,7 @@ iiop_out_keepalive() -> _ -> false end. - + get_flags() -> @@ -706,9 +709,9 @@ bidir_context() -> ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_BI_DIR_IIOP) -> [#'IOP_ServiceContext' {context_id=?IOP_BI_DIR_IIOP, - context_data = - #'IIOP_BiDirIIOPServiceContext'{listen_points = - [#'IIOP_ListenPoint'{host=host(), + context_data = + #'IIOP_BiDirIIOPServiceContext'{listen_points = + [#'IIOP_ListenPoint'{host=host(), port=iiop_port()}]}}]; true -> [] @@ -819,7 +822,7 @@ get_lightweight_nodes() -> _ -> false end. - + %%----------------------------------------------------------------- %% Security access operations (SSL) @@ -838,8 +841,8 @@ ssl_generation() -> V; _ -> 2 - end. - + end. + iiop_ssl_ip_address_local() -> case application:get_env(orber, iiop_ssl_ip_address_local) of {ok,I} when is_list(I) -> @@ -876,10 +879,10 @@ iiop_ssl_accept_timeout() -> case application:get_env(orber, iiop_ssl_accept_timeout) of {ok, N} when is_integer(N) -> N * 1000; - _ -> + _ -> infinity end. - + iiop_ssl_port() -> case application:get_env(orber, secure) of {ok, ssl} -> @@ -923,6 +926,52 @@ nat_iiop_ssl_port(LocalPort) -> -1 end. +ssl_server_options() -> + case application:get_env(orber, ssl_server_options) of + {ok, V1} when is_list(V1) -> + V1; + _ -> + [] + end. + +ssl_client_options() -> + case application:get_env(orber, ssl_client_options) of + {ok, V1} when is_list(V1) -> + V1; + _ -> + [] + end. + +check_ssl_opts(Value) -> + check_ssl_opts(Value, []). +check_ssl_opts([], []) -> + ok; +check_ssl_opts([], Acc) -> + {error, Acc}; +check_ssl_opts([{active, _} |T], Acc) -> + check_ssl_opts(T, [active |Acc]); +check_ssl_opts([{packet, _} |T], Acc) -> + check_ssl_opts(T, [packet |Acc]); +check_ssl_opts([{mode, _} |T], Acc) -> + check_ssl_opts(T, [mode |Acc]); +check_ssl_opts([list |T], Acc) -> + check_ssl_opts(T, [list |Acc]); +check_ssl_opts([binary |T], Acc) -> + check_ssl_opts(T, [binary |Acc]); +check_ssl_opts([_ |T], Acc) -> + check_ssl_opts(T, Acc). + +set_ssl_client_options(Value) when is_list(Value) -> + case check_ssl_opts(Value) of + ok -> + ok; + {error, List} -> + exit(lists:flatten( + io_lib:format("TCP options ~p is not allowed in set_ssl_client_options()", + [List]))) + end, + put(ssl_client_options, Value), ok. + ssl_server_certfile() -> case application:get_env(orber, ssl_server_certfile) of {ok, V1} when is_list(V1) -> @@ -932,7 +981,7 @@ ssl_server_certfile() -> _ -> [] end. - + ssl_client_certfile() -> case get(ssl_client_certfile) of undefined -> @@ -950,7 +999,7 @@ ssl_client_certfile() -> set_ssl_client_certfile(Value) when is_list(Value) -> put(ssl_client_certfile, Value). - + ssl_server_verify() -> Verify = case application:get_env(orber, ssl_server_verify) of {ok, V} when is_integer(V) -> @@ -964,7 +1013,7 @@ ssl_server_verify() -> true -> 0 end. - + ssl_client_verify() -> Verify = case get(ssl_client_verify) of undefined -> @@ -986,7 +1035,7 @@ ssl_client_verify() -> set_ssl_client_verify(Value) when is_integer(Value) andalso Value =< 2 andalso Value >= 0 -> put(ssl_client_verify, Value), ok. - + ssl_server_depth() -> case application:get_env(orber, ssl_server_depth) of {ok, V1} when is_integer(V1) -> @@ -994,7 +1043,7 @@ ssl_server_depth() -> _ -> 1 end. - + ssl_client_depth() -> case get(ssl_client_depth) of undefined -> @@ -1010,7 +1059,7 @@ ssl_client_depth() -> set_ssl_client_depth(Value) when is_integer(Value) -> put(ssl_client_depth, Value), ok. - + ssl_server_cacertfile() -> @@ -1022,7 +1071,7 @@ ssl_server_cacertfile() -> _ -> [] end. - + ssl_client_cacertfile() -> case get(ssl_client_cacertfile) of undefined -> @@ -1040,7 +1089,7 @@ ssl_client_cacertfile() -> set_ssl_client_cacertfile(Value) when is_list(Value) -> put(ssl_client_cacertfile, Value), ok. - + ssl_client_password() -> case application:get_env(orber, ssl_client_password) of @@ -1108,10 +1157,10 @@ ssl_server_cachetimeout() -> %%----------------------------------------------------------------- %% function : configure -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- configure(Key, Value) when is_atom(Key) -> configure(Key, Value, check); @@ -1125,10 +1174,10 @@ configure_override(Key, _) -> %%----------------------------------------------------------------- %% function : multi_configure -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- multi_configure(KeyValueList) when is_list(KeyValueList) -> case orber_tb:is_loaded() of @@ -1144,7 +1193,7 @@ multi_configure(KeyValueList) when is_list(KeyValueList) -> end end; multi_configure(KeyValueList) -> - ?EFORMAT("Given configuration parameters not a Key-Value-pair list: ~p", + ?EFORMAT("Given configuration parameters not a Key-Value-pair list: ~p", [KeyValueList]). multi_configure_helper([], _) -> @@ -1237,7 +1286,7 @@ configure(iiop_port, Value, Status) when is_integer(Value) -> %% Set the NAT listen port configure(nat_iiop_port, Value, Status) when is_integer(Value) andalso Value > 0 -> do_safe_configure(nat_iiop_port, Value, Status); -configure(nat_iiop_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso +configure(nat_iiop_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso Value1 > 0 andalso is_list(Value2) -> do_safe_configure(nat_iiop_port, {local, Value1, Value2}, Status); @@ -1312,12 +1361,20 @@ configure(iiop_ssl_backlog, Value, Status) when is_integer(Value) andalso Value do_safe_configure(iiop_ssl_backlog, Value, Status); configure(nat_iiop_ssl_port, Value, Status) when is_integer(Value) andalso Value > 0 -> do_safe_configure(nat_iiop_ssl_port, Value, Status); -configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso +configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso Value1 > 0 andalso is_list(Value2) -> do_safe_configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status); configure(iiop_ssl_port, Value, Status) when is_integer(Value) -> do_safe_configure(iiop_ssl_port, Value, Status); + +%% New SSL options +configure(ssl_server_options, Value, Status) when is_list(Value) -> + do_safe_configure(ssl_server_options, Value, Status); +configure(ssl_client_options, Value, Status) when is_list(Value) -> + do_safe_configure(ssl_client_options, Value, Status); + +%% Old SSL options configure(ssl_server_certfile, Value, Status) when is_list(Value) -> do_safe_configure(ssl_server_certfile, Value, Status); configure(ssl_server_certfile, Value, Status) when is_atom(Value) -> @@ -1434,9 +1491,9 @@ code_change(_OldVsn, State, _Extra) -> %%----------------------------------------------------------------- %% function : env -%% Arguments: -%% Returns : -%% Exception: +%% Arguments: +%% Returns : +%% Exception: %% Effect : Used when Key always exists (Default Value) %%----------------------------------------------------------------- env(Key) -> @@ -1445,10 +1502,10 @@ env(Key) -> %%----------------------------------------------------------------- %% function : init_env -%% Arguments: -%% Returns : -%% Exception: -%% Effect : +%% Arguments: +%% Returns : +%% Exception: +%% Effect : %%----------------------------------------------------------------- init_env() -> application:load(orber), diff --git a/lib/orber/src/orber_iiop_net.erl b/lib/orber/src/orber_iiop_net.erl index 58eba9f039..55caa5dd33 100644 --- a/lib/orber/src/orber_iiop_net.erl +++ b/lib/orber/src/orber_iiop_net.erl @@ -161,31 +161,51 @@ terminate(_Reason, _State) -> %%----------------------------------------------------------------- get_options(normal, _Options) -> []; -get_options(ssl, Options) -> - Verify = orber_tb:keysearch(ssl_server_verify, Options, - orber_env:ssl_server_verify()), - Depth = orber_tb:keysearch(ssl_server_depth, Options, - orber_env:ssl_server_depth()), - Cert = orber_tb:keysearch(ssl_server_certfile, Options, - orber_env:ssl_server_certfile()), - CaCert = orber_tb:keysearch(ssl_server_cacertfile, Options, - orber_env:ssl_server_cacertfile()), - Pwd = orber_tb:keysearch(ssl_server_password, Options, - orber_env:ssl_server_password()), - Key = orber_tb:keysearch(ssl_server_keyfile, Options, - orber_env:ssl_server_keyfile()), - Ciphers = orber_tb:keysearch(ssl_server_ciphers, Options, - orber_env:ssl_server_ciphers()), - Timeout = orber_tb:keysearch(ssl_server_cachetimeout, Options, - orber_env:ssl_server_cachetimeout()), - [{verify, Verify}, - {depth, Depth} | - ssl_server_extra_options([{certfile, Cert}, - {cacertfile, CaCert}, - {password, Pwd}, - {keyfile, Key}, - {ciphers, Ciphers}, - {cachetimeout, Timeout}], [])]. +get_options(ssl, Options) -> + SSLOpts = + case orber_tb:keysearch(ssl_server_options, Options, + orber_env:ssl_server_options()) of + [] -> + Verify = orber_tb:keysearch(ssl_server_verify, Options, + orber_env:ssl_server_verify()), + Depth = orber_tb:keysearch(ssl_server_depth, Options, + orber_env:ssl_server_depth()), + Cert = orber_tb:keysearch(ssl_server_certfile, Options, + orber_env:ssl_server_certfile()), + CaCert = orber_tb:keysearch(ssl_server_cacertfile, Options, + orber_env:ssl_server_cacertfile()), + Pwd = orber_tb:keysearch(ssl_server_password, Options, + orber_env:ssl_server_password()), + Key = orber_tb:keysearch(ssl_server_keyfile, Options, + orber_env:ssl_server_keyfile()), + Ciphers = orber_tb:keysearch(ssl_server_ciphers, Options, + orber_env:ssl_server_ciphers()), + Timeout = orber_tb:keysearch(ssl_server_cachetimeout, Options, + orber_env:ssl_server_cachetimeout()), + KeepAlive = orber_tb:keysearch(ssl_server_cachetimeout, Options, + orber_env:iiop_ssl_in_keepalive()), + [{verify, Verify}, + {depth, Depth}, + {certfile, Cert}, + {cacertfile, CaCert}, + {password, Pwd}, + {keyfile, Key}, + {ciphers, Ciphers}, + {cachetimeout, Timeout}, + {keepalive, KeepAlive}]; + Opts -> + case orber_tb:check_illegal_tcp_options(Opts) of + ok -> + check_old_ssl_server_options(Options), + Opts; + {error, IllegalOpts} -> + error_logger:error_report([{application, orber}, + "TCP options not allowed to set on a connection", + IllegalOpts]), + error("Illegal TCP option") + end + end, + ssl_server_extra_options(SSLOpts, []). %%----------------------------------------------------------------- %% Func: parse_options/2 @@ -266,23 +286,28 @@ handle_call({add, IP, Type, Port, AllOptions}, _From, State) -> Family = orber_env:ip_version(), case inet:getaddr(IP, Family) of {ok, IPTuple} -> - Options = [{ip, IPTuple}|get_options(Type, AllOptions)], - Ref = make_ref(), - ProxyOptions = filter_options(AllOptions, []), - case orber_socket:listen(Type, Port, Options, false) of - {ok, Listen, NewPort} -> - {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, Ref, - ProxyOptions), - link(Pid), - ets:insert(?CONNECTION_DB, #listen{pid = Pid, - socket = Listen, - port = NewPort, - type = Type, ref = Ref, - options = Options, - proxy_options = ProxyOptions}), - {reply, {ok, Ref}, State}; - Error -> - {reply, Error, State} + try [{ip, IPTuple} |get_options(Type, AllOptions)] of + Options -> + Ref = make_ref(), + ProxyOptions = filter_options(AllOptions, []), + case orber_socket:listen(Type, Port, Options, false) of + {ok, Listen, NewPort} -> + {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, Ref, + ProxyOptions), + link(Pid), + ets:insert(?CONNECTION_DB, #listen{pid = Pid, + socket = Listen, + port = NewPort, + type = Type, ref = Ref, + options = Options, + proxy_options = ProxyOptions}), + {reply, {ok, Ref}, State}; + Error -> + {reply, Error, State} + end + catch + error:Reason -> + {reply, {error, Reason}, State} end; Other -> {reply, Other, State} @@ -461,3 +486,31 @@ update_counter(#state{max_connections = infinity} = State, _) -> update_counter(State, Value) -> State#state{counter = State#state.counter + Value}. + +check_old_ssl_server_options(Options) -> + try + 0 = orber_tb:keysearch(ssl_server_verify, Options, + orber_env:ssl_server_verify()), + 1 = orber_tb:keysearch(ssl_server_depth, Options, + orber_env:ssl_server_depth()), + [] = orber_tb:keysearch(ssl_server_certfile, Options, + orber_env:ssl_server_certfile()), + [] = orber_tb:keysearch(ssl_server_cacertfile, Options, + orber_env:ssl_server_cacertfile()), + [] = orber_tb:keysearch(ssl_server_password, Options, + orber_env:ssl_server_password()), + [] = orber_tb:keysearch(ssl_server_keyfile, Options, + orber_env:ssl_server_keyfile()), + [] = orber_tb:keysearch(ssl_server_ciphers, Options, + orber_env:ssl_server_ciphers()), + infinity = orber_tb:keysearch(ssl_server_cachetimeout, Options, + orber_env:ssl_server_cachetimeout()), + false = orber_tb:keysearch(iiop_ssl_in_keepalive, Options, + orber_env:iiop_ssl_in_keepalive()) + catch + _:_ -> + io:format("hej\n",[]), + error_logger:warning_report([{application, orber}, + "Ignoring deprecated ssl server options used together with the ssl_server_options"]) + end. + diff --git a/lib/orber/src/orber_iiop_pm.erl b/lib/orber/src/orber_iiop_pm.erl index bf36b353bc..3c8c7a09f4 100644 --- a/lib/orber/src/orber_iiop_pm.erl +++ b/lib/orber/src/orber_iiop_pm.erl @@ -108,44 +108,82 @@ connect(Host, Port, SocketType, Timeout, Chars, Wchars, Ctx) end. get_ssl_socket_options([]) -> - [{verify, orber:ssl_client_verify()}, - {depth, orber:ssl_client_depth()} | - ssl_client_extra_options([{certfile, orber:ssl_client_certfile()}, - {cacertfile, orber:ssl_client_cacertfile()}, - {password, orber:ssl_client_password()}, - {keyfile, orber:ssl_client_keyfile()}, - {ciphers, orber:ssl_client_ciphers()}, - {cachetimeout, orber:ssl_client_cachetimeout()}], [])]; + SSLOpts = + case orber_env:ssl_client_options() of + [] -> + [{verify, orber_env:ssl_client_verify()}, + {depth, orber_env:ssl_client_depth()}, + {certfile, orber_env:ssl_client_certfile()}, + {cacertfile, orber_env:ssl_client_cacertfile()}, + {password, orber_env:ssl_client_password()}, + {keyfile, orber_env:ssl_client_keyfile()}, + {ciphers, orber_env:ssl_client_ciphers()}, + {cachetimeout, orber_env:ssl_client_cachetimeout()}, + {keepalive, orber_env:iiop_ssl_out_keepalive()}]; + Opts -> + case orber_tb:check_illegal_tcp_options(Opts) of + ok -> + check_old_ssl_client_options([]), + Opts; + {error, IllegalOpts} -> + error_logger:error_report([{application, orber}, + "TCP options not allowed to set on a connection", + IllegalOpts]), + error("Illegal TCP option") + end + end, + ssl_client_extra_options(SSLOpts, []); get_ssl_socket_options([#'IOP_ServiceContext' {context_id=?ORBER_GENERIC_CTX_ID, context_data = {configuration, Options}}|_]) -> - Verify = orber_tb:keysearch(ssl_client_verify, Options, - orber_env:ssl_client_verify()), - Depth = orber_tb:keysearch(ssl_client_depth, Options, - orber_env:ssl_client_depth()), - Cert = orber_tb:keysearch(ssl_client_certfile, Options, - orber_env:ssl_client_certfile()), - CaCert = orber_tb:keysearch(ssl_client_cacertfile, Options, - orber_env:ssl_client_cacertfile()), - Pwd = orber_tb:keysearch(ssl_client_password, Options, - orber_env:ssl_client_password()), - Key = orber_tb:keysearch(ssl_client_keyfile, Options, - orber_env:ssl_client_keyfile()), - Ciphers = orber_tb:keysearch(ssl_client_ciphers, Options, - orber_env:ssl_client_ciphers()), - Timeout = orber_tb:keysearch(ssl_client_cachetimeout, Options, - orber_env:ssl_client_cachetimeout()), - [{verify, Verify}, - {depth, Depth} | - ssl_client_extra_options([{certfile, Cert}, - {cacertfile, CaCert}, - {password, Pwd}, - {keyfile, Key}, - {ciphers, Ciphers}, - {cachetimeout, Timeout}], [])]; + SSLOpts = + case orber_tb:keysearch(ssl_client_options, Options, + orber_env:ssl_client_options()) of + [] -> + Verify = orber_tb:keysearch(ssl_client_verify, Options, + orber_env:ssl_client_verify()), + Depth = orber_tb:keysearch(ssl_client_depth, Options, + orber_env:ssl_client_depth()), + Cert = orber_tb:keysearch(ssl_client_certfile, Options, + orber_env:ssl_client_certfile()), + CaCert = orber_tb:keysearch(ssl_client_cacertfile, Options, + orber_env:ssl_client_cacertfile()), + Pwd = orber_tb:keysearch(ssl_client_password, Options, + orber_env:ssl_client_password()), + Key = orber_tb:keysearch(ssl_client_keyfile, Options, + orber_env:ssl_client_keyfile()), + Ciphers = orber_tb:keysearch(ssl_client_ciphers, Options, + orber_env:ssl_client_ciphers()), + Timeout = orber_tb:keysearch(ssl_client_cachetimeout, Options, + orber_env:ssl_client_cachetimeout()), + KeepAlive = orber_tb:keysearch(ssl_server_cachetimeout, Options, + orber_env:iiop_ssl_out_keepalive()), + [{verify, Verify}, + {depth, Depth}, + {certfile, Cert}, + {cacertfile, CaCert}, + {password, Pwd}, + {keyfile, Key}, + {ciphers, Ciphers}, + {cachetimeout, Timeout}, + {keepalive, KeepAlive}]; + Opts -> + case orber_tb:check_illegal_tcp_options(Opts) of + ok -> + check_old_ssl_client_options(Options), + Opts; + {error, IllegalOpts} -> + error_logger:error_report([{application, orber}, + "TCP options not allowed to set on a connection", + IllegalOpts]), + error("Illegal TCP option") + end + end, + ssl_client_extra_options(SSLOpts, []); get_ssl_socket_options([_|T]) -> get_ssl_socket_options(T). + ssl_client_extra_options([], Acc) -> Acc; ssl_client_extra_options([{_Type, []}|T], Acc) -> @@ -814,6 +852,36 @@ init_interceptors(Host, Port, {SHost, SPort}) -> %% Either 'false' or {Type, PIs}. Other end. + + +check_old_ssl_client_options(Options) -> + try + 0 = orber_tb:keysearch(ssl_client_verify, Options, + orber_env:ssl_client_verify()), + 1 = orber_tb:keysearch(ssl_client_depth, Options, + orber_env:ssl_client_depth()), + [] = orber_tb:keysearch(ssl_client_certfile, Options, + orber_env:ssl_client_certfile()), + [] = orber_tb:keysearch(ssl_client_cacertfile, Options, + orber_env:ssl_client_cacertfile()), + [] = orber_tb:keysearch(ssl_client_password, Options, + orber_env:ssl_client_password()), + [] = orber_tb:keysearch(ssl_client_keyfile, Options, + orber_env:ssl_client_keyfile()), + [] = orber_tb:keysearch(ssl_client_ciphers, Options, + orber_env:ssl_client_ciphers()), + infinity = orber_tb:keysearch(ssl_client_cachetimeout, Options, + orber_env:ssl_client_cachetimeout()), + false = orber_tb:keysearch(iiop_ssl_out_keepalive, Options, + orber_env:iiop_ssl_out_keepalive()) + + catch + _:_ -> + error_logger:warning_report([{application, orber}, + "Ignoring deprecated ssl client options used together with the ssl_client_options"]) + end. + + %%----------------------------------------------------------------- diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl index ec2cf8f42a..07a0e09ccc 100644 --- a/lib/orber/src/orber_socket.erl +++ b/lib/orber/src/orber_socket.erl @@ -14,8 +14,7 @@ %% 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% %% %% %%----------------------------------------------------------------- @@ -37,7 +36,7 @@ %%----------------------------------------------------------------- -export([start/0, connect/4, listen/3, listen/4, accept/2, accept/3, write/3, controlling_process/3, close/2, peername/2, sockname/2, - peerdata/2, peercert/2, sockdata/2, setopts/3, + peerdata/2, peercert/2, sockdata/2, setopts/3, clear/2, shutdown/3, post_accept/2, post_accept/3]). %%----------------------------------------------------------------- @@ -75,8 +74,6 @@ connect(Type, Host, Port, Options) -> case Type of normal -> [{keepalive, orber_env:iiop_out_keepalive()}|Options1]; - _ when Generation > 2 -> - [{keepalive, orber_env:iiop_ssl_out_keepalive()}|Options1]; _ -> Options1 end, @@ -251,8 +248,7 @@ listen(ssl, Port, Options, Exception) -> end, Options4 = if Generation > 2 -> - [{reuseaddr, true}, - {keepalive, orber_env:iiop_ssl_in_keepalive()}|Options3]; + [{reuseaddr, true} |Options3]; true -> Options3 end, @@ -362,8 +358,8 @@ peercert(ssl, Socket) -> ssl:peercert(Socket); peercert(Type, _Socket) -> orber:dbg("[~p] orber_socket:peercert(~p);~n" - "Only available for SSL sockets.", - [?LINE, Type], ?DEBUG_LEVEL), + "Only available for SSL sockets.", + [?LINE, Type], ?DEBUG_LEVEL), {error, ebadsocket}. %%----------------------------------------------------------------- diff --git a/lib/orber/src/orber_tb.erl b/lib/orber/src/orber_tb.erl index e6d5ee4400..cce95f7237 100644 --- a/lib/orber/src/orber_tb.erl +++ b/lib/orber/src/orber_tb.erl @@ -39,7 +39,8 @@ -compile({no_auto_import,[error/2]}). -export([wait_for_tables/1, wait_for_tables/2, wait_for_tables/3, is_loaded/0, is_loaded/1, is_running/0, is_running/1, - info/2, error/2, unique/1, keysearch/2, keysearch/3]). + info/2, error/2, unique/1, keysearch/2, keysearch/3, + check_illegal_tcp_options/1]). %%---------------------------------------------------------------------- %% Internal exports @@ -179,6 +180,38 @@ error(Format, Args) -> Args). + + + +%%---------------------------------------------------------------------- +%% function : check_illegal_tcp_options/1 +%% Arguments: +%% Returns : +%% Exception: +%% Effect : +%%---------------------------------------------------------------------- +check_illegal_tcp_options(Options) -> + check_illegal_tcp_options(Options, []). + +check_illegal_tcp_options([],[]) -> + ok; +check_illegal_tcp_options([],IllegalOpts) -> + {error, IllegalOpts}; +check_illegal_tcp_options([{active, V} |T], IllegalOpts) -> + check_illegal_tcp_options(T,[{active, V} |IllegalOpts]); +check_illegal_tcp_options([{packet, V} |T], IllegalOpts) -> + check_illegal_tcp_options(T,[{packet, V} |IllegalOpts]); +check_illegal_tcp_options([{mode, V} |T], IllegalOpts) -> + check_illegal_tcp_options(T,[{mode, V} |IllegalOpts]); +check_illegal_tcp_options([list |T], IllegalOpts) -> + check_illegal_tcp_options(T,[list |IllegalOpts]); +check_illegal_tcp_options([binary |T], IllegalOpts) -> + check_illegal_tcp_options(T,[binary |IllegalOpts]); +check_illegal_tcp_options([{reuseaddr, V} |T], IllegalOpts) -> + check_illegal_tcp_options(T,[{reuseaddr, V} |IllegalOpts]); +check_illegal_tcp_options([H|T], IllegalOpts) -> + check_illegal_tcp_options(T, IllegalOpts). + %%---------------------------------------------------------------------- %% Internal functions %%---------------------------------------------------------------------- diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index 996d0d1874..d4be009af3 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -176,6 +176,7 @@ clean: rm -f idl_output/* rm -f $(TARGET_FILES) rm -f errs core *~ + rm IDL-GENERATED docs: diff --git a/lib/orber/test/csiv2_SUITE.erl b/lib/orber/test/csiv2_SUITE.erl index 406a8ea693..60ffa1eb09 100644 --- a/lib/orber/test/csiv2_SUITE.erl +++ b/lib/orber/test/csiv2_SUITE.erl @@ -70,46 +70,46 @@ profiles = [#'IOP_TaggedProfile' {tag = ?TAG_INTERNET_IOP, - profile_data = + profile_data = #'IIOP_ProfileBody_1_1'{ iiop_version = #'IIOP_Version'{major = 1, minor = 2}, host = "127.0.0.1", port = 0, object_key = [0,86,66,1,0,0,0,24,47,70,77,65,95,67,73,82,80,77,65,78,95,80,79,65,95,83,69,67,85,82,69,0,0,0,0,4,0,0,4,186,0,0,2,10,81,218,65,185], - components = + components = [#'IOP_TaggedComponent'{tag = ?TAG_SSL_SEC_TRANS, component_data = #'SSLIOP_SSL'{ target_supports = 102, target_requires = 66, port = 49934}}, #'IOP_TaggedComponent'{tag = ?TAG_CSI_SEC_MECH_LIST, - component_data = + component_data = #'CSIIOP_CompoundSecMechList'{stateful = true, - mechanism_list = + mechanism_list = [#'CSIIOP_CompoundSecMech' {target_requires = 66, transport_mech = #'IOP_TaggedComponent'{ tag = ?TAG_TLS_SEC_TRANS, - component_data = + component_data = #'CSIIOP_TLS_SEC_TRANS'{ target_supports = 102, target_requires = 66, - addresses = + addresses = [#'CSIIOP_TransportAddress' {host_name = "127.0.0.1", port = 49934}]}}, - as_context_mech = + as_context_mech = #'CSIIOP_AS_ContextSec'{ target_supports = 0, target_requires = 0, client_authentication_mech = [], target_name = []}, - sas_context_mech = + sas_context_mech = #'CSIIOP_SAS_ContextSec'{ target_supports = 1024, target_requires = 0, - privilege_authorities = + privilege_authorities = [#'CSIIOP_ServiceConfiguration' {syntax = 1447174401, name = "Borland"}], @@ -124,7 +124,7 @@ supported_identity_types = 15}}]}}, #'IOP_TaggedComponent' {tag = ?TAG_CODE_SETS, - component_data = + component_data = #'CONV_FRAME_CodeSetComponentInfo'{'ForCharData' = #'CONV_FRAME_CodeSetComponent'{ native_code_set = 65537, @@ -151,15 +151,15 @@ -ifdef(false). %% PKIX1Explicit88 --define(AlgorithmIdentifier, +-define(AlgorithmIdentifier, #'AlgorithmIdentifier'{algorithm = ?OID, parameters = ?ANY}). -define(Validity, #'Validity'{notBefore = {utcTime, "19820102070533.8"}, notAfter = {generalTime, "19820102070533.8"}}). --define(SubjectPublicKeyInfo, - #'SubjectPublicKeyInfo'{algorithm = ?AlgorithmIdentifier, +-define(SubjectPublicKeyInfo, + #'SubjectPublicKeyInfo'{algorithm = ?AlgorithmIdentifier, subjectPublicKey = ?BIT_STR}). -define(AttributeTypeAndValue, @@ -178,26 +178,26 @@ -define(UniqueIdentifier, ?BIT_STR). --define(Extension, #'Extension'{extnID = ?OID, - critical = ?BOOLEAN, +-define(Extension, #'Extension'{extnID = ?OID, + critical = ?BOOLEAN, extnValue = ?OCTET_STR}). -define(Extensions, [?Extension]). -define(TBSCertificate, - #'TBSCertificate'{version = ?Version, - serialNumber = ?CertificateSerialNumber, - signature = ?AlgorithmIdentifier, - issuer = ?Name, - validity = ?Validity, - subject = ?Name, - subjectPublicKeyInfo = ?SubjectPublicKeyInfo, - issuerUniqueID = ?UniqueIdentifier, - subjectUniqueID = ?UniqueIdentifier, + #'TBSCertificate'{version = ?Version, + serialNumber = ?CertificateSerialNumber, + signature = ?AlgorithmIdentifier, + issuer = ?Name, + validity = ?Validity, + subject = ?Name, + subjectPublicKeyInfo = ?SubjectPublicKeyInfo, + issuerUniqueID = ?UniqueIdentifier, + subjectUniqueID = ?UniqueIdentifier, extensions = ?Extensions}). --define(Certificate, #'Certificate'{tbsCertificate = ?TBSCertificate, - signatureAlgorithm = ?AlgorithmIdentifier, +-define(Certificate, #'Certificate'{tbsCertificate = ?TBSCertificate, + signatureAlgorithm = ?AlgorithmIdentifier, signature = ?BIT_STR}). %% PKIX1Implicit88 @@ -206,66 +206,66 @@ -define(GeneralNames, [?GeneralName]). -%% PKIXAttributeCertificate --define(AttCertValidityPeriod, - #'AttCertValidityPeriod'{notBeforeTime = "19820102070533.8", +%% PKIXAttributeCertificate +-define(AttCertValidityPeriod, + #'AttCertValidityPeriod'{notBeforeTime = "19820102070533.8", notAfterTime = "19820102070533.8"}). --define(Attribute, #'Attribute'{type = ?OID, +-define(Attribute, #'Attribute'{type = ?OID, values = []}). -define(Attributes, [?Attribute]). --define(IssuerSerial, #'IssuerSerial'{issuer = ?GeneralNames, - serial = ?CertificateSerialNumber, +-define(IssuerSerial, #'IssuerSerial'{issuer = ?GeneralNames, + serial = ?CertificateSerialNumber, issuerUID = ?UniqueIdentifier}). -define(DigestedObjectType, publicKey). %% Enum --define(ObjectDigestInfo, - #'ObjectDigestInfo'{digestedObjectType = ?DigestedObjectType, - otherObjectTypeID = ?OID, - digestAlgorithm = ?AlgorithmIdentifier, +-define(ObjectDigestInfo, + #'ObjectDigestInfo'{digestedObjectType = ?DigestedObjectType, + otherObjectTypeID = ?OID, + digestAlgorithm = ?AlgorithmIdentifier, objectDigest = ?BIT_STR}). --define(V2Form, #'V2Form'{issuerName = ?GeneralNames, - baseCertificateID = ?IssuerSerial, +-define(V2Form, #'V2Form'{issuerName = ?GeneralNames, + baseCertificateID = ?IssuerSerial, objectDigestInfo = ?ObjectDigestInfo}). -define(AttCertVersion, v2). --define(Holder, #'Holder'{baseCertificateID = ?IssuerSerial, - entityName = ?GeneralNames, +-define(Holder, #'Holder'{baseCertificateID = ?IssuerSerial, + entityName = ?GeneralNames, objectDigestInfo = ?ObjectDigestInfo}). -define(AttCertIssuer, {v2Form, ?V2Form}). -define(AttributeCertificateInfo, - #'AttributeCertificateInfo'{version = ?AttCertVersion, - holder = ?Holder, - issuer = ?AttCertIssuer, - signature = ?AlgorithmIdentifier, - serialNumber = ?CertificateSerialNumber, + #'AttributeCertificateInfo'{version = ?AttCertVersion, + holder = ?Holder, + issuer = ?AttCertIssuer, + signature = ?AlgorithmIdentifier, + serialNumber = ?CertificateSerialNumber, attrCertValidityPeriod = ?AttCertValidityPeriod, - attributes = ?Attributes, - issuerUniqueID = ?UniqueIdentifier, + attributes = ?Attributes, + issuerUniqueID = ?UniqueIdentifier, extensions = ?Extensions}). --define(AttributeCertificate, - #'AttributeCertificate'{acinfo = ?AttributeCertificateInfo, - signatureAlgorithm = ?AlgorithmIdentifier, +-define(AttributeCertificate, + #'AttributeCertificate'{acinfo = ?AttributeCertificateInfo, + signatureAlgorithm = ?AlgorithmIdentifier, signatureValue = ?BIT_STR}). %% OrberCSIv2 --define(AttributeCertChain, - #'AttributeCertChain'{attributeCert = ?AttributeCertificate, +-define(AttributeCertChain, + #'AttributeCertChain'{attributeCert = ?AttributeCertificate, certificateChain = ?CertificateChain}). -define(CertificateChain, [?Certificate]). --define(VerifyingCertChain, [?Certificate]). +-define(VerifyingCertChain, [?Certificate]). -endif. @@ -314,15 +314,15 @@ %%----------------------------------------------------------------- %% Func: all/1 -%% Args: -%% Returns: +%% Args: +%% Returns: %%----------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> cases(). -groups() -> +groups() -> []. init_per_group(_GroupName, Config) -> @@ -335,7 +335,7 @@ end_per_group(_GroupName, Config) -> %% NOTE - the fragment test cases must bu first since we explicitly set a request %% id. Otherwise, the request-id counter would be increased and we cannot know %% what it is. -cases() -> +cases() -> [ssl_server_peercert_api, ssl_client_peercert_api]. %%----------------------------------------------------------------- @@ -361,14 +361,20 @@ end_per_testcase(_Case, Config) -> ok. init_per_suite(Config) -> - case orber_test_lib:ssl_version() of - no_ssl -> - {skip,"SSL is not installed!"}; - _ -> - Config + try crypto:start() of + ok -> + case orber_test_lib:ssl_version() of + no_ssl -> + {skip, "SSL is not installed!"}; + _ -> + Config + end + catch _:_ -> + {skip, "Crypto did not start"} end. end_per_suite(Config) -> + application:stop(crypto), Config. %%----------------------------------------------------------------- @@ -385,272 +391,272 @@ end_per_suite(Config) -> code_CertificateChain_api(doc) -> ["Code CertificateChain"]; code_CertificateChain_api(suite) -> []; code_CertificateChain_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('CertificateChain', ?CertificateChain)), - ?match({ok, [#'Certificate'{}]}, + ?match({ok, [#'Certificate'{}]}, 'OrberCSIv2':decode('CertificateChain', list_to_binary(Enc))), ok. code_AttributeCertChain_api(doc) -> ["Code AttributeCertChain"]; code_AttributeCertChain_api(suite) -> []; code_AttributeCertChain_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('AttributeCertChain', ?AttributeCertChain)), - ?match({ok, #'AttributeCertChain'{}}, - 'OrberCSIv2':decode('AttributeCertChain', list_to_binary(Enc))), + ?match({ok, #'AttributeCertChain'{}}, + 'OrberCSIv2':decode('AttributeCertChain', list_to_binary(Enc))), ok. code_VerifyingCertChain_api(doc) -> ["Code VerifyingCertChain"]; code_VerifyingCertChain_api(suite) -> []; code_VerifyingCertChain_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('VerifyingCertChain', ?VerifyingCertChain)), - ?match({ok, [#'Certificate'{}]}, - 'OrberCSIv2':decode('VerifyingCertChain', list_to_binary(Enc))), + ?match({ok, [#'Certificate'{}]}, + 'OrberCSIv2':decode('VerifyingCertChain', list_to_binary(Enc))), ok. %% PKIXAttributeCertificate code_AttributeCertificate_api(doc) -> ["Code AttributeCertificate"]; code_AttributeCertificate_api(suite) -> []; code_AttributeCertificate_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('AttributeCertificate', ?AttributeCertificate)), - ?match({ok, #'AttributeCertificate'{}}, - 'OrberCSIv2':decode('AttributeCertificate', list_to_binary(Enc))), + ?match({ok, #'AttributeCertificate'{}}, + 'OrberCSIv2':decode('AttributeCertificate', list_to_binary(Enc))), ok. code_AttributeCertificateInfo_api(doc) -> ["Code AttributeCertificateInfo"]; code_AttributeCertificateInfo_api(suite) -> []; code_AttributeCertificateInfo_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('AttributeCertificateInfo', ?AttributeCertificateInfo)), - ?match({ok, #'AttributeCertificateInfo'{}}, - 'OrberCSIv2':decode('AttributeCertificateInfo', list_to_binary(Enc))), + ?match({ok, #'AttributeCertificateInfo'{}}, + 'OrberCSIv2':decode('AttributeCertificateInfo', list_to_binary(Enc))), ok. code_AttCertVersion_api(doc) -> ["Code AttCertVersion"]; code_AttCertVersion_api(suite) -> []; code_AttCertVersion_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('AttCertVersion', ?AttCertVersion)), - ?match({ok, ?AttCertVersion}, - 'OrberCSIv2':decode('AttCertVersion', list_to_binary(Enc))), + ?match({ok, ?AttCertVersion}, + 'OrberCSIv2':decode('AttCertVersion', list_to_binary(Enc))), ok. code_Holder_api(doc) -> ["Code Holder"]; code_Holder_api(suite) -> []; code_Holder_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('Holder', ?Holder)), - ?match({ok, #'Holder'{}}, - 'OrberCSIv2':decode('Holder', list_to_binary(Enc))), + ?match({ok, #'Holder'{}}, + 'OrberCSIv2':decode('Holder', list_to_binary(Enc))), ok. code_AttCertIssuer_api(doc) -> ["Code AttCertIssuer"]; code_AttCertIssuer_api(suite) -> []; code_AttCertIssuer_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('AttCertIssuer', ?AttCertIssuer)), - ?match({ok, {v2Form, _}}, - 'OrberCSIv2':decode('AttCertIssuer', list_to_binary(Enc))), + ?match({ok, {v2Form, _}}, + 'OrberCSIv2':decode('AttCertIssuer', list_to_binary(Enc))), ok. code_AttCertValidityPeriod_api(doc) -> ["Code AttCertValidityPeriod"]; code_AttCertValidityPeriod_api(suite) -> []; code_AttCertValidityPeriod_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('AttCertValidityPeriod', ?AttCertValidityPeriod)), - ?match({ok, #'AttCertValidityPeriod'{}}, - 'OrberCSIv2':decode('AttCertValidityPeriod', list_to_binary(Enc))), + ?match({ok, #'AttCertValidityPeriod'{}}, + 'OrberCSIv2':decode('AttCertValidityPeriod', list_to_binary(Enc))), ok. code_V2Form_api(doc) -> ["Code V2Form"]; code_V2Form_api(suite) -> []; code_V2Form_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('V2Form', ?V2Form)), - ?match({ok, #'V2Form'{}}, - 'OrberCSIv2':decode('V2Form', list_to_binary(Enc))), + ?match({ok, #'V2Form'{}}, + 'OrberCSIv2':decode('V2Form', list_to_binary(Enc))), ok. code_IssuerSerial_api(doc) -> ["Code IssuerSerial"]; code_IssuerSerial_api(suite) -> []; code_IssuerSerial_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('IssuerSerial', ?IssuerSerial)), - ?match({ok, #'IssuerSerial'{}}, - 'OrberCSIv2':decode('IssuerSerial', list_to_binary(Enc))), + ?match({ok, #'IssuerSerial'{}}, + 'OrberCSIv2':decode('IssuerSerial', list_to_binary(Enc))), ok. code_ObjectDigestInfo_api(doc) -> ["Code ObjectDigestInfo"]; code_ObjectDigestInfo_api(suite) -> []; code_ObjectDigestInfo_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('ObjectDigestInfo', ?ObjectDigestInfo)), - ?match({ok, #'ObjectDigestInfo'{}}, - 'OrberCSIv2':decode('ObjectDigestInfo', list_to_binary(Enc))), + ?match({ok, #'ObjectDigestInfo'{}}, + 'OrberCSIv2':decode('ObjectDigestInfo', list_to_binary(Enc))), ok. %% PKIX1Explicit88 code_Certificate_api(doc) -> ["Code Certificate"]; code_Certificate_api(suite) -> []; code_Certificate_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('Certificate', ?Certificate)), - ?match({ok, #'Certificate'{}}, - 'OrberCSIv2':decode('Certificate', list_to_binary(Enc))), + ?match({ok, #'Certificate'{}}, + 'OrberCSIv2':decode('Certificate', list_to_binary(Enc))), ok. code_TBSCertificate_api(doc) -> ["Code TBSCertificate"]; code_TBSCertificate_api(suite) -> []; code_TBSCertificate_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('TBSCertificate', ?TBSCertificate)), - ?match({ok, #'TBSCertificate'{}}, - 'OrberCSIv2':decode('TBSCertificate', list_to_binary(Enc))), + ?match({ok, #'TBSCertificate'{}}, + 'OrberCSIv2':decode('TBSCertificate', list_to_binary(Enc))), ok. code_CertificateSerialNumber_api(doc) -> ["Code CertificateSerialNumber"]; code_CertificateSerialNumber_api(suite) -> []; code_CertificateSerialNumber_api(_Config) -> - {ok, Enc} = - ?match({ok, _}, + {ok, Enc} = + ?match({ok, _}, 'OrberCSIv2':encode('CertificateSerialNumber', ?CertificateSerialNumber)), - ?match({ok, ?CertificateSerialNumber}, - 'OrberCSIv2':decode('CertificateSerialNumber', list_to_binary(Enc))), + ?match({ok, ?CertificateSerialNumber}, + 'OrberCSIv2':decode('CertificateSerialNumber', list_to_binary(Enc))), ok. code_Version_api(doc) -> ["Code Version"]; code_Version_api(suite) -> []; code_Version_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('Version', ?Version)), - ?match({ok, ?Version}, 'OrberCSIv2':decode('Version', list_to_binary(Enc))), + ?match({ok, ?Version}, 'OrberCSIv2':decode('Version', list_to_binary(Enc))), ok. code_AlgorithmIdentifier_api(doc) -> ["Code AlgorithmIdentifier"]; code_AlgorithmIdentifier_api(suite) -> []; code_AlgorithmIdentifier_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('AlgorithmIdentifier', ?AlgorithmIdentifier)), - ?match({ok, #'AlgorithmIdentifier'{}}, - 'OrberCSIv2':decode('AlgorithmIdentifier', list_to_binary(Enc))), + ?match({ok, #'AlgorithmIdentifier'{}}, + 'OrberCSIv2':decode('AlgorithmIdentifier', list_to_binary(Enc))), ok. code_Name_api(doc) -> ["Code Name"]; code_Name_api(suite) -> []; code_Name_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('Name', ?Name)), - ?match({ok, {rdnSequence,_}}, - 'OrberCSIv2':decode('Name', list_to_binary(Enc))), + ?match({ok, {rdnSequence,_}}, + 'OrberCSIv2':decode('Name', list_to_binary(Enc))), ok. code_RDNSequence_api(doc) -> ["Code RDNSequence"]; code_RDNSequence_api(suite) -> []; code_RDNSequence_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('RDNSequence', ?RDNSequence)), - ?match({ok, [[#'AttributeTypeAndValue'{}]]}, - 'OrberCSIv2':decode('RDNSequence', list_to_binary(Enc))), + ?match({ok, [[#'AttributeTypeAndValue'{}]]}, + 'OrberCSIv2':decode('RDNSequence', list_to_binary(Enc))), ok. code_RelativeDistinguishedName_api(doc) -> ["Code RelativeDistinguishedName"]; code_RelativeDistinguishedName_api(suite) -> []; code_RelativeDistinguishedName_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('RelativeDistinguishedName', ?RelativeDistinguishedName)), - ?match({ok, [#'AttributeTypeAndValue'{}]}, - 'OrberCSIv2':decode('RelativeDistinguishedName', list_to_binary(Enc))), + ?match({ok, [#'AttributeTypeAndValue'{}]}, + 'OrberCSIv2':decode('RelativeDistinguishedName', list_to_binary(Enc))), ok. code_AttributeTypeAndValue_api(doc) -> ["Code AttributeTypeAndValue"]; code_AttributeTypeAndValue_api(suite) -> []; code_AttributeTypeAndValue_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('AttributeTypeAndValue', ?AttributeTypeAndValue)), - ?match({ok, #'AttributeTypeAndValue'{}}, - 'OrberCSIv2':decode('AttributeTypeAndValue', list_to_binary(Enc))), + ?match({ok, #'AttributeTypeAndValue'{}}, + 'OrberCSIv2':decode('AttributeTypeAndValue', list_to_binary(Enc))), ok. code_Attribute_api(doc) -> ["Code Attribute"]; code_Attribute_api(suite) -> []; code_Attribute_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('Attribute', ?Attribute)), - ?match({ok, #'Attribute'{}}, - 'OrberCSIv2':decode('Attribute', list_to_binary(Enc))), + ?match({ok, #'Attribute'{}}, + 'OrberCSIv2':decode('Attribute', list_to_binary(Enc))), ok. code_Validity_api(doc) -> ["Code Validity"]; code_Validity_api(suite) -> []; code_Validity_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('Validity', ?Validity)), - ?match({ok, #'Validity'{}}, - 'OrberCSIv2':decode('Validity', list_to_binary(Enc))), + ?match({ok, #'Validity'{}}, + 'OrberCSIv2':decode('Validity', list_to_binary(Enc))), ok. code_SubjectPublicKeyInfo_api(doc) -> ["Code SubjectPublicKeyInfo"]; code_SubjectPublicKeyInfo_api(suite) -> []; code_SubjectPublicKeyInfo_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('SubjectPublicKeyInfo', ?SubjectPublicKeyInfo)), - ?match({ok, #'SubjectPublicKeyInfo'{}}, - 'OrberCSIv2':decode('SubjectPublicKeyInfo', list_to_binary(Enc))), + ?match({ok, #'SubjectPublicKeyInfo'{}}, + 'OrberCSIv2':decode('SubjectPublicKeyInfo', list_to_binary(Enc))), ok. code_UniqueIdentifier_api(doc) -> ["Code UniqueIdentifier"]; code_UniqueIdentifier_api(suite) -> []; code_UniqueIdentifier_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('UniqueIdentifier', ?UniqueIdentifier)), - ?match({ok, _}, 'OrberCSIv2':decode('UniqueIdentifier', list_to_binary(Enc))), + ?match({ok, _}, 'OrberCSIv2':decode('UniqueIdentifier', list_to_binary(Enc))), ok. code_Extensions_api(doc) -> ["Code Extensions"]; code_Extensions_api(suite) -> []; code_Extensions_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('Extensions', ?Extensions)), - ?match({ok, [#'Extension'{}]}, - 'OrberCSIv2':decode('Extensions', list_to_binary(Enc))), + ?match({ok, [#'Extension'{}]}, + 'OrberCSIv2':decode('Extensions', list_to_binary(Enc))), ok. code_Extension_api(doc) -> ["Code Extension"]; code_Extension_api(suite) -> []; code_Extension_api(_Config) -> - {ok, Enc} = + {ok, Enc} = ?match({ok, _}, 'OrberCSIv2':encode('Extension', ?Extension)), - ?match({ok, #'Extension'{}}, - 'OrberCSIv2':decode('Extension', list_to_binary(Enc))), + ?match({ok, #'Extension'{}}, + 'OrberCSIv2':decode('Extension', list_to_binary(Enc))), ok. %% OpenSSL generated x509 Certificate code_OpenSSL509_api(doc) -> ["Code OpenSSL generated x509 Certificate"]; code_OpenSSL509_api(suite) -> []; code_OpenSSL509_api(_Config) -> - {ok, Cert} = - ?match({ok, #'Certificate'{}}, + {ok, Cert} = + ?match({ok, #'Certificate'{}}, 'OrberCSIv2':decode('Certificate', ?X509DER)), - AttrCertChain = #'AttributeCertChain'{attributeCert = ?AttributeCertificate, + AttrCertChain = #'AttributeCertChain'{attributeCert = ?AttributeCertificate, certificateChain = [Cert]}, - {ok, EAttrCertChain} = + {ok, EAttrCertChain} = ?match({ok, _}, 'OrberCSIv2':encode('AttributeCertChain', AttrCertChain)), - ?match({ok, #'AttributeCertChain'{}}, + ?match({ok, #'AttributeCertChain'{}}, 'OrberCSIv2':decode('AttributeCertChain', list_to_binary(EAttrCertChain))), ok. @@ -663,65 +669,65 @@ ssl_server_peercert_api(doc) -> ["Test ssl:peercert (server side)"]; ssl_server_peercert_api(suite) -> []; ssl_server_peercert_api(_Config) -> case os:type() of - vxworks -> - {skipped, "No SSL-support for VxWorks."}; - _ -> - Options = orber_test_lib:get_options(iiop_ssl, server, - 2, [{iiop_ssl_port, 0}]), - {ok, ServerNode, ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(Options)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - SSLOptions = orber_test_lib:get_options(ssl, client), - {ok, Socket} = - ?match({ok, _}, fake_client_ORB(ssl, ServerHost, ServerPort, SSLOptions)), - {ok, _PeerCert} = ?match({ok, _}, orber_socket:peercert(ssl, Socket)), -%% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [pkix, subject])), -%% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [ssl, subject])), -% ?match({ok, #'Certificate'{}}, -% 'OrberCSIv2':decode('Certificate', PeerCert)), - destroy_fake_ORB(ssl, Socket), - ok + vxworks -> + {skipped, "No SSL-support for VxWorks."}; + _ -> + Options = orber_test_lib:get_options(iiop_ssl, server, + 2, [{iiop_ssl_port, 0}]), + {ok, ServerNode, ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node(Options)), + ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), + SSLOptions = orber_test_lib:get_options(ssl, client), + {ok, Socket} = + ?match({ok, _}, fake_client_ORB(ssl, ServerHost, ServerPort, SSLOptions)), + {ok, _PeerCert} = ?match({ok, _}, orber_socket:peercert(ssl, Socket)), + %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [pkix, subject])), + %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [ssl, subject])), + % ?match({ok, #'Certificate'{}}, + % 'OrberCSIv2':decode('Certificate', PeerCert)), + destroy_fake_ORB(ssl, Socket), + ok end. ssl_client_peercert_api(doc) -> ["Test ssl:peercert (client side)"]; ssl_client_peercert_api(suite) -> []; ssl_client_peercert_api(_Config) -> case os:type() of - vxworks -> - {skipped, "No SSL-support for VxWorks."}; - _ -> - Options = orber_test_lib:get_options(iiop_ssl, client, - 2, [{iiop_ssl_port, 0}]), - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(Options)), - crypto:start(), - ssl:start(), - SSLOptions = orber_test_lib:get_options(ssl, server), - {ok, LSock} = ?match({ok, _}, ssl:listen(0, SSLOptions)), - {ok, {_Address, LPort}} = ?match({ok, {_, _}}, ssl:sockname(LSock)), - IOR = ?match({'IOP_IOR',_,_}, - iop_ior:create_external({1, 2}, "IDL:FAKE:1.0", - "localhost", 6004, "FAKE", - [#'IOP_TaggedComponent' - {tag=?TAG_SSL_SEC_TRANS, - component_data=#'SSLIOP_SSL' - {target_supports = 2, - target_requires = 2, - port = LPort}}])), - spawn(orber_test_lib, remote_apply, - [ClientNode, corba_object, non_existent, [IOR]]), - {ok, Socket} = ?match({ok, _}, ssl:transport_accept(LSock)), - ?match(ok, ssl:ssl_accept(Socket)), - - {ok, _PeerCert} = ?match({ok, _}, orber_socket:peercert(ssl, Socket)), -%% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [pkix, subject])), -%% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [ssl, subject])), -% ?match({ok, #'Certificate'{}}, -% 'OrberCSIv2':decode('Certificate', PeerCert)), - ssl:close(Socket), - ssl:close(LSock), - ssl:stop(), - ok + vxworks -> + {skipped, "No SSL-support for VxWorks."}; + _ -> + Options = orber_test_lib:get_options(iiop_ssl, client, + 2, [{iiop_ssl_port, 0}]), + {ok, ClientNode, _ClientHost} = + ?match({ok,_,_}, orber_test_lib:js_node(Options)), + crypto:start(), + ssl:start(), + SSLOptions = orber_test_lib:get_options(ssl, server), + {ok, LSock} = ?match({ok, _}, ssl:listen(0, SSLOptions)), + {ok, {_Address, LPort}} = ?match({ok, {_, _}}, ssl:sockname(LSock)), + IOR = ?match({'IOP_IOR',_,_}, + iop_ior:create_external({1, 2}, "IDL:FAKE:1.0", + "localhost", 6004, "FAKE", + [#'IOP_TaggedComponent' + {tag=?TAG_SSL_SEC_TRANS, + component_data=#'SSLIOP_SSL' + {target_supports = 2, + target_requires = 2, + port = LPort}}])), + spawn(orber_test_lib, remote_apply, + [ClientNode, corba_object, non_existent, [IOR]]), + {ok, Socket} = ?match({ok, _}, ssl:transport_accept(LSock)), + ?match(ok, ssl:ssl_accept(Socket)), + + {ok, _PeerCert} = ?match({ok, _}, orber_socket:peercert(ssl, Socket)), + %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [pkix, subject])), + %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [ssl, subject])), + % ?match({ok, #'Certificate'{}}, + % 'OrberCSIv2':decode('Certificate', PeerCert)), + ssl:close(Socket), + ssl:close(LSock), + ssl:stop(), + ok end. %%----------------------------------------------------------------- @@ -730,105 +736,105 @@ ssl_client_peercert_api(_Config) -> -ifdef(false). %% Not used yet. context_test(Obj) -> - IDToken1 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent, + IDToken1 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent, value = true}, - IDToken2 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAnonymous, + IDToken2 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAnonymous, value = false}, - IDToken3 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTPrincipalName, + IDToken3 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTPrincipalName, value = [0,255]}, - IDToken4 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTX509CertChain, + IDToken4 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTX509CertChain, value = [1,255]}, - IDToken5 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTDistinguishedName, + IDToken5 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTDistinguishedName, value = [2,255]}, - IDToken6 = #'CSI_IdentityToken'{label = ?ULONGMAX, + IDToken6 = #'CSI_IdentityToken'{label = ?ULONGMAX, value = [3,255]}, MTEstablishContext1 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken1, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken1, client_authentication_token = [1, 255]}}, MTEstablishContext2 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken2, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken2, client_authentication_token = [1, 255]}}, MTEstablishContext3 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken3, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken3, client_authentication_token = [1, 255]}}, MTEstablishContext4 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken4, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken4, client_authentication_token = [1, 255]}}, MTEstablishContext5 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken5, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken5, client_authentication_token = [1, 255]}}, MTEstablishContext6 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken6, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken6, client_authentication_token = [1, 255]}}, MTCompleteEstablishContext = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTCompleteEstablishContext, - value = #'CSI_CompleteEstablishContext'{client_context_id = ?ULONGLONGMAX, + {label = ?CSI_MsgType_MTCompleteEstablishContext, + value = #'CSI_CompleteEstablishContext'{client_context_id = ?ULONGLONGMAX, context_stateful = false, final_context_token = [1, 255]}}, MTContextError = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTContextError, + {label = ?CSI_MsgType_MTContextError, value = #'CSI_ContextError'{client_context_id = ?ULONGLONGMAX, - major_status = 1, - minor_status = 2, + major_status = 1, + minor_status = 2, error_token = [2,255]}}, MTMessageInContext = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTMessageInContext, - value = #'CSI_MessageInContext'{client_context_id = ?ULONGLONGMAX, + {label = ?CSI_MsgType_MTMessageInContext, + value = #'CSI_MessageInContext'{client_context_id = ?ULONGLONGMAX, discard_context = true}}, - Ctx = [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + Ctx = [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext1}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext2}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext3}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext4}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext5}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext6}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTCompleteEstablishContext}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTContextError}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTMessageInContext}], ?line ?match(ok, orber_test_server:testing_iiop_context(Obj, [{context, Ctx}])). @@ -836,7 +842,7 @@ context_test(Obj) -> fake_server_ORB(Type, Port, Options) -> start_ssl(Type), {ok, ListenSocket, NewPort} = - orber_socket:listen(Type, Port, + orber_socket:listen(Type, Port, [{active, false}|Options]), Socket = orber_socket:accept(Type, ListenSocket), orber_socket:post_accept(Type, Socket), @@ -846,7 +852,7 @@ fake_server_ORB(Type, Port, Options) -> fake_server_ORB(Type, Port, Options, Action, Data) -> start_ssl(Type), - {ok, ListenSocket, _NewPort} = + {ok, ListenSocket, _NewPort} = orber_socket:listen(Type, Port, [{active, false}|Options]), Socket = orber_socket:accept(Type, ListenSocket), orber_socket:post_accept(Type, Socket), @@ -885,13 +891,13 @@ fake_client_ORB(Type, Host, Port, Options, Action, Data) -> do_client_action(Type, Socket, fragments, FragList) -> ok = send_data(Type, Socket, FragList), {ok, Bytes} = gen_tcp:recv(Socket, 0), - {#reply_header{request_id = ?REQUEST_ID, reply_status = no_exception}, ok, [Par]} = + {#reply_header{request_id = ?REQUEST_ID, reply_status = no_exception}, ok, [Par]} = cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes), Par; do_client_action(Type, Socket, fragments_max, FragList) -> ok = send_data(Type, Socket, FragList), {ok, Bytes} = gen_tcp:recv(Socket, 0), - {#reply_header{request_id = ?REQUEST_ID, reply_status = system_exception}, Exc, []} = + {#reply_header{request_id = ?REQUEST_ID, reply_status = system_exception}, Exc, []} = cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes), Exc; do_client_action(Type, Socket, message_error, Data) -> @@ -916,4 +922,4 @@ send_data(_Type, _Socket, []) -> send_data(Type, Socket, [H|T]) -> orber_socket:write(Type, Socket, H), send_data(Type, Socket, T). - + diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index b9453663c3..3c1ffd59d3 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -50,30 +50,33 @@ %%----------------------------------------------------------------- %% External exports %%----------------------------------------------------------------- --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0, +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0, init_per_suite/1, end_per_suite/1, basic_PI_api/1, multi_orber_api/1, - init_per_testcase/2, end_per_testcase/2, multi_pseudo_orber_api/1, - light_orber_api/1, light_orber2_api/1, + init_per_testcase/2, end_per_testcase/2, multi_pseudo_orber_api/1, + light_orber_api/1, light_orber2_api/1, ssl_1_multi_orber_api/1, ssl_2_multi_orber_api/1, ssl_reconfigure_api/1, iiop_timeout_api/1, iiop_timeout_added_api/1, setup_connection_timeout_api/1, setup_multi_connection_timeout_api/1, setup_multi_connection_timeout_random_api/1, setup_multi_connection_timeout_attempts_api/1, - fragments_server_api/1, fragments_max_server_api/1, + fragments_server_api/1, fragments_max_server_api/1, fragments_max_server_added_api/1, fragments_client_api/1, light_ifr_api/1, max_requests_api/1, max_requests_added_api/1, - max_connections_api/1, max_packet_size_exceeded_api/1, + max_connections_api/1, max_packet_size_exceeded_api/1, max_packet_size_ok_api/1, proxy_interface_api/1, proxy_interface_ipv6_api/1, multiple_accept_api/1, implicit_context_api/1, - pseudo_implicit_context_api/1, pseudo_two_implicit_context_api/1, + pseudo_implicit_context_api/1, pseudo_two_implicit_context_api/1, oneway_implicit_context_api/1, implicit_context_roundtrip_api/1, oneway_pseudo_implicit_context_api/1, flags_added_api/1, - oneway_pseudo_two_implicit_context_api/1, + oneway_pseudo_two_implicit_context_api/1, local_interface_api/1, local_interface_ctx_override_api/1, local_interface_acl_override_api/1, bad_giop_header_api/1, bad_fragment_id_client_api/1, bad_id_cancel_request_api/1, close_connections_api/1, close_connections_local_interface_api/1, - close_connections_local_interface_ctx_override_api/1, ssl_reconfigure_generation_3_api/1, + close_connections_local_interface_ctx_override_api/1, ssl_1_multi_orber_generation_3_api/1, ssl_2_multi_orber_generation_3_api/1, + ssl_reconfigure_generation_3_api/1, + ssl_1_multi_orber_generation_3_api_old/1, ssl_2_multi_orber_generation_3_api_old/1, + ssl_reconfigure_generation_3_api_old/1, close_connections_alt_iiop_addr_api/1, close_connections_multiple_profiles_api/1]). @@ -84,15 +87,15 @@ %%----------------------------------------------------------------- %% Func: all/1 -%% Args: -%% Returns: +%% Args: +%% Returns: %%----------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> cases(). -groups() -> +groups() -> []. init_per_group(_GroupName, Config) -> @@ -105,7 +108,7 @@ end_per_group(_GroupName, Config) -> %% NOTE - the fragment test cases must be first since we explicitly set a request %% id. Otherwise, the request-id counter would be increased and we cannot know %% what it is. -cases() -> +cases() -> [fragments_server_api, fragments_max_server_api, fragments_max_server_added_api, fragments_client_api, flags_added_api, bad_fragment_id_client_api, @@ -134,21 +137,28 @@ cases() -> setup_multi_connection_timeout_attempts_api, setup_multi_connection_timeout_random_api, ssl_1_multi_orber_api, + ssl_1_multi_orber_generation_3_api_old, ssl_1_multi_orber_generation_3_api, ssl_2_multi_orber_api, + ssl_2_multi_orber_generation_3_api_old, ssl_2_multi_orber_generation_3_api, - ssl_reconfigure_generation_3_api, ssl_reconfigure_api]. + ssl_reconfigure_api, + ssl_reconfigure_generation_3_api_old, + ssl_reconfigure_generation_3_api]. %%----------------------------------------------------------------- %% Init and cleanup functions. %%----------------------------------------------------------------- -init_per_testcase(TC,Config) +init_per_testcase(TC,Config) when TC =:= ssl_1_multi_orber_api; TC =:= ssl_2_multi_orber_api; TC =:= ssl_reconfigure_api -> init_ssl(Config); -init_per_testcase(TC,Config) - when TC =:= ssl_1_multi_orber_generation_3_api; +init_per_testcase(TC,Config) + when TC =:= ssl_1_multi_orber_generation_3_api_old; + TC =:= ssl_2_multi_orber_generation_3_api_old; + TC =:= ssl_reconfigure_generation_3_api_old; + TC =:= ssl_1_multi_orber_generation_3_api; TC =:= ssl_2_multi_orber_generation_3_api; TC =:= ssl_reconfigure_generation_3_api -> init_ssl_3(Config); @@ -156,21 +166,31 @@ init_per_testcase(_Case, Config) -> init_all(Config). init_ssl(Config) -> - case orber_test_lib:ssl_version() of - no_ssl -> - {skip,"SSL is not installed!"}; - _ -> - init_all(Config) + case ?config(crypto_started, Config) of + true -> + case orber_test_lib:ssl_version() of + no_ssl -> + {skip, "SSL is not installed!"}; + _ -> + init_all(Config) + end; + false -> + {skip, "Crypto did not start"} end. init_ssl_3(Config) -> - case orber_test_lib:ssl_version() of - 3 -> - init_all(Config); - 2 -> - {skip,"Could not find the correct SSL version!"}; - no_ssl -> - {skip,"SSL is not installed!"} + case ?config(crypto_started, Config) of + true -> + case orber_test_lib:ssl_version() of + 3 -> + init_all(Config); + 2 -> + {skip, "Could not find the correct SSL version!"}; + no_ssl -> + {skip, "SSL is not installed!"} + end; + false -> + {skip, "Crypto did not start"} end. init_all(Config) -> @@ -194,12 +214,18 @@ end_per_testcase(_Case, Config) -> init_per_suite(Config) -> if is_list(Config) -> - Config; + try crypto:start() of + ok -> + [{crypto_started, true} | Config] + catch _:_ -> + [{crypto_started, false} | Config] + end; true -> exit("Config not a list") end. end_per_suite(Config) -> + application:stop(crypto), Config. %%----------------------------------------------------------------- @@ -211,238 +237,238 @@ implicit_context_api(suite) -> []; implicit_context_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([])), - ?match(ok, + ?match(ok, orber_test_server: - relay_call(Relay, + relay_call(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), - + ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. -implicit_context_roundtrip_api(doc) -> +implicit_context_roundtrip_api(doc) -> ["IIOP Implicit Contex roundtrip tests"]; implicit_context_roundtrip_api(suite) -> []; implicit_context_roundtrip_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), Relay = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + IOR = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [])), - ?match(ok, + ?match(ok, orber_test_server: - relay_call(Relay, + relay_call(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. - - + + oneway_implicit_context_api(doc) -> ["IIOP Implicit Contex oneway tests"]; oneway_implicit_context_api(suite) -> []; oneway_implicit_context_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([])), - ?match(ok, + ?match(ok, orber_test_server: - relay_cast(Relay, + relay_cast(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), - %% We must wait for a few seconds for the client to be able to set up the + %% We must wait for a few seconds for the client to be able to set up the %% connection (since it's a oneway operation). timer:sleep(5000), ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. - + pseudo_implicit_context_api(doc) -> ["IIOP Implicit Contex tests (via pseudo object)"]; pseudo_implicit_context_api(suite) -> []; pseudo_implicit_context_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])), - ?match(ok, + ?match(ok, orber_test_server: - relay_call(Relay, + relay_call(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. - -pseudo_two_implicit_context_api(doc) -> + +pseudo_two_implicit_context_api(doc) -> ["IIOP two Implicit Contex tests (via pseudo object)"]; pseudo_two_implicit_context_api(suite) -> []; pseudo_two_implicit_context_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])), - put(oe_server_in_context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + put(oe_server_in_context, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, context_data = {interface, IP}}]), - ?match(ok, + ?match(ok, orber_test_server: - relay_call(Relay, + relay_call(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. - + oneway_pseudo_implicit_context_api(doc) -> ["IIOP Implicit Contex tests (via pseudo object oneway)"]; oneway_pseudo_implicit_context_api(suite) -> []; oneway_pseudo_implicit_context_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])), - ?match(ok, + ?match(ok, orber_test_server: - relay_cast(Relay, + relay_cast(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. - -oneway_pseudo_two_implicit_context_api(doc) -> + +oneway_pseudo_two_implicit_context_api(doc) -> ["IIOP two Implicit Contex tests (via pseudo object oneway)"]; oneway_pseudo_two_implicit_context_api(suite) -> []; oneway_pseudo_two_implicit_context_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), %% Create a remote server - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")), - + Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])), %% Add incoming implicit context which must be removed. - put(oe_server_in_context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + put(oe_server_in_context, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, context_data = {interface, IP}}]), - ?match(ok, + ?match(ok, orber_test_server: - relay_cast(Relay, + relay_cast(Relay, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, Loopback}}]}], IOR)), ?match([_,_], orber:iiop_connections(out)), - Conns = ?match([_,_], + Conns = ?match([_,_], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ?match(true, lists:keymember(Loopback, 1, Conns)), ok. - + multiple_accept_api(doc) -> ["IIOP Multiple Accept tests"]; @@ -450,7 +476,7 @@ multiple_accept_api(suite) -> []; multiple_accept_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), @@ -461,84 +487,84 @@ multiple_accept_api(_Config) -> IOR1 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR1)), ?match([_], orber:iiop_connections(out)), {ok, Ref1} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [Loopback, normal])), IOR2 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR2)), ?match([_,_], orber:iiop_connections(out)), {ok, Ref2} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [Loopback, normal, 9543])), ?match({error, eaddrinuse}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [Loopback, normal, 9543])), IOR3 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++Loopback++":9543/NameService")), - ?match({'external', {Loopback, 9543, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {Loopback, 9543, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR3)), ?match([_,_,_], orber:iiop_connections(out)), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, remove_listen_interface, [Ref1])), %% Wait a few seconds to be sure that the connections really has been removed. timer:sleep(4000), ?match([_,_], orber:iiop_connections(out)), - - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, + + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, remove_listen_interface, [Ref2])), %% Wait a few seconds to be sure that the connections really has been removed. timer:sleep(4000), ?match([_], orber:iiop_connections(out)), - + ?match({'EXCEPTION',_}, corba:string_to_object("corbaloc::1.2@"++Loopback++":9543/NameService")), ?match({'EXCEPTION',_}, corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")), - + IOR4 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR4)), ok. -proxy_interface_api(doc) -> ["IIOP Proxy Interface tests", +proxy_interface_api(doc) -> ["IIOP Proxy Interface tests", "This case test if the server ORB use the correct", "interface when exporting IOR:s"]; proxy_interface_api(suite) -> []; proxy_interface_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR1 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR1)), IOR2 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR2)), ok. -proxy_interface_ipv6_api(doc) -> ["IIOP Proxy Interface tests", +proxy_interface_ipv6_api(doc) -> ["IIOP Proxy Interface tests", "This case test if the server ORB use the correct", "IPv6 interface when exporting IOR:s"]; proxy_interface_ipv6_api(suite) -> []; @@ -550,103 +576,103 @@ proxy_interface_ipv6_api(_Config) -> Reason end. -proxy_interface_ipv6_api2() -> +proxy_interface_ipv6_api2() -> Loopback = orber_test_lib:get_loopback_interface(inet6), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor ?ORB_ENV_LOCAL_INTERFACE)}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_IPV6}])), - + IP = orber_test_lib:remote_apply(ClientNode, orber_test_lib, get_host, []), IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])), - ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, orber_test_lib:remote_apply(ClientNode, iop_ior, get_key, [IOR1])), IOR2 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService"])), - ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, orber_test_lib:remote_apply(ClientNode, iop_ior, get_key, [IOR2])), ok. -local_interface_api(doc) -> ["IIOP Local Interface tests", +local_interface_api(doc) -> ["IIOP Local Interface tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; local_interface_api(suite) -> []; local_interface_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, Loopback}])), Port = orber:iiop_port(), ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService"])), - [{Loopback, RemotePort}] = + [{Loopback, RemotePort}] = ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)), - ?match([{IP, Port}], - orber_test_lib:remote_apply(ClientNode, orber, + ?match([{IP, Port}], + orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), ?match([{IP, Port}], orber:find_sockname_by_peername(Loopback,RemotePort)), ?match([{Loopback, RemotePort}], orber:find_peername_by_sockname(IP, Port)), - ?match([{Loopback, RemotePort}], - orber_test_lib:remote_apply(ClientNode, orber, - find_sockname_by_peername, + ?match([{Loopback, RemotePort}], + orber_test_lib:remote_apply(ClientNode, orber, + find_sockname_by_peername, [IP, Port])), - ?match([{IP, Port}], - orber_test_lib:remote_apply(ClientNode, orber, - find_peername_by_sockname, + ?match([{IP, Port}], + orber_test_lib:remote_apply(ClientNode, orber, + find_peername_by_sockname, [Loopback,RemotePort])), ok. -local_interface_ctx_override_api(doc) -> - ["IIOP Local Interface tests", +local_interface_ctx_override_api(doc) -> + ["IIOP Local Interface tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; local_interface_ctx_override_api(suite) -> []; local_interface_ctx_override_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, IP}])), Port = orber:iiop_port(), ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService", [#'IOP_ServiceContext' - {context_id=?ORBER_GENERIC_CTX_ID, + {context_id=?ORBER_GENERIC_CTX_ID, context_data = {interface, Loopback}}]])), - [{Loopback, RemotePort}] = + [{Loopback, RemotePort}] = ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)), - ?match([{IP, Port, Loopback}], - orber_test_lib:remote_apply(ClientNode, orber, + ?match([{IP, Port, Loopback}], + orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), ?match([{IP, Port}], orber:find_sockname_by_peername(Loopback,RemotePort)), ?match([{Loopback, RemotePort}], orber:find_peername_by_sockname(IP, Port)), - ?match([{Loopback, RemotePort}], - orber_test_lib:remote_apply(ClientNode, orber, - find_sockname_by_peername, + ?match([{Loopback, RemotePort}], + orber_test_lib:remote_apply(ClientNode, orber, + find_sockname_by_peername, [IP, Port])), - ?match([{IP, Port}], - orber_test_lib:remote_apply(ClientNode, orber, - find_peername_by_sockname, + ?match([{IP, Port}], + orber_test_lib:remote_apply(ClientNode, orber, + find_peername_by_sockname, [Loopback,RemotePort])), ok. -local_interface_acl_override_api(doc) -> - ["IIOP Local Interface tests", +local_interface_acl_override_api(doc) -> + ["IIOP Local Interface tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; local_interface_acl_override_api(suite) -> []; @@ -654,74 +680,74 @@ local_interface_acl_override_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), ACL = [{tcp_out, IP ++ "/18", [Loopback]}], - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, IP}, {iiop_acl, ACL}, {flags, ?ORB_ENV_USE_ACL_OUTGOING}])), Port = orber:iiop_port(), ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService", [#'IOP_ServiceContext' - {context_id=?ORBER_GENERIC_CTX_ID, + {context_id=?ORBER_GENERIC_CTX_ID, context_data = {interface, IP}}]])), ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)), ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService"])), - [{Loopback, RemotePort}] = + [{Loopback, RemotePort}] = ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)), - ?match([{IP, Port, IP}], orber_test_lib:remote_apply(ClientNode, orber, + ?match([{IP, Port, IP}], orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), ?match([{IP, Port}], orber:find_sockname_by_peername(Loopback,RemotePort)), ?match([{Loopback, RemotePort}], orber:find_peername_by_sockname(IP, Port)), - ?match([{Loopback, RemotePort}], - orber_test_lib:remote_apply(ClientNode, orber, - find_sockname_by_peername, + ?match([{Loopback, RemotePort}], + orber_test_lib:remote_apply(ClientNode, orber, + find_sockname_by_peername, [IP, Port])), - ?match([{IP, Port}], - orber_test_lib:remote_apply(ClientNode, orber, - find_peername_by_sockname, + ?match([{IP, Port}], + orber_test_lib:remote_apply(ClientNode, orber, + find_peername_by_sockname, [Loopback,RemotePort])), ok. -iiop_timeout_api(doc) -> ["IIOP TIMEOUT API tests", +iiop_timeout_api(doc) -> ["IIOP TIMEOUT API tests", "This case test if timeout configuration behaves correctly"]; iiop_timeout_api(suite) -> []; iiop_timeout_api(_Config) -> - + %% Install two secure orber. - {ok, ClientNode, ClientHost} = + {ok, ClientNode, ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_timeout, 6}, {iiop_connection_timeout, 3}, {iiop_in_connection_timeout, 3}])), ClientPort = orber_test_lib:remote_apply(ClientNode, orber, iiop_port, []), - - {ok, ServerNode, ServerHost} = + + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_timeout, 6}, {iiop_connection_timeout, 3}, {iiop_in_connection_timeout, 12}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [timeout])), - %% Tell client_orb to interoperate with server_orb. - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + %% Tell client_orb to interoperate with server_orb. + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, lookup, [ServerHost, ServerPort])), %% Interop worked fine, perform delay tests. - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, timeouts, [ServerHost, ServerPort, 6000])), - + %% Create a connection to the "client_orb", which will now act as server. - ?match({'IOP_IOR',_,_}, + ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.2@"++ClientHost++":"++integer_to_list(ClientPort)++"/NameService")), %% Check that the connection is established. ?match([{_, ClientPort}], orber:iiop_connections(out)), @@ -729,13 +755,13 @@ iiop_timeout_api(_Config) -> %% have been closed. timer:sleep(8000), ?match([], orber:iiop_connections(out)), - - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, + + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, [timeout])), ok. -iiop_timeout_added_api(doc) -> ["IIOP TIMEOUT API tests", +iiop_timeout_added_api(doc) -> ["IIOP TIMEOUT API tests", "This case test if timeout configuration behaves correctly"]; iiop_timeout_added_api(suite) -> []; iiop_timeout_added_api(_Config) -> @@ -743,18 +769,18 @@ iiop_timeout_added_api(_Config) -> {ok, Node, _Host} = ?match({ok,_,_}, orber_test_lib:js_node([])), Port = 1 + orber_test_lib:remote_apply(Node, orber, iiop_port, []), ?match({ok, _}, - orber_test_lib:remote_apply(Node, orber, - add_listen_interface, - [IP, normal, + orber_test_lib:remote_apply(Node, orber, + add_listen_interface, + [IP, normal, [{iiop_in_connection_timeout, 3}, {flags, ?ORB_ENV_LOCAL_INTERFACE}, {iiop_port, Port}]])), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [timeout])), - ?match({'IOP_IOR',_,_}, + ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService")), %% Check that the connection is established. ?match([{_, Port}], orber:iiop_connections(out)), @@ -762,9 +788,9 @@ iiop_timeout_added_api(_Config) -> %% have been closed. timer:sleep(8000), ?match([], orber:iiop_connections(out)), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [timeout])), ok. @@ -772,27 +798,27 @@ iiop_timeout_added_api(_Config) -> %% API tests for ORB to ORB using pseudo call/cast, no security %%----------------------------------------------------------------- -multi_pseudo_orber_api(doc) -> - ["MULTI ORB PSEUDO API tests", +multi_pseudo_orber_api(doc) -> + ["MULTI ORB PSEUDO API tests", "This case test if data encode/decode (IIOP) for pseudo objects", "produce the correct result, i.e., the test_server echos", "the input parameter or an exception is raised (MARSHAL)."]; multi_pseudo_orber_api(suite) -> []; multi_pseudo_orber_api(_Config) -> %% --- Create a slave-node --- - {ok, Node, Host} = - ?match({ok,_,_}, orber_test_lib:js_node()), + {ok, Node, Host} = + ?match({ok,_,_}, orber_test_lib:js_node()), Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [pseudo])), - + NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_}, corba:string_to_object("corbaloc::1.1@"++Host++":"++ integer_to_list(Port)++"/NameService")), - Obj = - ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + Obj = + ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))), orber_test_lib:corba_object_tests(Obj, NSR), @@ -809,11 +835,11 @@ multi_pseudo_orber_api(_Config) -> orber_test_lib:test_coding(Obj), %% Test if exit is handled properly. - ?match({'EXCEPTION',{'TRANSIENT',_,_,_}}, + ?match({'EXCEPTION',{'TRANSIENT',_,_,_}}, orber_test_server:stop_brutal(Obj)), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [pseudo])), ok. @@ -821,77 +847,77 @@ multi_pseudo_orber_api(_Config) -> %%----------------------------------------------------------------- %% API tests for ORB to ORB with local flags definition set. %%----------------------------------------------------------------- -flags_added_api(doc) -> +flags_added_api(doc) -> ["MULTI ORB PSEUDO with local flags definition set"]; flags_added_api(suite) -> []; flags_added_api(_Config) -> %% --- Create a slave-node --- IP = orber_test_lib:get_host(), - {ok, Node, _Host} = - ?match({ok,_,_}, orber_test_lib:js_node([])), + {ok, Node, _Host} = + ?match({ok,_,_}, orber_test_lib:js_node([])), Port = 1 + orber_test_lib:remote_apply(Node, orber, iiop_port, []), ?match({ok, _}, - orber_test_lib:remote_apply(Node, orber, - add_listen_interface, - [IP, normal, + orber_test_lib:remote_apply(Node, orber, + add_listen_interface, + [IP, normal, [{flags, (?ORB_ENV_LOCAL_INTERFACE bor ?ORB_ENV_EXCLUDE_CODESET_COMPONENT)}, {iiop_port, Port}]])), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [pseudo])), Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.1@"++IP++":"++ integer_to_list(Port)++"/NameService#mamba")), - ?match({'external', {IP, Port, _ObjectKey, _Counter, - #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, - profile_data= - #'IIOP_ProfileBody_1_1'{components=[]}}, - _NewHD}}, + ?match({'external', {IP, Port, _ObjectKey, _Counter, + #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, + profile_data= + #'IIOP_ProfileBody_1_1'{components=[]}}, + _NewHD}}, iop_ior:get_key(Obj)), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [pseudo])), ok. - + %%----------------------------------------------------------------- %% API tests for ORB to ORB with limited concurrent requests %%----------------------------------------------------------------- -max_requests_api(doc) -> +max_requests_api(doc) -> ["MULTI ORB PSEUDO with limited concurrent requests tests"]; max_requests_api(suite) -> []; max_requests_api(_Config) -> %% --- Create a slave-node --- - {ok, Node, Host} = - ?match({ok,_,_}, orber_test_lib:js_node([{iiop_max_in_requests, 1}])), + {ok, Node, Host} = + ?match({ok,_,_}, orber_test_lib:js_node([{iiop_max_in_requests, 1}])), Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []), max_requests(Node, Host, Port). -max_requests_added_api(doc) -> +max_requests_added_api(doc) -> ["MULTI ORB PSEUDO with limited concurrent requests tests"]; max_requests_added_api(suite) -> []; max_requests_added_api(_Config) -> %% --- Create a slave-node --- [IP] = ?match([_], orber:host()), - {ok, Node, _Host} = - ?match({ok,_,_}, orber_test_lib:js_node([])), + {ok, Node, _Host} = + ?match({ok,_,_}, orber_test_lib:js_node([])), Port = 1 + orber_test_lib:remote_apply(Node, orber, iiop_port, []), ?match({ok, _}, - orber_test_lib:remote_apply(Node, orber, - add_listen_interface, - [IP, normal, + orber_test_lib:remote_apply(Node, orber, + add_listen_interface, + [IP, normal, [{iiop_max_in_requests, 1}, {flags, ?ORB_ENV_LOCAL_INTERFACE}, {iiop_port, Port}]])), max_requests(Node, IP, Port). -max_requests(Node, Host, Port) -> - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, +max_requests(Node, Host, Port) -> + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [pseudo])), Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.1@"++Host++":"++ @@ -899,7 +925,7 @@ max_requests(Node, Host, Port) -> %% Can we even contact the object? ?match(ok, orber_test_server:print(Obj)), - + %% Invoke one blocking call followed by several invokations. spawn(orber_test_server, pseudo_call_delay, [Obj, 15000]), %% Wait for a second to be sure that the previous request has been sent @@ -912,8 +938,8 @@ max_requests(Node, Host, Port) -> %% allow one request at a time to the target ORB. ?match(true, (MegaSecsB + (Before+8)*1000000) < (MegaSecsA + After*1000000)), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [pseudo])), ok. @@ -921,17 +947,17 @@ max_requests(Node, Host, Port) -> %%----------------------------------------------------------------- %% API tests for ORB to ORB with limited concurrent connections %%----------------------------------------------------------------- -max_connections_api(doc) -> +max_connections_api(doc) -> ["MULTI ORB PSEUDO with limited concurrent connections tests"]; max_connections_api(suite) -> []; max_connections_api(_Config) -> %% --- Create a slave-node --- - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_backlog, 0}, {iiop_max_in_connections, 2}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), %% Claim connection 1 & 2 @@ -939,26 +965,26 @@ max_connections_api(_Config) -> corba:string_to_object("corbaname::1.2@"++ServerHost++":"++ integer_to_list(ServerPort)++"/NameService#mamba")), %% Claim backlog - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node()), + {ok, ClientNode, _ClientHost} = + ?match({ok,_,_}, orber_test_lib:js_node()), spawn(ClientNode, orber_test_server, print, [Obj]), timer:sleep(5000), ?match([_], orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [])), - + %% Try to connect. Should fail. Due to the behavior of different TCP stacks, backlog 1 %% might not be the precise value. Hence, we also need to define the iiop_timeout. Otherwise %% this test case will fail. For the same reason we must GC this connection. - {ok, ClientNodeII, _ClientHostII} = + {ok, ClientNodeII, _ClientHostII} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_setup_connection_timeout, 5}, {iiop_timeout, 5}, {iiop_connection_timeout, 8}])), - ?match({'EXCEPTION', _}, - orber_test_lib:remote_apply(ClientNodeII, orber_test_server, + ?match({'EXCEPTION', _}, + orber_test_lib:remote_apply(ClientNodeII, orber_test_server, testing_iiop_string, [Obj, "Fail"])), - + %% Remove 2 connections. We need to wait a moment so that both sides has detected it. timer:sleep(5000), ?match([_,_], orber:iiop_connections()), @@ -968,23 +994,23 @@ max_connections_api(_Config) -> ?match(ok, orber_iiop_pm:close_connection([{Host, Port}])), timer:sleep(5000), ?match([], orber:iiop_connections()), - + ?match([_], orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [])), ?match([], orber_test_lib:remote_apply(ClientNodeII, orber, iiop_connections, [])), - ?match({ok, "OK"}, - orber_test_lib:remote_apply(ClientNodeII, orber_test_server, + ?match({ok, "OK"}, + orber_test_lib:remote_apply(ClientNodeII, orber_test_server, testing_iiop_string, [Obj, "OK"])), - + timer:sleep(4000), ?match([_], orber_test_lib:remote_apply(ClientNodeII, orber, iiop_connections, [])), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, [pseudo])), ok. @@ -993,18 +1019,18 @@ max_connections_api(_Config) -> %%----------------------------------------------------------------- %% API tests for terminating connection by using an IOR. %%----------------------------------------------------------------- -close_connections_api(doc) -> +close_connections_api(doc) -> ["Close outgoing connection "]; close_connections_api(suite) -> []; close_connections_api(_Config) -> %% --- Create a slave-node --- IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IP = orber_test_lib:get_host(), @@ -1028,108 +1054,108 @@ close_connections_api(_Config) -> ok. -close_connections_local_interface_api(doc) -> - ["IIOP Local Interface disconnect tests", +close_connections_local_interface_api(doc) -> + ["IIOP Local Interface disconnect tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; close_connections_local_interface_api(suite) -> []; close_connections_local_interface_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, Loopback}])), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, IP}])), Port = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService"])), %% Check that the connnection is up and running using the default interface - ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, + ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - ?match([{IP, Port}], - orber_test_lib:remote_apply(ClientNode, orber, + ?match([{IP, Port}], + orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), %% Try to close the connection - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, close_connection, [IOR])), %% Wait a moment so that both sides has detected it. timer:sleep(5000), %% Now the connection shall be gone. - ?match([], orber_test_lib:remote_apply(ClientNode, orber, + ?match([], orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), - ?match([], orber_test_lib:remote_apply(ServerNode, orber, + ?match([], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ok. -close_connections_local_interface_ctx_override_api(doc) -> - ["IIOP Local Interface disconnect tests", +close_connections_local_interface_ctx_override_api(doc) -> + ["IIOP Local Interface disconnect tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; close_connections_local_interface_ctx_override_api(suite) -> []; close_connections_local_interface_ctx_override_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, IP}, {ip_address, IP}])), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, IP}])), Port = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, string_to_object, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService", [#'IOP_ServiceContext' - {context_id=?ORBER_GENERIC_CTX_ID, + {context_id=?ORBER_GENERIC_CTX_ID, context_data = {interface, Loopback}}]])), timer:sleep(2000), %% Check that the connnection is up and running using the default interface - ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, + ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - - ?match([{IP, Port, Loopback}], - orber_test_lib:remote_apply(ClientNode, orber, + + ?match([{IP, Port, Loopback}], + orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), %% Try to close not supplying the interface. - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, close_connection, [IOR])), - + timer:sleep(2000), %% The connection shall still be up and running - ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, + ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - ?match([{IP, Port, Loopback}], - orber_test_lib:remote_apply(ClientNode, orber, + ?match([{IP, Port, Loopback}], + orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), %% Try to close not supplying the interface. - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, close_connection, [IOR, IP])), - timer:sleep(2000), + timer:sleep(2000), %% The connection shall still be up and running - ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, + ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - ?match([{IP, Port, Loopback}], - orber_test_lib:remote_apply(ClientNode, orber, + ?match([{IP, Port, Loopback}], + orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), - + %% Try to close supplying the correct interface. - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber, close_connection, [IOR, Loopback])), %% Wait a moment so that both sides has detected it. timer:sleep(5000), %% Now the connection shall be gone. - ?match([], orber_test_lib:remote_apply(ServerNode, orber, + ?match([], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - ?match([], orber_test_lib:remote_apply(ClientNode, orber, + ?match([], orber_test_lib:remote_apply(ClientNode, orber, iiop_connections, [out])), ok. -close_connections_alt_iiop_addr_api(doc) -> - ["IIOP alternate address disconnect tests", +close_connections_alt_iiop_addr_api(doc) -> + ["IIOP alternate address disconnect tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; close_connections_alt_iiop_addr_api(suite) -> []; @@ -1137,12 +1163,12 @@ close_connections_alt_iiop_addr_api(_Config) -> %% --- Create a slave-node --- Loopback = orber_test_lib:get_loopback_interface(), IP = orber_test_lib:get_host(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{giop_version, {1, 2}}, {ip_address, {multiple, [IP, Loopback]}}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [{nameservice, Loopback, ServerPort}])), %% Create two connections Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, @@ -1151,25 +1177,25 @@ close_connections_alt_iiop_addr_api(_Config) -> ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.2@"++Loopback++":"++ integer_to_list(ServerPort)++"/NameService#mamba")), - timer:sleep(2000), + timer:sleep(2000), %% The connection shall still be up and running ?match([{_,_}, {_,_}], orber:iiop_connections(out)), ?match([{_,_}, {_,_}], - orber_test_lib:remote_apply(ServerNode, orber, + orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - + %% Try to close the connection ?match(ok, orber:close_connection(Obj)), %% Wait a moment so that both sides has detected it. timer:sleep(5000), %% Now the connections shall be gone. ?match([], orber:iiop_connections(out)), - ?match([], orber_test_lib:remote_apply(ServerNode, orber, + ?match([], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ok. -close_connections_multiple_profiles_api(doc) -> - ["IIOP alternate address disconnect tests", +close_connections_multiple_profiles_api(doc) -> + ["IIOP alternate address disconnect tests", "This case test if the server ORB use the correct", "local interface when connecting to another ORB"]; close_connections_multiple_profiles_api(suite) -> []; @@ -1177,11 +1203,11 @@ close_connections_multiple_profiles_api(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), %% --- Create a slave-node --- - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, {multiple, [Loopback, IP]}}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, install_test_data, [nameservice])), %% Create two connections Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, @@ -1193,23 +1219,23 @@ close_connections_multiple_profiles_api(_Config) -> %% The connection shall still be up and running ?match([{_,_}, {_,_}], orber:iiop_connections(out)), ?match([{_,_}, {_,_}], - orber_test_lib:remote_apply(ServerNode, orber, + orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), - + %% Try to close the connection ?match(ok, orber:close_connection(Obj)), %% Wait a moment so that both sides has detected it. timer:sleep(5000), %% Now the connections shall be gone. ?match([], orber:iiop_connections(out)), - ?match([], orber_test_lib:remote_apply(ServerNode, orber, + ?match([], orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])), ok. %%----------------------------------------------------------------- %% API tests for ORB to ORB with iiop_packet_size set %%----------------------------------------------------------------- -max_packet_size_exceeded_api(doc) -> +max_packet_size_exceeded_api(doc) -> ["Exceed the maximum request size"]; max_packet_size_exceeded_api(suite) -> []; max_packet_size_exceeded_api(_Config) -> @@ -1219,11 +1245,11 @@ max_packet_size_exceeded_api(_Config) -> {ok, LS} -> (catch gen_tcp:close(LS)), %% --- Create a slave-node --- - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_packet_size, 1}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}}, + ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}}, corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")), ok end. @@ -1231,7 +1257,7 @@ max_packet_size_exceeded_api(_Config) -> %%----------------------------------------------------------------- %% API tests for ORB to ORB with iiop_packet_size set %%----------------------------------------------------------------- -max_packet_size_ok_api(doc) -> +max_packet_size_ok_api(doc) -> ["Not exceed the maximum request size"]; max_packet_size_ok_api(suite) -> []; max_packet_size_ok_api(_Config) -> @@ -1241,7 +1267,7 @@ max_packet_size_ok_api(_Config) -> {ok, LS} -> (catch gen_tcp:close(LS)), %% --- Create a slave-node --- - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_packet_size, 5000}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), @@ -1251,7 +1277,7 @@ max_packet_size_ok_api(_Config) -> end. - + %%----------------------------------------------------------------- %% API tests for ORB to ORB, no security %%----------------------------------------------------------------- @@ -1259,49 +1285,49 @@ max_packet_size_ok_api(_Config) -> light_ifr_api(doc) -> ["LIGHT IFR ORB API tests"]; light_ifr_api(suite) -> []; light_ifr_api(_Config) -> - - {ok, ClientNode, _ClientHost} = + + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, 128}])), ?match([_,_,_,_], orber_test_lib:remote_apply(ClientNode, orber, get_tables, [])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + install_test_data, [nameservice])), - {ok, ServerNode, ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node([{flags, 128}])), + {ok, ServerNode, ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node([{flags, 128}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), ?match([_,_,_,_], orber_test_lib:remote_apply(ServerNode, orber, get_tables, [])), - Obj = ?match({'IOP_IOR',_,_}, + Obj = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaname::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService#mamba")), ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, test_coding, [Obj])), ?match(0, orber_test_lib:remote_apply(ClientNode, orber_diagnostics, missing_modules, [])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, + ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, [#orber_light_ifr{id = "FakeId1", - module=non_existing, + module=non_existing, type=?IFR_StructDef}])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, + ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, [#orber_light_ifr{id = "FakeId2", - module=non_existing, + module=non_existing, type=?IFR_UnionDef}])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, + ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, [#orber_light_ifr{id = "FakeId3", - module=non_existing, + module=non_existing, type=?IFR_ExceptionDef}])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, + ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, [#orber_light_ifr{id = "FakeId4", - module=non_existing, + module=non_existing, type=?IFR_InterfaceDef}])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, + ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write, [#orber_light_ifr{id = "FakeId5", - module=orber_test_lib, + module=orber_test_lib, type=?IFR_InterfaceDef}])), ?match(5, orber_test_lib:remote_apply(ClientNode, orber_diagnostics, missing_modules, [])), @@ -1316,14 +1342,14 @@ light_ifr_api(_Config) -> absolute_name="::Module::NonExisting"})), ?match(ok, mnesia:dirty_write(#ir_InterfaceDef{ir_Internal_ID = "FakedIId5", absolute_name="::orber::test::lib"})), - + ?match(5, orber_diagnostics:missing_modules()), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, [nameservice])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + uninstall_test_data, [nameservice])), ok. @@ -1331,23 +1357,23 @@ light_ifr_api(_Config) -> %% API tests for ORB to ORB, no security %%----------------------------------------------------------------- -light_orber_api(doc) -> ["LIGHT ORB API tests", +light_orber_api(doc) -> ["LIGHT ORB API tests", "This case test if a light Orber can communicate correctly", "with an fully installed Orber."]; light_orber_api(suite) -> []; light_orber_api(_Config) -> %% --- Create a slave-node --- LocalHost = net_adm:localhost(), - {ok, Node, _Host} = + {ok, Node, _Host} = ?match({ok,_,_}, orber_test_lib:js_node([{lightweight, ["iiop://"++LocalHost++":"++integer_to_list(orber:iiop_port())]}], lightweight)), ?match(ok, orber:info(io)), ?match([_], orber_test_lib:remote_apply(Node, orber_env, get_lightweight_nodes,[])), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [light])), - + Obj1=(catch orber_test_server:oe_create(state,[{pseudo,true}])), ?match({_,pseudo,orber_test_server_impl, _,_, _}, Obj1), Obj2=(catch orber_test_server:oe_create(state,[])), @@ -1357,11 +1383,11 @@ light_orber_api(_Config) -> 'CosNaming_NamingContext':bind(NS, lname:new(["mamba"]), Obj1), 'CosNaming_NamingContext':bind(NS, lname:new(["viper"]), Obj2), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, light_tests, [LocalHost, orber:iiop_port(), "viper"])), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, light_tests, [LocalHost, orber:iiop_port(), "mamba"])), @@ -1370,17 +1396,17 @@ light_orber_api(_Config) -> catch corba:dispose(Obj1), catch corba:dispose(Obj2), - catch 'CosNaming_NamingContext':destroy(NS), + catch 'CosNaming_NamingContext':destroy(NS), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [light])), ok. %%----------------------------------------------------------------- %% API tests for ORB to ORB, no security %%----------------------------------------------------------------- -light_orber2_api(doc) -> ["LIGHT ORB API tests", +light_orber2_api(doc) -> ["LIGHT ORB API tests", "This case test if a light Orber can communicate correctly", "with an fully installed Orber. This case test if we can", "start as lightweight without first setting the environment", @@ -1389,16 +1415,16 @@ light_orber2_api(suite) -> []; light_orber2_api(_Config) -> %% --- Create a slave-node --- LocalHost = net_adm:localhost(), - {ok, Node, _Host} = - ?match({ok,_,_}, orber_test_lib:js_node([], + {ok, Node, _Host} = + ?match({ok,_,_}, orber_test_lib:js_node([], {lightweight, ["iiop://"++LocalHost++":"++integer_to_list(orber:iiop_port())]})), ?match(ok, orber:info(io)), ?match([_], orber_test_lib:remote_apply(Node, orber_env, get_lightweight_nodes,[])), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [light])), - + Obj1=(catch orber_test_server:oe_create(state,[{pseudo,true}])), ?match({_,pseudo,orber_test_server_impl, _,_, _}, Obj1), Obj2=(catch orber_test_server:oe_create(state,[])), @@ -1407,12 +1433,12 @@ light_orber2_api(_Config) -> NS = corba:resolve_initial_references("NameService"), 'CosNaming_NamingContext':bind(NS, lname:new(["mamba"]), Obj1), 'CosNaming_NamingContext':bind(NS, lname:new(["viper"]), Obj2), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, light_tests, [LocalHost, orber:iiop_port(), "viper"])), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, light_tests, [LocalHost, orber:iiop_port(), "mamba"])), @@ -1421,10 +1447,10 @@ light_orber2_api(_Config) -> catch corba:dispose(Obj1), catch corba:dispose(Obj2), - catch 'CosNaming_NamingContext':destroy(NS), + catch 'CosNaming_NamingContext':destroy(NS), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [light])), ok. @@ -1432,13 +1458,13 @@ light_orber2_api(_Config) -> %% API tests for ORB to ORB, no security %%----------------------------------------------------------------- -multi_orber_api(doc) -> ["MULTI ORB API tests", +multi_orber_api(doc) -> ["MULTI ORB API tests", "This case test if data encode/decode (IIOP)", "produce the correct result, i.e., the test_server echos", "the input parameter or an exception is raised (MARSHAL)."]; multi_orber_api(suite) -> []; multi_orber_api(_Config) -> - + NewICObj1 = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([])), NewICObj2 = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{regname, {local, newic2}}])), NewICObj3 = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{regname, {global, newic3}}])), @@ -1448,34 +1474,34 @@ multi_orber_api(_Config) -> catch corba:dispose(NewICObj1), catch corba:dispose(NewICObj2), catch corba:dispose(NewICObj3), - + %% --- Create a slave-node --- - {ok, Node, Host} = - ?match({ok,_,_}, orber_test_lib:js_node()), + {ok, Node, Host} = + ?match({ok,_,_}, orber_test_lib:js_node()), Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [nameservice])), - + NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_}, corba:string_to_object("corbaloc::1.2@"++Host++":"++ integer_to_list(Port)++"/NameService")), - + ?match({'EXCEPTION',{'CosNaming_NamingContext_NotFound',_,_,_}}, 'CosNaming_NamingContext':resolve(NSR, lname:new(["not_exist"]))), - Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))), ?match(ok, orber_test_server:print(Obj)), - Obj12B = ?match({'IOP_IOR',_,_}, + Obj12B = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.2@"++Host++":"++integer_to_list(Port)++"/Mamba")), - - Obj11B = ?match({'IOP_IOR',_,_}, + + Obj11B = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.1@"++Host++":"++integer_to_list(Port)++"/Mamba")), - Obj10B = ?match({'IOP_IOR',_,_}, + Obj10B = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Mamba")), context_test(Obj12B), @@ -1484,7 +1510,7 @@ multi_orber_api(_Config) -> ?match(ok, orber_test_server:print(Obj12B)), ?match(ok, orber_test_server:print(Obj11B)), ?match(ok, orber_test_server:print(Obj10B)), - ?match({'EXCEPTION',{'CosNaming_NamingContextExt_InvalidAddress',_}}, + ?match({'EXCEPTION',{'CosNaming_NamingContextExt_InvalidAddress',_}}, corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Wrong")), ?match(ok, orber_test_lib:corba_object_tests(Obj12B, NSR)), @@ -1493,22 +1519,22 @@ multi_orber_api(_Config) -> %%--- Testing code and decode arguments --- orber_test_lib:test_coding(Obj), - - ?match({'EXCEPTION',#'BAD_CONTEXT'{}}, + + ?match({'EXCEPTION',#'BAD_CONTEXT'{}}, orber_test_server: - print(Obj12B, + print(Obj12B, [{context, - [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, - context_data = {interface, + [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {interface, {127,0,0,1}}}]}])), - - ?match({'EXCEPTION',{'TRANSIENT',_,_,_}}, + + ?match({'EXCEPTION',{'TRANSIENT',_,_,_}}, orber_test_server:stop_brutal(Obj12B)), - ?match({'EXCEPTION',{'TRANSIENT',_,_,_}}, + ?match({'EXCEPTION',{'TRANSIENT',_,_,_}}, orber_test_server:print(Obj12B)), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [nameservice])), ok. @@ -1516,9 +1542,9 @@ multi_orber_api(_Config) -> %%----------------------------------------------------------------- %% API tests for ORB to ORB, no security, using basic interceptors %%----------------------------------------------------------------- -basic_PI_api(doc) -> ["MULTI ORB API tests", +basic_PI_api(doc) -> ["MULTI ORB API tests", "This case test if data encode/decode (IIOP)", - "produce the correct result when using basic interceptors,", + "produce the correct result when using basic interceptors,", "i.e., the test_server echos", "the input parameter or an exception is raised (MARSHAL)."]; basic_PI_api(suite) -> []; @@ -1526,21 +1552,21 @@ basic_PI_api(_Config) -> %% Change configuration to use Basic Interceptors. orber:configure_override(interceptors, {native, [orber_test_lib]}), %% --- Create a slave-node --- - {ok, Node, Host} = - ?match({ok,_,_}, orber_test_lib:js_node([{interceptors, {native, [orber_test_lib]}}])), + {ok, Node, Host} = + ?match({ok,_,_}, orber_test_lib:js_node([{interceptors, {native, [orber_test_lib]}}])), Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [nameservice])), - - Obj12 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + + Obj12 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.2@"++Host++":"++integer_to_list(Port)++"/NameService#mamba")), - - Obj11 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + + Obj11 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.1@"++Host++":"++integer_to_list(Port)++"/NameService#mamba")), - - Obj10 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + + Obj10 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.0@"++Host++":"++integer_to_list(Port)++"/NameService#mamba")), ?match(ok, corba:print_object(Obj12)), @@ -1552,13 +1578,13 @@ basic_PI_api(_Config) -> ?match(ok, orber_test_server:print(Obj10)), - Obj12B = ?match({'IOP_IOR',_,_}, + Obj12B = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.2@"++Host++":"++integer_to_list(Port)++"/Mamba")), - - Obj11B = ?match({'IOP_IOR',_,_}, + + Obj11B = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.1@"++Host++":"++integer_to_list(Port)++"/Mamba")), - - Obj10B = ?match({'IOP_IOR',_,_}, + + Obj10B = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Mamba")), ?match(ok, corba:print_object(Obj12B, info_msg)), @@ -1568,7 +1594,7 @@ basic_PI_api(_Config) -> ?match(ok, orber_test_server:print(Obj12B)), ?match(ok, orber_test_server:print(Obj11B)), ?match(ok, orber_test_server:print(Obj10B)), - ?match({'EXCEPTION',{'CosNaming_NamingContextExt_InvalidAddress',_}}, + ?match({'EXCEPTION',{'CosNaming_NamingContextExt_InvalidAddress',_}}, corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Wrong")), ?match(ok, orber_test_lib:alternate_iiop_address(Host, Port)), @@ -1583,8 +1609,8 @@ basic_PI_api(_Config) -> application:set_env(orber, interceptors, false), - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + uninstall_test_data, [nameservice])), ok. @@ -1593,62 +1619,95 @@ basic_PI_api(_Config) -> %% API tests for ORB to ORB, ssl security depth 1 %%----------------------------------------------------------------- -ssl_1_multi_orber_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", +ssl_1_multi_orber_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", "secure orbs which must raise a NO_PERMISSION exception."]; ssl_1_multi_orber_api(suite) -> []; ssl_1_multi_orber_api(_Config) -> - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, 1, [{iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, 1, [{iiop_ssl_port, 0}]), ssl_suite(ServerOptions, ClientOptions). - -ssl_1_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", + + +ssl_1_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", + "This case set up two secure orbs and test if they can", + "communicate. The case also test to access one of the", + "secure orbs which must raise a NO_PERMISSION exception."]; +ssl_1_multi_orber_generation_3_api_old(suite) -> []; +ssl_1_multi_orber_generation_3_api_old(_Config) -> + + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, + 1, [{ssl_generation, 3}, + {iiop_ssl_port, 0}]), + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, + 1, [{ssl_generation, 3}, + {iiop_ssl_port, 0}]), + ssl_suite(ServerOptions, ClientOptions). + + +ssl_1_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", "secure orbs which must raise a NO_PERMISSION exception."]; ssl_1_multi_orber_generation_3_api(suite) -> []; ssl_1_multi_orber_generation_3_api(_Config) -> - - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, + + ServerOptions = orber_test_lib:get_options(iiop_ssl, server, 1, [{ssl_generation, 3}, {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options(iiop_ssl, client, 1, [{ssl_generation, 3}, {iiop_ssl_port, 0}]), ssl_suite(ServerOptions, ClientOptions). - %%----------------------------------------------------------------- %% API tests for ORB to ORB, ssl security depth 2 %%----------------------------------------------------------------- -ssl_2_multi_orber_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", +ssl_2_multi_orber_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", "secure orbs which must raise a NO_PERMISSION exception."]; ssl_2_multi_orber_api(suite) -> []; -ssl_2_multi_orber_api(_Config) -> - - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, +ssl_2_multi_orber_api(_Config) -> + + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, 2, [{iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, 2, [{iiop_ssl_port, 0}]), ssl_suite(ServerOptions, ClientOptions). -ssl_2_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", + +ssl_2_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", + "This case set up two secure orbs and test if they can", + "communicate. The case also test to access one of the", + "secure orbs which must raise a NO_PERMISSION exception."]; +ssl_2_multi_orber_generation_3_api_old(suite) -> []; +ssl_2_multi_orber_generation_3_api_old(_Config) -> + + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, + 2, [{ssl_generation, 3}, + {iiop_ssl_port, 0}]), + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, + 2, [{ssl_generation, 3}, + {iiop_ssl_port, 0}]), + ssl_suite(ServerOptions, ClientOptions). + + +ssl_2_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", "secure orbs which must raise a NO_PERMISSION exception."]; ssl_2_multi_orber_generation_3_api(suite) -> []; -ssl_2_multi_orber_generation_3_api(_Config) -> - - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, +ssl_2_multi_orber_generation_3_api(_Config) -> + + ServerOptions = orber_test_lib:get_options(iiop_ssl, server, 2, [{ssl_generation, 3}, {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options(iiop_ssl, client, 2, [{ssl_generation, 3}, {iiop_ssl_port, 0}]), ssl_suite(ServerOptions, ClientOptions). @@ -1656,77 +1715,135 @@ ssl_2_multi_orber_generation_3_api(_Config) -> %% API tests for ORB to ORB, ssl security depth 2 %%----------------------------------------------------------------- -ssl_reconfigure_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", +ssl_reconfigure_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", "secure orbs which must raise a NO_PERMISSION exception."]; ssl_reconfigure_api(suite) -> []; -ssl_reconfigure_api(_Config) -> - ssl_reconfigure([]). +ssl_reconfigure_api(_Config) -> + ssl_reconfigure_old([]). + -ssl_reconfigure_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", +ssl_reconfigure_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", + "This case set up two secure orbs and test if they can", + "communicate. The case also test to access one of the", + "secure orbs which must raise a NO_PERMISSION exception."]; +ssl_reconfigure_generation_3_api_old(suite) -> []; +ssl_reconfigure_generation_3_api_old(_Config) -> + ssl_reconfigure_old([{ssl_generation, 3}]). + +ssl_reconfigure_old(ExtraSSLOptions) -> + + IP = orber_test_lib:get_host(), + Loopback = orber_test_lib:get_loopback_interface(), + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, + orber_test_lib:js_node([{iiop_port, 0}, + {flags, ?ORB_ENV_LOCAL_INTERFACE}, + {ip_address, IP}|ExtraSSLOptions])), + orber_test_lib:remote_apply(ServerNode, ssl, start, []), + orber_test_lib:remote_apply(ServerNode, crypto, start, []), + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, + [ssl])), + ?match({ok, _}, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, + [Loopback, normal, [{iiop_port, 5648}, + {iiop_ssl_port, 5649}, + {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]])), + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, + 2, [{flags, ?ORB_ENV_LOCAL_INTERFACE}, + {iiop_port, 5648}, + {iiop_ssl_port, 5649}, + {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]), + ?match({ok, _}, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, + [Loopback, ssl, ServerOptions])), + + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, + 2, [{iiop_ssl_port, 0}|ExtraSSLOptions]), + {ok, ClientNode, _ClientHost} = + ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), + + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + install_test_data, + [ssl])), + orber_test_lib:remote_apply(ClientNode, ssl, start, []), + orber_test_lib:remote_apply(ServerNode, crypto, start, []), + Obj = ?match(#'IOP_IOR'{}, + orber_test_lib:remote_apply(ClientNode, corba, + string_to_object, ["corbaname:iiop:1.1@"++Loopback++":5648/NameService#mamba", + [{context, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + context_data = {configuration, ClientOptions}}]}]])), + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_server, + print, [Obj])). + + +ssl_reconfigure_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", "secure orbs which must raise a NO_PERMISSION exception."]; ssl_reconfigure_generation_3_api(suite) -> []; -ssl_reconfigure_generation_3_api(_Config) -> +ssl_reconfigure_generation_3_api(_Config) -> ssl_reconfigure([{ssl_generation, 3}]). + ssl_reconfigure(ExtraSSLOptions) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, - orber_test_lib:js_node([{iiop_port, 0}, - {flags, ?ORB_ENV_LOCAL_INTERFACE}, + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, + orber_test_lib:js_node([{iiop_port, 0}, + {flags, ?ORB_ENV_LOCAL_INTERFACE}, {ip_address, IP}|ExtraSSLOptions])), orber_test_lib:remote_apply(ServerNode, ssl, start, []), orber_test_lib:remote_apply(ServerNode, crypto, start, []), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [ssl])), - ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + ?match({ok, _}, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [Loopback, normal, [{iiop_port, 5648}, {iiop_ssl_port, 5649}, {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]])), - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, - 2, [{flags, ?ORB_ENV_LOCAL_INTERFACE}, + ServerOptions = orber_test_lib:get_options(iiop_ssl, server, + 2, [{flags, ?ORB_ENV_LOCAL_INTERFACE}, {iiop_port, 5648}, {iiop_ssl_port, 5649}, {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]), - ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + ?match({ok, _}, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [Loopback, ssl, ServerOptions])), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options(iiop_ssl, client, 2, [{iiop_ssl_port, 0}|ExtraSSLOptions]), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + install_test_data, [ssl])), orber_test_lib:remote_apply(ClientNode, ssl, start, []), orber_test_lib:remote_apply(ServerNode, crypto, start, []), - Obj = ?match(#'IOP_IOR'{}, + Obj = ?match(#'IOP_IOR'{}, orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaname:iiop:1.1@"++Loopback++":5648/NameService#mamba", - [{context, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + [{context, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, context_data = {configuration, ClientOptions}}]}]])), - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_server, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_server, print, [Obj])). - %%----------------------------------------------------------------- %% API tests for Orber to Java ORB, no security %%----------------------------------------------------------------- -%orber_java_api(doc) -> ["ERLANG-ORB <-> JAVA-ORB API tests", +%orber_java_api(doc) -> ["ERLANG-ORB <-> JAVA-ORB API tests", % "This case test if data encode/decode (IIOP)", % "produce the correct result, i.e., the test_server echos", % "the input parameter or an exception is raised (MARSHAL)."]; @@ -1739,38 +1856,38 @@ ssl_reconfigure(ExtraSSLOptions) -> %% Arguments: Config %% Depth %% Returns : ok -%% Effect : +%% Effect : %%------------------------------------------------------------ ssl_suite(ServerOptions, ClientOptions) -> - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [ssl])), %% Tell the client to interoperate with the server. The purpose of this %% operation is to look up, using NameService, an object reference and %% use it to contact the object. - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, lookup, [ServerHost, ServerPort])), - - ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, + + ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, alternate_ssl_iiop_address, [ServerHost, ServerPort, SSLServerPort])), - + %% 'This' node is not secure. Contact the server. Must refuse connection. NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_}, corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++ integer_to_list(ServerPort)++"/NameService")), - + %% Should be 'NO_PERMISSION'?? ?match({'EXCEPTION',{'COMM_FAILURE',_,_,_}}, 'CosNaming_NamingContext':resolve(NSR, lname:new(["not_exist"]))), @@ -1780,8 +1897,8 @@ ssl_suite(ServerOptions, ClientOptions) -> 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))), %% Uninstall. - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, [ssl])), ok. @@ -1793,7 +1910,7 @@ setup_connection_timeout_api(suite) -> []; setup_connection_timeout_api(_Config) -> ?match(ok, application:set_env(orber, iiop_backlog, 0)), %% Wait to be sure that the configuration has kicked in. - timer:sleep(2000), + timer:sleep(2000), {ok, Ref, Port} = create_fake_server_ORB(normal, 0, [], listen, []), ?match(ok, orber:configure(iiop_setup_connection_timeout, 5)), ?match(ok, orber:info(io)), @@ -1813,7 +1930,7 @@ setup_connection_timeout_api(_Config) -> %%----------------------------------------------------------------- %% iiop_setup_connection_timeout API tests for ORB to ORB. %%----------------------------------------------------------------- -setup_multi_connection_timeout_api(doc) -> +setup_multi_connection_timeout_api(doc) -> ["iiop_multi_setup_connection_timeout API tests for ORB to ORB."]; setup_multi_connection_timeout_api(suite) -> []; setup_multi_connection_timeout_api(_Config) -> @@ -1838,7 +1955,7 @@ setup_multi_connection_timeout_api(_Config) -> ?match(ok, application:set_env(orber, iiop_out_ports, undefined)), ok. -setup_multi_connection_timeout_attempts_api(doc) -> +setup_multi_connection_timeout_attempts_api(doc) -> ["iiop_multi_setup_connection_timeout API tests for ORB to ORB."]; setup_multi_connection_timeout_attempts_api(suite) -> []; setup_multi_connection_timeout_attempts_api(_Config) -> @@ -1864,7 +1981,7 @@ setup_multi_connection_timeout_attempts_api(_Config) -> ?match(ok, application:set_env(orber, iiop_out_ports, undefined)), ok. -setup_multi_connection_timeout_random_api(doc) -> +setup_multi_connection_timeout_random_api(doc) -> ["iiop_multi_setup_connection_timeout API tests for ORB to ORB."]; setup_multi_connection_timeout_random_api(suite) -> []; setup_multi_connection_timeout_random_api(_Config) -> @@ -1899,17 +2016,17 @@ bad_giop_header_api(_Config) -> orber:configure_override(interceptors, {native,[orber_iiop_tracer]}), orber:configure(orber_debug_level, 10), ?match(ok, orber:info(io)), - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node()), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), Req = <<"GIOP",1,2,0,100,0,0,0,5,0,0,0,10,50>> , - ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], + ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], message_error, [Req])), - + application:set_env(orber, interceptors, false), orber:configure(orber_debug_level, 0), ok. - + %%----------------------------------------------------------------- %% Fragmented IIOP tests (Server-side). @@ -1927,34 +2044,34 @@ fragments_server_api(doc) -> ["fragments API tests for server-side ORB."]; fragments_server_api(suite) -> []; fragments_server_api(_Config) -> %% --- Create a slave-node --- - {ok, Node, Host} = - ?match({ok,_,_}, orber_test_lib:js_node()), + {ok, Node, Host} = + ?match({ok,_,_}, orber_test_lib:js_node()), Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []), - - ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, - install_test_data, + + ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib, + install_test_data, [nameservice])), - + NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_}, corba:string_to_object("corbaloc::1.2@"++Host++":"++ integer_to_list(Port)++"/NameService")), - - Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + + Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))), Any = #any{typecode = {tk_string,0}, value = "123"}, - Target = #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, + Target = #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, value = iop_ior:get_objkey(Obj)}, - %% Fix a request header. + %% Fix a request header. {Hdr, Body, HdrLen, _What, _Flags} = cdr_encode:enc_request_split( - #giop_env{version = {1,2}, objkey = Target, + #giop_env{version = {1,2}, objkey = Target, request_id = ?REQUEST_ID, - response_expected = true, - op = testing_iiop_any, - parameters = [49], ctx = [], - tc = {tk_void,[tk_char],[]}, + response_expected = true, + op = testing_iiop_any, + parameters = [49], ctx = [], + tc = {tk_void,[tk_char],[]}, host = [orber_test_lib:get_host()], iiop_port = orber:iiop_port(), iiop_ssl_port = orber:iiop_ssl_port(), @@ -1969,11 +2086,11 @@ fragments_server_api(_Config) -> <<AligmnetData:Aligned/binary,49>> = Body, list_to_binary([AligmnetData, <<0,0,0,18,0,0,0,0,0,0,0,4,49>> ]) end, - + MessSize = HdrLen+size(NewBody), ReqFrag = list_to_binary([ <<"GIOP",1:8,2:8,2:8,0:8, MessSize:32/big-unsigned-integer>> , Hdr |NewBody]), - ?match(Any, fake_client_ORB(normal, Host, Port, [], fragments, + ?match(Any, fake_client_ORB(normal, Host, Port, [], fragments, [ReqFrag, ?FRAG_2, ?FRAG_3, ?FRAG_4])), ok. @@ -1986,9 +2103,9 @@ fragments_max_server_api(suite) -> []; fragments_max_server_api(_Config) -> %% --- Create a slave-node --- IP = orber_test_lib:get_host(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{iiop_max_fragments, 2}, - {ip_address, IP}])), + {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), fragments_max_server(ServerNode, IP, ServerPort). @@ -1997,37 +2114,37 @@ fragments_max_server_added_api(suite) -> []; fragments_max_server_added_api(_Config) -> %% --- Create a slave-node --- IP = orber_test_lib:get_host(), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node([])), + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node([])), ServerPort = 1 + orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, normal, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, + [IP, normal, [{iiop_max_fragments, 2}, {flags, ?ORB_ENV_LOCAL_INTERFACE}, {iiop_port, ServerPort}]])), fragments_max_server(ServerNode, IP, ServerPort). fragments_max_server(ServerNode, ServerHost, ServerPort) -> - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [nameservice])), Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname::1.2@"++ServerHost++":"++ integer_to_list(ServerPort)++"/NameService#mamba")), - Target = #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, + Target = #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, value = iop_ior:get_objkey(Obj)}, - %% Fix a request header. + %% Fix a request header. {Hdr, Body, HdrLen, _What, _Flags} = cdr_encode:enc_request_split( - #giop_env{version = {1,2}, - objkey = Target, - request_id = ?REQUEST_ID, - response_expected = true, - op = testing_iiop_any, - parameters = [49], ctx = [], - tc = {tk_void,[tk_char],[]}, + #giop_env{version = {1,2}, + objkey = Target, + request_id = ?REQUEST_ID, + response_expected = true, + op = testing_iiop_any, + parameters = [49], ctx = [], + tc = {tk_void,[tk_char],[]}, host = [orber_test_lib:get_host()], iiop_port = orber:iiop_port(), iiop_ssl_port = orber:iiop_ssl_port(), @@ -2046,8 +2163,8 @@ fragments_max_server(ServerNode, ServerHost, ServerPort) -> MessSize = HdrLen+size(NewBody), ReqFrag = list_to_binary([ <<"GIOP",1:8,2:8,2:8,0:8, MessSize:32/big-unsigned-integer>> , Hdr |NewBody]), - ?match(#'IMP_LIMIT'{}, - fake_client_ORB(normal, ServerHost, ServerPort, [], fragments_max, + ?match(#'IMP_LIMIT'{}, + fake_client_ORB(normal, ServerHost, ServerPort, [], fragments_max, [ReqFrag, ?FRAG_2, ?FRAG_3, ?FRAG_4])), ok. @@ -2063,11 +2180,11 @@ fragments_client_api(_Config) -> application:set_env(orber, interceptors, {native,[orber_iiop_tracer]}), orber:configure(orber_debug_level, 10), orber:info(), - IOR = ?match({'IOP_IOR',_,_}, - iop_ior:create_external({1, 2}, "IDL:FAKE:1.0", + IOR = ?match({'IOP_IOR',_,_}, + iop_ior:create_external({1, 2}, "IDL:FAKE:1.0", "localhost", 6004, "FAKE", [])), - spawn(?MODULE, create_fake_server_ORB, [normal, 6004, [], fragments, - [?REPLY_FRAG_1, ?FRAG_2, + spawn(?MODULE, create_fake_server_ORB, [normal, 6004, [], fragments, + [?REPLY_FRAG_1, ?FRAG_2, ?FRAG_3, ?FRAG_4]]), ?match({ok, Any}, orber_test_server:testing_iiop_any(IOR, Any)), application:set_env(orber, interceptors, false), @@ -2083,16 +2200,16 @@ bad_fragment_id_client_api(_Config) -> application:set_env(orber, interceptors, {native,[orber_iiop_tracer]}), orber:configure(orber_debug_level, 10), orber:info(), - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node()), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), Req = <<71,73,79,80,1,2,2,7,0,0,0,5,0,0,0,100,50>> , - ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], + ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], message_error, [Req])), - + application:set_env(orber, interceptors, false), orber:configure(orber_debug_level, 0), - + ok. %%----------------------------------------------------------------- @@ -2100,22 +2217,22 @@ bad_fragment_id_client_api(_Config) -> %%----------------------------------------------------------------- bad_id_cancel_request_api(doc) -> ["Description", "more description"]; bad_id_cancel_request_api(suite) -> []; -bad_id_cancel_request_api(Config) when is_list(Config) -> - Req10 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 0}, +bad_id_cancel_request_api(Config) when is_list(Config) -> + Req10 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 0}, request_id = 556}), - Req11 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 1}, + Req11 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 1}, request_id = 556}), - Req12 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 2}, + Req12 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 2}, request_id = 556}), - {ok, ServerNode, ServerHost} = + {ok, ServerNode, ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node()), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], - message_error, [Req10])), - ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], - message_error, [Req11])), - ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], - message_error, [Req12])), + ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], + message_error, [Req10])), + ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], + message_error, [Req11])), + ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [], + message_error, [Req12])), ok. %%----------------------------------------------------------------- @@ -2131,141 +2248,141 @@ pseudo_calls(0, _) -> pseudo_calls(Times, Obj) -> orber_test_server:pseudo_call(Obj), New = Times - 1, - pseudo_calls(New, Obj). + pseudo_calls(New, Obj). pseudo_casts(0, _) -> ok; pseudo_casts(Times, Obj) -> orber_test_server:pseudo_cast(Obj), New = Times - 1, - pseudo_casts(New, Obj). + pseudo_casts(New, Obj). context_test(Obj) -> - CodeSetCtx = #'CONV_FRAME_CodeSetContext'{char_data = 65537, + CodeSetCtx = #'CONV_FRAME_CodeSetContext'{char_data = 65537, wchar_data = 65801}, FTGrp = #'FT_FTGroupVersionServiceContext'{object_group_ref_version = ?ULONGMAX}, - FTReq = #'FT_FTRequestServiceContext'{client_id = "ClientId", - retention_id = ?LONGMAX, + FTReq = #'FT_FTRequestServiceContext'{client_id = "ClientId", + retention_id = ?LONGMAX, expiration_time = ?ULONGLONGMAX}, - IDToken1 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent, + IDToken1 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent, value = true}, - IDToken2 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAnonymous, + IDToken2 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAnonymous, value = false}, - IDToken3 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTPrincipalName, + IDToken3 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTPrincipalName, value = [0,255]}, - IDToken4 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTX509CertChain, + IDToken4 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTX509CertChain, value = [1,255]}, - IDToken5 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTDistinguishedName, + IDToken5 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTDistinguishedName, value = [2,255]}, - IDToken6 = #'CSI_IdentityToken'{label = ?ULONGMAX, + IDToken6 = #'CSI_IdentityToken'{label = ?ULONGMAX, value = [3,255]}, MTEstablishContext1 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken1, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken1, client_authentication_token = [1, 255]}}, MTEstablishContext2 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken2, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken2, client_authentication_token = [1, 255]}}, MTEstablishContext3 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken3, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken3, client_authentication_token = [1, 255]}}, MTEstablishContext4 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken4, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken4, client_authentication_token = [1, 255]}}, MTEstablishContext5 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken5, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken5, client_authentication_token = [1, 255]}}, MTEstablishContext6 = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTEstablishContext, - value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, - authorization_token = + {label = ?CSI_MsgType_MTEstablishContext, + value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX, + authorization_token = [#'CSI_AuthorizationElement' - {the_type = ?ULONGMAX, - the_element = [0,255]}], - identity_token = IDToken6, + {the_type = ?ULONGMAX, + the_element = [0,255]}], + identity_token = IDToken6, client_authentication_token = [1, 255]}}, MTCompleteEstablishContext = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTCompleteEstablishContext, - value = #'CSI_CompleteEstablishContext'{client_context_id = ?ULONGLONGMAX, + {label = ?CSI_MsgType_MTCompleteEstablishContext, + value = #'CSI_CompleteEstablishContext'{client_context_id = ?ULONGLONGMAX, context_stateful = false, final_context_token = [1, 255]}}, MTContextError = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTContextError, + {label = ?CSI_MsgType_MTContextError, value = #'CSI_ContextError'{client_context_id = ?ULONGLONGMAX, - major_status = 1, - minor_status = 2, + major_status = 1, + minor_status = 2, error_token = [2,255]}}, MTMessageInContext = #'CSI_SASContextBody' - {label = ?CSI_MsgType_MTMessageInContext, - value = #'CSI_MessageInContext'{client_context_id = ?ULONGLONGMAX, + {label = ?CSI_MsgType_MTMessageInContext, + value = #'CSI_MessageInContext'{client_context_id = ?ULONGLONGMAX, discard_context = true}}, - Ctx = [#'IOP_ServiceContext'{context_id=?IOP_CodeSets, + Ctx = [#'IOP_ServiceContext'{context_id=?IOP_CodeSets, context_data = CodeSetCtx}, - #'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION, + #'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION, context_data = FTGrp}, - #'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST, + #'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST, context_data = FTReq}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext1}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext2}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext3}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext4}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext5}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTEstablishContext6}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTCompleteEstablishContext}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTContextError}, - #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, + #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, context_data = MTMessageInContext}, - #'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, + #'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, context_data = {any_kind_of_data, {127,0,0,1}, 4001}}], ?match(ok, orber_test_server:testing_iiop_context(Obj, [{context, Ctx}])). create_fake_server_ORB(Type, Port, Options, listen, _Data) -> {ok, _ListenSocket, NewPort} = - orber_socket:listen(Type, Port, + orber_socket:listen(Type, Port, [{backlog, 0}, {active, false}|Options]), Socket = orber_socket:connect(Type, 'localhost', NewPort, [{active, false}|Options]), {ok, {Type, Socket}, NewPort}; create_fake_server_ORB(Type, Port, Options, Action, Data) -> - {ok, ListenSocket, _NewPort} = + {ok, ListenSocket, _NewPort} = orber_socket:listen(Type, Port, [{active, false}|Options]), Socket = orber_socket:accept(Type, ListenSocket), do_server_action(Type, Socket, Action, Data), @@ -2299,14 +2416,14 @@ do_client_action(Type, Socket, fragments, FragList) -> ok = send_data(Type, Socket, FragList), timer:sleep(3000), {ok, Bytes} = gen_tcp:recv(Socket, 0), - {#reply_header{request_id = ?REQUEST_ID, reply_status = no_exception}, ok, [Par]} = + {#reply_header{request_id = ?REQUEST_ID, reply_status = no_exception}, ok, [Par]} = cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes), Par; do_client_action(Type, Socket, fragments_max, FragList) -> ok = send_data(Type, Socket, FragList), timer:sleep(3000), {ok, Bytes} = gen_tcp:recv(Socket, 0), - {#reply_header{request_id = ?REQUEST_ID, reply_status = system_exception}, Exc, []} = + {#reply_header{request_id = ?REQUEST_ID, reply_status = system_exception}, Exc, []} = cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes), Exc; do_client_action(Type, Socket, message_error, Data) -> @@ -2323,4 +2440,4 @@ send_data(_Type, _Socket, []) -> send_data(Type, Socket, [H|T]) -> orber_socket:write(Type, Socket, H), send_data(Type, Socket, T). - + diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl index 625f168520..ee31b162c2 100644 --- a/lib/orber/test/orber_nat_SUITE.erl +++ b/lib/orber/test/orber_nat_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 2006-2011. 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% %% %% @@ -50,14 +50,15 @@ %%----------------------------------------------------------------- %% External exports %%----------------------------------------------------------------- --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0, +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0, init_per_suite/1, end_per_suite/1, - init_per_testcase/2, end_per_testcase/2, + init_per_testcase/2, end_per_testcase/2, nat_ip_address/1, nat_ip_address_multiple/1, nat_ip_address_local/1, nat_ip_address_local_local/1, nat_iiop_port/1, nat_iiop_port_local/1, - nat_iiop_port_local_local/1, nat_iiop_ssl_port/1, - nat_iiop_ssl_port_local/1]). + nat_iiop_port_local_local/1, + nat_iiop_ssl_port_old/1, nat_iiop_ssl_port_local_old/1, + nat_iiop_ssl_port/1, nat_iiop_ssl_port_local/1]). %%----------------------------------------------------------------- @@ -66,15 +67,15 @@ %%----------------------------------------------------------------- %% Func: all/1 -%% Args: -%% Returns: +%% Args: +%% Returns: %%----------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> cases(). -groups() -> +groups() -> []. init_per_group(_GroupName, Config) -> @@ -84,25 +85,38 @@ end_per_group(_GroupName, Config) -> Config. -cases() -> - [nat_ip_address, nat_ip_address_multiple, - nat_ip_address_local, nat_iiop_port, - nat_iiop_port_local, nat_ip_address_local_local, - nat_iiop_port_local_local, nat_iiop_ssl_port, +cases() -> + [nat_ip_address, + nat_ip_address_multiple, + nat_ip_address_local, + nat_iiop_port, + nat_iiop_port_local, + nat_ip_address_local_local, + nat_iiop_port_local_local, + nat_iiop_ssl_port_old, + nat_iiop_ssl_port_local_old, + nat_iiop_ssl_port, nat_iiop_ssl_port_local]. %%----------------------------------------------------------------- %% Init and cleanup functions. %%----------------------------------------------------------------- -init_per_testcase(TC, Config) +init_per_testcase(TC, Config) when TC =:= nat_iiop_ssl_port; - TC =:= nat_iiop_ssl_port_local -> - case orber_test_lib:ssl_version() of - no_ssl -> - {skip,"SSL not installed!"}; - _ -> - init_per_testcase(dummy_tc, Config) - end; + TC =:= nat_iiop_ssl_port_local; + TC =:= nat_iiop_ssl_port_old; + TC =:= nat_iiop_ssl_port_local_old -> + case ?config(crypto_started, Config) of + true -> + case orber_test_lib:ssl_version() of + no_ssl -> + {skip,"SSL not installed!"}; + _ -> + init_per_testcase(dummy_tc, Config) + end; + false -> + {skip, "Crypto did not start"} + end; init_per_testcase(_Case, Config) -> Path = code:which(?MODULE), code:add_pathz(filename:join(filename:dirname(Path), "idl_output")), @@ -125,12 +139,18 @@ end_per_testcase(_Case, Config) -> init_per_suite(Config) -> if is_list(Config) -> - Config; + try crypto:start() of + ok -> + [{crypto_started, true} | Config] + catch _:_ -> + [{crypto_started, false} | Config] + end; true -> exit("Config not a list") end. end_per_suite(Config) -> + application:stop(crypto), Config. %%----------------------------------------------------------------- @@ -143,13 +163,13 @@ nat_ip_address(suite) -> []; nat_ip_address(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT}, {nat_ip_address, Loopback}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR)), ok. @@ -158,14 +178,14 @@ nat_ip_address_multiple(doc) -> ["This case test if the server ORB use the corre nat_ip_address_multiple(suite) -> []; nat_ip_address_multiple(_Config) -> IP = orber_test_lib:get_host(), - - {ok, ServerNode, _ServerHost} = + + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT}, {nat_ip_address, {multiple, ["10.0.0.1"]}}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR)), ok. @@ -174,13 +194,13 @@ nat_ip_address_local(doc) -> ["This case test if the server ORB use the correct" nat_ip_address_local(suite) -> []; nat_ip_address_local(_Config) -> IP = orber_test_lib:get_host(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT}, {nat_ip_address, {local, "10.0.0.1", [{IP, "127.0.0.1"}]}}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR)), ok. @@ -190,19 +210,19 @@ nat_ip_address_local_local(suite) -> []; nat_ip_address_local_local(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node([{flags, - (?ORB_ENV_LOCAL_INTERFACE bor + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node([{flags, + (?ORB_ENV_LOCAL_INTERFACE bor ?ORB_ENV_ENABLE_NAT)}, {nat_ip_address, {local, "10.0.0.1", [{IP, "10.0.0.2"}]}}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR1 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {"10.0.0.2", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {"10.0.0.2", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR1)), IOR2 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR2)), ok. @@ -211,13 +231,13 @@ nat_iiop_port(doc) -> ["This case test if the server ORB use the correct", nat_iiop_port(suite) -> []; nat_iiop_port(_Config) -> IP = orber_test_lib:get_host(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT}, {nat_iiop_port, 42}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {_IP, 42, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {_IP, 42, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR)), ok. @@ -226,13 +246,13 @@ nat_iiop_port_local(doc) -> ["This case test if the server ORB use the correct", nat_iiop_port_local(suite) -> []; nat_iiop_port_local(_Config) -> IP = orber_test_lib:get_host(), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT}, {nat_iiop_port, {local, 42, [{4001, 43}]}}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), IOR = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {_IP, 42, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {_IP, 42, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR)), ok. @@ -242,27 +262,27 @@ nat_iiop_port_local_local(suite) -> []; nat_iiop_port_local_local(_Config) -> IP = orber_test_lib:get_host(), Loopback = orber_test_lib:get_loopback_interface(), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node([{flags, - (?ORB_ENV_LOCAL_INTERFACE bor + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node([{flags, + (?ORB_ENV_LOCAL_INTERFACE bor ?ORB_ENV_ENABLE_NAT)}, {ip_address, IP}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, [nat_iiop_port, {local, 42, [{ServerPort, 43}]}]), IOR1 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), - ?match({'external', {IP, 43, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {IP, 43, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR1)), {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [Loopback, normal, 10088])), IOR2 = ?match(#'IOP_IOR'{}, corba:string_to_object("corbaloc::1.2@"++Loopback++":10088/NameService")), - ?match({'external', {IP, 42, _ObjectKey, _Counter, _TP, _NewHD}}, + ?match({'external', {IP, 42, _ObjectKey, _Counter, _TP, _NewHD}}, iop_ior:get_key(IOR2)), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, remove_listen_interface, [Ref])), ok. @@ -271,103 +291,204 @@ nat_iiop_port_local_local(_Config) -> %% API tests for ORB to ORB, ssl security depth 1 %%----------------------------------------------------------------- -nat_iiop_ssl_port(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", +nat_iiop_ssl_port_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", + "Make sure NAT works for SSL"]; +nat_iiop_ssl_port_old(suite) -> []; +nat_iiop_ssl_port_old(_Config) -> + + IP = orber_test_lib:get_host(), + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, + 1, [{iiop_ssl_port, 0}, + {flags, ?ORB_ENV_ENABLE_NAT}, + {ip_address, IP}]), + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, + 1, [{iiop_ssl_port, 0}]), + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), + ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), + SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), + NATSSLServerPort = SSLServerPort+1, + {ok, Ref} = ?match({ok, _}, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, + [IP, ssl, NATSSLServerPort])), + orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, + [nat_iiop_ssl_port, + {local, NATSSLServerPort, [{4001, 43}]}]), + + {ok, ClientNode, _ClientHost} = + ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, + [ssl])), + + IOR1 = ?match(#'IOP_IOR'{}, + orber_test_lib:remote_apply(ClientNode, corba, + string_to_object, + ["corbaname::1.2@"++IP++":"++ + integer_to_list(ServerPort)++"/NameService#mamba"])), + + ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, + #host_data{protocol = ssl, + ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, + iop_ior:get_key(IOR1)), + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, + [ssl])), + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, + remove_listen_interface, [Ref])), + ok. + +nat_iiop_ssl_port_local_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", + "Make sure NAT works for SSL"]; +nat_iiop_ssl_port_local_old(suite) -> []; +nat_iiop_ssl_port_local_old(_Config) -> + + IP = orber_test_lib:get_host(), + ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, + 1, [{iiop_ssl_port, 0}, + {flags, + (?ORB_ENV_LOCAL_INTERFACE bor + ?ORB_ENV_ENABLE_NAT)}, + {ip_address, IP}]), + ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, + 1, [{iiop_ssl_port, 0}]), + {ok, ServerNode, _ServerHost} = + ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), + ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), + SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), + NATSSLServerPort = SSLServerPort+1, + {ok, Ref} = ?match({ok, _}, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, + [IP, ssl, NATSSLServerPort])), + orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, + [nat_iiop_ssl_port, + {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]), + + {ok, ClientNode, _ClientHost} = + ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, + [ssl])), + + IOR1 = ?match(#'IOP_IOR'{}, + orber_test_lib:remote_apply(ClientNode, corba, + string_to_object, + ["corbaname::1.2@"++IP++":"++ + integer_to_list(ServerPort)++"/NameService#mamba"])), + + ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, + #host_data{protocol = ssl, + ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, + iop_ior:get_key(IOR1)), + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, + [ssl])), + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, + remove_listen_interface, [Ref])), + ok. + + +nat_iiop_ssl_port(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "Make sure NAT works for SSL"]; nat_iiop_ssl_port(suite) -> []; nat_iiop_ssl_port(_Config) -> IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, + ServerOptions = orber_test_lib:get_options(iiop_ssl, server, 1, [{iiop_ssl_port, 0}, {flags, ?ORB_ENV_ENABLE_NAT}, {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options(iiop_ssl, client, 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), NATSSLServerPort = SSLServerPort+1, {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, + orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, + [nat_iiop_ssl_port, {local, NATSSLServerPort, [{4001, 43}]}]), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [ssl])), - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, + IOR1 = ?match(#'IOP_IOR'{}, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaname::1.2@"++IP++":"++ integer_to_list(ServerPort)++"/NameService#mamba"])), - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, + ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, + #host_data{protocol = ssl, + ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, remove_listen_interface, [Ref])), ok. -nat_iiop_ssl_port_local(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", +nat_iiop_ssl_port_local(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "Make sure NAT works for SSL"]; nat_iiop_ssl_port_local(suite) -> []; nat_iiop_ssl_port_local(_Config) -> IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options(iiop_ssl, server, + ServerOptions = orber_test_lib:get_options(iiop_ssl, server, 1, [{iiop_ssl_port, 0}, - {flags, - (?ORB_ENV_LOCAL_INTERFACE bor + {flags, + (?ORB_ENV_LOCAL_INTERFACE bor ?ORB_ENV_ENABLE_NAT)}, {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options(iiop_ssl, client, + ClientOptions = orber_test_lib:get_options(iiop_ssl, client, 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = + {ok, ServerNode, _ServerHost} = ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), NATSSLServerPort = SSLServerPort+1, {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, + orber_test_lib:remote_apply(ServerNode, orber, + add_listen_interface, [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, + orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, + [nat_iiop_ssl_port, {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]), - {ok, ClientNode, _ClientHost} = + {ok, ClientNode, _ClientHost} = ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + install_test_data, [ssl])), - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, + IOR1 = ?match(#'IOP_IOR'{}, + orber_test_lib:remote_apply(ClientNode, corba, string_to_object, ["corbaname::1.2@"++IP++":"++ integer_to_list(ServerPort)++"/NameService#mamba"])), - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, + ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, + #host_data{protocol = ssl, + ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, + ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, + uninstall_test_data, [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, + ?match(ok, + orber_test_lib:remote_apply(ServerNode, orber, remove_listen_interface, [Ref])), ok. diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 903ab1d771..0ddde49cd6 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -41,28 +41,31 @@ end end()). --export([js_node/2, +-export([js_node/2, js_node/1, js_node/0, - slave_sup/0, - remote_apply/4, + slave_sup/0, + remote_apply/4, install_test_data/1, light_tests/3, - uninstall_test_data/1, - destroy_node/2, + uninstall_test_data/1, + destroy_node/2, lookup/2, alternate_iiop_address/2, create_alternate_iiop_address/2, alternate_ssl_iiop_address/3, create_alternate_ssl_iiop_address/3, - test_coding/1, - test_coding/2, - corba_object_tests/2, + test_coding/1, + test_coding/2, + corba_object_tests/2, timeouts/3, precond/3, postcond/4, oe_get_interface/0, create_components_IOR/1, + get_options_old/2, + get_options_old/3, + get_options_old/4, get_options/2, get_options/3, get_options/4, @@ -89,13 +92,13 @@ %%------------------------------------------------------------ %% function : ssl_version -%% Arguments: +%% Arguments: %% Returns : integer() -%% Effect : -%% +%% Effect : +%% %%------------------------------------------------------------ ssl_version() -> - try + try ssl:module_info(), case catch erlang:system_info(otp_release) of Version when is_list(Version) -> @@ -114,10 +117,10 @@ ssl_version() -> %%------------------------------------------------------------ %% function : version_ok -%% Arguments: +%% Arguments: %% Returns : true | {skipped, Reason} -%% Effect : -%% +%% Effect : +%% %%------------------------------------------------------------ version_ok() -> {ok, Hostname} = inet:gethostname(), @@ -151,8 +154,8 @@ version_ok() -> %% function : get_host %% Arguments: Family - inet | inet6 %% Returns : string() -%% Effect : -%% +%% Effect : +%% %%------------------------------------------------------------ get_host() -> get_host(inet). @@ -172,13 +175,13 @@ get_host(Family) -> [IP] = ?match([_], orber:host()), IP end. - + %%------------------------------------------------------------ %% function : get_loopback_interface %% Arguments: Family - inet | inet6 %% Returns : string() -%% Effect : -%% +%% Effect : +%% %%------------------------------------------------------------ get_loopback_interface() -> get_loopback_interface(inet). @@ -193,12 +196,12 @@ get_loopback_interface(Family) -> _ when Family == inet -> "127.0.0.1"; _ -> - "0:0:0:0:0:FFFF:7F00:0001" + "0:0:0:0:0:FFFF:7F00:0001" end; _ when Family == inet -> "127.0.0.1"; _ -> - "0:0:0:0:0:FFFF:7F00:0001" + "0:0:0:0:0:FFFF:7F00:0001" end. %%------------------------------------------------------------ @@ -220,7 +223,7 @@ js_node(InitOptions, StartOptions) when is_list(InitOptions) -> {A,B,C} = erlang:now(), [_, Host] = string:tokens(atom_to_list(node()), [$@]), _NewInitOptions = check_options(InitOptions), - js_node_helper(Host, 0, lists:concat([A,'_',B,'_',C]), + js_node_helper(Host, 0, lists:concat([A,'_',B,'_',C]), InitOptions, 10, StartOptions). js_node_helper(Host, Port, Name, Options, Retries, StartOptions) -> @@ -234,8 +237,8 @@ js_node_helper(Host, Port, Name, Options, Retries, StartOptions) -> ok = rpc:call(NewNode, file, set_cwd, [Cwd]), true = rpc:call(NewNode, code, set_path, [Path]), rpc:call(NewNode, application, load, [orber]), - ok = rpc:call(NewNode, corba, orb_init, - [[{iiop_port, Port}, + ok = rpc:call(NewNode, corba, orb_init, + [[{iiop_port, Port}, {orber_debug_level, 10}|Options]]), start_orber(StartOptions, NewNode), spawn_link(NewNode, ?MODULE, slave_sup, []), @@ -247,8 +250,8 @@ js_node_helper(Host, Port, Name, Options, Retries, StartOptions) -> end; {error, Reason} when Retries == 0 -> {error, Reason}; - {error, Reason} -> - io:format("Could not start slavenode ~p:~p due to: ~p~n", + {error, Reason} -> + io:format("Could not start slavenode ~p:~p due to: ~p~n", [Host, Port, Reason]), timer:sleep(500), js_node_helper(Host, Port, Name, Options, Retries-1, StartOptions) @@ -285,7 +288,7 @@ starter(Host, Name, Args) -> slave_sup() -> process_flag(trap_exit, true), receive - {'EXIT', _, _} -> + {'EXIT', _, _} -> case os:type() of vxworks -> erlang:halt(); @@ -309,68 +312,106 @@ start_orber(lightweight, Node) -> start_orber(_, Node) -> ok = rpc:call(Node, orber, jump_start, []). - %%----------------------------------------------------------------- %% Type - ssl | iiop_ssl %% Role - 'server' | 'client' %% Options - [{Key, Value}] %%----------------------------------------------------------------- -get_options(Type, Role) -> - get_options(Type, Role, 2, []). +get_options_old(Type, Role) -> + get_options_old(Type, Role, 2, []). -get_options(ssl, Role, Level) -> - get_options(ssl, Role, Level, []). +get_options_old(ssl, Role, Level) -> + get_options_old(ssl, Role, Level, []). -get_options(ssl, Role, 2, Options) -> +get_options_old(ssl, Role, 2, Options) -> Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), [{depth, 2}, {verify, 2}, {keyfile, filename:join([Dir, Role, "key.pem"])}, - {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, - {certfile, filename:join([Dir, Role, "cert.pem"])}|Options]; -get_options(iiop_ssl, _Role, 2, Options) -> + {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, + {certfile, filename:join([Dir, Role, "cert.pem"])} |Options]; +get_options_old(iiop_ssl, _Role, 2, Options) -> Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), [{ssl_server_depth, 2}, {ssl_server_verify, 2}, {ssl_server_certfile, filename:join([Dir, "server", "cert.pem"])}, - {ssl_server_cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, + {ssl_server_cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, {ssl_server_keyfile, filename:join([Dir, "server", "key.pem"])}, {ssl_client_depth, 2}, {ssl_client_verify, 2}, {ssl_client_certfile, filename:join([Dir, "client", "cert.pem"])}, - {ssl_client_cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, + {ssl_client_cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, {ssl_client_keyfile, filename:join([Dir, "client", "key.pem"])}, - {secure, ssl}|Options]; -get_options(iiop_ssl, _Role, 1, Options) -> + {secure, ssl} |Options]; +get_options_old(iiop_ssl, _Role, 1, Options) -> Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), [{ssl_server_depth, 1}, {ssl_server_verify, 0}, {ssl_server_certfile, filename:join([Dir, "server", "cert.pem"])}, - {ssl_server_cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, + {ssl_server_cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, {ssl_server_keyfile, filename:join([Dir, "server", "key.pem"])}, {ssl_client_depth, 1}, {ssl_client_verify, 0}, {ssl_client_certfile, filename:join([Dir, "client", "cert.pem"])}, - {ssl_client_cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, + {ssl_client_cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, {ssl_client_keyfile, filename:join([Dir, "client", "key.pem"])}, - {secure, ssl}|Options]. + {secure, ssl} |Options]. +get_options(Type, Role) -> + get_options(Type, Role, 2, []). + +get_options(ssl, Role, Level) -> + get_options(ssl, Role, Level, []). + +get_options(ssl, Role, 2, Options) -> + Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), + [{depth, 2}, + {verify, 2}, + {keyfile, filename:join([Dir, Role, "key.pem"])}, + {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, + {certfile, filename:join([Dir, Role, "cert.pem"])} |Options]; +get_options(iiop_ssl, _Role, 2, Options) -> + Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), + [{ssl_server_options, [{depth, 2}, + {verify, 2}, + {certfile, filename:join([Dir, "server", "cert.pem"])}, + {cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, + {keyfile, filename:join([Dir, "server", "key.pem"])}]}, + {ssl_client_options, [{depth, 2}, + {verify, 2}, + {certfile, filename:join([Dir, "client", "cert.pem"])}, + {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, + {keyfile, filename:join([Dir, "client", "key.pem"])}]}, + {secure, ssl} |Options]; +get_options(iiop_ssl, _Role, 1, Options) -> + Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), + [{ssl_server_options, [{depth, 1}, + {verify, 0}, + {certfile, filename:join([Dir, "server", "cert.pem"])}, + {cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, + {keyfile, filename:join([Dir, "server", "key.pem"])}]}, + {ssl_client_options, [{depth, 1}, + {verify, 0}, + {certfile, filename:join([Dir, "client", "cert.pem"])}, + {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, + {keyfile, filename:join([Dir, "client", "key.pem"])}]}, + {secure, ssl} |Options]. create_paths() -> Path = filename:dirname(code:which(?MODULE)), " -pa " ++ Path ++ " -pa " ++ - filename:join(Path, "idl_output") ++ + filename:join(Path, "idl_output") ++ " -pa " ++ - filename:join(Path, "all_SUITE_data") ++ - " -pa " ++ + filename:join(Path, "all_SUITE_data") ++ + " -pa " ++ filename:dirname(code:which(orber)). %%------------------------------------------------------------ %% function : destroy_node %% Arguments: Node - which node to destroy. %% Type - normal | ssl -%% Returns : -%% Effect : +%% Returns : +%% Effect : %%------------------------------------------------------------ destroy_node(Node, Type) -> @@ -384,13 +425,13 @@ stopper(Node, _Type) -> slave:stop(Node) end. - + %%------------------------------------------------------------ %% function : remote_apply %% Arguments: N - Node, M - Module, %% F - Function, A - Arguments (list) -%% Returns : -%% Effect : +%% Returns : +%% Effect : %%------------------------------------------------------------ remote_apply(N, M,F,A) -> case rpc:call(N, M, F, A) of @@ -411,7 +452,7 @@ remote_apply(N, M,F,A) -> install_test_data(nameservice) -> oe_orber_test_server:oe_register(), - Mamba = orber_test_server:oe_create([], [{regname, {local, mamba}}]), + Mamba = orber_test_server:oe_create([], [{regname, {local, mamba}}]), true = corba:add_initial_service("Mamba", Mamba), NS = corba:resolve_initial_references("NameService"), NC1 = lname_component:set_id(lname_component:create(), "mamba"), @@ -420,7 +461,7 @@ install_test_data(nameservice) -> install_test_data({nameservice, AltAddr, AltPort}) -> oe_orber_test_server:oe_register(), - Obj = orber_test_server:oe_create([], [{regname, {local, mamba}}]), + Obj = orber_test_server:oe_create([], [{regname, {local, mamba}}]), Mamba = corba:add_alternate_iiop_address(Obj, AltAddr, AltPort), true = corba:add_initial_service("Mamba", Mamba), NS = corba:resolve_initial_references("NameService"), @@ -430,8 +471,8 @@ install_test_data({nameservice, AltAddr, AltPort}) -> install_test_data(timeout) -> oe_orber_test_server:oe_register(), - Mamba = orber_test_server:oe_create([], {local, mamba}), - Viper = orber_test_timeout_server:oe_create([], {local, viper}), + Mamba = orber_test_server:oe_create([], {local, mamba}), + Viper = orber_test_timeout_server:oe_create([], {local, viper}), NS = corba:resolve_initial_references("NameService"), NC1 = lname_component:set_id(lname_component:create(), "mamba"), N1 = lname:insert_component(lname:create(), 1, NC1), @@ -450,7 +491,7 @@ install_test_data(pseudo) -> install_test_data(ssl) -> oe_orber_test_server:oe_register(), - Mamba = orber_test_server:oe_create([], [{regname, {local, mamba}}]), + Mamba = orber_test_server:oe_create([], [{regname, {local, mamba}}]), NS = corba:resolve_initial_references("NameService"), NC1 = lname_component:set_id(lname_component:create(), "mamba"), N = lname:insert_component(lname:create(), 1, NC1), @@ -458,7 +499,7 @@ install_test_data(ssl) -> install_test_data(ssl_simple) -> oe_orber_test_server:oe_register(); - + install_test_data(light) -> %% Nothing to do at the moment but we might in the future ok; @@ -479,7 +520,7 @@ uninstall_test_data(pseudo) -> NC1 = lname_component:set_id(lname_component:create(), "mamba"), N = lname:insert_component(lname:create(), 1, NC1), _Obj = (catch 'CosNaming_NamingContext':resolve(NS, N)), - catch 'CosNaming_NamingContext':destroy(NS), + catch 'CosNaming_NamingContext':destroy(NS), oe_orber_test_server:oe_unregister(); uninstall_test_data(timeout) -> @@ -493,7 +534,7 @@ uninstall_test_data(timeout) -> Viper = (catch 'CosNaming_NamingContext':resolve(NS, N2)), catch corba:dispose(Mamba), catch corba:dispose(Viper), - catch 'CosNaming_NamingContext':destroy(NS), + catch 'CosNaming_NamingContext':destroy(NS), oe_orber_test_server:oe_unregister(); uninstall_test_data(nameservice) -> @@ -503,7 +544,7 @@ uninstall_test_data(nameservice) -> N = lname:insert_component(lname:create(), 1, NC1), Obj = (catch 'CosNaming_NamingContext':resolve(NS, N)), catch corba:dispose(Obj), - catch 'CosNaming_NamingContext':destroy(NS), + catch 'CosNaming_NamingContext':destroy(NS), oe_orber_test_server:oe_unregister(); uninstall_test_data(ssl) -> @@ -512,7 +553,7 @@ uninstall_test_data(ssl) -> N = lname:insert_component(lname:create(), 1, NC1), Obj = (catch 'CosNaming_NamingContext':resolve(NS, N)), catch corba:dispose(Obj), - catch 'CosNaming_NamingContext':destroy(NS), + catch 'CosNaming_NamingContext':destroy(NS), oe_orber_test_server:oe_unregister(); uninstall_test_data(ssl_simple) -> @@ -530,27 +571,27 @@ uninstall_test_data(_) -> %% Arguments: TestServerObj a orber_test_server ref %% OtherObj - any other Orber object. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ corba_object_tests(TestServerObj, OtherObj) -> - ?match(false, + ?match(false, corba_object:is_a(TestServerObj, "IDL:orber_parent/inherrit:1.0")), - ?match(true, + ?match(true, corba_object:is_a(TestServerObj, "IDL:omg.org/orber_parent/inherrit:1.0")), - ?match(true, + ?match(true, corba_object:is_a(TestServerObj, "IDL:omg.org/orber_test/server:1.0")), - ?match(false, + ?match(false, corba_object:is_a(TestServerObj, "IDL:orber_test/server:1.0")), - ?match(false, + ?match(false, corba_object:is_a(TestServerObj, "IDL:omg.org/orber_parent/inherrit:1.1")), - ?match(false, + ?match(false, corba_object:is_a(TestServerObj, "NotValidIFRID")), - ?match(false, + ?match(false, corba_object:is_nil(TestServerObj)), - ?match(false, + ?match(false, corba_object:is_equivalent(OtherObj,TestServerObj)), - ?match(true, + ?match(true, corba_object:is_equivalent(TestServerObj,TestServerObj)), ?match(false, corba_object:non_existent(TestServerObj)), ?match(false, corba_object:not_existent(TestServerObj)), @@ -562,32 +603,32 @@ corba_object_tests(TestServerObj, OtherObj) -> %% function : lookup %% Arguments: Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ lookup(Host, Port) -> Key = Host++":"++integer_to_list(Port), - NSR = corba:resolve_initial_references_remote("NameService", + NSR = corba:resolve_initial_references_remote("NameService", ["iiop://"++Key]), NC1 = lname_component:set_id(lname_component:create(), "not_exist"), N1 = lname:insert_component(lname:create(), 1, NC1), ?match({'EXCEPTION',{'CosNaming_NamingContext_NotFound',_,_,_}}, 'CosNaming_NamingContext':resolve(NSR, N1)), - + NC2 = lname_component:set_id(lname_component:create(), "mamba"), N2 = lname:insert_component(lname:create(), 1, NC2), - Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, 'CosNaming_NamingContext':resolve(NSR, N2)), orber_test_server:print(Obj), - Obj2 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + Obj2 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, corba:string_to_object("corbaname:iiop:1.1@"++Key++"/NameService#mamba")), - + orber_test_server:print(Obj2), - NSR2 = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_}, + NSR2 = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_}, corba:string_to_object("corbaloc:iiop:1.1@"++Key++"/NameService")), - Obj3 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + Obj3 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, 'CosNaming_NamingContext':resolve(NSR2, N2)), orber_test_server:print(Obj3). @@ -595,11 +636,11 @@ lookup(Host, Port) -> %% function : alternate_iiop_address %% Arguments: Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ alternate_iiop_address(Host, Port) -> IOR = create_alternate_iiop_address(Host, Port), - + ?match(false, corba_object:non_existent(IOR)), ?match({'object_forward',_}, corba:locate(IOR)), ?match({'object_forward',_}, corba:locate(IOR, 10000)), @@ -609,145 +650,145 @@ alternate_iiop_address(Host, Port) -> %% function : create_alternate_iiop_address %% Arguments: Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ create_alternate_iiop_address(Host, Port) -> - MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE, + MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE, component_data = ?ORBER_ORB_TYPE_1}, - #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS, + #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS, component_data = ?DEFAULT_CODESETS}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = Host, + 'HostID' = Host, 'Port' = Port}}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = Host, + 'HostID' = Host, 'Port' = 8000}}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = Host, + 'HostID' = Host, 'Port' = 8000}}], #'IOP_IOR'{type_id=TypeID, - profiles=P1} = _IORA = iop_ior:create({1,2}, + profiles=P1} = _IORA = iop_ior:create({1,2}, "IDL:omg.org/CosNaming/NamingContextExt:1.0", - [Host], 8000, -1, + [Host], 8000, -1, "NameService", MC, 0, 0), - #'IOP_IOR'{profiles=P2} = _IORB = iop_ior:create({1,1}, + #'IOP_IOR'{profiles=P2} = _IORB = iop_ior:create({1,1}, "IDL:omg.org/CosNaming/NamingContextExt:1.0", [Host], 8000, -1, "NameService", [], 0, 0), #'IOP_IOR'{type_id=TypeID, profiles=P2++P1}. - + %%------------------------------------------------------------ %% function : create_components_IOR -%% Arguments: +%% Arguments: %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ create_components_IOR(Version) -> - MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE, + MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE, component_data = ?ORBER_ORB_TYPE_1}, - #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS, + #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS, component_data = ?DEFAULT_CODESETS}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = "127.0.0.1", + 'HostID' = "127.0.0.1", 'Port' = 4001}}, - #'IOP_TaggedComponent'{tag = ?TAG_SSL_SEC_TRANS, - component_data = #'SSLIOP_SSL'{target_supports = 0, + #'IOP_TaggedComponent'{tag = ?TAG_SSL_SEC_TRANS, + component_data = #'SSLIOP_SSL'{target_supports = 0, target_requires = 1, port = 2}}, - #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP, - component_data = + #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP, + component_data = #'FT_TagFTGroupTaggedComponent' - {version = #'GIOP_Version'{major = 1, - minor = 2}, - ft_domain_id = "FT_FTDomainId", + {version = #'GIOP_Version'{major = 1, + minor = 2}, + ft_domain_id = "FT_FTDomainId", object_group_id = ?ULONGLONGMAX, object_group_ref_version = ?LONGMAX}}, - #'IOP_TaggedComponent'{tag = ?TAG_FT_PRIMARY, - component_data = + #'IOP_TaggedComponent'{tag = ?TAG_FT_PRIMARY, + component_data = #'FT_TagFTPrimaryTaggedComponent'{primary = true}}, - #'IOP_TaggedComponent'{tag = ?TAG_FT_HEARTBEAT_ENABLED, - component_data = + #'IOP_TaggedComponent'{tag = ?TAG_FT_HEARTBEAT_ENABLED, + component_data = #'FT_TagFTHeartbeatEnabledTaggedComponent'{heartbeat_enabled = true}}, - #'IOP_TaggedComponent'{tag = ?TAG_CSI_SEC_MECH_LIST, - component_data = + #'IOP_TaggedComponent'{tag = ?TAG_CSI_SEC_MECH_LIST, + component_data = #'CSIIOP_CompoundSecMechList' {stateful = false, - mechanism_list = + mechanism_list = [#'CSIIOP_CompoundSecMech' - {target_requires = 6, - transport_mech = + {target_requires = 6, + transport_mech = #'IOP_TaggedComponent' {tag=?TAG_TLS_SEC_TRANS, component_data=#'CSIIOP_TLS_SEC_TRANS' - {target_supports = 7, - target_requires = 8, - addresses = - [#'CSIIOP_TransportAddress'{host_name = "127.0.0.1", + {target_supports = 7, + target_requires = 8, + addresses = + [#'CSIIOP_TransportAddress'{host_name = "127.0.0.1", port = 6001}]}}, - as_context_mech = + as_context_mech = #'CSIIOP_AS_ContextSec' {target_supports = 9, target_requires = 10, - client_authentication_mech = [1, 255], - target_name = [2,255]}, - sas_context_mech = + client_authentication_mech = [1, 255], + target_name = [2,255]}, + sas_context_mech = #'CSIIOP_SAS_ContextSec' {target_supports = 11, target_requires = 12, - privilege_authorities = + privilege_authorities = [#'CSIIOP_ServiceConfiguration' - {syntax = ?ULONGMAX, - name = [3,255]}], + {syntax = ?ULONGMAX, + name = [3,255]}], supported_naming_mechanisms = [[4,255],[5,255]], supported_identity_types = ?ULONGMAX}}, #'CSIIOP_CompoundSecMech' - {target_requires = 6, - transport_mech = + {target_requires = 6, + transport_mech = #'IOP_TaggedComponent' {tag=?TAG_NULL_TAG, component_data=[]}, - as_context_mech = + as_context_mech = #'CSIIOP_AS_ContextSec' {target_supports = 9, target_requires = 10, - client_authentication_mech = [1, 255], - target_name = [2,255]}, - sas_context_mech = + client_authentication_mech = [1, 255], + target_name = [2,255]}, + sas_context_mech = #'CSIIOP_SAS_ContextSec' {target_supports = 11, target_requires = 12, - privilege_authorities = + privilege_authorities = [#'CSIIOP_ServiceConfiguration' - {syntax = ?ULONGMAX, - name = [3,255]}], + {syntax = ?ULONGMAX, + name = [3,255]}], supported_naming_mechanisms = [[4,255],[5,255]], supported_identity_types = ?ULONGMAX}}, #'CSIIOP_CompoundSecMech' - {target_requires = 6, - transport_mech = + {target_requires = 6, + transport_mech = #'IOP_TaggedComponent' {tag=?TAG_SECIOP_SEC_TRANS, component_data=#'CSIIOP_SECIOP_SEC_TRANS' - {target_supports = 7, - target_requires = 8, + {target_supports = 7, + target_requires = 8, mech_oid = [0,255], target_name = [0,255], - addresses = - [#'CSIIOP_TransportAddress'{host_name = "127.0.0.1", + addresses = + [#'CSIIOP_TransportAddress'{host_name = "127.0.0.1", port = 6001}]}}, - as_context_mech = + as_context_mech = #'CSIIOP_AS_ContextSec' {target_supports = 9, target_requires = 10, - client_authentication_mech = [1, 255], - target_name = [2,255]}, - sas_context_mech = + client_authentication_mech = [1, 255], + target_name = [2,255]}, + sas_context_mech = #'CSIIOP_SAS_ContextSec' {target_supports = 11, target_requires = 12, - privilege_authorities = + privilege_authorities = [#'CSIIOP_ServiceConfiguration' - {syntax = ?ULONGMAX, - name = [3,255]}], + {syntax = ?ULONGMAX, + name = [3,255]}], supported_naming_mechanisms = [[4,255],[5,255]], supported_identity_types = ?ULONGMAX}}]}}], iop_ior:create(Version, "IDL:omg.org/CosNaming/NamingContextExt:1.0", @@ -759,11 +800,11 @@ create_components_IOR(Version) -> %% function : alternate_ssl_iiop_address %% Arguments: Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ alternate_ssl_iiop_address(Host, Port, SSLPort) -> IOR = create_alternate_ssl_iiop_address(Host, Port, SSLPort), - + ?match(false, corba_object:non_existent(IOR)), ?match({'object_forward',_}, corba:locate(IOR)), ?match({'object_forward',_}, corba:locate(IOR, 10000)), @@ -774,37 +815,37 @@ alternate_ssl_iiop_address(Host, Port, SSLPort) -> %% function : create_alternate_ssl_iiop_address %% Arguments: Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ create_alternate_ssl_iiop_address(Host, Port, SSLPort) -> - MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE, + MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE, component_data = ?ORBER_ORB_TYPE_1}, - #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS, + #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS, component_data = ?DEFAULT_CODESETS}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = Host, + 'HostID' = Host, 'Port' = Port}}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = Host, + 'HostID' = Host, 'Port' = 8000}}, - #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, + #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, component_data = #'ALTERNATE_IIOP_ADDRESS'{ - 'HostID' = Host, + 'HostID' = Host, 'Port' = 8000}}, - #'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS, - component_data=#'SSLIOP_SSL'{target_supports = 2, - target_requires = 2, + #'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS, + component_data=#'SSLIOP_SSL'{target_supports = 2, + target_requires = 2, port = SSLPort}}], #'IOP_IOR'{type_id=TypeID, - profiles=P1} = _IORA = iop_ior:create_external({1,2}, + profiles=P1} = _IORA = iop_ior:create_external({1,2}, "IDL:omg.org/CosNaming/NamingContextExt:1.0", - Host, 8000, + Host, 8000, "NameService", MC), - #'IOP_IOR'{profiles=P2} = _IORB = iop_ior:create_external({1,1}, + #'IOP_IOR'{profiles=P2} = _IORB = iop_ior:create_external({1,1}, "IDL:omg.org/CosNaming/NamingContextExt:1.0", - Host, 8000, + Host, 8000, "NameService", []), #'IOP_IOR'{type_id=TypeID, profiles=P2++P1}. @@ -813,11 +854,11 @@ create_alternate_ssl_iiop_address(Host, Port, SSLPort) -> %% function : timeouts %% Arguments: Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ timeouts(Host, Port, ReqT) -> - NSR = corba:resolve_initial_references_remote("NameService", + NSR = corba:resolve_initial_references_remote("NameService", ["iiop://"++Host++":"++integer_to_list(Port)]), NC1 = lname_component:set_id(lname_component:create(), "mamba"), N1 = lname:insert_component(lname:create(), 1, NC1), @@ -827,21 +868,21 @@ timeouts(Host, Port, ReqT) -> Viper = 'CosNaming_NamingContext':resolve(NSR, N2), ?match({'EXCEPTION',{'TIMEOUT',_,_,_}}, - orber_test_timeout_server:twoway_function(Viper, ReqT, ReqT*2)), - ?match(ok, orber_test_timeout_server:oneway_function(Viper, ReqT*2)), + orber_test_timeout_server:twoway_function(Viper, ReqT, ReqT*2)), + ?match(ok, orber_test_timeout_server:oneway_function(Viper, ReqT*2)), ?match({'EXCEPTION',{'TIMEOUT',_,_,_}}, - orber_test_server:testing_iiop_twoway_delay(Mamba, ReqT)), + orber_test_server:testing_iiop_twoway_delay(Mamba, ReqT)), ?match(ok, orber_test_server:testing_iiop_oneway_delay(Mamba, ReqT)), - + %% Since the objects are stalled we must wait until they are available again %% to be able to run any more tests and get the correct results. timer:sleep(ReqT*4), - - ?match(ok, orber_test_timeout_server:twoway_function(Viper, ReqT*2, ReqT)), - ?match(ok, orber_test_timeout_server:oneway_function(Viper, ReqT*2)), - - ?match(ok, orber_test_server:testing_iiop_twoway_delay(Mamba, 0)), + + ?match(ok, orber_test_timeout_server:twoway_function(Viper, ReqT*2, ReqT)), + ?match(ok, orber_test_timeout_server:oneway_function(Viper, ReqT*2)), + + ?match(ok, orber_test_server:testing_iiop_twoway_delay(Mamba, 0)), ?match(ok, orber_test_server:testing_iiop_oneway_delay(Mamba, 0)), timer:sleep(ReqT*4), @@ -852,11 +893,11 @@ timeouts(Host, Port, ReqT) -> %% Arguments: Host - which node to contact. %% Port - which port the other orb uses. %% Returns : term() -%% Effect : +%% Effect : %%------------------------------------------------------------ light_tests(Host, Port, ObjName) -> - NSR = corba:resolve_initial_references_remote("NameService", + NSR = corba:resolve_initial_references_remote("NameService", ["iiop://"++Host++":"++integer_to_list(Port)]), NC1 = lname_component:set_id(lname_component:create(), "not_exist"), N1 = lname:insert_component(lname:create(), 1, NC1), @@ -867,7 +908,7 @@ light_tests(Host, Port, ObjName) -> 'CosNaming_NamingContext':resolve(NSR, N1)), NC2 = lname_component:set_id(lname_component:create(), ObjName), N2 = lname:insert_component(lname:create(), 1, NC2), - Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, + Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_}, 'CosNaming_NamingContext':resolve(NSR, N2)), Nodes = orber:get_lightweight_nodes(), io:format("Light Nodes: ~p~n", [Nodes]), @@ -889,165 +930,165 @@ test_coding(Obj) -> test_coding(Obj, Local) -> %%--- Testing code and decode arguments --- ?match({ok, 1.5}, orber_test_server:testing_iiop_float(Obj, 1.5)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_float(Obj, atom)), ?match({ok,1.0}, orber_test_server:testing_iiop_double(Obj, 1.0)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_double(Obj, "wrong")), - + ?match({ok,0}, orber_test_server:testing_iiop_short(Obj, 0)), ?match({ok,?SHORTMAX}, orber_test_server:testing_iiop_short(Obj, ?SHORTMAX)), ?match({ok,?SHORTMIN}, orber_test_server:testing_iiop_short(Obj, ?SHORTMIN)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_short(Obj, atomic)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_short(Obj, ?SHORTMAX+1)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_short(Obj, ?SHORTMIN-1)), - + ?match({ok,0}, orber_test_server:testing_iiop_ushort(Obj, 0)), ?match({ok,?USHORTMAX}, orber_test_server:testing_iiop_ushort(Obj, ?USHORTMAX)), ?match({ok,?USHORTMIN}, orber_test_server:testing_iiop_ushort(Obj, ?USHORTMIN)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_ushort(Obj, ?USHORTMAX+1)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_ushort(Obj, ?USHORTMIN-1)), - + ?match({ok,0}, orber_test_server:testing_iiop_long(Obj, 0)), ?match({ok,?LONGMAX}, orber_test_server:testing_iiop_long(Obj, ?LONGMAX)), ?match({ok,?LONGMIN}, orber_test_server:testing_iiop_long(Obj, ?LONGMIN)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_long(Obj, "wrong")), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_long(Obj, ?LONGMAX+1)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_long(Obj, ?LONGMIN-1)), - + ?match({ok,0}, orber_test_server:testing_iiop_longlong(Obj, 0)), ?match({ok,?LONGLONGMAX}, orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMAX)), ?match({ok,?LONGLONGMIN}, orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMIN)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_longlong(Obj, "wrong")), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMAX+1)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMIN-1)), - + ?match({ok,0}, orber_test_server:testing_iiop_ulong(Obj, 0)), ?match({ok,?ULONGMAX}, orber_test_server:testing_iiop_ulong(Obj, ?ULONGMAX)), ?match({ok,?ULONGMIN}, orber_test_server:testing_iiop_ulong(Obj, ?ULONGMIN)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_ulong(Obj, ?ULONGMAX+1)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_ulong(Obj, ?ULONGMIN-1)), - + ?match({ok,0}, orber_test_server:testing_iiop_ulonglong(Obj, 0)), ?match({ok,?ULONGLONGMAX}, orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMAX)), ?match({ok,?ULONGLONGMIN}, orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMIN)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMAX+1)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMIN-1)), - + ?match({ok,98}, orber_test_server:testing_iiop_char(Obj, 98)), ?match({ok,$b}, orber_test_server:testing_iiop_char(Obj, $b)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_char(Obj, atomic)), ?match({ok,65535}, orber_test_server:testing_iiop_wchar(Obj, 65535)), ?match({ok,$b}, orber_test_server:testing_iiop_wchar(Obj, $b)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_wchar(Obj, atomic)), - + ?match({ok,true}, orber_test_server:testing_iiop_bool(Obj, true)), ?match({ok,false}, orber_test_server:testing_iiop_bool(Obj, false)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_bool(Obj, atom)), - + ?match({ok,1}, orber_test_server:testing_iiop_octet(Obj, 1)), % No real guards for this case. -% ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, +% ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, % orber_test_server:testing_iiop_octet(Obj, 1.5)), IOR12 = create_components_IOR({1,2}), ?match({ok,Obj}, orber_test_server:testing_iiop_obj(Obj, Obj)), ?match({ok,IOR12}, orber_test_server:testing_iiop_obj(Obj, IOR12)), PObj = orber_test_server:oe_create([], [{pseudo,true}]), ?match({ok, _}, orber_test_server:testing_iiop_obj(Obj, PObj)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_obj(Obj, "no_object")), ?match({ok,"string"}, orber_test_server:testing_iiop_string(Obj, "string")), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_string(Obj, "ToLongString")), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_string(Obj, atomic)), ?match({ok,[65535]}, orber_test_server:testing_iiop_wstring(Obj, [65535])), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_wstring(Obj, "ToLongWstring")), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_wstring(Obj, atomic)), - ?match({ok, one}, + ?match({ok, one}, orber_test_server:testing_iiop_enum(Obj, one)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_enum(Obj, three)), - ?match({ok,[1,2,3]}, + ?match({ok,[1,2,3]}, orber_test_server:testing_iiop_seq(Obj, [1,2,3])), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_seq(Obj, [1,2,3,4])), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_seq(Obj, false)), - ?match({ok,[#orber_test_server_struc{a=1, b=2}]}, - orber_test_server:testing_iiop_struc_seq(Obj, + ?match({ok,[#orber_test_server_struc{a=1, b=2}]}, + orber_test_server:testing_iiop_struc_seq(Obj, [#orber_test_server_struc{a=1, b=2}])), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_struc_seq(Obj, false)), - ?match({ok,[#orber_test_server_uni{label=1, value=66}]}, - orber_test_server:testing_iiop_uni_seq(Obj, + ?match({ok,[#orber_test_server_uni{label=1, value=66}]}, + orber_test_server:testing_iiop_uni_seq(Obj, [#orber_test_server_uni{label=1, value=66}])), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_uni_seq(Obj, false)), - ?match({ok,{"one", "two"}}, + ?match({ok,{"one", "two"}}, orber_test_server:testing_iiop_array(Obj, {"one", "two"})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_array(Obj, {"one", "two", "three"})), - ?match({ok,#orber_test_server_struc{a=1, b=2}}, - orber_test_server:testing_iiop_struct(Obj, + ?match({ok,#orber_test_server_struc{a=1, b=2}}, + orber_test_server:testing_iiop_struct(Obj, #orber_test_server_struc{a=1, b=2})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_struct(Obj, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_struct(Obj, #orber_test_server_struc{a="WRONG", b=2})), - ?match({ok,#orber_test_server_uni{label=1, value=66}}, - orber_test_server:testing_iiop_union(Obj, + ?match({ok,#orber_test_server_uni{label=1, value=66}}, + orber_test_server:testing_iiop_union(Obj, #orber_test_server_uni{label=1, value=66})), - ?match({ok,#orber_test_server_uni_d{label=1, value=66}}, - orber_test_server:testing_iiop_union_d(Obj, + ?match({ok,#orber_test_server_uni_d{label=1, value=66}}, + orber_test_server:testing_iiop_union_d(Obj, #orber_test_server_uni_d{label=1, value=66})), - ?match({ok,#orber_test_server_uni_d{label=2, value=true}}, - orber_test_server:testing_iiop_union_d(Obj, + ?match({ok,#orber_test_server_uni_d{label=2, value=true}}, + orber_test_server:testing_iiop_union_d(Obj, #orber_test_server_uni_d{label=2, value=true})), ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_union_d(Obj, + orber_test_server:testing_iiop_union_d(Obj, #orber_test_server_uni_d{label=2, value=66})), case Local of true -> - ?match({ok,#orber_test_server_uni{label=2, value=66}}, - orber_test_server:testing_iiop_union(Obj, + ?match({ok,#orber_test_server_uni{label=2, value=66}}, + orber_test_server:testing_iiop_union(Obj, #orber_test_server_uni{label=2, value=66})); false -> - ?match({ok,#orber_test_server_uni{label=2, value=undefined}}, - orber_test_server:testing_iiop_union(Obj, + ?match({ok,#orber_test_server_uni{label=2, value=undefined}}, + orber_test_server:testing_iiop_union(Obj, #orber_test_server_uni{label=2, value=66})) end, @@ -1058,258 +1099,258 @@ test_coding(Obj, Local) -> C4 = orber_test_server:fixed52negconst1(), C5 = orber_test_server:fixed52negconst2(), C6 = orber_test_server:fixed52negconst3(), - + ?match({ok,C1}, orber_test_server:testing_iiop_fixed(Obj, C1)), ?match({ok,C2}, orber_test_server:testing_iiop_fixed(Obj, C2)), ?match({ok,C3}, orber_test_server:testing_iiop_fixed(Obj, C3)), ?match({ok,C4}, orber_test_server:testing_iiop_fixed(Obj, C4)), ?match({ok,C5}, orber_test_server:testing_iiop_fixed(Obj, C5)), ?match({ok,C6}, orber_test_server:testing_iiop_fixed(Obj, C6)), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_fixed(Obj, #fixed{digits = 5, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_fixed(Obj, #fixed{digits = 5, scale = 2, value = 123450})), ?match(ok, orber_test_server:testing_iiop_void(Obj)), - ?match({'EXCEPTION',{'BAD_QOS',_,_,_}}, + ?match({'EXCEPTION',{'BAD_QOS',_,_,_}}, orber_test_server:pseudo_call_raise_exc(Obj, 1)), - ?match({'EXCEPTION',{'BAD_QOS',_,_,_}}, + ?match({'EXCEPTION',{'BAD_QOS',_,_,_}}, orber_test_server:pseudo_call_raise_exc(Obj, 2)), - ?match({'EXCEPTION',{'orber_test_server_UserDefinedException',_}}, + ?match({'EXCEPTION',{'orber_test_server_UserDefinedException',_}}, orber_test_server:raise_local_exception(Obj)), ?match({'EXCEPTION',{'orber_test_server_ComplexUserDefinedException',_, - [#orber_test_server_struc{a=1, b=2}]}}, + [#orber_test_server_struc{a=1, b=2}]}}, orber_test_server:raise_complex_local_exception(Obj)), %% Test all TypeCodes - ?match({ok, #any{typecode = tk_long, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, + ?match({ok, #any{typecode = tk_long, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, value = 1})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, value = "wrong"})), - ?match({ok, #any{typecode = tk_float, value = 1.5}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_float, + ?match({ok, #any{typecode = tk_float, value = 1.5}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_float, value = 1.5})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, value = "wrong"})), - ?match({ok, #any{typecode = tk_double}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_double, + ?match({ok, #any{typecode = tk_double}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_double, value = 1.0})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_double, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_double, value = "wrong"})), - ?match({ok, #any{typecode = tk_short, value = -1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_short, + ?match({ok, #any{typecode = tk_short, value = -1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_short, value = -1})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_short, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_short, value = atomic})), - ?match({ok, #any{typecode = tk_ushort, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ushort, + ?match({ok, #any{typecode = tk_ushort, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ushort, value = 1})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ushort, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ushort, value = -1})), - ?match({ok, #any{typecode = tk_long, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, + ?match({ok, #any{typecode = tk_long, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, value = 1})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long, value = "wrong"})), - ?match({ok, #any{typecode = tk_longlong, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_longlong, + ?match({ok, #any{typecode = tk_longlong, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_longlong, value = 1})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_longlong, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_longlong, value = "wrong"})), - ?match({ok, #any{typecode = tk_ulong, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, + ?match({ok, #any{typecode = tk_ulong, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, value = 1})), - ?match({ok, #any{typecode = tk_ulong, value = 4294967295}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, + ?match({ok, #any{typecode = tk_ulong, value = 4294967295}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, value = 4294967295})), ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, value = 4294967296})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong, value = -1})), - ?match({ok, #any{typecode = tk_ulonglong, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulonglong, + ?match({ok, #any{typecode = tk_ulonglong, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulonglong, value = 1})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulonglong, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulonglong, value = -1})), - ?match({ok, #any{typecode = tk_char, value = 98}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char, + ?match({ok, #any{typecode = tk_char, value = 98}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char, value = 98})), - ?match({ok, #any{typecode = tk_char, value = $b}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char, + ?match({ok, #any{typecode = tk_char, value = $b}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char, value = $b})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char, value = atomic})), - ?match({ok, #any{typecode = tk_wchar, value = 65535}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar, + ?match({ok, #any{typecode = tk_wchar, value = 65535}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar, value = 65535})), - ?match({ok, #any{typecode = tk_wchar, value = $b}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar, + ?match({ok, #any{typecode = tk_wchar, value = $b}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar, value = $b})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar, value = atomic})), - ?match({ok, #any{typecode = tk_boolean, value = true}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean, + ?match({ok, #any{typecode = tk_boolean, value = true}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean, value = true})), - ?match({ok, #any{typecode = tk_boolean, value = false}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean, + ?match({ok, #any{typecode = tk_boolean, value = false}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean, value = false})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean, value = 1})), - ?match({ok, #any{typecode = tk_octet, value = 1}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_octet, + ?match({ok, #any{typecode = tk_octet, value = 1}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_octet, value = 1})), - ?match({ok, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, value = Obj}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, + ?match({ok, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, value = Obj}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, value = Obj})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, value = "No Object"})), - ?match({ok, #any{typecode = {tk_string, 6}, value = "string"}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_string, 6}, + ?match({ok, #any{typecode = {tk_string, 6}, value = "string"}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_string, 6}, value = "string"})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_string, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_string, value = atomic})), - ?match({ok, #any{typecode = {tk_wstring, 1}, value = [65535]}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_wstring, 1}, + ?match({ok, #any{typecode = {tk_wstring, 1}, value = [65535]}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_wstring, 1}, value = [65535]})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_wstring, 1}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_wstring, 1}, value = atomic})), - ?match({ok, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]}, - value = two}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]}, + ?match({ok, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]}, + value = two}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]}, value = two})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]}, value = three})), - ?match({ok, #any{typecode = {tk_sequence, tk_long, 3}, - value = [1,2,3]}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_sequence, tk_long, 3}, + ?match({ok, #any{typecode = {tk_sequence, tk_long, 3}, + value = [1,2,3]}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_sequence, tk_long, 3}, value = [1,2,3]})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_sequence, tk_long, 3}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_sequence, tk_long, 3}, value = false})), - ?match({ok, #any{typecode = {tk_array,{tk_string,0},2}, - value = {"one", "two"}}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2}, + ?match({ok, #any{typecode = {tk_array,{tk_string,0},2}, + value = {"one", "two"}}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2}, value = {"one", "two"}})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2}, value = {"one", "two", "three"}})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2}, value = {1, 2}})), ?match({ok, #any{typecode = {tk_struct,"IDL:omg.org/orber_test/server/struc:1.0", "struc", - [{"a",tk_long},{"b",tk_short}]}, - value = #orber_test_server_struc{a=1, b=2}}}, + [{"a",tk_long},{"b",tk_short}]}, + value = #orber_test_server_struc{a=1, b=2}}}, orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_struct,"IDL:omg.org/orber_test/server/struc:1.0", "struc", [{"a",tk_long},{"b",tk_short}]}, value = #orber_test_server_struc{a=1, b=2}})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_struct,"IDL:omg.org/orber_test/server/struc:1.0", "struc", - [{"a",tk_long},{"b",tk_short}]}, + [{"a",tk_long},{"b",tk_short}]}, value = #orber_test_server_struc{a=1, b="string"}})), - ?match({ok, #any{typecode = + ?match({ok, #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, - value = #orber_test_server_uni{label=1, value=66}}}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, + value = #orber_test_server_uni{label=1, value=66}}}, orber_test_server: - testing_iiop_any(Obj, - #any{typecode = + testing_iiop_any(Obj, + #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, value = #orber_test_server_uni{label=1, value=66}})), case Local of true -> - ?match({ok, #any{typecode = + ?match({ok, #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, - value = #orber_test_server_uni{label=2, value=66}}}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, + value = #orber_test_server_uni{label=2, value=66}}}, orber_test_server: testing_iiop_any(Obj, - #any{typecode = + #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, value = #orber_test_server_uni{label=2, value=66}})); false -> - ?match({ok, #any{typecode = + ?match({ok, #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, - value = #orber_test_server_uni{label=2, value=undefined}}}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, + value = #orber_test_server_uni{label=2, value=undefined}}}, orber_test_server: testing_iiop_any(Obj, - #any{typecode = + #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, value = #orber_test_server_uni{label=2, value=66}})) end, - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, orber_test_server: - testing_iiop_any(Obj, - #any{typecode = + testing_iiop_any(Obj, + #any{typecode = {tk_union,"IDL:omg.org/orber_test/server/uni:1.0", - "uni", tk_long, -1, [{1,"a",tk_long}]}, + "uni", tk_long, -1, [{1,"a",tk_long}]}, value = #orber_test_server_uni{label=1, value="string"}})), - ?match({ok, #any{typecode = {tk_fixed,5,2}, - value = #fixed{digits = 5, scale = 2, value = 12345}}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,5,2}, - value = #fixed{digits = 5, - scale = 2, + ?match({ok, #any{typecode = {tk_fixed,5,2}, + value = #fixed{digits = 5, scale = 2, value = 12345}}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,5,2}, + value = #fixed{digits = 5, + scale = 2, value = 12345}})), - ?match({ok, #any{typecode = {tk_fixed,10,2}, - value = #fixed{digits = 10, scale = 2, value = 1234567890}}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,10,2}, - value = #fixed{digits = 10, - scale = 2, + ?match({ok, #any{typecode = {tk_fixed,10,2}, + value = #fixed{digits = 10, scale = 2, value = 1234567890}}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,10,2}, + value = #fixed{digits = 10, + scale = 2, value = 1234567890}})), - ?match({ok, #any{typecode = {tk_fixed,6,2}, - value = #fixed{digits = 6, scale = 2, value = 300000}}}, - orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,6,2}, - value = #fixed{digits = 6, - scale = 2, + ?match({ok, #any{typecode = {tk_fixed,6,2}, + value = #fixed{digits = 6, scale = 2, value = 300000}}}, + orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,6,2}, + value = #fixed{digits = 6, + scale = 2, value = 300000}})), - ?match({'EXCEPTION',{'MARSHAL',_,_,_}}, + ?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', + + 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)), +%% ?match(RecA1, +%% orber_test_server:testing_iiop_rec_any(Obj, RecA1)), +%% ?match(RecA2, +%% orber_test_server:testing_iiop_rec_any(Obj, RecA2)), ok. @@ -1332,14 +1373,14 @@ Result : ~p ok. %%--------------- Testing Missing Module --------------------- -oe_get_interface() -> +oe_get_interface() -> non_existing_module:tc(foo). %%--------------- INTERCEPTOR FUNCTIONS ---------------------- %%------------------------------------------------------------ %% function : new_in_connection -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ new_in_connection(Arg, CHost, Port) -> Host = node(), @@ -1353,14 +1394,14 @@ To Host : ~p To Port : ~p Peers : ~p Arg : ~p -==========================================~n", +==========================================~n", [Host, CHost, Port, SHost, SPort, Peers, Arg]), {Host}. %%------------------------------------------------------------ %% function : new_out_connection -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ new_out_connection(Arg, SHost, Port) -> Host = node(), @@ -1369,73 +1410,73 @@ Node : ~p To Host : ~p To Port : ~p Arg : ~p -==========================================~n", +==========================================~n", [Host, SHost, Port, Arg]), {Host}. %%------------------------------------------------------------ %% function : closed_in_connection -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ closed_in_connection(Arg) -> error_logger:info_msg("=============== closed_in_connection ===== Node : ~p Connection: ~p -==========================================~n", +==========================================~n", [node(), Arg]), Arg. %%------------------------------------------------------------ %% function : closed_out_connection -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ closed_out_connection(Arg) -> error_logger:info_msg("=============== closed_out_connection ==== Node : ~p Connection: ~p -==========================================~n", +==========================================~n", [node(), Arg]), Arg. %%------------------------------------------------------------ %% function : in_request_encoded -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ -in_request_encoded(Ref, _ObjKey, Ctx, Op, +in_request_encoded(Ref, _ObjKey, Ctx, Op, <<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8,T/binary>>, _Args) -> error_logger:info_msg("=============== in_request_encoded ======= Connection: ~p Operation : ~p Body : ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, T, Ctx]), {T, "NewArgs"}. %%------------------------------------------------------------ %% function : in_reply_encoded -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ in_reply_encoded(Ref, _ObjKey, Ctx, Op, - <<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8,T/binary>>, + <<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8,T/binary>>, _Args) -> error_logger:info_msg("============== in_reply_encoded ========== Connection: ~p Operation : ~p Body : ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, T, Ctx]), {T, "NewArgs"}. %%------------------------------------------------------------ %% function : out_reply_encoded -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ out_reply_encoded(Ref, _ObjKey, Ctx, Op, List, _Args) -> error_logger:info_msg("============== out_reply_encoded ========= @@ -1443,14 +1484,14 @@ Connection: ~p Operation : ~p Body : ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, List, Ctx]), {list_to_binary([<<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8>>|List]), "NewArgs"}. %%------------------------------------------------------------ %% function : out_request_encoded -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ out_request_encoded(Ref, _ObjKey, Ctx, Op, List, _Args) -> error_logger:info_msg("============== out_request_encoded ======= @@ -1458,14 +1499,14 @@ Connection: ~p Operation : ~p Body : ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, List, Ctx]), {list_to_binary([<<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8>>|List]), "NewArgs"}. %%------------------------------------------------------------ %% function : in_request -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ in_request(Ref, _ObjKey, Ctx, Op, Params, _Args) -> error_logger:info_msg("=============== in_request =============== @@ -1473,14 +1514,14 @@ Connection: ~p Operation : ~p Parameters: ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, Params, Ctx]), {Params, "NewArgs"}. %%------------------------------------------------------------ %% function : in_reply -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ in_reply(Ref, _ObjKey, Ctx, Op, Reply, _Args) -> error_logger:info_msg("=============== in_reply ================= @@ -1488,14 +1529,14 @@ Connection: ~p Operation : ~p Reply : ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, Reply, Ctx]), {Reply, "NewArgs"}. %%------------------------------------------------------------ %% function : postinvoke -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ out_reply(Ref, _ObjKey, Ctx, Op, Reply, _Args) -> error_logger:info_msg("=============== out_reply ================ @@ -1503,14 +1544,14 @@ Connection: ~p Operation : ~p Reply : ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, Reply, Ctx]), {Reply, "NewArgs"}. %%------------------------------------------------------------ %% function : postinvoke -%% Arguments: -%% Returns : +%% Arguments: +%% Returns : %%------------------------------------------------------------ out_request(Ref, _ObjKey, Ctx, Op, Params, _Args) -> error_logger:info_msg("=============== out_request ============== @@ -1518,7 +1559,7 @@ Connection: ~p Operation : ~p Parameters: ~p Context : ~p -==========================================~n", +==========================================~n", [Ref, Op, Params, Ctx]), {Params, "NewArgs"}. diff --git a/lib/public_key/asn1/InformationFramework.asn1 b/lib/public_key/asn1/InformationFramework.asn1 deleted file mode 100644 index 40fbd11a2a..0000000000 --- a/lib/public_key/asn1/InformationFramework.asn1 +++ /dev/null @@ -1,682 +0,0 @@ -InformationFramework {joint-iso-itu-t ds(5) module(1) informationFramework(1) - 6} DEFINITIONS ::= -BEGIN - --- EXPORTS All --- The types and values defined in this module are exported for use in the other ASN.1 modules contained --- within the Directory Specifications, and for the use of other applications which will use them to access --- Directory services. Other applications may use them for their own purposes, but this will not constrain --- extensions and modifications needed to maintain or improve the Directory service. -IMPORTS - -- from ITU-T Rec. X.501 | ISO/IEC 9594-2 - directoryAbstractService, id-ar, id-at, id-mr, id-nf, id-oa, id-oc, - id-sc, selectedAttributeTypes, serviceAdministration - FROM UsefulDefinitions {joint-iso-itu-t ds(5) module(1) - usefulDefinitions(0) 6} - SearchRule - FROM ServiceAdministration serviceAdministration - -- from ITU-T Rec. X.511 | ISO/IEC 9594-3 - TypeAndContextAssertion - FROM DirectoryAbstractService directoryAbstractService - -- from ITU-T Rec. X.520 | ISO/IEC 9594-6 - booleanMatch, commonName, generalizedTimeMatch, generalizedTimeOrderingMatch, - integerFirstComponentMatch, integerMatch, integerOrderingMatch, - objectIdentifierFirstComponentMatch, UnboundedDirectoryString - FROM SelectedAttributeTypes selectedAttributeTypes; - --- attribute data types -Attribute{ATTRIBUTE:SupportedAttributes} ::= SEQUENCE { - type ATTRIBUTE.&id({SupportedAttributes}), - values - SET SIZE (0..MAX) OF ATTRIBUTE.&Type({SupportedAttributes}{@type}), - valuesWithContext - SET SIZE (1..MAX) OF - SEQUENCE {value ATTRIBUTE.&Type({SupportedAttributes}{@type}), - contextList SET SIZE (1..MAX) OF Context} OPTIONAL -} - -AttributeType ::= ATTRIBUTE.&id - -AttributeValue ::= ATTRIBUTE.&Type - -Context ::= SEQUENCE { - contextType CONTEXT.&id({SupportedContexts}), - contextValues - SET SIZE (1..MAX) OF CONTEXT.&Type({SupportedContexts}{@contextType}), - fallback BOOLEAN DEFAULT FALSE -} - -AttributeValueAssertion ::= SEQUENCE { - type ATTRIBUTE.&id({SupportedAttributes}), - assertion - ATTRIBUTE.&equality-match.&AssertionType - ({SupportedAttributes}{@type}), - assertedContexts - CHOICE {allContexts [0] NULL, - selectedContexts [1] SET SIZE (1..MAX) OF ContextAssertion - } OPTIONAL -} - -ContextAssertion ::= SEQUENCE { - contextType CONTEXT.&id({SupportedContexts}), - contextValues - SET SIZE (1..MAX) OF - CONTEXT.&Assertion({SupportedContexts}{@contextType}) -} - -AttributeTypeAssertion ::= SEQUENCE { - type ATTRIBUTE.&id({SupportedAttributes}), - assertedContexts SEQUENCE SIZE (1..MAX) OF ContextAssertion OPTIONAL -} - --- Definition of the following information object set is deferred, perhaps to standardized --- profiles or to protocol implementation conformance statements. The set is required to --- specify a table constraint on the values component of Attribute, the value component --- of AttributeTypeAndValue, and the assertion component of AttributeValueAssertion. -SupportedAttributes ATTRIBUTE ::= - {objectClass | aliasedEntryName, ...} - --- Definition of the following information object set is deferred, perhaps to standardized --- profiles or to protocol implementation conformance statements. The set is required to --- specify a table constraint on the context specifications -SupportedContexts CONTEXT ::= - {...} - --- naming data types -Name ::= CHOICE { -- only one possibility for now --rdnSequence RDNSequence -} - -RDNSequence ::= SEQUENCE OF RelativeDistinguishedName - -DistinguishedName ::= RDNSequence - -RelativeDistinguishedName ::= - SET SIZE (1..MAX) OF AttributeTypeAndDistinguishedValue - -AttributeTypeAndDistinguishedValue ::= SEQUENCE { - type ATTRIBUTE.&id({SupportedAttributes}), - value ATTRIBUTE.&Type({SupportedAttributes}{@type}), - primaryDistinguished BOOLEAN DEFAULT TRUE, - valuesWithContext - SET SIZE (1..MAX) OF - SEQUENCE {distingAttrValue - [0] ATTRIBUTE.&Type({SupportedAttributes}{@type}) - OPTIONAL, - contextList SET SIZE (1..MAX) OF Context} OPTIONAL -} - --- subtree data types -SubtreeSpecification ::= SEQUENCE { - base [0] LocalName DEFAULT {}, - COMPONENTS OF ChopSpecification, - specificationFilter [4] Refinement OPTIONAL -} - --- empty sequence specifies whole administrative area -LocalName ::= RDNSequence - -ChopSpecification ::= SEQUENCE { - specificExclusions - [1] SET SIZE (1..MAX) OF - CHOICE {chopBefore [0] LocalName, - chopAfter [1] LocalName} OPTIONAL, - minimum [2] BaseDistance DEFAULT 0, - maximum [3] BaseDistance OPTIONAL -} - -BaseDistance ::= INTEGER(0..MAX) - -Refinement ::= CHOICE { - item [0] OBJECT-CLASS.&id, - and [1] SET SIZE (1..MAX) OF Refinement, - or [2] SET SIZE (1..MAX) OF Refinement, - not [3] Refinement -} - --- OBJECT-CLASS information object class specification -OBJECT-CLASS ::= CLASS { - &Superclasses OBJECT-CLASS OPTIONAL, - &kind ObjectClassKind DEFAULT structural, - &MandatoryAttributes ATTRIBUTE OPTIONAL, - &OptionalAttributes ATTRIBUTE OPTIONAL, - &id OBJECT IDENTIFIER UNIQUE -} -WITH SYNTAX { - [SUBCLASS OF &Superclasses] - [KIND &kind] - [MUST CONTAIN &MandatoryAttributes] - [MAY CONTAIN &OptionalAttributes] - ID &id -} - -ObjectClassKind ::= ENUMERATED {abstract(0), structural(1), auxiliary(2)} - --- object classes -top OBJECT-CLASS ::= { - KIND abstract - MUST CONTAIN {objectClass} - ID id-oc-top -} - -alias OBJECT-CLASS ::= { - SUBCLASS OF {top} - MUST CONTAIN {aliasedEntryName} - ID id-oc-alias -} - -parent OBJECT-CLASS ::= {KIND abstract - ID id-oc-parent -} - -child OBJECT-CLASS ::= {KIND auxiliary - ID id-oc-child -} - --- ATTRIBUTE information object class specification -ATTRIBUTE ::= CLASS { - &derivation ATTRIBUTE OPTIONAL, - &Type OPTIONAL, -- either &Type or &derivation required - &equality-match MATCHING-RULE OPTIONAL, - &ordering-match MATCHING-RULE OPTIONAL, - &substrings-match MATCHING-RULE OPTIONAL, - &single-valued BOOLEAN DEFAULT FALSE, - &collective BOOLEAN DEFAULT FALSE, - &dummy BOOLEAN DEFAULT FALSE, - -- operational extensions - &no-user-modification BOOLEAN DEFAULT FALSE, - &usage AttributeUsage DEFAULT userApplications, - &id OBJECT IDENTIFIER UNIQUE -} -WITH SYNTAX { - [SUBTYPE OF &derivation] - [WITH SYNTAX &Type] - [EQUALITY MATCHING RULE &equality-match] - [ORDERING MATCHING RULE &ordering-match] - [SUBSTRINGS MATCHING RULE &substrings-match] - [SINGLE VALUE &single-valued] - [COLLECTIVE &collective] - [DUMMY &dummy] - [NO USER MODIFICATION &no-user-modification] - [USAGE &usage] - ID &id -} - -AttributeUsage ::= ENUMERATED { - userApplications(0), directoryOperation(1), distributedOperation(2), - dSAOperation(3)} - --- attributes -objectClass ATTRIBUTE ::= { - WITH SYNTAX OBJECT IDENTIFIER - EQUALITY MATCHING RULE objectIdentifierMatch - ID id-at-objectClass -} - -aliasedEntryName ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - SINGLE VALUE TRUE - ID id-at-aliasedEntryName -} - --- MATCHING-RULE information object class specification -MATCHING-RULE ::= CLASS { - &ParentMatchingRules MATCHING-RULE OPTIONAL, - &AssertionType OPTIONAL, - &uniqueMatchIndicator ATTRIBUTE OPTIONAL, - &id OBJECT IDENTIFIER UNIQUE -} -WITH SYNTAX { - [PARENT &ParentMatchingRules] - [SYNTAX &AssertionType] - [UNIQUE-MATCH-INDICATOR &uniqueMatchIndicator] - ID &id -} - --- matching rules -objectIdentifierMatch MATCHING-RULE ::= { - SYNTAX OBJECT IDENTIFIER - ID id-mr-objectIdentifierMatch -} - -distinguishedNameMatch MATCHING-RULE ::= { - SYNTAX DistinguishedName - ID id-mr-distinguishedNameMatch -} - -MAPPING-BASED-MATCHING{SelectedBy, BOOLEAN:combinable, MappingResult, - OBJECT IDENTIFIER:matchingRule} ::= CLASS { - &selectBy SelectedBy OPTIONAL, - &ApplicableTo ATTRIBUTE, - &subtypesIncluded BOOLEAN DEFAULT TRUE, - &combinable BOOLEAN(combinable), - &mappingResults MappingResult OPTIONAL, - &userControl BOOLEAN DEFAULT FALSE, - &exclusive BOOLEAN DEFAULT TRUE, - &matching-rule MATCHING-RULE.&id(matchingRule), - &id OBJECT IDENTIFIER UNIQUE -} -WITH SYNTAX { - [SELECT BY &selectBy] - APPLICABLE TO &ApplicableTo - [SUBTYPES INCLUDED &subtypesIncluded] - COMBINABLE &combinable - [MAPPING RESULTS &mappingResults] - [USER CONTROL &userControl] - [EXCLUSIVE &exclusive] - MATCHING RULE &matching-rule - ID &id -} - --- NAME-FORM information object class specification -NAME-FORM ::= CLASS { - &namedObjectClass OBJECT-CLASS, - &MandatoryAttributes ATTRIBUTE, - &OptionalAttributes ATTRIBUTE OPTIONAL, - &id OBJECT IDENTIFIER UNIQUE -} -WITH SYNTAX { - NAMES &namedObjectClass - WITH ATTRIBUTES &MandatoryAttributes - [AND OPTIONALLY &OptionalAttributes] - ID &id -} - --- STRUCTURE-RULE class and DIT structure rule data types -DITStructureRule ::= SEQUENCE { - ruleIdentifier RuleIdentifier, - -- shall be unique within the scope of the subschema - nameForm NAME-FORM.&id, - superiorStructureRules SET SIZE (1..MAX) OF RuleIdentifier OPTIONAL -} - -RuleIdentifier ::= INTEGER - -STRUCTURE-RULE ::= CLASS { - &nameForm NAME-FORM, - &SuperiorStructureRules STRUCTURE-RULE OPTIONAL, - &id RuleIdentifier -} -WITH SYNTAX { - NAME FORM &nameForm - [SUPERIOR RULES &SuperiorStructureRules] - ID &id -} - --- DIT content rule data type and CONTENT-RULE class -DITContentRule ::= SEQUENCE { - structuralObjectClass OBJECT-CLASS.&id, - auxiliaries SET SIZE (1..MAX) OF OBJECT-CLASS.&id OPTIONAL, - mandatory [1] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL, - optional [2] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL, - precluded [3] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL -} - -CONTENT-RULE ::= CLASS { - &structuralClass OBJECT-CLASS.&id UNIQUE, - &Auxiliaries OBJECT-CLASS OPTIONAL, - &Mandatory ATTRIBUTE OPTIONAL, - &Optional ATTRIBUTE OPTIONAL, - &Precluded ATTRIBUTE OPTIONAL -} -WITH SYNTAX { - STRUCTURAL OBJECT-CLASS &structuralClass - [AUXILIARY OBJECT-CLASSES &Auxiliaries] - [MUST CONTAIN &Mandatory] - [MAY CONTAIN &Optional] - [MUST-NOT CONTAIN &Precluded] -} - -CONTEXT ::= CLASS { - &Type , - &DefaultValue OPTIONAL, - &Assertion OPTIONAL, - &absentMatch BOOLEAN DEFAULT TRUE, - &id OBJECT IDENTIFIER UNIQUE -} -WITH SYNTAX { - WITH SYNTAX &Type - [DEFAULT-VALUE &DefaultValue] - [ASSERTED AS &Assertion] - [ABSENT-MATCH &absentMatch] - ID &id -} - -DITContextUse ::= SEQUENCE { - attributeType ATTRIBUTE.&id, - mandatoryContexts [1] SET SIZE (1..MAX) OF CONTEXT.&id OPTIONAL, - optionalContexts [2] SET SIZE (1..MAX) OF CONTEXT.&id OPTIONAL -} - -DIT-CONTEXT-USE-RULE ::= CLASS { - &attributeType ATTRIBUTE.&id UNIQUE, - &Mandatory CONTEXT OPTIONAL, - &Optional CONTEXT OPTIONAL -} -WITH SYNTAX { - ATTRIBUTE TYPE &attributeType - [MANDATORY CONTEXTS &Mandatory] - [OPTIONAL CONTEXTS &Optional] -} - -FRIENDS ::= CLASS { - &anchor ATTRIBUTE.&id UNIQUE, - &Friends ATTRIBUTE -}WITH SYNTAX {ANCHOR &anchor - FRIENDS &Friends -} - --- system schema information objects --- object classes -subentry OBJECT-CLASS ::= { - SUBCLASS OF {top} - KIND structural - MUST CONTAIN {commonName | subtreeSpecification} - ID id-sc-subentry -} - -subentryNameForm NAME-FORM ::= { - NAMES subentry - WITH ATTRIBUTES {commonName} - ID id-nf-subentryNameForm -} - -subtreeSpecification ATTRIBUTE ::= { - WITH SYNTAX SubtreeSpecification - USAGE directoryOperation - ID id-oa-subtreeSpecification -} - -administrativeRole ATTRIBUTE ::= { - WITH SYNTAX OBJECT-CLASS.&id - EQUALITY MATCHING RULE objectIdentifierMatch - USAGE directoryOperation - ID id-oa-administrativeRole -} - -createTimestamp ATTRIBUTE ::= { - WITH SYNTAX GeneralizedTime - -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1 - EQUALITY MATCHING RULE generalizedTimeMatch - ORDERING MATCHING RULE generalizedTimeOrderingMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-createTimestamp -} - -modifyTimestamp ATTRIBUTE ::= { - WITH SYNTAX GeneralizedTime - -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1 - EQUALITY MATCHING RULE generalizedTimeMatch - ORDERING MATCHING RULE generalizedTimeOrderingMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-modifyTimestamp -} - -subschemaTimestamp ATTRIBUTE ::= { - WITH SYNTAX GeneralizedTime - -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1 - EQUALITY MATCHING RULE generalizedTimeMatch - ORDERING MATCHING RULE generalizedTimeOrderingMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-subschemaTimestamp -} - -creatorsName ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-creatorsName -} - -modifiersName ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-modifiersName -} - -subschemaSubentryList ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-subschemaSubentryList -} - -accessControlSubentryList ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-accessControlSubentryList -} - -collectiveAttributeSubentryList ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-collectiveAttributeSubentryList -} - -contextDefaultSubentryList ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-contextDefaultSubentryList -} - -serviceAdminSubentryList ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-serviceAdminSubentryList -} - -hasSubordinates ATTRIBUTE ::= { - WITH SYNTAX BOOLEAN - EQUALITY MATCHING RULE booleanMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-hasSubordinates -} - -accessControlSubentry OBJECT-CLASS ::= { - KIND auxiliary - ID id-sc-accessControlSubentry -} - -collectiveAttributeSubentry OBJECT-CLASS ::= { - KIND auxiliary - ID id-sc-collectiveAttributeSubentry -} - -collectiveExclusions ATTRIBUTE ::= { - WITH SYNTAX OBJECT IDENTIFIER - EQUALITY MATCHING RULE objectIdentifierMatch - USAGE directoryOperation - ID id-oa-collectiveExclusions -} - -contextAssertionSubentry OBJECT-CLASS ::= { - KIND auxiliary - MUST CONTAIN {contextAssertionDefaults} - ID id-sc-contextAssertionSubentry -} - -contextAssertionDefaults ATTRIBUTE ::= { - WITH SYNTAX TypeAndContextAssertion - EQUALITY MATCHING RULE objectIdentifierFirstComponentMatch - USAGE directoryOperation - ID id-oa-contextAssertionDefault -} - -serviceAdminSubentry OBJECT-CLASS ::= { - KIND auxiliary - MUST CONTAIN {searchRules} - ID id-sc-serviceAdminSubentry -} - -searchRules ATTRIBUTE ::= { - WITH SYNTAX SearchRuleDescription - EQUALITY MATCHING RULE integerFirstComponentMatch - USAGE directoryOperation - ID id-oa-searchRules -} - -SearchRuleDescription ::= SEQUENCE { - COMPONENTS OF SearchRule, - name [28] SET SIZE (1..MAX) OF UnboundedDirectoryString OPTIONAL, - description [29] UnboundedDirectoryString OPTIONAL -} - -hierarchyLevel ATTRIBUTE ::= { - WITH SYNTAX HierarchyLevel - EQUALITY MATCHING RULE integerMatch - ORDERING MATCHING RULE integerOrderingMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-hierarchyLevel -} - -HierarchyLevel ::= INTEGER - -hierarchyBelow ATTRIBUTE ::= { - WITH SYNTAX HierarchyBelow - EQUALITY MATCHING RULE booleanMatch - SINGLE VALUE TRUE - NO USER MODIFICATION TRUE - USAGE directoryOperation - ID id-oa-hierarchyBelow -} - -HierarchyBelow ::= BOOLEAN - -hierarchyParent ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - SINGLE VALUE TRUE - USAGE directoryOperation - ID id-oa-hierarchyParent -} - -hierarchyTop ATTRIBUTE ::= { - WITH SYNTAX DistinguishedName - EQUALITY MATCHING RULE distinguishedNameMatch - SINGLE VALUE TRUE - USAGE directoryOperation - ID id-oa-hierarchyTop -} - --- object identifier assignments --- object classes -id-oc-top OBJECT IDENTIFIER ::= - {id-oc 0} - -id-oc-alias OBJECT IDENTIFIER ::= {id-oc 1} - -id-oc-parent OBJECT IDENTIFIER ::= {id-oc 28} - -id-oc-child OBJECT IDENTIFIER ::= {id-oc 29} - --- attributes -id-at-objectClass OBJECT IDENTIFIER ::= {id-at 0} - -id-at-aliasedEntryName OBJECT IDENTIFIER ::= {id-at 1} - --- matching rules -id-mr-objectIdentifierMatch OBJECT IDENTIFIER ::= {id-mr 0} - -id-mr-distinguishedNameMatch OBJECT IDENTIFIER ::= {id-mr 1} - --- operational attributes -id-oa-excludeAllCollectiveAttributes OBJECT IDENTIFIER ::= - {id-oa 0} - -id-oa-createTimestamp OBJECT IDENTIFIER ::= {id-oa 1} - -id-oa-modifyTimestamp OBJECT IDENTIFIER ::= {id-oa 2} - -id-oa-creatorsName OBJECT IDENTIFIER ::= {id-oa 3} - -id-oa-modifiersName OBJECT IDENTIFIER ::= {id-oa 4} - -id-oa-administrativeRole OBJECT IDENTIFIER ::= {id-oa 5} - -id-oa-subtreeSpecification OBJECT IDENTIFIER ::= {id-oa 6} - -id-oa-collectiveExclusions OBJECT IDENTIFIER ::= {id-oa 7} - -id-oa-subschemaTimestamp OBJECT IDENTIFIER ::= {id-oa 8} - -id-oa-hasSubordinates OBJECT IDENTIFIER ::= {id-oa 9} - -id-oa-subschemaSubentryList OBJECT IDENTIFIER ::= {id-oa 10} - -id-oa-accessControlSubentryList OBJECT IDENTIFIER ::= {id-oa 11} - -id-oa-collectiveAttributeSubentryList OBJECT IDENTIFIER ::= {id-oa 12} - -id-oa-contextDefaultSubentryList OBJECT IDENTIFIER ::= {id-oa 13} - -id-oa-contextAssertionDefault OBJECT IDENTIFIER ::= {id-oa 14} - -id-oa-serviceAdminSubentryList OBJECT IDENTIFIER ::= {id-oa 15} - -id-oa-searchRules OBJECT IDENTIFIER ::= {id-oa 16} - -id-oa-hierarchyLevel OBJECT IDENTIFIER ::= {id-oa 17} - -id-oa-hierarchyBelow OBJECT IDENTIFIER ::= {id-oa 18} - -id-oa-hierarchyParent OBJECT IDENTIFIER ::= {id-oa 19} - -id-oa-hierarchyTop OBJECT IDENTIFIER ::= {id-oa 20} - --- subentry classes -id-sc-subentry OBJECT IDENTIFIER ::= {id-sc 0} - -id-sc-accessControlSubentry OBJECT IDENTIFIER ::= {id-sc 1} - -id-sc-collectiveAttributeSubentry OBJECT IDENTIFIER ::= {id-sc 2} - -id-sc-contextAssertionSubentry OBJECT IDENTIFIER ::= {id-sc 3} - -id-sc-serviceAdminSubentry OBJECT IDENTIFIER ::= {id-sc 4} - --- Name forms -id-nf-subentryNameForm OBJECT IDENTIFIER ::= {id-nf 16} - --- administrative roles -id-ar-autonomousArea OBJECT IDENTIFIER ::= {id-ar 1} - -id-ar-accessControlSpecificArea OBJECT IDENTIFIER ::= {id-ar 2} - -id-ar-accessControlInnerArea OBJECT IDENTIFIER ::= {id-ar 3} - -id-ar-subschemaAdminSpecificArea OBJECT IDENTIFIER ::= {id-ar 4} - -id-ar-collectiveAttributeSpecificArea OBJECT IDENTIFIER ::= {id-ar 5} - -id-ar-collectiveAttributeInnerArea OBJECT IDENTIFIER ::= {id-ar 6} - -id-ar-contextDefaultSpecificArea OBJECT IDENTIFIER ::= {id-ar 7} - -id-ar-serviceSpecificArea OBJECT IDENTIFIER ::= {id-ar 8} - -END -- InformationFramework diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile index 2ce1168349..943d97bdb8 100644 --- a/lib/public_key/asn1/Makefile +++ b/lib/public_key/asn1/Makefile @@ -40,7 +40,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/public_key-$(VSN) ASN_TOP = OTP-PUB-KEY PKCS-FRAME ASN_MODULES = PKIX1Explicit88 PKIX1Implicit88 PKIX1Algorithms88 \ - PKIXAttributeCertificate PKCS-1 PKCS-3 PKCS-8 InformationFramework PKCS5v2-0 OTP-PKIX + PKIXAttributeCertificate PKCS-1 PKCS-3 PKCS-8 PKCS5v2-0 OTP-PKIX ASN_ASNS = $(ASN_MODULES:%=%.asn1) ASN_ERLS = $(ASN_TOP:%=%.erl) ASN_HRLS = $(ASN_TOP:%=%.hrl) @@ -117,5 +117,4 @@ OTP-PUB-KEY.asn1db: PKIX1Algorithms88.asn1 \ $(EBIN)/PKCS-FRAME.beam: PKCS-FRAME.erl PKCS-FRAME.hrl PKCS-FRAME.erl PKCS-FRAME.hrl: PKCS-FRAME.asn1db PKCS-FRAME.asn1db: PKCS-8.asn1\ - InformationFramework.asn1\ PKCS5v2-0.asn1
\ No newline at end of file diff --git a/lib/public_key/asn1/PKCS-8.asn1 b/lib/public_key/asn1/PKCS-8.asn1 index 7413519b57..8412345b68 100644 --- a/lib/public_key/asn1/PKCS-8.asn1 +++ b/lib/public_key/asn1/PKCS-8.asn1 @@ -14,15 +14,15 @@ BEGIN -- All types and values defined in this module is exported for use in other -- ASN.1 modules. -IMPORTS +--IMPORTS -- informationFramework -- FROM UsefulDefinitions {joint-iso-itu-t(2) ds(5) module(1) -- usefulDefinitions(0) 3} -Attribute +--Attribute -- FROM InformationFramework informationFramework - FROM InformationFramework; +-- FROM InformationFramework; -- This import is really unnecessary since ALGORITHM-IDENTIFIER is defined as a -- TYPE-IDENTIFIER @@ -55,8 +55,8 @@ Version ::= INTEGER {v1(0)} (v1,...) PrivateKey ::= OCTET STRING --- Attributes ::= SET OF Attribute -Attributes ::= SET OF Attribute {{...}} +-- Attributes ::= SET OF PKAttribute +Attributes ::= SET OF PKAttribute {{...}} -- Encrypted private-key information syntax @@ -78,6 +78,66 @@ KeyEncryptionAlgorithms TYPE-IDENTIFIER ::= { ... -- For local profiles } +-- From InformationFramework +PKAttribute{ATTRIBUTE:SupportedAttributes} ::= SEQUENCE { + type ATTRIBUTE.&id({SupportedAttributes}), + values + SET SIZE (0..MAX) OF ATTRIBUTE.&Type({SupportedAttributes}{@type}), + valuesWithContext + SET SIZE (1..MAX) OF + SEQUENCE {value ATTRIBUTE.&Type({SupportedAttributes}{@type}), + contextList SET SIZE (1..MAX) OF Context} OPTIONAL +} + +Context ::= SEQUENCE { + contextType CONTEXT.&id({SupportedContexts}), + contextValues + SET SIZE (1..MAX) OF CONTEXT.&Type({SupportedContexts}{@contextType}), + fallback BOOLEAN DEFAULT FALSE +} +-- Definition of the following information object set is deferred, perhaps to standardized +-- profiles or to protocol implementation conformance statements. The set is required to +-- specify a table constraint on the context specifications +SupportedContexts CONTEXT ::= + {...} + + +CONTEXT ::= CLASS { + &Type , + &DefaultValue OPTIONAL, + &Assertion OPTIONAL, + &absentMatch BOOLEAN DEFAULT TRUE, + &id OBJECT IDENTIFIER UNIQUE +} + +-- ATTRIBUTE information object class specification +ATTRIBUTE ::= CLASS { + &derivation ATTRIBUTE OPTIONAL, + &Type OPTIONAL, -- either &Type or &derivation required + &equality-match MATCHING-RULE OPTIONAL, + &ordering-match MATCHING-RULE OPTIONAL, + &substrings-match MATCHING-RULE OPTIONAL, + &single-valued BOOLEAN DEFAULT FALSE, + &collective BOOLEAN DEFAULT FALSE, + &dummy BOOLEAN DEFAULT FALSE, + -- operational extensions + &no-user-modification BOOLEAN DEFAULT FALSE, + &usage AttributeUsage DEFAULT userApplications, + &id OBJECT IDENTIFIER UNIQUE +} + +-- MATCHING-RULE information object class specification +MATCHING-RULE ::= CLASS { + &ParentMatchingRules MATCHING-RULE OPTIONAL, + &AssertionType OPTIONAL, + &uniqueMatchIndicator ATTRIBUTE OPTIONAL, + &id OBJECT IDENTIFIER UNIQUE +} + +AttributeUsage ::= ENUMERATED { + userApplications(0), directoryOperation(1), distributedOperation(2), + dSAOperation(3)} + END diff --git a/lib/public_key/asn1/PKCS-FRAME.set.asn b/lib/public_key/asn1/PKCS-FRAME.set.asn index a0777ff260..69b6727bef 100644 --- a/lib/public_key/asn1/PKCS-FRAME.set.asn +++ b/lib/public_key/asn1/PKCS-FRAME.set.asn @@ -1,3 +1,2 @@ PKCS-8.asn1 -InformationFramework.asn1 PKCS5v2-0.asn1 diff --git a/lib/public_key/test/erl_make_certs.erl b/lib/public_key/test/erl_make_certs.erl index 8b01ca3ad4..254aa6d2f9 100644 --- a/lib/public_key/test/erl_make_certs.erl +++ b/lib/public_key/test/erl_make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2011. 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 @@ -175,7 +175,7 @@ issuer(true, Opts, SubjectKey) -> issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) -> {issuer_der(Issuer), decode_key(IssuerKey)}; issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) -> - {ok, [{cert, Cert, _}|_]} = public_key:pem_to_der(File), + {ok, [{cert, Cert, _}|_]} = pem_to_der(File), {issuer_der(Cert), decode_key(IssuerKey)}. issuer_der(Issuer) -> @@ -185,7 +185,7 @@ issuer_der(Issuer) -> Subject. subject(undefined, IsRootCA) -> - User = if IsRootCA -> "RootCA"; true -> os:getenv("USER") end, + User = if IsRootCA -> "RootCA"; true -> user() end, Opts = [{email, User ++ "@erlang.org"}, {name, User}, {city, "Stockholm"}, @@ -196,6 +196,14 @@ subject(undefined, IsRootCA) -> subject(Opts, _) -> subject(Opts). +user() -> + case os:getenv("USER") of + false -> + "test_user"; + User -> + User + end. + subject(SubjectOpts) when is_list(SubjectOpts) -> Encode = fun(Opt) -> {Type,Value} = subject_enc(Opt), diff --git a/lib/reltool/doc/src/reltool.xml b/lib/reltool/doc/src/reltool.xml index 31e15e34e7..60e886e8f5 100644 --- a/lib/reltool/doc/src/reltool.xml +++ b/lib/reltool/doc/src/reltool.xml @@ -558,7 +558,17 @@ target_spec() = [target_spec()] <c>true</c> there is no need to install the target system with <c>reltool:install/2</c> before it can be started. In that case the file tree containing the target system can be moved without - re-installation.</p></desc> + re-installation.</p> + + <p>In most cases, the <c>RootDir</c> parameter should be set to + the same as the <c>root_dir</c> configuration parameter used in + the call to <c>reltool:get_target_spec/1</c> + (or <c>code:root_dir()</c> if the configuration parameter is not + set). In some cases it might be useful to evaluate the same + target specification towards different root directories. This + should, however, be used with great care as it requires + equivalent file structures under all roots.</p> + </desc> </func> <func> @@ -640,7 +650,7 @@ target_spec() = [target_spec()] </func> <func> - <name>get_target_spec(Server) -> {ok, targetSpec} | {error, Reason}</name> + <name>get_target_spec(Server) -> {ok, TargetSpec} | {error, Reason}</name> <fsummary>Return a specification of the target system</fsummary> <type> <v>Server = server()</v> diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 1a57c94443..6c11fe8581 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -472,7 +472,7 @@ au_conf_alloc(#conf{format_to = FTO} = Conf, _ -> fc(FTO, "~p instances used.", [Insts]), - format(FTO, " +M~ct ~p~n", [alloc_char(A), Insts]) + format(FTO, " +M~ct true~n", [alloc_char(A)]) end, mmbcs(Conf, Alc), smbcs_lmbcs_mmmbc(Conf, Alc), diff --git a/lib/sasl/doc/src/rb.xml b/lib/sasl/doc/src/rb.xml index f35ceb5777..3da825878e 100644 --- a/lib/sasl/doc/src/rb.xml +++ b/lib/sasl/doc/src/rb.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2010</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -123,7 +123,9 @@ <fsummary>List all reports</fsummary> <type> <v>Type = type()</v> - <v>type() = crash_report | supervisor_report | error | progress</v> + <v>type() = error | error_report | info_msg | info_report | + warning_msg | warning_report | crash_report | + supervisor_report | progress</v> </type> <desc> <p>This function lists all reports loaded in the diff --git a/lib/sasl/doc/src/release_handler.xml b/lib/sasl/doc/src/release_handler.xml index bd4a513750..e3438ede41 100644 --- a/lib/sasl/doc/src/release_handler.xml +++ b/lib/sasl/doc/src/release_handler.xml @@ -64,10 +64,10 @@ downgraded to the specified version by evaluating the instructions in <c>relup</c>. An installed release can be made <em>permanent</em>. There can only be one permanent release in - the system, and this is the release that is used if the system is - restarted. An installed release, except the permanent one, can be - <em>removed</em>. When a release is removed, all files that - belong to that release only are deleted.</p> + the system, and this is the release that is used if the system + is restarted. An installed release, except the permanent one, + can be <em>removed</em>. When a release is removed, all files + that belong to that release only are deleted.</p> <p>Each version of the release has a status. The status can be <c>unpacked</c>, <c>current</c>, <c>permanent</c>, or <c>old</c>. There is always one latest release which either has status @@ -107,16 +107,17 @@ old reboot_old permanent restarted. This is taken care of automatically if Erlang is started as an embedded system. Read about this in <em>Embedded System</em>. In this case, the system configuration file <c>sys.config</c> is mandatory.</p> - <p>A new release may restart the system. Which program to use is - specified by the SASL configuration parameter <c>start_prg</c> - which defaults to <c>$ROOT/bin/start</c>.</p> + <p>The installation of a new release may restart the system. Which + program to use is specified by the SASL configuration + parameter <c>start_prg</c> which defaults + to <c>$ROOT/bin/start</c>.</p> <p>The emulator restart on Windows NT expects that the system is started using the <c>erlsrv</c> program (as a service). Furthermore the release handler expects that the service is named <em>NodeName</em>_<em>Release</em>, where <em>NodeName</em> is the first part of the Erlang nodename (up to, but not including - the "@") and <em>Release</em> is the current release of - the application. The release handler furthermore expects that a + the "@") and <em>Release</em> is the current version of + the release. The release handler furthermore expects that a program like <c>start_erl.exe</c> is specified as "machine" to <c>erlsrv</c>. During upgrading with restart, a new service will be registered and started. The new service will be set to @@ -484,7 +485,7 @@ release_handler:set_unpacked(RelFile, [{myapp,"1.0","/home/user"},...]). <c>release_handler</c> to end up in an inconsistent state.</p> <p>No persistent information is updated, why these functions can be used on any Erlang node, embedded or not. Also, using these - functions does not effect which code will be loaded in case of + functions does not affect which code will be loaded in case of a reboot.</p> <p>If the upgrade or downgrade fails, the application may end up in an inconsistent state.</p> diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml index 1b90f0d4ee..32c2149a8d 100644 --- a/lib/sasl/doc/src/systools.xml +++ b/lib/sasl/doc/src/systools.xml @@ -198,7 +198,7 @@ the order in the <c>.rel</c> file is kept.</p> <p>If <c>sasl</c> is not included as an application in the <c>.rel</c> file, a warning is emitted because such a - release can not be used in an upgrade. To turn of this + release can not be used in an upgrade. To turn off this warning, add the option <c>no_warn_sasl</c>.</p> <p>All files are searched for in the current path. It is assumed that the <c>.app</c> and <c>.beam</c> files for an diff --git a/lib/sasl/test/alarm_handler_SUITE.erl b/lib/sasl/test/alarm_handler_SUITE.erl index a98e8c9c67..a4064ef27a 100644 --- a/lib/sasl/test/alarm_handler_SUITE.erl +++ b/lib/sasl/test/alarm_handler_SUITE.erl @@ -18,7 +18,7 @@ %% -module(alarm_handler_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%----------------------------------------------------------------- %% We will add an own alarm handler in order to verify that the @@ -56,34 +56,32 @@ end_per_group(_GroupName, Config) -> %%----------------------------------------------------------------- -set_alarm(suite) -> []; set_alarm(Config) when is_list(Config) -> - ?line gen_event:add_handler(alarm_handler, ?MODULE, self()), + gen_event:add_handler(alarm_handler, ?MODULE, self()), Alarm1 = {alarm1, "this is the alarm"}, Alarm2 = {"alarm2", this_is_the_alarm}, Alarm3 = {{alarm3}, {this_is,"the_alarm"}}, - ?line ok = alarm_handler:set_alarm(Alarm1), + ok = alarm_handler:set_alarm(Alarm1), reported(set_alarm, Alarm1), - ?line ok = alarm_handler:set_alarm(Alarm2), + ok = alarm_handler:set_alarm(Alarm2), reported(set_alarm, Alarm2), - ?line ok = alarm_handler:set_alarm(Alarm3), + ok = alarm_handler:set_alarm(Alarm3), reported(set_alarm, Alarm3), - ?line [Alarm3,Alarm2,Alarm1] = alarm_handler:get_alarms(), + [Alarm3,Alarm2,Alarm1] = alarm_handler:get_alarms(), alarm_handler:clear_alarm(alarm1), alarm_handler:clear_alarm("alarm2"), alarm_handler:clear_alarm({alarm3}), - ?line [] = alarm_handler:get_alarms(), + [] = alarm_handler:get_alarms(), test_server:messages_get(), - ?line my_yes = gen_event:delete_handler(alarm_handler, ?MODULE, []), + my_yes = gen_event:delete_handler(alarm_handler, ?MODULE, []), ok. %%----------------------------------------------------------------- -clear_alarm(suite) -> []; clear_alarm(Config) when is_list(Config) -> - ?line gen_event:add_handler(alarm_handler, ?MODULE, self()), + gen_event:add_handler(alarm_handler, ?MODULE, self()), Alarm1 = {alarm1, "this is the alarm"}, Alarm2 = {"alarm2", this_is_the_alarm}, Alarm3 = {{alarm3}, {this_is,"the_alarm"}}, @@ -92,44 +90,42 @@ clear_alarm(Config) when is_list(Config) -> alarm_handler:set_alarm(Alarm3), test_server:messages_get(), - ?line ok = alarm_handler:clear_alarm(alarm1), + ok = alarm_handler:clear_alarm(alarm1), reported(clear_alarm, alarm1), - ?line ok = alarm_handler:clear_alarm("alarm2"), + ok = alarm_handler:clear_alarm("alarm2"), reported(clear_alarm, "alarm2"), - ?line ok = alarm_handler:clear_alarm({alarm3}), + ok = alarm_handler:clear_alarm({alarm3}), reported(clear_alarm, {alarm3}), - ?line [] = alarm_handler:get_alarms(), + [] = alarm_handler:get_alarms(), - ?line my_yes = gen_event:delete_handler(alarm_handler, ?MODULE, []), + my_yes = gen_event:delete_handler(alarm_handler, ?MODULE, []), ok. %%----------------------------------------------------------------- -swap(suite) -> []; swap(Config) when is_list(Config) -> - ?line Alarm1 = {alarm1, "this is the alarm"}, - ?line Alarm2 = {"alarm2", this_is_the_alarm}, - ?line Alarm3 = {{alarm3}, {this_is,"the_alarm"}}, - ?line alarm_handler:set_alarm(Alarm1), - ?line alarm_handler:set_alarm(Alarm2), - ?line alarm_handler:set_alarm(Alarm3), - - ?line foo, + Alarm1 = {alarm1, "this is the alarm"}, + Alarm2 = {"alarm2", this_is_the_alarm}, + Alarm3 = {{alarm3}, {this_is,"the_alarm"}}, + alarm_handler:set_alarm(Alarm1), + alarm_handler:set_alarm(Alarm2), + alarm_handler:set_alarm(Alarm3), + case gen_event:which_handlers(alarm_handler) of [alarm_handler] -> - ?line ok = gen_event:swap_handler(alarm_handler, - {alarm_handler, swap}, - {?MODULE, self()}), - ?line [?MODULE] = gen_event:which_handlers(alarm_handler), + ok = gen_event:swap_handler(alarm_handler, + {alarm_handler, swap}, + {?MODULE, self()}), + [?MODULE] = gen_event:which_handlers(alarm_handler), Alarms = [Alarm3, Alarm2, Alarm1], reported(swap_alarms, Alarms), %% get_alarms is only valid with the default handler installed. - ?line {error, _} = alarm_handler:get_alarms(), + {error, _} = alarm_handler:get_alarms(), - ?line my_yes = gen_event:delete_handler(alarm_handler, - ?MODULE, []), - ?line gen_event:add_handler(alarm_handler, alarm_handler, []), + my_yes = gen_event:delete_handler(alarm_handler, + ?MODULE, []), + gen_event:add_handler(alarm_handler, alarm_handler, []), ok; _ -> alarm_handler:clear_alarm(alarm1), diff --git a/lib/sasl/test/overload_SUITE.erl b/lib/sasl/test/overload_SUITE.erl index 92b1aaed6e..e7f180b2ea 100644 --- a/lib/sasl/test/overload_SUITE.erl +++ b/lib/sasl/test/overload_SUITE.erl @@ -18,14 +18,13 @@ %% -module(overload_SUITE). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -compile(export_all). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> [info, set_config_data, set_env_vars, request, timeout]. -all(suite) -> all(). init_per_testcase(_Case,Config) -> restart_sasl(), @@ -38,37 +37,34 @@ end_per_testcase(Case,Config) -> ok. %%%----------------------------------------------------------------- -info(suite) -> []; info(_Config) -> - ?line Info = overload:get_overload_info(), - ?line [{total_intensity,0.0}, - {accept_intensity,0.0}, - {max_intensity,0.8}, - {weight,0.1}, - {total_requests,0}, - {accepted_requests,0}] = Info. + Info = overload:get_overload_info(), + [{total_intensity,0.0}, + {accept_intensity,0.0}, + {max_intensity,0.8}, + {weight,0.1}, + {total_requests,0}, + {accepted_requests,0}] = Info. %%%----------------------------------------------------------------- -set_config_data(suite) -> []; set_config_data(_Config) -> - ?line InfoDefault = overload:get_overload_info(), - ?line ok = check_info(0.8,0.1,InfoDefault), - ?line ok = overload:set_config_data(0.5,0.4), - ?line Info1 = overload:get_overload_info(), - ?line ok = check_info(0.5,0.4,Info1), + InfoDefault = overload:get_overload_info(), + ok = check_info(0.8,0.1,InfoDefault), + ok = overload:set_config_data(0.5,0.4), + Info1 = overload:get_overload_info(), + ok = check_info(0.5,0.4,Info1), ok. %%%----------------------------------------------------------------- -set_env_vars(suite) -> []; set_env_vars(_Config) -> - ?line InfoDefault = overload:get_overload_info(), - ?line ok = check_info(0.8,0.1,InfoDefault), - ?line ok = application:set_env(sasl,overload_max_intensity,0.5), - ?line ok = application:set_env(sasl,overload_weight,0.4), - ?line ok = application:stop(sasl), - ?line ok = application:start(sasl), - ?line Info1 = overload:get_overload_info(), - ?line ok = check_info(0.5,0.4,Info1), + InfoDefault = overload:get_overload_info(), + ok = check_info(0.8,0.1,InfoDefault), + ok = application:set_env(sasl,overload_max_intensity,0.5), + ok = application:set_env(sasl,overload_weight,0.4), + ok = application:stop(sasl), + ok = application:start(sasl), + Info1 = overload:get_overload_info(), + ok = check_info(0.5,0.4,Info1), ok. set_env_vars(cleanup,_Config) -> application:unset_env(sasl,overload_max_intensity), @@ -76,63 +72,61 @@ set_env_vars(cleanup,_Config) -> ok. %%%----------------------------------------------------------------- -request(suite) -> []; request(_Config) -> %% Find number of request that can be done with default settings %% and no delay - ?line overload:set_config_data(0.8, 0.1), - ?line NDefault = do_many_requests(0), - ?line restart_sasl(), - ?line ?t:format("NDefault: ~p",[NDefault]), - + overload:set_config_data(0.8, 0.1), + NDefault = do_many_requests(0), + restart_sasl(), + ?t:format("NDefault: ~p",[NDefault]), + %% Check that the number of requests increases when max_intensity %% increases - ?line overload:set_config_data(2, 0.1), - ?line NLargeMI = do_many_requests(0), - ?line restart_sasl(), - ?line ?t:format("NLargeMI: ~p",[NLargeMI]), - ?line true = NLargeMI > NDefault, + overload:set_config_data(2, 0.1), + NLargeMI = do_many_requests(0), + restart_sasl(), + ?t:format("NLargeMI: ~p",[NLargeMI]), + true = NLargeMI > NDefault, %% Check that the number of requests decreases when weight %% increases - ?line overload:set_config_data(0.8, 1), - ?line NLargeWeight = do_many_requests(0), - ?line restart_sasl(), - ?line ?t:format("NLargeWeight: ~p",[NLargeWeight]), - ?line true = NLargeWeight < NDefault, + overload:set_config_data(0.8, 1), + NLargeWeight = do_many_requests(0), + restart_sasl(), + ?t:format("NLargeWeight: ~p",[NLargeWeight]), + true = NLargeWeight < NDefault, %% Check that number of requests increases when delay between %% requests increases. %% (Keeping same config and comparing to large weight in order to %% minimize the time needed for this case.) - ?line overload:set_config_data(0.8, 1), - ?line NLargeTime = do_many_requests(500), - ?line restart_sasl(), - ?line ?t:format("NLargeTime: ~p",[NLargeTime]), - ?line true = NLargeTime > NLargeWeight, + overload:set_config_data(0.8, 1), + NLargeTime = do_many_requests(500), + restart_sasl(), + ?t:format("NLargeTime: ~p",[NLargeTime]), + true = NLargeTime > NLargeWeight, ok. %%%----------------------------------------------------------------- -timeout(suite) -> []; timeout(_Config) -> - ?line overload:set_config_data(0.8, 1), - ?line _N = do_many_requests(0), - + overload:set_config_data(0.8, 1), + _N = do_many_requests(0), + %% Check that the overload alarm is raised - ?line [{overload,_}] = alarm_handler:get_alarms(), + [{overload,_}] = alarm_handler:get_alarms(), %% Fake a clear timeout in overload.erl and check that, since it %% came very soon after the overload situation, the alarm is not %% cleared - ?line overload ! timeout, - ?line timer:sleep(1000), - ?line [{overload,_}] = alarm_handler:get_alarms(), + overload ! timeout, + timer:sleep(1000), + [{overload,_}] = alarm_handler:get_alarms(), %% A bit later, try again and check that this time the alarm is %% cleared - ?line overload ! timeout, - ?line timer:sleep(1000), - ?line [] = alarm_handler:get_alarms(), + overload ! timeout, + timer:sleep(1000), + [] = alarm_handler:get_alarms(), ok. @@ -171,5 +165,3 @@ check_info(MI,W,Info) -> {{_,MI},{_,W}} -> ok; _ -> ?t:fail({unexpected_info,MI,W,Info}) end. - - diff --git a/lib/sasl/test/rb_SUITE.erl b/lib/sasl/test/rb_SUITE.erl index b53c382609..35a4eb7e7b 100644 --- a/lib/sasl/test/rb_SUITE.erl +++ b/lib/sasl/test/rb_SUITE.erl @@ -18,7 +18,8 @@ %% -module(rb_SUITE). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). + -compile(export_all). @@ -45,19 +46,10 @@ groups() -> ]}]. -all(suite) -> - no_group_cases() ++ - [{conf, - install_mf_h, - element(3,lists:keyfind(running_error_logger,1,groups())), - remove_mf_h} - ]. - - init_per_suite(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line RbDir = filename:join(PrivDir,rb), - ?line ok = file:make_dir(RbDir), + PrivDir = ?config(priv_dir,Config), + RbDir = filename:join(PrivDir,rb), + ok = file:make_dir(RbDir), NewConfig = [{rb_dir,RbDir}|Config], reset_sasl(NewConfig), NewConfig. @@ -66,10 +58,18 @@ end_per_suite(_Config) -> ok. init_per_group(running_error_logger,Config) -> - install_mf_h(Config). + %% Install log_mf_h + RbDir = ?config(rb_dir,Config), + ok = application:set_env(sasl,error_logger_mf_dir,RbDir), + ok = application:set_env(sasl,error_logger_mf_maxbytes,5000), + ok = application:set_env(sasl,error_logger_mf_maxfiles,2), + restart_sasl(), + Config. end_per_group(running_error_logger,Config) -> - remove_mf_h(Config). + %% Remove log_mf_h??? + ok. + init_per_testcase(_Case,Config) -> case whereis(?SUP) of @@ -92,187 +92,152 @@ end_per_testcase(Case,Config) -> %%%----------------------------------------------------------------- +%%% Test cases -help() -> help(suite). -help(suite) -> []; help(_Config) -> - ?line Help = capture(fun() -> rb:h() end), - ?line "Report Browser Tool - usage" = hd(Help), - ?line "rb:stop - stop the rb_server" = lists:last(Help), + Help = capture(fun() -> rb:h() end), + "Report Browser Tool - usage" = hd(Help), + "rb:stop - stop the rb_server" = lists:last(Help), ok. - -start_error_stop() -> start_error_stop(suite). -start_error_stop(suite) -> []; +%% Test that all three sasl env vars must be set for a successful start of rb +%% Then stop rb. start_error_stop(Config) -> - ?line RbDir = ?config(rb_dir,Config), - - ?line {error,{"cannot locate report directory",_}} = rb:start(), - - - ?line ok = application:set_env(sasl,error_logger_mf_dir,"invaliddir"), - ?line ok = application:set_env(sasl,error_logger_mf_maxbytes,1000), - ?line ok = application:set_env(sasl,error_logger_mf_maxfiles,2), - ?line restart_sasl(), - ?line {error,{"cannot read the index file",_}} = rb:start(), - ?line ok = application:set_env(sasl,error_logger_mf_dir,RbDir), - ?line restart_sasl(), - ?line {ok,_} = rb:start(), - - ?line ok = rb:stop(), - ok. + RbDir = ?config(rb_dir,Config), + {error,{"cannot locate report directory",_}} = rb:start(), -%% start_opts(suite) -> []; -%% start_opts(Config) -> -%% PrivDir = ?config(priv_dir,Config), -%% RbDir = filename:join(PrivDir,rb_opts), -%% ok = file:make_dir(RbDir), - -install_mf_h(Config) -> - ?line RbDir = ?config(rb_dir,Config), - ?line ok = application:set_env(sasl,error_logger_mf_dir,RbDir), - ?line ok = application:set_env(sasl,error_logger_mf_maxbytes,5000), - ?line ok = application:set_env(sasl,error_logger_mf_maxfiles,2), - ?line restart_sasl(), - Config. + ok = application:set_env(sasl,error_logger_mf_dir,"invaliddir"), + ok = application:set_env(sasl,error_logger_mf_maxbytes,1000), + ok = application:set_env(sasl,error_logger_mf_maxfiles,2), + restart_sasl(), + {error,{"cannot read the index file",_}} = rb:start(), + ok = application:set_env(sasl,error_logger_mf_dir,RbDir), + restart_sasl(), + {ok,_} = rb:start(), -remove_mf_h(_Config) -> + ok = rb:stop(), ok. - - -show() -> show(suite). -show(suite) -> []; show(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), - + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + %% Insert some reports in the error log and start rb init_error_logs(), - ?line ok = start_rb(OutFile), + ok = start_rb(OutFile), %% Show all reports - ?line All = check_report(fun() -> rb:show() end,OutFile), + All = check_report(fun() -> rb:show() end,OutFile), %% Show by number - ?line [{_,First}] = check_report(fun() -> rb:show(1) end,OutFile), - ?line {1,First} = lists:keyfind(1,1,All), + [{_,First}] = check_report(fun() -> rb:show(1) end,OutFile), + {1,First} = lists:keyfind(1,1,All), %% Show by type - ?line [{_,CR}] = check_report(fun() -> rb:show(crash_report) end,OutFile), - ?line true = contains(CR,"rb_test_crash"), - ?line [{_,EC},{_,EM}] = check_report(fun() -> rb:show(error) end,OutFile), - ?line true = contains(EC,"rb_test_crash"), - ?line true = contains(EM,"rb_test_error_msg"), - ?line [{_,ER}] = check_report(fun() -> rb:show(error_report) end,OutFile), - ?line true = contains(ER,"rb_test_error"), - ?line [{_,IR}] = check_report(fun() -> rb:show(info_report) end,OutFile), - ?line true = contains(IR,"rb_test_info"), - ?line [{_,IM}] = check_report(fun() -> rb:show(info_msg) end,OutFile), - ?line true = contains(IM,"rb_test_info_msg"), - ?line [_|_] = check_report(fun() -> rb:show(progress) end,OutFile), - ?line [{_,SR}] = check_report(fun() -> rb:show(supervisor_report) end, - OutFile), - ?line true = contains(SR,"child_terminated"), - ?line true = contains(SR,"{rb_SUITE,rb_test_crash}"), + [{_,CR}] = check_report(fun() -> rb:show(crash_report) end,OutFile), + true = contains(CR,"rb_test_crash"), + [{_,EC},{_,EM}] = check_report(fun() -> rb:show(error) end,OutFile), + true = contains(EC,"rb_test_crash"), + true = contains(EM,"rb_test_error_msg"), + [{_,ER}] = check_report(fun() -> rb:show(error_report) end,OutFile), + true = contains(ER,"rb_test_error"), + [{_,IR}] = check_report(fun() -> rb:show(info_report) end,OutFile), + true = contains(IR,"rb_test_info"), + [{_,IM}] = check_report(fun() -> rb:show(info_msg) end,OutFile), + true = contains(IM,"rb_test_info_msg"), + [_|_] = check_report(fun() -> rb:show(progress) end,OutFile), + [{_,SR}] = check_report(fun() -> rb:show(supervisor_report) end, + OutFile), + true = contains(SR,"child_terminated"), + true = contains(SR,"{rb_SUITE,rb_test_crash}"), ok. -list() -> list(suite). -list(suite) -> []; list(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), %% Insert some reports in the error log and start rb init_error_logs(), - ?line ok = start_rb(OutFile), - - ?line All = capture(fun() -> rb:list() end), - ?line [{crash_report,[_]=CR}, - {error,[_,_]=EM}, - {error_report,[_]=ER}, - {info_msg,[_]=IM}, - {info_report,[_]=IR}, - {progress,[_|_]=P}, - {supervisor_report,[_]=SR}] = sort_list(All), - - ?line [{crash_report,CR}] = + ok = start_rb(OutFile), + + All = capture(fun() -> rb:list() end), + [{crash_report,[_]=CR}, + {error,[_,_]=EM}, + {error_report,[_]=ER}, + {info_msg,[_]=IM}, + {info_report,[_]=IR}, + {progress,[_|_]=P}, + {supervisor_report,[_]=SR}] = sort_list(All), + + [{crash_report,CR}] = sort_list(capture(fun() -> rb:list(crash_report) end)), - ?line [{error,EM}] = + [{error,EM}] = sort_list(capture(fun() -> rb:list(error) end)), - ?line [{error_report,ER}] = + [{error_report,ER}] = sort_list(capture(fun() -> rb:list(error_report) end)), - ?line [{info_msg,IM}] = + [{info_msg,IM}] = sort_list(capture(fun() -> rb:list(info_msg) end)), - ?line [{info_report,IR}] = + [{info_report,IR}] = sort_list(capture(fun() -> rb:list(info_report) end)), - ?line [{progress,P}] = + [{progress,P}] = sort_list(capture(fun() -> rb:list(progress) end)), - ?line [{supervisor_report,SR}] = + [{supervisor_report,SR}] = sort_list(capture(fun() -> rb:list(supervisor_report) end)), - - ok. + ok. -grep() -> grep(suite). -grep(suite) -> []; grep(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), %% Insert some reports in the error log and start rb init_error_logs(), - ?line ok = start_rb(OutFile), - - ?line [{_,S}, - {_,CR}, - {_,EC}, - {_,IM}, - {_,IR}, - {_,EM}, - {_,ER}]= check_report(fun() -> rb:grep("rb_test_") end,OutFile), - ?line true = contains(S, "rb_test_crash"), - ?line true = contains(CR, "rb_test_crash"), - ?line true = contains(EC, "rb_test_crash"), - ?line true = contains(IM, "rb_test_info_msg"), - ?line true = contains(IR, "rb_test_info"), - ?line true = contains(EM, "rb_test_error_msg"), - ?line true = contains(ER, "rb_test_error"), + ok = start_rb(OutFile), + + [{_,S}, + {_,CR}, + {_,EC}, + {_,IM}, + {_,IR}, + {_,EM}, + {_,ER}]= check_report(fun() -> rb:grep("rb_test_") end,OutFile), + true = contains(S, "rb_test_crash"), + true = contains(CR, "rb_test_crash"), + true = contains(EC, "rb_test_crash"), + true = contains(IM, "rb_test_info_msg"), + true = contains(IR, "rb_test_info"), + true = contains(EM, "rb_test_error_msg"), + true = contains(ER, "rb_test_error"), ok. - -filter_filter() -> filter_filter(suite). -filter_filter(suite) -> []; filter_filter(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), %% Insert some reports in the error log and start rb init_error_logs(), - ?line ok = start_rb(OutFile), + ok = start_rb(OutFile), - ?line All = check_report(fun() -> rb:show() end,OutFile), + All = check_report(fun() -> rb:show() end,OutFile), - ?line ER = [_] = rb_filter([{rb_SUITE,rb_test_error}],OutFile), - ?line [] = rb_filter([{rb_SUITE,rb_test}],OutFile), - ?line _E = [_,_] = rb_filter([{rb_SUITE,"rb_test",re}],OutFile), - ?line AllButER = rb_filter([{rb_SUITE,rb_test_error,no}],OutFile), + ER = [_] = rb_filter([{rb_SUITE,rb_test_error}],OutFile), + [] = rb_filter([{rb_SUITE,rb_test}],OutFile), + _E = [_,_] = rb_filter([{rb_SUITE,"rb_test",re}],OutFile), + AllButER = rb_filter([{rb_SUITE,rb_test_error,no}],OutFile), {_,AllRep} = lists:unzip(All), {_,ERRep} = lists:unzip(ER), {_,AllButERRep} = lists:unzip(AllButER), - ?line AllButERRep = AllRep -- ERRep, + AllButERRep = AllRep -- ERRep, ok. -filter_date() -> filter_date(suite). -filter_date(suite) -> []; filter_date(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), %% Insert some reports in the error log and start rb @@ -280,35 +245,33 @@ filter_date(Config) -> Between1 = calendar:local_time(), timer:sleep(1000), Between2 = calendar:local_time(), - ?line ok = start_rb(OutFile), + ok = start_rb(OutFile), - ?line All = check_report(fun() -> rb:show() end,OutFile), + All = check_report(fun() -> rb:show() end,OutFile), Before = calendar:gregorian_seconds_to_datetime( - calendar:datetime_to_gregorian_seconds(calendar:local_time()) - 10), + calendar:datetime_to_gregorian_seconds(calendar:local_time()) - 10), After = calendar:gregorian_seconds_to_datetime( calendar:datetime_to_gregorian_seconds(calendar:local_time()) + 1), - ?line All = rb_filter([],{Before,from},OutFile), - ?line All = rb_filter([],{After,to},OutFile), - ?line [] = rb_filter([],{Before,to},OutFile), - ?line [] = rb_filter([],{After,from},OutFile), - ?line All = rb_filter([],{Before,After},OutFile), + All = rb_filter([],{Before,from},OutFile), + All = rb_filter([],{After,to},OutFile), + [] = rb_filter([],{Before,to},OutFile), + [] = rb_filter([],{After,from},OutFile), + All = rb_filter([],{Before,After},OutFile), %%?t:format("~p~n",[All]), - ?line AllButLast = [{N-1,R} || {N,R} <- tl(All)], - ?line AllButLast = rb_filter([],{Before,Between1},OutFile), + AllButLast = [{N-1,R} || {N,R} <- tl(All)], + AllButLast = rb_filter([],{Before,Between1},OutFile), - ?line Last = hd(All), - ?line [Last] = rb_filter([],{Between2,After},OutFile), + Last = hd(All), + [Last] = rb_filter([],{Between2,After},OutFile), ok. -filter_filter_and_date() -> filter_filter_and_date(suite). -filter_filter_and_date(suite) -> []; filter_filter_and_date(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), %% Insert some reports in the error log and start rb @@ -316,102 +279,96 @@ filter_filter_and_date(Config) -> Between1 = calendar:local_time(), timer:sleep(1000), Between2 = calendar:local_time(), - ?line error_logger:error_report([{rb_SUITE,rb_test_filter}]), - ?line ok = start_rb(OutFile), + error_logger:error_report([{rb_SUITE,rb_test_filter}]), + ok = start_rb(OutFile), Before = calendar:gregorian_seconds_to_datetime( - calendar:datetime_to_gregorian_seconds(calendar:local_time()) - 10), + calendar:datetime_to_gregorian_seconds(calendar:local_time()) - 10), After = calendar:gregorian_seconds_to_datetime( calendar:datetime_to_gregorian_seconds(calendar:local_time()) + 1), - ?line All = check_report(fun() -> rb:show() end,OutFile), - ?line Last = hd(All), + All = check_report(fun() -> rb:show() end,OutFile), + Last = hd(All), - ?line [_,_,_] = rb_filter([{rb_SUITE,"rb_test",re}],{Before,After},OutFile), - ?line [_,_] = rb_filter([{rb_SUITE,"rb_test",re}],{Before,Between1},OutFile), - ?line [_] = rb_filter([{rb_SUITE,"rb_test",re}],{Between2,After},OutFile), - ?line [_] = rb_filter([{rb_SUITE,rb_test_filter}],{Before,After},OutFile), - ?line [] = rb_filter([{rb_SUITE,rb_test_filter}],{Before,Between1},OutFile), - ?line [Last] = rb_filter([{rb_SUITE,rb_test_filter,no}],{Between2,After},OutFile), - ?line {_,Str} = Last, - ?line false = contains(Str,"rb_test_filter"), + [_,_,_] = rb_filter([{rb_SUITE,"rb_test",re}],{Before,After},OutFile), + [_,_] = rb_filter([{rb_SUITE,"rb_test",re}],{Before,Between1},OutFile), + [_] = rb_filter([{rb_SUITE,"rb_test",re}],{Between2,After},OutFile), + [_] = rb_filter([{rb_SUITE,rb_test_filter}],{Before,After},OutFile), + [] = rb_filter([{rb_SUITE,rb_test_filter}],{Before,Between1},OutFile), + [Last] = rb_filter([{rb_SUITE,rb_test_filter,no}],{Between2,After},OutFile), + {_,Str} = Last, + false = contains(Str,"rb_test_filter"), ok. -filter_re_no() -> filter_re_no(suite). -filter_re_no(suite) -> []; filter_re_no(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), %% Insert some reports in the error log and start rb init_error_logs(), - ?line ok = start_rb(OutFile), + ok = start_rb(OutFile), - ?line All = check_report(fun() -> rb:show() end,OutFile), + All = check_report(fun() -> rb:show() end,OutFile), - ?line E = [_,_] = rb_filter([{rb_SUITE,"rb_test",re}],OutFile), - ?line AllButE = rb_filter([{rb_SUITE,"rb_test",re,no}],OutFile), + E = [_,_] = rb_filter([{rb_SUITE,"rb_test",re}],OutFile), + AllButE = rb_filter([{rb_SUITE,"rb_test",re,no}],OutFile), {_,AllRep} = lists:unzip(All), {_,ERep} = lists:unzip(E), {_,AllButERep} = lists:unzip(AllButE), - ?line AllButERep = AllRep -- ERep, + AllButERep = AllRep -- ERep, ok. -rescan() -> rescan(suite). -rescan(suite) -> []; rescan(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), - + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + %% Start rb - ?line ok = start_rb(OutFile), + ok = start_rb(OutFile), %% Insert one more report and check that the list is longer. Note %% that there might be two more reports, since the progress report %% from starting rb_server might not be included before the rescan. - ?line AllBefore = capture(fun() -> rb:list() end), - ?line error_logger:error_report([{rb_SUITE,rb_test_rescan}]), - ?line ok = rb:rescan(), - ?line AllAfter = capture(fun() -> rb:list() end), - ?line Diff = length(AllAfter) - length(AllBefore), - ?line true = (Diff >= 1), + AllBefore = capture(fun() -> rb:list() end), + error_logger:error_report([{rb_SUITE,rb_test_rescan}]), + ok = rb:rescan(), + AllAfter = capture(fun() -> rb:list() end), + Diff = length(AllAfter) - length(AllBefore), + true = (Diff >= 1), ok. -start_stop_log() -> start_stop_log(suite). -start_stop_log(suite) -> []; start_stop_log(Config) -> - ?line PrivDir = ?config(priv_dir,Config), - ?line OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), - ?line ok = file:write_file(OutFile,[]), + PrivDir = ?config(priv_dir,Config), + OutFile = filename:join(PrivDir,"rb_SUITE_log.txt"), + ok = file:write_file(OutFile,[]), %% Start rb and check that show is printed to standard_io - ?line ok = start_rb(), - ?line StdioResult = [_|_] = capture(fun() -> rb:show(1) end), - ?line {ok,<<>>} = file:read_file(OutFile), - + ok = start_rb(), + StdioResult = [_|_] = capture(fun() -> rb:show(1) end), + {ok,<<>>} = file:read_file(OutFile), + %% Start log and check that show is printed to log and not to standad_io - ?line ok = rb:start_log(OutFile), - ?line [] = capture(fun() -> rb:show(1) end), - ?line {ok,Bin} = file:read_file(OutFile), - ?line true = (Bin =/= <<>>), + ok = rb:start_log(OutFile), + [] = capture(fun() -> rb:show(1) end), + {ok,Bin} = file:read_file(OutFile), + true = (Bin =/= <<>>), %% Stop log and check that show is printed to standard_io and not to log - ?line ok = rb:stop_log(), - ?line ok = file:write_file(OutFile,[]), - ?line StdioResult = capture(fun() -> rb:show(1) end), - ?line {ok,<<>>} = file:read_file(OutFile), + ok = rb:stop_log(), + ok = file:write_file(OutFile,[]), + StdioResult = capture(fun() -> rb:show(1) end), + {ok,<<>>} = file:read_file(OutFile), %% Test that standard_io is used if log file can not be opened - ?line ok = rb:start_log(filename:join(nonexistingdir,"newfile.txt")), - ?line StdioResult = capture(fun() -> rb:show(1) end), - ?line {ok,<<>>} = file:read_file(OutFile), + ok = rb:start_log(filename:join(nonexistingdir,"newfile.txt")), + StdioResult = capture(fun() -> rb:show(1) end), + {ok,<<>>} = file:read_file(OutFile), ok. @@ -435,7 +392,7 @@ empty_error_logs(Config) -> catch delete_content(?config(rb_dir, Config)), ok = application:start(sasl), wait_for_sasl(). - + wait_for_sasl() -> wait_for_sasl(50). wait_for_sasl(0) -> @@ -448,7 +405,7 @@ wait_for_sasl(N) -> timer:sleep(100), wait_for_sasl(N-1) end. - + start_rb(OutFile) -> do_start_rb([{start_log,OutFile}]). start_rb() -> @@ -482,20 +439,20 @@ delete_content(Dir) -> Files). init_error_logs() -> - ?line error_logger:error_report([{rb_SUITE,rb_test_error}]), - ?line error_logger:error_msg("rb_test_error_msg"), - ?line error_logger:info_report([{rb_SUITE,rb_test_info}]), - ?line error_logger:info_msg("rb_test_info_msg"), - ?line _Pid = start(), - ?line Ref = erlang:monitor(process,?MODULE), - ?line gen_server:cast(?MODULE,crash), - ?line receive {'DOWN',Ref,process,_,{rb_SUITE,rb_test_crash}} -> ok - after 2000 -> - ?t:format("Got: ~p~n",[process_info(self(),messages)]), - ?t:fail("rb_SUITE server never died") - end, - ?line erlang:demonitor(Ref), - ?line wait_for_server(), + error_logger:error_report([{rb_SUITE,rb_test_error}]), + error_logger:error_msg("rb_test_error_msg"), + error_logger:info_report([{rb_SUITE,rb_test_info}]), + error_logger:info_msg("rb_test_info_msg"), + _Pid = start(), + Ref = erlang:monitor(process,?MODULE), + gen_server:cast(?MODULE,crash), + receive {'DOWN',Ref,process,_,{rb_SUITE,rb_test_crash}} -> ok + after 2000 -> + ?t:format("Got: ~p~n",[process_info(self(),messages)]), + ?t:fail("rb_SUITE server never died") + end, + erlang:demonitor(Ref), + wait_for_server(), ok. wait_for_server() -> diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl index 195324daa0..b6eaf41323 100644 --- a/lib/sasl/test/sasl_SUITE.erl +++ b/lib/sasl/test/sasl_SUITE.erl @@ -20,15 +20,15 @@ -include_lib("common_test/include/ct.hrl"). -% Default timetrap timeout (set in init_per_testcase). +%% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). -define(application, sasl). -% Test server specific exports +%% Test server specific exports -export([all/0,groups/0,init_per_group/2,end_per_group/2]). -export([init_per_testcase/2, end_per_testcase/2]). -% Test cases must be exported. +%% Test cases must be exported. -export([app_test/1, appup_test/1, log_mf_h_env/1]). @@ -47,7 +47,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), + Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), @@ -55,7 +55,7 @@ end_per_testcase(_Case, Config) -> ok. app_test(Config) when is_list(Config) -> - ?line ?t:app_test(sasl, allow), + ?t:app_test(sasl, allow), ok. %% Test that appup allows upgrade from/downgrade to a maximum of two @@ -67,11 +67,11 @@ appup_test(_Config) -> {ok,[{SaslVsn,UpFrom,DownTo}=Appup]} = file:consult(filename:join(Ebin,"sasl.appup")), ct:log("~p~n",[Appup]), - ?line {OkVsns,NokVsns} = create_test_vsns(SaslVsn), - ?line check_appup(OkVsns,UpFrom,{ok,[restart_new_emulator]}), - ?line check_appup(OkVsns,DownTo,{ok,[restart_new_emulator]}), - ?line check_appup(NokVsns,UpFrom,error), - ?line check_appup(NokVsns,DownTo,error), + {OkVsns,NokVsns} = create_test_vsns(SaslVsn), + check_appup(OkVsns,UpFrom,{ok,[restart_new_emulator]}), + check_appup(OkVsns,DownTo,{ok,[restart_new_emulator]}), + check_appup(NokVsns,UpFrom,error), + check_appup(NokVsns,DownTo,error), ok. diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index beb1e48ca7..43366d8917 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -28,9 +28,9 @@ -module(systools_SUITE). -%-define(debug, true). +%%-define(debug, true). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(format(S, A), ok). -define(datadir, ?config(data_dir, Config)). -define(privdir, ?config(priv_dir, Config)). @@ -40,20 +40,20 @@ -export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([ script_options/1, normal_script/1, no_mod_vsn_script/1, - wildcard_script/1, variable_script/1, no_sasl_script/1, - abnormal_script/1, src_tests_script/1, crazy_script/1, - warn_shadow_script/1, - included_script/1, included_override_script/1, - included_fail_script/1, included_bug_script/1, exref_script/1]). --export([ tar_options/1, normal_tar/1, no_mod_vsn_tar/1, variable_tar/1, - src_tests_tar/1, shadow_tar/1, var_tar/1, - exref_tar/1, link_tar/1, otp_9507/1]). --export([ normal_relup/1, restart_relup/1, abnormal_relup/1, no_sasl_relup/1, - no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, - regexp_relup/1, otp_3065/1]). --export([otp_6226/1]). +-export([script_options/1, normal_script/1, no_mod_vsn_script/1, + wildcard_script/1, variable_script/1, no_sasl_script/1, + abnormal_script/1, src_tests_script/1, crazy_script/1, + included_script/1, included_override_script/1, + included_fail_script/1, included_bug_script/1, exref_script/1, + otp_3065_circular_dependenies/1]). +-export([tar_options/1, normal_tar/1, no_mod_vsn_tar/1, variable_tar/1, + src_tests_tar/1, var_tar/1, + exref_tar/1, link_tar/1, otp_9507_path_ebin/1]). +-export([normal_relup/1, restart_relup/1, abnormal_relup/1, no_sasl_relup/1, + no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, + regexp_relup/1]). -export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]). +-export([otp_6226_outdir/1]). -export([init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). @@ -69,26 +69,25 @@ suite() -> all() -> [{group, script}, {group, tar}, {group, relup}, {group, hybrid}, - {group, tickets}]. + {group, options}]. groups() -> [{script, [], [script_options, normal_script, no_mod_vsn_script, wildcard_script, variable_script, abnormal_script, no_sasl_script, src_tests_script, crazy_script, - warn_shadow_script, included_script, included_override_script, + included_script, included_override_script, included_fail_script, included_bug_script, exref_script, - otp_3065]}, + otp_3065_circular_dependenies]}, {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, variable_tar, - src_tests_tar, shadow_tar, var_tar, - exref_tar, link_tar, otp_9507]}, + src_tests_tar, var_tar, exref_tar, link_tar, otp_9507_path_ebin]}, {relup, [], [normal_relup, restart_relup, abnormal_relup, no_sasl_relup, no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup ]}, {hybrid, [], [normal_hybrid,hybrid_no_old_sasl,hybrid_no_new_sasl]}, - {tickets, [], [otp_6226]}]. + {options, [], [otp_6226_outdir]}]. init_per_group(_GroupName, Config) -> Config. @@ -103,17 +102,17 @@ init_per_suite(Config) when is_list(Config) -> %% Make of copy of the data directory. DataDir = ?datadir, PrivDir = ?privdir, - ?line CopyDir = fname(PrivDir, "datacopy"), - ?line TarFile = fname(PrivDir, "datacopy.tgz"), - ?line {ok, Tar} = erl_tar:open(TarFile, [write, compressed]), - ?line ok = erl_tar:add(Tar, DataDir, CopyDir, [compressed]), - ?line ok = erl_tar:close(Tar), - ?line ok = erl_tar:extract(TarFile, [compressed]), - ?line ok = file:delete(TarFile), + CopyDir = fname(PrivDir, "datacopy"), + TarFile = fname(PrivDir, "datacopy.tgz"), + {ok, Tar} = erl_tar:open(TarFile, [write, compressed]), + ok = erl_tar:add(Tar, DataDir, CopyDir, [compressed]), + ok = erl_tar:close(Tar), + ok = erl_tar:extract(TarFile, [compressed]), + ok = file:delete(TarFile), %% Compile source files in the copy directory. - ?line Sources = filelib:wildcard(fname([CopyDir,'*','*','*','*','*.erl'])), - ?line lists:foreach(fun compile_source/1, Sources), + Sources = filelib:wildcard(fname([CopyDir,'*','*','*','*','*.erl'])), + lists:foreach(fun compile_source/1, Sources), %% To use in end_per_testcase Path = code:get_path(), @@ -144,7 +143,7 @@ init_per_testcase(link_tar, Config) -> {win32, _} -> {skip, "Skip on windows"} end; init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), + Dog = test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -175,531 +174,460 @@ end_per_testcase(_Case, Config) -> %% -%% make_script -%% -script_options(suite) -> []; -script_options(doc) -> - ["Check illegal script options."]; +%% make_script: Check illegal script options script_options(Config) when is_list(Config) -> - ?line {'EXIT',{{badarg,[{path,["Path",12,"Another"]}]}, _}} = - (catch systools:make_script("release", [{path,["Path",12,"Another"]}])), - ?line {'EXIT',{{badarg,[sillent]}, _}} = + {'EXIT',{{badarg,[{path,["Path",12,"Another"]}]}, _}} = + (catch systools:make_script("release", [{path,["Path",12,"Another"]}])), + {'EXIT',{{badarg,[sillent]}, _}} = (catch systools:make_script("release", [{path,["Path","Another"]},sillent])), - ?line {'EXIT',{{badarg,[locall]}, _}} = + {'EXIT',{{badarg,[locall]}, _}} = (catch systools:make_script("release", [{path,["Path","Another"]},locall])), - ?line {'EXIT',{{badarg,[src_testsxx]}, _}} = + {'EXIT',{{badarg,[src_testsxx]}, _}} = (catch systools:make_script("release", [{path,["Path"]},src_testsxx])), - ?line {'EXIT',{{badarg,[{variables, {"TEST", "/home/lib"}}]}, _}} = + {'EXIT',{{badarg,[{variables, {"TEST", "/home/lib"}}]}, _}} = (catch systools:make_script("release", [{variables, {"TEST", "/home/lib"}}])), - ?line {'EXIT',{{badarg,[{variables, [{a, b}, {"a", "b"}]}]}, _}} = + {'EXIT',{{badarg,[{variables, [{a, b}, {"a", "b"}]}]}, _}} = (catch systools:make_script("release", [{variables, [{a, b}, {"a", "b"}]}])), - ?line {'EXIT',{{badarg,[exreff]}, _}} = + {'EXIT',{{badarg,[exreff]}, _}} = (catch systools:make_script("release", [{path,["Path","Another"]},exreff])), - ?line {'EXIT',{{badarg,[{exref,["appl"]}]}, _}} = + {'EXIT',{{badarg,[{exref,["appl"]}]}, _}} = (catch systools:make_script("release", [{exref,["appl"]}])), - ?line {'EXIT',{{badarg,[{machine, "appl"}]}, _}} = + {'EXIT',{{badarg,[{machine, "appl"}]}, _}} = (catch systools:make_script("release", [{machine,"appl"}])), ok. -%% make_script -%% -normal_script(suite) -> []; -normal_script(doc) -> - ["Check that make_script handles normal case."]; +%% make_script: Check that normal case normal_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line PSAVE = code:get_path(), % Save path + {ok, OldDir} = file:get_cwd(), + PSAVE = code:get_path(), % Save path - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P1 = fname([LibDir, 'db-2.1', ebin]), - ?line P2 = fname([LibDir, 'fe-3.1', ebin]), + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P1 = fname([LibDir, 'db-2.1', ebin]), + P2 = fname([LibDir, 'fe-3.1', ebin]), - ?line true = code:add_patha(P1), - ?line true = code:add_patha(P2), + true = code:add_patha(P1), + true = code:add_patha(P2), - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(filename:basename(LatestName)), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity + ok = systools:make_script(filename:basename(LatestName)), + {ok, _} = read_script_file(LatestName), % Check readabillity %% Check the same but w. silent flag - ?line {ok, _, []} = systools:make_script(LatestName, [silent]), + {ok, _, []} = systools:make_script(LatestName, [silent]), %% Use the local option - ?line ok = systools:make_script(LatestName, [local]), - ?line ok = check_script_path(LatestName), + ok = systools:make_script(LatestName, [local]), + ok = check_script_path(LatestName), %% use the path option - ?line code:set_path(PSAVE), % Restore path + code:set_path(PSAVE), % Restore path %% Mess up std path: - ?line true = code:add_patha(fname([LibDir, 'db-1.0', ebin])), - ?line true = code:add_patha(fname([LibDir, 'fe-2.1', ebin])), + true = code:add_patha(fname([LibDir, 'db-1.0', ebin])), + true = code:add_patha(fname([LibDir, 'fe-2.1', ebin])), - ?line error = systools:make_script(LatestName), %should fail - ?line ok = systools:make_script(LatestName,[{path, [P1, P2]}]), + error = systools:make_script(LatestName), %should fail + ok = systools:make_script(LatestName,[{path, [P1, P2]}]), - ?line ok = file:set_cwd(OldDir), - ?line code:set_path(PSAVE), % Restore path + ok = file:set_cwd(OldDir), + code:set_path(PSAVE), % Restore path ok. -%% make_script -%% -no_mod_vsn_script(suite) -> []; -no_mod_vsn_script(doc) -> - ["Check that make_script handles normal case.", - "Modules specified without version in .app file (db-3.1)." - "Note that this is now the normal way - i.e. systools now " - "ignores the module versions in the .app file."]; +%% make_script: +%% Modules specified without version in .app file (db-3.1). +%% Note that this is now the normal way - i.e. systools now ignores +%% the module versions in the .app file. no_mod_vsn_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line PSAVE = code:get_path(), % Save path + {ok, OldDir} = file:get_cwd(), + PSAVE = code:get_path(), % Save path - ?line {LatestDir, LatestName} = create_script(latest_no_mod_vsn,Config), + {LatestDir, LatestName} = create_script(latest_no_mod_vsn,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P1 = fname([LibDir, 'db-3.1', ebin]), - ?line P2 = fname([LibDir, 'fe-3.1', ebin]), + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P1 = fname([LibDir, 'db-3.1', ebin]), + P2 = fname([LibDir, 'fe-3.1', ebin]), - ?line true = code:add_patha(P1), - ?line true = code:add_patha(P2), + true = code:add_patha(P1), + true = code:add_patha(P2), - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(filename:basename(LatestName)), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity + ok = systools:make_script(filename:basename(LatestName)), + {ok, _} = read_script_file(LatestName), % Check readabillity %% Check the same but w. silent flag - ?line {ok, _, []} = systools:make_script(LatestName, [silent]), + {ok, _, []} = systools:make_script(LatestName, [silent]), %% Use the local option - ?line ok = systools:make_script(LatestName, [local]), - ?line ok = check_script_path(LatestName), + ok = systools:make_script(LatestName, [local]), + ok = check_script_path(LatestName), %% use the path option - ?line code:set_path(PSAVE), % Restore path + code:set_path(PSAVE), % Restore path %% Mess up std path: - ?line true = code:add_patha(fname([LibDir, 'db-1.0', ebin])), - ?line true = code:add_patha(fname([LibDir, 'fe-2.1', ebin])), + true = code:add_patha(fname([LibDir, 'db-1.0', ebin])), + true = code:add_patha(fname([LibDir, 'fe-2.1', ebin])), - ?line error = systools:make_script(LatestName), %should fail - ?line ok = systools:make_script(LatestName, - [{path, [P1, P2]}]), + error = systools:make_script(LatestName), %should fail + ok = systools:make_script(LatestName, + [{path, [P1, P2]}]), - ?line ok = file:set_cwd(OldDir), - ?line code:set_path(PSAVE), % Restore path + ok = file:set_cwd(OldDir), + code:set_path(PSAVE), % Restore path ok. -%% make_script -%% -wildcard_script(suite) -> []; -wildcard_script(doc) -> - ["Check that make_script handles wildcards in path."]; +%% make_script: Check that make_script handles wildcards in path. wildcard_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line WildDir = fname([LibDir, '*', ebin]), + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + WildDir = fname([LibDir, '*', ebin]), - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line error = systools:make_script(filename:basename(LatestName)), + error = systools:make_script(filename:basename(LatestName)), - ?line ok = systools:make_script(LatestName, - [{path, [WildDir]}]), + ok = systools:make_script(LatestName, + [{path, [WildDir]}]), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity + {ok, _} = read_script_file(LatestName), % Check readabillity - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -variable_script(suite) -> []; -variable_script(doc) -> - ["Add own installation dependent variable in script."]; +%% make_script: Add own installation dependent variable in script. variable_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(LatestName, - [{path, P}, - {variables, [{"TEST", LibDir}]}]), + ok = systools:make_script(LatestName, + [{path, P}, + {variables, [{"TEST", LibDir}]}]), %% Check variables - ?line ok = check_var_script_file([fname(['$TEST', 'db-2.1', ebin]), - fname(['$TEST', 'fe-3.1', ebin])], - P, - LatestName), + ok = check_var_script_file([fname(['$TEST', 'db-2.1', ebin]), + fname(['$TEST', 'fe-3.1', ebin])], + P, + LatestName), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -abnormal_script(suite) -> []; -abnormal_script(doc) -> - ["Abnormal cases."]; +%% make_script: Abnormal cases. abnormal_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), + DataDir = filename:absname(?copydir), - ?line ok = file:set_cwd(LatestDir), - ?line LibDir = fname([DataDir, d_bad_app_vsn, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + ok = file:set_cwd(LatestDir), + LibDir = fname([DataDir, d_bad_app_vsn, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], %% Check wrong app vsn - ?line error = systools:make_script(LatestName, [{path, P}]), - ?line {error, - systools_make, - [{error_reading, {db, {no_valid_version, - {{"should be","2.1"}, - {"found file", _, "2.0"}}}}}]} = + error = systools:make_script(LatestName, [{path, P}]), + {error, + systools_make, + [{error_reading, {db, {no_valid_version, + {{"should be","2.1"}, + {"found file", _, "2.0"}}}}}]} = systools:make_script(LatestName, [silent, {path, P}]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -no_sasl_script(suite) -> []; -no_sasl_script(doc) -> - ["Create script without sasl appl. Check warning."]; +%% make_script: Create script without sasl appl. Check warning. no_sasl_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest1_no_sasl,Config), + {LatestDir, LatestName} = create_script(latest1_no_sasl,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _ , [{warning,missing_sasl}]} = + {ok, _ , [{warning,missing_sasl}]} = systools:make_script(LatestName,[{path, P},silent]), - ?line {ok, _ , []} = + {ok, _ , []} = systools:make_script(LatestName,[{path, P},silent, no_warn_sasl]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -src_tests_script(suite) -> []; -src_tests_script(doc) -> - ["Do not check date of object file or that source code can be found."]; +%% make_script: Do not check date of object file or that source code +%% can be found. src_tests_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line PSAVE = code:get_path(), % Save path + {ok, OldDir} = file:get_cwd(), + PSAVE = code:get_path(), % Save path - ?line {LatestDir, LatestName} = create_script(latest,Config), - ?line BootFile = LatestName ++ ".boot", + {LatestDir, LatestName} = create_script(latest,Config), + BootFile = LatestName ++ ".boot", - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_missing_src, lib]), - ?line P1 = fname([LibDir, 'db-2.1', ebin]), - ?line P2 = fname([LibDir, 'fe-3.1', ebin]), + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_missing_src, lib]), + P1 = fname([LibDir, 'db-2.1', ebin]), + P2 = fname([LibDir, 'fe-3.1', ebin]), N = [P1, P2], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% Manipulate the modification date of a beam file so it seems %% older than its .erl file - ?line Erl = filename:join([P1,"..","src","db1.erl"]), - ?line {ok, FileInfo=#file_info{mtime={{Y,M,D},T}}} = file:read_file_info(Erl), - ?line Beam = filename:join(P1,"db1.beam"), - ?line ok=file:write_file_info(Beam, FileInfo#file_info{mtime={{Y-1,M,D},T}}), + Erl = filename:join([P1,"..","src","db1.erl"]), + {ok, FileInfo=#file_info{mtime={{Y,M,D},T}}} = file:read_file_info(Erl), + Beam = filename:join(P1,"db1.beam"), + ok=file:write_file_info(Beam, FileInfo#file_info{mtime={{Y-1,M,D},T}}), %% Remove a .erl file - ?line Erl2 = filename:join([P1,"..","src","db2.erl"]), - ?line file:delete(Erl2), + Erl2 = filename:join([P1,"..","src","db2.erl"]), + file:delete(Erl2), %% Then make script %% .boot file should not exist - ?line ok = file:delete(BootFile), - ?line false = filelib:is_regular(BootFile), + ok = file:delete(BootFile), + false = filelib:is_regular(BootFile), %% With warnings_as_errors and src_tests option, an error should be issued - ?line error = + error = systools:make_script(LatestName, [silent, {path, N}, src_tests, warnings_as_errors]), - ?line error = + error = systools:make_script(LatestName, [{path, N}, src_tests, warnings_as_errors]), %% due to warnings_as_errors .boot file should still not exist - ?line false = filelib:is_regular(BootFile), + false = filelib:is_regular(BootFile), %% Two warnings should be issued when src_tests is given %% 1. old object code for db1.beam %% 2. missing source code for db2.beam - ?line {ok, _, [{warning,{obj_out_of_date,_}}, - {warning,{source_not_found,_}}]} = + {ok, _, [{warning,{obj_out_of_date,_}}, + {warning,{source_not_found,_}}]} = systools:make_script(LatestName, [silent, {path, N}, src_tests]), %% .boot file should exist now - ?line true = filelib:is_regular(BootFile), + true = filelib:is_regular(BootFile), %% Without the src_tests option, no warning should be issued - ?line {ok, _, []} = + {ok, _, []} = systools:make_script(LatestName, [silent, {path, N}]), %% Check that the old no_module_tests option (from the time when %% it was default to do the src_test) is ignored - ?line {ok, _, [{warning,{obj_out_of_date,_}}, - {warning,{source_not_found,_}}]} = + {ok, _, [{warning,{obj_out_of_date,_}}, + {warning,{source_not_found,_}}]} = systools:make_script(LatestName, [silent, {path, N}, no_module_tests, src_tests]), - ?line ok = file:set_cwd(OldDir), - ?line code:set_path(PSAVE), + ok = file:set_cwd(OldDir), + code:set_path(PSAVE), ok. -%% make_script -%% -warn_shadow_script(suite) -> []; -warn_shadow_script(doc) -> - ["Check that jam file out of date warning doesn't", - "shadow bad module version error."]; -warn_shadow_script(Config) when is_list(Config) -> - %% This test has been removed since the 'vsn' attribute is - %% not used any more, starting with R6. No warning - %% 'obj_out_of_date' seemed to be generated. - true. - - -%% make_script -%% -crazy_script(suite) -> []; -crazy_script(doc) -> - ["Do the crazy cases."]; +%% make_script: Do the crazy cases. crazy_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest, Config), + {LatestDir, LatestName} = create_script(latest, Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% Run with bad path - ?line error = systools:make_script(LatestName), - ?line {error, _, [{error_reading, _}, {error_reading, _}]} = + error = systools:make_script(LatestName), + {error, _, [{error_reading, _}, {error_reading, _}]} = systools:make_script(LatestName, [silent]), %% Run with .rel file lacking kernel - ?line {LatestDir2, LatestName2} = create_script(latest_nokernel, Config), - ?line ok = file:set_cwd(LatestDir2), + {LatestDir2, LatestName2} = create_script(latest_nokernel, Config), + ok = file:set_cwd(LatestDir2), - ?line error = systools:make_script(LatestName2), - ?line {error, _, {missing_mandatory_app,[kernel,stdlib]}} = + error = systools:make_script(LatestName2), + {error, _, {missing_mandatory_app,[kernel,stdlib]}} = systools:make_script(LatestName2, [silent,{path,P}]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -included_script(suite) -> []; -included_script(doc) -> - ["Check that make_script handles generation of script", - "for applications with included applications."]; +%% make_script: Check that make_script handles generation of script +%% for applications with included applications. included_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_include_files(inc1, Config), - ?line ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(LatestName), - ?line ok = check_include_script(LatestName, - [t1, t2, t3, t5, t4, t6], - [t1, t3, t6]), - ?line ok = file:set_cwd(OldDir), + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = create_include_files(inc1, Config), + ok = file:set_cwd(LatestDir), + ok = systools:make_script(LatestName), + ok = check_include_script(LatestName, + [t1, t2, t3, t5, t4, t6], + [t1, t3, t6]), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -included_override_script(suite) -> []; -included_override_script(doc) -> - ["Check that make_script handles generation of script", - "for applications with included applications which are override by", - "the .rel file."]; +%% make_script: Check that make_script handles generation of script +%% for applications with included applications which are override by +%% the .rel file. included_override_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_include_files(inc2, Config), - ?line ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(LatestName), - ?line ok = check_include_script(LatestName, - [t1, t2, t3, t4, t6, t5], - [t1, t3, t6, t5]), - - ?line {_, LatestName1} = create_include_files(inc3, Config), - ?line ok = systools:make_script(LatestName1), - ?line ok = check_include_script(LatestName1, - [t3, t5, t4, t6, t1, t2], - [t3, t6, t1, t2]), - - ?line {_, LatestName2} = create_include_files(inc4, Config), - ?line ok = systools:make_script(LatestName2), - ?line ok = check_include_script(LatestName2, - [t3, t4, t6, t5, t1, t2], - [t3, t6, t5, t1, t2]), - - ?line {_, LatestName3} = create_include_files(inc5, Config), - ?line ok = systools:make_script(LatestName3), - ?line ok = check_include_script(LatestName3, - [t3, t4, t6, t1, t2], - [t3, t6, t1, t2]), - - ?line ok = file:set_cwd(OldDir), + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = create_include_files(inc2, Config), + ok = file:set_cwd(LatestDir), + ok = systools:make_script(LatestName), + ok = check_include_script(LatestName, + [t1, t2, t3, t4, t6, t5], + [t1, t3, t6, t5]), + + {_, LatestName1} = create_include_files(inc3, Config), + ok = systools:make_script(LatestName1), + ok = check_include_script(LatestName1, + [t3, t5, t4, t6, t1, t2], + [t3, t6, t1, t2]), + + {_, LatestName2} = create_include_files(inc4, Config), + ok = systools:make_script(LatestName2), + ok = check_include_script(LatestName2, + [t3, t4, t6, t5, t1, t2], + [t3, t6, t5, t1, t2]), + + {_, LatestName3} = create_include_files(inc5, Config), + ok = systools:make_script(LatestName3), + ok = check_include_script(LatestName3, + [t3, t4, t6, t1, t2], + [t3, t6, t1, t2]), + + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -included_fail_script(suite) -> []; -included_fail_script(doc) -> - ["Check that make_script handles errors then generating", - "script with included applications."]; +%% make_script: Check that make_script handles errors then generating +%% script with included applications. included_fail_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_include_files(inc6, Config), - ?line ok = file:set_cwd(LatestDir), - ?line {error, _, {undefined_applications,[t2]}} = + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = create_include_files(inc6, Config), + ok = file:set_cwd(LatestDir), + {error, _, {undefined_applications,[t2]}} = systools:make_script(LatestName, [silent]), - ?line {_, LatestName1} = create_include_files(inc7, Config), - ?line {error, _, {duplicate_include,[{{t5,t7,_,_},{t5,t6,_,_}}]}} = + {_, LatestName1} = create_include_files(inc7, Config), + {error, _, {duplicate_include,[{{t5,t7,_,_},{t5,t6,_,_}}]}} = systools:make_script(LatestName1, [silent]), - ?line {_, LatestName3} = create_include_files(inc9, Config), - ?line {error, _, {circular_dependencies,[{t10,_},{t8,_}]}} = + {_, LatestName3} = create_include_files(inc9, Config), + {error, _, {circular_dependencies,[{t10,_},{t8,_}]}} = systools:make_script(LatestName3, [silent]), - ?line {_, LatestName4} = create_include_files(inc10, Config), - ?line {error, _, [{error_reading,{t9,{override_include,[t7]}}}]} = + {_, LatestName4} = create_include_files(inc10, Config), + {error, _, [{error_reading,{t9,{override_include,[t7]}}}]} = systools:make_script(LatestName4, [silent]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -included_bug_script(suite) -> []; -included_bug_script(doc) -> - ["Check that make_script handles generation of script", - "with difficult dependency for included applications."]; +%% make_script: Check that make_script handles generation of script +%% with difficult dependency for included applications. included_bug_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_include_files(inc11, Config), - ?line ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(LatestName), - ?line ok = check_include_script(LatestName, - [t13, t11, t12], - [t11, t12]), - ?line ok = file:set_cwd(OldDir), + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = create_include_files(inc11, Config), + ok = file:set_cwd(LatestDir), + ok = systools:make_script(LatestName), + ok = check_include_script(LatestName, + [t13, t11, t12], + [t11, t12]), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -otp_3065(suite) -> []; -otp_3065(doc) -> - ["Circular dependencies in systools:make_script()."]; -otp_3065(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_include_files(otp_3065, Config), - ?line ok = file:set_cwd(LatestDir), - ?line ok = systools:make_script(LatestName), - ?line ok = check_include_script(LatestName, - [aa12, chAts, chTraffic], - [chTraffic]), - ?line ok = file:set_cwd(OldDir), +%% make_script: Circular dependencies in systools:make_script(). +otp_3065_circular_dependenies(Config) when is_list(Config) -> + {ok, OldDir} = file:get_cwd(), + {LatestDir, LatestName} = + create_include_files(otp_3065_circular_dependenies, Config), + ok = file:set_cwd(LatestDir), + ok = systools:make_script(LatestName), + ok = check_include_script(LatestName, + [aa12, chAts, chTraffic], + [chTraffic]), + ok = file:set_cwd(OldDir), ok. -%% make_script -%% -exref_script(suite) -> []; -exref_script(doc) -> - ["Check that make_script exref option works."]; +%% make_script: Check that make_script exref option works. exref_script(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line PSAVE = code:get_path(), % Save path + {ok, OldDir} = file:get_cwd(), + PSAVE = code:get_path(), % Save path - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _, _} = systools:make_script(LatestName, [{path,P}, silent]), + {ok, _, _} = systools:make_script(LatestName, [{path,P}, silent]), %% Complete exref - ?line {ok, _, W1} = + {ok, _, W1} = systools:make_script(LatestName, [exref, {path,P}, silent]), - ?line check_exref_warnings(with_db1, W1), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity + check_exref_warnings(with_db1, W1), + {ok, _} = read_script_file(LatestName), % Check readabillity %% Only exref the db application. - ?line {ok, _, W2} = + {ok, _, W2} = systools:make_script(LatestName, [{exref,[db]}, {path,P}, silent]), - ?line check_exref_warnings(with_db1, W2), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity + check_exref_warnings(with_db1, W2), + {ok, _} = read_script_file(LatestName), % Check readabillity %% Only exref the fe application. - ?line {ok, _, W3} = + {ok, _, W3} = systools:make_script(LatestName, [{exref,[fe]}, {path,P}, silent]), - ?line check_exref_warnings(without_db1, W3), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity + check_exref_warnings(without_db1, W3), + {ok, _} = read_script_file(LatestName), % Check readabillity %% exref the db and stdlib applications. - ?line {ok, _, W4} = + {ok, _, W4} = systools:make_script(LatestName, [{exref,[db,stdlib]}, {path,P}, silent]), - ?line check_exref_warnings(with_db1, W4), - ?line {ok, _} = read_script_file(LatestName), % Check readabillity - ?line ok = file:set_cwd(OldDir), - ?line code:set_path(PSAVE), % Restore path + check_exref_warnings(with_db1, W4), + {ok, _} = read_script_file(LatestName), % Check readabillity + ok = file:set_cwd(OldDir), + code:set_path(PSAVE), % Restore path ok. check_exref_warnings(with_db1, W) -> @@ -729,11 +657,11 @@ filter({ok, W}) -> {ok, filter(W)}; filter(L) -> lists:filter(fun%({hipe_consttab,_,_}) -> false; - ({int,_,_}) -> false; - ({i,_,_}) -> false; - ({crypto,_,_}) -> false; - (_) -> true - end, + ({int,_,_}) -> false; + ({i,_,_}) -> false; + ({crypto,_,_}) -> false; + (_) -> true + end, L). get_exref1(T, [{warning, {T, Value}}|_]) -> {ok, Value}; @@ -753,197 +681,172 @@ no_hipe({ok, Value}) -> {ok, Value} end. -%% tar_options -%% -tar_options(suite) -> []; -tar_options(doc) -> - ["Check illegal tar options."]; +%% tar_options: Check illegal tar options. tar_options(Config) when is_list(Config) -> - ?line {'EXIT',{{badarg,[{path,["Path",12,"Another"]}]}, _}} = + {'EXIT',{{badarg,[{path,["Path",12,"Another"]}]}, _}} = (catch systools:make_tar("release", [{path,["Path",12,"Another"]}])), - ?line {'EXIT',{{badarg,[sillent]}, _}} = + {'EXIT',{{badarg,[sillent]}, _}} = (catch systools:make_tar("release", [{path,["Path","Another"]},sillent])), - ?line {'EXIT',{{badarg,[{dirs,["dirs"]}]}, _}} = + {'EXIT',{{badarg,[{dirs,["dirs"]}]}, _}} = (catch systools:make_tar("release", [{dirs, ["dirs"]}])), - ?line {'EXIT',{{badarg,[{erts, illegal}]}, _}} = + {'EXIT',{{badarg,[{erts, illegal}]}, _}} = (catch systools:make_tar("release", [{erts, illegal}])), - ?line {'EXIT',{{badarg,[src_testsxx]}, _}} = + {'EXIT',{{badarg,[src_testsxx]}, _}} = (catch systools:make_tar("release", [{path,["Path"]},src_testsxx])), - ?line {'EXIT',{{badarg,[{variables, [{a, b}, {"a", "b"}]}]}, _}} = + {'EXIT',{{badarg,[{variables, [{a, b}, {"a", "b"}]}]}, _}} = (catch systools:make_tar("release", [{variables, [{a, b}, {"a", "b"}]}])), - ?line {'EXIT',{{badarg,[{var_tar, illegal}]}, _}} = + {'EXIT',{{badarg,[{var_tar, illegal}]}, _}} = (catch systools:make_tar("release", [{var_tar, illegal}])), - ?line {'EXIT',{{badarg,[exreff]}, _}} = + {'EXIT',{{badarg,[exreff]}, _}} = (catch systools:make_tar("release", [{path,["Path","Another"]},exreff])), - ?line {'EXIT',{{badarg,[{exref,["appl"]}]}, _}} = + {'EXIT',{{badarg,[{exref,["appl"]}]}, _}} = (catch systools:make_tar("release", [{exref,["appl"]}])), - ?line {'EXIT',{{badarg,[{machine, "appl"}]}, _}} = + {'EXIT',{{badarg,[{machine, "appl"}]}, _}} = (catch systools:make_tar("release", [{machine,"appl"}])), ok. -%% normal_tar -%% -normal_tar(suite) -> []; -normal_tar(doc) -> - ["Check normal case"]; +%% make_tar: Check normal case normal_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), - ?line ok = systools:make_tar(LatestName, [{path, P}]), - ?line ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), - ?line {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), - ?line ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), + {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + ok = systools:make_tar(LatestName, [{path, P}]), + ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), + {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% no_mod_vsn_tar -%% -no_mod_vsn_tar(suite) -> []; -no_mod_vsn_tar(doc) -> - ["Check normal case", - "Modules specified without version in .app file (db-3.1)." - "Note that this is now the normal way - i.e. systools now " - "ignores the module versions in the .app file."]; +%% make_tar: Modules specified without version in .app file (db-3.1). +%% Note that this is now the normal way - i.e. systools now ignores +%% the module versions in the .app file. no_mod_vsn_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest_no_mod_vsn,Config), + {LatestDir, LatestName} = create_script(latest_no_mod_vsn,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-3.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-3.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), - ?line ok = systools:make_tar(LatestName, [{path, P}]), - ?line ok = check_tar(fname([lib,'db-3.1',ebin,'db.app']), LatestName), - ?line {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), - ?line ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), + {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + ok = systools:make_tar(LatestName, [{path, P}]), + ok = check_tar(fname([lib,'db-3.1',ebin,'db.app']), LatestName), + {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% variable_tar -%% -variable_tar(suite) -> []; -variable_tar(doc) -> - ["Use variable and create separate tar (included in generated tar)."]; +%% make_tar: Use variable and create separate tar (included in generated tar). variable_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _, _} = systools:make_script(LatestName, - [silent, - {path, P}, - {variables,[{"TEST", LibDir}]}]), + {ok, _, _} = systools:make_script(LatestName, + [silent, + {path, P}, + {variables,[{"TEST", LibDir}]}]), - ?line ok = systools:make_tar(LatestName, [{path, P}, - {variables,[{"TEST", LibDir}]}]), - ?line ok = check_var_tar("TEST", LatestName), + ok = systools:make_tar(LatestName, [{path, P}, + {variables,[{"TEST", LibDir}]}]), + ok = check_var_tar("TEST", LatestName), - ?line {ok, _, _} = systools:make_tar(LatestName, - [{path, P}, silent, - {variables,[{"TEST", LibDir}]}]), - ?line ok = check_var_tar("TEST", LatestName), + {ok, _, _} = systools:make_tar(LatestName, + [{path, P}, silent, + {variables,[{"TEST", LibDir}]}]), + ok = check_var_tar("TEST", LatestName), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% link_tar -%% -link_tar(suite) -> []; -link_tar(doc) -> - ["Check that symlinks in applications are handled correctly"]; +%% make_tar: Check that symlinks in applications are handled correctly. link_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_links, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_links, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], %% Make some links - ?line Db1Erl = fname(['db-2.1',src,'db1.erl']), - ?line NormalDb1Erl = fname([DataDir,d_normal,lib,Db1Erl]), - ?line LinkDb1Erl = fname([LibDir, Db1Erl]), - ?line ok = file:make_symlink(NormalDb1Erl, LinkDb1Erl), - ?line Db1Beam = fname(['db-2.1',ebin,'db1.beam']), - ?line NormalDb1Beam = fname([DataDir,d_normal,lib,Db1Beam]), - ?line LinkDb1Beam = fname([LibDir, Db1Beam]), - ?line ok = file:make_symlink(NormalDb1Beam, LinkDb1Beam), - ?line FeApp = fname(['fe-3.1',ebin,'fe.app']), - ?line NormalFeApp = fname([DataDir,d_normal,lib,FeApp]), - ?line LinkFeApp = fname([LibDir, FeApp]), - ?line ok = file:make_symlink(NormalFeApp, LinkFeApp), - + Db1Erl = fname(['db-2.1',src,'db1.erl']), + NormalDb1Erl = fname([DataDir,d_normal,lib,Db1Erl]), + LinkDb1Erl = fname([LibDir, Db1Erl]), + ok = file:make_symlink(NormalDb1Erl, LinkDb1Erl), + Db1Beam = fname(['db-2.1',ebin,'db1.beam']), + NormalDb1Beam = fname([DataDir,d_normal,lib,Db1Beam]), + LinkDb1Beam = fname([LibDir, Db1Beam]), + ok = file:make_symlink(NormalDb1Beam, LinkDb1Beam), + FeApp = fname(['fe-3.1',ebin,'fe.app']), + NormalFeApp = fname([DataDir,d_normal,lib,FeApp]), + LinkFeApp = fname([LibDir, FeApp]), + ok = file:make_symlink(NormalFeApp, LinkFeApp), + %% Create the tar and check that the linked files are included as %% regular files - ?line ok = file:set_cwd(LatestDir), - - ?line {ok,_,[]} = systools:make_script(LatestName, [{path, P},silent]), - - ?line {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), - ?line ok = check_tar_regular(?privdir, - [fname([lib,FeApp]), - fname([lib,Db1Beam])], - LatestName), - - ?line {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent, - {dirs, [src]}]), - ?line ok = check_tar_regular(?privdir, - [fname([lib,FeApp]), - fname([lib,Db1Beam]), - fname([lib,Db1Erl])], - LatestName), - - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(LatestDir), + + {ok,_,[]} = systools:make_script(LatestName, [{path, P},silent]), + + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent]), + ok = check_tar_regular(?privdir, + [fname([lib,FeApp]), + fname([lib,Db1Beam])], + LatestName), + + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent, + {dirs, [src]}]), + ok = check_tar_regular(?privdir, + [fname([lib,FeApp]), + fname([lib,Db1Beam]), + fname([lib,Db1Erl])], + LatestName), + + ok = file:set_cwd(OldDir), ok. -%% src_tests_tar -%% -src_tests_tar(suite) -> []; -src_tests_tar(doc) -> - ["Do not check date of object file or that source code can be found."]; +%% make_tar: Do not check date of object file or that source code can be found. src_tests_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_missing_src, lib]), - ?line P1 = fname([LibDir, 'db-2.1', ebin]), - ?line P2 = fname([LibDir, 'fe-3.1', ebin]), + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_missing_src, lib]), + P1 = fname([LibDir, 'db-2.1', ebin]), + P2 = fname([LibDir, 'fe-3.1', ebin]), P = [P1, P2], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% Manipulate the modification date of a beam file so it seems %% older than the .erl file @@ -953,362 +856,308 @@ src_tests_tar(Config) when is_list(Config) -> ok = file:write_file_info(Beam, FileInfo#file_info{mtime={{Y-1,M,D},T}}), %% Remove a .erl file - ?line Erl2 = filename:join([P1,"..","src","db2.erl"]), - ?line file:delete(Erl2), + Erl2 = filename:join([P1,"..","src","db2.erl"]), + file:delete(Erl2), - ?line ok = systools:make_script(LatestName, [{path, P}]), + ok = systools:make_script(LatestName, [{path, P}]), %% Then make tar - two warnings should be issued when %% src_tests is given %% 1. old object code for db1.beam %% 2. missing source code for db2.beam - ?line {ok, _, [{warning,{obj_out_of_date,_}}, - {warning,{source_not_found,_}}]} = + {ok, _, [{warning,{obj_out_of_date,_}}, + {warning,{source_not_found,_}}]} = systools:make_tar(LatestName, [{path, P}, silent, {dirs, [src]}, src_tests]), - ?line ok = check_tar(fname([lib,'db-2.1',src,'db1.erl']), LatestName), + ok = check_tar(fname([lib,'db-2.1',src,'db1.erl']), LatestName), %% Without the src_tests option, no warning should be issued - ?line {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent, - {dirs, [src]}]), - ?line ok = check_tar(fname([lib,'db-2.1',src,'db1.erl']), LatestName), + {ok, _, []} = systools:make_tar(LatestName, [{path, P}, silent, + {dirs, [src]}]), + ok = check_tar(fname([lib,'db-2.1',src,'db1.erl']), LatestName), %% Check that the old no_module_tests option (from the time when %% it was default to do the src_test) is ignored - ?line {ok, _, [{warning,{obj_out_of_date,_}}, - {warning,{source_not_found,_}}]} = + {ok, _, [{warning,{obj_out_of_date,_}}, + {warning,{source_not_found,_}}]} = systools:make_tar(LatestName, [{path, P}, silent, {dirs, [src]}, no_module_tests, src_tests]), - ?line ok = check_tar(fname([lib,'db-2.1',src,'db1.erl']), LatestName), - - ?line ok = file:set_cwd(OldDir), - ok. + ok = check_tar(fname([lib,'db-2.1',src,'db1.erl']), LatestName), -%% shadow_tar -%% -shadow_tar(suite) -> []; -shadow_tar(doc) -> - ["Check that jam file out of date warning doesn't", - "shadow bad module version error."]; -shadow_tar(Config) when is_list(Config) -> - % This test has been commented out since the 'vsn' attribute is not used - % any more, starting with R6. No warning 'obj_out_of_date' seemed to be - % generated. - true; -shadow_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line PSAVE = code:get_path(), % Save path - - ?line {LatestDir, LatestName} = create_script(latest,Config), - - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, 'd_bad_mod+warn', lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], - - ?line ok = file:set_cwd(LatestDir), - - ?line {error, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), - ?line {error, _, _} = systools:make_tar(LatestName, [{path, P}, silent, - {dirs, [src]}]), - ?line ok = file:set_cwd(OldDir), - ?line code:set_path(PSAVE), + ok = file:set_cwd(OldDir), ok. -%% var_tar -%% -var_tar(suite) -> []; -var_tar(doc) -> - ["Check that make_tar handles generation and placement of tar", - "files for variables outside the main tar file.", - "Test the {var_tar, include | ownfile | omit} option."]; +%% make_tar: Check that make_tar handles generation and placement of +%% tar files for variables outside the main tar file. +%% Test the {var_tar, include | ownfile | omit} optio. var_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line PSAVE = code:get_path(), % Save path + {ok, OldDir} = file:get_cwd(), + PSAVE = code:get_path(), % Save path - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _, _} = systools:make_script(LatestName, - [silent, - {path, P}, - {variables,[{"TEST", LibDir}]}]), + {ok, _, _} = systools:make_script(LatestName, + [silent, + {path, P}, + {variables,[{"TEST", LibDir}]}]), - ?line ok = systools:make_tar(LatestName, [{path, P}, - {var_tar, ownfile}, - {variables,[{"TEST", LibDir}]}]), + ok = systools:make_tar(LatestName, [{path, P}, + {var_tar, ownfile}, + {variables,[{"TEST", LibDir}]}]), - ?line true = exists_tar_file("TEST"), %% Also removes the file ! - ?line {error, {not_generated, _}} = check_var_tar("TEST", LatestName), + true = exists_tar_file("TEST"), %% Also removes the file ! + {error, {not_generated, _}} = check_var_tar("TEST", LatestName), - ?line ok = systools:make_tar(LatestName, [{path, P}, - {var_tar, omit}, - {variables,[{"TEST", LibDir}]}]), + ok = systools:make_tar(LatestName, [{path, P}, + {var_tar, omit}, + {variables,[{"TEST", LibDir}]}]), - ?line {error, {not_generated, _}} = check_var_tar("TEST", LatestName), - ?line false = exists_tar_file("TEST"), + {error, {not_generated, _}} = check_var_tar("TEST", LatestName), + false = exists_tar_file("TEST"), - ?line ok = systools:make_tar(LatestName, [{path, P}, - {var_tar, include}, - {variables,[{"TEST", LibDir}]}]), + ok = systools:make_tar(LatestName, [{path, P}, + {var_tar, include}, + {variables,[{"TEST", LibDir}]}]), - ?line ok = check_var_tar("TEST", LatestName), - ?line false = exists_tar_file("TEST"), + ok = check_var_tar("TEST", LatestName), + false = exists_tar_file("TEST"), - ?line ok = file:set_cwd(OldDir), - ?line code:set_path(PSAVE), + ok = file:set_cwd(OldDir), + code:set_path(PSAVE), ok. -%% exref_tar -%% -exref_tar(suite) -> []; -exref_tar(doc) -> - ["Check exref option."]; +%% make_tar: Check exref option. exref_tar(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest,Config), + {LatestDir, LatestName} = create_script(latest,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'fe-3.1', ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), - ?line {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), %% Complete exref - ?line {ok, _, W1} = + {ok, _, W1} = systools:make_tar(LatestName, [exref, {path, P}, silent]), - ?line check_exref_warnings(with_db1, W1), - ?line ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), + check_exref_warnings(with_db1, W1), + ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), %% Only exref the db application. - ?line {ok, _, W2} = + {ok, _, W2} = systools:make_tar(LatestName, [{exref, [db]}, {path, P}, silent]), - ?line check_exref_warnings(with_db1, W2), - ?line ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), + check_exref_warnings(with_db1, W2), + ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), %% Only exref the fe application. - ?line {ok, _, W3} = + {ok, _, W3} = systools:make_tar(LatestName, [{exref, [fe]}, {path, P}, silent]), - ?line check_exref_warnings(without_db1, W3), - ?line ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), + check_exref_warnings(without_db1, W3), + ok = check_tar(fname([lib,'db-2.1',ebin,'db.app']), LatestName), %% exref the db and stdlib applications. - ?line {ok, _, W4} = + {ok, _, W4} = systools:make_tar(LatestName, [{exref, [db, stdlib]}, {path, P}, silent]), - ?line check_exref_warnings(with_db1, W4), - ?line ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), + check_exref_warnings(with_db1, W4), + ok = check_tar(fname([lib,'fe-3.1',ebin,'fe.app']), LatestName), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% otp_9507 -%% -otp_9507(suite) -> []; -otp_9507(doc) -> - ["make_tar failed when path given as just 'ebin'."]; -otp_9507(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), +%% make_tar: OTP-9507 - make_tar failed when path given as just 'ebin'. +otp_9507_path_ebin(Config) when is_list(Config) -> + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest_small,Config), + {LatestDir, LatestName} = create_script(latest_small,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line FeDir = fname([LibDir, 'fe-3.1']), + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + FeDir = fname([LibDir, 'fe-3.1']), - ?line ok = file:set_cwd(FeDir), + ok = file:set_cwd(FeDir), RelName = fname([LatestDir,LatestName]), - ?line P1 = ["./ebin", - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], - ?line {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]), - ?line ok = systools:make_tar(RelName, [{path, P1}]), - ?line Content1 = tar_contents(RelName), + P1 = ["./ebin", + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]), + ok = systools:make_tar(RelName, [{path, P1}]), + Content1 = tar_contents(RelName), - ?line P2 = ["ebin", - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + P2 = ["ebin", + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], %% Tickets solves the following line - it used to fail with %% {function_clause,[{filename,join,[[]]},...} - ?line ok = systools:make_tar(RelName, [{path, P2}]), - ?line Content2 = tar_contents(RelName), + ok = systools:make_tar(RelName, [{path, P2}]), + Content2 = tar_contents(RelName), true = (Content1 == Content2), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% The relup stuff. -%% -%% - - -%% make_relup -%% -normal_relup(suite) -> []; -normal_relup(doc) -> - ["Check normal case"]; +%% make_relup: Check normal case normal_relup(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir,LatestName} = create_script(latest0,Config), - ?line {_LatestDir1,LatestName1} = create_script(latest1,Config), - ?line {_LatestDir2,LatestName2} = create_script(latest2,Config), + {LatestDir,LatestName} = create_script(latest0,Config), + {_LatestDir1,LatestName1} = create_script(latest1,Config), + {_LatestDir2,LatestName2} = create_script(latest2,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% This is the ultra normal case - ?line ok = systools:make_relup(LatestName, [LatestName1], [LatestName1], - [{path, P}]), - ?line ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), - ?line {ok, _, _, []} = + ok = systools:make_relup(LatestName, [LatestName1], [LatestName1], + [{path, P}]), + ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), + {ok, _, _, []} = systools:make_relup(LatestName, [LatestName1], [LatestName1], [{path, P}, silent]), - ?line ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), + ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), %% file should not be written if warnings_as_errors is enabled. %% delete before running tests. - ?line ok = file:delete("relup"), + ok = file:delete("relup"), %% Check that warnings are treated as errors - ?line error = + error = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, warnings_as_errors]), - ?line error = + error = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, silent, warnings_as_errors]), %% relup file should not exist - ?line false = filelib:is_regular("relup"), + false = filelib:is_regular("relup"), %% Check that warnings get through - ?line ok = systools:make_relup(LatestName, [LatestName2], [LatestName1], - [{path, P}]), - ?line ok = check_relup([{fe, "3.1"}, {db, "2.1"}], [{db, "1.0"}]), - ?line {ok, _, _, [pre_R15_emulator_upgrade,{erts_vsn_changed, _}]} = + ok = systools:make_relup(LatestName, [LatestName2], [LatestName1], + [{path, P}]), + ok = check_relup([{fe, "3.1"}, {db, "2.1"}], [{db, "1.0"}]), + {ok, _, _, [pre_R15_emulator_upgrade,{erts_vsn_changed, _}]} = systools:make_relup(LatestName, [LatestName2], [LatestName1], [{path, P}, silent]), - ?line ok = check_relup([{fe, "3.1"}, {db, "2.1"}], [{db, "1.0"}]), + ok = check_relup([{fe, "3.1"}, {db, "2.1"}], [{db, "1.0"}]), %% relup file should exist now - ?line true = filelib:is_regular("relup"), + true = filelib:is_regular("relup"), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -restart_relup(suite) -> []; -restart_relup(doc) -> - ["Test relup which includes emulator restart"]; +%% make_relup: Test relup which includes emulator restart. restart_relup(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir,LatestName} = create_script(latest0,Config), - ?line {_LatestDir1,LatestName1} = create_script(latest1,Config), - ?line {_LatestDir0CurrErts,LatestName0CurrErts} = + {LatestDir,LatestName} = create_script(latest0,Config), + {_LatestDir1,LatestName1} = create_script(latest1,Config), + {_LatestDir0CurrErts,LatestName0CurrErts} = create_script(latest0_current_erts,Config), - ?line {_CurrentAllDir,CurrentAllName} = create_script(current_all,Config), - ?line {_CurrentAllFutErtsDir,CurrentAllFutErtsName} = + {_CurrentAllDir,CurrentAllName} = create_script(current_all,Config), + {_CurrentAllFutErtsDir,CurrentAllFutErtsName} = create_script(current_all_future_erts,Config), - ?line {_CurrentAllFutSaslDir,CurrentAllFutSaslName} = + {_CurrentAllFutSaslDir,CurrentAllFutSaslName} = create_script(current_all_future_sasl,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin]), - fname([DataDir, lib, 'sasl-9.9', ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin]), + fname([DataDir, lib, 'sasl-9.9', ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% OTP-2561: Check that the option 'restart_emulator' generates a %% "restart_emulator" instruction. - ?line {ok, _ , _, []} = - systools:make_relup(LatestName, [LatestName1], [LatestName1], - [{path, P},restart_emulator,silent]), - ?line ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), - ?line ok = check_restart_emulator(), + {ok, _ , _, []} = + systools:make_relup(LatestName, [LatestName1], [LatestName1], + [{path, P},restart_emulator,silent]), + ok = check_relup([{db, "2.1"}], [{db, "1.0"}]), + ok = check_restart_emulator(), %% Pre-R15 to Post-R15 upgrade - ?line {ok, _ , _, Ws} = - systools:make_relup(LatestName0CurrErts, - [LatestName1], - [LatestName1], - [{path, P},silent]), - ?line ok = check_relup([{db,"2.1"}], [{db, "1.0"}]), - ?line ok = check_pre_to_post_r15_restart_emulator(), - ?line ok = check_pre_to_post_r15_warnings(Ws), + {ok, _ , _, Ws} = + systools:make_relup(LatestName0CurrErts, + [LatestName1], + [LatestName1], + [{path, P},silent]), + ok = check_relup([{db,"2.1"}], [{db, "1.0"}]), + ok = check_pre_to_post_r15_restart_emulator(), + ok = check_pre_to_post_r15_warnings(Ws), %% Check that new sasl version generates a restart_new_emulator %% instruction - ?line {ok, _ , _, []} = - systools:make_relup(CurrentAllFutSaslName, - [CurrentAllName], - [CurrentAllName], - [{path, P},silent]), - ?line ok = check_relup([{fe, "3.1"}], []), - ?line ok = check_restart_emulator_diff_coreapp(), + {ok, _ , _, []} = + systools:make_relup(CurrentAllFutSaslName, + [CurrentAllName], + [CurrentAllName], + [{path, P},silent]), + ok = check_relup([{fe, "3.1"}], []), + ok = check_restart_emulator_diff_coreapp(), %% Check that new erts version generates a restart_new_emulator %% instruction, if FromSaslVsn >= R15SaslVsn %% (One erts_vsn_changed warning for upgrade and one for downgrade) - ?line {ok, _ , _, [{erts_vsn_changed,_},{erts_vsn_changed,_}]} = - systools:make_relup(CurrentAllFutErtsName, - [CurrentAllName], - [CurrentAllName], - [{path, P},silent]), - ?line ok = check_relup([{fe, "3.1"}], []), - ?line ok = check_restart_emulator_diff_coreapp(), + {ok, _ , _, [{erts_vsn_changed,_},{erts_vsn_changed,_}]} = + systools:make_relup(CurrentAllFutErtsName, + [CurrentAllName], + [CurrentAllName], + [{path, P},silent]), + ok = check_relup([{fe, "3.1"}], []), + ok = check_restart_emulator_diff_coreapp(), %% Check that new erts version generates a restart_new_emulator %% instruction, and can be combined with restart_emulator opt. %% (One erts_vsn_changed warning for upgrade and one for downgrade) - ?line {ok, _ , _, [{erts_vsn_changed,_},{erts_vsn_changed,_}]} = - systools:make_relup(CurrentAllFutErtsName, - [CurrentAllName], - [CurrentAllName], - [{path, P},restart_emulator,silent]), - ?line ok = check_relup([{fe, "3.1"}], []), - ?line ok = check_restart_emulator(), - ?line ok = check_restart_emulator_diff_coreapp(), - - ?line ok = file:set_cwd(OldDir), + {ok, _ , _, [{erts_vsn_changed,_},{erts_vsn_changed,_}]} = + systools:make_relup(CurrentAllFutErtsName, + [CurrentAllName], + [CurrentAllName], + [{path, P},restart_emulator,silent]), + ok = check_relup([{fe, "3.1"}], []), + ok = check_restart_emulator(), + ok = check_restart_emulator_diff_coreapp(), + + ok = file:set_cwd(OldDir), ok. @@ -1364,293 +1213,276 @@ check_pre_to_post_r15_warnings(Ws) -> true = lists:member(pre_R15_emulator_upgrade,Ws), ok. -%% make_relup -%% -no_appup_relup(suite) -> []; -no_appup_relup(doc) -> - ["Check that appup files may be missing, but only if we don't need them."]; +%% make_relup: Check that appup files may be missing, but only if we +%% don't need them. no_appup_relup(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir,LatestName} = create_script(latest_small,Config), - ?line {_LatestDir0,LatestName0} = create_script(latest_small0,Config), - ?line {_LatestDir1,LatestName1} = create_script(latest_small1,Config), + {LatestDir,LatestName} = create_script(latest_small,Config), + {_LatestDir0,LatestName0} = create_script(latest_small0,Config), + {_LatestDir1,LatestName1} = create_script(latest_small1,Config), - ?line DataDir = filename:absname(?copydir), + DataDir = filename:absname(?copydir), - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% Check that appup might be missing - ?line P1 = [fname([DataDir, d_no_appup, lib, 'fe-3.1', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], - ?line ok = + P1 = [fname([DataDir, d_no_appup, lib, 'fe-3.1', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + ok = systools:make_relup(LatestName, [LatestName], [], [{path, P1}]), - ?line {ok,_, _, []} = + {ok,_, _, []} = systools:make_relup(LatestName, [LatestName], [], [silent, {path, P1}]), %% Check that appup might NOT be missing when we need it - ?line P2 = [fname([DataDir, d_no_appup, lib, 'fe-3.1', ebin]), - fname([DataDir, d_no_appup, lib, 'fe-2.1', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], - ?line error = + P2 = [fname([DataDir, d_no_appup, lib, 'fe-3.1', ebin]), + fname([DataDir, d_no_appup, lib, 'fe-2.1', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + error = systools:make_relup(LatestName, [LatestName0], [], [{path, P2}]), - ?line {error,_,{file_problem, {_,{error,{open,_,_}}}}} = + {error,_,{file_problem, {_,{error,{open,_,_}}}}} = systools:make_relup(LatestName, [], [LatestName0], [silent, {path, P2}]), %% Check that appups missing vsn traps - ?line P3 = [fname([DataDir, d_no_appup, lib, 'fe-2.1', ebin]), - fname([DataDir, d_no_appup, lib, 'fe-500.18.7', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + P3 = [fname([DataDir, d_no_appup, lib, 'fe-2.1', ebin]), + fname([DataDir, d_no_appup, lib, 'fe-500.18.7', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line error = + error = systools:make_relup(LatestName0, [LatestName1], [], [{path, P3}]), - ?line {error,_,{no_relup, _, _, _}} = + {error,_,{no_relup, _, _, _}} = systools:make_relup(LatestName0, [], [LatestName1], [silent, {path, P3}]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_relup -%% -bad_appup_relup(suite) -> []; -bad_appup_relup(doc) -> - ["Check that badly written appup files are detected"]; +%% make_relup: Check that badly written appup files are detected. bad_appup_relup(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir,LatestName} = create_script(latest_small,Config), - ?line {_LatestDir0,LatestName0} = create_script(latest_small0,Config), + {LatestDir,LatestName} = create_script(latest_small,Config), + {_LatestDir0,LatestName0} = create_script(latest_small0,Config), - ?line DataDir = filename:absname(?copydir), - ?line N2 = [fname([DataDir, d_bad_appup, lib, 'fe-3.1', ebin]), - fname([DataDir, d_bad_appup, lib, 'fe-2.1', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + N2 = [fname([DataDir, d_bad_appup, lib, 'fe-3.1', ebin]), + fname([DataDir, d_bad_appup, lib, 'fe-2.1', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% Check that bad appup is trapped - ?line error = + error = systools:make_relup(LatestName, [LatestName0], [], [{path, N2}]), - ?line {error,_,{file_problem, {_, {error, {parse,_, _}}}}} = + {error,_,{file_problem, {_, {error, {parse,_, _}}}}} = systools:make_relup(LatestName, [], [LatestName0], [silent, {path, N2}]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% make_relup -%% -abnormal_relup(suite) -> []; -abnormal_relup(doc) -> - ["Check some abnormal cases"]; +%% make_relup: Check some abnormal cases. abnormal_relup(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir,LatestName} = create_script(latest0,Config), - ?line {_LatestDir1,LatestName1} = create_script(latest1,Config), + {LatestDir,LatestName} = create_script(latest0,Config), + {_LatestDir1,LatestName1} = create_script(latest1,Config), %% Check wrong app vsn - ?line DataDir = filename:absname(?copydir), - ?line P = [fname([DataDir, d_bad_app_vsn, lib, 'db-2.1', ebin]), - fname([DataDir, d_bad_app_vsn, lib, 'fe-3.1', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], - - ?line ok = file:set_cwd(LatestDir), - - ?line error = systools:make_relup(LatestName, [LatestName1], [LatestName1], - [{path, P}]), - ?line R0 = systools:make_relup(LatestName, [LatestName1], [LatestName1], - [silent, {path, P}]), - ?line {error,systools_make, - [{error_reading,{db,{no_valid_version, - {{"should be","2.1"}, - {"found file", _, "2.0"}}}}}]} = R0, - ?line ok = file:set_cwd(OldDir), + DataDir = filename:absname(?copydir), + P = [fname([DataDir, d_bad_app_vsn, lib, 'db-2.1', ebin]), + fname([DataDir, d_bad_app_vsn, lib, 'fe-3.1', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + + ok = file:set_cwd(LatestDir), + + error = systools:make_relup(LatestName, [LatestName1], [LatestName1], + [{path, P}]), + R0 = systools:make_relup(LatestName, [LatestName1], [LatestName1], + [silent, {path, P}]), + {error,systools_make, + [{error_reading,{db,{no_valid_version, + {{"should be","2.1"}, + {"found file", _, "2.0"}}}}}]} = R0, + ok = file:set_cwd(OldDir), ok. -%% make_relup -%% -no_sasl_relup(suite) -> []; -no_sasl_relup(doc) -> - ["Check relup can not be created is sasl is not in rel file"]; +%% make_relup: Check relup can not be created is sasl is not in rel file. no_sasl_relup(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {Dir1,Name1} = create_script(latest1_no_sasl,Config), - ?line {_Dir2,Name2} = create_script(latest1,Config), + {ok, OldDir} = file:get_cwd(), + {Dir1,Name1} = create_script(latest1_no_sasl,Config), + {_Dir2,Name2} = create_script(latest1,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(Dir1), + ok = file:set_cwd(Dir1), - ?line error = systools:make_relup(Name2, [Name1], [Name1], [{path, P}]), - ?line R1 = systools:make_relup(Name2, [Name1], [Name1],[silent, {path, P}]), - ?line {error,systools_relup,{missing_sasl,_}} = R1, + error = systools:make_relup(Name2, [Name1], [Name1], [{path, P}]), + R1 = systools:make_relup(Name2, [Name1], [Name1],[silent, {path, P}]), + {error,systools_relup,{missing_sasl,_}} = R1, - ?line error = systools:make_relup(Name1, [Name2], [Name2], [{path, P}]), - ?line R2 = systools:make_relup(Name1, [Name2], [Name2],[silent, {path, P}]), - ?line {error,systools_relup,{missing_sasl,_}} = R2, + error = systools:make_relup(Name1, [Name2], [Name2], [{path, P}]), + R2 = systools:make_relup(Name1, [Name2], [Name2],[silent, {path, P}]), + {error,systools_relup,{missing_sasl,_}} = R2, - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -%% Check that application start type is used in relup -app_start_type_relup(suite) -> - []; -app_start_type_relup(doc) -> - ["Release upgrade file with various application start types"]; +%% make_relup: Check that application start type is used in relup app_start_type_relup(Config) when is_list(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line {Dir1,Name1} = create_script(latest_app_start_type1,Config), - ?line {Dir2,Name2} = create_script(latest_app_start_type2,Config), - ?line Release1 = filename:join(Dir1,Name1), - ?line Release2 = filename:join(Dir2,Name2), - - ?line {ok, Release2Relup, systools_relup, []} = systools:make_relup(Release2, [Release1], [Release1], [{outdir, PrivDir}, silent]), - ?line {"LATEST_APP_START_TYPE2", - [{"LATEST_APP_START_TYPE1",[], UpInstructions}], - [{"LATEST_APP_START_TYPE1",[], DownInstructions}]} = Release2Relup, + PrivDir = ?config(priv_dir, Config), + {Dir1,Name1} = create_script(latest_app_start_type1,Config), + {Dir2,Name2} = create_script(latest_app_start_type2,Config), + Release1 = filename:join(Dir1,Name1), + Release2 = filename:join(Dir2,Name2), + + {ok, Release2Relup, systools_relup, []} = systools:make_relup(Release2, [Release1], [Release1], [{outdir, PrivDir}, silent]), + {"LATEST_APP_START_TYPE2", + [{"LATEST_APP_START_TYPE1",[], UpInstructions}], + [{"LATEST_APP_START_TYPE1",[], DownInstructions}]} = Release2Relup, %% ?t:format("Up: ~p",[UpInstructions]), %% ?t:format("Dn: ~p",[DownInstructions]), - ?line [{load_object_code, {mnesia, _, _}}, - {load_object_code, {runtime_tools, _, _}}, - {load_object_code, {webtool, _, _}}, - {load_object_code, {snmp, _, _}}, - {load_object_code, {xmerl, _, _}}, - point_of_no_return - | UpInstructionsT] = UpInstructions, - ?line true = lists:member({apply,{application,start,[mnesia,permanent]}}, UpInstructionsT), - ?line true = lists:member({apply,{application,start,[runtime_tools,transient]}}, UpInstructionsT), - ?line true = lists:member({apply,{application,start,[webtool,temporary]}}, UpInstructionsT), - ?line true = lists:member({apply,{application,load,[snmp]}}, UpInstructionsT), - ?line false = lists:any(fun({apply,{application,_,[xmerl|_]}}) -> true; (_) -> false end, UpInstructionsT), - ?line [point_of_no_return | DownInstructionsT] = DownInstructions, - ?line true = lists:member({apply,{application,stop,[mnesia]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,stop,[runtime_tools]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,stop,[webtool]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,stop,[snmp]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,stop,[xmerl]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,unload,[mnesia]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,unload,[runtime_tools]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,unload,[webtool]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,unload,[snmp]}}, DownInstructionsT), - ?line true = lists:member({apply,{application,unload,[xmerl]}}, DownInstructionsT), + [{load_object_code, {mnesia, _, _}}, + {load_object_code, {runtime_tools, _, _}}, + {load_object_code, {webtool, _, _}}, + {load_object_code, {snmp, _, _}}, + {load_object_code, {xmerl, _, _}}, + point_of_no_return + | UpInstructionsT] = UpInstructions, + true = lists:member({apply,{application,start,[mnesia,permanent]}}, UpInstructionsT), + true = lists:member({apply,{application,start,[runtime_tools,transient]}}, UpInstructionsT), + true = lists:member({apply,{application,start,[webtool,temporary]}}, UpInstructionsT), + true = lists:member({apply,{application,load,[snmp]}}, UpInstructionsT), + false = lists:any(fun({apply,{application,_,[xmerl|_]}}) -> true; (_) -> false end, UpInstructionsT), + [point_of_no_return | DownInstructionsT] = DownInstructions, + true = lists:member({apply,{application,stop,[mnesia]}}, DownInstructionsT), + true = lists:member({apply,{application,stop,[runtime_tools]}}, DownInstructionsT), + true = lists:member({apply,{application,stop,[webtool]}}, DownInstructionsT), + true = lists:member({apply,{application,stop,[snmp]}}, DownInstructionsT), + true = lists:member({apply,{application,stop,[xmerl]}}, DownInstructionsT), + true = lists:member({apply,{application,unload,[mnesia]}}, DownInstructionsT), + true = lists:member({apply,{application,unload,[runtime_tools]}}, DownInstructionsT), + true = lists:member({apply,{application,unload,[webtool]}}, DownInstructionsT), + true = lists:member({apply,{application,unload,[snmp]}}, DownInstructionsT), + true = lists:member({apply,{application,unload,[xmerl]}}, DownInstructionsT), ok. -%% regexp_relup +%% make_relup: Check that regexp can be used in .appup for UpFromVsn +%% and DownToVsn. regexp_relup(Config) -> - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir,LatestName} = create_script(latest_small,Config), - ?line {_LatestDir0,LatestName0} = create_script(latest_small0,Config), - ?line {_LatestDir1,LatestName1} = create_script(latest_small2,Config), + {LatestDir,LatestName} = create_script(latest_small,Config), + {_LatestDir0,LatestName0} = create_script(latest_small0,Config), + {_LatestDir1,LatestName1} = create_script(latest_small2,Config), - ?line DataDir = filename:absname(?copydir), - ?line P = [fname([DataDir, d_regexp_appup, lib, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + P = [fname([DataDir, d_regexp_appup, lib, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(LatestDir), %% Upgrade fe 2.1 -> 3.1, and downgrade 2.1 -> 3.1 %% Shall match the first entry if fe-3.1 appup. - ?line {ok, _, _, []} = + {ok, _, _, []} = systools:make_relup(LatestName, [LatestName0], [LatestName0], [{path, P}, silent]), - ?line ok = check_relup([{fe, "3.1"}], [{fe, "2.1"}]), + ok = check_relup([{fe, "3.1"}], [{fe, "2.1"}]), %% Upgrade fe 2.1.1 -> 3.1 %% Shall match the second entry in fe-3.1 appup. Have added a %% restart_emulator instruction there to distinguish it from %% the first entry... - ?line {ok, _, _, []} = + {ok, _, _, []} = systools:make_relup(LatestName, [LatestName1], [], [{path, P}, silent]), - ?line ok = check_relup_up_only([{fe, "3.1"}]), - ?line ok = check_restart_emulator_up_only(), + ok = check_relup_up_only([{fe, "3.1"}]), + ok = check_restart_emulator_up_only(), %% Attempt downgrade fe 3.1 -> 2.1.1 %% Shall not match any entry!! - ?line {error,systools_relup,{no_relup,_,_,_}} = + {error,systools_relup,{no_relup,_,_,_}} = systools:make_relup(LatestName, [], [LatestName1], [{path, P}, silent]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. +%% make_hybrid_boot: Normal case. %% For upgrade of erts - create a boot file which is a hybrid between %% old and new release - i.e. starts erts, kernel, stdlib, sasl from %% new release, all other apps from old release. normal_hybrid(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {Dir1,Name1} = create_script(latest1,Config), - ?line {_Dir2,Name2} = create_script(current_all,Config), + {ok, OldDir} = file:get_cwd(), + {Dir1,Name1} = create_script(latest1,Config), + {_Dir2,Name2} = create_script(current_all,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(Dir1), + ok = file:set_cwd(Dir1), - ?line {ok, _ , []} = systools:make_script(Name1,[{path, P},silent]), - ?line {ok, _ , []} = systools:make_script(Name2,[{path, P},silent]), - ?line {ok,Boot1} = file:read_file(Name1 ++ ".boot"), - ?line {ok,Boot2} = file:read_file(Name2 ++ ".boot"), + {ok, _ , []} = systools:make_script(Name1,[{path, P},silent]), + {ok, _ , []} = systools:make_script(Name2,[{path, P},silent]), + {ok,Boot1} = file:read_file(Name1 ++ ".boot"), + {ok,Boot2} = file:read_file(Name2 ++ ".boot"), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), - ?line BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, - ?line {ok,Hybrid} = systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, - BasePaths, [dummy,args]), + BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, + {ok,Hybrid} = systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, + BasePaths, [dummy,args]), - ?line {script,{"Test release","tmp_vsn"},Script} = binary_to_term(Hybrid), + {script,{"Test release","tmp_vsn"},Script} = binary_to_term(Hybrid), ct:log("~p.~n",[Script]), %% Check that all paths to base apps are replaced by paths from BaseLib Boot1Str = io_lib:format("~p~n",[binary_to_term(Boot1)]), HybridStr = io_lib:format("~p~n",[binary_to_term(Hybrid)]), ReOpts = [global,{capture,first,list},unicode], - ?line {match,OldKernelMatch} = re:run(Boot1Str,"kernel-[0-9\.]+",ReOpts), - ?line {match,OldStdlibMatch} = re:run(Boot1Str,"stdlib-[0-9\.]+",ReOpts), - ?line {match,OldSaslMatch} = re:run(Boot1Str,"sasl-[0-9\.]+",ReOpts), + {match,OldKernelMatch} = re:run(Boot1Str,"kernel-[0-9\.]+",ReOpts), + {match,OldStdlibMatch} = re:run(Boot1Str,"stdlib-[0-9\.]+",ReOpts), + {match,OldSaslMatch} = re:run(Boot1Str,"sasl-[0-9\.]+",ReOpts), - ?line nomatch = re:run(HybridStr,"kernel-[0-9\.]+",ReOpts), - ?line nomatch = re:run(HybridStr,"stdlib-[0-9\.]+",ReOpts), - ?line nomatch = re:run(HybridStr,"sasl-[0-9\.]+",ReOpts), - ?line {match,NewKernelMatch} = re:run(HybridStr,"testkernelpath",ReOpts), - ?line {match,NewStdlibMatch} = re:run(HybridStr,"teststdlibpath",ReOpts), - ?line {match,NewSaslMatch} = re:run(HybridStr,"testsaslpath",ReOpts), + nomatch = re:run(HybridStr,"kernel-[0-9\.]+",ReOpts), + nomatch = re:run(HybridStr,"stdlib-[0-9\.]+",ReOpts), + nomatch = re:run(HybridStr,"sasl-[0-9\.]+",ReOpts), + {match,NewKernelMatch} = re:run(HybridStr,"testkernelpath",ReOpts), + {match,NewStdlibMatch} = re:run(HybridStr,"teststdlibpath",ReOpts), + {match,NewSaslMatch} = re:run(HybridStr,"testsaslpath",ReOpts), NewKernelN = length(NewKernelMatch), - ?line NewKernelN = length(OldKernelMatch), + NewKernelN = length(OldKernelMatch), NewStdlibN = length(NewStdlibMatch), - ?line NewStdlibN = length(OldStdlibMatch), + NewStdlibN = length(OldStdlibMatch), NewSaslN = length(NewSaslMatch), - ?line NewSaslN = length(OldSaslMatch), + NewSaslN = length(OldSaslMatch), %% Check that application load instruction has correct versions Apps = application:loaded_applications(), @@ -1658,33 +1490,33 @@ normal_hybrid(Config) -> {_,_,StdlibVsn} = lists:keyfind(stdlib,1,Apps), {_,_,SaslVsn} = lists:keyfind(sasl,1,Apps), - ?line [KernelInfo] = [I || {kernelProcess,application_controller, + [KernelInfo] = [I || {kernelProcess,application_controller, {application_controller,start, [{application,kernel,I}]}} <- Script], - ?line [StdlibInfo] = [I || {apply, + [StdlibInfo] = [I || {apply, {application,load, [{application,stdlib,I}]}} <- Script], - ?line [SaslInfo] = [I || {apply, + [SaslInfo] = [I || {apply, {application,load, [{application,sasl,I}]}} <- Script], - ?line {vsn,KernelVsn} = lists:keyfind(vsn,1,KernelInfo), - ?line {vsn,StdlibVsn} = lists:keyfind(vsn,1,StdlibInfo), - ?line {vsn,SaslVsn} = lists:keyfind(vsn,1,SaslInfo), + {vsn,KernelVsn} = lists:keyfind(vsn,1,KernelInfo), + {vsn,StdlibVsn} = lists:keyfind(vsn,1,StdlibInfo), + {vsn,SaslVsn} = lists:keyfind(vsn,1,SaslInfo), %% Check that new_emulator_upgrade call is added - ?line [_,{apply,{release_handler,new_emulator_upgrade,[dummy,args]}}|_] = + [_,{apply,{release_handler,new_emulator_upgrade,[dummy,args]}}|_] = lists:reverse(Script), %% Check that db-1.0 and fe-3.1 are used (i.e. vsns from old release) %% And that fe is in there (it exists in old rel but not in new) - ?line {match,DbMatch} = re:run(HybridStr,"db-[0-9\.]+",ReOpts), - ?line {match,[_|_]=FeMatch} = re:run(HybridStr,"fe-[0-9\.]+",ReOpts), - ?line true = lists:all(fun(["db-1.0"]) -> true; + {match,DbMatch} = re:run(HybridStr,"db-[0-9\.]+",ReOpts), + {match,[_|_]=FeMatch} = re:run(HybridStr,"fe-[0-9\.]+",ReOpts), + true = lists:all(fun(["db-1.0"]) -> true; (_) -> false end, DbMatch), - ?line true = lists:all(fun(["fe-3.1"]) -> true; + true = lists:all(fun(["fe-3.1"]) -> true; (_) -> false end, FeMatch), @@ -1694,210 +1526,209 @@ normal_hybrid(Config) -> {_,_,Old} = binary_to_term(Boot1), OldLength = length(Old), NewLength = length(Script), - ?line NewLength = OldLength + 1, + NewLength = OldLength + 1, ok. +%% make_hybrid_boot: No sasl in from-release. %% Check that systools_make:make_hybrid_boot fails with a meaningful %% error message if the FromBoot does not include the sasl %% application. hybrid_no_old_sasl(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {Dir1,Name1} = create_script(latest1_no_sasl,Config), - ?line {_Dir2,Name2} = create_script(current_all,Config), + {ok, OldDir} = file:get_cwd(), + {Dir1,Name1} = create_script(latest1_no_sasl,Config), + {_Dir2,Name2} = create_script(current_all,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(Dir1), + ok = file:set_cwd(Dir1), - ?line {ok, _ , [{warning,missing_sasl}]} = + {ok, _ , [{warning,missing_sasl}]} = systools:make_script(Name1,[{path, P},silent]), - ?line {ok, _ , []} = systools:make_script(Name2,[{path, P},silent]), - ?line {ok,Boot1} = file:read_file(Name1 ++ ".boot"), - ?line {ok,Boot2} = file:read_file(Name2 ++ ".boot"), + {ok, _ , []} = systools:make_script(Name2,[{path, P},silent]), + {ok,Boot1} = file:read_file(Name1 ++ ".boot"), + {ok,Boot2} = file:read_file(Name2 ++ ".boot"), - ?line BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, - ?line {error,{app_not_replaced,sasl}} = + BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, + {error,{app_not_replaced,sasl}} = systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, BasePaths,[dummy,args]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. +%% make_hybrid_boot: No sasl in to-release. %% Check that systools_make:make_hybrid_boot fails with a meaningful %% error message if the ToBoot does not include the sasl %% application. hybrid_no_new_sasl(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {Dir1,Name1} = create_script(latest1,Config), - ?line {_Dir2,Name2} = create_script(current_all_no_sasl,Config), + {ok, OldDir} = file:get_cwd(), + {Dir1,Name1} = create_script(latest1,Config), + {_Dir2,Name2} = create_script(current_all_no_sasl,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = [fname([DataDir, d_normal, lib])], - ?line P = [fname([LibDir, '*', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = [fname([DataDir, d_normal, lib])], + P = [fname([LibDir, '*', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], - ?line ok = file:set_cwd(Dir1), + ok = file:set_cwd(Dir1), - ?line {ok, _ , []} = systools:make_script(Name1,[{path, P},silent]), - ?line {ok, _ , [{warning,missing_sasl}]} = + {ok, _ , []} = systools:make_script(Name1,[{path, P},silent]), + {ok, _ , [{warning,missing_sasl}]} = systools:make_script(Name2,[{path, P},silent]), - ?line {ok,Boot1} = file:read_file(Name1 ++ ".boot"), - ?line {ok,Boot2} = file:read_file(Name2 ++ ".boot"), + {ok,Boot1} = file:read_file(Name1 ++ ".boot"), + {ok,Boot2} = file:read_file(Name2 ++ ".boot"), - ?line BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, - ?line {error,{app_not_found,sasl}} = + BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, + {error,{app_not_found,sasl}} = systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, BasePaths,[dummy,args]), - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. -otp_6226(suite) -> - []; -otp_6226(doc) -> - ["{outdir,Dir} option for systools:make_script()"]; -otp_6226(Config) when is_list(Config) -> +%% options: {outdir,Dir} option +otp_6226_outdir(Config) when is_list(Config) -> PrivDir = ?privdir, - ?line {ok, OldDir} = file:get_cwd(), + {ok, OldDir} = file:get_cwd(), - ?line {LatestDir, LatestName} = create_script(latest0,Config), - ?line {_LatestDir, LatestName1} = create_script(latest1,Config), + {LatestDir, LatestName} = create_script(latest0,Config), + {_LatestDir, LatestName1} = create_script(latest1,Config), - ?line DataDir = filename:absname(?copydir), - ?line LibDir = fname([DataDir, d_normal, lib]), - ?line P = [fname([LibDir, 'db-2.1', ebin]), - fname([LibDir, 'db-1.0', ebin]), - fname([LibDir, 'fe-3.1', ebin]), - fname([DataDir, lib, kernel, ebin]), - fname([DataDir, lib, stdlib, ebin]), - fname([DataDir, lib, sasl, ebin])], + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'db-1.0', ebin]), + fname([LibDir, 'fe-3.1', ebin]), + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin]), + fname([DataDir, lib, sasl, ebin])], + + ok = file:set_cwd(LatestDir), - ?line ok = file:set_cwd(LatestDir), - %% Create an outdir1 directory - ?line ok = file:make_dir("outdir1"), + ok = file:make_dir("outdir1"), %% ==== Now test systools:make_script ==== %% a) badarg - ?line {'EXIT', {{badarg,[{outdir,outdir1}]}, _}} = + {'EXIT', {{badarg,[{outdir,outdir1}]}, _}} = (catch systools:make_script(LatestName, [{outdir,outdir1}, {path,P},silent])), %% b) absolute path Outdir1 = filename:join(PrivDir, "outdir1"), - ?line {ok,_,[]} = systools:make_script(LatestName, [{outdir,Outdir1}, - {path,P},silent]), - ?line Script1 = filename:join(Outdir1, LatestName ++ ".script"), - ?line Boot1 = filename:join(Outdir1, LatestName ++ ".boot"), - ?line true = filelib:is_file(Script1), - ?line true = filelib:is_file(Boot1), - ?line ok = file:delete(Script1), - ?line ok = file:delete(Boot1), + {ok,_,[]} = systools:make_script(LatestName, [{outdir,Outdir1}, + {path,P},silent]), + Script1 = filename:join(Outdir1, LatestName ++ ".script"), + Boot1 = filename:join(Outdir1, LatestName ++ ".boot"), + true = filelib:is_file(Script1), + true = filelib:is_file(Boot1), + ok = file:delete(Script1), + ok = file:delete(Boot1), %% c) relative path - ?line {ok,_,[]} = systools:make_script(LatestName, [{outdir,"./outdir1"}, - {path,P},silent]), - ?line true = filelib:is_file(Script1), - ?line true = filelib:is_file(Boot1), - ?line ok = file:delete(Script1), - ?line ok = file:delete(Boot1), + {ok,_,[]} = systools:make_script(LatestName, [{outdir,"./outdir1"}, + {path,P},silent]), + true = filelib:is_file(Script1), + true = filelib:is_file(Boot1), + ok = file:delete(Script1), + ok = file:delete(Boot1), %% d) absolute but incorrect path - ?line Outdir2 = filename:join(PrivDir, "outdir2"), - ?line Script2 = filename:join(Outdir2, LatestName ++ ".script"), - ?line {error,_,{open,Script2,_}} = + Outdir2 = filename:join(PrivDir, "outdir2"), + Script2 = filename:join(Outdir2, LatestName ++ ".script"), + {error,_,{open,Script2,_}} = systools:make_script(LatestName, [{outdir,Outdir2},{path,P},silent]), %% e) relative but incorrect path - ?line {error,_,{open,_,_}} = + {error,_,{open,_,_}} = systools:make_script(LatestName, [{outdir,"./outdir2"},{path,P},silent]), %% f) with .rel in another directory than cwd - ?line ok = file:set_cwd(Outdir1), - ?line {ok,_,[]} = systools:make_script(filename:join(PrivDir, LatestName), - [{outdir,"."},{path,P},silent]), - ?line true = filelib:is_file(LatestName ++ ".script"), - ?line true = filelib:is_file(LatestName ++ ".boot"), - ?line ok = file:delete(LatestName ++ ".script"), - ?line ok = file:delete(LatestName ++ ".boot"), - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(Outdir1), + {ok,_,[]} = systools:make_script(filename:join(PrivDir, LatestName), + [{outdir,"."},{path,P},silent]), + true = filelib:is_file(LatestName ++ ".script"), + true = filelib:is_file(LatestName ++ ".boot"), + ok = file:delete(LatestName ++ ".script"), + ok = file:delete(LatestName ++ ".boot"), + ok = file:set_cwd(LatestDir), %% ==== Now test systools:make_tar ===== - ?line {ok,_,[]} = systools:make_script(LatestName, [{path,P},silent]), + {ok,_,[]} = systools:make_script(LatestName, [{path,P},silent]), %% a) badarg - ?line {'EXIT', {{badarg, [{outdir,outdir1}]}, _}} = + {'EXIT', {{badarg, [{outdir,outdir1}]}, _}} = (catch systools:make_tar(LatestName,[{outdir,outdir1},{path,P},silent])), %% b) absolute path - ?line {ok,_,[]} = systools:make_tar(LatestName, [{outdir,Outdir1}, - {path,P},silent]), - ?line Tar1 = filename:join(Outdir1,LatestName++".tar.gz"), - ?line true = filelib:is_file(Tar1), - ?line ok = file:delete(Tar1), + {ok,_,[]} = systools:make_tar(LatestName, [{outdir,Outdir1}, + {path,P},silent]), + Tar1 = filename:join(Outdir1,LatestName++".tar.gz"), + true = filelib:is_file(Tar1), + ok = file:delete(Tar1), %% c) relative path - ?line {ok,_,[]} = systools:make_tar(LatestName, [{outdir,"./outdir1"}, - {path,P},silent]), - ?line true = filelib:is_file(Tar1), - ?line ok = file:delete(Tar1), + {ok,_,[]} = systools:make_tar(LatestName, [{outdir,"./outdir1"}, + {path,P},silent]), + true = filelib:is_file(Tar1), + ok = file:delete(Tar1), %% d) absolute but incorrect path - ?line Tar2 = filename:join(Outdir2,LatestName++".tar.gz"), - ?line {error,_,{tar_error,{open,Tar2,{Tar2,enoent}}}} = + Tar2 = filename:join(Outdir2,LatestName++".tar.gz"), + {error,_,{tar_error,{open,Tar2,{Tar2,enoent}}}} = systools:make_tar(LatestName, [{outdir,Outdir2},{path,P},silent]), - + %% e) relative but incorrect path - ?line {error,_,{tar_error,{open,_,_}}} = - systools:make_tar(LatestName, [{outdir,"./outdir2"},{path,P},silent]), + {error,_,{tar_error,{open,_,_}}} = + systools:make_tar(LatestName, [{outdir,"./outdir2"},{path,P},silent]), %% f) with .rel in another directory than cwd - ?line ok = file:set_cwd(Outdir1), - ?line {ok,_,[]} = systools:make_tar(filename:join(PrivDir, LatestName), - [{outdir,"."},{path,P},silent]), - ?line true = filelib:is_file(Tar1), - ?line ok = file:set_cwd(LatestDir), + ok = file:set_cwd(Outdir1), + {ok,_,[]} = systools:make_tar(filename:join(PrivDir, LatestName), + [{outdir,"."},{path,P},silent]), + true = filelib:is_file(Tar1), + ok = file:set_cwd(LatestDir), %% ===== Now test systools:make_relup ===== %% a) badarg - ?line {'EXIT', {{badarg, [{outdir,outdir1}]}, _}} = + {'EXIT', {{badarg, [{outdir,outdir1}]}, _}} = (catch systools:make_relup(LatestName,[LatestName1],[LatestName1], [{outdir,outdir1}, {path,P},silent])), %% b) absolute path Relup = filename:join(Outdir1, "relup"), - ?line {ok,_,_,[]} = systools:make_relup(LatestName,[LatestName1],[LatestName1], - [{outdir,Outdir1}, - {path,P},silent]), - ?line true = filelib:is_file(Relup), - ?line ok = file:delete(Relup), - + {ok,_,_,[]} = systools:make_relup(LatestName,[LatestName1],[LatestName1], + [{outdir,Outdir1}, + {path,P},silent]), + true = filelib:is_file(Relup), + ok = file:delete(Relup), + %% c) relative path - ?line {ok,_,_,[]} = systools:make_relup(LatestName,[LatestName1],[LatestName1], - [{outdir,"./outdir1"}, - {path,P},silent]), - ?line true = filelib:is_file(Relup), - ?line ok = file:delete(Relup), - + {ok,_,_,[]} = systools:make_relup(LatestName,[LatestName1],[LatestName1], + [{outdir,"./outdir1"}, + {path,P},silent]), + true = filelib:is_file(Relup), + ok = file:delete(Relup), + %% d) absolute but incorrect path - ?line {error,_,{file_problem,{"relup",enoent}}} = + {error,_,{file_problem,{"relup",enoent}}} = systools:make_relup(LatestName,[LatestName1],[LatestName1], [{outdir,Outdir2},{path,P},silent]), - + %% e) relative but incorrect path - ?line {error,_,{file_problem,{"relup",enoent}}} = + {error,_,{file_problem,{"relup",enoent}}} = systools:make_relup(LatestName,[LatestName1],[LatestName1], [{outdir,"./outdir2"},{path,P},silent]), @@ -1906,7 +1737,7 @@ otp_6226(Config) when is_list(Config) -> %% cwd, not in the same directory as the .rel file -- %% Change back to previous working directory - ?line ok = file:set_cwd(OldDir), + ok = file:set_cwd(OldDir), ok. @@ -1929,7 +1760,7 @@ check_var_script_file(VarDirs, NoExistDirs, RelName) -> AllPaths = lists:append(lists:map(fun({path, P}) -> P; (_) -> [] end, - ListOfThings)), + ListOfThings)), case lists:filter(fun(VarDir) -> lists:member(VarDir, AllPaths) end, VarDirs) of VarDirs -> @@ -1954,7 +1785,7 @@ check_include_script(RelName, ExpectedLoad, ExpectedStart) -> [App || {apply,{application,load,[{application,App,_}]}} <- ListOfThings, App=/=kernel, App=/=stdlib], - + if ActualLoad =:= ExpectedLoad -> ok; true -> test_server:fail({bad_load_order, ActualLoad, ExpectedLoad}) end, @@ -2029,7 +1860,7 @@ check_tar_regular(PrivDir, Files, RelName) -> NotThere -> {error,{erroneous_tar_file,tar_name(RelName),NotThere}} end. - + delete_tree(Dir) -> case filelib:is_dir(Dir) of true -> @@ -2110,15 +1941,15 @@ create_script(current_all_future_sasl,Config) -> do_create_script(Id,Config,ErtsVsn,AppVsns) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, Id), - ?line {ok,Fd} = file:open(Name++".rel",write), - ?line RelfileContent = + PrivDir = ?privdir, + Name = fname(PrivDir, Id), + {ok,Fd} = file:open(Name++".rel",write), + RelfileContent = {release,{"Test release", string:to_upper(atom_to_list(Id))}, {erts,erts_vsn(ErtsVsn)}, app_vsns(AppVsns)}, - ?line io:format(Fd,"~p.~n",[RelfileContent]), - ?line ok = file:close(Fd), + io:format(Fd,"~p.~n",[RelfileContent]), + ok = file:close(Fd), {filename:dirname(Name), filename:basename(Name)}. core_apps(Vsn) -> @@ -2139,372 +1970,372 @@ erts_vsn(Vsn) -> Vsn. create_include_files(inc1, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc1), + PrivDir = ?privdir, + Name = fname(PrivDir, inc1), create_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t6, \"1.0\"}, {t5, \"1.0\"}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\"}, {t2, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t6, \"1.0\"}, {t5, \"1.0\"}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\"}, {t2, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc2, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc2), + PrivDir = ?privdir, + Name = fname(PrivDir, inc2), create_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t6 does not include t5 ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t6, \"1.0\", [t4]}, {t5, \"1.0\"}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\"}, {t2, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t6, \"1.0\", [t4]}, {t5, \"1.0\"}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\"}, {t2, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc3, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc3), + PrivDir = ?privdir, + Name = fname(PrivDir, inc3), create_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t3 does not include t2 ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t6, \"1.0\"}, {t5, \"1.0\"}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\", []}, {t2, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t6, \"1.0\"}, {t5, \"1.0\"}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\", []}, {t2, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc4, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc4), + PrivDir = ?privdir, + Name = fname(PrivDir, inc4), create_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t3 does not include t2 ! %% t6 does not include t5 ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t6, \"1.0\", [t4]}, {t5, \"1.0\"}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\", []}, {t2, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t6, \"1.0\", [t4]}, {t5, \"1.0\"}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\", []}, {t2, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc5, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc5), + PrivDir = ?privdir, + Name = fname(PrivDir, inc5), create_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t6 does not include t5 ! %% exclude t5. Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t6, \"1.0\", [t4]}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\", []}, {t2, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t6, \"1.0\", [t4]}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\", []}, {t2, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc6, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc6), + PrivDir = ?privdir, + Name = fname(PrivDir, inc6), create_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t3 does include non existing t2 ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t6, \"1.0\"}, {t5, \"1.0\"}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t6, \"1.0\"}, {t5, \"1.0\"}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc7, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc7), + PrivDir = ?privdir, + Name = fname(PrivDir, inc7), create_apps(PrivDir), create_app(t7, PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t7 and t6 does include t5 ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t7, \"1.0\"}, {t6, \"1.0\"}, {t5, \"1.0\"}, \n" - " {t4, \"1.0\"}, {t3, \"1.0\"}, {t2, \"1.0\"}, \n" - " {t1, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t7, \"1.0\"}, {t6, \"1.0\"}, {t5, \"1.0\"}, \n" + " {t4, \"1.0\"}, {t3, \"1.0\"}, {t2, \"1.0\"}, \n" + " {t1, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc8, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc8), + PrivDir = ?privdir, + Name = fname(PrivDir, inc8), create_circular_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t8 uses t9 and t10 includes t9 ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t8, \"1.0\"}, {t9, \"1.0\"}, {t10, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t8, \"1.0\"}, {t9, \"1.0\"}, {t10, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc9, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc9), + PrivDir = ?privdir, + Name = fname(PrivDir, inc9), create_circular_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t8 uses t9, t9 uses t10 and t10 includes t8 ==> circular !! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t8, \"1.0\"}, {t9, \"1.0\"}, {t10, \"1.0\", [t8]}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t8, \"1.0\"}, {t9, \"1.0\"}, {t10, \"1.0\", [t8]}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc10, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc10), + PrivDir = ?privdir, + Name = fname(PrivDir, inc10), create_circular_apps(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), %% t9 tries to include not specified (in .app file) application ! Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t8, \"1.0\"}, {t9, \"1.0\", [t7]}, {t10, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t8, \"1.0\"}, {t9, \"1.0\", [t7]}, {t10, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; create_include_files(inc11, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, inc11), + PrivDir = ?privdir, + Name = fname(PrivDir, inc11), create_apps2(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {t11, \"1.0\"}, \n" - " {t12, \"1.0\"}, \n" - " {t13, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {t11, \"1.0\"}, \n" + " {t12, \"1.0\"}, \n" + " {t13, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}; -create_include_files(otp_3065, Config) -> - ?line PrivDir = ?privdir, - ?line Name = fname(PrivDir, otp_3065), +create_include_files(otp_3065_circular_dependenies, Config) -> + PrivDir = ?privdir, + Name = fname(PrivDir, otp_3065_circular_dependenies), create_apps_3065(PrivDir), - ?line Apps = application_controller:which_applications(), - ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), - ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + Apps = application_controller:which_applications(), + {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), Rel = "{release, {\"test\",\"R1A\"}, {erts, \"45\"},\n" - " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" - ++ StdlibVer ++ "\"},\n" - " {chAts, \"1.0\"}, {aa12, \"1.0\"}, \n" - " {chTraffic, \"1.0\"}]}.\n", + " [{kernel, \"" ++ KernelVer ++ "\"}, {stdlib, \"" + ++ StdlibVer ++ "\"},\n" + " {chAts, \"1.0\"}, {aa12, \"1.0\"}, \n" + " {chTraffic, \"1.0\"}]}.\n", file:write_file(Name ++ ".rel", list_to_binary(Rel)), {filename:dirname(Name), filename:basename(Name)}. create_apps(Dir) -> T1 = "{application, t1,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [kernel, stdlib]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [kernel, stdlib]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't1.app'), list_to_binary(T1)), T2 = "{application, t2,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [t1]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [t1]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't2.app'), list_to_binary(T2)), T3 = "{application, t3,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [t2]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [t2]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't3.app'), list_to_binary(T3)), T4 = "{application, t4,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [t3]},\n" - " {included_applications, []},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [t3]},\n" + " {included_applications, []},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't4.app'), list_to_binary(T4)), T5 = "{application, t5,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [t3]},\n" - " {included_applications, []},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [t3]},\n" + " {included_applications, []},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't5.app'), list_to_binary(T5)), T6 = "{application, t6,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [t4, t5]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [t4, t5]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't6.app'), list_to_binary(T6)). create_app(t7, Dir) -> T7 = "{application, t7,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [t5]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [t5]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't7.app'), list_to_binary(T7)). create_circular_apps(Dir) -> T8 = "{application, t8,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [t9]},\n" - " {included_applications, []},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [t9]},\n" + " {included_applications, []},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't8.app'), list_to_binary(T8)), T9 = "{application, t9,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [t10]},\n" - " {included_applications, []},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [t10]},\n" + " {included_applications, []},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't9.app'), list_to_binary(T9)), T10 = "{application, t10,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [t8, t9]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [t8, t9]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't10.app'), list_to_binary(T10)). create_apps2(Dir) -> T11 = "{application, t11,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [t13]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [t13]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't11.app'), list_to_binary(T11)), T12 = "{application, t12,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [t11]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [t11]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't12.app'), list_to_binary(T12)), T13 = "{application, t13,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, []},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, []},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 't13.app'), list_to_binary(T13)). create_apps_3065(Dir) -> T11 = "{application, chTraffic,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [chAts]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [chAts]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 'chTraffic.app'), list_to_binary(T11)), T12 = "{application, chAts,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, []},\n" - " {included_applications, [aa12]},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, []},\n" + " {included_applications, [aa12]},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 'chAts.app'), list_to_binary(T12)), T13 = "{application, aa12,\n" - " [{vsn, \"1.0\"},\n" - " {description, \"test\"},\n" - " {modules, []},\n" - " {applications, [chAts]},\n" - " {included_applications, []},\n" - " {registered, []}]}.\n", + " [{vsn, \"1.0\"},\n" + " {description, \"test\"},\n" + " {modules, []},\n" + " {applications, [chAts]},\n" + " {included_applications, []},\n" + " {registered, []}]}.\n", file:write_file(fname(Dir, 'aa12.app'), list_to_binary(T13)). fname(N) -> diff --git a/lib/sasl/test/systools_rc_SUITE.erl b/lib/sasl/test/systools_rc_SUITE.erl index 2ab9e269f9..bd4aa9e7a7 100644 --- a/lib/sasl/test/systools_rc_SUITE.erl +++ b/lib/sasl/test/systools_rc_SUITE.erl @@ -18,7 +18,7 @@ %% -module(systools_rc_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("sasl/src/systools.hrl"). -export([all/0,groups/0,init_per_group/2,end_per_group/2, syntax_check/1, translate/1, translate_app/1, @@ -41,7 +41,6 @@ end_per_group(_GroupName, Config) -> Config. -syntax_check(suite) -> []; syntax_check(Config) when is_list(Config) -> PreApps = [#application{name = test, @@ -69,8 +68,8 @@ syntax_check(Config) when is_list(Config) -> {update, baz, 5000, soft, brutal_purge, brutal_purge, []}, {add_module, new_mod}, {remove_application, snmp} - ], - ?line {ok, _} = systools_rc:translate_scripts([S1], Apps, PreApps), + ], + {ok, _} = systools_rc:translate_scripts([S1], Apps, PreApps), S2 = [ {apply, {m, f, [a]}}, {load_object_code, {tst, "1.0", [new_mod]}}, @@ -90,41 +89,40 @@ syntax_check(Config) when is_list(Config) -> {apply, {m,f,[a]}}, restart_new_emulator, restart_emulator - ], - ?line {ok, _} = systools_rc:translate_scripts([S2], Apps, []), + ], + {ok, _} = systools_rc:translate_scripts([S2], Apps, []), S3 = [{apply, {m, f, a}}], - ?line {error, _, _} = systools_rc:translate_scripts([S3], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S3], Apps, []), S3_1 = [{apply, {m, 3, a}}], - ?line {error, _, _} = systools_rc:translate_scripts([S3_1], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S3_1], Apps, []), S4 = [{apply, {m, f}}], - ?line {error, _, _} = systools_rc:translate_scripts([S4], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S4], Apps, []), S5 = [{load_object_code, hej}], - ?line {error, _, _} = systools_rc:translate_scripts([S5], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S5], Apps, []), S6 = [{load_object_code, {342, "1.0", [foo]}}], - ?line {error, _, _} = systools_rc:translate_scripts([S6], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S6], Apps, []), S7 = [{load_object_code, {tets, "1.0", foo}}], - ?line {error, _, _} = systools_rc:translate_scripts([S7], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S7], Apps, []), S8 = [{suspend, [m1]}, point_of_no_return], - ?line {error, _, _} = systools_rc:translate_scripts([S8], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S8], Apps, []), S9 = [{update, ba, {advanced, extra}, brutal_purge, brutal_purge, []}], - ?line {error, _, _} = systools_rc:translate_scripts([S9], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S9], Apps, []), S10 = [{update, bar, {advanced, extra}, brutal_purge, brutal_purge, [baz]}], - ?line {error, _, _} = systools_rc:translate_scripts([S10], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S10], Apps, []), S11 = [{update, bar, {advanced, extra}, brutal_purge, brutal_purge, [ba]}], - ?line {error, _, _} = systools_rc:translate_scripts([S11], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S11], Apps, []), S12 = [{update, bar, advanced, brutal_purge, brutal_purge, []}], - ?line {error, _, _} = systools_rc:translate_scripts([S12], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S12], Apps, []), S13 = [{update, bar, {advanced, extra}, rutal_purge, brutal_purge, [ba]}], - ?line {error, _, _} = systools_rc:translate_scripts([S13], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S13], Apps, []), S14 = [{update, bar, {advanced, extra}, brutal_purge, rutal_purge, [ba]}], - ?line {error, _, _} = systools_rc:translate_scripts([S14], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S14], Apps, []), S15 = [{update, bar, {advanced, extra}, brutal_purge, brutal_purge, ba}], - ?line {error, _, _} = systools_rc:translate_scripts([S15], Apps, []), + {error, _, _} = systools_rc:translate_scripts([S15], Apps, []), S16 = [{code_change, [module]}], - ?line {error, _, _} = systools_rc:translate_scripts([S16], Apps, []), - ?line ok. + {error, _, _} = systools_rc:translate_scripts([S16], Apps, []), + ok. -translate(suite) -> []; translate(Config) when is_list(Config) -> Apps = [#application{name = test, @@ -136,170 +134,170 @@ translate(Config) when is_list(Config) -> mod = {sasl, []}}], %% Simple translation (1) Up1 = [{update, foo, soft, soft_purge, soft_purge, []}], - ?line {ok, X1} = systools_rc:translate_scripts([Up1], Apps, []), - ?line [{load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[foo]}] = X1, + {ok, X1} = systools_rc:translate_scripts([Up1], Apps, []), + [{load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[foo]}] = X1, %% Simple translation (2) Up2 = [{update, foo, {advanced, extra}, soft_purge, soft_purge, []}], - ?line {ok, X2} = systools_rc:translate_scripts([Up2], Apps, []), - ?line [{load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {code_change, up, [{foo, extra}]}, - {resume,[foo]}] = X2, - - ?line {ok, X22} = systools_rc:translate_scripts(dn,[Up2], Apps, []), - ?line [{load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {code_change, down, [{foo, extra}]}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[foo]}] = X22, + {ok, X2} = systools_rc:translate_scripts([Up2], Apps, []), + [{load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {code_change, up, [{foo, extra}]}, + {resume,[foo]}] = X2, + + {ok, X22} = systools_rc:translate_scripts(dn,[Up2], Apps, []), + [{load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {code_change, down, [{foo, extra}]}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[foo]}] = X22, Up2a = [{update, foo, static, default, {advanced,extra}, soft_purge, soft_purge, []}], - ?line {ok, X2a} = systools_rc:translate_scripts([Up2a], Apps, []), - ?line [{load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {code_change, up, [{foo, extra}]}, - {resume,[foo]}] = X2a, - - ?line {ok, X22a} = systools_rc:translate_scripts(dn,[Up2a], Apps, []), - ?line [{load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {code_change, down, [{foo, extra}]}, - {resume,[foo]}] = X22a, + {ok, X2a} = systools_rc:translate_scripts([Up2a], Apps, []), + [{load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {code_change, up, [{foo, extra}]}, + {resume,[foo]}] = X2a, + + {ok, X22a} = systools_rc:translate_scripts(dn,[Up2a], Apps, []), + [{load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {code_change, down, [{foo, extra}]}, + {resume,[foo]}] = X22a, %% Simple dependency (1) Up3 = [{update, foo, soft, soft_purge, soft_purge, [bar]}, {update, bar, soft, soft_purge, soft_purge, []}], - ?line {ok, X31} = systools_rc:translate_scripts([Up3], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X31, - ?line {ok, X32} = systools_rc:translate_scripts(dn,[Up3], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X32, + {ok, X31} = systools_rc:translate_scripts([Up3], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X31, + {ok, X32} = systools_rc:translate_scripts(dn,[Up3], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X32, Up3a = [{update, foo, static, default, soft, soft_purge, soft_purge, [bar]}, {update, bar, static, default, soft, soft_purge, soft_purge, []}], - ?line {ok, X3a1} = systools_rc:translate_scripts([Up3a], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo, bar]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X3a1, - ?line {ok, X3a2} = systools_rc:translate_scripts(dn,[Up3a], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X3a2, + {ok, X3a1} = systools_rc:translate_scripts([Up3a], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo, bar]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X3a1, + {ok, X3a2} = systools_rc:translate_scripts(dn,[Up3a], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X3a2, %% Simple dependency (2) Up4 = [{update, foo, soft, soft_purge, soft_purge, [bar]}, {update, bar, {advanced, []}, soft_purge, soft_purge, []}], - ?line {ok, X4} = systools_rc:translate_scripts(up,[Up4], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {code_change,up,[{bar,[]}]}, - {resume,[bar,foo]}] = X4, - - ?line {ok, X42} = systools_rc:translate_scripts(dn,[Up4], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {code_change,down,[{bar,[]}]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X42, + {ok, X4} = systools_rc:translate_scripts(up,[Up4], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {code_change,up,[{bar,[]}]}, + {resume,[bar,foo]}] = X4, + + {ok, X42} = systools_rc:translate_scripts(dn,[Up4], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {code_change,down,[{bar,[]}]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X42, Up4a = [{update, foo, soft, soft_purge, soft_purge, [bar]}, {update, bar, static, infinity, {advanced, []}, soft_purge, soft_purge, []}], - ?line {ok, X4a} = systools_rc:translate_scripts(up,[Up4a], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,{bar,infinity}]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {code_change,up,[{bar,[]}]}, - {resume,[bar,foo]}] = X4a, - - ?line {ok, X42a} = systools_rc:translate_scripts(dn,[Up4a], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,{bar,infinity}]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {code_change,down,[{bar,[]}]}, - {resume,[bar,foo]}] = X42a, + {ok, X4a} = systools_rc:translate_scripts(up,[Up4a], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,{bar,infinity}]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {code_change,up,[{bar,[]}]}, + {resume,[bar,foo]}] = X4a, + + {ok, X42a} = systools_rc:translate_scripts(dn,[Up4a], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,{bar,infinity}]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {code_change,down,[{bar,[]}]}, + {resume,[bar,foo]}] = X42a, Up4b = [{update, foo, soft, soft_purge, soft_purge, [bar]}, {update, bar, dynamic, infinity, {advanced, []}, soft_purge, soft_purge, []}], - ?line {ok, X4b} = systools_rc:translate_scripts(up,[Up4b], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,{bar,infinity}]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {code_change,up,[{bar,[]}]}, - {resume,[bar,foo]}] = X4b, - - ?line {ok, X42b} = systools_rc:translate_scripts(dn,[Up4b], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,{bar,infinity}]}, - {code_change,down,[{bar,[]}]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X42b, + {ok, X4b} = systools_rc:translate_scripts(up,[Up4b], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,{bar,infinity}]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {code_change,up,[{bar,[]}]}, + {resume,[bar,foo]}] = X4b, + + {ok, X42b} = systools_rc:translate_scripts(dn,[Up4b], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,{bar,infinity}]}, + {code_change,down,[{bar,[]}]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X42b, %% More complex dependency Up5 = [{update, foo, soft, soft_purge, soft_purge, [bar, baz]}, {update, bar, {advanced, []}, soft_purge, soft_purge, []}, {update, baz, {advanced, baz}, soft_purge, soft_purge, [bar]}], - ?line {ok, X5} = systools_rc:translate_scripts([Up5], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,baz,bar]}}, - point_of_no_return, - {suspend,[foo,baz,bar]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {code_change,up,[{baz,baz},{bar,[]}]}, - {resume,[bar,baz,foo]}] = X5, - - ?line {ok, X52} = systools_rc:translate_scripts(dn,[Up5], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,baz,bar]}}, - point_of_no_return, - {suspend,[foo,baz,bar]}, - {code_change,down,[{baz,baz},{bar,[]}]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {resume,[bar,baz,foo]}] = X52, + {ok, X5} = systools_rc:translate_scripts([Up5], Apps, []), + [{load_object_code,{test,"1.0",[foo,baz,bar]}}, + point_of_no_return, + {suspend,[foo,baz,bar]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {code_change,up,[{baz,baz},{bar,[]}]}, + {resume,[bar,baz,foo]}] = X5, + + {ok, X52} = systools_rc:translate_scripts(dn,[Up5], Apps, []), + [{load_object_code,{test,"1.0",[foo,baz,bar]}}, + point_of_no_return, + {suspend,[foo,baz,bar]}, + {code_change,down,[{baz,baz},{bar,[]}]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {resume,[bar,baz,foo]}] = X52, Up5a = [{update, foo, dynamic, infinity, soft, soft_purge, soft_purge, [bar, baz]}, @@ -307,26 +305,26 @@ translate(Config) when is_list(Config) -> soft_purge, []}, {update, baz, dynamic, default, {advanced, baz}, soft_purge, soft_purge, [bar]}], - ?line {ok, X5a} = systools_rc:translate_scripts([Up5a], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,baz,bar]}}, - point_of_no_return, - {suspend,[{foo,infinity},baz,{bar,7000}]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {code_change,up,[{baz,baz}, {bar,[]}]}, - {resume,[bar,baz,foo]}] = X5a, - - ?line {ok, X52a} = systools_rc:translate_scripts(dn,[Up5a], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,baz,bar]}}, - point_of_no_return, - {suspend,[{foo,infinity},baz,{bar,7000}]}, - {code_change,down,[{baz,baz}]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {code_change,down,[{bar,[]}]}, - {resume,[bar,baz,foo]}] = X52a, + {ok, X5a} = systools_rc:translate_scripts([Up5a], Apps, []), + [{load_object_code,{test,"1.0",[foo,baz,bar]}}, + point_of_no_return, + {suspend,[{foo,infinity},baz,{bar,7000}]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {code_change,up,[{baz,baz}, {bar,[]}]}, + {resume,[bar,baz,foo]}] = X5a, + + {ok, X52a} = systools_rc:translate_scripts(dn,[Up5a], Apps, []), + [{load_object_code,{test,"1.0",[foo,baz,bar]}}, + point_of_no_return, + {suspend,[{foo,infinity},baz,{bar,7000}]}, + {code_change,down,[{baz,baz}]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {code_change,down,[{bar,[]}]}, + {resume,[bar,baz,foo]}] = X52a, Up5b = [{update, foo, dynamic, infinity, soft, soft_purge, soft_purge, [bar, baz]}, @@ -334,65 +332,65 @@ translate(Config) when is_list(Config) -> soft_purge, []}, {update, baz, static, default, {advanced, baz}, soft_purge, soft_purge, [bar]}], - ?line {ok, X5b} = systools_rc:translate_scripts([Up5b], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,baz,bar]}}, - point_of_no_return, - {suspend,[{foo,infinity},baz,{bar,7000}]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {code_change,up,[{baz,baz},{bar,[]}]}, - {resume,[bar,baz,foo]}] = X5b, - - ?line {ok, X52b} = systools_rc:translate_scripts(dn,[Up5b], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,baz,bar]}}, - point_of_no_return, - {suspend,[{foo,infinity},baz,{bar,7000}]}, - {code_change,down,[{bar,[]}]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {code_change,down,[{baz,baz}]}, - {resume,[bar,baz,foo]}] = X52b, + {ok, X5b} = systools_rc:translate_scripts([Up5b], Apps, []), + [{load_object_code,{test,"1.0",[foo,baz,bar]}}, + point_of_no_return, + {suspend,[{foo,infinity},baz,{bar,7000}]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {code_change,up,[{baz,baz},{bar,[]}]}, + {resume,[bar,baz,foo]}] = X5b, + + {ok, X52b} = systools_rc:translate_scripts(dn,[Up5b], Apps, []), + [{load_object_code,{test,"1.0",[foo,baz,bar]}}, + point_of_no_return, + {suspend,[{foo,infinity},baz,{bar,7000}]}, + {code_change,down,[{bar,[]}]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {code_change,down,[{baz,baz}]}, + {resume,[bar,baz,foo]}] = X52b, %% Simple circular dependency (1) Up6 = [{update, foo, soft, soft_purge, soft_purge, [bar]}, {update, bar, soft, soft_purge, soft_purge, [foo]}], - ?line {ok, X61} = systools_rc:translate_scripts([Up6], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X61, - ?line {ok, X62} = systools_rc:translate_scripts(dn,[Up6], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {suspend,[foo,bar]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {resume,[bar,foo]}] = X62, + {ok, X61} = systools_rc:translate_scripts([Up6], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X61, + {ok, X62} = systools_rc:translate_scripts(dn,[Up6], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {suspend,[foo,bar]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {resume,[bar,foo]}] = X62, %% Simple circular dependency (2) Up7 = [{update, foo, soft, soft_purge, soft_purge, [bar, baz]}, {update, bar, soft, soft_purge, soft_purge, [foo]}, {update, baz, soft, soft_purge, soft_purge, [bar]}], - ?line {ok, X71} = systools_rc:translate_scripts([Up7], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar,baz]}}, - point_of_no_return, - {suspend,[foo,bar,baz]}, - {load,{baz,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[baz, bar, foo]}] = X71, - ?line {ok, X72} = systools_rc:translate_scripts(dn,[Up7], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar,baz]}}, - point_of_no_return, - {suspend,[foo,bar,baz]}, - {load,{foo,soft_purge,soft_purge}}, - {load,{bar,soft_purge,soft_purge}}, - {load,{baz,soft_purge,soft_purge}}, - {resume,[baz,bar,foo]}] = X72, + {ok, X71} = systools_rc:translate_scripts([Up7], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar,baz]}}, + point_of_no_return, + {suspend,[foo,bar,baz]}, + {load,{baz,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[baz, bar, foo]}] = X71, + {ok, X72} = systools_rc:translate_scripts(dn,[Up7], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar,baz]}}, + point_of_no_return, + {suspend,[foo,bar,baz]}, + {load,{foo,soft_purge,soft_purge}}, + {load,{bar,soft_purge,soft_purge}}, + {load,{baz,soft_purge,soft_purge}}, + {resume,[baz,bar,foo]}] = X72, %% Complex circular dependencies, check only order %% @@ -402,20 +400,20 @@ translate(Config) when is_list(Config) -> {update, z, soft, soft_purge, soft_purge, [x]}, {update, bar, soft, soft_purge, soft_purge, [baz]}, {update, baz, soft, soft_purge, soft_purge, [bar]}], - ?line {ok, X8} = systools_rc:translate_scripts([Up8], Apps, []), - ?line {value, {suspend, Order}} = lists:keysearch(suspend, 1, X8), - ?line Rest = case lists:reverse(Order) of - [bar, baz | R] -> R; - [baz, bar | R] -> R - end, - ?line case Rest of - [y, z, x, foo] -> ok; - [y, x, z, foo] -> ok; - [foo, y, z, x] -> ok; - [foo, y, x, z] -> ok; - [y, foo, z, x] -> ok; - [y, foo, x, z] -> ok - end, + {ok, X8} = systools_rc:translate_scripts([Up8], Apps, []), + {value, {suspend, Order}} = lists:keysearch(suspend, 1, X8), + Rest = case lists:reverse(Order) of + [bar, baz | R] -> R; + [baz, bar | R] -> R + end, + case Rest of + [y, z, x, foo] -> ok; + [y, x, z, foo] -> ok; + [foo, y, z, x] -> ok; + [foo, y, x, z] -> ok; + [y, foo, z, x] -> ok; + [y, foo, x, z] -> ok + end, %% Check that order among other instructions isn't changed Up9 = [{update, foo, soft, soft_purge, soft_purge, [baz]}, @@ -430,13 +428,12 @@ translate(Config) when is_list(Config) -> {apply, {m, f, [5]}}, {update, baz, soft, soft_purge, soft_purge, [bar]}, {apply, {m, f, [6]}}], - ?line {ok, X9} = systools_rc:translate_scripts([Up9], Apps, []), + {ok, X9} = systools_rc:translate_scripts([Up9], Apps, []), Other2 = [X || {apply, {m, f, [X]}} <- X9], - ?line [1,2,3,4,5,6] = lists:sort(Other2), - ?line ok. + [1,2,3,4,5,6] = lists:sort(Other2), + ok. -translate_app(suite) -> []; translate_app(Config) when is_list(Config) -> PreApps = [#application{name = test, @@ -461,33 +458,33 @@ translate_app(Config) when is_list(Config) -> %% Simple translation (1) Up1 = [{add_module, foo}, {add_module, bar}], - ?line {ok, X1} = systools_rc:translate_scripts([Up1], Apps, []), - ?line [{load_object_code,{test,"1.0",[foo,bar]}}, - point_of_no_return, - {load,{foo,brutal_purge,brutal_purge}}, - {load,{bar,brutal_purge,brutal_purge}}] = X1, + {ok, X1} = systools_rc:translate_scripts([Up1], Apps, []), + [{load_object_code,{test,"1.0",[foo,bar]}}, + point_of_no_return, + {load,{foo,brutal_purge,brutal_purge}}, + {load,{bar,brutal_purge,brutal_purge}}] = X1, %% Simple translation (2) Up2 = [{add_application, test}], - ?line {ok, X2} = systools_rc:translate_scripts([Up2], Apps, []), -io:format("X2=~p~n", [X2]), - ?line [{load_object_code,{test,"1.0",[foo,bar,baz]}}, - point_of_no_return, - {load,{foo,brutal_purge,brutal_purge}}, - {load,{bar,brutal_purge,brutal_purge}}, - {load,{baz,brutal_purge,brutal_purge}}, - {apply,{application,start,[test,permanent]}}] = X2, + {ok, X2} = systools_rc:translate_scripts([Up2], Apps, []), + io:format("X2=~p~n", [X2]), + [{load_object_code,{test,"1.0",[foo,bar,baz]}}, + point_of_no_return, + {load,{foo,brutal_purge,brutal_purge}}, + {load,{bar,brutal_purge,brutal_purge}}, + {load,{baz,brutal_purge,brutal_purge}}, + {apply,{application,start,[test,permanent]}}] = X2, %% Simple translation (3) Up3 = [{remove_application, pelle}], - ?line {ok, X3} = systools_rc:translate_scripts([Up3], Apps, PreApps), - ?line [point_of_no_return, - {apply,{application,stop,[pelle]}}, - {remove,{pelle,brutal_purge,brutal_purge}}, - {remove,{kalle,brutal_purge,brutal_purge}}, - {purge,[pelle,kalle]}, - {apply,{application,unload,[pelle]}}] = X3, - ?line ok. + {ok, X3} = systools_rc:translate_scripts([Up3], Apps, PreApps), + [point_of_no_return, + {apply,{application,stop,[pelle]}}, + {remove,{pelle,brutal_purge,brutal_purge}}, + {remove,{kalle,brutal_purge,brutal_purge}}, + {purge,[pelle,kalle]}, + {apply,{application,unload,[pelle]}}] = X3, + ok. translate_emulator_restarts(_Config) -> @@ -506,36 +503,36 @@ translate_emulator_restarts(_Config) -> mod = {sasl, []}}], %% restart_new_emulator Up1 = [{update, foo, soft, soft_purge, soft_purge, []},restart_new_emulator], - ?line {ok, X1} = systools_rc:translate_scripts([Up1], Apps, []), - ?line [restart_new_emulator, - {load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[foo]}] = X1, + {ok, X1} = systools_rc:translate_scripts([Up1], Apps, []), + [restart_new_emulator, + {load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[foo]}] = X1, %% restart_emulator Up2 = [{update, foo, soft, soft_purge, soft_purge, []},restart_emulator], - ?line {ok, X2} = systools_rc:translate_scripts([Up2], Apps, []), - ?line [{load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[foo]}, - restart_emulator] = X2, + {ok, X2} = systools_rc:translate_scripts([Up2], Apps, []), + [{load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[foo]}, + restart_emulator] = X2, %% restart_emulator + restart_new_emulator Up3 = [{update, foo, soft, soft_purge, soft_purge, []}, restart_emulator, restart_new_emulator], - ?line {ok, X3} = systools_rc:translate_scripts([Up3], Apps, []), - ?line [restart_new_emulator, - {load_object_code, {test,"1.0",[foo]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[foo]}, - restart_emulator] = X3, + {ok, X3} = systools_rc:translate_scripts([Up3], Apps, []), + [restart_new_emulator, + {load_object_code, {test,"1.0",[foo]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[foo]}, + restart_emulator] = X3, %% restart_emulator + restart_new_emulator Up4a = [{update, foo, soft, soft_purge, soft_purge, []}, @@ -545,28 +542,28 @@ translate_emulator_restarts(_Config) -> {update, x, soft, soft_purge, soft_purge, []}, restart_emulator, restart_emulator], - ?line {ok, X4} = systools_rc:translate_scripts([Up4a,Up4b], Apps, []), - ?line [restart_new_emulator, - {load_object_code, {test,"1.0",[foo,x]}}, - point_of_no_return, - {suspend,[foo]}, - {load,{foo,soft_purge,soft_purge}}, - {resume,[foo]}, - {suspend,[x]}, - {load,{x,soft_purge,soft_purge}}, - {resume,[x]}, - restart_emulator] = X4, + {ok, X4} = systools_rc:translate_scripts([Up4a,Up4b], Apps, []), + [restart_new_emulator, + {load_object_code, {test,"1.0",[foo,x]}}, + point_of_no_return, + {suspend,[foo]}, + {load,{foo,soft_purge,soft_purge}}, + {resume,[foo]}, + {suspend,[x]}, + {load,{x,soft_purge,soft_purge}}, + {resume,[x]}, + restart_emulator] = X4, %% only restart_new_emulator Up5 = [restart_new_emulator], - ?line {ok, X5} = systools_rc:translate_scripts([Up5], Apps, []), - ?line [restart_new_emulator, - point_of_no_return] = X5, + {ok, X5} = systools_rc:translate_scripts([Up5], Apps, []), + [restart_new_emulator, + point_of_no_return] = X5, %% only restart_emulator Up6 = [restart_emulator], - ?line {ok, X6} = systools_rc:translate_scripts([Up6], Apps, []), - ?line [point_of_no_return, - restart_emulator] = X6, + {ok, X6} = systools_rc:translate_scripts([Up6], Apps, []), + [point_of_no_return, + restart_emulator] = X6, ok. diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index a32e2c14c8..64a0d1a13f 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -34,23 +34,25 @@ <section> - <title>SNMP Development Toolkit 4.21.3</title> - <p>Version 4.21.3 supports code replacement in runtime from/to - version 4.21.2, 4.21.1, 4.21 and 4.20.1. </p> - + <title>SNMP Development Toolkit 4.21.4</title> + <p>Version 4.21.4 supports code replacement in runtime from/to + version 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1, 4.20 and 4.19. </p> + <section> <title>Improvements and new features</title> -<!-- <p>-</p> ---> - + +<!-- <list type="bulleted"> <item> - <p>[compiler] Improved version info printout. </p> + <p>[compiler] Improved version info printout from the + <seealso marker="snmpc(command)#">MIB compiler frontend escript</seealso>. </p> <p>Own Id: OTP-9618</p> </item> </list> +--> + </section> <section> @@ -61,40 +63,31 @@ <list type="bulleted"> <item> - <p>[compiler] Fix the <c>--warnings/--W</c> option parsing in the - <seealso marker="snmpc(command)#option_warnings">snmpc</seealso> - wrapper (e)script. - The short warning option was incorrectly <c>--w</c>, instead - of as documented <c>--W</c>. This has now been corrected. </p> - <p>*** POTENTIAL INCOMPATIBILITY ***</p> - <p>Tuncer Ayaz</p> - <p>Own Id: OTP-9718</p> + <p>[agent] Removed use of old style tuple funs. </p> + <p>Own Id: OTP-9779</p> </item> </list> - </section> <section> <title>Incompatibilities</title> -<!-- - <p>-</p> ---> + <p>-</p> +<!-- <list type="bulleted"> <item> - <p>[compiler] The short warning option has been changed from - <c>--w</c> to <c>--W</c> to comply with the documentation. </p> - <p>Tuncer Ayaz</p> + <p>foo. </p> <p>Own Id: OTP-9718</p> - </item> - + </item> </list> +--> + </section> - </section> <!-- 4.21.3 --> + </section> <!-- 4.21.4 --> <section> diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index d84c9e9272..219ac62a73 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,11 +22,17 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.21.3", + [ + {update, snmpa_local_db, soft, soft_purge, soft_purge, []} + ] + }, {"4.21.2", [ {load_module, snmpa_mpd, soft_purge, soft_purge, []}, {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, @@ -35,6 +41,7 @@ {load_module, snmpa_mpd, soft_purge, soft_purge, []}, {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] @@ -45,6 +52,7 @@ {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_target_mib, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] @@ -65,6 +73,7 @@ [snmp_conf, snmp_config]}, {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, {update, snmp_note_store, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, @@ -89,6 +98,7 @@ [snmp_conf, snmp_config]}, {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, {update, snmp_note_store, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, @@ -134,6 +144,7 @@ {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if, snmpm_mpd, snmpm_config]}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_net_if, soft, soft_purge, soft_purge, [snmp_conf, snmpa_mpd]}, {update, snmpa_agent, soft, soft_purge, soft_purge, @@ -145,11 +156,17 @@ %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.21.3", + [ + {update, snmpa_local_db, soft, soft_purge, soft_purge, []} + ] + }, {"4.21.2", [ {load_module, snmpa_mpd, soft_purge, soft_purge, []}, {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, @@ -158,6 +175,7 @@ {load_module, snmpa_mpd, soft_purge, soft_purge, []}, {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] @@ -168,6 +186,7 @@ {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_target_mib, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] @@ -188,6 +207,7 @@ [snmp_conf, snmp_config]}, {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, {update, snmp_note_store, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, @@ -212,6 +232,7 @@ [snmp_conf, snmp_config]}, {load_module, snmpa_conf, soft_purge, soft_purge, [snmp_config]}, {update, snmp_note_store, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, @@ -257,6 +278,7 @@ {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if, snmpm_mpd, snmpm_config]}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, {update, snmpa_net_if, soft, soft_purge, soft_purge, [snmp_conf, snmpa_mpd]}, {update, snmpa_agent, soft, soft_purge, soft_purge, diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 43f67a744e..ee2e633c69 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.21.3 +SNMP_VSN = 4.21.4 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssl/src/ssl_app.erl b/lib/ssl/src/ssl_app.erl index c9f81726b9..0c475a6d01 100644 --- a/lib/ssl/src/ssl_app.erl +++ b/lib/ssl/src/ssl_app.erl @@ -27,16 +27,9 @@ -export([start/2, stop/1]). -%%-------------------------------------------------------------------- --spec start(normal | {takeover, node()} | {failover, node()}, list()) -> - ignore | {ok, pid()} | {error, term()}. -%%-------------------------------------------------------------------- start(_Type, _StartArgs) -> ssl_sup:start_link(). -%-------------------------------------------------------------------- --spec stop(term())-> ok. -%%-------------------------------------------------------------------- stop(_State) -> ok. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 95a5efd6d0..015265441e 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -166,7 +166,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, false -> %% decryption failed or invalid padding, %% intentionally break Content to make - %% sure a packet with a an invalid padding + %% sure a packet with invalid padding %% but otherwise correct data will fail %% the MAC test later {<<16#F0, Content/binary>>, Mac, CipherState1} @@ -523,7 +523,7 @@ hash_size(sha) -> %% %% implementation note: %% We return the original (possibly invalid) PadLength in any case. -%% A invalid PadLength will be cought by is_correct_padding/2 +%% An invalid PadLength will be caught by is_correct_padding/2 %% generic_block_cipher_from_bin(T, HashSize) -> Sz1 = byte_size(T) - 1, diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index d4807704b2..28dd0c85d0 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -293,10 +293,6 @@ start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> %% gen_fsm callbacks %%==================================================================== %%-------------------------------------------------------------------- --spec init(list()) -> {ok, state_name(), #state{}, timeout()} | {stop, term()}. -%% Possible return values not used now. -%% | {ok, state_name(), #state{}} | -%% ignore %% Description:Whenever a gen_fsm is started using gen_fsm:start/[3,4] or %% gen_fsm:start_link/3,4, this function is called by the new process to %% initialize. @@ -324,8 +320,6 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, end. %%-------------------------------------------------------------------- -%% -spec state_name(event(), #state{}) -> gen_fsm_state_return() -%% %% Description:There should be one instance of this function for each %% possible state name. Whenever a gen_fsm receives an event sent %% using gen_fsm:send_event/2, the instance of this function with the @@ -728,10 +722,6 @@ connection(timeout, State) -> connection(Msg, State) -> handle_unexpected_message(Msg, connection, State). %%-------------------------------------------------------------------- --spec handle_event(term(), state_name(), #state{}) -> term(). -%% As it is not currently used gen_fsm_state_return() makes -%% dialyzer unhappy! -%% %% Description: Whenever a gen_fsm receives an event sent using %% gen_fsm:send_all_state_event/2, this function is called to handle %% the event. Not currently used! @@ -740,12 +730,6 @@ handle_event(_Event, StateName, State) -> {next_state, StateName, State, get_timeout(State)}. %%-------------------------------------------------------------------- --spec handle_sync_event(term(), from(), state_name(), #state{}) -> - gen_fsm_state_return() | - {reply, reply(), state_name(), #state{}} | - {reply, reply(), state_name(), #state{}, timeout()} | - {stop, reason(), reply(), #state{}}. -%% %% Description: Whenever a gen_fsm receives an event sent using %% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle %% the event. @@ -905,11 +889,6 @@ handle_sync_event(peer_certificate, _, StateName, {reply, {ok, Cert}, StateName, State, get_timeout(State)}. %%-------------------------------------------------------------------- --spec handle_info(msg(),state_name(), #state{}) -> - {next_state, state_name(), #state{}}| - {next_state, state_name(), #state{}, timeout()} | - {stop, reason(), #state{}}. -%% %% Description: This function is called by a gen_fsm when it receives any %% other message than a synchronous or asynchronous event %% (or a system message). @@ -972,8 +951,6 @@ handle_info(Msg, StateName, State) -> {next_state, StateName, State, get_timeout(State)}. %%-------------------------------------------------------------------- --spec terminate(reason(), state_name(), #state{}) -> term(). -%% %% Description:This function is called by a gen_fsm when it is about %% to terminate. It should be the opposite of Module:init/1 and do any %% necessary cleaning up. When it returns, the gen_fsm terminates with @@ -1004,8 +981,6 @@ terminate(Reason, _StateName, #state{transport_cb = Transport, Transport:close(Socket). %%-------------------------------------------------------------------- --spec code_change(term(), state_name(), #state{}, list()) -> {ok, state_name(), #state{}}. -%% %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index c1912401d7..9d9afb7707 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -41,7 +41,6 @@ start_link() -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. init([]) -> SessionCertManager = session_and_cert_manager_child_spec(), diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 6a44ef8c3e..6389ff03f5 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -51,7 +51,7 @@ session_lifetime, certificate_db, session_validation_timer, - last_delay_timer %% Keep for testing purposes + last_delay_timer = {undefined, undefined}%% Keep for testing purposes }). -define('24H_in_msec', 8640000). @@ -427,7 +427,7 @@ delay_time() -> ?CLEAN_SESSION_DB end. -invalidate_session(Cache, CacheCb, Key, Session, State) -> +invalidate_session(Cache, CacheCb, Key, Session, #state{last_delay_timer = LastTimer} = State) -> case CacheCb:lookup(Cache, Key) of undefined -> %% Session is already invalidated {noreply, State}; @@ -441,5 +441,10 @@ invalidate_session(Cache, CacheCb, Key, Session, State) -> CacheCb:update(Cache, Key, Session#session{is_resumable = false}), TRef = erlang:send_after(delay_time(), self(), {delayed_clean_session, Key}), - {noreply, State#state{last_delay_timer = TRef}} + {noreply, State#state{last_delay_timer = last_delay_timer(Key, TRef, LastTimer)}} end. + +last_delay_timer({{_,_},_}, TRef, {LastServer, _}) -> + {LastServer, TRef}; +last_delay_timer({_,_}, TRef, {_, LastClient}) -> + {TRef, LastClient}. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index f52d2f961c..830026c825 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -508,8 +508,12 @@ decode_cipher_text(CipherText, ConnnectionStates0) -> %% %% Description: Encodes data to send on the ssl-socket. %%-------------------------------------------------------------------- -encode_data(Frag, Version, ConnectionStates) -> - Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version), +encode_data(Frag, Version, + #connection_states{current_write = #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates). %%-------------------------------------------------------------------- @@ -588,11 +592,11 @@ record_protocol_role(client) -> record_protocol_role(server) -> ?SERVER. -%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast -split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version) when {3, 1} == Version orelse - {3, 0} == Version -> +%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are not vulnerable to this attack. +split_bin(<<FirstByte:8, Rest/binary>>, ChunkSize, Version, BCA) when BCA =/= ?RC4 andalso ({3, 1} == Version orelse + {3, 0} == Version) -> do_split_bin(Rest, ChunkSize, [[FirstByte]]); -split_bin(Bin, ChunkSize, _) -> +split_bin(Bin, ChunkSize, _, _) -> do_split_bin(Bin, ChunkSize, []). do_split_bin(<<>>, _, Acc) -> diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl index 93969f628f..f9bbf905e1 100644 --- a/lib/ssl/src/ssl_session_cache.erl +++ b/lib/ssl/src/ssl_session_cache.erl @@ -28,27 +28,19 @@ -export([init/1, terminate/1, lookup/2, update/3, delete/2, foldl/3, select_session/2]). --type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. - %%-------------------------------------------------------------------- --spec init(list()) -> db_handle(). %% Returns reference to the cache (opaque) -%% %% Description: Return table reference. Called by ssl_manager process. %%-------------------------------------------------------------------- init(_) -> ets:new(cache_name(), [set, protected]). %%-------------------------------------------------------------------- --spec terminate(db_handle()) -> any(). -%% %% Description: Handles cache table at termination of ssl manager. %%-------------------------------------------------------------------- terminate(Cache) -> ets:delete(Cache). %%-------------------------------------------------------------------- --spec lookup(db_handle(), key()) -> #session{} | undefined. -%% %% Description: Looks up a cach entry. Should be callable from any %% process. %%-------------------------------------------------------------------- @@ -61,8 +53,6 @@ lookup(Cache, Key) -> end. %%-------------------------------------------------------------------- --spec update(db_handle(), key(), #session{}) -> any(). -%% %% Description: Caches a new session or updates a already cached one. %% Will only be called from the ssl_manager process. %%-------------------------------------------------------------------- @@ -70,8 +60,6 @@ update(Cache, Key, Session) -> ets:insert(Cache, {Key, Session}). %%-------------------------------------------------------------------- --spec delete(db_handle(), key()) -> any(). -%% %% Description: Delets a cache entry. %% Will only be called from the ssl_manager process. %%-------------------------------------------------------------------- @@ -79,8 +67,6 @@ delete(Cache, Key) -> ets:delete(Cache, Key). %%-------------------------------------------------------------------- --spec foldl(fun(), term(), db_handle()) -> term(). -%% %% Description: Calls Fun(Elem, AccIn) on successive elements of the %% cache, starting with AccIn == Acc0. Fun/2 must return a new %% accumulator which is passed to the next call. The function returns @@ -91,8 +77,6 @@ foldl(Fun, Acc0, Cache) -> ets:foldl(Fun, Acc0, Cache). %%-------------------------------------------------------------------- --spec select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}]. -%% %% Description: Selects a session that could be reused. Should be callable %% from any process. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_session_cache_api.erl b/lib/ssl/src/ssl_session_cache_api.erl index f8416bf327..f2b22b0f1b 100644 --- a/lib/ssl/src/ssl_session_cache_api.erl +++ b/lib/ssl/src/ssl_session_cache_api.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -20,18 +20,15 @@ %% -module(ssl_session_cache_api). +-include("ssl_handshake.hrl"). +-include("ssl_internal.hrl"). --export([behaviour_info/1]). +-type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. -behaviour_info(callbacks) -> - [ - {init, 1}, - {terminate, 1}, - {lookup, 2}, - {update, 3}, - {delete, 2}, - {foldl, 3}, - {select_session, 2} - ]; -behaviour_info(_) -> - undefined. +-callback init(list()) -> db_handle(). +-callback terminate(db_handle()) -> any(). +-callback lookup(db_handle(), key()) -> #session{} | undefined. +-callback update(db_handle(), key(), #session{}) -> any(). +-callback delete(db_handle(), key()) -> any(). +-callback foldl(fun(), term(), db_handle()) -> term(). +-callback select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}]. diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index cb10b1362a..59039a6e0a 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -41,7 +41,6 @@ start_link() -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. init([]) -> %% OLD ssl - moved start to ssl.erl only if old diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 8b01ca3ad4..254aa6d2f9 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2011. 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 @@ -175,7 +175,7 @@ issuer(true, Opts, SubjectKey) -> issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) -> {issuer_der(Issuer), decode_key(IssuerKey)}; issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) -> - {ok, [{cert, Cert, _}|_]} = public_key:pem_to_der(File), + {ok, [{cert, Cert, _}|_]} = pem_to_der(File), {issuer_der(Cert), decode_key(IssuerKey)}. issuer_der(Issuer) -> @@ -185,7 +185,7 @@ issuer_der(Issuer) -> Subject. subject(undefined, IsRootCA) -> - User = if IsRootCA -> "RootCA"; true -> os:getenv("USER") end, + User = if IsRootCA -> "RootCA"; true -> user() end, Opts = [{email, User ++ "@erlang.org"}, {name, User}, {city, "Stockholm"}, @@ -196,6 +196,14 @@ subject(undefined, IsRootCA) -> subject(Opts, _) -> subject(Opts). +user() -> + case os:getenv("USER") of + false -> + "test_user"; + User -> + User + end. + subject(SubjectOpts) when is_list(SubjectOpts) -> Encode = fun(Opt) -> {Type,Value} = subject_enc(Opt), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index fc91bf382f..527263363c 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -259,7 +259,7 @@ all() -> no_reuses_session_server_restart_new_cert_file, reuseaddr, hibernate, connect_twice, renegotiate_dos_mitigate_active, renegotiate_dos_mitigate_passive, - tcp_error_propagation_in_active_mode + tcp_error_propagation_in_active_mode, rizzo, no_rizzo_rc4 ]. groups() -> @@ -3033,8 +3033,8 @@ invalid_signature_server(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, "bad certificate"}, - Client, {error,"bad certificate"}). + tcp_delivery_workaround(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}). %%-------------------------------------------------------------------- @@ -3079,42 +3079,47 @@ invalid_signature_client(Config) when is_list(Config) -> tcp_delivery_workaround(Server, ServerMsg, Client, ClientMsg) -> receive {Server, ServerMsg} -> - receive - {Client, ClientMsg} -> - ok; - {Client, {error,closed}} -> - test_server:format("client got close"), - ok; - Unexpected -> - test_server:fail(Unexpected) - end; + client_msg(Client, ClientMsg); {Client, ClientMsg} -> - receive - {Server, ServerMsg} -> - ok; - Unexpected -> - test_server:fail(Unexpected) - end; + server_msg(Server, ServerMsg); {Client, {error,closed}} -> - receive - {Server, ServerMsg} -> - ok; - Unexpected -> - test_server:fail(Unexpected) - end; + server_msg(Server, ServerMsg); {Server, {error,closed}} -> - receive - {Client, ClientMsg} -> - ok; - {Client, {error,closed}} -> - test_server:format("client got close"), - ok; - Unexpected -> - test_server:fail(Unexpected) - end; + client_msg(Client, ClientMsg); + {Client, {error, esslconnect}} -> + server_msg(Server, ServerMsg); + {Server, {error, esslaccept}} -> + client_msg(Client, ClientMsg) + end. + +client_msg(Client, ClientMsg) -> + receive + {Client, ClientMsg} -> + ok; + {Client, {error,closed}} -> + test_server:format("client got close"), + ok; + {Client, {error, esslconnect}} -> + test_server:format("client got econnaborted"), + ok; Unexpected -> test_server:fail(Unexpected) end. + +server_msg(Server, ServerMsg) -> + receive + {Server, ServerMsg} -> + ok; + {Server, {error,closed}} -> + test_server:format("server got close"), + ok; + {Server, {error, esslaccept}} -> + test_server:format("server got econnaborted"), + ok; + Unexpected -> + test_server:fail(Unexpected) + end. + %%-------------------------------------------------------------------- cert_expired(doc) -> ["Test server with invalid signature"]; @@ -3786,7 +3791,73 @@ tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> Pid ! {tcp_error, Socket, etimedout}, ssl_test_lib:check_result(Client, {ssl_closed, SslSocket}). +%%-------------------------------------------------------------------- + +rizzo(doc) -> ["Test that there is a 1/n-1-split for non RC4 in 'TLS < 1.1' as it is + vunrable to Rizzo/Dungon attack"]; + +rizzo(Config) when is_list(Config) -> + Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], + run_send_recv_rizzo(Ciphers, Config, sslv3, + {?MODULE, send_recv_result_active_rizzo, []}), + run_send_recv_rizzo(Ciphers, Config, tlsv1, + {?MODULE, send_recv_result_active_rizzo, []}). + +no_rizzo_rc4(doc) -> + ["Test that there is no 1/n-1-split for RC4 as it is not vunrable to Rizzo/Dungon attack"]; + +no_rizzo_rc4(Config) when is_list(Config) -> + Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(),Y == rc4_128], + run_send_recv_rizzo(Ciphers, Config, sslv3, + {?MODULE, send_recv_result_active_no_rizzo, []}), + run_send_recv_rizzo(Ciphers, Config, tlsv1, + {?MODULE, send_recv_result_active_no_rizzo, []}). + +run_send_recv_rizzo(Ciphers, Config, Version, Mfa) -> + Result = lists:map(fun(Cipher) -> + rizzo_test(Cipher, Config, Version, Mfa) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + +rizzo_test(Cipher, Config, Version, Mfa) -> + {ClientOpts, ServerOpts} = client_server_opts(Cipher, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, Mfa}, + {options, [{active, true}, {ciphers, [Cipher]}, + {versions, [Version]} + | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, Mfa}, + {options, [{active, true} | ClientOpts]}]), + Result = ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + case Result of + ok -> + []; + Error -> + [{Cipher, Error}] + end. + +client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == rsa orelse KeyAlgo == dhe_rsa -> + {?config(client_opts, Config), + ?config(server_opts, Config)}; +client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == dss orelse KeyAlgo == dhe_dss -> + {?config(client_dsa_opts, Config), + ?config(server_dsa_opts, Config)}. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -3807,6 +3878,23 @@ send_recv_result_active(Socket) -> ok end. +send_recv_result_active_rizzo(Socket) -> + ssl:send(Socket, "Hello world"), + receive + {ssl, Socket, "H"} -> + receive + {ssl, Socket, "ello world"} -> + ok + end + end. + +send_recv_result_active_no_rizzo(Socket) -> + ssl:send(Socket, "Hello world"), + receive + {ssl, Socket, "Hello world"} -> + ok + end. + send_recv_result_active_once(Socket) -> ssl:send(Socket, "Hello world"), receive diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 7f782233ef..491aa893c2 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -225,9 +225,10 @@ session_cleanup(Config)when is_list(Config) -> check_timer(SessionTimer), test_server:sleep(?DELAY *2), %% Delay time + some extra time - DelayTimer = get_delay_timer(), + {ServerDelayTimer, ClientDelayTimer} = get_delay_timers(), - check_timer(DelayTimer), + check_timer(ServerDelayTimer), + check_timer(ClientDelayTimer), test_server:sleep(?SLEEP), %% Make sure clean has had time to run @@ -250,16 +251,22 @@ check_timer(Timer) -> check_timer(Timer) end. -get_delay_timer() -> +get_delay_timers() -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), case element(7, State) of - undefined -> + {undefined, undefined} -> + test_server:sleep(?SLEEP), + get_delay_timers(); + {undefined, _} -> + test_server:sleep(?SLEEP), + get_delay_timers(); + {_, undefined} -> test_server:sleep(?SLEEP), - get_delay_timer(); - DelayTimer -> - DelayTimer + get_delay_timers(); + DelayTimers -> + DelayTimers end. %%-------------------------------------------------------------------- session_cache_process_list(doc) -> diff --git a/lib/stdlib/doc/src/io_protocol.xml b/lib/stdlib/doc/src/io_protocol.xml index 3e8ab1affc..0ff3d5c1ee 100644 --- a/lib/stdlib/doc/src/io_protocol.xml +++ b/lib/stdlib/doc/src/io_protocol.xml @@ -50,10 +50,10 @@ current I/O-protocol.</p> and execution time efficiency has triggered extensions to the protocol over the years, making the protocol larger and somewhat less easy to implement than the original. It can certainly be argumented that the -current protocol is to complex, but this text describes how it looks +current protocol is too complex, but this text describes how it looks today, not how it should have looked.</p> -<p>The basic ideas from the original protocol still holds. The io_server +<p>The basic ideas from the original protocol still hold. The io_server and client communicate with one single, rather simplistic protocol and no server state is ever present in the client. Any io_server can be used together with any client code and client code need not be aware @@ -62,7 +62,7 @@ of the actual device the io_server communicates with.</p> <section> <title>Protocol basics</title> -<p>As described in Roberts paper, servers and clients communicate using +<p>As described in Robert's paper, servers and clients communicate using io_request/io_reply tuples as follows:</p> <p><em>{io_request, From, ReplyAs, Request}</em><br/> @@ -103,7 +103,7 @@ Reply part.</p> <em>{put_chars, Encoding, Module, Function, Args}</em> </p> <list type="bulleted"> -<item>Encoding is either 'latin1' or 'unicode', meaning that the +<item>Encoding is either 'unicode' or 'latin1', meaning that the characters are (in case of binaries) encoded as either UTF-8 or iso-latin-1 (pure bytes). A well behaved io_server should also return error if list elements contain integers > 255 when the @@ -116,13 +116,13 @@ Reply part.</p> produces. Note that byte-oriented data is simplest sent using latin1 Encoding</item> -<item>Characters are the data to be put on the device. If encoding is - latin1, this is an iolist(). If encoding is unicode, this is an +<item>Characters are the data to be put on the device. If Encoding is + latin1, this is an iolist(). If Encoding is unicode, this is an Erlang standard mixed unicode list (one integer in a list per character, characters in binaries represented as UTF-8).</item> <item>Module, Function, Args denotes a function which will be called to - produce the data (like io_lib:format), Args is a list of arguments + produce the data (like io_lib:format). Args is a list of arguments to the function. The function should produce data in the given Encoding. The io_server should call the function as apply(Mod, Func, Args) and will put the returned data on the device as if it was sent @@ -164,7 +164,7 @@ latin1, Module, Function, Args} respectively. </p> <list type="bulleted"> <item>Encoding denotes how data is to be sent back to the client and what data is sent to the function denoted by - Module/Function/Arity. If the function supplied returns data as a + Module/Function/ExtraArgs. If the function supplied returns data as a list, the data is converted to this encoding. If however the function supplied returns data in some other format, no conversion can be done and it's up to the client supplied function to return @@ -179,7 +179,7 @@ latin1, Module, Function, Args} respectively. </p> <item>Prompt is a list of characters (not mixed, no binaries) or an atom() to be output as a prompt for input on the device. The Prompt is often ignored by the io_server and a Prompt set to '' should always - be ignored (and result in nothing being written to the device). </item> + be ignored (and result in nothing being written to the device).</item> <item><p>Module, Function, ExtraArgs denotes a function and arguments to determine when enough data is written. The function should take two @@ -550,7 +550,7 @@ request({get_line, Encoding, _Prompt}, State) -> </code> <p>Here we have cheated a little by more or less only implementing -get_until and using internal helpers to implement get__chars and +get_until and using internal helpers to implement get_chars and get_line. In production code, this might be to inefficient, but that of course depends on the frequency of the different requests. Before we start actually implementing the functions put_chars/2 and @@ -618,7 +618,7 @@ encounter an error or the list is exhausted. The last return value is sent back to the client (it's first returned to the main loop and then sent back by the function io_reply).</p> -<p>The getopt and setopt requests is also simple to handle, we just +<p>The getopt and setopt requests are also simple to handle, we just change or read our state record:</p> <code> diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 65ccdcb7a8..5bc34e35af 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -766,9 +766,9 @@ run_in_short_tempdir(Config, Fun) -> %% We need a base directory with a much shorter pathname than %% priv_dir. We KNOW that priv_dir is located four levels below %% the directory that common_test puts the ct_run.* directories - %% in. That fact is not documented, but an usually reliable source + %% in. That fact is not documented, but a usually reliable source %% assured me that the directory structure is unlikely to change - %% in future versions of common_test because of backward + %% in future versions of common_test because of backwards %% compatibility (tools developed by users of common_test depend %% on the current directory layout). Base = lists:foldl(fun(_, D) -> diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml index 78bb922cc5..5bfa42c36f 100644 --- a/lib/test_server/doc/src/test_server.xml +++ b/lib/test_server/doc/src/test_server.xml @@ -203,7 +203,7 @@ <func> <name>format(Format) -> ok</name> <name>format(Format, Args)</name> - <name>format(Pri,Format)</name> + <name>format(Pri, Format)</name> <name>format(Pri, Format, Args)</name> <fsummary></fsummary> <type> diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 642bb14c88..70422adccd 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -3625,12 +3625,15 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, host -> ok end, - test_server_sup:framework_call(report, [tc_start,{?pl2a(Mod),Func}]), print(major, "=case ~p:~p", [Mod, Func]), MinorName = start_minor_log_file(Mod, Func), print(minor, "<a name=\"top\"></a>", [], internal_raw), MinorBase = filename:basename(MinorName), print(major, "=logfile ~s", [filename:basename(MinorName)]), + + Args1 = [[{tc_logfile,MinorName} | proplists:delete(tc_logfile,hd(Args))]], + test_server_sup:framework_call(report, [tc_start,{{?pl2a(Mod),Func},MinorName}]), + print_props((RunInit==skip_init), get_props(Mode)), print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), @@ -3644,7 +3647,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, do_if_parallel(Main, ok, fun erlang:yield/0), %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = - run_test_case_apply(Num, Mod, Func, Args, get_name(Mode), + run_test_case_apply(Num, Mod, Func, Args1, get_name(Mode), RunInit, Where, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src index d5af919eec..332b855df6 100644 --- a/lib/test_server/test/test_server_SUITE_data/Makefile.src +++ b/lib/test_server/test/test_server_SUITE_data/Makefile.src @@ -1,2 +1,7 @@ all: - erlc *.erl
\ No newline at end of file + erlc test_server_SUITE.erl + erlc test_server_parallel01_SUITE.erl + erlc test_server_conf01_SUITE.erl + erlc test_server_shuffle01_SUITE.erl + erlc test_server_conf02_SUITE.erl + erlc test_server_skip_SUITE.erl
\ No newline at end of file diff --git a/lib/tools/emacs/erlang-flymake.el b/lib/tools/emacs/erlang-flymake.el index bc368e9454..2e447b55de 100644 --- a/lib/tools/emacs/erlang-flymake.el +++ b/lib/tools/emacs/erlang-flymake.el @@ -60,7 +60,8 @@ check on newline and when there are no changes)." (list (concat (erlang-flymake-get-app-dir) "ebin"))) (defun erlang-flymake-get-include-dirs () - (list (concat (erlang-flymake-get-app-dir) "include"))) + (list (concat (erlang-flymake-get-app-dir) "include") + (concat (erlang-flymake-get-app-dir) "deps"))) (defun erlang-flymake-get-app-dir () (let ((src-path (file-name-directory (buffer-file-name)))) diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 881a3c2997..576d7e261c 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -130,13 +130,20 @@ compile(Config) when is_list(Config) -> ?line {ok,_} = compile:file(x), ?line {ok,_} = compile:file("d/y",[debug_info,{outdir,"d"},report]), ?line Key = "A Krypto Key", - ?line {ok,_} = compile:file(crypt, [debug_info,{debug_info_key,Key},report]), + CryptoWorks = crypto_works(), + case CryptoWorks of + false -> + {ok,_} = compile:file(crypt, [debug_info,report]), + {ok,crypt} = cover:compile_beam("crypt.beam"); + true -> + {ok,_} = compile:file(crypt, [{debug_info_key,Key},report]), + {error,{encrypted_abstract_code,_}} = + cover:compile_beam("crypt.beam"), + ok = beam_lib:crypto_key_fun(simple_crypto_fun(Key)), + {ok,crypt} = cover:compile_beam("crypt.beam") + end, ?line {ok,v} = cover:compile_beam(v), ?line {ok,w} = cover:compile_beam("w.beam"), - ?line {error,{encrypted_abstract_code,_}} = - cover:compile_beam("crypt.beam"), - ?line ok = beam_lib:crypto_key_fun(simple_crypto_fun(Key)), - ?line {ok,crypt} = cover:compile_beam("crypt.beam"), ?line {error,{no_abstract_code,"./x.beam"}} = cover:compile_beam(x), ?line {error,{already_cover_compiled,no_beam_found,a}}=cover:compile_beam(a), ?line {error,non_existing} = cover:compile_beam(z), @@ -148,6 +155,15 @@ compile(Config) when is_list(Config) -> ?line Files = lsfiles(), ?line remove(files(Files, ".beam")). +crypto_works() -> + try crypto:start() of + {error,{already_started,crypto}} -> true; + ok -> true + catch + error:_ -> + false + end. + simple_crypto_fun(Key) -> fun(init) -> ok; ({debug_info, des3_cbc, crypt, _}) -> Key diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index ecdbc5ce57..3283fa571f 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -183,8 +183,14 @@ eed(Config) when is_list(Config) -> ?line ok = eprof:log("eprof_SUITE_logfile"), ?line stopped = eprof:stop(), ?line ?t:timetrap_cancel(TTrap), - S = lists:flatten(io_lib:format("~p times slower", [10*(T3-T2)/(T2-T1)])), - {comment,S}. + try + S = lists:flatten(io_lib:format("~p times slower", + [10*(T3-T2)/(T2-T1)])), + {comment,S} + catch + error:badarith -> + {comment,"No time elapsed. Bad clock? Fast computer?"} + end. ensure_eprof_stopped() -> Pid = whereis(eprof), diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index f2afa60e33..1bee6021ab 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -34,7 +34,7 @@ ]). %% Default timetrap timeout (set in init_per_testcase) --define(default_timeout, ?t:minutes(2)). +-define(default_timeout, ?t:minutes(4)). init_per_suite(Config) when is_list(Config) -> Config. @@ -49,6 +49,7 @@ init_per_testcase(_Case, Config) -> end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), + catch lcnt:stop(), ok. suite() -> [{ct_hooks,[ts_install_cth]}]. diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index fd39b55dd4..6392f5765f 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -682,10 +682,10 @@ analyze_result(show_succ, Args, Analysis) -> analyze_result(no_spec, Args, Analysis) -> {Args, Analysis#analysis{no_spec = true}}; analyze_result({pa, Dir}, Args, Analysis) -> - code:add_patha(Dir), + true = code:add_patha(Dir), {Args, Analysis}; analyze_result({pz, Dir}, Args, Analysis) -> - code:add_pathz(Dir), + true = code:add_pathz(Dir), {Args, Analysis}. %%-------------------------------------------------------------------- diff --git a/lib/wx/api_gen/wx_extra/wxEvtHandler.erl b/lib/wx/api_gen/wx_extra/wxEvtHandler.erl index c6810eb32c..080ebfa49f 100644 --- a/lib/wx/api_gen/wx_extra/wxEvtHandler.erl +++ b/lib/wx/api_gen/wx_extra/wxEvtHandler.erl @@ -76,7 +76,7 @@ parse_opts([{callback,Fun}|R], Opts) when is_function(Fun) -> %% Check Fun Arity? parse_opts(R, Opts#evh{cb=Fun}); parse_opts([callback|R], Opts) -> - parse_opts(R, Opts#evh{cb=1}); + parse_opts(R, Opts#evh{cb=self()}); parse_opts([{userData, UserData}|R],Opts) -> parse_opts(R, Opts#evh{userdata=UserData}); parse_opts([{skip, Skip}|R],Opts) when is_boolean(Skip) -> diff --git a/lib/wx/src/gen/wxEvtHandler.erl b/lib/wx/src/gen/wxEvtHandler.erl index f155351b66..820c2b7a58 100644 --- a/lib/wx/src/gen/wxEvtHandler.erl +++ b/lib/wx/src/gen/wxEvtHandler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -95,7 +95,7 @@ parse_opts([{callback,Fun}|R], Opts) when is_function(Fun) -> %% Check Fun Arity? parse_opts(R, Opts#evh{cb=Fun}); parse_opts([callback|R], Opts) -> - parse_opts(R, Opts#evh{cb=1}); + parse_opts(R, Opts#evh{cb=self()}); parse_opts([{userData, UserData}|R],Opts) -> parse_opts(R, Opts#evh{userdata=UserData}); parse_opts([{skip, Skip}|R],Opts) when is_boolean(Skip) -> diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 82c4cfbad5..bc85cd93d4 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -226,9 +226,11 @@ call(Name, Request, Timeout) when is_atom(Name) orelse is_pid(Name) -> %% Invokes handle_cast(Request, State) in the server cast(#wx_ref{state=Pid}, Request) when is_pid(Pid) -> - Pid ! {'$gen_cast',Request}; + Pid ! {'$gen_cast',Request}, + ok; cast(Name, Request) when is_atom(Name) orelse is_pid(Name) -> - Name ! {'$gen_cast',Request}. + Name ! {'$gen_cast',Request}, + ok. %% @spec (Ref::wxObject()) -> pid() %% @doc Get the pid of the object handle. @@ -258,9 +260,10 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name, Mod, Args, [WxEnv|Options]) -> case WxEnv of - undefined -> ok; + undefined -> ok; _ -> wx:set_env(WxEnv) end, + put('_wx_object_', {Mod,'_wx_init_'}), Debug = debug_options(Name, Options), case catch Mod:init(Args) of {#wx_ref{} = Ref, State} -> @@ -350,57 +353,16 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod) -> {noreply, NState, Time1} -> loop(Parent, Name, NState, Mod, Time1, []); {stop, Reason, Reply, NState} -> - {'EXIT', R} = + {'EXIT', R} = (catch terminate(Reason, Name, Msg, Mod, NState, [])), reply(From, Reply), exit(R); Other -> handle_common_reply(Other, Name, Msg, Mod, State, []) end; - -handle_msg(Msg = {_,_,'_wx_invoke_cb_'}, Parent, Name, State, Mod) -> - Reply = dispatch_cb(Msg, Mod, State), - handle_no_reply(Reply, Parent, Name, Msg, Mod, State, []); handle_msg(Msg, Parent, Name, State, Mod) -> Reply = (catch dispatch(Msg, Mod, State)), handle_no_reply(Reply, Parent, Name, Msg, Mod, State, []). -%% @hidden -dispatch_cb({{Msg=#wx{}, Obj=#wx_ref{}}, _, '_wx_invoke_cb_'}, Mod, State) -> - Callback = fun() -> - wxe_util:cast(?WXE_CB_START, <<>>), - case Mod:handle_sync_event(Msg, Obj, State) of - ok -> <<>>; - noreply -> <<>>; - Other -> - Args = [Msg, Obj, State], - MFA = {Mod, handle_sync_event, Args}, - exit({bad_return, Other, MFA}) - end - end, - wxe_server:invoke_callback(Callback), - {noreply, State}; -dispatch_cb({Func, ArgList, '_wx_invoke_cb_'}, Mod, State) -> - try %% This don't work yet.... - [#wx_ref{type=ThisClass}] = ArgList, - case Mod:handle_overloaded(Func, ArgList, State) of - {reply, CBReply, NState} -> - ThisClass:send_return_value(Func, CBReply), - {noreply, NState}; - {reply, CBReply, NState, Time1} -> - ThisClass:send_return_value(Func, CBReply), - {noreply, NState, Time1}; - {noreply, NState} -> - ThisClass:send_return_value(Func, <<>>), - {noreply, NState}; - {noreply, NState, Time1} -> - ThisClass:send_return_value(Func, <<>>), - {noreply, NState, Time1}; - Other -> Other - end - catch _Err:Reason -> - %% Hopefully we can release the wx-thread with this - wxe_util:cast(?WXE_CB_RETURN, <<>>), - {'EXIT', {Reason, erlang:get_stacktrace()}} - end. + %% @hidden handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> case catch Mod:handle_call(Msg, From, State) of @@ -426,9 +388,6 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Other -> handle_common_reply(Other, Name, Msg, Mod, State, Debug) end; -handle_msg(Msg = {_,_,'_wx_invoke_cb_'}, Parent, Name, State, Mod, Debug) -> - Reply = dispatch_cb(Msg, Mod, State), - handle_no_reply(Reply, Parent, Name, Msg, Mod, State, Debug); handle_msg(Msg, Parent, Name, State, Mod, Debug) -> Reply = (catch dispatch(Msg, Mod, State)), handle_no_reply(Reply, Parent, Name, Msg, Mod, State, Debug). diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl index 69e2189fac..6e982c97f6 100644 --- a/lib/wx/src/wxe_server.erl +++ b/lib/wx/src/wxe_server.erl @@ -221,7 +221,7 @@ handle_connect(Object, EvData, From, State0 = #state{users=Users}) -> Evs = [#event{object=Object,callback=Callback, cb_handler=CBHandler}|Evs0], User = User0#user{events=Evs, evt_handler=Handler}, State1 = State0#state{users=gb_trees:update(From, User, Users)}, - if is_function(Callback) -> + if is_function(Callback) orelse is_pid(Callback) -> {FunId, State} = attach_fun(Callback,State1), Res = wxEvtHandler:connect_impl(CBHandler,Object, wxEvtHandler:replace_fun_with_id(EvData,FunId)), @@ -229,6 +229,7 @@ handle_connect(Object, EvData, From, State0 = #state{users=Users}) -> ok -> {reply,Res,State}; _Error -> {reply,Res,State0} end; + true -> Res = {call_impl, connect_cb, CBHandler}, {reply, Res, State1} @@ -239,6 +240,8 @@ invoke_cb({{Ev=#wx{}, Ref=#wx_ref{}}, FunId,_}, _S) -> case get(FunId) of Fun when is_function(Fun) -> invoke_callback(fun() -> Fun(Ev, Ref), <<>> end); + Pid when is_pid(Pid) -> %% wx_object sync event + invoke_callback(Pid, Ev, Ref); Err -> ?log("Internal Error ~p~n",[Err]) end; @@ -270,6 +273,44 @@ invoke_callback(Fun) -> spawn(CB), ok. +invoke_callback(Pid, Ev, Ref) -> + Env = get(?WXE_IDENTIFIER), + CB = fun() -> + wx:set_env(Env), + wxe_util:cast(?WXE_CB_START, <<>>), + try + case get_wx_object_state(Pid) of + ignore -> + %% Ignore early events + wxEvent:skip(Ref); + {Mod, State} -> + case Mod:handle_sync_event(Ev, Ref, State) of + ok -> ok; + noreply -> ok; + Return -> exit({bad_return, Return}) + end + end + catch _:Reason -> + wxEvent:skip(Ref), + ?log("Callback fun crashed with {'EXIT, ~p, ~p}~n", + [Reason, erlang:get_stacktrace()]) + end, + wxe_util:cast(?WXE_CB_RETURN, <<>>) + end, + spawn(CB), + ok. + +get_wx_object_state(Pid) -> + case process_info(Pid, dictionary) of + {dictionary, Dict} -> + case lists:keysearch('_wx_object_',1,Dict) of + {value, {'_wx_object_', {_Mod, '_wx_init_'}}} -> ignore; + {value, {'_wx_object_', Value}} -> Value; + _ -> ignore + end; + _ -> ignore + end. + new_evt_listener(State) -> #wx_env{port=Port} = wx:get_env(), _ = erlang:port_control(Port,98,<<>>), diff --git a/lib/wx/test/Makefile b/lib/wx/test/Makefile index cf51d7918f..333711789f 100644 --- a/lib/wx/test/Makefile +++ b/lib/wx/test/Makefile @@ -27,7 +27,7 @@ PWD = $(shell pwd) APPDIR = $(shell dirname $(PWD)) ERL_COMPILE_FLAGS = -pa $(APPDIR)/ebin -Mods = wxt wx_test_lib \ +Mods = wxt wx_test_lib wx_obj_test \ wx_app_SUITE \ wx_basic_SUITE \ wx_event_SUITE \ diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index 9ad34248a9..46c72bb453 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -48,7 +48,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [create_window, several_apps, wx_api, wx_misc, - data_types]. + data_types, wx_object]. groups() -> []. @@ -298,3 +298,77 @@ data_types(_Config) -> wxClientDC:destroy(CDC), %%wx_test_lib:wx_destroy(Frame,Config). wx:destroy(). + +wx_object(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); +wx_object(Config) -> + wx:new(), + Frame = ?mt(wxFrame, wx_obj_test:start([])), + timer:sleep(500), + ?m(ok, check_events(flush())), + + Me = self(), + ?m({call, foobar, {Me, _}}, wx_object:call(Frame, foobar)), + ?m(ok, wx_object:cast(Frame, foobar2)), + ?m([{cast, foobar2}], flush()), + FramePid = wx_object:get_pid(Frame), + io:format("wx_object pid ~p~n",[FramePid]), + FramePid ! foo3, + ?m([{info, foo3}], flush()), + + ?m(ok, wx_object:cast(Frame, fun(_) -> hehe end)), + ?m([{cast, hehe}], flush()), + wxWindow:refresh(Frame), + ?m([{sync_event, #wx{event=#wxPaint{}}, _}], flush()), + ?m(ok, wx_object:cast(Frame, fun(_) -> timer:sleep(200), slept end)), + %% The sleep above should not hinder the Paint event below + %% Which it did in my buggy handling of the sync_callback + wxWindow:refresh(Frame), + ?m([{sync_event, #wx{event=#wxPaint{}}, _}], flush()), + ?m([{cast, slept}], flush()), + + Monitor = erlang:monitor(process, FramePid), + case proplists:get_value(user, Config, false) of + false -> + timer:sleep(100), + wxFrame:destroy(Frame); + true -> + timer:sleep(500), + ?m(ok, wxFrame:destroy(Frame)); + _ -> + ?m(ok, wxEvtHandler:connect(Frame, close_window, [{skip,true}])), + wx_test_lib:wait_for_close() + end, + ?m(ok, receive + {'DOWN', Monitor, _, _, _} -> + ?m([{terminate, wx_deleted}], flush()), + ok + after 1000 -> + Msgs = flush(), + io:format("Error ~p Alive ~p~n",[Msgs, is_process_alive(FramePid)]) + end), + catch wx:destroy(), + ok. + +check_events(Msgs) -> + check_events(Msgs, 0,0). + +check_events([{event, #wx{event=#wxSize{}}}|Rest], Async, Sync) -> + check_events(Rest, Async+1, Sync); +check_events([{sync_event, #wx{event=#wxPaint{}}, Obj}|Rest], Async, Sync) -> + ?mt(wxPaintEvent, Obj), + check_events(Rest, Async, Sync+1); +check_events([], Async, Sync) -> + case Async > 0 of %% Test sync explictly + true -> ok; + false -> {Async, Sync} + end. + +flush() -> + flush([], 500). + +flush(Acc, Wait) -> + receive + Msg -> flush([Msg|Acc], Wait div 10) + after Wait -> + lists:reverse(Acc) + end. diff --git a/lib/wx/test/wx_obj_test.erl b/lib/wx/test/wx_obj_test.erl new file mode 100644 index 0000000000..b4d7640c7e --- /dev/null +++ b/lib/wx/test/wx_obj_test.erl @@ -0,0 +1,86 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +-module(wx_obj_test). +-include_lib("wx/include/wx.hrl"). + +-export([start/1]). + +%% wx_object callbacks +-export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, + handle_sync_event/3, handle_event/2, handle_cast/2]). + +-record(state, {frame, panel, opts}). + +start(Opts) -> + wx_object:start_link(?MODULE, [{parent, self()}, Opts], []). + +init(Opts) -> + put(parent_pid, proplists:get_value(parent, Opts)), + Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Test wx_object", [{size, {500, 400}}]), + Sz = wxBoxSizer:new(?wxHORIZONTAL), + Panel = wxPanel:new(Frame), + wxSizer:add(Sz, Panel, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxPanel:connect(Panel, size, [{skip, true}]), + wxPanel:connect(Panel, paint, [callback, {userData, proplists:get_value(parent, Opts)}]), + wxWindow:show(Frame), + {Frame, #state{frame=Frame, panel=Panel, opts=Opts}}. + +handle_sync_event(Event = #wx{obj=Panel}, WxEvent, #state{opts=Opts}) -> + DC=wxPaintDC:new(Panel), %% We must create & destroy paintDC, or call wxEvent:skip(WxEvent)) + wxPaintDC:destroy(DC), %% in sync_event. Otherwise wx on windows keeps sending the events. + Pid = proplists:get_value(parent, Opts), + true = is_pid(Pid), + Pid ! {sync_event, Event, WxEvent}, + ok. + +handle_event(Event, State = #state{opts=Opts}) -> + Pid = proplists:get_value(parent, Opts), + Pid ! {event, Event}, + {noreply, State}. + +handle_call(What, From, State) when is_function(What) -> + Result = What(State), + {reply, {call, Result, From}, State}; +handle_call(What, From, State) -> + {reply, {call, What, From}, State}. + +handle_cast(What, State = #state{opts=Opts}) when is_function(What) -> + Result = What(State), + Pid = proplists:get_value(parent, Opts), + Pid ! {cast, Result}, + {noreply, State}; + +handle_cast(What, State = #state{opts=Opts}) -> + Pid = proplists:get_value(parent, Opts), + Pid ! {cast, What}, + {noreply, State}. + +handle_info(What, State = #state{opts=Opts}) -> + Pid = proplists:get_value(parent, Opts), + Pid ! {info, What}, + {noreply, State}. + +terminate(What, #state{opts=Opts}) -> + Pid = proplists:get_value(parent, Opts), + Pid ! {terminate, What}, + ok. + +code_change(Ver1, Ver2, State = #state{opts=Opts}) -> + Pid = proplists:get_value(parent, Opts), + Pid ! {code_change, Ver1, Ver2}, + State. diff --git a/lib/wx/test/wx_test_lib.hrl b/lib/wx/test/wx_test_lib.hrl index 34e1e9c6b8..820e8f0050 100644 --- a/lib/wx/test/wx_test_lib.hrl +++ b/lib/wx/test/wx_test_lib.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -40,7 +40,6 @@ -define(m(ExpectedRes, Expr), fun() -> - {TeStFILe, TeSTLiNe} = {?FILE, ?LINE}, AcTuAlReS = (catch (Expr)), case AcTuAlReS of ExpectedRes -> @@ -48,8 +47,8 @@ AcTuAlReS; _ -> wx_test_lib:error("Not Matching Actual result was:~n ~p ~n Expected ~s~n", - [AcTuAlReS, ??ExpectedRes], - TeStFILe,TeSTLiNe), + [AcTuAlReS, ??ExpectedRes], + ?FILE,?LINE), AcTuAlReS end end()). diff --git a/lib/xmerl/include/xmerl_xsd.hrl b/lib/xmerl/include/xmerl_xsd.hrl index 6dad7d8ff0..644cc2e433 100644 --- a/lib/xmerl/include/xmerl_xsd.hrl +++ b/lib/xmerl/include/xmerl_xsd.hrl @@ -184,7 +184,7 @@ %% allowed for a schema. %% chain, represents a series of ordered objects, some of whom may be %% optional. -%% alterantive, a collection of objects of which only one is choosen. +%% alterantive, a collection of objects of which only one is chosen. -record(chain,{ content, occurance={1,1} diff --git a/system/doc/design_principles/release_handling.xml b/system/doc/design_principles/release_handling.xml index 8ed36f3c56..4378b6599c 100644 --- a/system/doc/design_principles/release_handling.xml +++ b/system/doc/design_principles/release_handling.xml @@ -178,13 +178,13 @@ <marker id="instr"></marker> <title>Release Handling Instructions</title> <p>OTP supports a set of <em>release handling instructions</em> - that is used when creating <c>.appup</c> files. The release + that are used when creating <c>.appup</c> files. The release handler understands a subset of these, the <em>low-level</em> instructions. To make it easier for the user, there are also a number of <em>high-level</em> instructions, which are translated to low-level instructions by <c>systools:make_relup</c>.</p> <p>Here, some of the most frequently used instructions are - described. The complete list of instructions is found in + described. The complete list of instructions can be found in <c>appup(4)</c>.</p> <p>First, some definitions:</p> <taglist> @@ -239,9 +239,10 @@ <p><c>update</c> with argument <c>supervisor</c> is used when changing the start specification of a supervisor. See <seealso marker="appup_cookbook#sup">Appup Cookbook</seealso>.</p> - <p>The release handler finds the processes <em>using</em> a module - to update by traversing the supervision tree of each running - application and checking all the child specifications:</p> + <p>When a module is to be updated, the release handler finds + which processes that are <em>using</em> the module by + traversing the supervision tree of each running application + and checking all the child specifications:</p> <code type="none"> {Id, StartFunc, Restart, Shutdown, Type, Modules}</code> <p>A process is using a module if the name is listed in @@ -265,8 +266,8 @@ <p>The instruction loads the module and is absolutely necessary when running Erlang in embedded mode. It is not strictly required when running Erlang in interactive (default) mode, - since the code server automatically searches for and loads - unloaded modules.</p> + since the code server then automatically searches for and + loads unloaded modules.</p> <p>The opposite of <c>add_module</c> is <c>delete_module</c> which unloads a module:</p> <code type="none"> @@ -294,7 +295,7 @@ the modules are unloaded using a number of <c>delete_module</c> instructions and then the application specification is unloaded from the application controller.</p> - <p>Instruction for removing an application:</p> + <p>Instruction for restarting an application:</p> <code type="none"> {restart_application, Application}</code> <p>Restarting an application means that the application is stopped @@ -331,17 +332,17 @@ of the emulator and the core applications. Then it shuts down the current emulator by calling <c>init:reboot()</c>, see <c>init(3)</c>. All processes are terminated gracefully and - the system can then be rebooted by the heart program, using - the temporary boot file. After the reboot, the rest of the - relup instructions are executed. This is done as a part of the - boot script.</p> + the system is rebooted by the heart program, using the + temporary boot file. After the reboot, the rest of the relup + instructions are executed. This is done as a part of the + temporary boot script.</p> <p>An info report is written when the upgrade is completed. To programatically find out if the upgrade is complete, - call <c>release_handler:which_releases/0</c> and check if the - expected release has status <c>current</c>.</p> - <p>The new version must be made permanent when the new emulator - is up and running. Otherwise, the old version will be used in - case of a new system reboot.</p> + call <c>release_handler:which_releases(current)</c> and check + if it returns the expected (i.e. the new) release.</p> + <p>The new release version must be made permanent when the new + emulator is up and running. Otherwise, the old version will be + used in case of a new system reboot.</p> <p>On UNIX, the release handler tells the heart program which command to use to reboot the system. Note that the environment variable <c>HEART_COMMAND</c>, normally used by the heart @@ -362,8 +363,8 @@ a relup script, and it shall always be placed at the end. If the relup is generated by <c>systools:make_relup/3,4</c> this is automatically ensured.</p> - <p>When the release handler encounters the instruction, it shuts down - the emulator by calling <c>init:reboot()</c>, see + <p>When the release handler encounters the instruction, it shuts + down the emulator by calling <c>init:reboot()</c>, see <c>init(3)</c>. All processes are terminated gracefully and the system can then be rebooted by the heart program using the new release version. No more upgrade instruction will be @@ -581,8 +582,8 @@ release_handler:remove_release(Vsn) => ok</code> [].</code> <p>2) Start the system as a simple target system. Note that in reality, it should be started as an embedded system. However, - using <c>erl</c> with the correct boot script and <c>.config</c> - file is enough for illustration purposes:</p> + using <c>erl</c> with the correct boot script and config file is + enough for illustration purposes:</p> <pre> % <input>cd $ROOT</input> % <input>bin/erl -boot $ROOT/releases/A/start -config $ROOT/releases/A/sys</input> @@ -617,6 +618,7 @@ lib/ch_app-2/ebin/ch3.beam releases/B/start.boot releases/B/relup releases/B/sys.config +releases/B/ch_rel-2.rel releases/ch_rel-2.rel</code> <p>4) Copy the release package <c>ch_rel-2.tar.gz</c> to the <c>$ROOT/releases</c> directory.</p> diff --git a/system/doc/design_principles/release_structure.xml b/system/doc/design_principles/release_structure.xml index 2e1daa611a..8aea0e1a10 100644 --- a/system/doc/design_principles/release_structure.xml +++ b/system/doc/design_principles/release_structure.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2009</year> + <year>2003</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -61,12 +61,14 @@ {ApplicationN, AppVsnN}]}.</code> <p>The file must be named <c>Rel.rel</c>, where <c>Rel</c> is a unique name.</p> - <p><c>Name</c>, <c>Vsn</c> and <c>Evsn</c> are strings.</p> + <p><c>Name</c>, <c>Vsn</c> and <c>EVsn</c> are strings.</p> <p>Each <c>Application</c> (atom) and <c>AppVsn</c> (string) is the name and version of an application included in the release. - Note the the minimal release based on Erlang/OTP consists of + Note that the minimal release based on Erlang/OTP consists of the <c>kernel</c> and <c>stdlib</c> applications, so these applications must be included in the list.</p> + <p>If the release is to be upgraded, it must also include + the <c>sasl</c> application.</p> <marker id="ch_rel"></marker> <p>Example: We want to make a release of <c>ch_app</c> from the <seealso marker="applications#ch_app">Applications</seealso> @@ -173,6 +175,7 @@ lib/ch_app-1/ebin/ch_app.beam lib/ch_app-1/ebin/ch_sup.beam lib/ch_app-1/ebin/ch3.beam releases/A/start.boot +releases/A/ch_rel-1.rel releases/ch_rel-1.rel</pre> <p>Note that a new boot script was generated, without the <c>local</c> option set, before the release package was made. @@ -180,6 +183,17 @@ releases/ch_rel-1.rel</pre> under <c>lib</c>. Also, we do not know where the release package will be installed, so we do not want any hardcoded absolute paths in the boot script here.</p> + <p>The release resource file <c>mysystem.rel</c> is duplicated in + the tar file. Originally, this file was only stored in + the <c>releases</c> directory in order to make it possible for + the <c>release_handler</c> to extract this file + separately. After unpacking the tar file, <c>release_handler</c> + would automatically copy the file + to <c>releases/FIRST</c>. However, sometimes the tar file is + unpacked without involving the <c>release_handler</c> (e.g. when + unpacking the first target system) and therefore the file is now + instead duplicated in the tar file so no manual copying is + necessary.</p> <p>If a <c>relup</c> file and/or a system configuration file called <c>sys.config</c> is found, these files are included in the release package as well. See diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 43d46d87cc..5fca7225bb 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -563,12 +563,12 @@ number < atom < reference < fun < port < pid < tuple < list element.</p> <p>When comparing an integer to a float, the term with the lesser precision will be converted into the other term's type, unless the - operator is one of =:= and =/=. A float is more precise than + operator is one of =:= or =/=. A float is more precise than an integer until all significant figures of the float are to the left of - the decimal point. This happens when the float is larger/smaller then + the decimal point. This happens when the float is larger/smaller than +/-9007199254740992.0. The conversion strategy is changed depending on the size of the float because otherwise comparison of large - floats and integers would loose their transitivity.</p> + floats and integers would lose their transitivity.</p> <p>Returns the Boolean value of the expression, <c>true</c> or <c>false</c>.</p> diff --git a/system/doc/system_principles/create_target.xml b/system/doc/system_principles/create_target.xmlsrc index 7d9f4681b9..bc2a76db47 100644 --- a/system/doc/system_principles/create_target.xml +++ b/system/doc/system_principles/create_target.xmlsrc @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2009</year> + <year>2002</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>Creating a First Target System</title> @@ -44,10 +44,10 @@ may be irrelevant for the purpose in question. Thus, there is a need to be able to create a new system based on a given Erlang/OTP system, where dispensable applications are removed, - and a set of new applications that are included in the new - system. Documentation and source code is irrelevant and is - therefore not included in the new system.</p> - <p>This chapter is about creating such a system, which we call a + and a set of new applications are included. Documentation and + source code is irrelevant and is therefore not included in the + new system.</p> + <p>This chapter is about creating such a system, which we call a <em>target system</em>.</p> <p>In the following sections we consider creating target systems with different requirements of functionality:</p> @@ -63,10 +63,11 @@ </list> <p>We only consider the case when Erlang/OTP is running on a UNIX system.</p> - <p>There is an example Erlang module <c>target_system.erl</c> that - contains functions for creating and installing a target system. - That module is used in the examples below. The source code of - the module is listed at the end of this chapter.</p> + <p>In the <c>sasl</c> application there is an example Erlang + module <c>target_system.erl</c> that contains functions for + creating and installing a target system. This module is used in + the examples below, and the source code of the module is listed + at the end of this chapter.</p> </section> <section> @@ -95,7 +96,7 @@ file reside, start the Erlang/OTP system:</p> <pre> os> <input>erl -pa /home/user/target_system/myapps/pea-1.0/ebin</input></pre> - <p>where also the path to the <c>pea-1.0</c> ebin directory is + <p>where also the path to the <c>pea-1.0</c> ebin directory is provided. </p> <p><em>Step 3.</em> Now create the target system: </p> <pre> @@ -117,28 +118,41 @@ os> <input>erl -pa /home/user/target_system/myapps/pea-1.0/ebin</input></pre> <code type="none"> erts-5.1/bin/ releases/FIRST/start.boot +releases/FIRST/mysystem.rel releases/mysystem.rel lib/kernel-2.7/ lib/stdlib-1.10/ lib/sasl-1.9.3/ lib/pea-1.0/ </code> <p>The file <c>releases/FIRST/start.boot</c> is a copy of our - <c>mysystem.boot</c>, and a copy of the original - <c>mysystem.rel</c> has been put in the <c>releases</c> - directory.</p> + <c>mysystem.boot</c></p> + <p>The release resource file <c>mysystem.rel</c> is duplicated + in the tar file. Originally, this file was only stored in + the <c>releases</c> directory in order to make it possible + for the <c>release_handler</c> to extract this file + separately. After unpacking the tar + file, <c>release_handler</c> would automatically copy the + file to <c>releases/FIRST</c>. However, sometimes the tar + file is unpacked without involving + the <c>release_handler</c> (e.g. when unpacking the first + target system) and therefore the file is now instead + duplicated in the tar file so no manual copying is + necessary.</p> </item> <item>Creates the temporary directory <c>tmp</c> and extracts the tar file <c>mysystem.tar.gz</c> into that directory. </item> <item>Deletes the <c>erl</c> and <c>start</c> files from - <c>tmp/erts-5.1/bin</c>. XXX Why.</item> + <c>tmp/erts-5.1/bin</c>. These files will be created again from + source when installing the release.</item> <item>Creates the directory <c>tmp/bin</c>.</item> - <item>Copies the previously creates file <c>plain.boot</c> to + <item>Copies the previously created file <c>plain.boot</c> to <c>tmp/bin/start.boot</c>.</item> <item>Copies the files <c>epmd</c>, <c>run_erl</c>, and <c>to_erl</c> from the directory <c>tmp/erts-5.1/bin</c> to the directory <c>tmp/bin</c>.</item> - <item>Creates the file <c>tmp/releases/start_erl.data</c> with the - contents "5.1 FIRST". + <item>Creates the file <c>tmp/releases/start_erl.data</c> with + the contents "5.1 FIRST". This file is to be passed as data + file to the <c>start_erl</c> script. </item> <item>Recreates the file <c>mysystem.tar.gz</c> from the directories in the directory <c>tmp</c>, and removes <c>tmp</c>.</item> @@ -147,7 +161,7 @@ lib/pea-1.0/ </code> <section> <title>Installing a Target System</title> - <p><em>Step 4.</em> Install the created target system in a + <p><em>Step 4.</em> Install the created target system in a suitable directory. </p> <pre> 2> <input>target_system:install("mysystem", "/usr/local/erl-target").</input></pre> @@ -187,7 +201,7 @@ os> <input>/usr/local/erl-target/bin/erl</input></pre> <pre> os> <input>/usr/local/erl-target/bin/erl -boot /usr/local/erl-target/releases/FIRST/start</input></pre> <p>We start a <em>simple target system</em> as above. The only difference - is that also the file <c>releases/RELEASES</c> is present for + is that also the file <c>releases/RELEASES</c> is present for code replacement in run-time to work.</p> <p>To start an <em>embedded target system</em> the shell script <c>bin/start</c> is used. That shell script calls @@ -210,7 +224,7 @@ os> <input>/usr/local/erl-target/bin/erl -boot /usr/local/erl-target/releases/FI file of the release version found (<c>"releases/FIRST/start.boot"</c>).</p> <p><c>start_erl</c> also assumes that there is <c>sys.config</c> in - release version directory (<c>"releases/FIRST/sys.config</c>). That + release version directory (<c>"releases/FIRST/sys.config"</c>). That is the topic of the next section (see below).</p> <p>The <c>start_erl</c> shell script should normally not be altered by the user.</p> @@ -222,7 +236,7 @@ os> <input>/usr/local/erl-target/bin/erl -boot /usr/local/erl-target/releases/FI <c>sys.config</c> in the release version directory (<c>"releases/FIRST/sys.config"</c>). If there is no such a file, the system start will fail. Hence such a file has to - added as well.</p> + be added as well.</p> <p></p> <p>If you have system configuration data that are neither file location dependent nor site dependent, it may be convenient to @@ -245,253 +259,9 @@ os> <input>/usr/local/erl-target/bin/erl -boot /usr/local/erl-target/releases/FI <section> <title>Listing of target_system.erl</title> - <code type="none"><![CDATA[ --module(target_system). --include_lib("kernel/include/file.hrl"). --export([create/1, install/2]). --define(BUFSIZE, 8192). - -%% Note: RelFileName below is the *stem* without trailing .rel, -%% .script etc. -%% - -%% create(RelFileName) -%% -create(RelFileName) -> - RelFile = RelFileName ++ ".rel", - io:fwrite("Reading file: \"~s\" ...~n", [RelFile]), - {ok, [RelSpec]} = file:consult(RelFile), - io:fwrite("Creating file: \"~s\" from \"~s\" ...~n", - ["plain.rel", RelFile]), - {release, - {RelName, RelVsn}, - {erts, ErtsVsn}, - AppVsns} = RelSpec, - PlainRelSpec = {release, - {RelName, RelVsn}, - {erts, ErtsVsn}, - lists:filter(fun({kernel, _}) -> - true; - ({stdlib, _}) -> - true; - (_) -> - false - end, AppVsns) - }, - {ok, Fd} = file:open("plain.rel", [write]), - io:fwrite(Fd, "~p.~n", [PlainRelSpec]), - file:close(Fd), - - io:fwrite("Making \"plain.script\" and \"plain.boot\" files ...~n"), - make_script("plain"), - - io:fwrite("Making \"~s.script\" and \"~s.boot\" files ...~n", - [RelFileName, RelFileName]), - make_script(RelFileName), - - TarFileName = io_lib:fwrite("~s.tar.gz", [RelFileName]), - io:fwrite("Creating tar file \"~s\" ...~n", [TarFileName]), - make_tar(RelFileName), - - io:fwrite("Creating directory \"tmp\" ...~n"), - file:make_dir("tmp"), - - io:fwrite("Extracting \"~s\" into directory \"tmp\" ...~n", [TarFileName]), - extract_tar(TarFileName, "tmp"), - - TmpBinDir = filename:join(["tmp", "bin"]), - ErtsBinDir = filename:join(["tmp", "erts-" ++ ErtsVsn, "bin"]), - io:fwrite("Deleting \"erl\" and \"start\" in directory \"~s\" ...~n", - [ErtsBinDir]), - file:delete(filename:join([ErtsBinDir, "erl"])), - file:delete(filename:join([ErtsBinDir, "start"])), - - io:fwrite("Creating temporary directory \"~s\" ...~n", [TmpBinDir]), - file:make_dir(TmpBinDir), - - io:fwrite("Copying file \"plain.boot\" to \"~s\" ...~n", - [filename:join([TmpBinDir, "start.boot"])]), - copy_file("plain.boot", filename:join([TmpBinDir, "start.boot"])), - - io:fwrite("Copying files \"epmd\", \"run_erl\" and \"to_erl\" from \n" - "\"~s\" to \"~s\" ...~n", - [ErtsBinDir, TmpBinDir]), - copy_file(filename:join([ErtsBinDir, "epmd"]), - filename:join([TmpBinDir, "epmd"]), [preserve]), - copy_file(filename:join([ErtsBinDir, "run_erl"]), - filename:join([TmpBinDir, "run_erl"]), [preserve]), - copy_file(filename:join([ErtsBinDir, "to_erl"]), - filename:join([TmpBinDir, "to_erl"]), [preserve]), - - StartErlDataFile = filename:join(["tmp", "releases", "start_erl.data"]), - io:fwrite("Creating \"~s\" ...~n", [StartErlDataFile]), - StartErlData = io_lib:fwrite("~s ~s~n", [ErtsVsn, RelVsn]), - write_file(StartErlDataFile, StartErlData), - - io:fwrite("Recreating tar file \"~s\" from contents in directory " - "\"tmp\" ...~n", [TarFileName]), - {ok, Tar} = erl_tar:open(TarFileName, [write, compressed]), - {ok, Cwd} = file:get_cwd(), - file:set_cwd("tmp"), - erl_tar:add(Tar, "bin", []), - erl_tar:add(Tar, "erts-" ++ ErtsVsn, []), - erl_tar:add(Tar, "releases", []), - erl_tar:add(Tar, "lib", []), - erl_tar:close(Tar), - file:set_cwd(Cwd), - io:fwrite("Removing directory \"tmp\" ...~n"), - remove_dir_tree("tmp"), - ok. - - -install(RelFileName, RootDir) -> - TarFile = RelFileName ++ ".tar.gz", - io:fwrite("Extracting ~s ...~n", [TarFile]), - extract_tar(TarFile, RootDir), - StartErlDataFile = filename:join([RootDir, "releases", "start_erl.data"]), - {ok, StartErlData} = read_txt_file(StartErlDataFile), - [ErlVsn, RelVsn| _] = string:tokens(StartErlData, " \n"), - ErtsBinDir = filename:join([RootDir, "erts-" ++ ErlVsn, "bin"]), - BinDir = filename:join([RootDir, "bin"]), - io:fwrite("Substituting in erl.src, start.src and start_erl.src to\n" - "form erl, start and start_erl ...\n"), - subst_src_scripts(["erl", "start", "start_erl"], ErtsBinDir, BinDir, - [{"FINAL_ROOTDIR", RootDir}, {"EMU", "beam"}], - [preserve]), - io:fwrite("Creating the RELEASES file ...\n"), - create_RELEASES(RootDir, - filename:join([RootDir, "releases", RelFileName])). - -%% LOCALS + <p>This module can also be found in the <c>examples</c> directory + of the <c>sasl</c> application.</p> + <codeinclude file="../../../lib/sasl/examples/src/target_system.erl" tag="%module" type="erl"></codeinclude> -%% make_script(RelFileName) -%% -make_script(RelFileName) -> - Opts = [no_module_tests], - systools:make_script(RelFileName, Opts). - -%% make_tar(RelFileName) -%% -make_tar(RelFileName) -> - RootDir = code:root_dir(), - systools:make_tar(RelFileName, [{erts, RootDir}]). - -%% extract_tar(TarFile, DestDir) -%% -extract_tar(TarFile, DestDir) -> - erl_tar:extract(TarFile, [{cwd, DestDir}, compressed]). - -create_RELEASES(DestDir, RelFileName) -> - release_handler:create_RELEASES(DestDir, RelFileName ++ ".rel"). - -subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) -> - lists:foreach(fun(Script) -> - subst_src_script(Script, SrcDir, DestDir, - Vars, Opts) - end, Scripts). - -subst_src_script(Script, SrcDir, DestDir, Vars, Opts) -> - subst_file(filename:join([SrcDir, Script ++ ".src"]), - filename:join([DestDir, Script]), - Vars, Opts). - -subst_file(Src, Dest, Vars, Opts) -> - {ok, Conts} = read_txt_file(Src), - NConts = subst(Conts, Vars), - write_file(Dest, NConts), - case lists:member(preserve, Opts) of - true -> - {ok, FileInfo} = file:read_file_info(Src), - file:write_file_info(Dest, FileInfo); - false -> - ok - end. - -%% subst(Str, Vars) -%% Vars = [{Var, Val}] -%% Var = Val = string() -%% Substitute all occurrences of %Var% for Val in Str, using the list -%% of variables in Vars. -%% -subst(Str, Vars) -> - subst(Str, Vars, []). - -subst([$%, C| Rest], Vars, Result) when $A =< C, C =< $Z -> - subst_var([C| Rest], Vars, Result, []); -subst([$%, C| Rest], Vars, Result) when $a =< C, C =< $z -> - subst_var([C| Rest], Vars, Result, []); -subst([$%, C| Rest], Vars, Result) when C == $_ -> - subst_var([C| Rest], Vars, Result, []); -subst([C| Rest], Vars, Result) -> - subst(Rest, Vars, [C| Result]); -subst([], _Vars, Result) -> - lists:reverse(Result). - -subst_var([$%| Rest], Vars, Result, VarAcc) -> - Key = lists:reverse(VarAcc), - case lists:keysearch(Key, 1, Vars) of - {value, {Key, Value}} -> - subst(Rest, Vars, lists:reverse(Value, Result)); - false -> - subst(Rest, Vars, [$%| VarAcc ++ [$%| Result]]) - end; -subst_var([C| Rest], Vars, Result, VarAcc) -> - subst_var(Rest, Vars, Result, [C| VarAcc]); -subst_var([], Vars, Result, VarAcc) -> - subst([], Vars, [VarAcc ++ [$%| Result]]). - -copy_file(Src, Dest) -> - copy_file(Src, Dest, []). - -copy_file(Src, Dest, Opts) -> - {ok, InFd} = file:open(Src, [raw, binary, read]), - {ok, OutFd} = file:open(Dest, [raw, binary, write]), - do_copy_file(InFd, OutFd), - file:close(InFd), - file:close(OutFd), - case lists:member(preserve, Opts) of - true -> - {ok, FileInfo} = file:read_file_info(Src), - file:write_file_info(Dest, FileInfo); - false -> - ok - end. - -do_copy_file(InFd, OutFd) -> - case file:read(InFd, ?BUFSIZE) of - {ok, Bin} -> - file:write(OutFd, Bin), - do_copy_file(InFd, OutFd); - eof -> - ok - end. - -write_file(FName, Conts) -> - {ok, Fd} = file:open(FName, [write]), - file:write(Fd, Conts), - file:close(Fd). - -read_txt_file(File) -> - {ok, Bin} = file:read_file(File), - {ok, binary_to_list(Bin)}. - -remove_dir_tree(Dir) -> - remove_all_files(".", [Dir]). - -remove_all_files(Dir, Files) -> - lists:foreach(fun(File) -> - FilePath = filename:join([Dir, File]), - {ok, FileInfo} = file:read_file_info(FilePath), - case FileInfo#file_info.type of - directory -> - {ok, DirFiles} = file:list_dir(FilePath), - remove_all_files(FilePath, DirFiles), - file:del_dir(FilePath); - _ -> - file:delete(FilePath) - end - end, Files). - ]]></code> </section> </chapter> - |