diff options
162 files changed, 10470 insertions, 2758 deletions
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 481c7a17fb..6862410a3a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index c8fe7b4bd2..6f30c7fb21 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -6723,6 +6723,17 @@ true</pre> See also <seealso marker="#trace_pattern/3">erlang:trace_pattern/3</seealso>.</p> </item> + <tag><c>call_time</c></tag> + <item> + <p>Return the call time values for this function or + <c>true</c> for the pseudo function <c>on_load</c> if call + time tracing is active. Returns <c>false</c> otherwise. + The call time values returned, <c>[{Pid, Count, S, Us}]</c>, + is a list of each process that has executed the function and its specific counters. + See also + <seealso marker="#trace_pattern/3">erlang:trace_pattern/3</seealso>.</p> + </item> + <tag><c>all</c></tag> <item> <p>Return a list containing the <c>{Item, Value}</c> tuples @@ -6825,13 +6836,13 @@ true</pre> </item> <tag><c>restart</c></tag> <item> - <p>For the <c>FlagList</c> option <c>call_count</c>: + <p>For the <c>FlagList</c> option <c>call_count</c> and <c>call_time</c>: restart the existing counters. The behaviour is undefined for other <c>FlagList</c> options.</p> </item> <tag><c>pause</c></tag> <item> - <p>For the <c>FlagList</c> option <c>call_count</c>: pause + <p>For the <c>FlagList</c> option <c>call_count</c> and <c>call_time</c>: pause the existing counters. The behaviour is undefined for other <c>FlagList</c> options.</p> </item> @@ -6886,6 +6897,23 @@ true</pre> <p>The counter value can be read with <seealso marker="#trace_info/2">erlang:trace_info/2</seealso>.</p> </item> + <tag><c>call_time</c></tag> + <item> + <p>Starts (<c>MatchSpec == true</c>) or stops + (<c>MatchSpec == false</c>) call time tracing for all + types of function calls. For every function a counter is + incremented when the function is called. Time spent in the function + is accumulated in two other counters, seconds and micro-seconds. + The counters are stored for each call traced process.</p> + <p>If call time tracing is started while already running, + the count and time is restarted from zero. Running counters can be + paused with <c>MatchSpec == pause</c>. Paused and running + counters can be restarted from zero with + <c>MatchSpec == restart</c>.</p> + <p>The counter value can be read with + <seealso marker="#trace_info/2">erlang:trace_info/2</seealso>.</p> + </item> + </taglist> <p>The <c>global</c> and <c>local</c> options are mutually exclusive and <c>global</c> is the default (if no options are @@ -6893,7 +6921,7 @@ true</pre> perform a kind of local tracing, and can also not be combined with <c>global</c>. A function can be either globally or locally traced. If global tracing is specified for a - specified set of functions; local, meta and call count + specified set of functions; local, meta, call time and call count tracing for the matching set of local functions will be disabled, and vice versa.</p> <p>When disabling trace, the option must match the type of trace diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 1138c0c871..28f69b9460 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -123,6 +123,7 @@ atom busy_dist_port atom busy_port atom call atom call_count +atom call_time atom caller atom capture atom case_clause diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 8462f1c7fd..596ad9a010 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -368,7 +368,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) BIF_RET(am_true); } - static void set_default_trace_pattern(Eterm module) { diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 6278ff6bad..682f31b83f 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -30,6 +30,7 @@ #include "error.h" #include "erl_binary.h" #include "beam_bp.h" +#include "erl_term.h" /* ************************************************************************* ** Macros @@ -100,6 +101,11 @@ do { \ (b)->prev = (a); \ } while (0) + +#define BREAK_IS_BIF (1) +#define BREAK_IS_ERL (0) + + /* ************************************************************************* ** Local prototypes */ @@ -114,7 +120,7 @@ static int set_break(Eterm mfa[3], int specified, static int set_module_break(Module *modp, Eterm mfa[3], int specified, Binary *match_spec, BeamInstr break_op, enum erts_break_op count_op, Eterm tracer_pid); -static int set_function_break(Module *modp, BeamInstr *pc, +static int set_function_break(Module *modp, BeamInstr *pc, int bif, Binary *match_spec, BeamInstr break_op, enum erts_break_op count_op, Eterm tracer_pid); @@ -122,11 +128,29 @@ static int clear_break(Eterm mfa[3], int specified, BeamInstr break_op); static int clear_module_break(Module *modp, Eterm mfa[3], int specified, BeamInstr break_op); -static int clear_function_break(Module *modp, BeamInstr *pc, +static int clear_function_break(Module *modp, BeamInstr *pc, int bif, BeamInstr break_op); static BpData *is_break(BeamInstr *pc, BeamInstr break_op); - +static BpData *get_break(Process *p, BeamInstr *pc, BeamInstr break_op); + +/* bp_hash */ +#define BP_TIME_ADD(pi0, pi1) \ + do { \ + Uint r; \ + (pi0)->count += (pi1)->count; \ + (pi0)->s_time += (pi1)->s_time; \ + (pi0)->us_time += (pi1)->us_time; \ + r = (pi0)->us_time / 1000000; \ + (pi0)->s_time += r; \ + (pi0)->us_time = (pi0)->us_time % 1000000; \ + } while(0) + +static void bp_hash_init(bp_time_hash_t *hash, Uint n); +static void bp_hash_rehash(bp_time_hash_t *hash, Uint n); +static ERTS_INLINE bp_data_time_item_t * bp_hash_get(bp_time_hash_t *hash, bp_data_time_item_t *sitem); +static ERTS_INLINE bp_data_time_item_t * bp_hash_put(bp_time_hash_t *hash, bp_data_time_item_t *sitem); +static void bp_hash_delete(bp_time_hash_t *hash); /* ************************************************************************* @@ -156,25 +180,20 @@ erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec, (BeamInstr) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid); } +/* set breakpoint data for on exported bif entry */ + void erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, Eterm tracer_pid) { - BpDataTrace *bdt; ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + set_function_break(NULL, pc, BREAK_IS_BIF, match_spec, (BeamInstr) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid); +} - bdt = (BpDataTrace *) pc[-4]; - if (bdt) { - MatchSetUnref(bdt->match_spec); - MatchSetRef(match_spec); - bdt->match_spec = match_spec; - bdt->tracer_pid = tracer_pid; - } else { - bdt = Alloc(sizeof(BpDataTrace)); - BpInit((BpData *) bdt, 0); - MatchSetRef(match_spec); - bdt->match_spec = match_spec; - bdt->tracer_pid = tracer_pid; - pc[-4] = (BeamInstr) bdt; - } +void erts_set_time_trace_bif(BeamInstr *pc, enum erts_break_op count_op) { + set_function_break(NULL, pc, BREAK_IS_BIF, NULL, (BeamInstr) BeamOp(op_i_time_breakpoint), count_op, NIL); +} + +void erts_clear_time_trace_bif(BeamInstr *pc) { + clear_function_break(NULL, pc, BREAK_IS_BIF, (BeamInstr) BeamOp(op_i_time_breakpoint)); } int @@ -191,7 +210,12 @@ erts_set_count_break(Eterm mfa[3], int specified, enum erts_break_op count_op) { (BeamInstr) BeamOp(op_i_count_breakpoint), count_op, NIL); } - +int +erts_set_time_break(Eterm mfa[3], int specified, enum erts_break_op count_op) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return set_break(mfa, specified, NULL, + (BeamInstr) BeamOp(op_i_time_breakpoint), count_op, NIL); +} int erts_clear_trace_break(Eterm mfa[3], int specified) { @@ -209,17 +233,7 @@ erts_clear_mtrace_break(Eterm mfa[3], int specified) { void erts_clear_mtrace_bif(BeamInstr *pc) { - BpDataTrace *bdt; - ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); - - bdt = (BpDataTrace *) pc[-4]; - if (bdt) { - if (bdt->match_spec) { - MatchSetUnref(bdt->match_spec); - } - Free(bdt); - } - pc[-4] = (BeamInstr) NULL; + clear_function_break(NULL, pc, BREAK_IS_BIF, (BeamInstr) BeamOp(op_i_mtrace_breakpoint)); } int @@ -237,6 +251,13 @@ erts_clear_count_break(Eterm mfa[3], int specified) { } int +erts_clear_time_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return clear_break(mfa, specified, + (BeamInstr) BeamOp(op_i_time_breakpoint)); +} + +int erts_clear_break(Eterm mfa[3], int specified) { ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); return clear_break(mfa, specified, 0); @@ -253,7 +274,7 @@ int erts_clear_function_break(Module *modp, BeamInstr *pc) { ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); ASSERT(modp); - return clear_function_break(modp, pc, 0); + return clear_function_break(modp, pc, BREAK_IS_ERL, 0); } @@ -265,9 +286,12 @@ BeamInstr erts_trace_break(Process *p, BeamInstr *pc, Eterm *args, Uint32 *ret_flags, Eterm *tracer_pid) { Eterm tpid1, tpid2; - BpDataTrace *bdt = (BpDataTrace *) pc[-4]; + BpData **bds = (BpData **) (pc)[-4]; + BpDataTrace *bdt = NULL; + ASSERT(bds); ASSERT(pc[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + bdt = (BpDataTrace *) bds[bp_sched2ix_proc(p)]; ASSERT(bdt); bdt = (BpDataTrace *) bdt->next; ASSERT(bdt); @@ -286,7 +310,7 @@ erts_trace_break(Process *p, BeamInstr *pc, Eterm *args, bdt->tracer_pid = tpid2; ErtsSmpBPUnlock(bdt); } - pc[-4] = (BeamInstr) bdt; + bds[bp_sched2ix_proc(p)] = (BpData *) bdt; return bdt->orig_instr; } @@ -298,12 +322,15 @@ erts_trace_break(Process *p, BeamInstr *pc, Eterm *args, Uint32 erts_bif_mtrace(Process *p, BeamInstr *pc, Eterm *args, int local, Eterm *tracer_pid) { - BpDataTrace *bdt = (BpDataTrace *) pc[-4]; + BpData **bds = (BpData **) (pc)[-4]; + BpDataTrace *bdt = NULL; + ASSERT(tracer_pid); - if (bdt) { + if (bds) { Eterm tpid1, tpid2; Uint32 flags; + bdt = (BpDataTrace *)bds[bp_sched2ix_proc(p)]; ErtsSmpBPLock(bdt); tpid1 = tpid2 = bdt->tracer_pid; @@ -364,24 +391,6 @@ erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, Eterm *tracer_pid_r } int -erts_is_mtrace_bif(BeamInstr *pc, Binary **match_spec_ret, Eterm *tracer_pid_ret) { - BpDataTrace *bdt = (BpDataTrace *) pc[-4]; - - if (bdt) { - if (match_spec_ret) { - *match_spec_ret = bdt->match_spec; - } - if (tracer_pid_ret) { - ErtsSmpBPLock(bdt); - *tracer_pid_ret = bdt->tracer_pid; - ErtsSmpBPUnlock(bdt); - } - return !0; - } - return 0; -} - -int erts_is_native_break(BeamInstr *pc) { #ifdef HIPE ASSERT(pc[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); @@ -399,15 +408,69 @@ erts_is_count_break(BeamInstr *pc, Sint *count_ret) { if (bdc) { if (count_ret) { - ErtsSmpBPLock(bdc); - *count_ret = bdc->count; - ErtsSmpBPUnlock(bdc); + *count_ret = (Sint) erts_smp_atomic_read(&bdc->acount); } return !0; } return 0; } +int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) { + Uint i, ix; + bp_time_hash_t hash; + Uint size; + Eterm *hp, t; + bp_data_time_item_t *item = NULL; + BpDataTime *bdt = (BpDataTime *) is_break(pc, (BeamInstr) BeamOp(op_i_time_breakpoint)); + + if (bdt) { + if (retval) { + /* collect all hashes to one hash */ + bp_hash_init(&hash, 64); + /* foreach threadspecific hash */ + for (i = 0; i < bdt->n; i++) { + bp_data_time_item_t *sitem; + + /* foreach hash bucket not NIL*/ + for(ix = 0; ix < bdt->hash[i].n; ix++) { + item = &(bdt->hash[i].item[ix]); + if (item->pid != NIL) { + sitem = bp_hash_get(&hash, item); + if (sitem) { + BP_TIME_ADD(sitem, item); + } else { + bp_hash_put(&hash, item); + } + } + } + } + /* *retval should be NIL or term from previous bif in export entry */ + + if (hash.used > 0) { + size = (5 + 2)*hash.used; + hp = HAlloc(p, size); + + for(ix = 0; ix < hash.n; ix++) { + item = &(hash.item[ix]); + if (item->pid != NIL) { + t = TUPLE4(hp, item->pid, + make_small(item->count), + make_small(item->s_time), + make_small(item->us_time)); + hp += 5; + *retval = CONS(hp, t, *retval); hp += 2; + } + } + } + bp_hash_delete(&hash); + } + return !0; + } + + return 0; +} + + BeamInstr * erts_find_local_func(Eterm mfa[3]) { Module *modp; @@ -432,6 +495,351 @@ erts_find_local_func(Eterm mfa[3]) { return NULL; } +/* bp_hash */ +ERTS_INLINE Uint bp_sched2ix() { +#ifdef ERTS_SMP + ErtsSchedulerData *esdp; + esdp = erts_get_scheduler_data(); + return esdp->no - 1; +#else + return 0; +#endif +} +static void bp_hash_init(bp_time_hash_t *hash, Uint n) { + Uint size = sizeof(bp_data_time_item_t)*n; + Uint i; + + hash->n = n; + hash->used = 0; + + hash->item = (bp_data_time_item_t *)Alloc(size); + sys_memzero(hash->item, size); + + for(i = 0; i < n; ++i) { + hash->item[i].pid = NIL; + } +} + +static void bp_hash_rehash(bp_time_hash_t *hash, Uint n) { + bp_data_time_item_t *item = NULL; + Uint size = sizeof(bp_data_time_item_t)*n; + Uint ix; + Uint hval; + + item = (bp_data_time_item_t *)Alloc(size); + sys_memzero(item, size); + + for( ix = 0; ix < n; ++ix) { + item[ix].pid = NIL; + } + + /* rehash, old hash -> new hash */ + + for( ix = 0; ix < hash->n; ix++) { + if (hash->item[ix].pid != NIL) { + + hval = ((hash->item[ix].pid) >> 4) % n; /* new n */ + + while (item[hval].pid != NIL) { + hval = (hval + 1) % n; + } + item[hval].pid = hash->item[ix].pid; + item[hval].count = hash->item[ix].count; + item[hval].s_time = hash->item[ix].s_time; + item[hval].us_time = hash->item[ix].us_time; + } + } + + Free(hash->item); + hash->n = n; + hash->item = item; +} +static ERTS_INLINE bp_data_time_item_t * bp_hash_get(bp_time_hash_t *hash, bp_data_time_item_t *sitem) { + Eterm pid = sitem->pid; + Uint hval = (pid >> 4) % hash->n; + bp_data_time_item_t *item = NULL; + + item = hash->item; + + while (item[hval].pid != pid) { + if (item[hval].pid == NIL) return NULL; + hval = (hval + 1) % hash->n; + } + + return &(item[hval]); +} + +static ERTS_INLINE bp_data_time_item_t * bp_hash_put(bp_time_hash_t *hash, bp_data_time_item_t* sitem) { + Uint hval; + float r = 0.0; + bp_data_time_item_t *item; + + /* make sure that the hash is not saturated */ + /* if saturated, rehash it */ + + r = hash->used / (float) hash->n; + + if (r > 0.7f) { + bp_hash_rehash(hash, hash->n * 2); + } + /* Do hval after rehash */ + hval = (sitem->pid >> 4) % hash->n; + + /* find free slot */ + item = hash->item; + + while (item[hval].pid != NIL) { + hval = (hval + 1) % hash->n; + } + item = &(hash->item[hval]); + + item->pid = sitem->pid; + item->s_time = sitem->s_time; + item->us_time = sitem->us_time; + item->count = sitem->count; + hash->used++; + + return item; +} + +static void bp_hash_delete(bp_time_hash_t *hash) { + hash->n = 0; + hash->used = 0; + Free(hash->item); + hash->item = NULL; +} + +static void bp_time_diff(bp_data_time_item_t *item, /* out */ + process_breakpoint_time_t *pbt, /* in */ + Uint ms, Uint s, Uint us) { + int dms,ds,dus; + + dms = ms - pbt->ms; + ds = s - pbt->s; + dus = us - pbt->us; + + /* get_sys_now may return zero difftime, + * this is ok. + */ + + ASSERT(dms >= 0 || ds >= 0 || dus >= 0); + + if (dus < 0) { + dus += 1000000; + ds -= 1; + } + if (ds < 0) { + ds += 1000000; + } + + item->s_time = ds; + item->us_time = dus; +} + +void erts_schedule_time_break(Process *p, Uint schedule) { + Uint ms, s, us; + process_breakpoint_time_t *pbt = NULL; + bp_data_time_item_t sitem, *item = NULL; + bp_time_hash_t *h = NULL; + BpDataTime *pbdt = NULL; + + ASSERT(p); + + pbt = ERTS_PROC_GET_CALL_TIME(p); + + if (pbt) { + + switch(schedule) { + case ERTS_BP_CALL_TIME_SCHEDULE_EXITING : + break; + case ERTS_BP_CALL_TIME_SCHEDULE_OUT : + /* When a process is scheduled _out_, + * timestamp it and add its delta to + * the previous breakpoint. + */ + + pbdt = (BpDataTime *) get_break(p, pbt->pc, (BeamInstr) BeamOp(op_i_time_breakpoint)); + if (pbdt) { + get_sys_now(&ms,&s,&us); + bp_time_diff(&sitem, pbt, ms, s, us); + sitem.pid = p->id; + sitem.count = 0; + + h = &(pbdt->hash[bp_sched2ix_proc(p)]); + + ASSERT(h); + ASSERT(h->item); + + item = bp_hash_get(h, &sitem); + if (!item) { + item = bp_hash_put(h, &sitem); + } else { + BP_TIME_ADD(item, &sitem); + } + } + break; + case ERTS_BP_CALL_TIME_SCHEDULE_IN : + /* When a process is scheduled _in_, + * timestamp it and remove the previous + * timestamp in the psd. + */ + get_sys_now(&ms,&s,&us); + pbt->ms = ms; + pbt->s = s; + pbt->us = us; + break; + default : + ASSERT(0); + /* will never happen */ + break; + } + } /* pbt */ +} + +/* call_time breakpoint + * Accumulated times are added to the previous bp, + * not the current one. The current one is saved + * for future reference. + * The previous breakpoint is stored in the process it self, the psd. + * We do not need to store in a stack frame. + * There is no need for locking, each thread has its own + * area in each bp to save data. + * Since we need to diffrentiate between processes for each bp, + * every bp has a hash (per thread) to process-bp statistics. + * - egil + */ + +void erts_trace_time_break(Process *p, BeamInstr *pc, BpDataTime *bdt, Uint type) { + Uint ms,s,us; + process_breakpoint_time_t *pbt = NULL; + bp_data_time_item_t sitem, *item = NULL; + bp_time_hash_t *h = NULL; + BpDataTime *pbdt = NULL; + + ASSERT(p); + ASSERT(p->status == P_RUNNING); + + /* get previous timestamp and breakpoint + * from the process psd */ + + pbt = ERTS_PROC_GET_CALL_TIME(p); + get_sys_now(&ms,&s,&us); + + switch(type) { + /* get pbt + * timestamp = t0 + * lookup bdt from code + * set ts0 to pbt + * add call count here? + */ + case ERTS_BP_CALL_TIME_CALL: + case ERTS_BP_CALL_TIME_TAIL_CALL: + + if (pbt) { + ASSERT(pbt->pc); + /* add time to previous code */ + bp_time_diff(&sitem, pbt, ms, s, us); + sitem.pid = p->id; + sitem.count = 0; + + /* previous breakpoint */ + pbdt = (BpDataTime *) get_break(p, pbt->pc, (BeamInstr) BeamOp(op_i_time_breakpoint)); + + /* if null then the breakpoint was removed */ + if (pbdt) { + h = &(pbdt->hash[bp_sched2ix_proc(p)]); + + ASSERT(h); + ASSERT(h->item); + + item = bp_hash_get(h, &sitem); + if (!item) { + item = bp_hash_put(h, &sitem); + } else { + BP_TIME_ADD(item, &sitem); + } + } + + } else { + /* first call of process to instrumented function */ + pbt = Alloc(sizeof(process_breakpoint_time_t)); + (void *) ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCK_MAIN, pbt); + } + /* add count to this code */ + sitem.pid = p->id; + sitem.count = 1; + sitem.s_time = 0; + sitem.us_time = 0; + + /* this breakpoint */ + ASSERT(bdt); + h = &(bdt->hash[bp_sched2ix_proc(p)]); + + ASSERT(h); + ASSERT(h->item); + + item = bp_hash_get(h, &sitem); + if (!item) { + item = bp_hash_put(h, &sitem); + } else { + BP_TIME_ADD(item, &sitem); + } + + pbt->pc = pc; + pbt->ms = ms; + pbt->s = s; + pbt->us = us; + break; + + case ERTS_BP_CALL_TIME_RETURN: + /* get pbt + * lookup bdt from code + * timestamp = t1 + * get ts0 from pbt + * get item from bdt->hash[bp_hash(p->id)] + * ack diff (t1, t0) to item + */ + + if(pbt) { + /* might have been removed due to + * trace_pattern(false) + */ + ASSERT(pbt->pc); + + bp_time_diff(&sitem, pbt, ms, s, us); + sitem.pid = p->id; + sitem.count = 0; + + /* previous breakpoint */ + pbdt = (BpDataTime *) get_break(p, pbt->pc, (BeamInstr) BeamOp(op_i_time_breakpoint)); + + /* beware, the trace_pattern might have been removed */ + if (pbdt) { + h = &(pbdt->hash[bp_sched2ix_proc(p)]); + + ASSERT(h); + ASSERT(h->item); + + item = bp_hash_get(h, &sitem); + if (!item) { + item = bp_hash_put(h, &sitem); + } else { + BP_TIME_ADD(item, &sitem); + } + } + + pbt->pc = pc; + pbt->ms = ms; + pbt->s = s; + pbt->us = us; + } + break; + default : + ASSERT(0); + /* will never happen */ + break; + } +} /* ************************************************************************* @@ -489,26 +897,35 @@ static int set_module_break(Module *modp, Eterm mfa[3], int specified, ASSERT(code_ptr[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); if ((specified < 2 || mfa[1] == ((Eterm) code_ptr[3])) && (specified < 3 || ((int) mfa[2]) == ((int) code_ptr[4]))) { - BeamInstr *pc = code_ptr+5; + BeamInstr *pc = code_ptr+5; num_processed += - set_function_break(modp, pc, match_spec, + set_function_break(modp, pc, BREAK_IS_ERL, match_spec, break_op, count_op, tracer_pid); } } return num_processed; } -static int set_function_break(Module *modp, BeamInstr *pc, +static int set_function_break(Module *modp, BeamInstr *pc, int bif, Binary *match_spec, BeamInstr break_op, enum erts_break_op count_op, Eterm tracer_pid) { - BpData *bd, **r; + + BeamInstr **code_base = NULL; + BpData *bd, **r, ***rs; size_t size; - BeamInstr **code_base = (BeamInstr **)modp->code; + Uint ix = 0; - ASSERT(code_base); - ASSERT(code_base <= (BeamInstr **)pc); - ASSERT((BeamInstr **)pc < code_base + (modp->code_length/sizeof(BeamInstr *))); + if (bif == BREAK_IS_ERL) { + code_base = (BeamInstr **)modp->code; + ASSERT(code_base); + ASSERT(code_base <= (BeamInstr **)pc); + ASSERT((BeamInstr **)pc < code_base + (modp->code_length/sizeof(BeamInstr *))); + } else { + ASSERT(*pc == (BeamInstr) em_apply_bif); + ASSERT(modp == NULL); + } + /* * Currently no trace support for native code. */ @@ -519,6 +936,7 @@ static int set_function_break(Module *modp, BeamInstr *pc, if ( (bd = is_break(pc, break_op))) { if (break_op == (BeamInstr) BeamOp(op_i_trace_breakpoint) || break_op == (BeamInstr) BeamOp(op_i_mtrace_breakpoint)) { + BpDataTrace *bdt = (BpDataTrace *) bd; Binary *old_match_spec; @@ -531,20 +949,44 @@ static int set_function_break(Module *modp, BeamInstr *pc, ErtsSmpBPUnlock(bdt); MatchSetUnref(old_match_spec); } else { + BpDataCount *bdc = (BpDataCount *) bd; + long count = 0; + long res = 0; + ASSERT(! match_spec); ASSERT(is_nil(tracer_pid)); - if (break_op == (BeamInstr) BeamOp(op_i_count_breakpoint)) { - BpDataCount *bdc = (BpDataCount *) bd; - ErtsSmpBPLock(bdc); + if (break_op == (BeamInstr) BeamOp(op_i_count_breakpoint)) { if (count_op == erts_break_stop) { - if (bdc->count >= 0) { - bdc->count = -bdc->count-1; /* Stop call counter */ + count = erts_smp_atomic_read(&bdc->acount); + if (count >= 0) { + while(1) { + res = erts_smp_atomic_cmpxchg(&bdc->acount, -count - 1, count); + if ((res == count) || count < 0) break; + count = res; + } } } else { - bdc->count = 0; /* Reset call counter */ + /* Reset call counter */ + erts_smp_atomic_set(&bdc->acount, 0); } - ErtsSmpBPUnlock(bdc); + + } else if (break_op == (BeamInstr) BeamOp(op_i_time_breakpoint)) { + BpDataTime *bdt = (BpDataTime *) bd; + Uint i = 0; + + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + + if (count_op == erts_break_stop) { + bdt->pause = 1; + } else { + bdt->pause = 0; + for (i = 0; i < bdt->n; i++) { + bp_hash_delete(&(bdt->hash[i])); + bp_hash_init(&(bdt->hash[i]), 32); + } + } + } else { ASSERT (! count_op); } @@ -558,43 +1000,63 @@ static int set_function_break(Module *modp, BeamInstr *pc, ASSERT(! match_spec); ASSERT(is_nil(tracer_pid)); if (break_op == (BeamInstr) BeamOp(op_i_count_breakpoint)) { - if (count_op == erts_break_reset - || count_op == erts_break_stop) { + if (count_op == erts_break_reset || count_op == erts_break_stop) { /* Do not insert a new breakpoint */ return 1; } size = sizeof(BpDataCount); + } else if (break_op == (BeamInstr) BeamOp(op_i_time_breakpoint)) { + if (count_op == erts_break_reset || count_op == erts_break_stop) { + /* Do not insert a new breakpoint */ + return 1; + } + size = sizeof(BpDataTime); } else { ASSERT(! count_op); ASSERT(break_op == (BeamInstr) BeamOp(op_i_debug_breakpoint)); size = sizeof(BpDataDebug); } } - r = (BpData **) (pc-4); + rs = (BpData ***) (pc-4); + if (! *rs) { + size_t ssize = sizeof(BeamInstr) * erts_no_schedulers; + *rs = (BpData **) Alloc(ssize); + sys_memzero(*rs, ssize); + } + + r = &((*rs)[0]); + if (! *r) { ASSERT(*pc != (BeamInstr) BeamOp(op_i_trace_breakpoint)); ASSERT(*pc != (BeamInstr) BeamOp(op_i_mtrace_breakpoint)); ASSERT(*pc != (BeamInstr) BeamOp(op_i_debug_breakpoint)); ASSERT(*pc != (BeamInstr) BeamOp(op_i_count_breakpoint)); + ASSERT(*pc != (BeamInstr) BeamOp(op_i_time_breakpoint)); /* First breakpoint; create singleton ring */ bd = Alloc(size); BpInit(bd, *pc); - *pc = break_op; *r = bd; + if (bif == BREAK_IS_ERL) { + *pc = break_op; + } } else { ASSERT(*pc == (BeamInstr) BeamOp(op_i_trace_breakpoint) || *pc == (BeamInstr) BeamOp(op_i_mtrace_breakpoint) || *pc == (BeamInstr) BeamOp(op_i_debug_breakpoint) || - *pc == (BeamInstr) BeamOp(op_i_count_breakpoint)); + *pc == (BeamInstr) BeamOp(op_i_time_breakpoint) || + *pc == (BeamInstr) BeamOp(op_i_count_breakpoint) || + *pc == (BeamInstr) em_apply_bif); if (*pc == (BeamInstr) BeamOp(op_i_debug_breakpoint)) { /* Debug bp must be last, so if it is also first; * it must be singleton. */ - ASSERT(BpSingleton(*r)); + ASSERT(BpSingleton(*r)); /* Insert new bp first in the ring, i.e second to last. */ bd = Alloc(size); BpInitAndSpliceNext(bd, *pc, *r); - *pc = break_op; - } else if ((*r)->prev->orig_instr + if (bif == BREAK_IS_ERL) { + *pc = break_op; + } + } else if ((*r)->prev->orig_instr == (BeamInstr) BeamOp(op_i_debug_breakpoint)) { /* Debug bp last in the ring; insert new second to last. */ bd = Alloc(size); @@ -608,6 +1070,11 @@ static int set_function_break(Module *modp, BeamInstr *pc, *r = bd; } } + for (ix = 1; ix < erts_no_schedulers; ++ix) { + (*rs)[ix] = (*rs)[0]; + } + + bd->this_instr = break_op; /* Init the bp type specific data */ if (break_op == (BeamInstr) BeamOp(op_i_trace_breakpoint) || break_op == (BeamInstr) BeamOp(op_i_mtrace_breakpoint)) { @@ -617,12 +1084,25 @@ static int set_function_break(Module *modp, BeamInstr *pc, MatchSetRef(match_spec); bdt->match_spec = match_spec; bdt->tracer_pid = tracer_pid; + } else if (break_op == (BeamInstr) BeamOp(op_i_time_breakpoint)) { + BpDataTime *bdt = (BpDataTime *) bd; + Uint i = 0; + + bdt->pause = 0; + bdt->n = erts_no_schedulers; + bdt->hash = Alloc(sizeof(bp_time_hash_t)*(bdt->n)); + + for (i = 0; i < bdt->n; i++) { + bp_hash_init(&(bdt->hash[i]), 32); + } } else if (break_op == (BeamInstr) BeamOp(op_i_count_breakpoint)) { BpDataCount *bdc = (BpDataCount *) bd; + erts_smp_atomic_init(&bdc->acount, 0); + } - bdc->count = 0; + if (bif == BREAK_IS_ERL) { + ++(*(BeamInstr*)&code_base[MI_NUM_BREAKPOINTS]); } - ++(*(BeamInstr*)&code_base[MI_NUM_BREAKPOINTS]); return 1; } @@ -672,33 +1152,51 @@ static int clear_module_break(Module *m, Eterm mfa[3], int specified, BeamInstr *pc = code_ptr + 5; num_processed += - clear_function_break(m, pc, break_op); + clear_function_break(m, pc, BREAK_IS_ERL, break_op); } } return num_processed; } -static int clear_function_break(Module *m, BeamInstr *pc, BeamInstr break_op) { +static int clear_function_break(Module *m, BeamInstr *pc, int bif, BeamInstr break_op) { BpData *bd; - BeamInstr **code_base = (BeamInstr **)m->code; - - ASSERT(code_base); - ASSERT(code_base <= (BeamInstr **)pc); - ASSERT((BeamInstr **)pc < code_base + (m->code_length/sizeof(BeamInstr *))); + Uint ix = 0; + BeamInstr **code_base = NULL; + + if (bif == BREAK_IS_ERL) { + code_base = (BeamInstr **)m->code; + ASSERT(code_base); + ASSERT(code_base <= (BeamInstr **)pc); + ASSERT((BeamInstr **)pc < code_base + (m->code_length/sizeof(BeamInstr *))); + } else { + ASSERT(*pc == (BeamInstr) em_apply_bif); + ASSERT(m == NULL); + } + /* * Currently no trace support for native code. */ if (erts_is_native_break(pc)) { return 0; } + while ( (bd = is_break(pc, break_op))) { /* Remove all breakpoints of this type. * There should be only one of each type, * but break_op may be 0 which matches any type. */ BeamInstr op; - BpData **r = (BpData **) (pc-4); + BpData ***rs = (BpData ***) (pc - 4); + BpData **r = NULL; + +#ifdef DEBUG + for (ix = 1; ix < erts_no_schedulers; ++ix) { + ASSERT((*rs)[ix] == (*rs)[0]); + } +#endif + r = &((*rs)[0]); + ASSERT(*r); /* Find opcode for this breakpoint */ if (break_op) { @@ -714,8 +1212,11 @@ static int clear_function_break(Module *m, BeamInstr *pc, BeamInstr break_op) { if (BpSingleton(bd)) { ASSERT(*r == bd); /* Only one breakpoint to remove */ - *r = NULL; - *pc = bd->orig_instr; + if (bif == BREAK_IS_ERL) { + *pc = bd->orig_instr; + } + Free(*rs); + *rs = NULL; } else { BpData *bd_prev = bd->prev; @@ -727,7 +1228,9 @@ static int clear_function_break(Module *m, BeamInstr *pc, BeamInstr break_op) { bd_prev->orig_instr = bd->orig_instr; } else if (bd_prev == *r) { /* We removed the first breakpoint in the ring */ - *pc = bd->orig_instr; + if (bif == BREAK_IS_ERL) { + *pc = bd->orig_instr; + } } else { bd_prev->orig_instr = bd->orig_instr; } @@ -736,13 +1239,53 @@ static int clear_function_break(Module *m, BeamInstr *pc, BeamInstr break_op) { op == (BeamInstr) BeamOp(op_i_mtrace_breakpoint)) { BpDataTrace *bdt = (BpDataTrace *) bd; - MatchSetUnref(bdt->match_spec); } + if (op == (BeamInstr) BeamOp(op_i_time_breakpoint)) { + BpDataTime *bdt = (BpDataTime *) bd; + Uint i = 0; + Uint j = 0; + Process *h_p = NULL; + bp_data_time_item_t *item = NULL; + process_breakpoint_time_t *pbt = NULL; + + /* remove all psd associated with the hash + * and then delete the hash. + * ... sigh ... + */ + + for( i = 0; i < bdt->n; ++i) { + if (bdt->hash[i].used) { + for (j = 0; j < bdt->hash[i].n; ++j) { + item = &(bdt->hash[i].item[j]); + if (item->pid != NIL) { + h_p = process_tab[internal_pid_index(item->pid)]; + if (h_p) { + pbt = ERTS_PROC_SET_CALL_TIME(h_p, ERTS_PROC_LOCK_MAIN, NULL); + if (pbt) { + Free(pbt); + } + } + } + } + } + bp_hash_delete(&(bdt->hash[i])); + } + Free(bdt->hash); + bdt->hash = NULL; + bdt->n = 0; + } Free(bd); - ASSERT(((BeamInstr) code_base[MI_NUM_BREAKPOINTS]) > 0); - --(*(BeamInstr*)&code_base[MI_NUM_BREAKPOINTS]); - } + if (bif == BREAK_IS_ERL) { + ASSERT(((BeamInstr) code_base[MI_NUM_BREAKPOINTS]) > 0); + --(*(BeamInstr*)&code_base[MI_NUM_BREAKPOINTS]); + } + if (*rs) { + for (ix = 1; ix < erts_no_schedulers; ++ix) { + (*rs)[ix] = (*rs)[0]; + } + } + } /* while bd != NULL */ return 1; } @@ -755,32 +1298,63 @@ static int clear_function_break(Module *m, BeamInstr *pc, BeamInstr break_op) { ** returned. The program counter must point to the first executable ** (breakpoint) instruction of the function. */ -static BpData *is_break(BeamInstr *pc, BeamInstr break_op) { + +BpData *erts_get_time_break(Process *p, BeamInstr *pc) { + return get_break(p, pc, (BeamInstr) BeamOp(op_i_time_breakpoint)); +} + +static BpData *get_break(Process *p, BeamInstr *pc, BeamInstr break_op) { ASSERT(pc[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); if (! erts_is_native_break(pc)) { - BpData *bd = (BpData *) pc[-4]; - - if (break_op == 0) { - return bd; - } - if (*pc == break_op) { - ASSERT(bd); - return bd->next; - } - if (! bd){ + BpData **rs = (BpData **) pc[-4]; + BpData *bd = NULL, *ebd = NULL; + + if (! rs) { return NULL; } + + bd = ebd = rs[bp_sched2ix_proc(p)]; + ASSERT(bd); + if (bd->this_instr == break_op) { + return bd; + } + bd = bd->next; - while (bd != (BpData *) pc[-4]) { + while (bd != ebd) { ASSERT(bd); - if (bd->orig_instr == break_op) { - bd = bd->next; + if (bd->this_instr == break_op) { ASSERT(bd); return bd; - } else { - bd = bd->next; } + bd = bd->next; } } return NULL; } + +static BpData *is_break(BeamInstr *pc, BeamInstr break_op) { + BpData **rs = (BpData **) pc[-4]; + BpData *bd = NULL, *ebd = NULL; + ASSERT(pc[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + + if (! rs) { + return NULL; + } + + bd = ebd = rs[bp_sched2ix()]; + ASSERT(bd); + if ( (break_op == 0) || (bd->this_instr == break_op)) { + return bd; + } + + bd = bd->next; + while (bd != ebd) { + ASSERT(bd); + if (bd->this_instr == break_op) { + ASSERT(bd); + return bd; + } + bd = bd->next; + } + return NULL; +} diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 786cbbe9d9..b5d5b3c203 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -27,28 +27,46 @@ -/* -** Common struct to all bp_data_* -** -** Two gotchas: -** -** 1) The type of bp_data structure in the ring is deduced from the -** orig_instr field of the structure _before_ in the ring, except for -** the first structure in the ring that has its instruction in -** pc[0] of the code to execute. -** -** 2) pc[-4] points to the _last_ structure in the ring before the -** breakpoints are being executed. -** -** So, as an example, when a breakpointed function starts to execute, -** the first instruction that is a breakpoint instruction at pc[0] finds -** its data at ((BpData *) pc[-4])->next and has to cast that pointer -** to the correct bp_data type. +/* A couple of gotchas: + * + * The breakpoint structure from BeamInstr, + * In beam_emu where the instruction counter pointer, I (or pc), + * points to the *current* instruction. At that time, if the instruction + * is a breakpoint instruction the pc looks like the following, + * + * I[-5] | op_i_func_info_IaaI | scheduler specific entries + * I[-4] | BpData** bpa | --> | BpData * bdas1 | ... | BpData * bdasN | + * I[-3] | Tagged Module | | | + * I[-2] | Tagged Function | V V + * I[-1] | Arity | BpData -> BpData -> BpData -> BpData + * I[0] | The bp instruction | ^ * the bp wheel * | + * |------------------------------ + * + * Common struct to all bp_data_* + * + * 1) The type of bp_data structure in the ring is deduced from the + * orig_instr field of the structure _before_ in the ring, except for + * the first structure in the ring that has its instruction in + * pc[0] of the code to execute. + * This is valid as long as you don't search for the function while it is + * being executed by something else. Or is in the middle of its rotation for + * any other reason. + * A key, the bp beam instruction, is included for this reason. + * + * 2) pc[-4][sched_id - 1] points to the _last_ structure in the ring before the + * breakpoints are being executed. + * + * So, as an example, when a breakpointed function starts to execute, + * the first instruction that is a breakpoint instruction at pc[0] finds + * its data at ((BpData **) pc[-4][sched_id - 1])->next and has to cast that pointer + * to the correct bp_data type. */ + typedef struct bp_data { struct bp_data *next; /* Doubly linked ring pointers */ struct bp_data *prev; /* -"- */ BeamInstr orig_instr; /* The original instruction to execute */ + BeamInstr this_instr; /* key */ } BpData; /* ** All the following bp_data_.. structs must begin the same way @@ -57,26 +75,67 @@ typedef struct bp_data { typedef struct bp_data_trace { struct bp_data *next; struct bp_data *prev; - BeamInstr orig_instr; + BeamInstr orig_instr; + BeamInstr this_instr; /* key */ Binary *match_spec; - Eterm tracer_pid; + Eterm tracer_pid; } BpDataTrace; typedef struct bp_data_debug { struct bp_data *next; struct bp_data *prev; - BeamInstr orig_instr; + BeamInstr orig_instr; + BeamInstr this_instr; /* key */ } BpDataDebug; -typedef struct bp_data_count { /* Call count */ +typedef struct bp_data_count { /* Call count */ struct bp_data *next; struct bp_data *prev; BeamInstr orig_instr; - Sint count; + BeamInstr this_instr; /* key */ + erts_smp_atomic_t acount; } BpDataCount; +typedef struct { + Eterm pid; + Sint count; + Uint s_time; + Uint us_time; +} bp_data_time_item_t; + +typedef struct { + Uint n; + Uint used; + bp_data_time_item_t *item; +} bp_time_hash_t; + +typedef struct bp_data_time { /* Call time */ + struct bp_data *next; + struct bp_data *prev; + BeamInstr orig_instr; + BeamInstr this_instr; /* key */ + Uint pause; + Uint n; + bp_time_hash_t *hash; +} BpDataTime; + +typedef struct { + Uint ms; + Uint s; + Uint us; + Uint *pc; +} process_breakpoint_time_t; /* used within psd */ + extern erts_smp_spinlock_t erts_bp_lock; +#define ERTS_BP_CALL_TIME_SCHEDULE_IN (0) +#define ERTS_BP_CALL_TIME_SCHEDULE_OUT (1) +#define ERTS_BP_CALL_TIME_SCHEDULE_EXITING (2) + +#define ERTS_BP_CALL_TIME_CALL (0) +#define ERTS_BP_CALL_TIME_RETURN (1) +#define ERTS_BP_CALL_TIME_TAIL_CALL (2) + #ifdef ERTS_SMP #define ErtsSmpBPLock(BDC) erts_smp_spin_lock(&erts_bp_lock) #define ErtsSmpBPUnlock(BDC) erts_smp_spin_unlock(&erts_bp_lock) @@ -85,31 +144,46 @@ extern erts_smp_spinlock_t erts_bp_lock; #define ErtsSmpBPUnlock(BDC) #endif -#define ErtsCountBreak(pc,instr_result) \ -do { \ - BpDataCount *bdc = (BpDataCount *) (pc)[-4]; \ - \ +ERTS_INLINE Uint bp_sched2ix(void); + +#ifdef ERTS_SMP +#define bp_sched2ix_proc(p) ((p)->scheduler_data->no - 1) +#else +#define bp_sched2ix_proc(p) (0) +#endif + +#define ErtsCountBreak(p, pc,instr_result) \ +do { \ + BpData **bds = (BpData **) (pc)[-4]; \ + BpDataCount *bdc = NULL; \ + Uint ix = bp_sched2ix_proc( (p) ); \ + long count = 0; \ + \ ASSERT((pc)[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); \ - ASSERT(bdc); \ - bdc = (BpDataCount *) bdc->next; \ - ASSERT(bdc); \ - (pc)[-4] = (BeamInstr) bdc; \ - ErtsSmpBPLock(bdc); \ - if (bdc->count >= 0) bdc->count++; \ - ErtsSmpBPUnlock(bdc); \ - *(instr_result) = bdc->orig_instr; \ + ASSERT(bds); \ + bdc = (BpDataCount *) bds[ix]; \ + bdc = (BpDataCount *) bdc->next; \ + ASSERT(bdc); \ + bds[ix] = (BpData *) bdc; \ + count = erts_smp_atomic_read(&bdc->acount); \ + if (count >= 0) erts_smp_atomic_inc(&bdc->acount); \ + *(instr_result) = bdc->orig_instr; \ } while (0) -#define ErtsBreakSkip(pc,instr_result) \ -do { \ - BpData *bd = (BpData *) (pc)[-4]; \ - \ +#define ErtsBreakSkip(p, pc,instr_result) \ +do { \ + BpData **bds = (BpData **) (pc)[-4]; \ + BpData *bd = NULL; \ + Uint ix = bp_sched2ix_proc( (p) ); \ + \ ASSERT((pc)[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); \ - ASSERT(bd); \ - bd = bd->next; \ - ASSERT(bd); \ - (pc)[-4] = (BeamInstr) bd; \ - *(instr_result) = bd->orig_instr; \ + ASSERT(bds); \ + bd = bds[ix]; \ + ASSERT(bd); \ + bd = bd->next; \ + ASSERT(bd); \ + bds[ix] = bd; \ + *(instr_result) = bd->orig_instr; \ } while (0) enum erts_break_op{ @@ -159,6 +233,17 @@ int erts_is_mtrace_bif(BeamInstr *pc, Binary **match_spec_ret, Eterm *tracer_pid_ret); int erts_is_native_break(BeamInstr *pc); int erts_is_count_break(BeamInstr *pc, Sint *count_ret); +int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *call_time); + +void erts_trace_time_break(Process *p, BeamInstr *pc, BpDataTime *bdt, Uint type); +void erts_schedule_time_break(Process *p, Uint out); +int erts_set_time_break(Eterm mfa[3], int specified, enum erts_break_op); +int erts_clear_time_break(Eterm mfa[3], int specified); + +int erts_is_time_trace_bif(Process *p, BeamInstr *pc, Eterm *call_time); +void erts_set_time_trace_bif(BeamInstr *pc, enum erts_break_op); +void erts_clear_time_trace_bif(BeamInstr *pc); +BpData *erts_get_time_break(Process *p, BeamInstr *pc); BeamInstr *erts_find_local_func(Eterm mfa[3]); diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index d42e74ccc9..c0680086aa 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -228,9 +228,10 @@ BeamInstr* em_call_traced_function; ** for the refering variable (one of these), and rouge references ** will most likely cause chaos. */ -BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ -BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */ -BeamInstr beam_exception_trace[1]; /* UGLY also OpCode(i_return_trace) */ +BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ +BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */ +BeamInstr beam_exception_trace[1]; /* UGLY also OpCode(i_return_trace) */ +BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ /* * All Beam instructions in numerical order. @@ -4403,35 +4404,109 @@ apply_bif_or_nif_epilogue: OpCase(i_count_breakpoint): { BeamInstr real_I; - ErtsCountBreak((BeamInstr *) I, &real_I); + ErtsCountBreak(c_p, (BeamInstr *) I, &real_I); ASSERT(VALID_INSTR(real_I)); Goto(real_I); } + /* need to send mfa instead of bdt pointer + * the pointer might be deallocated. + */ + + OpCase(i_time_breakpoint): { + BeamInstr real_I; + BpData **bds = (BpData **) (I)[-4]; + BpDataTime *bdt = NULL; + Uint ix = 0; +#ifdef ERTS_SMP + ix = c_p->scheduler_data->no - 1; +#else + ix = 0; +#endif + bdt = (BpDataTime *)bds[ix]; + + ASSERT((I)[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); + ASSERT(bdt); + bdt = (BpDataTime *) bdt->next; + ASSERT(bdt); + bds[ix] = (BpData *) bdt; + real_I = bdt->orig_instr; + ASSERT(VALID_INSTR(real_I)); + + if (IS_TRACED_FL(c_p, F_TRACE_CALLS) && !(bdt->pause)) { + if ( (*(c_p->cp) == (BeamInstr) OpCode(i_return_time_trace)) || + (*(c_p->cp) == (BeamInstr) OpCode(return_trace)) || + (*(c_p->cp) == (BeamInstr) OpCode(i_return_to_trace))) { + /* This _IS_ a tail recursive call */ + SWAPOUT; + erts_trace_time_break(c_p, I, bdt, ERTS_BP_CALL_TIME_TAIL_CALL); + SWAPIN; + } else { + SWAPOUT; + erts_trace_time_break(c_p, I, bdt, ERTS_BP_CALL_TIME_CALL); + + /* r register needs to be copied to the array + * for the garbage collector + */ + ASSERT(c_p->htop <= E && E <= c_p->hend); + if (E - 2 < HTOP) { + reg[0] = r(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect(c_p, 2, reg, I[-1]); + PROCESS_MAIN_CHK_LOCKS(c_p); + r(0) = reg[0]; + } + SWAPIN; + + ASSERT(c_p->htop <= E && E <= c_p->hend); + + E -= 2; + E[0] = make_cp(I); + E[1] = make_cp(c_p->cp); /* original return address */ + c_p->cp = (BeamInstr *) make_cp(beam_return_time_trace); + } + } + + Goto(real_I); + } + + OpCase(i_return_time_trace): { + BeamInstr *pc = (BeamInstr *) (UWord) E[0]; + SWAPOUT; + erts_trace_time_break(c_p, pc, NULL, ERTS_BP_CALL_TIME_RETURN); + SWAPIN; + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[1])); + E += 2; + Goto(*I); + } + OpCase(i_trace_breakpoint): if (! IS_TRACED_FL(c_p, F_TRACE_CALLS)) { BeamInstr real_I; - ErtsBreakSkip((BeamInstr *) I, &real_I); + ErtsBreakSkip(c_p, (BeamInstr *) I, &real_I); Goto(real_I); } /* Fall through to next case */ OpCase(i_mtrace_breakpoint): { - Uint real_I; + BeamInstr real_I; Uint32 flags; Eterm tracer_pid; - Uint *cpp; + BeamInstr *cpp; int return_to_trace = 0, need = 0; flags = 0; SWAPOUT; reg[0] = r(0); if (*(c_p->cp) == (BeamInstr) OpCode(return_trace)) { - cpp = (Uint*)&E[2]; - } else if (*(c_p->cp) - == (BeamInstr) OpCode(i_return_to_trace)) { + cpp = (BeamInstr*)&E[2]; + } else if (*(c_p->cp) == (BeamInstr) OpCode(i_return_to_trace)) { return_to_trace = !0; - cpp = (Uint*)&E[0]; + cpp = (BeamInstr*)&E[0]; + } else if (*(c_p->cp) == (BeamInstr) OpCode(i_return_time_trace)) { + return_to_trace = !0; + cpp = (BeamInstr*)&E[0]; } else { cpp = NULL; } @@ -4448,6 +4523,8 @@ apply_bif_or_nif_epilogue: } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) { return_to_trace = !0; cpp += 1; + } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_time_trace)) { + cpp += 2; } else break; } @@ -4957,13 +5034,15 @@ apply_bif_or_nif_epilogue: em_call_error_handler = OpCode(call_error_handler); em_call_traced_function = OpCode(call_traced_function); em_apply_bif = OpCode(apply_bif); - beam_apply[0] = (BeamInstr) OpCode(i_apply); - beam_apply[1] = (BeamInstr) OpCode(normal_exit); - beam_exit[0] = (BeamInstr) OpCode(error_action_code); - beam_continue_exit[0] = (BeamInstr) OpCode(continue_exit); - beam_return_to_trace[0] = (BeamInstr) OpCode(i_return_to_trace); - beam_return_trace[0] = (BeamInstr) OpCode(return_trace); - beam_exception_trace[0] = (BeamInstr) OpCode(return_trace); /* UGLY */ + + beam_apply[0] = (BeamInstr) OpCode(i_apply); + beam_apply[1] = (BeamInstr) OpCode(normal_exit); + beam_exit[0] = (BeamInstr) OpCode(error_action_code); + beam_continue_exit[0] = (BeamInstr) OpCode(continue_exit); + beam_return_to_trace[0] = (BeamInstr) OpCode(i_return_to_trace); + beam_return_trace[0] = (BeamInstr) OpCode(return_trace); + beam_exception_trace[0] = (BeamInstr) OpCode(return_trace); /* UGLY */ + beam_return_time_trace[0] = (BeamInstr) OpCode(i_return_time_trace); /* * Enter all BIFs into the export table. @@ -4975,6 +5054,8 @@ apply_bif_or_nif_epilogue: bif_export[i] = ep; ep->code[3] = (BeamInstr) OpCode(apply_bif); ep->code[4] = (BeamInstr) bif_table[i].f; + /* XXX: set func info for bifs */ + ((BeamInstr*)ep->code + 3)[-5] = (BeamInstr) BeamOp(op_i_func_info_IaaI); } return; @@ -5167,14 +5248,18 @@ next_catch(Process* c_p, Eterm *reg) { int active_catches = c_p->catches > 0; int have_return_to_trace = 0; Eterm *ptr, *prev, *return_to_trace_ptr = NULL; - BeamInstr i_return_trace = beam_return_trace[0]; - BeamInstr i_return_to_trace = beam_return_to_trace[0]; + + BeamInstr i_return_trace = beam_return_trace[0]; + BeamInstr i_return_to_trace = beam_return_to_trace[0]; + BeamInstr i_return_time_trace = beam_return_time_trace[0]; + ptr = prev = c_p->stop; ASSERT(is_CP(*ptr)); ASSERT(ptr <= STACK_START(c_p)); if (ptr == STACK_START(c_p)) return NULL; if ((is_not_CP(*ptr) || (*cp_val(*ptr) != i_return_trace && - *cp_val(*ptr) != i_return_to_trace)) + *cp_val(*ptr) != i_return_to_trace && + *cp_val(*ptr) != i_return_time_trace )) && c_p->cp) { /* Can not follow cp here - code may be unloaded */ BeamInstr *cpp = c_p->cp; @@ -5186,6 +5271,9 @@ next_catch(Process* c_p, Eterm *reg) { } else if (cpp == beam_return_trace) { /* Skip return_trace parameters */ ptr += 2; + } else if (cpp == beam_return_time_trace) { + /* Skip return_trace parameters */ + ptr += 1; } else if (cpp == beam_return_to_trace) { have_return_to_trace = !0; /* Record next cp */ } @@ -5215,6 +5303,13 @@ next_catch(Process* c_p, Eterm *reg) { } have_return_to_trace = !0; /* Record next cp */ return_to_trace_ptr = NULL; + } else if (*cp_val(*prev) == i_return_time_trace) { + /* Skip stack frame variables */ + while (++ptr, ptr < STACK_START(c_p) && is_not_CP(*ptr)) { + if (is_catch(*ptr) && active_catches) goto found_catch; + } + /* Skip return_trace parameters */ + ptr += 1; } else { if (have_return_to_trace) { /* Record this cp as possible return_to trace cp */ diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index f8823b85fe..16ae643ed9 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -2897,17 +2897,10 @@ unsigned long erts_alc_test(unsigned long op, } case 0xf10: { ethr_tid *tid = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(ethr_tid)); -#ifdef ERTS_ENABLE_LOCK_COUNT - if (erts_lcnt_thr_create(tid, - (void * (*)(void *)) a1, - (void *) a2, - NULL) != 0) -#else if (ethr_thr_create(tid, (void * (*)(void *)) a1, (void *) a2, NULL) != 0) -#endif ERTS_ALC_TEST_ABORT; return (unsigned long) tid; } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 70d0e91a2c..48cda52612 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1892,6 +1892,37 @@ c_compiler_used(Eterm **hpp, Uint *szp) } +static int is_snif_term(Eterm module_atom) { + int i; + Atom *a = atom_tab(atom_val(module_atom)); + char *aname = (char *) a->name; + + /* if a->name has a '.' then the bif (snif) is bogus i.e a package */ + for (i = 0; i < a->len; i++) { + if (aname[i] == '.') + return 0; + } + + return 1; +} + +static Eterm build_snif_term(Eterm **hpp, Uint *szp, int ix, Eterm res) { + Eterm tup; + tup = erts_bld_tuple(hpp, szp, 3, bif_table[ix].module, bif_table[ix].name, make_small(bif_table[ix].arity)); + res = erts_bld_cons( hpp, szp, tup, res); + return res; +} + +static Eterm build_snifs_term(Eterm **hpp, Uint *szp, Eterm res) { + int i; + for (i = 0; i < BIF_SIZE; i++) { + if (is_snif_term(bif_table[i].module)) { + res = build_snif_term(hpp, szp, i, res); + } + } + return res; +} + BIF_RETTYPE system_info_1(BIF_ALIST_1) { Eterm res; @@ -1940,6 +1971,15 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(db_get_trace_control_word_0(BIF_P)); } else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) { BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false); + } else if (ERTS_IS_ATOM_STR("snifs", BIF_ARG_1)) { + Uint size = 0; + Uint *szp; + + szp = &size; + build_snifs_term(NULL, szp, NIL); + hp = HAlloc(BIF_P, size); + res = build_snifs_term(&hp, NULL, NIL); + BIF_RET(res); } else if (BIF_ARG_1 == am_sequential_tracer) { val = erts_get_system_seq_tracer(); ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false) diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 7fe4410e0d..443cac9033 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -40,8 +40,7 @@ #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) -static erts_smp_mtx_t trace_pattern_mutex; -const struct trace_pattern_flags erts_trace_pattern_flags_off = {0, 0, 0, 0}; +const struct trace_pattern_flags erts_trace_pattern_flags_off = {0, 0, 0, 0, 0}; static int erts_default_trace_pattern_is_on; static Binary *erts_default_match_spec; static Binary *erts_default_meta_match_spec; @@ -65,7 +64,6 @@ static void clear_trace_bif(int bif_index); void erts_bif_trace_init(void) { - erts_smp_mtx_init(&trace_pattern_mutex, "trace_pattern"); erts_default_trace_pattern_is_on = 0; erts_default_match_spec = NULL; erts_default_meta_match_spec = NULL; @@ -186,6 +184,14 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) flags.breakpoint = 1; flags.call_count = 1; break; + case am_call_time: + if (is_global) { + goto error; + } + flags.breakpoint = 1; + flags.call_time = 1; + break; + default: goto error; } @@ -195,8 +201,8 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) goto error; } - if (match_prog_set && !flags.local && !flags.meta && flags.call_count) { - /* A match prog is not allowed with just call_count */ + if (match_prog_set && !flags.local && !flags.meta && (flags.call_count || flags.call_time)) { + /* A match prog is not allowed with just call_count or call_time*/ goto error; } @@ -235,6 +241,8 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) |= flags.meta; erts_default_trace_pattern_flags.call_count |= (on == 1) ? flags.call_count : 0; + erts_default_trace_pattern_flags.call_time + |= (on == 1) ? flags.call_time : 0; } else { erts_default_trace_pattern_flags.local &= ~flags.local; @@ -242,10 +250,13 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) &= ~flags.meta; erts_default_trace_pattern_flags.call_count &= ~flags.call_count; + erts_default_trace_pattern_flags.call_time + &= ~flags.call_time; if (! (erts_default_trace_pattern_flags.breakpoint = erts_default_trace_pattern_flags.local | erts_default_trace_pattern_flags.meta | - erts_default_trace_pattern_flags.call_count)) { + erts_default_trace_pattern_flags.call_count | + erts_default_trace_pattern_flags.call_time)) { erts_default_trace_pattern_is_on = !!on; /* i.e off */ } } @@ -267,8 +278,9 @@ trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) if (on) { if (on != 1) { flags.call_count = 0; + flags.call_time = 0; } - flags.breakpoint = flags.local | flags.meta | flags.call_count; + flags.breakpoint = flags.local | flags.meta | flags.call_count | flags.call_time; erts_default_trace_pattern_flags = flags; /* Struct copy */ erts_default_trace_pattern_is_on = !!flags.breakpoint; } @@ -336,7 +348,6 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, struct trace_pattern_flags *trace_pattern_flags, Eterm *meta_tracer_pid) { - erts_smp_mtx_lock(&trace_pattern_mutex); if (trace_pattern_is_on) *trace_pattern_is_on = erts_default_trace_pattern_is_on; if (match_spec) @@ -347,12 +358,10 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, *trace_pattern_flags = erts_default_trace_pattern_flags; if (meta_tracer_pid) *meta_tracer_pid = erts_default_meta_tracer_pid; - erts_smp_mtx_unlock(&trace_pattern_mutex); } - Uint erts_trace_flag2bit(Eterm flag) { @@ -380,7 +389,7 @@ erts_trace_flag2bit(Eterm flag) default: return 0; } } - + /* Scan the argument list and sort out the trace flags. ** ** Returns !0 on success, 0 on failure. @@ -931,6 +940,7 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) #define FUNC_TRACE_LOCAL_TRACE (1<<2) #define FUNC_TRACE_META_TRACE (1<<3) #define FUNC_TRACE_COUNT_TRACE (1<<4) +#define FUNC_TRACE_TIME_TRACE (1<<5) /* * Returns either FUNC_TRACE_NOEXIST, FUNC_TRACE_UNTRACED, * FUNC_TRACE_GLOBAL_TRACE, or, @@ -945,11 +955,13 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) * * If the return value contains FUNC_TRACE_COUNT_TRACE, *count is set. */ -static int function_is_traced(Eterm mfa[3], - Binary **ms, /* out */ - Binary **ms_meta, /* out */ +static int function_is_traced(Process *p, + Eterm mfa[3], + Binary **ms, /* out */ + Binary **ms_meta, /* out */ Eterm *tracer_pid_meta, /* out */ - Sint *count) /* out */ + Sint *count, /* out */ + Eterm *call_time) /* out */ { Export e; Export* ep; @@ -980,10 +992,13 @@ static int function_is_traced(Eterm mfa[3], r |= FUNC_TRACE_LOCAL_TRACE; *ms = ep->match_prog_set; } - if (erts_is_mtrace_bif(ep->code+3, ms_meta, + if (erts_is_mtrace_break(ep->code+3, ms_meta, tracer_pid_meta)) { r |= FUNC_TRACE_META_TRACE; } + if (erts_is_time_break(p, ep->code+3, call_time)) { + r |= FUNC_TRACE_TIME_TRACE; + } } return r ? r : FUNC_TRACE_UNTRACED; } @@ -1001,7 +1016,9 @@ static int function_is_traced(Eterm mfa[3], | (erts_is_mtrace_break(code, ms_meta, tracer_pid_meta) ? FUNC_TRACE_META_TRACE : 0) | (erts_is_count_break(code, count) - ? FUNC_TRACE_COUNT_TRACE : 0); + ? FUNC_TRACE_COUNT_TRACE : 0) + | (erts_is_time_break(p, code, call_time) + ? FUNC_TRACE_TIME_TRACE : 0); return r ? r : FUNC_TRACE_UNTRACED; } @@ -1020,6 +1037,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) Eterm match_spec = am_false; Eterm retval = am_false; Eterm meta = am_false; + Eterm call_time = NIL; int r; @@ -1039,7 +1057,22 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) mfa[1] = tp[2]; mfa[2] = signed_val(tp[3]); - r = function_is_traced(mfa, &ms, &ms_meta, &meta, &count); +#ifdef ERTS_SMP + if ( (key == am_call_time) || (key == am_all)) { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + } +#endif + + r = function_is_traced(p, mfa, &ms, &ms_meta, &meta, &count, &call_time); + +#ifdef ERTS_SMP + if ( (key == am_call_time) || (key == am_all)) { + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + } +#endif + switch (r) { case FUNC_TRACE_NOEXIST: UnUseTmpHeap(3,p); @@ -1092,8 +1125,13 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) erts_make_integer(count, p); } break; + case am_call_time: + if (r & FUNC_TRACE_TIME_TRACE) { + retval = call_time; + } + break; case am_all: { - Eterm match_spec_meta = am_false, c = am_false, t; + Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false; if (ms) { match_spec = MatchSetGetSource(ms); @@ -1111,10 +1149,15 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) erts_make_integer(-count-1, p) : erts_make_integer(count, p); } - hp = HAlloc(p, (3+2)*5); + if (r & FUNC_TRACE_TIME_TRACE) { + ct = call_time; + } + hp = HAlloc(p, (3+2)*6); retval = NIL; t = TUPLE2(hp, am_call_count, c); hp += 3; retval = CONS(hp, t, retval); hp += 2; + t = TUPLE2(hp, am_call_time, ct); hp += 3; + retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_meta_match_spec, match_spec_meta); hp += 3; retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_meta, meta); hp += 3; @@ -1210,6 +1253,13 @@ trace_info_on_load(Process* p, Eterm key) } else { return TUPLE2(hp, key, am_false); } + case am_call_time: + hp = HAlloc(p, 3); + if (erts_default_trace_pattern_flags.call_time) { + return TUPLE2(hp, key, am_true); + } else { + return TUPLE2(hp, key, am_false); + } case am_all: { Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t; @@ -1284,6 +1334,7 @@ erts_set_trace_pattern(Eterm* mfa, int specified, for (j = 0; j < specified && mfa[j] == ep->code[j]; j++) { /* Empty loop body */ } + if (j == specified) { if (on) { if (! flags.breakpoint) @@ -1356,6 +1407,12 @@ erts_set_trace_pattern(Eterm* mfa, int specified, erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_GLOBAL; m = 1; } + if (flags.call_time) { + erts_set_time_trace_bif(bif_export[i]->code + 3, on); + /* I don't want to remove any other tracers */ + erts_bif_trace_flags[i] |= BIF_TRACE_AS_CALL_TIME; + m = 1; + } if (erts_bif_trace_flags[i]) { setup_bif_trace(i); } @@ -1375,6 +1432,11 @@ erts_set_trace_pattern(Eterm* mfa, int specified, } m = 1; } + if (flags.call_time) { + erts_clear_time_trace_bif(bif_export[i]->code + 3); + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_CALL_TIME; + m = 1; + } if (! erts_bif_trace_flags[i]) { reset_bif_trace(i); } @@ -1392,6 +1454,7 @@ erts_set_trace_pattern(Eterm* mfa, int specified, erts_clear_trace_break(mfa, specified); erts_clear_mtrace_break(mfa, specified); erts_clear_count_break(mfa, specified); + erts_clear_time_break(mfa, specified); } else { int m = 0; if (flags.local) { @@ -1405,6 +1468,9 @@ erts_set_trace_pattern(Eterm* mfa, int specified, if (flags.call_count) { m = erts_set_count_break(mfa, specified, on); } + if (flags.call_time) { + m = erts_set_time_break(mfa, specified, on); + } /* All assignments to 'm' above should give the same value, * so just use the last */ matches += m; @@ -1420,6 +1486,9 @@ erts_set_trace_pattern(Eterm* mfa, int specified, if (flags.call_count) { m = erts_clear_count_break(mfa, specified); } + if (flags.call_time) { + m = erts_clear_time_break(mfa, specified); + } /* All assignments to 'm' above should give the same value, * so just use the last */ matches += m; @@ -1536,7 +1605,7 @@ static void reset_bif_trace(int bif_index) { ASSERT(ExportIsBuiltIn(ep)); ASSERT(ep->code[4]); ASSERT(! ep->match_prog_set); - ASSERT(! erts_is_mtrace_bif((BeamInstr *)ep->code+3, NULL, NULL)); + ASSERT(! erts_is_mtrace_break((BeamInstr *)ep->code+3, NULL, NULL)); ep->code[4] = (BeamInstr) bif_table[bif_index].f; } diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index 50d8c25c46..aa37edafd1 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -1,19 +1,19 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2007-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 2007-2010. All Rights Reserved. + * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in * compliance with the License. You should have received a copy of the * Erlang Public License along with this software. If not, it can be * retrieved online at http://www.erlang.org/. - * + * * Software distributed under the License is distributed on an "AS IS" * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See * the License for the specific language governing rights and limitations * under the License. - * + * * %CopyrightEnd% */ @@ -603,11 +603,7 @@ erl_drv_thread_create(char *name, dtid->name = ((char *) dtid) + sizeof(struct ErlDrvTid_); sys_strcpy(dtid->name, name); } -#ifdef ERTS_ENABLE_LOCK_COUNT - res = erts_lcnt_thr_create(&dtid->tid, erl_drv_thread_wrapper, dtid, use_opts); -#else res = ethr_thr_create(&dtid->tid, erl_drv_thread_wrapper, dtid, use_opts); -#endif if (res != 0) { erts_free(ERTS_ALC_T_DRV_TID, dtid); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 2ee802cf3e..4a4507b212 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -702,6 +702,10 @@ early_init(int *argc, char **argv) /* #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_late_init(); #endif + +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_late_init(); +#endif #if defined(HIPE) hipe_signal_init(); /* must be done very early */ diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 6ff5c1b9da..cee470ae37 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -105,7 +105,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "node_table", NULL }, { "dist_table", NULL }, { "sys_tracers", NULL }, - { "trace_pattern", NULL }, { "module_tab", NULL }, { "export_tab", NULL }, { "fun_tab", NULL }, diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index 0d7e1335c1..26028aeefc 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -257,6 +257,10 @@ void erts_lcnt_init() { erts_lcnt_clear_counters(); } +void erts_lcnt_late_init() { + erts_thr_install_exit_handler(erts_lcnt_thread_exit_handler); +} + /* list operations */ /* BEGIN ASSUMPTION: lcnt_data_lock taken */ @@ -570,36 +574,26 @@ void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res) { /* thread operations */ -static void *lcnt_thr_init(erts_lcnt_thread_data_t *eltd) { - void *(*function)(void *); - void *argument; - void *res; - function = eltd->function; - argument = eltd->argument; - - ethr_tsd_set(lcnt_thr_data_key, eltd); - - res = (void *)function(argument); - free(eltd); - return (void *)res; -} - - - -int erts_lcnt_thr_create(ethr_tid *tid, void * (*function)(void *), void *arg, ethr_thr_opts *opts) { +void erts_lcnt_thread_setup(void) { erts_lcnt_thread_data_t *eltd; - + lcnt_lock(); /* lock for thread id global update */ eltd = lcnt_thread_data_alloc(); lcnt_unlock(); - - eltd->function = function; - eltd->argument = arg; - - return ethr_thr_create(tid, (void *)lcnt_thr_init, (void *)eltd, opts); + ASSERT(eltd); + ethr_tsd_set(lcnt_thr_data_key, eltd); } +void erts_lcnt_thread_exit_handler() { + erts_lcnt_thread_data_t *eltd; + + eltd = ethr_tsd_get(lcnt_thr_data_key); + + if (eltd) { + free(eltd); + } +} /* bindings for bifs */ diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index e3044c371f..6306580ae4 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -155,11 +155,6 @@ typedef struct { erts_lcnt_time_t timer; /* timer */ int timer_set; /* bool */ int lock_in_conflict; /* bool */ - - /* function pointer */ - void *(*function)(void *); - void *argument; - } erts_lcnt_thread_data_t; /* globals */ @@ -169,6 +164,11 @@ extern Uint16 erts_lcnt_rt_options; /* function declerations */ void erts_lcnt_init(void); +void erts_lcnt_late_init(void); + +/* thread operations */ +void erts_lcnt_thread_setup(void); +void erts_lcnt_thread_exit_handler(void); /* list operations (local) */ erts_lcnt_lock_list_t *erts_lcnt_list_init(void); @@ -194,12 +194,7 @@ void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option); void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option); void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res); -/* thread operations */ - -int erts_lcnt_thr_create(ethr_tid *tid, void * (*function)(void *), void *arg, ethr_thr_opts *opts); - /* bif interface */ - Uint16 erts_lcnt_set_rt_opt(Uint16 opt); Uint16 erts_lcnt_clear_rt_opt(Uint16 opt); void erts_lcnt_clear_counters(void); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 75de00d4c1..3d63fa1caf 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1546,7 +1546,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif); } else { /* Function traced, patch the original instruction word */ - BpData* bp = (BpData*) code_ptr[1]; + BpData** bps = (BpData**) code_ptr[1]; + BpData* bp = (BpData*) bps[bp_sched2ix()]; bp->orig_instr = (BeamInstr) BeamOp(op_call_nif); } code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 055733ac49..bae17d1569 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -38,6 +38,7 @@ #include "erl_instrument.h" #include "erl_threads.h" #include "erl_binary.h" +#include "beam_bp.h" #define ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED (2000*CONTEXT_REDS) #define ERTS_RUNQ_CALL_CHECK_BALANCE_REDS \ @@ -392,7 +393,12 @@ erts_pre_init_process(void) erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].get_locks = ERTS_PSD_DIST_ENTRY_GET_LOCKS; erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks - = ERTS_PSD_DIST_ENTRY_GET_LOCKS; + = ERTS_PSD_DIST_ENTRY_SET_LOCKS; + + erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].get_locks + = ERTS_PSD_CALL_TIME_BP_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].set_locks + = ERTS_PSD_CALL_TIME_BP_SET_LOCKS; /* Check that we have locks for all entries */ for (ix = 0; ix < ERTS_PSD_SIZE; ix++) { @@ -3108,11 +3114,7 @@ erts_start_schedulers(void) ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(actual); actual++; ASSERT(actual == esdp->no); -#ifdef ERTS_ENABLE_LOCK_COUNT - res = erts_lcnt_thr_create(&esdp->tid,sched_thread_func,(void*)esdp,&opts); -#else res = ethr_thr_create(&esdp->tid,sched_thread_func,(void*)esdp,&opts); -#endif if (res != 0) { actual--; break; @@ -5872,6 +5874,9 @@ Process *schedule(Process *p, int calls) } if (IS_TRACED(p)) { + if (IS_TRACED_FL(p, F_TRACE_CALLS) && p->status != P_FREE) { + erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT); + } switch (p->status) { case P_EXITING: if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) @@ -6308,7 +6313,11 @@ Process *schedule(Process *p, int calls) trace_virtual_sched(p, am_in); break; } + if (IS_TRACED_FL(p, F_TRACE_CALLS)) { + erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_IN); + } } + if (p->status != P_EXITING) p->status = P_RUNNING; @@ -8051,8 +8060,13 @@ erts_do_exit_process(Process* p, Eterm reason) ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); #endif - if (IS_TRACED_FL(p,F_TRACE_PROCS)) - trace_proc(p, p, am_exit, reason); + if (IS_TRACED(p)) { + if (IS_TRACED_FL(p, F_TRACE_CALLS)) + erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING); + + if (IS_TRACED_FL(p,F_TRACE_PROCS)) + trace_proc(p, p, am_exit, reason); + } erts_trace_check_exiting(p->id); @@ -8101,6 +8115,8 @@ continue_exit_process(Process *p Eterm reason = p->fvalue; DistEntry *dep; struct saved_calls *scb; + process_breakpoint_time_t *pbt; + #ifdef DEBUG int yield_allowed = 1; #endif @@ -8240,6 +8256,7 @@ continue_exit_process(Process *p ? ERTS_PROC_SET_DIST_ENTRY(p, ERTS_PROC_LOCKS_ALL, NULL) : NULL); scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL); + pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL); erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); processes_busy--; @@ -8282,6 +8299,9 @@ continue_exit_process(Process *p if (scb) erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); + if (pbt) + erts_free(ERTS_ALC_T_BPD, (void *) pbt); + delete_process(p); erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index e2cb523cf5..8f9f7f004e 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -397,8 +397,9 @@ extern ErtsSchedulerData *erts_scheduler_data; #define ERTS_PSD_SAVED_CALLS_BUF 1 #define ERTS_PSD_SCHED_ID 2 #define ERTS_PSD_DIST_ENTRY 3 +#define ERTS_PSD_CALL_TIME_BP 4 -#define ERTS_PSD_SIZE 4 +#define ERTS_PSD_SIZE 5 typedef struct { void *data[ERTS_PSD_SIZE]; @@ -419,6 +420,9 @@ typedef struct { #define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_CALL_TIME_BP_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_CALL_TIME_BP_SET_LOCKS ERTS_PROC_LOCK_MAIN + typedef struct { ErtsProcLocks get_locks; ErtsProcLocks set_locks; @@ -1208,6 +1212,12 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) #define ERTS_PROC_SET_SAVED_CALLS_BUF(P, L, SCB) \ ((struct saved_calls *) erts_psd_set((P), (L), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB))) +#define ERTS_PROC_GET_CALL_TIME(P) \ + ((process_breakpoint_time_t *) erts_psd_get((P), ERTS_PSD_CALL_TIME_BP)) +#define ERTS_PROC_SET_CALL_TIME(P, L, PBT) \ + ((process_breakpoint_time_t *) erts_psd_set((P), (L), ERTS_PSD_CALL_TIME_BP, (void *) (PBT))) + + ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, ErtsProcLocks plocks, diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 21f85bd045..35b338c6eb 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -294,11 +294,7 @@ erts_thr_create(erts_tid_t *tid, void * (*func)(void *), void *arg, erts_thr_opts_t *opts) { #ifdef USE_THREADS -#ifdef ERTS_ENABLE_LOCK_COUNT - int res = erts_lcnt_thr_create(tid, func, arg, opts); -#else int res = ethr_thr_create(tid, func, arg, opts); -#endif if (res) erts_thr_fatal_error(res, "create thread"); #endif diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 381a182e39..3043bb1e8c 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -43,8 +43,9 @@ #undef DEBUG_PRINTOUTS #endif -extern Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ -extern Eterm beam_return_trace[1]; /* OpCode(i_return_trace) */ +extern Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ +extern Eterm beam_return_trace[1]; /* OpCode(i_return_trace) */ +extern Eterm beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ /* Pseudo export entries. Never filled in with data, only used to yield unique pointers of the correct type. */ @@ -2116,6 +2117,7 @@ erts_bif_trace(int bif_index, Process* p, Uint32 flags = 0, flags_meta = 0; int global = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_GLOBAL); int local = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_LOCAL); + int time = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_CALL_TIME); Eterm meta_tracer_pid = NIL; int applying = (I == &(ep->code[3])); /* Yup, the apply code for a bif * is actually in the @@ -2139,6 +2141,17 @@ erts_bif_trace(int bif_index, Process* p, flags_meta = erts_bif_mtrace(p, ep->code+3, args, local, &meta_tracer_pid); } + if (time) { + BpDataTime *bdt = NULL; + BeamInstr *pc = (BeamInstr *)ep->code+3; + + bdt = (BpDataTime *) erts_get_time_break(p, pc); + ASSERT(bdt); + + if (!bdt->pause) { + erts_trace_time_break(p, pc, bdt, ERTS_BP_CALL_TIME_CALL); + } + } /* Restore original continuation pointer (if changed). */ p->cp = cp; @@ -2147,8 +2160,9 @@ erts_bif_trace(int bif_index, Process* p, result = func(p, arg1, arg2, arg3, I); if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { - Uint i_return_trace = beam_return_trace[0]; - Uint i_return_to_trace = beam_return_to_trace[0]; + BeamInstr i_return_trace = beam_return_trace[0]; + BeamInstr i_return_to_trace = beam_return_to_trace[0]; + BeamInstr i_return_time_trace = beam_return_time_trace[0]; Eterm *cpp; /* Maybe advance cp to skip trace stack frames */ for (cpp = p->stop; ; cp = cp_val(*cpp++)) { @@ -2156,6 +2170,10 @@ erts_bif_trace(int bif_index, Process* p, /* Skip stack frame variables */ while (is_not_CP(*cpp)) cpp++; cpp += 2; /* Skip return_trace parameters */ + } else if (*cp == i_return_time_trace) { + /* Skip stack frame variables */ + while (is_not_CP(*cpp)) cpp++; + cpp += 1; /* Skip return_time_trace parameters */ } else if (*cp == i_return_to_trace) { /* A return_to trace message is going to be generated * by normal means, so we do not have to. diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h index 87c1d483f4..c604fdf7c3 100644 --- a/erts/emulator/beam/export.h +++ b/erts/emulator/beam/export.h @@ -37,7 +37,7 @@ typedef struct export void* address; /* Pointer to code for function. */ struct binary* match_prog_set; /* Match program for tracing. */ - Eterm fake_op_func_info_for_hipe[2]; /* MUST be just before code[] */ + BeamInstr fake_op_func_info_for_hipe[2]; /* MUST be just before code[] */ /* * code[0]: Tagged atom for module. * code[1]: Tagged atom for function. @@ -52,11 +52,7 @@ typedef struct export * on_load function that has not been run yet. * Otherwise: 0. */ -#if HALFWORD_HEAP BeamInstr code[5]; -#else - Eterm code[5]; -#endif } Export; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 19dd3d6f97..b4a7a22082 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1741,8 +1741,10 @@ struct trace_pattern_flags { unsigned int local : 1; /* Local call trace breakpoint */ unsigned int meta : 1; /* Metadata trace breakpoint */ unsigned int call_count : 1; /* Fast call count breakpoint */ + unsigned int call_time : 1; /* Fast call time breakpoint */ }; extern const struct trace_pattern_flags erts_trace_pattern_flags_off; +extern int erts_call_time_breakpoint_tracing; int erts_set_trace_pattern(Eterm* mfa, int specified, Binary* match_prog_set, Binary *meta_match_prog_set, int on, struct trace_pattern_flags, @@ -1786,18 +1788,20 @@ extern void erts_match_prog_foreach_offheap(Binary *b, void (*)(ErlOffHeap *, void *), void *); -#define MATCH_SET_RETURN_TRACE 0x1 /* return trace requested */ -#define MATCH_SET_RETURN_TO_TRACE 0x2 /* Misleading name, it is not actually - set by the match program, but by the - breakpoint functions */ -#define MATCH_SET_EXCEPTION_TRACE 0x4 /* exception trace requested */ +#define MATCH_SET_RETURN_TRACE (0x1) /* return trace requested */ +#define MATCH_SET_RETURN_TO_TRACE (0x2) /* Misleading name, it is not actually + set by the match program, but by the + breakpoint functions */ +#define MATCH_SET_EXCEPTION_TRACE (0x4) /* exception trace requested */ #define MATCH_SET_RX_TRACE (MATCH_SET_RETURN_TRACE|MATCH_SET_EXCEPTION_TRACE) /* * Flag values when tracing bif + * Future note: flag field is 8 bits */ -#define BIF_TRACE_AS_LOCAL 0x1 -#define BIF_TRACE_AS_GLOBAL 0x2 -#define BIF_TRACE_AS_META 0x4 +#define BIF_TRACE_AS_LOCAL (0x1) +#define BIF_TRACE_AS_GLOBAL (0x2) +#define BIF_TRACE_AS_META (0x4) +#define BIF_TRACE_AS_CALL_TIME (0x8) extern erts_driver_t vanilla_driver; extern erts_driver_t spawn_driver; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 42c84989c6..a2439d5582 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -84,6 +84,8 @@ i_trace_breakpoint i_mtrace_breakpoint i_debug_breakpoint i_count_breakpoint +i_time_breakpoint +i_return_time_trace i_return_to_trace i_yield i_global_cons diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 50b208848f..151fa06e8e 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -457,6 +457,10 @@ thr_create_prepare_child(void *vtcdp) { erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_thread_setup(); +#endif + #ifndef NO_FPE_SIGNALS /* * We do not want fp exeptions in other threads than the diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index d3921a14f8..bd02cf85eb 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -2986,7 +2986,15 @@ static void ethr_internal_free(void *ptr) { erts_free(ERTS_ALC_T_ETHR_INTERNAL, ptr); } -#endif + +#ifdef ERTS_ENABLE_LOCK_COUNT +static void +thr_create_prepare_child(void *vtcdp) +{ + erts_lcnt_thread_setup(); +} +#endif /* ERTS_ENABLE_LOCK_COUNT */ +#endif /* USE_THREADS */ void erts_sys_pre_init(void) @@ -3000,6 +3008,11 @@ erts_sys_pre_init(void) eid.alloc = ethr_internal_alloc; eid.realloc = ethr_internal_realloc; eid.free = ethr_internal_free; + +#ifdef ERTS_ENABLE_LOCK_COUNT + eid.thread_create_child_func = thr_create_prepare_child; +#endif + erts_thr_init(&eid); #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_init(); diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 97b94c466f..5ec17a5e2a 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -101,6 +101,7 @@ MODULES= \ trace_local_SUITE \ trace_meta_SUITE \ trace_call_count_SUITE \ + trace_call_time_SUITE \ scheduler_SUITE \ old_scheduler_SUITE \ z_SUITE \ diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index c9101b77c2..ab727b7cb1 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -902,7 +902,8 @@ scheduler_suspend_test(Config, Schedulers) -> ?line [SState] = mcall(Node, [fun () -> erlang:system_info(schedulers_state) end]), - ?line {Sched, _, _} = SState, + ?line ?t:format("SState=~p~n", [SState]), + ?line {Sched, SchedOnln, _SchedAvail} = SState, ?line true = is_integer(Sched), ?line [ok] = mcall(Node, [fun () -> sst0_loop(300) end]), ?line [ok] = mcall(Node, [fun () -> sst1_loop(300) end]), @@ -914,6 +915,14 @@ scheduler_suspend_test(Config, Schedulers) -> fun () -> sst2_loop(200) end, fun () -> sst3_loop(Sched, 200) end]), ?line [SState] = mcall(Node, [fun () -> + case Sched == SchedOnln of + false -> + Sched = erlang:system_flag( + schedulers_online, + SchedOnln); + true -> + ok + end, erlang:system_info(schedulers_state) end]), ?line stop_node(Node), diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl new file mode 100644 index 0000000000..7bc91addde --- /dev/null +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -0,0 +1,614 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Define to run outside of test server +%%% +%%% -define(STANDALONE,1). +%%% +%%% +%%% Define for debug output +%%% +%%% -define(debug,1). + +-module(trace_call_time_SUITE). + +%% Exported end user tests + +-export([seq/3, seq_r/3]). +-export([loaded/1, a_function/1, a_called_function/1, dec/1, nif_dec/1]). + +-define(US_ERROR, 10000). +-define(R_ERROR, 0.8). +-define(SINGLE_CALL_US_TIME, 10). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Result examination macros + +-define(CT(P,MFA),{trace,P,call,MFA}). +-define(CTT(P, MFA),{trace_ts,P,call,MFA,{_,_,_}}). +-define(RF(P,MFA,V),{trace,P,return_from,MFA,V}). +-define(RFT(P,MFA,V),{trace_ts,P,return_from,MFA,V,{_,_,_}}). +-define(RT(P,MFA),{trace,P,return_to,MFA}). +-define(RTT(P,MFA),{trace_ts,P,return_to,MFA,{_,_,_}}). + +-ifdef(debug). +-define(dbgformat(A,B),io:format(A,B)). +-else. +-define(dbgformat(A,B),noop). +-endif. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-include("test_server.hrl"). + +%% When run in test server. +-export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([basic/1, on_and_off/1, info/1, + pause_and_restart/1, scheduling/1, called_function/1, combo/1, bif/1, nif/1]). + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:seconds(400)), + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), + timer:now_diff(now(),now()), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), + erlang:trace(all, false, [all]), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(doc) -> + ["Test call count tracing of local function calls."]; +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> [basic, on_and_off, info, + pause_and_restart, scheduling, combo, bif, nif, called_function] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +basic(suite) -> + []; +basic(doc) -> + ["Tests basic call count trace"]; +basic(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + + ?line {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2), + ?line L = lists:reverse(Lr), + + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line Pid ! quit, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +on_and_off(suite) -> + []; +on_and_off(doc) -> + ["Tests turning trace parameters on and off"]; +on_and_off(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 100, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + + ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]), + ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2), + + ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_time]), + ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3), + + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, false, none), + ?line {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, false, none), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [], none), + ?line {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5), + + ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + ?line {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + ?line L = lists:reverse(Lr), + %% + ?line Pid ! quit, + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +info(suite) -> + []; +info(doc) -> + ["Tests the trace_info BIF"]; +info(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]), + ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, L), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + ?line {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time), + ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all), + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +pause_and_restart(suite) -> + []; +pause_and_restart(doc) -> + ["Tests pausing and restarting call time counters"]; +pause_and_restart(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 100, + ?line Pid = setup(), + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, [], none), + ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + ?line ok = check_trace_info({?MODULE, seq, 3}, [], none), + ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3), + %% + ?line Pid ! quit, + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +scheduling(suite) -> + []; +scheduling(doc) -> + ["Tests in/out scheduling of call time counters"]; +scheduling(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000000, + ?line Np = erlang:system_info(schedulers_online), + ?line F = 12, + + %% setup load processes + %% (single, no internal calls) + + ?line erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]), + + ?line Pids = [setup() || _ <- lists:seq(1, F*Np)], + ?line {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}), + ?line [Pid ! quit || Pid <- Pids], + + %% logic dictates that each process will get ~ 1/F of the schedulers time + + ?line {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time), + + ?line lists:foreach(fun (Pid) -> + ?line ok = case check_process_time(lists:keysearch(Pid, 1, CT), M, F, T1) of + schedule_time_error -> + test_server:comment("Warning: Failed time ratio"), + ok; + Other -> Other + end + end, Pids), + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +combo(suite) -> + []; +combo(doc) -> + ["Tests combining local call trace and meta trace with call time trace"]; +combo(Config) when is_list(Config) -> + ?line Self = self(), + ?line Nbc = 3, + ?line MetaMs = [{'_',[],[{return_trace}]}], + ?line Flags = lists:sort([call, return_to]), + ?line LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end), + ?line MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), + + % bifs + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]), + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]), + %% not implemented + %?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), + + ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + %% + ?line {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + ?line {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + ?line {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + ?line {meta_match_spec,MetaMs} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + + %% check empty trace_info for ?MODULE:seq_r/3 + ?line {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all), + ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo), + ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo), + ?line {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo), + ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo), + ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo), + ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfo), + + %% check empty trace_info for erlang:term_to_binary/1 + ?line {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all), + ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif), + ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif), + ?line {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif), + ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif), + %% not implemented + ?line {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif), + %?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), + ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif), + + %% + ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + ?line T0 = now(), + ?line with_bif(Nbc), + ?line T1 = now(), + ?line TimeB = timer:now_diff(T1,T0), + %% + + ?line List = collect(100), + ?line {MetaR, LocalR} = + lists:foldl( + fun ({P,X}, {M,L}) when P == MetaTracer -> + {[X|M],L}; + ({P,X}, {M,L}) when P == LocalTracer -> + {M,[X|L]} + end, + {[],[]}, + List), + ?line Meta = lists:reverse(MetaR), + ?line Local = lists:reverse(LocalR), + + ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,3},[3,2,1]), + ?CTT(Self,{erlang,term_to_binary,[3]}), % bif + ?RFT(Self,{erlang,term_to_binary,1},<<131,97,3>>), + ?CTT(Self,{erlang,term_to_binary,[2]}), + ?RFT(Self,{erlang,term_to_binary,1},<<131,97,2>>) + ] = Meta, + + ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RT(Self,{?MODULE,combo,1}), + ?CT(Self,{erlang,term_to_binary,[3]}), % bif + ?RT(Self,{?MODULE,with_bif,1}), + ?CT(Self,{erlang,term_to_binary,[2]}), + ?RT(Self,{?MODULE,with_bif,1}) + ] = Local, + + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{self(), Nbc - 1, 0, 0}], TimeB), + %% + ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]), + ?line erlang:trace_pattern(on_load, false, [local,meta,call_time]), + ?line erlang:trace(all, false, [all]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +bif(suite) -> + []; +bif(doc) -> + ["Tests tracing of bifs"]; +bif(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000000, + %% + ?line 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]), + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, fun() -> with_bif(M) end), + + ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2), + ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2), + + % disable term2binary + + ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), + + ?line {L, T2} = execute(Pid, fun() -> with_bif(M) end), + + ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2), + ?line ok = check_trace_info({erlang, term_to_binary, 1}, false, none), + + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line Pid ! quit, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +nif(suite) -> + []; +nif(doc) -> + ["Tests tracing of nifs"]; +nif(Config) when is_list(Config) -> + load_nif(Config), + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 1000000, + %% + ?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), + ?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), + ?line Pid = setup(), + ?line {L, T1} = execute(Pid, fun() -> with_nif(M) end), + + % the nif is called M - 1 times, the last time the function with 'with_nif' + % returns ok and does not call the nif. + ?line ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4), + ?line ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/5), + + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line Pid ! quit, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +called_function(suite) -> + []; +called_function(doc) -> + ["Tests combining nested function calls and that the time accumulates to the right function"]; +called_function(Config) when is_list(Config) -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ?line M = 2100, + ?line Pid = setup(), + %% + ?line 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]), + ?line {L, T1} = execute(Pid, {?MODULE, a_function, [M]}), + ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M, 0, 0}], T1), + + ?line 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]), + ?line {L, T2} = execute(Pid, {?MODULE, a_function, [M]}), + ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME), + ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M, 0, 0}], T2), + + + ?line 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]), + ?line {L, T3} = execute(Pid, {?MODULE, a_function, [M]}), + ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME), + ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ), + ?line ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3), + + ?line Pid ! quit, + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + ok. + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% The Tests +%%% + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Local helpers + + +load_nif(Config) -> + ?line Path = ?config(data_dir, Config), + ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + + +%% Stack recursive seq +seq(Stop, Stop, Succ) when is_function(Succ) -> + [Stop]; +seq(Start, Stop, Succ) when is_function(Succ) -> + [Start | seq(Succ(Start), Stop, Succ)]. + + +a_function(1) -> a_called_function(1); +a_function(N) when N > 1 -> a_function(a_called_function(N)). + +a_called_function(N) -> dec(N). + +with_bif(1) -> ok; +with_bif(N) -> + with_bif(erlang:binary_to_term(erlang:term_to_binary(N)) - 1). + +with_nif(0) -> error; +with_nif(1) -> ok; +with_nif(N) -> + with_nif(?MODULE:nif_dec(N)). + + +nif_dec(N) -> 0. + +dec(N) -> + loaded(10000), + N - 1. + +loaded(N) when N > 1 -> loaded(N - 1); +loaded(_) -> 5. + + +%% Tail recursive seq, result list is reversed +seq_r(Start, Stop, Succ) when is_function(Succ) -> + seq_r(Start, Stop, Succ, []). + +seq_r(Stop, Stop, _, R) -> + [Stop | R]; +seq_r(Start, Stop, Succ, R) -> + seq_r(Succ(Start), Stop, Succ, [Start | R]). + +% Check call time tracing data and print mismatches +check_trace_info(Mfa, [{Pid, C,_,_}] = Expect, Time) -> + case erlang:trace_info(Mfa, call_time) of + % Time tests are somewhat problematic. We want to know if Time (EXPECTED_TIME) and S*1000000 + Us (ACTUAL_TIME) + % is the same. + % If the ratio EXPECTED_TIME/ACTUAL_TIME is ~ 1 or if EXPECTED_TIME - ACTUAL_TIME is near zero, the test is ok. + {call_time,[{Pid,C,S,Us}]} when S >= 0, Us >= 0, abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; abs(Time - S*1000000 - Us) < ?US_ERROR -> + ok; + {call_time,[{Pid,C,S,Us}]} -> + Sum = S*1000000 + Us, + io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, should be 1.0)~n", + [Mfa, Expect, Time, S, Us, Sum, Time, Sum - Time, Time/Sum]), + time_error; + Other -> + io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~p~n", [ Mfa, Expect, Time, Other]), + time_count_error + end; +check_trace_info(Mfa, Expect, _) -> + case erlang:trace_info(Mfa, call_time) of + {call_time, Expect} -> + ok; + Other -> + io:format("Expected ~p -> {call_time, ~p}~n - got ~p~n", [Mfa, Expect, Other]), + result_not_expected_error + end. + + +%check process time +check_process_time({value,{Pid, M, S, Us}}, M, F, Time) -> + ?line Sum = S*1000000 + Us, + if + abs(1 - (F/(Time/Sum))) < ?R_ERROR -> + ok; + true -> + io:format("- Pid ~p, Got ratio ~.2f, expected ratio ~w~n", [Pid, Time/Sum,F]), + schedule_time_error + end; +check_process_time(Other, M, _, _) -> + io:format(" - Got ~p, expected count ~w~n", [Other, M]), + error. + + + +%% Message relay process +relay_n(0, _) -> + ok; +relay_n(N, Dest) -> + receive Msg -> + Dest ! {self(), Msg}, + relay_n(N-1, Dest) + end. + + + +%% Collect received messages +collect(Time) -> + Ref = erlang:start_timer(Time, self(), done), + L = lists:reverse(collect([], Ref)), + ?dbgformat("Got: ~p~n",[L]), + L. + +collect(A, 0) -> + receive + Mess -> + collect([Mess | A], 0) + after 0 -> + A + end; +collect(A, Ref) -> + receive + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) + end. + +setup() -> + Pid = spawn_link(fun() -> loop() end), + ?line 1 = erlang:trace(Pid, true, [call]), + Pid. + +execute(Pids, Mfa) when is_list(Pids) -> + T0 = now(), + [P ! {self(), execute, Mfa} || P <- Pids], + As = [receive {P, answer, Answer} -> Answer end || P <- Pids], + T1 = now(), + {As, timer:now_diff(T1,T0)}; +execute(P, Mfa) -> + T0 = now(), + P ! {self(), execute, Mfa}, + A = receive {P, answer, Answer} -> Answer end, + T1 = now(), + {A, timer:now_diff(T1,T0)}. + + + +loop() -> + receive + quit -> + ok; + {Pid, execute, Fun } when is_function(Fun) -> + Pid ! {self(), answer, erlang:apply(Fun, [])}, + loop(); + {Pid, execute, {M, F, A}} -> + Pid ! {self(), answer, erlang:apply(M, F, A)}, + loop() + end. diff --git a/erts/emulator/test/trace_call_time_SUITE_data/Makefile.src b/erts/emulator/test/trace_call_time_SUITE_data/Makefile.src new file mode 100644 index 0000000000..2b2a35bd2c --- /dev/null +++ b/erts/emulator/test/trace_call_time_SUITE_data/Makefile.src @@ -0,0 +1,6 @@ + +NIF_LIBS = trace_nif@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c new file mode 100644 index 0000000000..33b346aab7 --- /dev/null +++ b/erts/emulator/test/trace_call_time_SUITE_data/trace_nif.c @@ -0,0 +1,37 @@ +#include "erl_nif.h" + + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ +} + +static ERL_NIF_TERM nif_dec_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int x = 0; + enif_get_uint(env, argv[0], &x); + return enif_make_int(env, x - 1); +} + + + +static ErlNifFunc nif_funcs[] = +{ + {"nif_dec", 1, nif_dec_1} +}; + +ERL_NIF_INIT(trace_call_time_SUITE,nif_funcs,load,reload,upgrade,unload) diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 74fc0878cf..d1fd9d40e2 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% ===================================================================== @@ -122,6 +122,9 @@ bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1, bitstr_flags/1]). +-export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0, + c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). + %% %% needed by the include file below -- do not move %% diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index d5dfde6514..4642fb68b3 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -29,6 +29,8 @@ %% Erlc interface. -export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]). +-export_type([option/0]). + -include("erl_compile.hrl"). -include("core_parse.hrl"). diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 9b73e08ad8..77005a6f9d 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @author Richard Carlsson <[email protected]> @@ -32,6 +32,8 @@ get/2, is_defined/2, is_empty/1, keys/1, lookup/2, new_key/1, new_key/2, new_keys/2, new_keys/3, size/1, to_list/1]). +-export_type([environment/0]). + -import(erlang, [max/2]). -ifdef(DEBUG). diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index ab1bbe5ade..e3dd690470 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -96,6 +96,9 @@ loop(#server_state{parent = Parent, legal_warnings = LegalWarnings} = State, end; {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); + {AnalPid, ext_types, ExtTypes} -> + send_ext_types(Parent, ExtTypes), + loop(State, Analysis, ExtCalls); {AnalPid, unknown_behaviours, UnknownBehaviour} -> send_unknown_behaviours(Parent, UnknownBehaviour), loop(State, Analysis, ExtCalls); @@ -123,8 +126,7 @@ analysis_start(Parent, Analysis) -> parent = Parent, start_from = Analysis#analysis.start_from, use_contracts = Analysis#analysis.use_contracts, - behaviours = {Analysis#analysis.behaviours_chk, - []} + behaviours = {Analysis#analysis.behaviours_chk, []} }, Files = ordsets:from_list(Analysis#analysis.files), {Callgraph, NoWarn, TmpCServer0} = compile_and_store(Files, State), @@ -132,22 +134,36 @@ analysis_start(Parent, Analysis) -> NewCServer = try NewRecords = dialyzer_codeserver:get_temp_records(TmpCServer0), - OldRecords = dialyzer_plt:get_types(State#analysis_state.plt), + NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer0), + OldRecords = dialyzer_plt:get_types(Plt), + OldExpTypes0 = dialyzer_plt:get_exported_types(Plt), MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), + RemMods = + [case Analysis#analysis.start_from of + byte_code -> list_to_atom(filename:basename(F, ".beam")); + src_code -> list_to_atom(filename:basename(F, ".erl")) + end || F <- Files], + OldExpTypes1 = dialyzer_utils:sets_filter(RemMods, OldExpTypes0), + MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), - TmpCServer2 = dialyzer_utils:process_record_remote_types(TmpCServer1), - dialyzer_contracts:process_contract_remote_types(TmpCServer2) + TmpCServer2 = + dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, + TmpCServer1), + TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), + dialyzer_contracts:process_contract_remote_types(TmpCServer3) catch throw:{error, _ErrorMsg} = Error -> exit(Error) end, - NewPlt = dialyzer_plt:insert_types(Plt, dialyzer_codeserver:get_records(NewCServer)), - State0 = State#analysis_state{plt = NewPlt}, + NewPlt0 = dialyzer_plt:insert_types(Plt, dialyzer_codeserver:get_records(NewCServer)), + ExpTypes = dialyzer_codeserver:get_exported_types(NewCServer), + NewPlt1 = dialyzer_plt:insert_exported_types(NewPlt0, ExpTypes), + State0 = State#analysis_state{plt = NewPlt1}, dump_callgraph(Callgraph, State0, Analysis), State1 = State0#analysis_state{codeserver = NewCServer}, State2 = State1#analysis_state{no_warn_unused = NoWarn}, %% Remove all old versions of the files being analyzed AllNodes = dialyzer_callgraph:all_nodes(Callgraph), - Plt1 = dialyzer_plt:delete_list(NewPlt, AllNodes), + Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes), Exports = dialyzer_codeserver:get_exports(NewCServer), NewCallgraph = case Analysis#analysis.race_detection of @@ -155,6 +171,7 @@ analysis_start(Parent, Analysis) -> false -> Callgraph end, State3 = analyze_callgraph(NewCallgraph, State2#analysis_state{plt = Plt1}), + rcv_and_send_ext_types(Parent), NonExports = sets:subtract(sets:from_list(AllNodes), Exports), NonExportsList = sets:to_list(NonExports), Plt3 = dialyzer_plt:delete_list(State3#analysis_state.plt, NonExportsList), @@ -371,14 +388,28 @@ compile_byte(File, Callgraph, CServer, UseContracts) -> store_core(Mod, Core, NoWarn, Callgraph, CServer) -> Exp = get_exports_from_core(Core), + OldExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer), + NewExpTypes = get_exported_types_from_core(Core), + MergedExpTypes = sets:union(NewExpTypes, OldExpTypes), CServer1 = dialyzer_codeserver:insert_exports(Exp, CServer), - {LabeledCore, CServer2} = label_core(Core, CServer1), - store_code_and_build_callgraph(Mod, LabeledCore, Callgraph, CServer2, NoWarn). + CServer2 = dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, + CServer1), + {LabeledCore, CServer3} = label_core(Core, CServer2), + store_code_and_build_callgraph(Mod, LabeledCore, Callgraph, CServer3, NoWarn). abs_get_nowarn(Abs, M) -> [{M, F, A} || {attribute, _, compile, {nowarn_unused_function, {F, A}}} <- Abs]. +get_exported_types_from_core(Core) -> + Attrs = cerl:module_attrs(Core), + ExpTypes1 = [cerl:concrete(L2) || {L1, L2} <- Attrs, cerl:is_literal(L1), + cerl:is_literal(L2), + cerl:concrete(L1) =:= 'export_type'], + ExpTypes2 = lists:flatten(ExpTypes1), + M = cerl:atom_val(cerl:module_name(Core)), + sets:from_list([{M, F, A} || {F, A} <- ExpTypes2]). + get_exports_from_core(Core) -> Tree = cerl:from_records(Core), Exports1 = cerl:module_exports(Tree), @@ -454,6 +485,19 @@ default_includes(Dir) -> %% Handle Messages %%------------------------------------------------------------------- +rcv_and_send_ext_types(Parent) -> + Self = self(), + Self ! {Self, done}, + ExtTypes = rcv_ext_types(Self, []), + Parent ! {Self, ext_types, ExtTypes}. + +rcv_ext_types(Self, ExtTypes) -> + receive + {Self, ext_types, ExtType} -> + rcv_ext_types(Self, [ExtType|ExtTypes]); + {Self, done} -> lists:usort(ExtTypes) + end. + send_log(Parent, Msg) -> Parent ! {self(), log, Msg}, ok. @@ -476,6 +520,10 @@ send_ext_calls(Parent, ExtCalls) -> Parent ! {self(), ext_calls, ExtCalls}, ok. +send_ext_types(Parent, ExtTypes) -> + Parent ! {self(), ext_types, ExtTypes}, + ok. + send_unknown_behaviours(Parent, UnknownBehaviours) -> Parent ! {self(), unknown_behaviours, UnknownBehaviours}, ok. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 4e8dceaa8e..3fae816cfe 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -156,9 +156,11 @@ check_all_callbacks(Module, Behaviour, Callbacks, State) -> check_all_callbacks(_Module, _Behaviour, [], _State, Acc) -> Acc; -check_all_callbacks(Module, Behaviour, [{Fun, Arity, Spec}|Rest], State, Acc) -> - Records = dialyzer_codeserver:get_records(State#state.codeserver), - case parse_spec(Spec, Records) of +check_all_callbacks(Module, Behaviour, [{Fun, Arity, Spec}|Rest], + #state{codeserver = CServer} = State, Acc) -> + Records = dialyzer_codeserver:get_records(CServer), + ExpTypes = dialyzer_codeserver:get_exported_types(CServer), + case parse_spec(Spec, ExpTypes, Records) of {ok, Fun, Type} -> RetType = erl_types:t_fun_range(Type), ArgTypes = erl_types:t_fun_args(Type), @@ -172,7 +174,7 @@ check_all_callbacks(Module, Behaviour, [{Fun, Arity}|Rest], State, Acc) -> Warns = {spec_missing, [Behaviour, Fun, Arity]}, check_all_callbacks(Module, Behaviour, Rest, State, [Warns|Acc]). -parse_spec(String, Records) -> +parse_spec(String, ExpTypes, Records) -> case erl_scan:string(String) of {ok, Tokens, _} -> case erl_parse:parse(Tokens) of @@ -181,7 +183,8 @@ parse_spec(String, Records) -> {attribute, _, 'spec', {{Fun, _}, [TypeForm|_Constraint]}} -> MaybeRemoteType = erl_types:t_from_form(TypeForm), try - Type = erl_types:t_solve_remote(MaybeRemoteType, Records), + Type = erl_types:t_solve_remote(MaybeRemoteType, ExpTypes, + Records), {ok, Fun, Type} catch throw:{error,Msg} -> {spec_remote_error, Msg} diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index f932f43548..d3de5aaf45 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -59,6 +59,8 @@ put_named_tables/2, put_public_tables/2, put_behaviour_api_calls/2, get_behaviour_api_calls/1]). +-export_type([callgraph/0]). + -include("dialyzer.hrl"). %%---------------------------------------------------------------------- diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index d533e734db..1d02c4f0dc 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -38,6 +38,7 @@ {backend_pid :: pid(), erlang_mode = false :: boolean(), external_calls = [] :: [mfa()], + external_types = [] :: [mfa()], legal_warnings = ordsets:new() :: [dial_warn_tag()], mod_deps = dict:new() :: dict(), output = standard_io :: io:device(), @@ -538,6 +539,8 @@ cl_loop(State, LogCache) -> return_value(State, NewPlt); {BackendPid, ext_calls, ExtCalls} -> cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache); + {BackendPid, ext_types, ExtTypes} -> + cl_loop(State#cl_state{external_types = ExtTypes}, LogCache); {BackendPid, mod_deps, ModDeps} -> NewState = State#cl_state{mod_deps = ModDeps}, cl_loop(NewState, LogCache); @@ -613,6 +616,7 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, false -> print_warnings(State), print_ext_calls(State), + print_ext_types(State), print_unknown_behaviours(State), maybe_close_output_file(State), {RetValue, []}; @@ -649,10 +653,41 @@ do_print_ext_calls(Output, [{M,F,A}|T], Before) -> do_print_ext_calls(_, [], _) -> ok. +print_ext_types(#cl_state{report_mode = quiet}) -> + ok; +print_ext_types(#cl_state{output = Output, + external_calls = Calls, + external_types = Types, + stored_warnings = Warnings, + output_format = Format}) -> + case Types =:= [] of + true -> ok; + false -> + case Warnings =:= [] andalso Calls =:= [] of + true -> io:nl(Output); %% Need to do a newline first + false -> ok + end, + case Format of + formatted -> + io:put_chars(Output, "Unknown types:\n"), + do_print_ext_types(Output, Types, " "); + raw -> + io:put_chars(Output, "%% Unknown types:\n"), + do_print_ext_types(Output, Types, "%% ") + end + end. + +do_print_ext_types(Output, [{M,F,A}|T], Before) -> + io:format(Output, "~s~p:~p/~p\n", [Before,M,F,A]), + do_print_ext_types(Output, T, Before); +do_print_ext_types(_, [], _) -> + ok. + %%print_unknown_behaviours(#cl_state{report_mode = quiet}) -> %% ok; print_unknown_behaviours(#cl_state{output = Output, external_calls = Calls, + external_types = Types, stored_warnings = Warnings, unknown_behaviours = DupBehaviours, legal_warnings = LegalWarnings, @@ -662,7 +697,7 @@ print_unknown_behaviours(#cl_state{output = Output, false -> ok; true -> Behaviours = lists:usort(DupBehaviours), - case Warnings =:= [] andalso Calls =:= [] of + case Warnings =:= [] andalso Calls =:= [] andalso Types =:= [] of true -> io:nl(Output); %% Need to do a newline first false -> ok end, diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 3bc5fadc21..3cf090712c 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -29,15 +29,19 @@ -export([delete/1, finalize_contracts/2, + finalize_exported_types/2, finalize_records/2, get_contracts/1, + get_exported_types/1, get_exports/1, get_records/1, get_next_core_label/1, get_temp_contracts/1, + get_temp_exported_types/1, get_temp_records/1, - insert/3, - insert_exports/2, + insert/3, + insert_exports/2, + insert_temp_exported_types/2, is_exported/2, lookup_mod_code/2, lookup_mfa_code/2, @@ -52,17 +56,21 @@ store_contracts/3, store_temp_contracts/3]). +-export_type([codeserver/0]). + -include("dialyzer.hrl"). %%-------------------------------------------------------------------- --record(codeserver, {table_pid :: pid(), - exports = sets:new() :: set(), % set(mfa()) - next_core_label = 0 :: label(), - records = dict:new() :: dict(), - temp_records = dict:new() :: dict(), - contracts = dict:new() :: dict(), - temp_contracts = dict:new() :: dict()}). +-record(codeserver, {table_pid :: pid(), + exported_types = sets:new() :: set(), % set(mfa()) + temp_exported_types = sets:new() :: set(), % set(mfa()) + exports = sets:new() :: set(), % set(mfa()) + next_core_label = 0 :: label(), + records = dict:new() :: dict(), + temp_records = dict:new() :: dict(), + contracts = dict:new() :: dict(), + temp_contracts = dict:new() :: dict()}). -opaque codeserver() :: #codeserver{}. @@ -84,6 +92,11 @@ insert(Mod, ModCode, CS) -> NewTablePid = table__insert(CS#codeserver.table_pid, Mod, ModCode), CS#codeserver{table_pid = NewTablePid}. +-spec insert_temp_exported_types(set(), codeserver()) -> codeserver(). + +insert_temp_exported_types(Set, CS) -> + CS#codeserver{temp_exported_types = Set}. + -spec insert_exports([mfa()], codeserver()) -> codeserver(). insert_exports(List, #codeserver{exports = Exports} = CS) -> @@ -96,11 +109,26 @@ insert_exports(List, #codeserver{exports = Exports} = CS) -> is_exported(MFA, #codeserver{exports = Exports}) -> sets:is_element(MFA, Exports). +-spec get_exported_types(codeserver()) -> set(). % set(mfa()) + +get_exported_types(#codeserver{exported_types = ExpTypes}) -> + ExpTypes. + +-spec get_temp_exported_types(codeserver()) -> set(). + +get_temp_exported_types(#codeserver{temp_exported_types = TempExpTypes}) -> + TempExpTypes. + -spec get_exports(codeserver()) -> set(). % set(mfa()) get_exports(#codeserver{exports = Exports}) -> Exports. +-spec finalize_exported_types(set(), codeserver()) -> codeserver(). + +finalize_exported_types(Set, CS) -> + CS#codeserver{exported_types = Set, temp_exported_types = sets:new()}. + -spec lookup_mod_code(module(), codeserver()) -> cerl:c_module(). lookup_mod_code(Mod, CS) when is_atom(Mod) -> diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 3486c72748..2bedf99e42 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -33,6 +33,8 @@ process_contract_remote_types/1, store_tmp_contract/5]). +-export_type([file_contract/0, plt_contracts/0]). + %%----------------------------------------------------------------------- -include("dialyzer.hrl"). @@ -50,7 +52,7 @@ %% to expand records and/or remote types that they might contain. %%----------------------------------------------------------------------- --type tmp_contract_fun() :: fun((dict()) -> contract_pair()). +-type tmp_contract_fun() :: fun((set(), dict()) -> contract_pair()). -record(tmp_contract, {contract_funs = [] :: [tmp_contract_fun()], forms = [] :: [{_, _}]}). @@ -140,10 +142,11 @@ sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter). process_contract_remote_types(CodeServer) -> TmpContractDict = dialyzer_codeserver:get_temp_contracts(CodeServer), + ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}}) -> - NewCs = [CFun(RecordDict) || CFun <- CFuns], + NewCs = [CFun(ExpTypes, RecordDict) || CFun <- CFuns], Args = general_domain(NewCs), {File, #contract{contracts = NewCs, args = Args, forms = Forms}} end, @@ -354,9 +357,9 @@ contract_from_form(Forms, RecDict) -> contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], RecDict, TypeAcc, FormAcc) -> TypeFun = - fun(AllRecords) -> + fun(ExpTypes, AllRecords) -> Type = erl_types:t_from_form(Form, RecDict), - NewType = erl_types:t_solve_remote(Type, AllRecords), + NewType = erl_types:t_solve_remote(Type, ExpTypes, AllRecords), {NewType, []} end, NewTypeAcc = [TypeFun | TypeAcc], @@ -366,11 +369,12 @@ contract_from_form([{type, _L1, bounded_fun, [{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left], RecDict, TypeAcc, FormAcc) -> TypeFun = - fun(AllRecords) -> - Constr1 = [constraint_from_form(C, RecDict, AllRecords) || C <- Constr], + fun(ExpTypes, AllRecords) -> + Constr1 = [constraint_from_form(C, RecDict, ExpTypes, AllRecords) + || C <- Constr], VarDict = insert_constraints(Constr1, dict:new()), Type = erl_types:t_from_form(Form, RecDict, VarDict), - NewType = erl_types:t_solve_remote(Type, AllRecords), + NewType = erl_types:t_solve_remote(Type, ExpTypes, AllRecords), {NewType, Constr1} end, NewTypeAcc = [TypeFun | TypeAcc], @@ -380,13 +384,15 @@ contract_from_form([], _RecDict, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. constraint_from_form({type, _, constraint, [{atom, _, is_subtype}, - [Type1, Type2]]}, RecDict, AllRecords) -> + [Type1, Type2]]}, RecDict, + ExpTypes, AllRecords) -> T1 = erl_types:t_from_form(Type1, RecDict), T2 = erl_types:t_from_form(Type2, RecDict), - T3 = erl_types:t_solve_remote(T1, AllRecords), - T4 = erl_types:t_solve_remote(T2, AllRecords), + T3 = erl_types:t_solve_remote(T1, ExpTypes, AllRecords), + T4 = erl_types:t_solve_remote(T2, ExpTypes, AllRecords), {subtype, T3, T4}; -constraint_from_form({type, _, constraint, [{atom,_,Name}, List]}, _RecDict, _) -> +constraint_from_form({type, _, constraint, [{atom,_,Name}, List]}, _RecDict, + _ExpTypes, _AllRecords) -> N = length(List), throw({error, io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}). diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 1ccfaaa52f..a3c7114ee1 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -38,6 +38,8 @@ %% Debug and test interfaces. -export([get_top_level_signatures/2, pp/1]). +-export_type([state/0]). + -include("dialyzer.hrl"). -import(erl_types, diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index e387077a46..c10375eea2 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -39,10 +39,12 @@ from_file/1, get_default_plt/0, get_types/1, + get_exported_types/1, %% insert/3, insert_list/2, insert_contract_list/2, insert_types/2, + insert_exported_types/2, lookup/2, lookup_contract/2, lookup_module/2, @@ -57,6 +59,8 @@ %% Debug utilities -export([pp_non_returning/0, pp_mod/1]). +-export_type([plt/0, plt_info/0]). + %%---------------------------------------------------------------------- -type mod_deps() :: dict(). @@ -70,9 +74,10 @@ %%---------------------------------------------------------------------- --record(plt, {info = table_new() :: dict(), - types = table_new() :: dict(), - contracts = table_new() :: dict()}). +-record(plt, {info = table_new() :: dict(), + types = table_new() :: dict(), + contracts = table_new() :: dict(), + exported_types = sets:new() :: set()}). -opaque plt() :: #plt{}. -include("dialyzer.hrl"). @@ -80,13 +85,14 @@ -type file_md5() :: {file:filename(), binary()}. -type plt_info() :: {[file_md5()], dict()}. --record(file_plt, {version = "" :: string(), - file_md5_list = [] :: [file_md5()], - info = dict:new() :: dict(), - contracts = dict:new() :: dict(), - types = dict:new() :: dict(), - mod_deps :: mod_deps(), - implementation_md5 = [] :: [file_md5()]}). +-record(file_plt, {version = "" :: string(), + file_md5_list = [] :: [file_md5()], + info = dict:new() :: dict(), + contracts = dict:new() :: dict(), + types = dict:new() :: dict(), + exported_types = sets:new() :: set(), + mod_deps :: mod_deps(), + implementation_md5 = [] :: [file_md5()]}). %%---------------------------------------------------------------------- @@ -97,17 +103,21 @@ new() -> -spec delete_module(plt(), module()) -> plt(). -delete_module(#plt{info = Info, types = Types, contracts = Contracts}, Mod) -> +delete_module(#plt{info = Info, types = Types, contracts = Contracts, + exported_types = ExpTypes}, Mod) -> #plt{info = table_delete_module(Info, Mod), types = table_delete_module2(Types, Mod), - contracts = table_delete_module(Contracts, Mod)}. + contracts = table_delete_module(Contracts, Mod), + exported_types = table_delete_module1(ExpTypes, Mod)}. -spec delete_list(plt(), [mfa() | integer()]) -> plt(). -delete_list(#plt{info = Info, types = Types, contracts = Contracts}, List) -> +delete_list(#plt{info = Info, types = Types, contracts = Contracts, + exported_types = ExpTypes}, List) -> #plt{info = table_delete_list(Info, List), types = Types, - contracts = table_delete_list(Contracts, List)}. + contracts = table_delete_list(Contracts, List), + exported_types = ExpTypes}. -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). @@ -150,11 +160,21 @@ lookup(#plt{info = Info}, Label) when is_integer(Label) -> insert_types(PLT, Rec) -> PLT#plt{types = Rec}. +-spec insert_exported_types(plt(), set()) -> plt(). + +insert_exported_types(PLT, Set) -> + PLT#plt{exported_types = Set}. + -spec get_types(plt()) -> dict(). get_types(#plt{types = Types}) -> Types. +-spec get_exported_types(plt()) -> set(). + +get_exported_types(#plt{exported_types = ExpTypes}) -> + ExpTypes. + -type mfa_types() :: {mfa(), erl_types:erl_type(), [erl_types:erl_type()]}. -spec lookup_module(plt(), module()) -> 'none' | {'value', [mfa_types()]}. @@ -207,7 +227,8 @@ from_file(FileName, ReturnInfo) -> ok -> Plt = #plt{info = Rec#file_plt.info, types = Rec#file_plt.types, - contracts = Rec#file_plt.contracts}, + contracts = Rec#file_plt.contracts, + exported_types = Rec#file_plt.exported_types}, case ReturnInfo of false -> Plt; true -> @@ -261,15 +282,18 @@ get_record_from_file(FileName) -> merge_plts(List) -> InfoList = [Info || #plt{info = Info} <- List], TypesList = [Types || #plt{types = Types} <- List], + ExpTypesList = [ExpTypes || #plt{exported_types = ExpTypes} <- List], ContractsList = [Contracts || #plt{contracts = Contracts} <- List], #plt{info = table_merge(InfoList), types = table_merge(TypesList), + exported_types = sets_merge(ExpTypesList), contracts = table_merge(ContractsList)}. -spec to_file(file:filename(), plt(), mod_deps(), {[file_md5()], mod_deps()}) -> 'ok'. to_file(FileName, - #plt{info = Info, types = Types, contracts = Contracts}, + #plt{info = Info, types = Types, contracts = Contracts, + exported_types = ExpTypes}, ModDeps, {MD5, OldModDeps}) -> NewModDeps = dict:merge(fun(_Key, OldVal, NewVal) -> ordsets:union(OldVal, NewVal) @@ -281,6 +305,7 @@ to_file(FileName, info = Info, contracts = Contracts, types = Types, + exported_types = ExpTypes, mod_deps = NewModDeps, implementation_md5 = ImplMd5}, Bin = term_to_binary(Record, [compressed]), @@ -475,6 +500,9 @@ table_delete_module(Plt, Mod) -> (_, _) -> true end, Plt). +table_delete_module1(Plt, Mod) -> + sets:filter(fun({M, _F, _A}) -> M =/= Mod end, Plt). + table_delete_module2(Plt, Mod) -> dict:filter(fun(M, _Val) -> M =/= Mod end, Plt). @@ -526,6 +554,15 @@ table_merge([Plt|Plts], Acc) -> NewAcc = dict:merge(fun(_Key, Val, Val) -> Val end, Plt, Acc), table_merge(Plts, NewAcc). +sets_merge([H|T]) -> + sets_merge(T, H). + +sets_merge([], Acc) -> + Acc; +sets_merge([Plt|Plts], Acc) -> + NewAcc = sets:union(Plt, Acc), + sets_merge(Plts, NewAcc). + %%--------------------------------------------------------------------------- %% Debug utilities. diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 4972967960..fb16e6a75f 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -39,6 +39,8 @@ let_tag_new/2, new/0, put_curr_fun/3, put_fun_args/2, put_race_analysis/2, put_race_list/3]). +-export_type([races/0]). + -include("dialyzer.hrl"). %%% =========================================================================== @@ -1704,7 +1706,6 @@ compare_types(VarArgs, WarnVarArgs, RaceWarnTag, RaceVarMap) -> false -> compare_var_list(VA1, WVA1, RaceVarMap) orelse compare_argtypes(VA2, WVA2) - end end; ?WARN_ETS_LOOKUP_INSERT -> diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 6ea243c26f..338027c5ab 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -42,6 +42,7 @@ merge_records/2, pp_hook/0, process_record_remote_types/1, + sets_filter/2, src_compiler_opts/0 ]). @@ -78,7 +79,7 @@ print_types1([{record, _Name} = Key|T], RecDict) -> %% -type abstract_code() :: [tuple()]. %% XXX: refine --type comp_options() :: [atom()]. %% XXX: only a resticted set of options used +-type comp_options() :: [atom()]. %% XXX: a restricted set of options is used %% ============================================================================ %% @@ -169,7 +170,7 @@ get_record_and_type_info(AbstractCode) -> Module = get_module(AbstractCode), get_record_and_type_info(AbstractCode, Module, dict:new()). --spec get_record_and_type_info(abstract_code(), atom(), dict()) -> +-spec get_record_and_type_info(abstract_code(), module(), dict()) -> {'ok', dict()} | {'error', string()}. get_record_and_type_info(AbstractCode, Module, RecDict) -> @@ -278,13 +279,16 @@ type_record_fields([RecKey|Recs], RecDict) -> process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), + TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer), RecordFun = fun(Key, Value) -> case Key of {record, _Name} -> FieldFun = fun(_Arity, Fields) -> - [{Name, erl_types:t_solve_remote(Field, TempRecords)} || {Name, Field} <- Fields] + [{Name, erl_types:t_solve_remote(Field, TempExpTypes, + TempRecords)} + || {Name, Field} <- Fields] end, orddict:map(FieldFun, Value); _Other -> Value @@ -295,7 +299,8 @@ process_record_remote_types(CServer) -> dict:map(RecordFun, Record) end, NewRecords = dict:map(ModuleFun, TempRecords), - dialyzer_codeserver:finalize_records(NewRecords, CServer). + CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), + dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1). -spec merge_records(dict(), dict()) -> dict(). @@ -353,6 +358,20 @@ get_spec_info([], SpecDict, _RecordsDict, _ModName, _File) -> %% ============================================================================ %% +%% Exported types +%% +%% ============================================================================ + +-spec sets_filter([module()], set()) -> set(). + +sets_filter([], ExpTypes) -> + ExpTypes; +sets_filter([Mod|Mods], ExpTypes) -> + NewExpTypes = sets:filter(fun({M, _F, _A}) -> M =/= Mod end, ExpTypes), + sets_filter(Mods, NewExpTypes). + +%% ============================================================================ +%% %% Util utils %% %% ============================================================================ @@ -361,7 +380,8 @@ get_spec_info([], SpecDict, _RecordsDict, _ModName, _File) -> src_compiler_opts() -> [no_copt, to_core, binary, return_errors, - no_inline, strict_record_tests, strict_record_updates]. + no_inline, strict_record_tests, strict_record_updates, + no_is_record_optimization]. -spec get_module(abstract_code()) -> module(). diff --git a/lib/gs/contribs/bonk/bonk.erl b/lib/gs/contribs/bonk/bonk.erl index 12d94f6c5e..79f01bf659 100644 --- a/lib/gs/contribs/bonk/bonk.erl +++ b/lib/gs/contribs/bonk/bonk.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -33,10 +33,10 @@ run() -> run([ColorMode]) -> % This is for the start script... run(ColorMode); -run(ColorMode) when atom(ColorMode) -> +run(ColorMode) when is_atom(ColorMode) -> GS = gs:start(), - SoundPid=spawn_link(bonk_sound,start,[]), - {H,M,S}=time(), + SoundPid = spawn_link(bonk_sound,start,[]), + {H,M,S} = time(), random:seed(H*13,M*7,S*3), {SqrPids, Bmps, Colors} = create_board(GS, ColorMode), {ScoreL,_File} = get_highscore(), @@ -96,7 +96,7 @@ init(SoundPid, SqrPids, Bmps, Colors) -> game(SoundPid, SqrPids, Bmps, Colors, Scores) -> receive - {gs, _Square, buttonpress, SqrPid, [1 | _Rest]} when pid(SqrPid) -> + {gs, _Square, buttonpress, SqrPid, [1 | _Rest]} when is_pid(SqrPid) -> SqrPid ! bonk, game(SoundPid, SqrPids, Bmps, Colors, Scores); {gs, _Id, buttonpress, _Data, [Butt | _Rest]} when Butt =/= 1 -> @@ -224,11 +224,9 @@ update_score(SoundPid, SqrPids, Scores) -> send_to_all([], _Msg) -> true; - -send_to_all([Pid|Rest],Msg) when pid(Pid) -> +send_to_all([Pid|Rest],Msg) when is_pid(Pid) -> Pid ! Msg, send_to_all(Rest,Msg); - send_to_all([_Else|Rest],Msg) -> send_to_all(Rest,Msg). @@ -460,7 +458,7 @@ update_scorelist(SoundPid, Scores) -> {ScoreL,FileName} = get_highscore(), New_scorelist=update_scorelist_2(ScoreL, Score, 0, SoundPid), display_highscore(New_scorelist), - case file:open(FileName, write) of + case file:open(FileName, [write]) of {error,_} -> true; {ok,FD} -> @@ -559,7 +557,7 @@ display_about() -> {activebg, BGColor}]), gs:create(text, aboutText, aboutCan, [{width, Wid-30}, {coords, [{15, 0}]}, {fg, TextColor}, {justify, center}]), - case file:open(lists:append(bonk_dir(),"bonk.txt"), read) of + case file:open(lists:append(bonk_dir(),"bonk.txt"), [read]) of {ok, Fd} -> write_text(Fd, "", io:get_line(Fd, "")), file:close(Fd); diff --git a/lib/gs/contribs/othello/othello_adt.erl b/lib/gs/contribs/othello/othello_adt.erl index d1d3ec950b..fb60c30b89 100644 --- a/lib/gs/contribs/othello/othello_adt.erl +++ b/lib/gs/contribs/othello/othello_adt.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -375,29 +375,29 @@ is_good(Colour,H,Board) -> false. is_good_0(_,_,false,_) -> false; -is_good_0(_,H,D,_) when integer(H), integer(D), H+D<0 -> false; -is_good_0(_,H,D,_) when integer(H), integer(D), H+D>63 -> false; -is_good_0(black,H,D,Board) when integer(H), integer(D) -> +is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false; +is_good_0(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false; +is_good_0(black,H,D,Board) when is_integer(H), is_integer(D) -> case element((H+D)+1,Board) of white -> is_good_1(black,H+D,dir(H+D,D),Board); _ -> false end; -is_good_0(white,H,D,Board) when integer(H), integer(D) -> +is_good_0(white,H,D,Board) when is_integer(H), is_integer(D) -> case element((H+D)+1,Board) of black -> is_good_1(white,H+D,dir(H+D,D),Board); _ -> false end. is_good_1(_,_,false,_) -> false; -is_good_1(_,H,D,_) when integer(H), integer(D), H+D<0 -> false; -is_good_1(_,H,D,_) when integer(H), integer(D), H+D>63 -> false; -is_good_1(black,H,D,Board) when integer(H), integer(D) -> +is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D<0 -> false; +is_good_1(_,H,D,_) when is_integer(H), is_integer(D), H+D>63 -> false; +is_good_1(black,H,D,Board) when is_integer(H), is_integer(D) -> case element((H+D)+1,Board) of white -> is_good_1(black,H+D,dir(H+D,D),Board); black -> throw(true); _ -> false end; -is_good_1(white,H,D,Board) when integer(H), integer(D) -> +is_good_1(white,H,D,Board) when is_integer(H), is_integer(D) -> case element((H+D)+1,Board) of black -> is_good_1(white,H+D,dir(H+D,D),Board); white -> throw(true); @@ -429,15 +429,15 @@ turn(Colour,H,D,Board) -> Board end. -turn_0(_,H,D,B) when integer(H), integer(D), H+D<0 -> B; -turn_0(_,H,D,B) when integer(H), integer(D), H+D>63 -> B; -turn_0(black,H,D,Board) when integer(H), integer(D) -> +turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D<0 -> B; +turn_0(_,H,D,B) when is_integer(H), is_integer(D), H+D>63 -> B; +turn_0(black,H,D,Board) when is_integer(H), is_integer(D) -> E = H+D, case element(E+1,Board) of white -> turn_0(black,H+D,D,swap(black,E,Board)); _ -> Board end; -turn_0(white,H,D,Board) when integer(H), integer(D) -> +turn_0(white,H,D,Board) when is_integer(H), is_integer(D) -> E = H+D, case element(E+1,Board) of black -> turn_0(white,H+D,D,swap(white,E,Board)); @@ -450,7 +450,7 @@ turn_0(white,H,D,Board) when integer(H), integer(D) -> %% Neighbours are not changed !! %%------------------------------------------------------- -swap(Colour,Pos,Board) when integer(Pos) -> +swap(Colour,Pos,Board) when is_integer(Pos) -> setelement(Pos+1,Board,Colour). score(Pos) -> score1({col(Pos),row(Pos)}). diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 92c36d5bca..758914ff9e 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -178,7 +178,7 @@ t_remote/3, t_string/0, t_struct_from_opaque/2, - t_solve_remote/2, + t_solve_remote/3, t_subst/2, t_subtract/2, t_subtract_list/2, @@ -222,6 +222,8 @@ -export([t_is_identifier/1]). -endif. +-export_type([erl_type/0]). + %%============================================================================= %% %% Definition of the type structure @@ -399,7 +401,8 @@ t_is_none(_) -> false. -spec t_opaque(module(), atom(), [_], erl_type()) -> erl_type(). t_opaque(Mod, Name, Args, Struct) -> - ?opaque(set_singleton(#opaque{mod=Mod, name=Name, args=Args, struct=Struct})). + O = #opaque{mod = Mod, name = Name, args = Args, struct = Struct}, + ?opaque(set_singleton(O)). -spec t_is_opaque(erl_type()) -> boolean(). @@ -428,7 +431,7 @@ t_opaque_structure(?opaque(Elements)) -> t_opaque_module(?opaque(Elements)) -> case ordsets:size(Elements) of 1 -> - [#opaque{mod=Module}] = ordsets:to_list(Elements), + [#opaque{mod = Module}] = ordsets:to_list(Elements), Module; _ -> throw({error, "Unexpected multiple opaque types"}) end. @@ -632,7 +635,7 @@ t_unopaque_on_mismatch(GenType, Type, Opaques) -> case t_inf(GenType, Type) of ?none -> Unopaqued = t_unopaque(Type, Opaques), - %% Unions might be a problem, must investigate. + %% XXX: Unions might be a problem, must investigate. case t_inf(GenType, Unopaqued) of ?none -> Type; _ -> Unopaqued @@ -644,10 +647,10 @@ t_unopaque_on_mismatch(GenType, Type, Opaques) -> module_builtin_opaques(Module) -> [O || O <- all_opaque_builtins(), t_opaque_module(O) =:= Module]. - + %%----------------------------------------------------------------------------- -%% Remote types -%% These types are used for preprocessing they should never reach the analysis stage +%% Remote types: these types are used for preprocessing; +%% they should never reach the analysis stage. -spec t_remote(module(), atom(), [_]) -> erl_type(). @@ -659,126 +662,133 @@ t_remote(Mod, Name, Args) -> t_is_remote(?remote(_)) -> true; t_is_remote(_) -> false. --spec t_solve_remote(erl_type(), dict()) -> erl_type(). +-spec t_solve_remote(erl_type(), set(), dict()) -> erl_type(). -t_solve_remote(Type , Records) -> - {RT, _RR} = t_solve_remote(Type, Records, []), +t_solve_remote(Type, ExpTypes, Records) -> + {RT, _RR} = t_solve_remote(Type, ExpTypes, Records, []), RT. -t_solve_remote(?function(Domain, Range), R, C) -> - {RT1, RR1} = t_solve_remote(Domain, R, C), - {RT2, RR2} = t_solve_remote(Range, R, C), +t_solve_remote(?function(Domain, Range), ET, R, C) -> + {RT1, RR1} = t_solve_remote(Domain, ET, R, C), + {RT2, RR2} = t_solve_remote(Range, ET, R, C), {?function(RT1, RT2), RR1 ++ RR2}; -t_solve_remote(?list(Types, Term, Size), R, C) -> - {RT, RR} = t_solve_remote(Types, R, C), +t_solve_remote(?list(Types, Term, Size), ET, R, C) -> + {RT, RR} = t_solve_remote(Types, ET, R, C), {?list(RT, Term, Size), RR}; -t_solve_remote(?product(Types), R, C) -> - {RL, RR} = list_solve_remote(Types, R, C), +t_solve_remote(?product(Types), ET, R, C) -> + {RL, RR} = list_solve_remote(Types, ET, R, C), {?product(RL), RR}; -t_solve_remote(?opaque(Set), R, C) -> +t_solve_remote(?opaque(Set), ET, R, C) -> List = ordsets:to_list(Set), - {NewList, RR} = opaques_solve_remote(List, R, C), + {NewList, RR} = opaques_solve_remote(List, ET, R, C), {?opaque(ordsets:from_list(NewList)), RR}; -t_solve_remote(?tuple(?any, _, _) = T, _R, _C) -> {T, []}; -t_solve_remote(?tuple(Types, Arity, Tag), R, C) -> - {RL, RR} = list_solve_remote(Types, R, C), +t_solve_remote(?tuple(?any, _, _) = T, _ET, _R, _C) -> {T, []}; +t_solve_remote(?tuple(Types, Arity, Tag), ET, R, C) -> + {RL, RR} = list_solve_remote(Types, ET, R, C), {?tuple(RL, Arity, Tag), RR}; -t_solve_remote(?tuple_set(Set), R, C) -> - {NewSet, RR} = tuples_solve_remote(Set, R, C), +t_solve_remote(?tuple_set(Set), ET, R, C) -> + {NewSet, RR} = tuples_solve_remote(Set, ET, R, C), {?tuple_set(NewSet), RR}; -t_solve_remote(?remote(Set), R, C) -> +t_solve_remote(?remote(Set), ET, R, C) -> RemoteList = ordsets:to_list(Set), - {RL, RR} = list_solve_remote_type(RemoteList, R, C), + {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C), {t_sup(RL), RR}; -t_solve_remote(?union(List), R, C) -> - {RL, RR} = list_solve_remote(List, R, C), +t_solve_remote(?union(List), ET, R, C) -> + {RL, RR} = list_solve_remote(List, ET, R, C), {t_sup(RL), RR}; -t_solve_remote(T, _R, _C) -> {T, []}. +t_solve_remote(T, _ET, _R, _C) -> {T, []}. t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, - R, C) -> + ET, R, C) -> + ArgsLen = length(Args), case dict:find(RemMod, R) of error -> - Msg = io_lib:format("Cannot locate module ~w to " - "resolve the remote type: ~w:~w()~n", - [RemMod, RemMod, Name]), - throw({error, Msg}); + self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, + {t_any(), []}; {ok, RemDict} -> - case lookup_type(Name, RemDict) of - {type, {_Mod, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> - {NewType, NewCycle, NewRR} = - case unfold(RemType, C) of - true -> - List = lists:zip(ArgNames, Args), - TmpVarDict = dict:from_list(List), - {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; - false -> {t_any(), C, [RemType]} - end, - {RT, RR} = t_solve_remote(NewType, R, NewCycle), - RetRR = NewRR ++ RR, - RT1 = - case lists:member(RemType, RetRR) of - true -> t_limit(RT, ?REC_TYPE_LIMIT); - false -> RT - end, - {RT1, RetRR}; - {opaque, {Mod, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> - List = lists:zip(ArgNames, Args), - TmpVarDict = dict:from_list(List), - {Rep, NewCycle, NewRR} = - case unfold(RemType, C) of - true -> {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; - false -> {t_any(), C, [RemType]} - end, - {NewRep, RR} = t_solve_remote(Rep, R, NewCycle), - RetRR = NewRR ++ RR, - RT1 = - case lists:member(RemType, RetRR) of - true -> t_limit(NewRep, ?REC_TYPE_LIMIT); - false -> NewRep - end, - {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, - RemDict, TmpVarDict), - RetRR}; - {type, _} -> - Msg = io_lib:format("Unknown remote type ~w\n", [Name]), - throw({error, Msg}); - {opaque, _} -> - Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), - throw({error, Msg}); - error -> - Msg = io_lib:format("Unable to find remote type ~w:~w()\n", - [RemMod, Name]), + MFA = {RemMod, Name, ArgsLen}, + case sets:is_element(MFA, ET) of + true -> + case lookup_type(Name, RemDict) of + {type, {_Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + {NewType, NewCycle, NewRR} = + case unfold(RemType, C) of + true -> + List = lists:zip(ArgNames, Args), + TmpVarDict = dict:from_list(List), + {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; + false -> {t_any(), C, [RemType]} + end, + {RT, RR} = t_solve_remote(NewType, ET, R, NewCycle), + RetRR = NewRR ++ RR, + RT1 = + case lists:member(RemType, RetRR) of + true -> t_limit(RT, ?REC_TYPE_LIMIT); + false -> RT + end, + {RT1, RetRR}; + {opaque, {Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + List = lists:zip(ArgNames, Args), + TmpVarDict = dict:from_list(List), + {Rep, NewCycle, NewRR} = + case unfold(RemType, C) of + true -> {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; + false -> {t_any(), C, [RemType]} + end, + {NewRep, RR} = t_solve_remote(Rep, ET, R, NewCycle), + RetRR = NewRR ++ RR, + RT1 = + case lists:member(RemType, RetRR) of + true -> t_limit(NewRep, ?REC_TYPE_LIMIT); + false -> NewRep + end, + {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, + RemDict, TmpVarDict), + RetRR}; + {type, _} -> + Msg = io_lib:format("Unknown remote type ~w\n", [Name]), + throw({error, Msg}); + {opaque, _} -> + Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), + throw({error, Msg}); + error -> + Msg = io_lib:format("Unable to find remote type ~w:~w()\n", + [RemMod, Name]), + throw({error, Msg}) + end; + false -> + Msg = io_lib:format("Unable to find exported type ~w:~w/~w\n", + [RemMod, Name, ArgsLen]), throw({error, Msg}) end end. -list_solve_remote([], _R, _C) -> +list_solve_remote([], _ET, _R, _C) -> {[], []}; -list_solve_remote([Type|Types], R, C) -> - {RT, RR1} = t_solve_remote(Type, R, C), - {RL, RR2} = list_solve_remote(Types, R, C), +list_solve_remote([Type|Types], ET, R, C) -> + {RT, RR1} = t_solve_remote(Type, ET, R, C), + {RL, RR2} = list_solve_remote(Types, ET, R, C), {[RT|RL], RR1 ++ RR2}. -list_solve_remote_type([], _R, _C) -> +list_solve_remote_type([], _ET, _R, _C) -> {[], []}; -list_solve_remote_type([Type|Types], R, C) -> - {RT, RR1} = t_solve_remote_type(Type, R, C), - {RL, RR2} = list_solve_remote_type(Types, R, C), +list_solve_remote_type([Type|Types], ET, R, C) -> + {RT, RR1} = t_solve_remote_type(Type, ET, R, C), + {RL, RR2} = list_solve_remote_type(Types, ET, R, C), {[RT|RL], RR1 ++ RR2}. -opaques_solve_remote([], _R, _C) -> +opaques_solve_remote([], _ET, _R, _C) -> {[], []}; -opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], R, C) -> - {RT, RR1} = t_solve_remote(Struct, R, C), - {LOp, RR2} = opaques_solve_remote(Tail, R, C), +opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) -> + {RT, RR1} = t_solve_remote(Struct, ET, R, C), + {LOp, RR2} = opaques_solve_remote(Tail, ET, R, C), {[Remote#opaque{struct = RT}|LOp], RR1 ++ RR2}. -tuples_solve_remote([], _R, _C) -> +tuples_solve_remote([], _ET, _R, _C) -> {[], []}; -tuples_solve_remote([{Sz, Tuples}|Tail], R, C) -> - {RL, RR1} = list_solve_remote(Tuples, R, C), - {LSzTpls, RR2} = tuples_solve_remote(Tail, R, C), +tuples_solve_remote([{Sz, Tuples}|Tail], ET, R, C) -> + {RL, RR1} = list_solve_remote(Tuples, ET, R, C), + {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C), {[{Sz, RL}|LSzTpls], RR1 ++ RR2}. %%----------------------------------------------------------------------------- @@ -802,7 +812,7 @@ t_is_none_or_unit(?unit) -> true; t_is_none_or_unit(_) -> false. %%----------------------------------------------------------------------------- -%% Atoms and the derived type bool +%% Atoms and the derived type boolean %% -spec t_atom() -> erl_type(). @@ -2524,12 +2534,14 @@ t_subst(T, _Dict, _Fun) -> %% Unification %% --spec t_unify(erl_type(), erl_type()) -> {erl_type(), [{_, erl_type()}]}. +-type t_unify_ret() :: {erl_type(), [{_, erl_type()}]}. + +-spec t_unify(erl_type(), erl_type()) -> t_unify_ret(). t_unify(T1, T2) -> t_unify(T1, T2, []). --spec t_unify(erl_type(), erl_type(), [erl_type()]) -> {erl_type(), [{_, erl_type()}]}. +-spec t_unify(erl_type(), erl_type(), [erl_type()]) -> t_unify_ret(). t_unify(T1, T2, Opaques) -> {T, Dict} = t_unify(T1, T2, dict:new(), Opaques), @@ -2542,7 +2554,7 @@ t_unify(?var(Id1) = T, ?var(Id2), Dict, Opaques) -> error -> case dict:find(Id2, Dict) of error -> {T, dict:store(Id2, T, Dict)}; - {ok, Type} -> {Type, t_unify(T, Type, Dict, Opaques)} + {ok, Type} -> t_unify(T, Type, Dict, Opaques) end; {ok, Type1} -> case dict:find(Id2, Dict) of @@ -3339,8 +3351,8 @@ sequence([], [], _Delimiter) -> []; sequence([T], Acc, _Delimiter) -> lists:flatten(lists:reverse([T|Acc])); -sequence([T|Left], Acc, Delimiter) -> - sequence(Left, [T ++ Delimiter|Acc], Delimiter). +sequence([T|Ts], Acc, Delimiter) -> + sequence(Ts, [T ++ Delimiter|Acc], Delimiter). %%============================================================================= %% diff --git a/lib/hipe/flow/hipe_dominators.erl b/lib/hipe/flow/hipe_dominators.erl index 3bfa6d43c4..17357461a5 100644 --- a/lib/hipe/flow/hipe_dominators.erl +++ b/lib/hipe/flow/hipe_dominators.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%------------------------------------------------------------------------ @@ -37,6 +37,8 @@ domFrontier_create/2, domFrontier_get/2]). +-export_type([domTree/0]). + -include("cfg.hrl"). %%======================================================================== diff --git a/lib/hipe/util/hipe_digraph.erl b/lib/hipe/util/hipe_digraph.erl index a62e913fe5..fcfaa64684 100644 --- a/lib/hipe/util/hipe_digraph.erl +++ b/lib/hipe/util/hipe_digraph.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%----------------------------------------------------------------------- @@ -30,6 +30,8 @@ from_list/1, to_list/1, get_parents/2, get_children/2]). -export([reverse_preorder_sccs/1]). +-export_type([hdg/0]). + %%------------------------------------------------------------------------ -type ordset(T) :: [T]. % XXX: temporarily diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 7430a62b1b..9c8df28fec 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -167,6 +167,8 @@ ssl_options() = {verify, code()} | <v>http_option() = {timeout, timeout()} | {connect_timeout, timeout()} | {ssl, ssl_options()} | + {ossl, ssl_options()} | + {essl, ssl_options()} | {autoredirect, boolean()} | {proxy_auth, {userstring(), passwordstring()}} | {version, http_version()} | @@ -222,7 +224,22 @@ ssl_options() = {verify, code()} | <tag><c><![CDATA[ssl]]></c></tag> <item> - <p>If using SSL, these SSL-specific options are used. </p> + <p>This is the default ssl config option, currently defaults to + <c>ossl</c>, see below. </p> + <p>Defaults to <c>[]</c>. </p> + </item> + + <tag><c><![CDATA[ossl]]></c></tag> + <item> + <p>If using the OpenSSL based (old) implementation of SSL, + these SSL-specific options are used. </p> + <p>Defaults to <c>[]</c>. </p> + </item> + + <tag><c><![CDATA[essl]]></c></tag> + <item> + <p>If using the Erlang based (new) implementation of SSL, + these SSL-specific options are used. </p> <p>Defaults to <c>[]</c>. </p> </item> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 7dabeb33e9..847605fe93 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -148,8 +148,13 @@ in the apache like configuration file. </item> - <tag>{socket_type, ip_comm | ssl}</tag> + <tag>{socket_type, ip_comm | ssl | ossl | essl}</tag> <item> + <p>When using ssl, there are several alternatives. + <c>ossl</c> specifically uses the OpenSSL based (old) SSL. + <c>essl</c> specifically uses the Erlang based (new) SSL. + When using <c>ssl</c> it <em>currently</em> defaults to + <c>ossl</c>. </p> <p>Defaults to <c>ip_comm</c>. </p> </item> @@ -267,18 +272,22 @@ text/plain asc txt The <c>common</c> format is one line that looks like this: <c>remotehost rfc931 authuser [date] "request" status bytes</c></p> - <pre>remotehost + <pre> +remotehost Remote rfc931 The client's remote username (RFC 931). authuser - The username with which the user authenticated himself. + The username with which the user authenticated + himself. [date] Date and time of the request (RFC 1123). "request" - The request line exactly as it came from the client(RFC 1945). + The request line exactly as it came from the client + (RFC 1945). status - The HTTP status code returned to the client (RFC 1945). + The HTTP status code returned to the client + (RFC 1945). bytes The content-length of the document transferred. </pre> @@ -286,10 +295,11 @@ bytes <p>The <c>combined</c> format is on line that look like this: <c>remotehost rfc931 authuser [date] "request" status bytes "referer" "user_agent" </c></p> - <pre>"referer" + <pre> +"referer" The url the client was on before - requesting your url. (If it could not be determined a minus - sign will be placed in this field) + requesting your url. (If it could not be determined + a minus sign will be placed in this field) "user_agent" The software the client claims to be using. (If it could not be determined a minus sign will be placed in @@ -389,6 +399,31 @@ bytes and an access to http://your.server.org/image/foo.gif would refer to the file /ftp/pub/image/foo.gif.</item> + <tag>{re_write, {Re, Replacement}}</tag> + + <item> Where Re = string() and Replacement = string(). + The ReWrite property allows documents to be stored in the local file + system instead of the document_root location. URLs are rewritten + by re:replace/3 to produce a path in the local filesystem. + For example: + + <code>{re_write, {"^/[~]([^/]+)(.*)$", "/home/\\1/public\\2"}</code> + + and an access to http://your.server.org/~bob/foo.gif would refer to + the file /home/bob/public/foo.gif. + + In an Apache like configuration file the Re is separated + from Replacement with one single space, and as expected + backslashes do not need to be backslash escaped so the + same example would become: + + <code>ReWrite ^/[~]([^/]+)(.*)$ /home/\1/public\2</code> + + Beware of trailing space in Replacement that will be used. + If you must have a space in Re use e.g the character encoding + <code>\040</code> see <seealso marker="re">re(3)</seealso>. + </item> + <tag>{directory_index, [string()]}</tag> <item> @@ -408,7 +443,7 @@ bytes </taglist> <marker id="cgi_prop"></marker> - <p><em>CGI properties - requires mod_cgi</em></p> + <p><em>CGI properties - requires mod_cgi</em></p> <taglist> <tag>{script_alias, {Alias, RealName}}</tag> <item> Where Alias = string() and RealName = string(). @@ -423,6 +458,19 @@ bytes the server to run the script /web/cgi-bin/foo. </item> + <tag>{script_re_write, {Re, Replacement}}</tag> + <item> Where Re = string() and Replacement = string(). + Has the same behavior as the ReWrite property, except that + it also marks the target directory as containing CGI + scripts. URLs with a path beginning with url-path are mapped to + scripts beginning with directory-filename, for example: + + <code> {script_re_write, {"^/cgi-bin/(\\d+)/", "/web/\\1/cgi-bin/"}</code> + + and an access to http://your.server.org/cgi-bin/17/foo would cause + the server to run the script /web/17/cgi-bin/foo. + </item> + <tag>{script_nocache, boolean()}</tag> <item> diff --git a/lib/inets/doc/src/mod_esi.xml b/lib/inets/doc/src/mod_esi.xml index 6bad77dc0a..3c473d3f94 100644 --- a/lib/inets/doc/src/mod_esi.xml +++ b/lib/inets/doc/src/mod_esi.xml @@ -73,7 +73,8 @@ <v>SessionID = term()</v> <v>Env = [EnvironmentDirectives] ++ ParsedHeader</v> <v>EnvironmentDirectives = {Key,Value}</v> - <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name. <v>Input = string()</v> + <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name</v> + <v>Input = string()</v> </type> <desc> <p>The <c>Module</c> must be found in the code path and export diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index fed42291ab..23ad5c0df0 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,6 +32,67 @@ <file>notes.xml</file> </header> + <section><title>Inets 5.4</title> + + <section><title>Improvements and New Features</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc|httpd] - Now allow the use of the "new" ssl, by using + the <c>essl</c> tag instead. </p> + <p>See the <c>http_option</c> option in the + <seealso marker="httpc#request2">request/4,5</seealso> or + the <seealso marker="httpd#comm_prop">socket-type</seealso> + section of the Communication properties chapter for more info, </p> + <p>Own Id: OTP-7907</p> + </item> + + <item> + <p>Deprecated functions designated to be removed in R14 has been + removed. Also, some new functions has been marked as deprecated + (the old http client api module). </p> + <p>Own Id: OTP-8564</p> + <p>*** POTENTIAL INCOMPATIBILITY ***</p> + </item> + + <item> + <p>[httpd] - Improved mod_alias. + Now able to do better URL rewrites. </p> + <p>See + <seealso marker="httpd#alias_prop">URL aliasing properties</seealso> + and the + <seealso marker="httpd#cgi_prop">CGI properties</seealso> + section(s) for more info, </p> + <p>Own Id: OTP-8573</p> + </item> + + </list> + </section> + + <section><title>Fixed Bugs and Malfunctions</title> + + <p>-</p> + +<!-- + <list> + <item> + <p>[httpd] The server did not fully support the documented module + callback api. Specifically, the load function should be able to + return the atom <c>ok</c>, but this was not accepted. </p> + <p>Own Id: OTP-8359</p> + </item> + + </list> +--> + + </section> + + </section> <!-- 5.4 --> + + <section><title>Inets 5.3.3</title> <section><title>Improvements and New Features</title> @@ -304,6 +365,7 @@ <p>Own Id: OTP-8016</p> <p>*** POTENTIAL INCOMPATIBILITY ***</p> </item> + </list> </section> diff --git a/lib/inets/examples/Makefile b/lib/inets/examples/Makefile index a42b0e38b6..775c449062 100644 --- a/lib/inets/examples/Makefile +++ b/lib/inets/examples/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 2010. All Rights Reserved. +# # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in # compliance with the License. You should have received a copy of the # Erlang Public License along with this software. If not, it can be # retrieved online at http://www.erlang.org/. -# +# # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See # the License for the specific language governing rights and limitations # under the License. -# +# # %CopyrightEnd% # # @@ -21,189 +21,15 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(INETS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN) - -# ---------------------------------------------------- -# Target Specs +# Common Macros # ---------------------------------------------------- -MODULE= -AUTH_FILES = server_root/auth/group \ - server_root/auth/passwd -CGI_FILES = server_root/cgi-bin/printenv.sh -CONF_FILES = server_root/conf/8080.conf \ - server_root/conf/8888.conf \ - server_root/conf/httpd.conf \ - server_root/conf/ssl.conf \ - server_root/conf/mime.types -OPEN_FILES = server_root/htdocs/open/dummy.html -MNESIA_OPEN_FILES = server_root/htdocs/mnesia_open/dummy.html -MISC_FILES = server_root/htdocs/misc/friedrich.html \ - server_root/htdocs/misc/oech.html -SECRET_FILES = server_root/htdocs/secret/dummy.html -MNESIA_SECRET_FILES = server_root/htdocs/mnesia_secret/dummy.html -HTDOCS_FILES = server_root/htdocs/index.html \ - server_root/htdocs/config.shtml \ - server_root/htdocs/echo.shtml \ - server_root/htdocs/exec.shtml \ - server_root/htdocs/flastmod.shtml \ - server_root/htdocs/fsize.shtml \ - server_root/htdocs/include.shtml -ICON_FILES = server_root/icons/README \ - server_root/icons/a.gif \ - server_root/icons/alert.black.gif \ - server_root/icons/alert.red.gif \ - server_root/icons/apache_pb.gif \ - server_root/icons/back.gif \ - server_root/icons/ball.gray.gif \ - server_root/icons/ball.red.gif \ - server_root/icons/binary.gif \ - server_root/icons/binhex.gif \ - server_root/icons/blank.gif \ - server_root/icons/bomb.gif \ - server_root/icons/box1.gif \ - server_root/icons/box2.gif \ - server_root/icons/broken.gif \ - server_root/icons/burst.gif \ - server_root/icons/button1.gif \ - server_root/icons/button10.gif \ - server_root/icons/button2.gif \ - server_root/icons/button3.gif \ - server_root/icons/button4.gif \ - server_root/icons/button5.gif \ - server_root/icons/button6.gif \ - server_root/icons/button7.gif \ - server_root/icons/button8.gif \ - server_root/icons/button9.gif \ - server_root/icons/buttonl.gif \ - server_root/icons/buttonr.gif \ - server_root/icons/c.gif \ - server_root/icons/comp.blue.gif \ - server_root/icons/comp.gray.gif \ - server_root/icons/compressed.gif \ - server_root/icons/continued.gif \ - server_root/icons/dir.gif \ - server_root/icons/down.gif \ - server_root/icons/dvi.gif \ - server_root/icons/f.gif \ - server_root/icons/folder.gif \ - server_root/icons/folder.open.gif \ - server_root/icons/folder.sec.gif \ - server_root/icons/forward.gif \ - server_root/icons/generic.gif \ - server_root/icons/generic.red.gif \ - server_root/icons/generic.sec.gif \ - server_root/icons/hand.right.gif \ - server_root/icons/hand.up.gif \ - server_root/icons/htdig.gif \ - server_root/icons/icon.sheet.gif \ - server_root/icons/image1.gif \ - server_root/icons/image2.gif \ - server_root/icons/image3.gif \ - server_root/icons/index.gif \ - server_root/icons/layout.gif \ - server_root/icons/left.gif \ - server_root/icons/link.gif \ - server_root/icons/movie.gif \ - server_root/icons/p.gif \ - server_root/icons/patch.gif \ - server_root/icons/pdf.gif \ - server_root/icons/pie0.gif \ - server_root/icons/pie1.gif \ - server_root/icons/pie2.gif \ - server_root/icons/pie3.gif \ - server_root/icons/pie4.gif \ - server_root/icons/pie5.gif \ - server_root/icons/pie6.gif \ - server_root/icons/pie7.gif \ - server_root/icons/pie8.gif \ - server_root/icons/portal.gif \ - server_root/icons/poweredby.gif \ - server_root/icons/ps.gif \ - server_root/icons/quill.gif \ - server_root/icons/right.gif \ - server_root/icons/screw1.gif \ - server_root/icons/screw2.gif \ - server_root/icons/script.gif \ - server_root/icons/sound1.gif \ - server_root/icons/sound2.gif \ - server_root/icons/sphere1.gif \ - server_root/icons/sphere2.gif \ - server_root/icons/star.gif \ - server_root/icons/star_blank.gif \ - server_root/icons/tar.gif \ - server_root/icons/tex.gif \ - server_root/icons/text.gif \ - server_root/icons/transfer.gif \ - server_root/icons/unknown.gif \ - server_root/icons/up.gif \ - server_root/icons/uu.gif \ - server_root/icons/uuencoded.gif \ - server_root/icons/world1.gif \ - server_root/icons/world2.gif +include subdirs.mk -SSL_FILES = server_root/ssl/ssl_client.pem \ - server_root/ssl/ssl_server.pem +SPECIAL_TARGETS = # ---------------------------------------------------- -# FLAGS +# Default Subdir Targets # ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: - -clean: - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/auth - $(INSTALL_DATA) $(AUTH_FILES) $(RELSYSDIR)/examples/server_root/auth - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/cgi-bin - $(INSTALL_SCRIPT) $(CGI_FILES) $(RELSYSDIR)/examples/server_root/cgi-bin - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/conf - $(INSTALL_DATA) $(CONF_FILES) $(RELSYSDIR)/examples/server_root/conf - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/open - $(INSTALL_DATA) $(OPEN_FILES) \ - $(RELSYSDIR)/examples/server_root/htdocs/open - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open - $(INSTALL_DATA) $(MNESIA_OPEN_FILES) \ - $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/misc - $(INSTALL_DATA) $(MISC_FILES) \ - $(RELSYSDIR)/examples/server_root/htdocs/misc - $(INSTALL_DIR) \ - $(RELSYSDIR)/examples/server_root/htdocs/secret/top_secret - $(INSTALL_DIR) \ - $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret/top_secret - $(INSTALL_DATA) $(SECRET_FILES) \ - $(RELSYSDIR)/examples/server_root/htdocs/secret - $(INSTALL_DATA) $(MNESIA_SECRET_FILES) \ - $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs - $(INSTALL_DATA) $(HTDOCS_FILES) $(RELSYSDIR)/examples/server_root/htdocs - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/icons - $(INSTALL_DATA) $(ICON_FILES) $(RELSYSDIR)/examples/server_root/icons - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/ssl - $(INSTALL_DATA) $(SSL_FILES) $(RELSYSDIR)/examples/server_root/ssl - $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/logs - -release_docs_spec: +include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/inets/examples/httpd_load_test/Makefile b/lib/inets/examples/httpd_load_test/Makefile new file mode 100644 index 0000000000..1cc61ad8ae --- /dev/null +++ b/lib/inets/examples/httpd_load_test/Makefile @@ -0,0 +1,123 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +include $(ERL_TOP)/make/target.mk + +EBIN = . + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk + +VSN=$(INETS_VSN) + + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN) +EXAMPLE_RELSYSDIR = $(RELSYSDIR)/examples +HDLT_RELSYSDIR = $(EXAMPLE_RELSYSDIR)/httpd_load_test + + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +include modules.mk + +ERL_FILES = $(MODULES:%=%.erl) + +SOURCE = $(ERL_FILES) $(INTERNAL_HRL_FILES) + +TARGET_FILES = \ + $(ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) + +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug -W +endif + + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +include ../../src/inets_app/inets.mk + +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include + + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +debug: + @${MAKE} TYPE=debug opt + +opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f errs core *~ + +docs: + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + + +release_spec: opt + $(INSTALL_DIR) $(EXAMPLE_RELSYSDIR) + $(INSTALL_DIR) $(HDLT_RELSYSDIR) + $(INSTALL_DATA) $(SCRIPT_SKELETONS) $(HDLT_RELSYSDIR) + $(INSTALL_DATA) $(CONF_SKELETONS) $(HDLT_RELSYSDIR) + $(INSTALL_DATA) $(CERT_FILES) $(HDLT_RELSYSDIR) + $(INSTALL_DATA) $(TARGET_FILES) $(HDLT_RELSYSDIR) + $(INSTALL_DATA) $(ERL_FILES) $(HDLT_RELSYSDIR) + + +release_docs_spec: + + +# ---------------------------------------------------- +# Include dependencies +# ---------------------------------------------------- + +megaco_codec_transform.$(EMULATOR): megaco_codec_transform.erl + +megaco_codec_meas.$(EMULATOR): megaco_codec_meas.erl + +megaco_codec_mstone1.$(EMULATOR): megaco_codec_mstone1.erl + +megaco_codec_mstone2.$(EMULATOR): megaco_codec_mstone2.erl + +megaco_codec_mstone_lib.$(EMULATOR): megaco_codec_mstone_lib.erl + diff --git a/lib/inets/examples/httpd_load_test/hdlt.config.skel b/lib/inets/examples/httpd_load_test/hdlt.config.skel new file mode 100644 index 0000000000..640867ebac --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt.config.skel @@ -0,0 +1,20 @@ +%% Debug: silence | info | log | debug +{debug, [{ctrl, info}, {proxy, silence}, {slave, silence}, {client, silence}]}. +{server, {"/usr/local/bin", "fooserver"}}. +%% {port, 8888}. % integer() > 0 +{server_dir, "/tmp/hdlt"}. % Absolute path +{work_dir, "/tmp/hdlt"}. % Absolute path +{clients, + [ + {"/opt/local/bin", "foo"}, + {"/usr/local/bin", "bar"} + ] +}. +%% {send_rate, 80}. % Max number of outstanding requests, integer() > 0 +%% {test_time, 120}. % Number of seconds, +%% {max_nof_schedulers, 8}. % integer() >= 0 +%% {work_simulator, 10000}. % integer() > 0 +%% {data_size, {100, 500, 2}}. % {integer() > 0, integer() > 0, integer() > 0} +%% {socket_type, ip_comm}. % ip_comm | ssl | essl | ossl +%% {server_cert_file, "hdlt_ssl_server_cert.pem"}. +%% {client_cert_file, "hdlt_ssl_client_cert.pem"}.
\ No newline at end of file diff --git a/lib/inets/examples/httpd_load_test/hdlt.erl b/lib/inets/examples/httpd_load_test/hdlt.erl new file mode 100644 index 0000000000..18d8c34ccf --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt.erl @@ -0,0 +1,74 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: Main API module for the httpd load test utility +%%---------------------------------------------------------------------- + +-module(hdlt). + + +%%----------------------------------------------------------------- +%% Public interface +%%----------------------------------------------------------------- + +-export([start/0, start/1, stop/0, help/0]). + + +%%----------------------------------------------------------------- +%% Start the HDLT utility +%%----------------------------------------------------------------- + +start() -> + ConfigFile = "hdlt.config", + case file:consult(ConfigFile) of + {ok, Config} when is_list(Config) -> + start(Config); + Error -> + Error + end. + +start(Config) -> + Flag = process_flag(trap_exit, true), + Result = + case hdlt_ctrl:start(Config) of + {ok, Pid} -> + receive + {'EXIT', Pid, normal} -> + ok; + {'EXIT', Pid, Reason} -> + io:format("HDLT failed: " + "~n ~p" + "~n", [Reason]), + {error, Reason} + end; + Error -> + Error + end, + process_flag(trap_exit, Flag), + Result. + + + +stop() -> + hdlt_ctrl:stop(). + + +help() -> + hdlt_ctrl:help(). diff --git a/lib/inets/examples/httpd_load_test/hdlt.sh.skel b/lib/inets/examples/httpd_load_test/hdlt.sh.skel new file mode 100644 index 0000000000..a250bad9c5 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt.sh.skel @@ -0,0 +1,44 @@ +#!/bin/sh + +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +# Skeleton for a script intended to run the hdlt(N) +# performance test. +# +# This test can be used for several things depending on the +# configuration: SMP or SocketType performance tests +# + +ERL_HOME=<path to otp top dir> +INETS_HOME=$ERL_HOME/lib/erlang/lib/<inets dir> +HDLT_HOME=$INETS_HOME/examples/httpd_load_test +PATH=$ERL_HOME/bin:$PATH + +HDLT="-s hdlt start" +STOP="-s init stop" + +ERL="erl \ + -noshell \ + -pa $HDLT_HOME \ + $HDLT \ + $STOP" + +echo $ERL +$ERL | tee hdlt.log + diff --git a/lib/inets/examples/httpd_load_test/hdlt_client.erl b/lib/inets/examples/httpd_load_test/hdlt_client.erl new file mode 100644 index 0000000000..d65ac5a885 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_client.erl @@ -0,0 +1,370 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: The HDLT client module. +%% This is the traffic generator +%%---------------------------------------------------------------------- + +-module(hdlt_client). + +-export([ + start/1, + stop/0, + start_inets/0, + start_service/1, + release/0, + node_info/0 + ]). + +-export([ + proxy/1 + ]). + +-include("hdlt_logger.hrl"). + +-define(CTRL, hdlt_ctrl). +-define(PROXY, hdlt_proxy). + +-record(state, + { + mode = initial, + send_rate, + time, + stop_time, + url, + nof_reqs = 0, + nof_reps = 0, + last_req, + sizes, + socket_type, + cert_file + }). + + + +start(Debug) -> + proc_lib:start_link(?MODULE, proxy, [Debug]). + +stop() -> + (catch erlang:send(?PROXY, stop)), + ok. + +start_inets() -> + ?PROXY ! start_inets. + +start_service(Args) -> + ?PROXY ! {start_client, Args, self()}, + receive + client_started -> + %% ?LOG("client service started"), + ok + end. + +release() -> + ?PROXY ! release. + +node_info() -> + ?PROXY ! {node_info, self()}, + receive + {node_info, NodeInfo} -> + NodeInfo + end. + + +%% --------------------------------------------------------------------- +%% +%% The proxy process +%% + +proxy(Debug) -> + process_flag(trap_exit, true), + erlang:register(?PROXY, self()), + SName = lists:flatten( + io_lib:format("HDLT PROXY[~p,~p]", [self(), node()])), + ?SET_NAME(SName), + ?SET_LEVEL(Debug), + ?LOG("starting", []), + Ref = await_for_controller(10), + CtrlNode = node(Ref), + erlang:monitor_node(CtrlNode, true), + proc_lib:init_ack({ok, self()}), + ?DEBUG("started", []), + proxy_loop(Ref, CtrlNode, undefined). + +await_for_controller(N) when N > 0 -> + case global:whereis_name(hdlt_ctrl) of + Pid when is_pid(Pid) -> + erlang:monitor(process, Pid); + _ -> + timer:sleep(1000), + await_for_controller(N-1) + end; +await_for_controller(_) -> + proc_lib:init_ack({error, controller_not_found, nodes()}), + timer:sleep(500), + init:stop(). + + +proxy_loop(Ref, CtrlNode, Client) -> + ?DEBUG("await command", []), + receive + stop -> + ?LOG("stop", []), + timer:sleep(1000), + halt(); + + start_inets -> + ?LOG("start the inets service framework", []), + %% inets:enable_trace(max, "/tmp/inets-httpc-trace.log", all), + case (catch inets:start()) of + ok -> + ?LOG("framework started", []), + proxy_loop(Ref, CtrlNode, Client); + Error -> + ?LOG("failed starting inets service framework: " + "~n Error: ~p", [Error]), + timer:sleep(1000), + halt() + end; + + {start_client, Args, From} -> + ?LOG("start client with" + "~n Args: ~p", [Args]), + Client2 = spawn_link(fun() -> client(Args) end), + From ! client_started, + proxy_loop(Ref, CtrlNode, Client2); + + release -> + ?LOG("release", []), + Client ! go, + proxy_loop(Ref, CtrlNode, Client); + + {node_info, Pid} -> + ?LOG("received requets for node info", []), + NodeInfo = get_node_info(), + Pid ! {node_info, NodeInfo}, + proxy_loop(Ref, CtrlNode, Client); + + {'EXIT', Client, normal} -> + ?LOG("received normal exit message from client (~p)", + [Client]), + exit(normal); + + {'EXIT', Client, Reason} -> + ?INFO("received exit message from client (~p)" + "~n Reason: ~p", [Client, Reason]), + %% Unexpected client termination, inform the controller and die + global:send(hdlt_ctrl, {client_exit, Client, node(), Reason}), + exit({client_exit, Reason}); + + {nodedown, CtrlNode} -> + ?LOG("received nodedown for controller node - terminate", []), + halt(); + + {'DOWN', Ref, process, _, _} -> + ?INFO("received DOWN message for controller - terminate", []), + %% The controller has terminated, dont care why, time to die + halt() + + end. + + + +%% --------------------------------------------------------------------- +%% +%% The client process +%% + +client([SocketType, CertFile, URLBase, Sizes, Time, SendRate, Debug]) -> + SName = lists:flatten( + io_lib:format("HDLT CLIENT[~p,~p]", [self(), node()])), + ?SET_NAME(SName), + ?SET_LEVEL(Debug), + ?LOG("starting with" + "~n SocketType: ~p" + "~n Time: ~p" + "~n SendRate: ~p", [SocketType, Time, SendRate]), + httpc:set_options([{max_pipeline_length, 0}]), + if + (SocketType =:= ssl) orelse + (SocketType =:= ossl) orelse + (SocketType =:= essl) -> + %% Ensure crypto and ssl started: + crypto:start(), + ssl:start(); + true -> + ok + end, + State = #state{mode = idle, + url = URLBase, + time = Time, + send_rate = SendRate, + sizes = Sizes, + socket_type = SocketType, + cert_file = CertFile}, + ?DEBUG("started", []), + client_loop(State). + +%% The point is to first start all client nodes and then this +%% process. Then, when they are all started, the go-ahead, go, +%% message is sent to let them lose at the same time. +client_loop(#state{mode = idle, + time = Time, + send_rate = SendRate} = State) -> + ?DEBUG("[idle] awaiting the go command", []), + receive + go -> + ?LOG("[idle] received go", []), + erlang:send_after(Time, self(), stop), + NewState = send_requests(State, SendRate), + client_loop(NewState#state{mode = generating, + nof_reqs = SendRate}) + end; + +%% In this mode the client is generating traffic. +%% It will continue to do so until the stop message +%% is received. +client_loop(#state{mode = generating} = State) -> + receive + stop -> + ?LOG("[generating] received stop", []), + StopTime = timestamp(), + req_reply(State), + client_loop(State#state{mode = stopping, stop_time = StopTime}); + + {http, {_, {{_, 200, _}, _, _}}} -> + %% ?DEBUG("[generating] received reply - send another request", []), + NewState = send_requests(State, 1), + client_loop(NewState#state{nof_reps = NewState#state.nof_reps + 1, + nof_reqs = NewState#state.nof_reqs + 1}); + + {http, {ReqId, {error, Reason}}} -> + ?INFO("[generating] request ~p failed: " + "~n Reason: ~p" + "~n NofReqs: ~p" + "~n NofReps: ~p", + [ReqId, Reason, State#state.nof_reqs, State#state.nof_reps]), + exit({Reason, generating, State#state.nof_reqs, State#state.nof_reps}); + + Else -> + ?LOG("[generating] received unexpected message: " + "~n~p", [Else]), + unexpected_data(Else), + client_loop(State) + end; + +%% The client no longer issues any new requests, instead it +%% waits for replies for all the oustanding requests to +%% arrive. +client_loop(#state{mode = stopping, + time = Time, + last_req = LastReqId} = State) -> + receive + {http, {LastReqId, {{_, 200, _}, _, _}}} -> + ?DEBUG("[stopping] received reply for last request (~p)", [LastReqId]), + time_to_complete(State), + ok; + + {http, {ReqId, {{_, 200, _}, _, _}}} -> + ?DEBUG("[stopping] received reply ~p", [ReqId]), + client_loop(State); + + {http, {ReqId, {error, Reason}}} -> + ?INFO("[stopping] request ~p failed: " + "~n Reason: ~p" + "~n NofReqs: ~p" + "~n NofReps: ~p", + [ReqId, Reason, State#state.nof_reqs, State#state.nof_reps]), + exit({Reason, stopping, State#state.nof_reqs, State#state.nof_reps}); + + Else -> + ?LOG("[stopping] received unexpected message: " + "~n~p", [Else]), + unexpected_data(Else), + client_loop(State) + + after Time -> + ?INFO("timeout when" + "~n Number of requests: ~p" + "~n Number of replies: ~p", + [State#state.nof_reqs, State#state.nof_reps]), + exit({timeout, State#state.nof_reqs, State#state.nof_reps}) + end. + +req_reply(#state{nof_reqs = NofReqs, nof_reps = NofReps}) -> + load_data({req_reply, node(), NofReqs, NofReps}). + +time_to_complete(#state{stop_time = StopTime}) -> + StoppedTime = os:timestamp(), + load_data({time_to_complete, node(), StopTime, StoppedTime}). + +load_data(Data) -> + global:send(?CTRL, {load_data, Data}). + +unexpected_data(Else) -> + global:send(?CTRL, {unexpected_data, Else}). + + +send_requests(#state{sizes = Sizes} = State, N) -> + send_requests(State, N, Sizes). + +send_requests(State, 0, Sizes) -> + State#state{sizes = Sizes}; +send_requests(#state{socket_type = SocketType, + cert_file = CertFile} = State, N, [Sz | Sizes]) -> + URL = lists:flatten(io_lib:format("~s~w", [State#state.url, Sz])), + Method = get, + Request = {URL, []}, + HTTPOptions = + case SocketType of + ip_comm -> + []; + _ -> + SslOpts = [{verify, 0}, + {certfile, CertFile}, + {keyfile, CertFile}], + case SocketType of + ssl -> + [{ssl, SslOpts}]; + ossl -> + [{ssl, {ossl, SslOpts}}]; + essl -> + [{ssl, {essl, SslOpts}}] + end + end, + Options = [{sync, false}], + {ok, Ref} = httpc:request(Method, Request, HTTPOptions, Options), + send_requests(State#state{last_req = Ref}, N-1, lists:append(Sizes, [Sz])). + + +timestamp() -> + os:timestamp(). + + +get_node_info() -> + [{cpu_topology, erlang:system_info(cpu_topology)}, + {heap_type, erlang:system_info(heap_type)}, + {nof_schedulers, erlang:system_info(schedulers)}, + {otp_release, erlang:system_info(otp_release)}, + {version, erlang:system_info(version)}, + {system_version, erlang:system_info(system_version)}, + {system_architecture, erlang:system_info(system_architecture)}]. + + diff --git a/lib/inets/examples/httpd_load_test/hdlt_ctrl.erl b/lib/inets/examples/httpd_load_test/hdlt_ctrl.erl new file mode 100644 index 0000000000..950d2632f7 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_ctrl.erl @@ -0,0 +1,1530 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: The httpd load test (hdlt) controller/collector module, +%% This module contains all the code of the httpd load test +%% controller/collector. It sets up the test, starts all +%% server and client nodes and applications and finally +%% collects test data. +%%---------------------------------------------------------------------- + +-module(hdlt_ctrl). + +-export([start/1, stop/0, help/0]). + +-export([init/1, proxy/7]). + +-include_lib("kernel/include/file.hrl"). +-include("hdlt_logger.hrl"). + +-define(DEFAULT_SENDRATE, 89). +-define(DEFAULT_TEST_TIME, 120). % 2 minutes +-define(DEFAULT_PORT, 8889). +-define(TIMEOUT, 60000). +-define(DEFAULT_MAX_NOF_SCHEDULERS, 8). +-define(DEFAULT_SERVER_DIR, "/tmp/hdlt"). +-define(DEFAULT_WORK_DIR, "/tmp/hdlt"). +-define(SSH_PORT, 22). +-define(DEFAULT_SOCKET_TYPE, ip_comm). +-define(DEFAULT_SERVER_CERT, "hdlt_ssl_server_cert.pem"). +-define(DEFAULT_CLIENT_CERT, "hdlt_ssl_client_cert.pem"). +-define(SSH_CONNECT_TIMEOUT, 5000). +-define(NODE_START_TIMEOUT, 5000). +-define(LOCAL_PROXY_START_TIMEOUT, ?NODE_START_TIMEOUT * 4). +-define(DEFAULT_DEBUGS, + [{ctrl, info}, {slave, silence}, {proxy, silence}, {client, silence}]). +-define(DEFAULT_WORK_SIM, 10000). +-define(DEFAULT_DATA_SIZE_START, 500). +-define(DEFAULT_DATA_SIZE_END, 1500). +-define(DEFAULT_DATA_SIZE_INCR, 1). +-define(DEFAULT_DATA_SIZE, {?DEFAULT_DATA_SIZE_START, + ?DEFAULT_DATA_SIZE_END, + ?DEFAULT_DATA_SIZE_INCR}). + + +%% hdlt = httpd load test + +-define(COLLECTOR, hdlt_ctrl). +-define(RESULTS_TAB, hdlt_results). + +-define(CLIENT_MOD, hdlt_client). +-define(CLIENT_NODE_NAME, ?CLIENT_MOD). + +-define(SERVER_MOD, hdlt_server). +-define(SERVER_NODE_NAME, ?SERVER_MOD). + +-define(LOGGER, hdlt_logger). + + +-record(state, + { + url, + test_time, + send_rate, + http_server, + http_port, + results = ?RESULTS_TAB, + nodes, + server_root, + doc_root, + server_dir, + work_dir, + server_conn, + client_conns = [], + client_mod = ?CLIENT_MOD, + clients, + nof_schedulers = 0, + max_nof_schedulers, + socket_type, + server_cert_file, + client_cert_file, + debugs, + client_sz_from, + client_sz_to, + client_sz_incr + } + ). + +-record(proxy, + { + mode, + mod, + connection, + channel, + host, + cmd, + node_name, + node, + ref, + erl_path, + paths, + args + }). + +-record(connection, + { + proxy, + node, + node_name, + host + }). + + +-record(client, {host, path, version}). +-record(server, {host, path, version}). + + +start(Config) when is_list(Config) -> + proc_lib:start_link(?MODULE, init, [Config]). + +stop() -> + global:send(?COLLECTOR, stop). + +init(Config) -> + %% io:format("Config: ~n~p~n", [Config]), + case (catch do_init(Config)) of + {ok, State} -> + proc_lib:init_ack({ok, self()}), + loop(State); + {error, _Reason} = Error -> + proc_lib:init_ack(Error), + ok; + {'EXIT', Reason} -> + proc_lib:init_ack({error, Reason}), + ok + end. + +do_init(Config) -> + %% Do not trap exit, but register ourself + global:register_name(?COLLECTOR, self()), + + State = #state{}, + ets:new(State#state.results, [bag, named_table]), + + hdlt_logger:start(), + global:sync(), + + %% Maybe enable debug + Debugs = get_debugs(Config), + ?SET_NAME("HDLT CTRL"), + set_debug_level(Debugs), + + ?DEBUG("network info: " + "~n Global names: ~p" + "~n Nodes: ~p", [global:registered_names(), nodes()]), + + %% Read config + ?LOG("read config", []), + SendRate = get_send_rate(Config), + Clients = get_clients(Config), + TestTime = get_test_time(Config), + Server = get_server(Config), + Port = get_port(Config), + ServerDir = get_server_dir(Config), + WorkingDir = get_work_dir(Config), + MaxNofSchedulers = get_max_nof_schedulers(Config), + SocketType = get_socket_type(Config), + ServerCertFile = get_server_cert_file(Config), + ClientCertFile = get_client_cert_file(Config), + WorkSim = get_work_sim(Config), + {From, To, Incr} = get_data_size(Config), + + URL = url(Server, Port, SocketType, WorkSim), + ServerRoot = filename:join(ServerDir, "server_root"), + DocRoot = ServerRoot, %% Not really used in this test + + ?DEBUG("randomize setup", []), + randomized_sizes_init(), + + %% Start used applications + ?DEBUG("ensure crypto started", []), + crypto:start(), + ?DEBUG("ensure ssh started", []), + ssh:start(), + + State2 = State#state{server_root = ServerRoot, + doc_root = DocRoot, + server_dir = ServerDir, + work_dir = WorkingDir, + max_nof_schedulers = MaxNofSchedulers, + socket_type = SocketType, + server_cert_file = ServerCertFile, + client_cert_file = ClientCertFile, + http_server = Server, + http_port = Port, + url = URL, + test_time = TestTime, + send_rate = SendRate, + clients = Clients, + debugs = Debugs, + client_sz_from = From, + client_sz_to = To, + client_sz_incr = Incr}, + + ?LOG("prepare server host", []), + prepare_server_host(State2), + + ?LOG("prepare client hosts", []), + State3 = prepare_client_hosts(State2), + + ?LOG("basic init done", []), + {ok, State3}. + + +loop(#state{nof_schedulers = N, max_nof_schedulers = M} = State) when N > M -> + + ?INFO("Starting to analyse data", []), + + AnalysedTab = analyse_data(State), + + Files = save_results_to_file(AnalysedTab, State), + io:format("~n******************************************************" + "~n~nResult(s) saved to: ~n~p~n", [Files]), + clean_up(State); + +loop(#state{url = URL, + test_time = TestTime, + send_rate = SendRate, + nof_schedulers = NofSchedulers} = State) -> + + {StartH, StartM, StartS} = erlang:time(), + + ?INFO("Performing test with ~p smp-scheduler(s): ~n" + " It will take a minimum of: ~p seconds. ~n" + " Start time: ~.2.0w:~.2.0w:~.2.0w", + [NofSchedulers, round(TestTime/1000), StartH, StartM, StartS]), + + %% Start the server node + %% (The local proxy, the node, the remote proxy, and the inets framework) + State1 = start_server_node(State), + ?DEBUG("nodes after server start: ~p", [nodes() -- [node()]]), + + %% Start the client node(s) + %% (The local proxy, the node, the remote proxy, and the inets framework) + ?LOG("start client node(s)", []), + State2 = start_client_nodes(State1), + ?DEBUG("nodes after client(s) start: ~p", [nodes() -- [node()]]), + + ?LOG("start server", []), + start_server(State2), + + ?LOG("start clients", []), + start_clients(State2, URL, TestTime, SendRate), + + ?LOG("release clients", []), + release_clients(State2), + + ?LOG("collect data", []), + collect_data(State2), + + ?LOG("stop all nodes", []), + State3 = stop_nodes(State2), + + ?INFO("Test with ~p smp-scheduler(s) complete" + "~n~n" + "****************************************************************" + "~n", + [NofSchedulers]), + loop(State3#state{nof_schedulers = NofSchedulers + 1}). + + +prepare_server_host(#state{server_root = ServerRoot, + http_server = #server{host = Host}, + socket_type = SocketType, + server_cert_file = CertFile}) -> + ?INFO("prepare server host ~s", [Host]), + Opts = [{user_interaction, false}, + {silently_accept_hosts, true}, + {timeout, 2*?SSH_CONNECT_TIMEOUT}, + {connect_timeout, ?SSH_CONNECT_TIMEOUT}], + case ssh_sftp:start_channel(Host, Opts) of + {ok, Sftp, ConnectionRef} -> + ?DEBUG("sftp connection established - now transer server content", + []), + create_server_content(Sftp, ServerRoot, SocketType, CertFile), + ?DEBUG("server content transfered - now close ssh connection ", + []), + ssh:close(ConnectionRef), + ?DEBUG("server preparation complete ", []), + ok; + Error -> + ?INFO("FAILED creating sftp channel to server host ~s: " + "~n ~p", [Host, Error]), + exit({failed_establishing_sftp_connection, Error}) + end. + +create_server_content(Sftp, ServerRoot, SocketType, CertFile) -> + %% Create server root + ?DEBUG("ensure existence of ~p", [ServerRoot]), + ensure_remote_dir_exist(Sftp, ServerRoot), + + %% Create the server ebin dir (for the starter module) + EBIN = filename:join(ServerRoot, "ebin"), + ?DEBUG("make ebin dir: ~p", [EBIN]), + maybe_create_remote_dir(Sftp, EBIN), + + %% Create the server ebin dir (for the starter module) + LOG = filename:join(ServerRoot, "log"), + ?DEBUG("make log dir: ~p", [LOG]), + maybe_create_remote_dir(Sftp, LOG), + + LocalServerMod = local_server_module(), + ?DEBUG("copy server stub/proxy module ~s", [LocalServerMod]), + RemoteServerMod = remote_server_module(EBIN), + {ok, ServerModBin} = file:read_file(LocalServerMod), + ok = ssh_sftp:write_file(Sftp, RemoteServerMod, ServerModBin), + + LocalSlaveMod = local_slave_module(), + ?DEBUG("copy slave module ~s", [LocalSlaveMod]), + RemoteSlaveMod = remote_slave_module(EBIN), + {ok, SlaveModBin} = file:read_file(LocalSlaveMod), + ok = ssh_sftp:write_file(Sftp, RemoteSlaveMod, SlaveModBin), + + LocalLoggerMod = local_logger_module(), + ?DEBUG("copy logger module ~s", [LocalLoggerMod]), + RemoteLoggerMod = remote_logger_module(EBIN), + {ok, LoggerModBin} = file:read_file(LocalLoggerMod), + ok = ssh_sftp:write_file(Sftp, RemoteLoggerMod, LoggerModBin), + + %% Create the inets server data dir + CGI = filename:join(ServerRoot, "cgi-bin"), + ?DEBUG("make cgi dir: ~p", [CGI]), + maybe_create_remote_dir(Sftp, CGI), + + LocalRandomMod = local_random_html_module(), + ?DEBUG("copy random-html module ~s", [LocalRandomMod]), + RemoteRandomMod = remote_random_html_module(EBIN), + {ok, RandomModBin} = file:read_file(LocalRandomMod), + ok = ssh_sftp:write_file(Sftp, RemoteRandomMod, RandomModBin), + + case SocketType of + ip_comm -> + ok; + _ -> + SSLDir = filename:join(ServerRoot, "ssl"), + ?DEBUG("make conf dir: ~p", [SSLDir]), + maybe_create_remote_dir(Sftp, SSLDir), + ?DEBUG("copy ssl cert file ~s", [CertFile]), + {ok, CertBin} = file:read_file(CertFile), + RemoteCertFile = filename:join(SSLDir, + filename:basename(CertFile)), + ok = ssh_sftp:write_file(Sftp, RemoteCertFile, CertBin), + ok + end, + + ?DEBUG("done", []), + ok. + +remote_server_module(Path) -> + Mod = server_module(), + filename:join(Path, Mod). + +local_server_module() -> + Mod = server_module(), + case code:where_is_file(Mod) of + Path when is_list(Path) -> + Path; + _ -> + exit({server_module_not_found, Mod}) + end. + +server_module() -> + module(?SERVER_MOD). + + +prepare_client_hosts(#state{work_dir = WorkDir, + clients = Clients, + socket_type = SocketType, + client_cert_file = CertFile} = State) -> + Clients2 = + prepare_client_hosts(WorkDir, SocketType, CertFile, Clients, []), + State#state{clients = Clients2}. + +prepare_client_hosts(_WorkDir, _SocketType, _CertFile, [], Acc) -> + lists:reverse(Acc); +prepare_client_hosts(WorkDir, SocketType, CertFile, [Client|Clients], Acc) -> + case prepare_client_host(WorkDir, SocketType, CertFile, Client) of + ok -> + prepare_client_hosts(WorkDir, SocketType, CertFile, Clients, + [Client|Acc]); + _ -> + prepare_client_hosts(WorkDir, SocketType, CertFile, Clients, Acc) + end. + +prepare_client_host(WorkDir, SocketType, CertFile, #client{host = Host}) -> + ?INFO("prepare client host ~s", [Host]), + Opts = [{user_interaction, false}, + {silently_accept_hosts, true}, + {timeout, 2*?SSH_CONNECT_TIMEOUT}, + {connect_timeout, ?SSH_CONNECT_TIMEOUT}], + case ssh_sftp:start_channel(Host, Opts) of + {ok, Sftp, ConnectionRef} -> + ?DEBUG("sftp connection established - now transer client content", + []), + create_client_content(Sftp, WorkDir, SocketType, CertFile), + ?DEBUG("client content transered - now close ssh connection ", []), + ssh:close(ConnectionRef), + ?DEBUG("client preparation complete ", []), + ok; + Error -> + ?INFO("FAILED creating sftp channel to client host ~s: skipping" + "~n ~p", [Host, Error]), + Error + end. + +create_client_content(Sftp, WorkDir, SocketType, CertFile) -> + %% Create work dir + ?DEBUG("ensure existence of ~p", [WorkDir]), + ensure_remote_dir_exist(Sftp, WorkDir), + + %% Create the client ebin dir + EBIN = filename:join(WorkDir, "ebin"), + RemoteClientMod = remote_client_module(EBIN), + ?DEBUG("make ebin dir: ~p", [EBIN]), + maybe_create_remote_dir(Sftp, EBIN), + + LocalClientMod = local_client_module(), + ?DEBUG("copy client stub/proxy module ~s", [LocalClientMod]), + {ok, ClientModBin} = file:read_file(LocalClientMod), + ok = ssh_sftp:write_file(Sftp, RemoteClientMod, ClientModBin), + + LocalSlaveMod = local_slave_module(), + ?DEBUG("copy slave module ~s", [LocalSlaveMod]), + RemoteSlaveMod = remote_slave_module(EBIN), + {ok, SlaveModBin} = file:read_file(LocalSlaveMod), + ok = ssh_sftp:write_file(Sftp, RemoteSlaveMod, SlaveModBin), + + LocalLoggerMod = local_logger_module(), + ?DEBUG("copy logger module ~s", [LocalLoggerMod]), + RemoteLoggerMod = remote_logger_module(EBIN), + {ok, LoggerModBin} = file:read_file(LocalLoggerMod), + ok = ssh_sftp:write_file(Sftp, RemoteLoggerMod, LoggerModBin), + + case SocketType of + ip_comm -> + ok; + _ -> + %% We should really store the remote path somewhere as + %% we use it when starting the client service... + SSLDir = filename:join(WorkDir, "ssl"), + ?DEBUG("make ssl dir: ~p", [SSLDir]), + maybe_create_remote_dir(Sftp, SSLDir), + ?DEBUG("copy ssl cert file ~s", [CertFile]), + {ok, CertBin} = file:read_file(CertFile), + RemoteCertFile = filename:join(SSLDir, + filename:basename(CertFile)), + ok = ssh_sftp:write_file(Sftp, RemoteCertFile, CertBin), + ok + end, + + ?DEBUG("done", []), + ok. + +remote_client_module(Path) -> + Mod = client_module(), + filename:join(Path, Mod). + +local_client_module() -> + Mod = client_module(), + case code:where_is_file(Mod) of + Path when is_list(Path) -> + Path; + _ -> + exit({client_module_not_found, Mod}) + end. + +client_module() -> + module(?CLIENT_MOD). + + +remote_slave_module(Path) -> + Mod = slave_module(), + filename:join(Path, Mod). + +local_slave_module() -> + Mod = slave_module(), + case code:where_is_file(Mod) of + Path when is_list(Path) -> + Path; + _ -> + exit({slave_module_not_found, Mod}) + end. + +slave_module() -> + module(hdlt_slave). + + +remote_logger_module(Path) -> + Mod = logger_module(), + filename:join(Path, Mod). + +local_logger_module() -> + Mod = logger_module(), + case code:where_is_file(Mod) of + Path when is_list(Path) -> + Path; + _ -> + exit({logger_module_not_found, Mod}) + end. + +logger_module() -> + module(hdlt_logger). + + +remote_random_html_module(Path) -> + Mod = random_html_module(), + filename:join(Path, Mod). + +local_random_html_module() -> + Mod = random_html_module(), + case code:where_is_file(Mod) of + Path when is_list(Path) -> + Path; + _ -> + exit({random_module_not_found, Mod}) + end. + +random_html_module() -> + module(hdlt_random_html). + + +module(Mod) -> + Ext = string:to_lower(erlang:system_info(machine)), + lists:flatten(io_lib:format("~w.~s", [Mod, Ext])). + + +%% ----------------------------------------------------------------------- +%% - For every node created (server and client both) there is both +%% a local and remote proxy. +%% - The local proxy is running on the local (controller/collector) node. +%% - The remote proxy is running on the client or server node(s). +%% - The local (ctrl) proxy monitor the remote (server/client) proxy. +%% - The remote (server/client) proxy monitor the local (ctrl) proxy. +%% + +start_client_nodes(#state{clients = Clients, + work_dir = WorkDir, + debugs = Debugs} = State) -> + Connections = + [start_client_node(Client, WorkDir, Debugs) || Client <- Clients], + State#state{client_conns = Connections}. + +start_client_node(#client{path = ErlPath, host = Host}, WorkDir, Debugs) -> + ?INFO("start client on host ~p", [Host]), + EbinDir = filename:join(WorkDir, "ebin"), + start_client_node(Host, ErlPath, [EbinDir], Debugs). + +start_client_node(Host, ErlPath, Paths, Debugs) -> + start_node(Host, ?CLIENT_NODE_NAME, + ErlPath, Paths, [], ?CLIENT_MOD, Debugs). + + +start_server_node(#state{http_server = #server{path = ErlPath, host = Host}, + server_root = ServerRoot, + nof_schedulers = NofScheds, + debugs = Debugs} = State) -> + ?INFO("start server on host ~p", [Host]), + CgiBinDir = filename:join(ServerRoot, "cgi-bin"), + EbinDir = filename:join(ServerRoot, "ebin"), + Connection = + start_server_node(Host, ErlPath, [CgiBinDir, EbinDir], + Debugs, NofScheds), + State#state{server_conn = Connection}. + +start_server_node(Host, ErlPath, Paths, Debugs, NofScheds) -> + Args = + if + NofScheds =:= 0 -> + "-smp disable"; + true -> + lists:flatten(io_lib:format("-smp +S ~w", [NofScheds])) + end, + start_node(Host, ?SERVER_NODE_NAME, + ErlPath, Paths, Args, ?SERVER_MOD, Debugs). + + +%% ----------------------------------------------------------------------- +%% - For every node created (server and client both) there is both +%% a local and remote proxy. +%% - The local proxy is running on the local (controller/collector) node. +%% - The remote proxy is running on the client or server node(s). +%% - The local (ctrl) proxy monitor the remote (server/client) proxy. +%% - The remote (server/client) proxy monitor the local (ctrl) proxy. +%% + +start_node(Host, NodeName, ErlPath, Paths, Args, Module, Debugs) -> + %% Start the (local) proxy + ?DEBUG("start_node -> start local proxy and remote node", []), + ProxyDebug = proplists:get_value(proxy, Debugs, silence), + Proxy = proxy_start(Host, NodeName, ErlPath, Paths, Args, Module, + ProxyDebug), + + ?DEBUG("start_node -> local proxy started - now start node", []), + SlaveDebug = proplists:get_value(slave, Debugs, silence), + Node = proxy_start_node(Proxy, SlaveDebug), + + ?DEBUG("start_node -> sync global", []), + global:sync(), + + ?DEBUG("start_node -> start remote proxy", []), + proxy_start_remote(Proxy), + + ?DEBUG("start_node -> start (remote) inets framework", []), + proxy_start_inets(Proxy), + + ?DEBUG("start_node -> done", []), + #connection{proxy = Proxy, node = Node, node_name = NodeName, host = Host}. + + +proxy_start(Host, NodeName, ErlPath, Paths, Args, Module, Debug) -> + ?LOG("try starting local proxy for ~p@~s", [NodeName, Host]), + ProxyArgs = [Host, NodeName, ErlPath, Paths, Args, Module, Debug], + case proc_lib:start_link(?MODULE, proxy, + ProxyArgs, ?LOCAL_PROXY_START_TIMEOUT) of + {ok, Proxy} -> + Proxy; + Error -> + exit({failed_starting_proxy, Error}) + end. + +proxy_start_node(Proxy, Debug) -> + {ok, Node} = proxy_request(Proxy, {start_node, Debug}), + Node. + +proxy_start_remote(Proxy) -> + proxy_request(Proxy, start_remote_proxy). + +proxy_start_inets(Proxy) -> + proxy_request(Proxy, start_inets). + +proxy_start_service(Proxy, Args) -> + proxy_request(Proxy, {start_service, Args}). + +proxy_release(Proxy) -> + proxy_request(Proxy, release). + +proxy_stop(Proxy) -> + StopResult = proxy_request(Proxy, stop), + ?DEBUG("proxy stop result: ~p", [StopResult]), + StopResult. + +proxy_request(Proxy, Req) -> + Ref = make_ref(), + Proxy ! {proxy_request, Ref, self(), Req}, + receive + {proxy_reply, Ref, Proxy, Rep} -> + Rep + end. + +proxy_reply(From, Ref, Rep) -> + From ! {proxy_reply, Ref, self(), Rep}. + +proxy(Host, NodeName, ErlPath, Paths, Args, Module, Debug) -> + process_flag(trap_exit, true), + SName = lists:flatten( + io_lib:format("HDLT CTRL PROXY[~p,~s,~w]", + [self(), Host, NodeName])), + ?SET_NAME(SName), + ?SET_LEVEL(Debug), + ?LOG("starting with" + "~n Host: ~p" + "~n NodeName: ~p" + "~n ErlPath: ~p" + "~n Paths: ~p" + "~n Args: ~p" + "~n Module: ~p", [Host, NodeName, ErlPath, Paths, Args, Module]), + State = #proxy{mode = started, + mod = Module, + host = Host, + node_name = NodeName, + erl_path = ErlPath, + paths = Paths, + args = Args}, + proc_lib:init_ack({ok, self()}), + ?DEBUG("started", []), + proxy_loop(State). + + +proxy_loop(#proxy{mode = stopping}) -> + receive + {proxy_request, Ref, From, stop} -> + ?LOG("[stopping] received stop order", []), + proxy_reply(From, Ref, ok), + exit(normal); + + {'EXIT', Pid, Reason} -> + ?INFO("[stopping] received exit message from ~p: " + "~n Reason: ~p", [Pid, Reason]), + exit(Reason) + + end; + +proxy_loop(#proxy{mode = started, + host = Host, + node_name = NodeName, + erl_path = ErlPath, + paths = Paths, + args = Args} = State) -> + receive + {proxy_request, Ref, From, {start_node, Debug}} -> + ?LOG("[starting] received start_node order", []), + case hdlt_slave:start_link(Host, NodeName, + ErlPath, Paths, Args, + Debug) of + {ok, Node} -> + ?DEBUG("[starting] node ~p started - now monitor", [Node]), + erlang:monitor_node(Node, true), + State2 = State#proxy{mode = operational, + node = Node}, + proxy_reply(From, Ref, {ok, Node}), + proxy_loop(State2); + {error, Reason} -> + ?INFO("[starting] failed starting node: " + "~n Reason: ~p", [Reason]), + exit({failed_starting_node, {Host, NodeName, Reason}}) + end; + + {'EXIT', Pid, Reason} -> + ?INFO("[stopping] received exit message from ~p: " + "~n Reason: ~p", [Pid, Reason]), + exit(Reason) + + end; + +proxy_loop(#proxy{mode = operational, + mod = Mod, + node = Node} = State) -> + ?DEBUG("[operational] await command", []), + receive + {proxy_request, Ref, From, start_remote_proxy} -> + ?LOG("[operational] start remote proxy", []), + case rpc:call(Node, Mod, start, [?GET_LEVEL()]) of + {ok, Pid} -> + ?DEBUG("[operational] remote proxy started (~p) - " + "create monitor", [Pid]), + ProxyRef = erlang:monitor(process, Pid), + ?DEBUG("[operational] monitor: ~p", [Ref]), + proxy_reply(From, Ref, ok), + proxy_loop(State#proxy{ref = ProxyRef}); + Error -> + ?INFO("[operational] failed starting remote proxy" + "~n Error: ~p", [Error]), + ReplyReason = {failed_starting_remote_proxy, + {Node, Error}}, + Reply = {error, ReplyReason}, + proxy_reply(From, Ref, Reply), + exit({failed_starting_remote_proxy, {Node, Error}}) + end; + + {proxy_request, Ref, From, start_inets} -> + ?INFO("[operational] start inets framework", []), + rpc:cast(Node, Mod, start_inets, []), + proxy_reply(From, Ref, ok), + proxy_loop(State); + + {proxy_request, Ref, From, {start_service, Args}} -> + ?INFO("[operational] start service with" + "~n ~p", [Args]), + case rpc:call(Node, Mod, start_service, Args) of + ok -> + ?DEBUG("[operational] service started", []), + proxy_reply(From, Ref, ok), + proxy_loop(State); + Error -> + ?INFO("[operational] failed starting service: " + "~n Args. ~p" + "~n Error: ~p", [Args, Error]), + erlang:demonitor(State#proxy.ref, [flush]), + Reply = {error, {failed_starting_service, Node, Error}}, + proxy_reply(From, Ref, Reply), + exit({failed_starting_service, Node, Error}) + end; + + {proxy_request, Ref, From, release} -> + ?INFO("[operational] release", []), + rpc:call(Node, Mod, release, []), + proxy_reply(From, Ref, ok), + proxy_loop(State); + + {proxy_request, Ref, From, stop} -> + ?INFO("[operational] received stop order", []), + erlang:demonitor(State#proxy.ref, [flush]), + ?DEBUG("[operational] rpc cast stop order", []), + rpc:cast(Node, Mod, stop, []), + %% And wait for the node death to be reported + Reason = + receive + {nodedown, Node} when State#proxy.node =:= Node -> + ok + after 10000 -> + ?INFO("Node did not die within expected time frame", + []), + {node_death_timeout, Node} + end, + ?DEBUG("[operational] ack stop", []), + proxy_reply(From, Ref, Reason), + exit(normal); + + {nodedown, Node} when State#proxy.node =:= Node -> + ?INFO("[operational] received unexpected nodedoen message", []), + exit({node_died, Node}); + + {'DOWN', Ref, process, _, normal} when State#proxy.ref =:= Ref -> + ?INFO("[operational] remote proxy terminated normally", []), + proxy_loop(State#proxy{ref = undefined, + connection = undefined, + mode = stopping}); + + {'DOWN', Ref, process, _, noconnection} when State#proxy.ref =:= Ref -> + ?INFO("[operational] remote proxy terminated - no node", []), + proxy_loop(State#proxy{ref = undefined, + connection = undefined, + mode = stopping}); + + {'DOWN', Ref, process, _, Reason} when State#proxy.ref =:= Ref -> + ?INFO("[operational] remote proxy terminated: " + "~n Reason: ~p", [Reason]), + exit({remote_proxy_crash, Reason}); + + {'EXIT', Pid, Reason} -> + ?INFO("[operational] received unexpected exit message from ~p: " + "~n Reason: ~p", [Pid, Reason]), + proxy_loop(State) + + end. + + +stop_nodes(#state{server_conn = ServerConn, + client_conns = ClientConns} = State) -> + lists:foreach( + fun(#connection{proxy = Proxy, node_name = NodeName, host = Host}) -> + ?DEBUG("stop_erlang_nodes -> send stop order to local proxy ~p" + "~n for node ~p on ~s", [Proxy, NodeName, Host]), + proxy_stop(Proxy) + end, + ClientConns ++ [ServerConn]), + ?DEBUG("stop_erlang_nodes -> sleep some to give the nodes time to die", + []), + timer:sleep(1000), + ?DEBUG("stop_erlang_nodes -> and a final cleanup round", []), + lists:foreach(fun(Node) -> + ?INFO("try brutal stop node ~p", [Node]), + rpc:cast(Node, erlang, halt, []) + end, + nodes() -- [node()]), + ?DEBUG("stop_erlang_nodes -> done", []), + State#state{server_conn = undefined, client_conns = []}. + + +%% The nodes on which the HDLT clients run have been started previously +start_clients(#state{client_conns = Connections, + debugs = Debugs, + work_dir = WorkDir, + socket_type = SocketType, + client_cert_file = CertFile, + client_sz_from = From, + client_sz_to = To, + client_sz_incr = Incr}, + URL, TestTime, SendRate) -> + Debug = proplists:get_value(client, Debugs, silence), + StartClient = + fun(#connection{host = Host} = Connection) -> + ?DEBUG("start client on ~p", [Host]), + start_client(Connection, + WorkDir, SocketType, CertFile, + URL, From, To, Incr, + TestTime, SendRate, Debug); + (_) -> + ok + end, + lists:foreach(StartClient, Connections). + +start_client(#connection{proxy = Proxy}, + WorkDir, SocketType, LocalCertFile, + URL, From, To, Incr, + TestTime, SendRate, Debug) -> + SSLDir = filename:join(WorkDir, "ssl"), + CertFile = filename:join(SSLDir, filename:basename(LocalCertFile)), + Sizes = randomized_sizes(From, To, Incr), + Args = [SocketType, CertFile, URL, Sizes, TestTime, SendRate, Debug], + proxy_start_service(Proxy, [Args]). + +release_clients(#state{client_conns = Connections}) -> + ReleaseClient = + fun(#connection{proxy = Proxy, + host = Host}) -> + ?DEBUG("release client on ~p", [Host]), + proxy_release(Proxy); + (_) -> + ok + end, + lists:foreach(ReleaseClient, Connections). + + +start_server(#state{server_conn = #connection{proxy = Proxy}, + http_port = Port, + server_root = ServerRoot, + doc_root = DocRoot, + socket_type = SocketType, + server_cert_file = CertFile}) -> + + HttpdConfig = + httpd_config(Port, "hdlt", ServerRoot, DocRoot, SocketType, CertFile), + ?LOG("start the httpd inets service with config: " + "~n ~p", [HttpdConfig]), + proxy_start_service(Proxy, [HttpdConfig]), + ?DEBUG("start_server -> done", []), + ok. + + +httpd_config(Port, ServerName, ServerRoot, DocRoot, + SocketType, LocalCertFile) -> + LogDir = filename:join(ServerRoot, "log"), + ErrorLog = filename:join(LogDir, "error_log"), + TransferLog = filename:join(LogDir, "access_log"), + + SSL = + case SocketType of + ip_comm -> + []; + _ -> % ssl + SSLDir = filename:join(ServerRoot, "ssl"), + CertFile = + filename:join(SSLDir, filename:basename(LocalCertFile)), + [ + {ssl_certificate_file, CertFile}, + {ssl_certificate_key_file, CertFile}, + {ssl_verify_client, 0} + ] + end, + [{port, Port}, + {server_name, ServerName}, + {server_root, ServerRoot}, + {document_root, DocRoot}, + {error_log, ErrorLog}, + {error_log_format, pretty}, + {transfer_log, TransferLog}, + {socket_type, SocketType}, + {max_clients, 10000}, + {modules, [mod_alias, mod_auth, mod_esi, mod_actions, mod_cgi, + mod_dir, mod_get, mod_head, mod_log, mod_disk_log]}, + {script_alias, {"/cgi-bin", filename:join(ServerRoot, "cgi-bin")}}, + {erl_script_alias, {"/cgi-bin", [hdlt_random_html]}}, + {erl_script_timeout, 120000} | SSL]. + + +clean_up(#state{server_root = ServerRoot, + work_dir = WorkDir, + http_server = #server{host = Host}, + clients = Clients}) -> + ?DEBUG("begin server cleanup", []), + server_clean_up(ServerRoot, WorkDir, Host), + ?DEBUG("begin lient cleanup", []), + clients_clean_up(WorkDir, Clients), + ?DEBUG("cleanup done", []), + ok. + +server_clean_up(ServerRoot, WorkDir, Host) -> + ?DEBUG("server cleanup - create sftp channel", []), + {ok, Sftp, ConnectionRef} = + ssh_sftp:start_channel(Host, [{user_interaction, false}, + {silently_accept_hosts, true}]), + ?DEBUG("server cleanup - delete ~p dirs", [ServerRoot]), + del_dirs(Sftp, ServerRoot), + ?DEBUG("server cleanup - delete ~p dirs", [WorkDir]), + del_dirs(Sftp, WorkDir), + ?DEBUG("server cleanup - close sftp channel", []), + ssh:close(ConnectionRef). + +clients_clean_up(_WorkDir, []) -> + ok; +clients_clean_up(WorkDir, [Client|Clients]) -> + client_clean_up(WorkDir, Client), + clients_clean_up(WorkDir, Clients). + +client_clean_up(WorkDir, #client{host = Host}) -> + ?DEBUG("client cleanup - create sftp channel to ~p", [Host]), + {ok, Sftp, ConnectionRef} = + ssh_sftp:start_channel(Host, [{user_interaction, false}, + {silently_accept_hosts, true}]), + ?DEBUG("client cleanup - delete ~p dirs", [WorkDir]), + del_dirs(Sftp, WorkDir), + ?DEBUG("client cleanup - close sftp channel", []), + ssh:close(ConnectionRef). + + +del_dirs(Sftp, Dir) -> + case ssh_sftp:list_dir(Sftp, Dir) of + {ok, []} -> + ssh_sftp:del_dir(Sftp, Dir); + {ok, Files} -> + Files2 = [F || F <- Files, (F =/= "..") andalso (F =/= ".")], + lists:foreach(fun(File) when ((File =/= "..") andalso + (File =/= ".")) -> + FullPath = filename:join(Dir, File), + case ssh_sftp:read_file_info(Sftp, + FullPath) of + {ok, #file_info{type = directory}} -> + del_dirs(Sftp, FullPath), + ssh_sftp:del_dir(Sftp, FullPath); + {ok, _} -> + ssh_sftp:delete(Sftp, FullPath) + end + end, Files2); + _ -> + ok + end. + +collect_data(#state{clients = Clients} = State) -> + N = length(Clients), + collect_req_reply(N, State), + collect_time(N, State). + +collect_req_reply(0, _State) -> + ?DEBUG("all reply data collected", []), + ok; +collect_req_reply(N, #state{nof_schedulers = NofScheduler, + results = Db, + client_conns = Conns} = State) -> + ?DEBUG("await reply data from ~p client(s)", [N]), + receive + {load_data, + {req_reply, Client, NoRequests, NoReplys}} -> + ?DEBUG("received req_reply load-data from client ~p: " + "~n Number of requests: ~p" + "~n Number of replies: ~p", + [Client, NoRequests, NoReplys]), + ets:insert(Db, {{NofScheduler, Client}, + {req_reply, NoRequests, NoReplys}}); + stop -> + ?INFO("received stop", []), + exit(self(), stop); + + {client_exit, Client, Node, Reason} -> + ?INFO("Received unexpected client exit from ~p on node ~p " + "while collecting replies: " + "~n ~p", [Client, Node, Reason]), + case lists:keysearch(Node, #connection.node, Conns) of + {value, Conn} -> + ?LOG("Found problem connection: " + "~n ~p", [Conn]), + exit({unexpected_client_exit, Reason}); + false -> + collect_req_reply(N, State) + end + end, + collect_req_reply(N-1, State). + +collect_time(0, _State) -> + ?DEBUG("all time data collected", []), + ok; +collect_time(N, #state{nof_schedulers = NofScheduler, + results = Db, + client_conns = Conns} = State) -> + ?DEBUG("await time data from ~p clients", [N]), + receive + {load_data, + {time_to_complete, Client, StopTime, LastResponseTime}} -> + ?LOG("received time load-data from client ~p: " + "~n Time of stop: ~p" + "~n Time of last response: ~p", + [Client, StopTime, LastResponseTime]), + ets:insert(Db, {{NofScheduler, Client}, + {time, StopTime, LastResponseTime}}); + stop -> + ?INFO("received stop while collecting data, when N = ~p", [N]), + exit(self(), stop); + + {client_exit, Client, Node, Reason} -> + ?INFO("Received unexpected exit from client ~p on node ~p " + "while collecting time data: " + "~n ~p", [Client, Node, Reason]), + case lists:keysearch(Node, #connection.node, Conns) of + {value, Conn} -> + ?LOG("Found problem connection: " + "~n ~p", [Conn]), + exit({unexpected_client_exit, Reason}); + false -> + collect_req_reply(N, State) + end; + + Else -> %%% Something is wrong! + ?INFO("RECEIVED UNEXPECTED MESSAGE WHILE COLLECTING TIME DATA: " + "~n ~p", [Else]), + collect_time(N, State) + end, + collect_time(N-1, State). + +analyse_data(#state{results = Db, + max_nof_schedulers = MaxNofSchedulers, + test_time = MicroSec}) -> + Tab = ets:new(analysed_results, [set]), + lists:foreach(fun(NofSchedulers) -> + Result = analyse(NofSchedulers, Db, MicroSec), + ets:insert(Tab, Result) + end, [N || N <- lists:seq(0, MaxNofSchedulers)]), + Tab. + + +no_requests_replys(NoSchedulers, Tab) -> + NoRequests = + ets:select(Tab, [{{{NoSchedulers,'_'},{req_reply, '$1', '_'}}, + [],['$$']}]), + NoReplys = + ets:select(Tab, [{{{NoSchedulers, '_'}, {req_reply, '_', '$1'}}, + [], ['$$']}]), + + {lists:sum(lists:append(NoRequests)), + lists:sum(lists:append(NoReplys))}. + +max_time_to_final_response(NofSchedulers, Tab) -> + Candidates = + ets:select(Tab, [{{{NofSchedulers, '_'}, {time, '$1', '$2'}}, + [], ['$$']}]), + + NewCandidates = lists:map( + fun([StopTime, LastTime]) -> + round( + timer:now_diff(LastTime, StopTime) / 100000)/10 + end, Candidates), + + lists:max(NewCandidates). + + +analyse(NofSchedulers, Db, TestTime) -> + Sec = TestTime / 1000, + {NoRequests, NoReplys} = no_requests_replys(NofSchedulers, Db), + {NofSchedulers, round(NoReplys / Sec), NoRequests, + max_time_to_final_response(NofSchedulers, Db)}. + + +save_results_to_file(AnalysedTab, + #state{socket_type = SocketType, + http_server = #server{host = Server}, + max_nof_schedulers = MaxNofSchedulers}) -> + FileName = fun(Post) -> + File = + lists:flatten( + io_lib:format("~s_~w_~s", + [Server, SocketType, Post])), + filename:join("./", File) + end, + Reps = FileName("replys_per_sec.txt"), + Reqs = FileName("total_requests.txt"), + Decay = FileName("decay_time.txt"), + + [FdReps, FdReqs, FdDecay] = + lists:map(fun(File) -> + {ok, Fd} = file:open(File, [write]), + Fd + end, [Reps, Reqs, Decay]), + lists:foreach(fun(NofSchedulers) -> + save_result_to_file(NofSchedulers, + FdReps, FdReqs, + FdDecay, AnalysedTab) + end, [N || N <- lists:seq(0, MaxNofSchedulers)]), + [Reps, Reqs, Decay]. + +save_result_to_file(NofSchedulers, + FdReps, FdReqs, FdDecay, AnalysedTab) -> + + [{NofSchedulers, NofRepsPerSec, NofReqs, MaxFinalResponseTime}] = + ets:lookup(AnalysedTab, NofSchedulers), + + file:write(FdReps, io_lib:format("~p,~p~n", + [NofRepsPerSec, NofSchedulers])), + file:write(FdReqs, io_lib:format("~p,~p~n", + [NofReqs, NofSchedulers])), + file:write(FdDecay, io_lib:format("~p,~p~n", [MaxFinalResponseTime, + NofSchedulers])). + + +help() -> + io:format("hdlt:start(Options). Where options:~n " + " ~n~p~n~n hdlt:start([]). -> hdlt:start(~p)~n~n", + [[{send_rate, "integer()", + "Numer of outstanding requests that a client " + "should have during the test to create a load situation."}, + {clients, "[{path(), host()}]", "Paths to erlang and names of hosts to run clients on."}, + {test_time, "{hours(), mins(), sec()}", + "How long the test should be run."}, + {server, "{path(), host()}", "Path to erl and name of host to run the HTTP-server on."}, + {port, "port()", "The port that the HTTP-server should use."}, + {server_dir, "dir()", "The directory where the HTTP server " + " stores its contents and configuration."}, + {work_dir, "dir()", "Path on the computer, where the test " + "is run, to a directory where the results can be saved."}, + {max_no_schedulers, "integer()", + "Max number of schedulers to run."}, + {socket_type, "Httpd configuration option socket_type"}], + defaults()]). + + +defaults() -> + [{send_rate, ?DEFAULT_SENDRATE}, + %% {clients, []}, + {test_time, ?DEFAULT_TEST_TIME}, + %% {server, ?DEFAULT_SERVER}, + {port, ?DEFAULT_PORT}, + {server_dir, ?DEFAULT_SERVER_DIR}, + {work_dir, ?DEFAULT_WORK_DIR}, + {max_nof_schedulers, ?DEFAULT_MAX_NOF_SCHEDULERS}, + {socket_type, ?DEFAULT_SOCKET_TYPE}]. + + +get_debugs(Config) -> + ?DEBUG("get debugs", []), + Debugs = proplists:get_value(debug, Config, ?DEFAULT_DEBUGS), + verify_debugs(Debugs), + Debugs. + +verify_debugs([]) -> + ok; +verify_debugs([{Tag, Debug}|Debugs]) -> + verify_debug(Tag, Debug), + verify_debugs(Debugs). + +verify_debug(Tag, Debug) -> + case lists:member(Tag, [ctrl, proxy, slave, client]) of + true -> + ok; + false -> + exit({bad_debug_tag, Tag}) + end, + case lists:member(Debug, [silence, info, log, debug]) of + true -> + ok; + false -> + exit({bad_debug_level, Debug}) + end. + +get_send_rate(Config) -> + ?DEBUG("get send_rate", []), + case proplists:get_value(send_rate, Config, ?DEFAULT_SENDRATE) of + SendRate when is_integer(SendRate) andalso (SendRate > 0) -> + SendRate; + BadSendRate -> + exit({bad_sendrate, BadSendRate}) + end. + + +get_clients(Config) -> + ?DEBUG("get clients", []), + case proplists:get_value(clients, Config, undefined) of + undefined -> + missing_mandatory_config(clients); + Clients when is_list(Clients) andalso (length(Clients) > 0) -> + case [#client{path = Path, host = Host} || + {Path, Host} <- Clients] of + Clients2 when (length(Clients2) > 0) -> + Clients2; + _ -> + exit({bad_clients, Clients}) + end; + + BadClients -> + exit({bad_clients, BadClients}) + + end. + +get_server(Config) -> + ?DEBUG("get server", []), + case proplists:get_value(server, Config) of + {Path, Host} when is_list(Path) andalso is_list(Host) -> + #server{path = Path, host = Host}; + undefined -> + missing_mandatory_config(server) + end. + +get_server_dir(Config) -> + ?DEBUG("get server_dir", []), + get_dir(server_dir, Config, ?DEFAULT_SERVER_DIR). + +get_work_dir(Config) -> + ?DEBUG("get work_dir", []), + get_dir(work_dir, Config, ?DEFAULT_WORK_DIR). + +get_dir(Key, Config, Default) -> + Dir = proplists:get_value(Key, Config, Default), + ensure_absolute(Dir), + Dir. + +ensure_absolute(Path) -> + case filename:pathtype(Path) of + absolute -> + ok; + PathType -> + exit({bad_pathtype, Path, PathType}) + end. + +get_port(Config) -> + ?DEBUG("get port", []), + case proplists:get_value(port, Config, ?DEFAULT_PORT) of + Port when is_integer(Port) andalso (Port > 0) -> + Port; + BadPort -> + exit({bad_port, BadPort}) + end. + +get_socket_type(Config) -> + ?DEBUG("get socket_type", []), + case proplists:get_value(socket_type, Config, ?DEFAULT_SOCKET_TYPE) of + SocketType when ((SocketType =:= ip_comm) orelse + (SocketType =:= ssl) orelse + (SocketType =:= essl) orelse + (SocketType =:= ossl)) -> + SocketType; + BadSocketType -> + exit({bad_socket_type, BadSocketType}) + end. + +get_test_time(Config) -> + ?DEBUG("get test_time", []), + case proplists:get_value(test_time, Config, ?DEFAULT_TEST_TIME) of + Seconds when is_integer(Seconds) andalso (Seconds > 0) -> + timer:seconds(Seconds); + BadTestTime -> + exit({bad_test_time, BadTestTime}) + end. + +get_max_nof_schedulers(Config) -> + ?DEBUG("get max_nof_schedulers", []), + case proplists:get_value(max_nof_schedulers, + Config, + ?DEFAULT_MAX_NOF_SCHEDULERS) of + MaxNofScheds when (is_integer(MaxNofScheds) andalso + (MaxNofScheds >= 0)) -> + MaxNofScheds; + BadMaxNofScheds -> + exit({bad_max_nof_schedulers, BadMaxNofScheds}) + end. + + +get_server_cert_file(Config) -> + ?DEBUG("get server cert file", []), + get_cert_file(server_cert_file, ?DEFAULT_SERVER_CERT, Config). + +get_client_cert_file(Config) -> + ?DEBUG("get client cert file", []), + get_cert_file(client_cert_file, ?DEFAULT_CLIENT_CERT, Config). + +get_cert_file(Tag, DefaultCertFileName, Config) -> + LibDir = code:lib_dir(inets), + HdltDir = filename:join(LibDir, "examples/httpd_load_test"), + DefaultCertFile = filename:join(HdltDir, DefaultCertFileName), + case proplists:get_value(Tag, Config, DefaultCertFile) of + F when is_list(F) -> + case file:read_file_info(F) of + {ok, #file_info{type = regular}} -> + F; + {ok, #file_info{type = Type}} -> + exit({wrong_file_type, Tag, F, Type}); + {error, Reason} -> + exit({failed_readin_file_info, Tag, F, Reason}) + end; + BadFile -> + exit({bad_cert_file, Tag, BadFile}) + end. + + +get_work_sim(Config) -> + ?DEBUG("get work_sim", []), + case proplists:get_value(work_simulator, Config, ?DEFAULT_WORK_SIM) of + WS when is_integer(WS) andalso (WS > 0) -> + WS; + BadWS -> + exit({bad_work_simulator, BadWS}) + end. + + +get_data_size(Config) -> + ?DEBUG("get data_size", []), + case proplists:get_value(data_size, Config, ?DEFAULT_DATA_SIZE) of + {From, To, Incr} = DS when (is_integer(From) andalso + is_integer(To) andalso + is_integer(Incr) andalso + (To > From) andalso + (From > 0) andalso + (Incr > 0)) -> + DS; + {From, To} when (is_integer(From) andalso + is_integer(To) andalso + (To > From) andalso + (From > 0)) -> + {From, To, ?DEFAULT_DATA_SIZE_INCR}; + BadDS -> + exit({bad_data_size, BadDS}) + end. + + +url(#server{host = Host}, Port, SocketType, WorkSim) -> + Scheme = + case SocketType of + ip_comm -> + "http"; + _ -> %% SSL + "https" + end, + lists:flatten( + io_lib:format("~s://~s:~w/cgi-bin/hdlt_random_html:page?~w:", + [Scheme, Host, Port, WorkSim])). + + +missing_mandatory_config(Missing) -> + exit({missing_mandatory_config, Missing}). + + +ensure_remote_dir_exist(Sftp, Path0) -> + case filename:split(Path0) of + [Root, Dir | Rest] -> + %% We never accept creating the root directory, + %% or the next level, so these *must* exist: + Path = filename:join(Root, Dir), + case ssh_sftp:read_file_info(Sftp, Path) of + {ok, #file_info{type = directory}} -> + ensure_remote_dir_exist(Sftp, Path, Rest); + {ok, #file_info{type = Type}} -> + ?INFO("Not a dir: ~p (~p)", [Path, Type]), + exit({not_a_dir, Path, Type}); + {error, Reason} -> + ?INFO("Failed reading file info for ~p: ~p", + [Path, Reason]), + exit({failed_reading_file_info, Path, Reason}) + end; + BadSplit -> + ?INFO("Bad remote dir path: ~p -> ~p", [Path0, BadSplit]), + exit({bad_dir, Path0}) + end. + +ensure_remote_dir_exist(_Sftp, _Dir, []) -> + ok; +ensure_remote_dir_exist(Sftp, Path, [Dir|Rest]) -> + NewPath = filename:join(Path, Dir), + case ssh_sftp:read_file_info(Sftp, NewPath) of + {ok, #file_info{type = directory}} -> + ensure_remote_dir_exist(Sftp, NewPath, Rest); + {ok, #file_info{type = Type}} -> + %% Exist, but is not a dir + ?INFO("Not a dir: ~p (~p)", [NewPath, Type]), + exit({not_a_dir, NewPath, Type}); + {error, Reason} -> + %% This *could* be because the dir does not exist, + %% but it could also be some other error. + %% As usual, the error reason of the sftp is + %% a pease of crap, so we cannot use the + %% error reason. + %% The simplest way to test this is to simply + %% try to create the directory, since we should + %% ensure its existence anyway.. + case ssh_sftp:make_dir(Sftp, NewPath) of + ok -> + ensure_remote_dir_exist(Sftp, NewPath, Rest); + _ -> + ?INFO("Failed reading file info for ~p: ~p", + [Dir, Reason]), + exit({failed_reading_file_info, NewPath, Reason}) + end + end. + +maybe_create_remote_dir(Sftp, Dir) -> + case ssh_sftp:read_file_info(Sftp, Dir) of + {ok, #file_info{type = directory}} -> + ok; + {ok, #file_info{type = Type}} -> + %% Exist, but is not a dir + ?INFO("Not a dir: ~p (~p)", [Dir, Type]), + exit({not_a_dir, Dir, Type}); + {error, Reason} -> + %% Assume dir noes not exist... + case ssh_sftp:make_dir(Sftp, Dir) of + ok -> + ok; + _ -> + ?INFO("Failed reading file info for ~p: ~p", + [Dir, Reason]), + exit({failed_reading_file_info, Dir, Reason}) + end + end. + + +set_debug_level(Debugs) -> + Debug = proplists:get_value(ctrl, Debugs, silence), + ?SET_LEVEL(Debug). + + +%% Generates a list of numbers between A and B, such that +%% there is exact one number between A and B and then +%% randomizes that list. + +randomized_sizes_init() -> + {A, B, C} = os:timestamp(), + random:seed(A, B, C). + +randomized_sizes(From, To, Incr) -> + L = lists:seq(From, To, Incr), + Len = length(L), + randomized_sizes2(L, 0, Len-1). + +randomized_sizes2(L, N, Len) when N >= Len -> + L; +randomized_sizes2(L, N, Len) -> + SplitWhere = random:uniform(Len), + {A, B} = lists:split(SplitWhere, L), + randomized_sizes2(B ++ A, N+1, Len). diff --git a/lib/inets/examples/httpd_load_test/hdlt_logger.erl b/lib/inets/examples/httpd_load_test/hdlt_logger.erl new file mode 100644 index 0000000000..b0c7eab2d1 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_logger.erl @@ -0,0 +1,138 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +%% Purpose: This is a simple logger utility for the HDLT toolkit. +%% It assumesd that the debug level and the "name" of the +%% logging entity has been put in process environment +%% (using the set_level and set_name functions respectively). +%%---------------------------------------------------------------------- + +%% + +-module(hdlt_logger). + +-export([ + start/0, + set_level/1, get_level/0, set_name/1, + info/2, log/2, debug/2 + ]). + +-export([logger/1]). + +-define(LOGGER, ?MODULE). +-define(MSG, hdlt_logger_msg). +-define(LEVEL, hdlt_logger_level). +-define(NAME, hdlt_logger_name). +-define(INFO_STR, "INFO"). +-define(LOG_STR, "LOG "). +-define(DEBUG_STR, "DBG "). + + +start() -> + Self = self(), + proc_lib:start(?MODULE, logger, [Self]). + +set_name(Name) when is_list(Name) -> + put(?NAME, Name), + ok. + +get_level() -> + get(?LEVEL). + +set_level(Level) -> + case lists:member(Level, [silence, info, log, debug]) of + true -> + put(?LEVEL, Level), + ok; + false -> + erlang:error({bad_debug_level, Level}) + end. + + +info(F, A) -> +%% io:format("info -> " ++ F ++ "~n", A), + do_log(info, get(?LEVEL), F, A). + +log(F, A) -> +%% io:format("log -> " ++ F ++ "~n", A), + do_log(log, get(?LEVEL), F, A). + +debug(F, A) -> +%% io:format("debug -> " ++ F ++ "~n", A), + do_log(debug, get(?LEVEL), F, A). + + +logger(Parent) -> + global:register_name(?LOGGER, self()), + Ref = erlang:monitor(process, Parent), + proc_lib:init_ack(self()), + logger_loop(Ref). + +logger_loop(Ref) -> + receive + {?MSG, F, A} -> + io:format(F, A), + logger_loop(Ref); + {'DOWN', Ref, process, _Object, _Info} -> + %% start the stop timer + erlang:send_after(timer:seconds(5), self(), stop), + logger_loop(undefined); + stop -> + global:unregister_name(?LOGGER), + ok + end. + + +formated_timestamp() -> + {Date, Time} = erlang:localtime(), + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w", + [YYYY,MM,DD,Hour,Min,Sec]), + lists:flatten(FormatDate). + +do_log(_, silence, _, _) -> + ok; +do_log(info, info, F, A) -> + do_log(?INFO_STR, F, A); +do_log(info, log, F, A) -> + do_log(?INFO_STR, F, A); +do_log(log, log, F, A) -> + do_log(?LOG_STR, F, A); +do_log(info, debug, F, A) -> + do_log(?INFO_STR, F, A); +do_log(log, debug, F, A) -> + do_log(?LOG_STR, F, A); +do_log(debug, debug, F, A) -> + do_log(?DEBUG_STR, F, A); +do_log(_, _, _F, _A) -> + ok. + +do_log(SEV, F, A) -> + Name = + case get(?NAME) of + L when is_list(L) -> + L; + _ -> + "UNDEFINED" + end, + Msg = {?MSG, "~s ~s [~s] " ++ F ++ "~n", + [SEV, Name, formated_timestamp() | A]}, + (catch global:send(?LOGGER, Msg)). diff --git a/lib/inets/examples/httpd_load_test/hdlt_logger.hrl b/lib/inets/examples/httpd_load_test/hdlt_logger.hrl new file mode 100644 index 0000000000..aa94babc48 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_logger.hrl @@ -0,0 +1,33 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-ifndef(hdlt_logger_hrl). +-define(hdlt_logger_hrl, true). + +%% Various log macros +-define(SET_LEVEL(N), hdlt_logger:set_level(N)). +-define(GET_LEVEL(), hdlt_logger:get_level()). +-define(SET_NAME(N), hdlt_logger:set_name(N)). + +-define(INFO(F, A), hdlt_logger:info(F, A)). +-define(LOG(F, A), hdlt_logger:log(F, A)). +-define(DEBUG(F, A), hdlt_logger:debug(F, A)). + +-endif. % -ifdef(hdlt_logger_hrl). diff --git a/lib/inets/examples/httpd_load_test/hdlt_random_html.erl b/lib/inets/examples/httpd_load_test/hdlt_random_html.erl new file mode 100644 index 0000000000..e3a572c61f --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_random_html.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(hdlt_random_html). +-export([page/3]). + +page(SessionID, _Env, Input) -> +%% log("page(~p) -> deliver content-type when" +%% "~n SessionID: ~p" +%% "~n Env: ~p" +%% "~n Input: ~p", [self(), SessionID, Env, Input]), + [WorkSimStr, SzSimStr] = string:tokens(Input, [$:]), + WorkSim = list_to_integer(WorkSimStr), + SzSim = list_to_integer(SzSimStr), + mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"), + mod_esi:deliver(SessionID, start("Random test page")), + mod_esi:deliver(SessionID, content(WorkSim, SzSim)), + mod_esi:deliver(SessionID, stop()), + ok. + +start(Title) -> + "<HTML> +<HEAD> +<TITLE>" ++ Title ++ "</TITLE> + </HEAD> +<BODY>\n". + +stop() -> + "</BODY> +</HTML> +". + +content(WorkSim, SzSim) -> + {A, B, C} = now(), + random:seed(A, B, C), + lists:sort([random:uniform(X) || X <- lists:seq(1, WorkSim)]), + lists:flatten(lists:duplicate(SzSim, "Dummy data ")). + +%% log(F, A) -> +%% hdlt_logger:set_name("HDLT RANDOM-HTML"), +%% hdlt_logger:set_level(debug), +%% hdlt_logger:log(F, A). diff --git a/lib/inets/examples/httpd_load_test/hdlt_server.erl b/lib/inets/examples/httpd_load_test/hdlt_server.erl new file mode 100644 index 0000000000..3e5a849d5b --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_server.erl @@ -0,0 +1,163 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%---------------------------------------------------------------------- +%% Purpose: The HDLT server module. +%% This is just a stub, making future expansion easy. +%% All code in this module is executed in the local node! +%%---------------------------------------------------------------------- + +-module(hdlt_server). + +-export([start/1, stop/0, start_inets/0, start_service/1]). + +-export([proxy/1]). + +-include_lib("kernel/include/file.hrl"). +-include("hdlt_logger.hrl"). + + +-define(PROXY, hdlt_proxy). + + +%% This function is used to start the proxy process +%% This function is called *after* the nodes has been +%% "connected" with the controller/collector node. + +start(Debug) -> + proc_lib:start(?MODULE, proxy, [Debug]). + +stop() -> + ?PROXY ! stop. + +start_inets() -> + ?PROXY ! start_inets. + +start_service(Config) -> + ?PROXY ! {server_start, Config, self()}, + receive + {server_start_result, Result} -> + Result + after 15000 -> + {error, timeout} + end. + + +proxy(Debug) -> + process_flag(trap_exit, true), + erlang:register(?PROXY, self()), + ?SET_NAME("HDLT PROXY"), + ?SET_LEVEL(Debug), + ?LOG("starting", []), + Ref = await_for_controller(10), + CtrlNode = node(Ref), + erlang:monitor_node(CtrlNode, true), + proc_lib:init_ack({ok, self()}), + ?DEBUG("started", []), + proxy_loop(Ref, CtrlNode). + +await_for_controller(N) when N > 0 -> + case global:whereis_name(hdlt_ctrl) of + Pid when is_pid(Pid) -> + erlang:monitor(process, Pid); + _ -> + timer:sleep(1000), + await_for_controller(N-1) + end; +await_for_controller(_) -> + proc_lib:init_ack({error, controller_not_found, nodes()}), + timer:sleep(500), + halt(). + + +proxy_loop(Ref, CtrlNode) -> + ?DEBUG("await command", []), + receive + stop -> + ?LOG("received stop", []), + halt(); + + start_inets -> + ?LOG("start the inets service framework", []), + case (catch inets:start()) of + ok -> + ?LOG("framework started", []), + proxy_loop(Ref, CtrlNode); + Error -> + ?LOG("failed starting inets service framework: " + "~n Error: ~p", [Error]), + halt() + end; + + {server_start, Config, From} -> + ?LOG("start-server", []), + maybe_start_crypto_and_ssl(Config), + %% inets:enable_trace(max, "/tmp/inets-httpd-trace.log", httpd), + %% inets:enable_trace(max, "/tmp/inets-httpd-trace.log", all), + case (catch inets:start(httpd, Config)) of + {ok, _} -> + ?LOG("server started when" + "~n which(inets): ~p" + "~n RootDir: ~p" + "~n System info: ~p", [code:which(inets), + code:root_dir(), + get_node_info()]), + From ! {server_start_result, ok}, + proxy_loop(Ref, CtrlNode); + Error -> + ?INFO("server start failed" + "~n Error: ~p", [Error]), + From ! {server_start_result, Error}, + halt() + end; + + {nodedown, CtrlNode} -> + ?LOG("received nodedown for controller node - terminate", []), + halt(); + + {'DOWN', Ref, process, _, _} -> + ?LOG("received DOWN message for controller - terminate", []), + %% The controller has terminated, time to die + halt() + + end. + + +maybe_start_crypto_and_ssl(Config) -> + case lists:keysearch(socket_type, 1, Config) of + {value, {socket_type, SocketType}} when ((SocketType =:= ssl) orelse + (SocketType =:= ossl) orelse + (SocketType =:= essl)) -> + ?LOG("maybe start crypto and ssl", []), + (catch crypto:start()), + ssl:start(); + _ -> + ok + end. + + +get_node_info() -> + [{cpu_topology, erlang:system_info(cpu_topology)}, + {heap_type, erlang:system_info(heap_type)}, + {nof_schedulers, erlang:system_info(schedulers)}, + {otp_release, erlang:system_info(otp_release)}, + {version, erlang:system_info(version)}, + {system_version, erlang:system_info(system_version)}, + {system_architecture, erlang:system_info(system_architecture)}]. + diff --git a/lib/inets/examples/httpd_load_test/hdlt_slave.erl b/lib/inets/examples/httpd_load_test/hdlt_slave.erl new file mode 100644 index 0000000000..52af9b5b90 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_slave.erl @@ -0,0 +1,291 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(hdlt_slave). + + +-export([start_link/4, start_link/5, start_link/6, stop/1]). + +%% Internal exports +-export([wait_for_slave/9, slave_start/1, wait_for_master_to_die/3]). + +-include("hdlt_logger.hrl"). + +-define(SSH_PORT, 22). +-define(TIMEOUT, 60000). +-define(LOGGER, hdlt_logger). + + +%% *********************************************************************** +%% start_link/4,5 -- +%% +%% The start/4,5 functions are used to start a slave Erlang node. +%% The node on which the start/N functions are used is called the +%% master in the description below. +%% +%% If hostname is the same for the master and the slave, +%% the Erlang node will simply be spawned. The only requirment for +%% this to work is that the 'erl' program can be found in PATH. +%% +%% If the master and slave are on different hosts, start/N uses +%% the 'rsh' program to spawn an Erlang node on the other host. +%% Alternative, if the master was started as +%% 'erl -sname xxx -rsh my_rsh...', then 'my_rsh' will be used instead +%% of 'rsh' (this is useful for systems where the rsh program is named +%% 'remsh'). +%% +%% For this to work, the following conditions must be fulfilled: +%% +%% 1. There must be an Rsh program on computer; if not an error +%% is returned. +%% +%% 2. The hosts must be configured to allowed 'rsh' access without +%% prompts for password. +%% +%% The slave node will have its filer and user server redirected +%% to the master. When the master node dies, the slave node will +%% terminate. For the start_link functions, the slave node will +%% terminate also if the process which called start_link terminates. +%% +%% Returns: {ok, Name@Host} | +%% {error, timeout} | +%% {error, no_rsh} | +%% {error, {already_running, Name@Host}} + +start_link(Host, Name, ErlPath, Paths) -> + start_link(Host, Name, ErlPath, Paths, [], silence). + +start_link(Host, Name, ErlPath, Paths, DebugLevel) when is_atom(DebugLevel) -> + start_link(Host, Name, ErlPath, Paths, [], DebugLevel); +start_link(Host, Name, ErlPath, Paths, Args) when is_list(Args) -> + start_link(Host, Name, ErlPath, Paths, Args, silence). + +start_link(Host, Name, ErlPath, Paths, Args, DebugLevel) -> + Node = list_to_atom(lists:concat([Name, "@", Host])), + case net_adm:ping(Node) of + pang -> + start_it(Host, Name, Node, ErlPath, Paths, Args, DebugLevel); + pong -> + {error, {already_running, Node}} + end. + +%% Stops a running node. + +stop(Node) -> + rpc:call(Node, erlang, halt, []), + ok. + + +%% Starts a new slave node. + +start_it(Host, Name, Node, ErlPath, Paths, Args, DebugLevel) -> + Prog = filename:join([ErlPath, "erl"]), + spawn(?MODULE, wait_for_slave, [self(), Host, Name, Node, Paths, Args, self(), Prog, DebugLevel]), + receive + {result, Result} -> Result + end. + +%% Waits for the slave to start. + +wait_for_slave(Parent, Host, Name, Node, Paths, Args, + LinkTo, Prog, DebugLevel) -> + ?SET_NAME("HDLT SLAVE STARTER"), + ?SET_LEVEL(DebugLevel), + ?DEBUG("begin", []), + Waiter = register_unique_name(0), + case mk_cmd(Host, Name, Paths, Args, Waiter, Prog) of + {ok, Cmd} -> + ?DEBUG("command generated: ~n~s", [Cmd]), + case (catch ssh_slave_start(Host, Cmd)) of + {ok, Conn, _Chan} -> + ?DEBUG("ssh channel created", []), + receive + {SlavePid, slave_started} -> + ?DEBUG("slave started: ~p", [SlavePid]), + unregister(Waiter), + slave_started(Parent, LinkTo, SlavePid, Conn, + DebugLevel) + after 32000 -> + ?INFO("slave node failed to report in on time", + []), + %% If it seems that the node was partially started, + %% try to kill it. + case net_adm:ping(Node) of + pong -> + spawn(Node, erlang, halt, []), + ok; + _ -> + ok + end, + Parent ! {result, {error, timeout}} + end; + {error, Reason} = Error -> + ?INFO("FAILED starting node: " + "~n ~p" + "~n ~p", [Reason, Cmd]), + Parent ! {result, Error} + end; + Other -> + ?INFO("FAILED creating node command string: " + "~n ~p", [Other]), + Parent ! {result, Other} + end. + + +ssh_slave_start(Host, ErlCmd) -> + ?DEBUG("ssh_slave_start -> try connect to ~p", [Host]), + Connection = + case (catch ssh:connect(Host, ?SSH_PORT, + [{silently_accept_hosts, true}])) of + {ok, Conn} -> + ?DEBUG("ssh_exec_erl -> connected: ~p", [Conn]), + Conn; + Error1 -> + ?LOG("failed connecting to ~p: ~p", [Host, Error1]), + throw({error, {ssh_connect_failed, Error1}}) + end, + + ?DEBUG("ssh_exec_erl -> connected - now create channel", []), + Channel = + case (catch ssh_connection:session_channel(Connection, ?TIMEOUT)) of + {ok, Chan} -> + ?DEBUG("ssh_exec_erl -> channel ~p created", [Chan]), + Chan; + Error2 -> + ?LOG("failed creating channel: ~p", [Error2]), + throw({error, {ssh_channel_create_failed, Error2}}) + end, + + ?DEBUG("ssh_exec_erl -> channel created - now exec command: " + "~n ~p", [ErlCmd]), + case (catch ssh_connection:exec(Connection, Channel, ErlCmd, infinity)) of + success -> + ?DEBUG("ssh_exec_erl -> command exec'ed - clean ssh msg", []), + clean_ssh_msg(), + ?DEBUG("ssh_exec_erl -> done", []), + {ok, Connection, Channel}; + Error3 -> + ?LOG("failed exec comand: ~p", [Error3]), + throw({error, {ssh_exec_failed, Error3}}) + end. + +clean_ssh_msg() -> + receive + {ssh_cm, _X, _Y} -> + clean_ssh_msg() + after 1000 -> + ok + end. + + +slave_started(ReplyTo, Master, Slave, Conn, Level) + when is_pid(Master) andalso is_pid(Slave) -> + process_flag(trap_exit, true), + SName = lists:flatten( + io_lib:format("HDLT SLAVE CTRL[~p,~p]", + [self(), node(Slave)])), + ?SET_NAME(SName), + ?SET_LEVEL(Level), + ?LOG("initiating", []), + MasterRef = erlang:monitor(process, Master), + SlaveRef = erlang:monitor(process, Slave), + ReplyTo ! {result, {ok, node(Slave)}}, + slave_running(Master, MasterRef, Slave, SlaveRef, Conn). + + +%% The slave node will be killed if the master process terminates, +%% The master process will not be killed if the slave node terminates. + +slave_running(Master, MasterRef, Slave, SlaveRef, Conn) -> + ?DEBUG("await message", []), + receive + {'DOWN', MasterRef, process, _Object, _Info} -> + ?LOG("received DOWN from master", []), + erlang:demonitor(SlaveRef, [flush]), + Slave ! {nodedown, node()}, + ssh:close(Conn); + + {'DOWN', SlaveRef, process, Object, _Info} -> + ?LOG("received DOWN from slave (~p)", [Object]), + erlang:demonitor(MasterRef, [flush]), + ssh:close(Conn); + + Other -> + ?DEBUG("received unknown: ~n~p", [Other]), + slave_running(Master, MasterRef, Slave, SlaveRef, Conn) + + end. + +register_unique_name(Number) -> + Name = list_to_atom(lists:concat([?MODULE, "_waiter_", Number])), + case catch register(Name, self()) of + true -> + Name; + {'EXIT', {badarg, _}} -> + register_unique_name(Number+1) + end. + + +%% Makes up the command to start the nodes. +%% If the node should run on the local host, there is +%% no need to use rsh. + +mk_cmd(Host, Name, Paths, Args, Waiter, Prog) -> + PaPaths = [[" -pa ", Path] || Path <- Paths], + {ok, lists:flatten( + lists:concat([Prog, + " -detached -nopinput ", + Args, " ", + " -sname ", Name, "@", Host, + " -s ", ?MODULE, " slave_start ", node(), + " ", Waiter, + " ", PaPaths]))}. + + +%% This function will be invoked on the slave, using the -s option of erl. +%% It will wait for the master node to terminate. + +slave_start([Master, Waiter]) -> + spawn(?MODULE, wait_for_master_to_die, [Master, Waiter, silence]); +slave_start([Master, Waiter, Level]) -> + spawn(?MODULE, wait_for_master_to_die, [Master, Waiter, Level]). + + +wait_for_master_to_die(Master, Waiter, Level) -> + process_flag(trap_exit, true), + SName = lists:flatten( + io_lib:format("HDLT-SLAVE MASTER MONITOR[~p,~p,~p]", + [self(), node(), Master])), + ?SET_NAME(SName), + ?SET_LEVEL(Level), + erlang:monitor_node(Master, true), + {Waiter, Master} ! {self(), slave_started}, + wloop(Master). + +wloop(Master) -> + ?DEBUG("await message", []), + receive + {nodedown, Master} -> + ?INFO("received master nodedown", []), + halt(); + _Other -> + wloop(Master) + end. + + + diff --git a/lib/inets/examples/httpd_load_test/hdlt_ssl_client_cert.pem b/lib/inets/examples/httpd_load_test/hdlt_ssl_client_cert.pem new file mode 120000 index 0000000000..41644a1098 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_ssl_client_cert.pem @@ -0,0 +1 @@ +../../test/httpc_SUITE_data/ssl_client_cert.pem
\ No newline at end of file diff --git a/lib/inets/examples/httpd_load_test/hdlt_ssl_server_cert.pem b/lib/inets/examples/httpd_load_test/hdlt_ssl_server_cert.pem new file mode 120000 index 0000000000..41644a1098 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/hdlt_ssl_server_cert.pem @@ -0,0 +1 @@ +../../test/httpc_SUITE_data/ssl_client_cert.pem
\ No newline at end of file diff --git a/lib/inets/examples/httpd_load_test/modules.mk b/lib/inets/examples/httpd_load_test/modules.mk new file mode 100644 index 0000000000..9d0d7103d5 --- /dev/null +++ b/lib/inets/examples/httpd_load_test/modules.mk @@ -0,0 +1,44 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +SCRIPT_SKELETONS = \ + hdlt.sh.skel + +CONF_SKELETONS = \ + hdlt.config.skel + +CERT_FILES = \ + hdlt_ssl_client_cert.pem \ + hdlt_ssl_server_cert.pem + +README = HDLT_README + +MODULES = \ + hdlt \ + hdlt_ctrl \ + hdlt_client \ + hdlt_logger \ + hdlt_random_html \ + hdlt_server \ + hdlt_slave + +INTERNAL_HRL_FILES = \ + hdlt_logger.hrl + + diff --git a/lib/inets/examples/server_root/Makefile b/lib/inets/examples/server_root/Makefile new file mode 100644 index 0000000000..d7a3231068 --- /dev/null +++ b/lib/inets/examples/server_root/Makefile @@ -0,0 +1,209 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(INETS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +MODULE= + +AUTH_FILES = auth/group \ + auth/passwd +CGI_FILES = cgi-bin/printenv.sh +CONF_FILES = conf/8080.conf \ + conf/8888.conf \ + conf/httpd.conf \ + conf/ssl.conf \ + conf/mime.types +OPEN_FILES = htdocs/open/dummy.html +MNESIA_OPEN_FILES = htdocs/mnesia_open/dummy.html +MISC_FILES = htdocs/misc/friedrich.html \ + htdocs/misc/oech.html +SECRET_FILES = htdocs/secret/dummy.html +MNESIA_SECRET_FILES = htdocs/mnesia_secret/dummy.html +HTDOCS_FILES = htdocs/index.html \ + htdocs/config.shtml \ + htdocs/echo.shtml \ + htdocs/exec.shtml \ + htdocs/flastmod.shtml \ + htdocs/fsize.shtml \ + htdocs/include.shtml +ICON_FILES = icons/README \ + icons/a.gif \ + icons/alert.black.gif \ + icons/alert.red.gif \ + icons/apache_pb.gif \ + icons/back.gif \ + icons/ball.gray.gif \ + icons/ball.red.gif \ + icons/binary.gif \ + icons/binhex.gif \ + icons/blank.gif \ + icons/bomb.gif \ + icons/box1.gif \ + icons/box2.gif \ + icons/broken.gif \ + icons/burst.gif \ + icons/button1.gif \ + icons/button10.gif \ + icons/button2.gif \ + icons/button3.gif \ + icons/button4.gif \ + icons/button5.gif \ + icons/button6.gif \ + icons/button7.gif \ + icons/button8.gif \ + icons/button9.gif \ + icons/buttonl.gif \ + icons/buttonr.gif \ + icons/c.gif \ + icons/comp.blue.gif \ + icons/comp.gray.gif \ + icons/compressed.gif \ + icons/continued.gif \ + icons/dir.gif \ + icons/down.gif \ + icons/dvi.gif \ + icons/f.gif \ + icons/folder.gif \ + icons/folder.open.gif \ + icons/folder.sec.gif \ + icons/forward.gif \ + icons/generic.gif \ + icons/generic.red.gif \ + icons/generic.sec.gif \ + icons/hand.right.gif \ + icons/hand.up.gif \ + icons/htdig.gif \ + icons/icon.sheet.gif \ + icons/image1.gif \ + icons/image2.gif \ + icons/image3.gif \ + icons/index.gif \ + icons/layout.gif \ + icons/left.gif \ + icons/link.gif \ + icons/movie.gif \ + icons/p.gif \ + icons/patch.gif \ + icons/pdf.gif \ + icons/pie0.gif \ + icons/pie1.gif \ + icons/pie2.gif \ + icons/pie3.gif \ + icons/pie4.gif \ + icons/pie5.gif \ + icons/pie6.gif \ + icons/pie7.gif \ + icons/pie8.gif \ + icons/portal.gif \ + icons/poweredby.gif \ + icons/ps.gif \ + icons/quill.gif \ + icons/right.gif \ + icons/screw1.gif \ + icons/screw2.gif \ + icons/script.gif \ + icons/sound1.gif \ + icons/sound2.gif \ + icons/sphere1.gif \ + icons/sphere2.gif \ + icons/star.gif \ + icons/star_blank.gif \ + icons/tar.gif \ + icons/tex.gif \ + icons/text.gif \ + icons/transfer.gif \ + icons/unknown.gif \ + icons/up.gif \ + icons/uu.gif \ + icons/uuencoded.gif \ + icons/world1.gif \ + icons/world2.gif + +SSL_FILES = ssl/ssl_client.pem \ + ssl/ssl_server.pem + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: + +clean: + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/auth + $(INSTALL_DATA) $(AUTH_FILES) $(RELSYSDIR)/examples/server_root/auth + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/cgi-bin + $(INSTALL_SCRIPT) $(CGI_FILES) $(RELSYSDIR)/examples/server_root/cgi-bin + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/conf + $(INSTALL_DATA) $(CONF_FILES) $(RELSYSDIR)/examples/server_root/conf + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/open + $(INSTALL_DATA) $(OPEN_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/open + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open + $(INSTALL_DATA) $(MNESIA_OPEN_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/misc + $(INSTALL_DATA) $(MISC_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/misc + $(INSTALL_DIR) \ + $(RELSYSDIR)/examples/server_root/htdocs/secret/top_secret + $(INSTALL_DIR) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret/top_secret + $(INSTALL_DATA) $(SECRET_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/secret + $(INSTALL_DATA) $(MNESIA_SECRET_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs + $(INSTALL_DATA) $(HTDOCS_FILES) $(RELSYSDIR)/examples/server_root/htdocs + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/icons + $(INSTALL_DATA) $(ICON_FILES) $(RELSYSDIR)/examples/server_root/icons + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/ssl + $(INSTALL_DATA) $(SSL_FILES) $(RELSYSDIR)/examples/server_root/ssl + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/logs + +release_docs_spec: + diff --git a/lib/inets/examples/subdirs.mk b/lib/inets/examples/subdirs.mk new file mode 100644 index 0000000000..10a331fc26 --- /dev/null +++ b/lib/inets/examples/subdirs.mk @@ -0,0 +1,3 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +SUB_DIRECTORIES = server_root httpd_load_test
\ No newline at end of file diff --git a/lib/inets/src/ftp/Makefile b/lib/inets/src/ftp/Makefile index 0c15277a18..19b93870df 100644 --- a/lib/inets/src/ftp/Makefile +++ b/lib/inets/src/ftp/Makefile @@ -22,6 +22,7 @@ include $(ERL_TOP)/make/target.mk EBIN = ../../ebin include $(ERL_TOP)/make/$(TARGET)/otp.mk + # ---------------------------------------------------- # Application version # ---------------------------------------------------- @@ -29,6 +30,7 @@ include ../../vsn.mk VSN = $(INETS_VSN) + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -52,24 +54,21 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- -# INETS FLAGS +# FLAGS # ---------------------------------------------------- -INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' + +include ../inets_app/inets.mk ifeq ($(FTP_DEBUG),true) INETS_FLAGS += -Dftp_debug endif +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include \ + -I../inets_app -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -INETS_ERL_FLAGS += -I ../inets_app -pa ../../ebin - -ERL_COMPILE_FLAGS += $(INETS_ERL_FLAGS) \ - $(INETS_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' # ---------------------------------------------------- # Targets @@ -89,9 +88,10 @@ docs: include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/ftp + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/ftp + $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin release_docs_spec: diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 534fcae675..5ad74851c8 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @@ -25,14 +25,12 @@ -behaviour(gen_server). -behaviour(inets_service). --deprecated({open, 3, next_major_release}). --deprecated({force_active, 1, next_major_release}). %% API - Client interface -export([cd/2, close/1, delete/2, formaterror/1, lcd/2, lpwd/1, ls/1, ls/2, mkdir/2, nlist/1, nlist/2, - open/1, open/2, open/3, force_active/1, + open/1, open/2, pwd/1, quote/2, recv/2, recv/3, recv_bin/2, recv_chunk_start/2, recv_chunk/1, @@ -133,11 +131,6 @@ open(Host, Port) when is_integer(Port) -> open(Host, [{port, Port}]); %% </BACKWARD-COMPATIBILLITY> -%% <BACKWARD-COMPATIBILLITY> -open(Host, [H|_] = Flags) when is_atom(H) -> - open(Host, ?FTP_PORT, Flags); -%% </BACKWARD-COMPATIBILLITY> - open(Host, Opts) when is_list(Opts) -> ?fcrt("open", [{host, Host}, {opts, Opts}]), try @@ -160,32 +153,6 @@ open(Host, Opts) when is_list(Opts) -> end. -%% <BACKWARD-COMPATIBILLITY> -open(Host, Port, Flags) when is_integer(Port) andalso is_list(Flags) -> - ?fcrt("open", [{host, Host}, {port, Port}, {flags, Flags}]), - try - {ok, StartOptions} = start_options([{flags, Flags}]), - ?fcrt("open", [{start_options, StartOptions}]), - {ok, OpenOptions} = open_options([{host, Host}, {port, Port}|Flags]), - ?fcrt("open", [{open_options, OpenOptions}]), - case ftp_sup:start_child([[{client, self()} | StartOptions], []]) of - {ok, Pid} -> - ?fcrt("open - ok", [{pid, Pid}]), - call(Pid, {open, ip_comm, OpenOptions}, plain); - Error1 -> - ?fcrt("open - error", [{error1, Error1}]), - Error1 - end - catch - throw:Error2 -> - Error2 - end. -%% </BACKWARD-COMPATIBILLITY> - - - - - %%-------------------------------------------------------------------------- %% user(Pid, User, Pass, <Acc>) -> ok | {error, euser} | {error, econn} %% | {error, eacct} @@ -528,16 +495,6 @@ close(Pid) -> cast(Pid, close), ok. -%%-------------------------------------------------------------------------- -%% force_active(Pid) -> ok -%% Pid = pid() -%% -%% Description: Force connection to use active mode. -%%-------------------------------------------------------------------------- -force_active(Pid) -> - error_logger:info_report("This function is deprecated use the mode flag " - "instead"), - call(Pid, force_active, atom). %%-------------------------------------------------------------------------- %% formaterror(Tag) -> string() @@ -886,9 +843,6 @@ handle_call({_, {open, ip_comm, Host, Opts}}, From, State) -> {stop, normal, State2#state{client = undefined}} end; -handle_call({_, force_active}, _, State) -> - {reply, ok, State#state{mode = active}}; - handle_call({_, {user, User, Password}}, From, #state{csock = CSock} = State) when (CSock =/= undefined) -> handle_user(User, Password, "", State#state{client = From}); diff --git a/lib/inets/src/ftp/ftp_internal.hrl b/lib/inets/src/ftp/ftp_internal.hrl index c3fa1e611d..148f8217ba 100644 --- a/lib/inets/src/ftp/ftp_internal.hrl +++ b/lib/inets/src/ftp/ftp_internal.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -21,7 +21,8 @@ -ifndef(ftp_internal_hrl). -define(ftp_internal_hrl, true). --include("inets_internal.hrl"). +-include_lib("inets/src/inets_app/inets_internal.hrl"). + -define(SERVICE, ftpc). -define(fcri(Label, Content), ?report_important(Label, ?SERVICE, Content)). -define(fcrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)). diff --git a/lib/inets/src/http_client/Makefile b/lib/inets/src/http_client/Makefile index 628c91421f..575c6efaec 100644 --- a/lib/inets/src/http_client/Makefile +++ b/lib/inets/src/http_client/Makefile @@ -61,20 +61,17 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- -# INETS FLAGS -# ---------------------------------------------------- -INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' - - -# ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -INETS_ERL_FLAGS += -I ../http_lib -I ../inets_app -pa ../../ebin -ERL_COMPILE_FLAGS += $(INETS_ERL_FLAGS) \ - $(INETS_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' +include ../inets_app/inets.mk + +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include \ + -I../inets_app \ + -I../http_lib # ---------------------------------------------------- @@ -94,9 +91,10 @@ docs: include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/http_client + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/http_client + $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin release_docs_spec: diff --git a/lib/inets/src/http_client/http.erl b/lib/inets/src/http_client/http.erl index 7e1e90b50e..bbe2fec267 100644 --- a/lib/inets/src/http_client/http.erl +++ b/lib/inets/src/http_client/http.erl @@ -18,21 +18,38 @@ %% %% -%% Description: -%%% This version of the HTTP/1.1 client supports: -%%% - RFC 2616 HTTP 1.1 client part -%%% - RFC 2818 HTTP Over TLS +%%% Description: OLD API MODULE - USE httpc INSTEAD -module(http). -%% API --export([request/1, request/2, request/4, request/5, +-deprecated({request, 1, next_major_release}). +-deprecated({request, 2, next_major_release}). +-deprecated({request, 4, next_major_release}). +-deprecated({request, 5, next_major_release}). +-deprecated({cancel_request, 1, next_major_release}). +-deprecated({cancel_request, 2, next_major_release}). +-deprecated({set_option, 2, next_major_release}). +-deprecated({set_option, 3, next_major_release}). +-deprecated({set_options, 1, next_major_release}). +-deprecated({set_options, 2, next_major_release}). +-deprecated({verify_cookies, 2, next_major_release}). +-deprecated({verify_cookies, 3, next_major_release}). +-deprecated({cookie_header, 1, next_major_release}). +-deprecated({cookie_header, 2, next_major_release}). +-deprecated({stream_next, 1, next_major_release}). +-deprecated({default_profile, 0, next_major_release}). + +%% Deprecated +-export([ + request/1, request/2, request/4, request/5, cancel_request/1, cancel_request/2, set_option/2, set_option/3, set_options/1, set_options/2, - verify_cookies/2, verify_cookies/3, cookie_header/1, - cookie_header/2, stream_next/1, - default_profile/0]). + verify_cookies/2, verify_cookies/3, + cookie_header/1, cookie_header/2, + stream_next/1, + default_profile/0 + ]). %%%========================================================================= diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 6deeab6948..851364001c 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -48,7 +48,7 @@ stop_service/1, services/0, service_info/1]). --include("http_internal.hrl"). +-include_lib("inets/src/http_lib/http_internal.hrl"). -include("httpc_internal.hrl"). -define(DEFAULT_PROFILE, default). @@ -104,8 +104,14 @@ request(Url, Profile) -> %% HTTPOptions - [HttpOption] %% HTTPOption - {timeout, Time} | {connect_timeout, Time} | %% {ssl, SSLOptions} | {proxy_auth, {User, Password}} -%% Ssloptions = [SSLOption] -%% SSLOption = {verify, code()} | {depth, depth()} | {certfile, path()} | +%% Ssloptions = ssl_options() | +%% {ssl, ssl_options()} | +%% {ossl, ssl_options()} | +%% {essl, ssl_options()} +%% ssl_options() = [ssl_option()] +%% ssl_option() = {verify, code()} | +%% {depth, depth()} | +%% {certfile, path()} | %% {keyfile, path()} | {password, string()} | {cacertfile, path()} | %% {ciphers, string()} %% Options - [Option] @@ -579,7 +585,13 @@ http_options_default() -> error end, SslPost = fun(Value) when is_list(Value) -> - {ok, Value}; + {ok, {?HTTP_DEFAULT_SSL_KIND, Value}}; + ({ssl, SslOptions}) when is_list(SslOptions) -> + {ok, {?HTTP_DEFAULT_SSL_KIND, SslOptions}}; + ({ossl, SslOptions}) when is_list(SslOptions) -> + {ok, {ossl, SslOptions}}; + ({essl, SslOptions}) when is_list(SslOptions) -> + {ok, {essl, SslOptions}}; (_) -> error end, @@ -604,14 +616,14 @@ http_options_default() -> error end, [ - {version, {value, "HTTP/1.1"}, #http_options.version, VersionPost}, - {timeout, {value, ?HTTP_REQUEST_TIMEOUT}, #http_options.timeout, TimeoutPost}, - {autoredirect, {value, true}, #http_options.autoredirect, AutoRedirectPost}, - {ssl, {value, []}, #http_options.ssl, SslPost}, - {proxy_auth, {value, undefined}, #http_options.proxy_auth, ProxyAuthPost}, - {relaxed, {value, false}, #http_options.relaxed, RelaxedPost}, - %% this field has to be *after* the timeout field (as that field is used for the default value) - {connect_timeout, {field, #http_options.timeout}, #http_options.connect_timeout, ConnTimeoutPost} + {version, {value, "HTTP/1.1"}, #http_options.version, VersionPost}, + {timeout, {value, ?HTTP_REQUEST_TIMEOUT}, #http_options.timeout, TimeoutPost}, + {autoredirect, {value, true}, #http_options.autoredirect, AutoRedirectPost}, + {ssl, {value, {?HTTP_DEFAULT_SSL_KIND, []}}, #http_options.ssl, SslPost}, + {proxy_auth, {value, undefined}, #http_options.proxy_auth, ProxyAuthPost}, + {relaxed, {value, false}, #http_options.relaxed, RelaxedPost}, + %% this field has to be *after* the timeout option (as that field is used for the default value) + {connect_timeout, {field, #http_options.timeout}, #http_options.connect_timeout, ConnTimeoutPost} ]. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 5e79d874fb..c34b641b7b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -22,8 +22,8 @@ -behaviour(gen_server). +-include_lib("inets/src/http_lib/http_internal.hrl"). -include("httpc_internal.hrl"). --include("http_internal.hrl"). %%-------------------------------------------------------------------- @@ -177,8 +177,8 @@ stream(BodyPart, Request = #request{stream = Self}, Code) stream(BodyPart, Request = #request{stream = Self}, 404) when (Self =:= self) orelse (Self =:= {self, once}) -> ?hcrt("stream - self with 404", [{stream, Self}]), - httpc_response:send(Request#request.from, - {Request#request.id, stream, BodyPart}), + httpc_response:send(Request#request.from, + {Request#request.id, stream, BodyPart}), {<<>>, Request}; %% Stream to file @@ -286,8 +286,7 @@ handle_call({connect_and_send, #request{address = Address0, handle_call(#request{address = Addr} = Request, _, #state{status = Status, - session = #tcp_session{socket = Socket, - type = pipeline} = Session, + session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, profile_name = ProfileName} = State) @@ -301,7 +300,7 @@ handle_call(#request{address = Addr} = Request, _, Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Request, Socket) of + case httpc_request:send(Address, Session, Request) of ok -> ?hcrd("request sent", []), @@ -320,10 +319,10 @@ handle_call(#request{address = Addr} = Request, _, NewTimers = NewState#state.timers, NewPipeline = queue:in(Request, State#state.pipeline), NewSession = - Session#tcp_session{queue_length = - %% Queue + current - queue:len(NewPipeline) + 1, - client_close = ClientClose}, + Session#session{queue_length = + %% Queue + current + queue:len(NewPipeline) + 1, + client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), ?hcrd("session updated", []), {reply, ok, State#state{pipeline = NewPipeline, @@ -336,8 +335,8 @@ handle_call(#request{address = Addr} = Request, _, cancel_timer(Timers#timers.queue_timer, timeout_queue), NewSession = - Session#tcp_session{queue_length = 1, - client_close = ClientClose}, + Session#session{queue_length = 1, + client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), Relaxed = (Request#request.settings)#http_options.relaxed, @@ -357,8 +356,7 @@ handle_call(#request{address = Addr} = Request, _, handle_call(#request{address = Addr} = Request, _, #state{status = Status, - session = #tcp_session{socket = Socket, - type = keep_alive} = Session, + session = #session{type = keep_alive} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, profile_name = ProfileName} = State) @@ -370,7 +368,7 @@ handle_call(#request{address = Addr} = Request, _, {status, Status}]), Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Request, Socket) of + case httpc_request:send(Address, Session, Request) of ok -> ?hcrd("request sent", []), @@ -389,10 +387,10 @@ handle_call(#request{address = Addr} = Request, _, NewTimers = NewState#state.timers, NewKeepAlive = queue:in(Request, State#state.keep_alive), NewSession = - Session#tcp_session{queue_length = - %% Queue + current - queue:len(NewKeepAlive) + 1, - client_close = ClientClose}, + Session#session{queue_length = + %% Queue + current + queue:len(NewKeepAlive) + 1, + client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), ?hcrd("session updated", []), {reply, ok, State#state{keep_alive = NewKeepAlive, @@ -405,8 +403,8 @@ handle_call(#request{address = Addr} = Request, _, cancel_timer(Timers#timers.queue_timer, timeout_queue), NewSession = - Session#tcp_session{queue_length = 1, - client_close = ClientClose}, + Session#session{queue_length = 1, + client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), Relaxed = (Request#request.settings)#http_options.relaxed, @@ -589,13 +587,13 @@ handle_info({ssl_closed, _}, State = #state{request = undefined}) -> %%% Error cases handle_info({tcp_closed, _}, #state{session = Session0} = State) -> - Socket = Session0#tcp_session.socket, - Session = Session0#tcp_session{socket = {remote_close, Socket}}, + Socket = Session0#session.socket, + Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; handle_info({ssl_closed, _}, #state{session = Session0} = State) -> - Socket = Session0#tcp_session.socket, - Session = Session0#tcp_session{socket = {remote_close, Socket}}, + Socket = Session0#session.socket, + Session = Session0#session{socket = {remote_close, Socket}}, %% {stop, session_remotly_closed, State}; {stop, normal, State#state{session = Session}}; handle_info({tcp_error, _, _} = Reason, State) -> @@ -699,19 +697,18 @@ terminate(normal, #state{session = undefined}) -> %% Init error sending, no session information has been setup but %% there is a socket that needs closing. terminate(normal, - #state{request = Request, - session = #tcp_session{id = undefined, - socket = Socket}}) -> - http_transport:close(socket_type(Request), Socket); + #state{session = #session{id = undefined} = Session}) -> + close_socket(Session); %% Socket closed remotely terminate(normal, - #state{session = #tcp_session{socket = {remote_close, Socket}, - id = Id}, + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline}) -> + request = Request, + timers = Timers, + pipeline = Pipeline}) -> ?hcrt("terminate(normal) - remote close", [{id, Id}, {profile, ProfileName}]), @@ -728,11 +725,11 @@ terminate(normal, deliver_answers([Request | queue:to_list(Pipeline)]), %% And, just in case, close our side (**really** overkill) - http_transport:close(socket_type(Request), Socket); + http_transport:close(SocketType, Socket); -terminate(_, #state{session = #tcp_session{id = Id, - socket = Socket, - scheme = Scheme}, +terminate(_, #state{session = #session{id = Id, + socket = Socket, + socket_type = SocketType}, request = undefined, profile_name = ProfileName, timers = Timers, @@ -744,7 +741,7 @@ terminate(_, #state{session = #tcp_session{id = Id, maybe_retry_queue(KeepAlive, State), cancel_timer(Timers#timers.queue_timer, timeout_queue), - http_transport:close(socket_type(Scheme), Socket); + http_transport:close(SocketType, Socket); terminate(Reason, #state{request = undefined}) -> ?hcrt("terminate", [{reason, Reason}]), @@ -878,22 +875,23 @@ connect_and_send_first_request(Address, ConnTimeout = Settings#http_options.connect_timeout, case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> + Session = #session{id = {OrigAddress, self()}, + scheme = Scheme, + socket = Socket, + socket_type = SocketType}, ?hcrd("connected - now send first request", [{socket, Socket}]), - case httpc_request:send(Address, Request, Socket) of + case httpc_request:send(Address, Session, Request) of ok -> ?hcrd("first request sent", []), ClientClose = httpc_request:is_client_closing(Headers), SessionType = httpc_manager:session_type(Options), - Session = - #tcp_session{id = {OrigAddress, self()}, - scheme = Scheme, - socket = Socket, - client_close = ClientClose, - type = SessionType}, + Session2 = + Session#session{client_close = ClientClose, + type = SessionType}, TmpState = State#state{request = Request, - session = Session, + session = Session2, mfa = init_mfa(Request, State), status_line = init_status_line(Request), headers = undefined, @@ -947,21 +945,20 @@ handler_info(#state{request = Request, ?hcrt("handler info", [{request_info, RequestInfo}]), %% Info about the current session/socket - SessionType = Session#tcp_session.type, - QueueLen = case Session#tcp_session.type of + SessionType = Session#session.type, + QueueLen = case SessionType of pipeline -> queue:len(Pipeline); keep_alive -> queue:len(KeepAlive) end, - Socket = Session#tcp_session.socket, - Scheme = Session#tcp_session.scheme, - SocketType = socket_type(Scheme), + Scheme = Session#session.scheme, + Socket = Session#session.socket, + SocketType = Session#session.socket_type, ?hcrt("handler info", [{session_type, SessionType}, {queue_length, QueueLen}, {scheme, Scheme}, - {socket_type, SocketType}, {socket, Socket}]), SocketOpts = http_transport:getopts(SocketType, Socket), @@ -1118,9 +1115,7 @@ handle_response(#state{request = Request, ?hcrd("handle response - continue", []), %% Send request body {_, RequestBody} = Request#request.content, - http_transport:send(socket_type(Session#tcp_session.scheme), - Session#tcp_session.socket, - RequestBody), + send_raw(Session, RequestBody), %% Wait for next response activate_once(Session), Relaxed = (Request#request.settings)#http_options.relaxed, @@ -1217,7 +1212,7 @@ handle_pipeline(#state{status = pipeline, %% If a pipeline that has been idle for some time is not %% closed by the server, the client may want to close it. NewState = activate_queue_timeout(TimeOut, State), - NewSession = Session#tcp_session{queue_length = 0}, + NewSession = Session#session{queue_length = 0}, httpc_manager:insert_session(NewSession, ProfileName), %% Note mfa will be initilized when a new request %% arrives. @@ -1239,9 +1234,9 @@ handle_pipeline(#state{status = pipeline, false -> ?hcrv("next request", [{request, NextRequest}]), NewSession = - Session#tcp_session{queue_length = - %% Queue + current - queue:len(Pipeline) + 1}, + Session#session{queue_length = + %% Queue + current + queue:len(Pipeline) + 1}, httpc_manager:insert_session(NewSession, ProfileName), Relaxed = (NextRequest#request.settings)#http_options.relaxed, @@ -1290,16 +1285,16 @@ handle_keep_alive_queue( %% If a keep_alive session has been idle for some time is not %% closed by the server, the client may want to close it. NewState = activate_queue_timeout(TimeOut, State), - NewSession = Session#tcp_session{queue_length = 0}, + NewSession = Session#session{queue_length = 0}, httpc_manager:insert_session(NewSession, ProfileName), %% Note mfa will be initilized when a new request %% arrives. {noreply, - NewState#state{request = undefined, - mfa = undefined, + NewState#state{request = undefined, + mfa = undefined, status_line = undefined, - headers = undefined, - body = undefined + headers = undefined, + body = undefined } }; {{value, NextRequest}, KeepAlive} -> @@ -1342,10 +1337,12 @@ case_insensitive_header(Str) when is_list(Str) -> case_insensitive_header(Str) -> Str. -activate_once(#tcp_session{scheme = Scheme, socket = Socket}) -> - SocketType = socket_type(Scheme), +activate_once(#session{socket = Socket, socket_type = SocketType}) -> http_transport:setopts(SocketType, Socket, [{active, once}]). +close_socket(#session{socket = Socket, socket_type = SocketType}) -> + http_transport:close(SocketType, Socket). + activate_request_timeout( #state{request = #request{timer = undefined} = Request} = State) -> Timeout = (Request#request.settings)#http_options.timeout, @@ -1378,7 +1375,7 @@ activate_queue_timeout(Time, State) -> State#state{timers = #timers{queue_timer = Ref}}. -is_pipeline_enabled_client(#tcp_session{type = pipeline}) -> +is_pipeline_enabled_client(#session{type = pipeline}) -> true; is_pipeline_enabled_client(_) -> false. @@ -1391,7 +1388,7 @@ is_keep_alive_enabled_server("HTTP/1.0", is_keep_alive_enabled_server(_,_) -> false. -is_keep_alive_connection(Headers, #tcp_session{client_close = ClientClose}) -> +is_keep_alive_connection(Headers, #session{client_close = ClientClose}) -> (not ((ClientClose) orelse httpc_response:is_server_closing(Headers))). try_to_enable_pipeline_or_keep_alive( @@ -1416,7 +1413,7 @@ try_to_enable_pipeline_or_keep_alive( httpc_manager:insert_session(Session, ProfileName), %% Make sure type is keep_alive in session %% as it in this case might be pipeline - NewSession = Session#tcp_session{type = keep_alive}, + NewSession = Session#session{type = keep_alive}, State#state{status = keep_alive, session = NewSession} end; @@ -1551,11 +1548,11 @@ init_status_line(#request{settings = Settings}) -> socket_type(#request{scheme = http}) -> ip_comm; socket_type(#request{scheme = https, settings = Settings}) -> - {ssl, Settings#http_options.ssl}; -socket_type(http) -> - ip_comm; -socket_type(https) -> - {ssl, []}. %% Dummy value ok for ex setopts that does not use this value + Settings#http_options.ssl. +%% socket_type(http) -> +%% ip_comm; +%% socket_type(https) -> +%% {ssl1, []}. %% Dummy value ok for ex setopts that does not use this value start_stream({_Version, _Code, _ReasonPhrase}, _Headers, #request{stream = none} = Request) -> @@ -1624,18 +1621,15 @@ end_stream(SL, R) -> next_body_chunk(#state{request = #request{stream = {self, once}}, - once = once, session = Session} = State) -> - http_transport:setopts(socket_type(Session#tcp_session.scheme), - Session#tcp_session.socket, - [{active, once}]), + once = once, + session = Session} = State) -> + activate_once(Session), State#state{once = inactive}; next_body_chunk(#state{request = #request{stream = {self, once}}, once = inactive} = State) -> State; %% Wait for user to call stream_next next_body_chunk(#state{session = Session} = State) -> - http_transport:setopts(socket_type(Session#tcp_session.scheme), - Session#tcp_session.socket, - [{active, once}]), + activate_once(Session), State. handle_verbose(verbose) -> @@ -1712,6 +1706,11 @@ handle_verbose(_) -> %% ok. +send_raw(#session{socket = Socket, socket_type = SocketType}, Body) -> + http_transport:send(SocketType, Socket, Body). + + + call(Msg, Pid) -> Timeout = infinity, call(Msg, Pid, Timeout). diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 4d76c4beb3..3cdd95a02b 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -18,7 +18,11 @@ %% %% --include("inets_internal.hrl"). +-ifndef(httpc_internal_hrl). +-define(httpc_internal_hrl, true). + +-include_lib("inets/src/inets_app/inets_internal.hrl"). + -define(SERVICE, httpc). -define(hcri(Label, Data), ?report_important(Label, ?SERVICE, Data)). -define(hcrv(Label, Data), ?report_verbose(Label, ?SERVICE, Data)). @@ -104,13 +108,14 @@ } ). --record(tcp_session, +-record(session, { id, % {{Host, Port}, HandlerPid} client_close, % true | false scheme, % http (HTTP/TCP) | https (HTTP/SSL/TCP) socket, % Open socket, used by connection - queue_length = 1, % Current length of pipeline or keep alive queue + socket_type, % socket-type, used by connection + queue_length = 1, % Current length of pipeline or keep-alive queue type % pipeline | keep_alive (wait for response before sending new request) }). @@ -138,3 +143,6 @@ %% path, % string() %% q % query: string() %% }). + + +-endif. % -ifdef(httpc_internal_hrl). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index b278077a66..d5d6376369 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -21,8 +21,8 @@ -behaviour(gen_server). +-include_lib("inets/src/http_lib/http_internal.hrl"). -include("httpc_internal.hrl"). --include("http_internal.hrl"). %% Internal Application API -export([ @@ -333,7 +333,7 @@ do_init(ProfileName, CookiesDir) -> ?hcrt("create session db", []), SessionDbName = session_db_name(ProfileName), ets:new(SessionDbName, - [public, set, named_table, {keypos, #tcp_session.id}]), + [public, set, named_table, {keypos, #session.id}]), %% Create handler db ?hcrt("create handler/request db", []), @@ -876,12 +876,12 @@ select_session(Method, HostPort, Scheme, SessionType, %% client_close, scheme and type specified. %% The fields id (part of: HandlerPid) and queue_length %% specified. - Pattern = #tcp_session{id = {HostPort, '$1'}, - client_close = false, - scheme = Scheme, - socket = '_', - queue_length = '$2', - type = SessionType}, + Pattern = #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + _ = '_'}, %% {'_', {HostPort, '$1'}, false, Scheme, '_', '$2', SessionTyp}, Candidates = ets:match(SessionDb, Pattern), ?hcrd("select session", [{host_port, HostPort}, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index 55e0af4b42..d4df97ad40 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -19,12 +19,13 @@ -module(httpc_request). --include("http_internal.hrl"). +-include_lib("inets/src/http_lib/http_internal.hrl"). -include("httpc_internal.hrl"). %%% Internal API -export([send/3, is_idempotent/1, is_client_closing/1]). + %%%========================================================================= %%% Internal application API %%%========================================================================= @@ -39,10 +40,9 @@ %% %% Description: Composes and sends a HTTP-request. %%------------------------------------------------------------------------- -send(SendAddr, #request{scheme = Scheme, socket_opts = SocketOpts} = Request, - Socket) +send(SendAddr, #session{socket = Socket, socket_type = SocketType}, + #request{socket_opts = SocketOpts} = Request) when is_list(SocketOpts) -> - SocketType = socket_type(Scheme), case http_transport:setopts(SocketType, Socket, SocketOpts) of ok -> send(SendAddr, Socket, SocketType, @@ -50,8 +50,7 @@ send(SendAddr, #request{scheme = Scheme, socket_opts = SocketOpts} = Request, {error, Reason} -> {error, {setopts_failed, Reason}} end; -send(SendAddr, #request{scheme = Scheme} = Request, Socket) -> - SocketType = socket_type(Scheme), +send(SendAddr, #session{socket = Socket, socket_type = SocketType}, Request) -> send(SendAddr, Socket, SocketType, Request). send(SendAddr, Socket, SocketType, @@ -209,10 +208,6 @@ headers(_, "HTTP/0.9") -> headers(Headers, _) -> Headers. -socket_type(http) -> - ip_comm; -socket_type(https) -> - {ssl, []}. http_headers([], Headers) -> lists:flatten(Headers); diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl index df7d40a33e..bb9c516259 100644 --- a/lib/inets/src/http_client/httpc_response.erl +++ b/lib/inets/src/http_client/httpc_response.erl @@ -19,7 +19,7 @@ -module(httpc_response). --include("http_internal.hrl"). +-include_lib("inets/src/http_lib/http_internal.hrl"). -include("httpc_internal.hrl"). %% API diff --git a/lib/inets/src/http_lib/Makefile b/lib/inets/src/http_lib/Makefile index 7f4c92861c..5dac3b0c00 100644 --- a/lib/inets/src/http_lib/Makefile +++ b/lib/inets/src/http_lib/Makefile @@ -55,24 +55,16 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- -# INETS FLAGS -# ---------------------------------------------------- -INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' - - -# ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -INETS_ERL_FLAGS += -I ../inets_app -ifeq ($(WARN_UNUSED_WARS),true) -ERL_COMPILE_FLAGS += +warn_unused_vars -endif +include ../inets_app/inets.mk -ERL_COMPILE_FLAGS += $(INETS_ERL_FLAGS) \ - $(INETS_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include \ + -I../inets_app # ---------------------------------------------------- @@ -94,9 +86,10 @@ docs: include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/http_lib + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/http_lib + $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin release_docs_spec: diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index bb2e831727..5440f214b5 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -1,28 +1,37 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% --include("inets_internal.hrl"). +-ifndef(http_internal_hrl). +-define(http_internal_hrl, true). --define(HTTP_MAX_BODY_SIZE, nolimit). +-include_lib("inets/src/inets_app/inets_internal.hrl"). + +-define(HTTP_MAX_BODY_SIZE, nolimit). -define(HTTP_MAX_HEADER_SIZE, 10240). --define(HTTP_MAX_URI_SIZE, nolimit). +-define(HTTP_MAX_URI_SIZE, nolimit). + +-ifndef(HTTP_DEFAULT_SSL_KIND). +-define(HTTP_DEFAULT_SSL_KIND, ossl). +%% -define(HTTP_DEFAULT_SSL_KIND, essl). +-endif. % -ifdef(HTTP_DEFAULT_SSL_KIND). + %%% Response headers -record(http_response_h,{ @@ -106,3 +115,5 @@ 'last-modified', other=[] % list() - Key/Value list with other headers }). + +-endif. % -ifdef(http_internal_hrl). diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 7c2ac626e6..b8121852b8 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -36,7 +36,9 @@ -export([negotiate/3]). --include("inets_internal.hrl"). +-include_lib("inets/src/inets_app/inets_internal.hrl"). +-include("http_internal.hrl"). + -define(SERVICE, httpl). -define(hlri(Label, Content), ?report_important(Label, ?SERVICE, Content)). -define(hlrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)). @@ -55,6 +57,18 @@ %% Description: Makes sure inet_db or ssl is started. %%------------------------------------------------------------------------- start(ip_comm) -> + do_start_ip_comm(); + +%% This is just for backward compatibillity +start({ssl, _}) -> + do_start_ssl(); +start({ossl, _}) -> + do_start_ssl(); +start({essl, _}) -> + do_start_ssl(). + + +do_start_ip_comm() -> case inet_db:start() of {ok, _} -> ok; @@ -62,8 +76,9 @@ start(ip_comm) -> ok; Error -> Error - end; -start({ssl, _}) -> + end. + +do_start_ssl() -> case ssl:start() of ok -> ok; @@ -97,18 +112,26 @@ connect(ip_comm = _SocketType, {Host, Port}, Opts0, Timeout) [{host, Host}, {port, Port}, {opts, Opts}, {timeout, Timeout}]), gen_tcp:connect(Host, Port, Opts, Timeout); -connect({ssl, SslConfig}, {Host, Port}, _, Timeout) -> - Opts = [binary, {active, false}] ++ SslConfig, - ?hlrt("connect using ssl", - [{host, Host}, {port, Port}, {ssl_config, SslConfig}, - {timeout, Timeout}]), +%% Wrapper for backaward compatibillity +connect({ssl, SslConfig}, Address, Opts, Timeout) -> + connect({?HTTP_DEFAULT_SSL_KIND, SslConfig}, Address, Opts, Timeout); + +connect({ossl, SslConfig}, {Host, Port}, _, Timeout) -> + Opts = [binary, {active, false}, {ssl_imp, old}] ++ SslConfig, + ?hlrt("connect using ossl", + [{host, Host}, + {port, Port}, + {ssl_config, SslConfig}, + {timeout, Timeout}]), ssl:connect(Host, Port, Opts, Timeout); -connect({erl_ssl, SslConfig}, {Host, Port}, _, Timeout) -> +connect({essl, SslConfig}, {Host, Port}, _, Timeout) -> Opts = [binary, {active, false}, {ssl_imp, new}] ++ SslConfig, - ?hlrt("connect using erl_ssl", - [{host, Host}, {port, Port}, {ssl_config, SslConfig}, - {timeout, Timeout}]), + ?hlrt("connect using essl", + [{host, Host}, + {port, Port}, + {ssl_config, SslConfig}, + {timeout, Timeout}]), ssl:connect(Host, Port, Opts, Timeout). @@ -136,13 +159,32 @@ listen(ip_comm, Addr, Port) -> Else end; -listen({ssl, SSLConfig} = Ssl, Addr, Port) -> +%% Wrapper for backaward compatibillity +listen({ssl, SSLConfig}, Addr, Port) -> + ?hlrt("listen (wrapper)", + [{addr, Addr}, + {port, Port}, + {ssl_config, SSLConfig}]), + listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); + +listen({ossl, SSLConfig} = Ssl, Addr, Port) -> + ?hlrt("listen (ossl)", + [{addr, Addr}, + {port, Port}, + {ssl_config, SSLConfig}]), Opt = sock_opt(Ssl, Addr, SSLConfig), - ssl:listen(Port, Opt); - -listen({erl_ssl, SSLConfig} = Ssl, Addr, Port) -> + ?hlrt("listen options", [{opt, Opt}]), + ssl:listen(Port, [{ssl_imp, old} | Opt]); + +listen({essl, SSLConfig} = Ssl, Addr, Port) -> + ?hlrt("listen (essl)", + [{addr, Addr}, + {port, Port}, + {ssl_config, SSLConfig}]), Opt = sock_opt(Ssl, Addr, SSLConfig), - ssl:listen(Port, [{ssl_imp, new} | Opt]). + ?hlrt("listen options", [{opt, Opt}]), + Opt2 = [{ssl_imp, new}, {reuseaddr, true} | Opt], + ssl:listen(Port, Opt2). listen_ip_comm(Addr, Port) -> @@ -228,9 +270,17 @@ ip_family_of(IpFamilyStr) -> %%------------------------------------------------------------------------- accept(SocketType, ListenSocket) -> accept(SocketType, ListenSocket, infinity). + accept(ip_comm, ListenSocket, Timeout) -> gen_tcp:accept(ListenSocket, Timeout); -accept({ssl,_SSLConfig}, ListenSocket, Timeout) -> + +%% Wrapper for backaward compatibillity +accept({ssl, SSLConfig}, ListenSocket, Timeout) -> + accept({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, ListenSocket, Timeout); + +accept({ossl, _SSLConfig}, ListenSocket, Timeout) -> + ssl:transport_accept(ListenSocket, Timeout); +accept({essl, _SSLConfig}, ListenSocket, Timeout) -> ssl:transport_accept(ListenSocket, Timeout). @@ -244,7 +294,15 @@ accept({ssl,_SSLConfig}, ListenSocket, Timeout) -> %%------------------------------------------------------------------------- controlling_process(ip_comm, Socket, NewOwner) -> gen_tcp:controlling_process(Socket, NewOwner); -controlling_process({ssl, _}, Socket, NewOwner) -> + +%% Wrapper for backaward compatibillity +controlling_process({ssl, SSLConfig}, Socket, NewOwner) -> + controlling_process({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, NewOwner); + +controlling_process({ossl, _}, Socket, NewOwner) -> + ssl:controlling_process(Socket, NewOwner); + +controlling_process({essl, _}, Socket, NewOwner) -> ssl:controlling_process(Socket, NewOwner). @@ -259,9 +317,23 @@ controlling_process({ssl, _}, Socket, NewOwner) -> setopts(ip_comm, Socket, Options) -> ?hlrt("ip_comm setopts", [{socket, Socket}, {options, Options}]), inet:setopts(Socket, Options); -setopts({ssl, _}, Socket, Options) -> - ?hlrt("ssl setopts", [{socket, Socket}, {options, Options}]), - ssl:setopts(Socket, Options). + +%% Wrapper for backaward compatibillity +setopts({ssl, SSLConfig}, Socket, Options) -> + setopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); + +setopts({ossl, _}, Socket, Options) -> + ?hlrt("[o]ssl setopts", [{socket, Socket}, {options, Options}]), + Reason = (catch ssl:setopts(Socket, Options)), + ?hlrt("[o]ssl setopts result", [{reason, Reason}]), + Reason; + + +setopts({essl, _}, Socket, Options) -> + ?hlrt("[e]ssl setopts", [{socket, Socket}, {options, Options}]), + Reason = (catch ssl:setopts(Socket, Options)), + ?hlrt("[e]ssl setopts result", [{reason, Reason}]), + Reason. %%------------------------------------------------------------------------- @@ -283,15 +355,27 @@ getopts(ip_comm, Socket, Options) -> {error, _} -> [] end; -getopts({ssl, _}, Socket, Options) -> + +%% Wrapper for backaward compatibillity +getopts({ssl, SSLConfig}, Socket, Options) -> + getopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); + +getopts({ossl, _}, Socket, Options) -> ?hlrt("ssl getopts", [{socket, Socket}, {options, Options}]), + getopts_ssl(Socket, Options); + +getopts({essl, _}, Socket, Options) -> + ?hlrt("essl getopts", [{socket, Socket}, {options, Options}]), + getopts_ssl(Socket, Options). + +getopts_ssl(Socket, Options) -> case ssl:getopts(Socket, Options) of {ok, SocketOpts} -> SocketOpts; {error, _} -> [] end. - + %%------------------------------------------------------------------------- %% getstat(SocketType, Socket) -> socket_stats() @@ -308,8 +392,15 @@ getstat(ip_comm = _SocketType, Socket) -> {error, _} -> [] end; -getstat({ssl, _} = _SocketType, _Socket) -> - %% ?hlrt("ssl getstat", [{socket, Socket}]), + +%% Wrapper for backaward compatibillity +getstat({ssl, SSLConfig}, Socket) -> + getstat({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); + +getstat({ossl, _} = _SocketType, _Socket) -> + []; + +getstat({essl, _} = _SocketType, _Socket) -> []. @@ -322,7 +413,15 @@ getstat({ssl, _} = _SocketType, _Socket) -> %%------------------------------------------------------------------------- send(ip_comm, Socket, Message) -> gen_tcp:send(Socket, Message); -send({ssl, _}, Socket, Message) -> + +%% Wrapper for backaward compatibillity +send({ssl, SSLConfig}, Socket, Message) -> + send({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Message); + +send({ossl, _}, Socket, Message) -> + ssl:send(Socket, Message); + +send({essl, _}, Socket, Message) -> ssl:send(Socket, Message). @@ -335,9 +434,18 @@ send({ssl, _}, Socket, Message) -> %%------------------------------------------------------------------------- close(ip_comm, Socket) -> gen_tcp:close(Socket); -close({ssl, _}, Socket) -> + +%% Wrapper for backaward compatibillity +close({ssl, SSLConfig}, Socket) -> + close({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); + +close({ossl, _}, Socket) -> + ssl:close(Socket); + +close({essl, _}, Socket) -> ssl:close(Socket). + %%------------------------------------------------------------------------- %% peername(SocketType, Socket) -> {Port, SockName} %% SocketType = ip_comm | {ssl, _} @@ -368,7 +476,17 @@ peername(ip_comm, Socket) -> {-1, "unknown"} end; -peername({ssl, _}, Socket) -> +%% Wrapper for backaward compatibillity +peername({ssl, SSLConfig}, Socket) -> + peername({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); + +peername({ossl, _}, Socket) -> + peername_ssl(Socket); + +peername({essl, _}, Socket) -> + peername_ssl(Socket). + +peername_ssl(Socket) -> case ssl:peername(Socket) of {ok,{{A, B, C, D}, Port}} -> PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++ @@ -409,7 +527,17 @@ sockname(ip_comm, Socket) -> {-1, "unknown"} end; -sockname({ssl, _}, Socket) -> +%% Wrapper for backaward compatibillity +sockname({ssl, SSLConfig}, Socket) -> + sockname({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); + +sockname({ossl, _}, Socket) -> + sockname_ssl(Socket); + +sockname({essl, _}, Socket) -> + sockname_ssl(Socket). + +sockname_ssl(Socket) -> case ssl:sockname(Socket) of {ok,{{A, B, C, D}, Port}} -> SockName = integer_to_list(A)++"."++integer_to_list(B)++"."++ @@ -455,22 +583,31 @@ sock_opt2(Opts) -> [{packet, 0}, {active, false} | Opts]. negotiate(ip_comm,_,_) -> + ?hlrt("negotiate(ip_comm)", []), ok; -negotiate({ssl,_},Socket,Timeout) -> - negotiate(Socket, Timeout); -negotiate({erl_ssl, _}, Socket, Timeout) -> - negotiate(Socket, Timeout). - -negotiate(Socket, Timeout) -> +negotiate({ssl, SSLConfig}, Socket, Timeout) -> + ?hlrt("negotiate(ssl)", []), + negotiate({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Timeout); +negotiate({ossl, _}, Socket, Timeout) -> + ?hlrt("negotiate(ossl)", []), + negotiate_ssl(Socket, Timeout); +negotiate({essl, _}, Socket, Timeout) -> + ?hlrt("negotiate(essl)", []), + negotiate_ssl(Socket, Timeout). + +negotiate_ssl(Socket, Timeout) -> + ?hlrt("negotiate_ssl", [{socket, Socket}, {timeout, Timeout}]), case ssl:ssl_accept(Socket, Timeout) of ok -> ok; - {error, Error} -> - case lists:member(Error, - [timeout,econnreset,esslaccept,esslerrssl]) of + {error, Reason} -> + ?hlrd("negotiate_ssl - accept failed", [{reason, Reason}]), + %% Look for "valid" error reasons + ValidReasons = [timeout, econnreset, esslaccept, esslerrssl], + case lists:member(Reason, ValidReasons) of true -> - {error,normal}; + {error, normal}; false -> - {error, Error} + {error, Reason} end end. diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index ce1405011e..879e605217 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -90,20 +90,17 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- -# INETS FLAGS -# ---------------------------------------------------- -INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' - - -# ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -INETS_ERL_FLAGS += -I ../http_lib -I ../inets_app -pa ../../ebin -ERL_COMPILE_FLAGS += $(INETS_ERL_FLAGS) \ - $(INETS_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' +include ../inets_app/inets.mk + +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include \ + -I../inets_app \ + -I../http_lib # ---------------------------------------------------- @@ -125,9 +122,10 @@ docs: include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/http_server + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/http_server + $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin release_docs_spec: diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index 8fe54ccef6..fb5fa1c758 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -24,54 +24,25 @@ -include("httpd.hrl"). --deprecated({start, 0, next_major_release}). --deprecated({start, 1, next_major_release}). --deprecated({start_link, 1, next_major_release}). --deprecated({start_child, 0, next_major_release}). --deprecated({start_child, 1, next_major_release}). --deprecated({stop, 0, next_major_release}). --deprecated({stop, 1, next_major_release}). --deprecated({stop, 2, next_major_release}). --deprecated({stop_child, 0, next_major_release}). --deprecated({stop_child, 1, next_major_release}). --deprecated({stop_child, 2, next_major_release}). --deprecated({restart, 0, next_major_release}). --deprecated({restart, 1, next_major_release}). --deprecated({restart, 2, next_major_release}). --deprecated({block, 0, next_major_release}). --deprecated({block, 1, next_major_release}). --deprecated({block, 2, next_major_release}). --deprecated({block, 3, next_major_release}). --deprecated({block, 4, next_major_release}). --deprecated({unblock, 0, next_major_release}). --deprecated({unblock, 1, next_major_release}). --deprecated({unblock, 2, next_major_release}). %% Behavior callbacks --export([start_standalone/1, start_service/1, stop_service/1, services/0, - service_info/1]). +-export([ + start_standalone/1, + start_service/1, + stop_service/1, + services/0, + service_info/1 + ]). %% API -export([parse_query/1, reload_config/2, info/1, info/2, info/3]). -%% Deprecated --export([start/0, start/1, - start_link/0, start_link/1, - start_child/0,start_child/1, - stop/0,stop/1,stop/2, - stop_child/0,stop_child/1,stop_child/2, - restart/0,restart/1,restart/2]). - -%% Management stuff should be internal functions -%% Will be from r13 --export([block/0,block/1,block/2,block/3,block/4, - unblock/0,unblock/1,unblock/2]). - -%% Internal Debugging and status info stuff... -%% Keep for now should probably be moved to test catalog --export([get_status/1,get_status/2,get_status/3, - get_admin_state/0,get_admin_state/1,get_admin_state/2, - get_usage_state/0,get_usage_state/1,get_usage_state/2]). +%% Internal debugging and status info stuff... +-export([ + get_status/1, get_status/2, get_status/3, + get_admin_state/0, get_admin_state/1, get_admin_state/2, + get_usage_state/0, get_usage_state/1, get_usage_state/2 + ]). %%%======================================================================== %%% API @@ -111,6 +82,7 @@ info(Address, Port, Properties) when is_integer(Port) andalso is_list(Properties) -> httpd_conf:get_config(Address, Port, Properties). + %%%======================================================================== %%% Behavior callbacks %%%======================================================================== @@ -149,6 +121,8 @@ service_info(Pid) -> exit:{noproc, _} -> {error, service_not_available} end. + + %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -176,6 +150,7 @@ child_name2info({httpd_instance_sup, Address, Port}) -> {ok, [{bind_address, Address}, {port, Port} | Info]} end. + reload(Config, Address, Port) -> Name = make_name(Address,Port), case whereis(Name) of @@ -185,26 +160,12 @@ reload(Config, Address, Port) -> {error,not_started} end. -reload(Addr, Port) when is_integer(Port) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:reload(Pid, undefined); - _ -> - {error,not_started} - end. %%% ========================================================= -%%% Function: block/0, block/1, block/2, block/3, block/4 -%%% block() -%%% block(Port) -%%% block(ConfigFile) -%%% block(Addr,Port) -%%% block(Port,Mode) -%%% block(ConfigFile,Mode) -%%% block(Addr,Port,Mode) -%%% block(ConfigFile,Mode,Timeout) -%%% block(Addr,Port,Mode,Timeout) +%%% Function: block/3, block/4 +%%% block(Addr, Port, Mode) +%%% block(ConfigFile, Mode, Timeout) +%%% block(Addr, Port, Mode, Timeout) %%% %%% Returns: ok | {error,Reason} %%% @@ -237,58 +198,32 @@ reload(Addr, Port) when is_integer(Port) -> %%% Mode -> disturbing | non_disturbing %%% Timeout -> integer() %%% -block() -> block(undefined,8888,disturbing). - -block(Port) when is_integer(Port) -> - block(undefined,Port,disturbing); - -block(ConfigFile) when is_list(ConfigFile) -> - case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - block(Addr,Port,disturbing); - Error -> - Error - end. - -block(Addr,Port) when is_integer(Port) -> - block(Addr,Port,disturbing); - -block(Port,Mode) when is_integer(Port) andalso is_atom(Mode) -> - block(undefined,Port,Mode); - -block(ConfigFile,Mode) when is_list(ConfigFile) andalso is_atom(Mode) -> - case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - block(Addr,Port,Mode); - Error -> - Error - end. - -block(Addr,Port,disturbing) when is_integer(Port) -> - do_block(Addr,Port,disturbing); -block(Addr,Port,non_disturbing) when is_integer(Port) -> - do_block(Addr,Port,non_disturbing); +block(Addr, Port, disturbing) when is_integer(Port) -> + do_block(Addr, Port, disturbing); +block(Addr, Port, non_disturbing) when is_integer(Port) -> + do_block(Addr, Port, non_disturbing); -block(ConfigFile,Mode,Timeout) when is_list(ConfigFile) andalso - is_atom(Mode) andalso - is_integer(Timeout) -> +block(ConfigFile, Mode, Timeout) + when is_list(ConfigFile) andalso + is_atom(Mode) andalso + is_integer(Timeout) -> case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - block(Addr,Port,Mode,Timeout); + {ok, Addr, Port} -> + block(Addr, Port, Mode, Timeout); Error -> Error end. -block(Addr,Port,non_disturbing,Timeout) +block(Addr, Port, non_disturbing, Timeout) + when is_integer(Port) andalso is_integer(Timeout) -> + do_block(Addr, Port, non_disturbing, Timeout); +block(Addr,Port,disturbing,Timeout) when is_integer(Port) andalso is_integer(Timeout) -> - do_block(Addr,Port,non_disturbing,Timeout); -block(Addr,Port,disturbing,Timeout) when is_integer(Port) andalso - is_integer(Timeout) -> - do_block(Addr,Port,disturbing,Timeout). + do_block(Addr, Port, disturbing, Timeout). -do_block(Addr,Port,Mode) when is_integer(Port) andalso is_atom(Mode) -> +do_block(Addr, Port, Mode) when is_integer(Port) andalso is_atom(Mode) -> Name = make_name(Addr,Port), case whereis(Name) of Pid when is_pid(Pid) -> @@ -298,7 +233,7 @@ do_block(Addr,Port,Mode) when is_integer(Port) andalso is_atom(Mode) -> end. -do_block(Addr,Port,Mode,Timeout) +do_block(Addr, Port, Mode, Timeout) when is_integer(Port) andalso is_atom(Mode) -> Name = make_name(Addr,Port), case whereis(Name) of @@ -310,11 +245,8 @@ do_block(Addr,Port,Mode,Timeout) %%% ========================================================= -%%% Function: unblock/0, unblock/1, unblock/2 -%%% unblock() -%%% unblock(Port) -%%% unblock(ConfigFile) -%%% unblock(Addr,Port) +%%% Function: unblock/2 +%%% unblock(Addr, Port) %%% %%% Description: This function is used to reverse a previous block %%% operation on the HTTP server. @@ -323,16 +255,6 @@ do_block(Addr,Port,Mode,Timeout) %%% Addr -> {A,B,C,D} | string() | undefined %%% ConfigFile -> string() %%% -unblock() -> unblock(undefined,8888). -unblock(Port) when is_integer(Port) -> unblock(undefined,Port); - -unblock(ConfigFile) when is_list(ConfigFile) -> - case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - unblock(Addr,Port); - Error -> - Error - end. unblock(Addr, Port) when is_integer(Port) -> Name = make_name(Addr,Port), @@ -521,80 +443,81 @@ do_reload_config(ConfigList, Mode) -> %%%-------------------------------------------------------------- %%% Deprecated %%%-------------------------------------------------------------- -start() -> - start("/var/tmp/server_root/conf/8888.conf"). -start(ConfigFile) -> - {ok, Pid} = inets:start(httpd, ConfigFile, stand_alone), - unlink(Pid), - {ok, Pid}. +%% start() -> +%% start("/var/tmp/server_root/conf/8888.conf"). -start_link() -> - start("/var/tmp/server_root/conf/8888.conf"). +%% start(ConfigFile) -> +%% {ok, Pid} = inets:start(httpd, ConfigFile, stand_alone), +%% unlink(Pid), +%% {ok, Pid}. -start_link(ConfigFile) when is_list(ConfigFile) -> - inets:start(httpd, ConfigFile, stand_alone). +%% start_link() -> +%% start("/var/tmp/server_root/conf/8888.conf"). -stop() -> - stop(8888). +%% start_link(ConfigFile) when is_list(ConfigFile) -> +%% inets:start(httpd, ConfigFile, stand_alone). -stop(Port) when is_integer(Port) -> - stop(undefined, Port); -stop(Pid) when is_pid(Pid) -> - old_stop(Pid); -stop(ConfigFile) when is_list(ConfigFile) -> - old_stop(ConfigFile). +%% stop() -> +%% stop(8888). -stop(Addr, Port) when is_integer(Port) -> - old_stop(Addr, Port). +%% stop(Port) when is_integer(Port) -> +%% stop(undefined, Port); +%% stop(Pid) when is_pid(Pid) -> +%% old_stop(Pid); +%% stop(ConfigFile) when is_list(ConfigFile) -> +%% old_stop(ConfigFile). -start_child() -> - start_child("/var/tmp/server_root/conf/8888.conf"). +%% stop(Addr, Port) when is_integer(Port) -> +%% old_stop(Addr, Port). -start_child(ConfigFile) -> - httpd_sup:start_child(ConfigFile). +%% start_child() -> +%% start_child("/var/tmp/server_root/conf/8888.conf"). -stop_child() -> - stop_child(8888). +%% start_child(ConfigFile) -> +%% httpd_sup:start_child(ConfigFile). -stop_child(Port) -> - stop_child(undefined, Port). +%% stop_child() -> +%% stop_child(8888). -stop_child(Addr, Port) when is_integer(Port) -> - httpd_sup:stop_child(Addr, Port). +%% stop_child(Port) -> +%% stop_child(undefined, Port). -restart() -> reload(undefined, 8888). +%% stop_child(Addr, Port) when is_integer(Port) -> +%% httpd_sup:stop_child(Addr, Port). -restart(Port) when is_integer(Port) -> - reload(undefined, Port). -restart(Addr, Port) -> - reload(Addr, Port). +%% restart() -> reload(undefined, 8888). -old_stop(Pid) when is_pid(Pid) -> - do_stop(Pid); -old_stop(ConfigFile) when is_list(ConfigFile) -> - case get_addr_and_port(ConfigFile) of - {ok, Addr, Port} -> - old_stop(Addr, Port); - - Error -> - Error - end; -old_stop(_StartArgs) -> - ok. +%% restart(Port) when is_integer(Port) -> +%% reload(undefined, Port). +%% restart(Addr, Port) -> +%% reload(Addr, Port). -old_stop(Addr, Port) when is_integer(Port) -> - Name = old_make_name(Addr, Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - do_stop(Pid), - ok; - _ -> - not_started - end. +%% old_stop(Pid) when is_pid(Pid) -> +%% do_stop(Pid); +%% old_stop(ConfigFile) when is_list(ConfigFile) -> +%% case get_addr_and_port(ConfigFile) of +%% {ok, Addr, Port} -> +%% old_stop(Addr, Port); + +%% Error -> +%% Error +%% end; +%% old_stop(_StartArgs) -> +%% ok. + +%% old_stop(Addr, Port) when is_integer(Port) -> +%% Name = old_make_name(Addr, Port), +%% case whereis(Name) of +%% Pid when is_pid(Pid) -> +%% do_stop(Pid), +%% ok; +%% _ -> +%% not_started +%% end. -do_stop(Pid) -> - exit(Pid, shutdown). +%% do_stop(Pid) -> +%% exit(Pid, shutdown). -old_make_name(Addr,Port) -> - httpd_util:make_name("httpd_instance_sup",Addr,Port). +%% old_make_name(Addr,Port) -> +%% httpd_util:make_name("httpd_instance_sup",Addr,Port). diff --git a/lib/inets/src/http_server/httpd_acceptor.erl b/lib/inets/src/http_server/httpd_acceptor.erl index 568fd3c610..c261eff6b2 100644 --- a/lib/inets/src/http_server/httpd_acceptor.erl +++ b/lib/inets/src/http_server/httpd_acceptor.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @@ -138,9 +138,9 @@ acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> handle_error(Reason, ConfigDb), ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout); - {'EXIT', Reason} -> - ?hdri("accept exited", [{reason, Reason}]), - handle_error({'EXIT', Reason}, ConfigDb), + {'EXIT', _Reason} = EXIT -> + ?hdri("accept exited", [{reason, _Reason}]), + handle_error(EXIT, ConfigDb), ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) end. diff --git a/lib/inets/src/http_server/httpd_cgi.erl b/lib/inets/src/http_server/httpd_cgi.erl index 0532d7d100..c06a06aad3 100644 --- a/lib/inets/src/http_server/httpd_cgi.erl +++ b/lib/inets/src/http_server/httpd_cgi.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -21,7 +21,8 @@ -export([parse_headers/1, handle_headers/1]). --include("inets_internal.hrl"). +-include_lib("inets/src/inets_app/inets_internal.hrl"). + %%%========================================================================= %%% Internal application API diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 5ca2e47eb5..8438c4037e 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -25,13 +25,15 @@ %% Application internal API -export([load/1, load/2, load_mime_types/1, store/1, store/2, - remove/1, remove_all/1, config/1, get_config/2, get_config/3, - lookup/2, lookup/3, lookup/4, - validate_properties/1]). + remove/1, remove_all/1, get_config/2, get_config/3, + lookup_socket_type/1, + lookup/2, lookup/3, lookup/4, + validate_properties/1]). -define(VMODULE,"CONF"). -include("httpd.hrl"). -include("httpd_internal.hrl"). +-include_lib("inets/src/http_lib/http_internal.hrl"). %%%========================================================================= @@ -216,9 +218,12 @@ load("ServerName " ++ ServerName, []) -> {ok,[],{server_name,clean(ServerName)}}; load("SocketType " ++ SocketType, []) -> - case check_enum(clean(SocketType),["ssl","ip_comm"]) of + %% ssl is the same as HTTP_DEFAULT_SSL_KIND + %% ossl is ssl based on OpenSSL (the "old" ssl) + %% essl is the pure Erlang-based ssl (the "new" ssl) + case check_enum(clean(SocketType), ["ssl", "ossl", "essl", "ip_comm"]) of {ok, ValidSocketType} -> - {ok, [], {socket_type,ValidSocketType}}; + {ok, [], {socket_type, ValidSocketType}}; {error,_} -> {error, ?NICE(clean(SocketType) ++ " is an invalid SocketType")} end; @@ -226,7 +231,7 @@ load("SocketType " ++ SocketType, []) -> load("Port " ++ Port, []) -> case make_integer(Port) of {ok, Integer} -> - {ok, [], {port,Integer}}; + {ok, [], {port, Integer}}; {error, _} -> {error, ?NICE(clean(Port)++" is an invalid Port")} end; @@ -534,7 +539,10 @@ validate_config_params([{server_name, Value} | _]) -> throw({server_name, Value}); validate_config_params([{socket_type, Value} | Rest]) - when (Value =:= ip_comm) orelse (Value =:= ssl) -> + when (Value =:= ip_comm) orelse + (Value =:= ssl) orelse + (Value =:= ossl) orelse + (Value =:= essl) -> validate_config_params(Rest); validate_config_params([{socket_type, Value} | _]) -> throw({socket_type, Value}); @@ -695,6 +703,8 @@ store(ConfigList0) -> ConfigList) catch throw:Error -> + ?hdri("store - config parameter validation failed", + [{error, Error}]), {error, {invalid_option, Error}} end. @@ -741,27 +751,27 @@ remove(ConfigDB) -> ets:delete(ConfigDB), ok. -config(ConfigDB) -> - case httpd_util:lookup(ConfigDB, socket_type,ip_comm) of - ssl -> - case ssl_certificate_file(ConfigDB) of - undefined -> - {error, - "Directive SSLCertificateFile " - "not found in the config file"}; - SSLCertificateFile -> - {ssl, - SSLCertificateFile++ - ssl_certificate_key_file(ConfigDB)++ - ssl_verify_client(ConfigDB)++ - ssl_ciphers(ConfigDB)++ - ssl_password(ConfigDB)++ - ssl_verify_depth(ConfigDB)++ - ssl_ca_certificate_file(ConfigDB)} - end; - ip_comm -> - ip_comm - end. +%% config(ConfigDB) -> +%% case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of +%% ssl -> +%% case ssl_certificate_file(ConfigDB) of +%% undefined -> +%% {error, +%% "Directive SSLCertificateFile " +%% "not found in the config file"}; +%% SSLCertificateFile -> +%% {ssl, +%% SSLCertificateFile++ +%% ssl_certificate_key_file(ConfigDB)++ +%% ssl_verify_client(ConfigDB)++ +%% ssl_ciphers(ConfigDB)++ +%% ssl_password(ConfigDB)++ +%% ssl_verify_depth(ConfigDB)++ +%% ssl_ca_certificate_file(ConfigDB)} +%% end; +%% ip_comm -> +%% ip_comm +%% end. get_config(Address, Port) -> @@ -797,6 +807,38 @@ table(Address, Port) -> httpd_util:make_name("httpd_conf", Address, Port). +lookup_socket_type(ConfigDB) -> + case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of + ip_comm -> + ip_comm; + SSL when (SSL =:= ssl) orelse (SSL =:= ossl) orelse (SSL =:= essl) -> + SSLTag = + if + (SSL =:= ssl) -> + ?HTTP_DEFAULT_SSL_KIND; + true -> + SSL + end, + case ssl_certificate_file(ConfigDB) of + undefined -> + Reason = "Directive SSLCertificateFile " + "not found in the config file", + throw({error, Reason}); + SSLCertificateFile -> + {SSLTag, SSLCertificateFile ++ ssl_config(ConfigDB)} + end + end. + +ssl_config(ConfigDB) -> + ssl_certificate_key_file(ConfigDB) ++ + ssl_verify_client(ConfigDB) ++ + ssl_ciphers(ConfigDB) ++ + ssl_password(ConfigDB) ++ + ssl_verify_depth(ConfigDB) ++ + ssl_ca_certificate_file(ConfigDB). + + + %%%======================================================================== %%% Internal functions %%%======================================================================== diff --git a/lib/inets/src/http_server/httpd_esi.erl b/lib/inets/src/http_server/httpd_esi.erl index b1a75fda52..026ec9a5fe 100644 --- a/lib/inets/src/http_server/httpd_esi.erl +++ b/lib/inets/src/http_server/httpd_esi.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -21,7 +21,8 @@ -export([parse_headers/1, handle_headers/1]). --include("inets_internal.hrl"). +-include_lib("inets/src/inets_app/inets_internal.hrl"). + %%%========================================================================= %%% Internal application API diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl index 7795ab6c18..38b0ddefd3 100644 --- a/lib/inets/src/http_server/httpd_internal.hrl +++ b/lib/inets/src/http_server/httpd_internal.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -21,7 +21,8 @@ -ifndef(httpd_internal_hrl). -define(httpd_internal_hrl, true). --include("inets_internal.hrl"). +-include_lib("inets/src/inets_app/inets_internal.hrl"). + -define(SERVICE, httpd). -define(hdri(Label, Content), ?report_important(Label, ?SERVICE, Content)). -define(hdrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)). diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index f2e8763907..b44bc77c41 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @@ -238,24 +238,25 @@ init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port]) -> case (catch do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port)) of {error, Reason} -> String = lists:flatten( - io_lib:format("Failed initiating " - "web server: ~n~p~n~p~n", - [ConfigFile,Reason])), + io_lib:format("Failed initiating web server: " + "~n~p" + "~n~p" + "~n", [ConfigFile, Reason])), error_logger:error_report(String), {stop, {error, Reason}}; {ok, State} -> {ok, State} end; -init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port, - ListenInfo]) -> +init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo]) -> process_flag(trap_exit, true), case (catch do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo)) of {error, Reason} -> String = lists:flatten( - io_lib:format("Failed initiating " - "web server: ~n~p~n~p~n", - [ConfigFile,Reason])), + io_lib:format("Failed initiating web server: " + "~n~p" + "~n~p" + "~n", [ConfigFile, Reason])), error_logger:error_report(String), {stop, {error, Reason}}; {ok, State} -> @@ -264,13 +265,14 @@ init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port, do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), - ConfigDB = do_initial_store(ConfigList), - SocketType = httpd_conf:config(ConfigDB), + ConfigDB = do_initial_store(ConfigList), + SocketType = httpd_conf:lookup_socket_type(ConfigDB), case httpd_acceptor_sup:start_acceptor(SocketType, Addr, Port, ConfigDB, AcceptTimeout) of {ok, _Pid} -> - Status = [{max_conn,0}, {last_heavy_load,never}, - {last_connection,never}], + Status = [{max_conn, 0}, + {last_heavy_load, never}, + {last_connection, never}], State = #state{socket_type = SocketType, config_file = NewConfigFile, config_db = ConfigDB, @@ -284,7 +286,7 @@ do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo) -> NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), - SocketType = httpd_conf:config(ConfigDB), + SocketType = httpd_conf:lookup_socket_type(ConfigDB), case httpd_acceptor_sup:start_acceptor(SocketType, Addr, Port, ConfigDB, AcceptTimeout, ListenInfo) of diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 8eee08e766..883acbf585 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -19,22 +19,35 @@ -module(httpd_request). --include("http_internal.hrl"). +-include_lib("inets/src/http_lib/http_internal.hrl"). -include("httpd.hrl"). +-include("httpd_internal.hrl"). --export([parse/1, whole_body/2, validate/3, update_mod_data/5, - body_data/2]). +-export([ + parse/1, + whole_body/2, + validate/3, + update_mod_data/5, + body_data/2 + ]). %% Callback API - used for example if the header/body is received a %% little at a time on a socket. --export([parse_method/1, parse_uri/1, parse_version/1, parse_headers/1, - whole_body/1]). +-export([ + parse_method/1, parse_uri/1, parse_version/1, parse_headers/1, + whole_body/1 + ]). + %%%========================================================================= %%% Internal application API %%%========================================================================= parse([Bin, MaxSizes]) -> - parse_method(Bin, [], MaxSizes, []). + ?hdrt("parse", [{bin, Bin}, {max_sizes, MaxSizes}]), + parse_method(Bin, [], MaxSizes, []); +parse(Unknown) -> + ?hdrt("parse", [{unknown, Unknown}]), + exit({bad_args, Unknown}). %% Functions that may be returned during the decoding process %% if the input data is incompleate. @@ -119,30 +132,65 @@ update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)-> %%% Internal functions %%%======================================================================== parse_method(<<>>, Method, MaxSizes, Result) -> + ?hdrt("parse_method - empty bin", + [{method, Method}, {max_sizes, MaxSizes}, {result, Result}]), {?MODULE, parse_method, [Method, MaxSizes, Result]}; parse_method(<<?SP, Rest/binary>>, Method, MaxSizes, Result) -> + ?hdrt("parse_method - SP begin", + [{rest, Rest}, + {method, Method}, + {max_sizes, MaxSizes}, + {result, Result}]), parse_uri(Rest, [], 0, MaxSizes, [string:strip(lists:reverse(Method)) | Result]); parse_method(<<Octet, Rest/binary>>, Method, MaxSizes, Result) -> + ?hdrt("parse_method", + [{octet, Octet}, + {rest, Rest}, + {method, Method}, + {max_sizes, MaxSizes}, + {result, Result}]), parse_method(Rest, [Octet | Method], MaxSizes, Result). -parse_uri(_, _, CurrSize, {MaxURI, _}, _) when CurrSize > MaxURI, - MaxURI =/= nolimit -> +parse_uri(_, _, CurrSize, {MaxURI, _}, _) + when (CurrSize > MaxURI) andalso (MaxURI =/= nolimit) -> + ?hdrt("parse_uri", + [{current_size, CurrSize}, + {max_uri, MaxURI}]), %% We do not know the version of the client as it comes after the %% uri send the lowest version in the response so that the client %% will be able to handle it. HttpVersion = "HTTP/0.9", {error, {uri_too_long, MaxURI}, HttpVersion}; parse_uri(<<>>, URI, CurrSize, MaxSizes, Result) -> + ?hdrt("parse_uri - empty bin", + [{uri, URI}, + {current_size, CurrSize}, + {max_sz, MaxSizes}, + {result, Result}]), {?MODULE, parse_uri, [URI, CurrSize, MaxSizes, Result]}; parse_uri(<<?SP, Rest/binary>>, URI, _, MaxSizes, Result) -> + ?hdrt("parse_uri - SP begin", + [{uri, URI}, + {max_sz, MaxSizes}, + {result, Result}]), parse_version(Rest, [], MaxSizes, [string:strip(lists:reverse(URI)) | Result]); %% Can happen if it is a simple HTTP/0.9 request e.i "GET /\r\n\r\n" -parse_uri(<<?CR, _Rest/binary>> = Data, URI, _,MaxSizes, Result) -> +parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, MaxSizes, Result) -> + ?hdrt("parse_uri - CR begin", + [{uri, URI}, + {max_sz, MaxSizes}, + {result, Result}]), parse_version(Data, [], MaxSizes, [string:strip(lists:reverse(URI)) | Result]); parse_uri(<<Octet, Rest/binary>>, URI, CurrSize, MaxSizes, Result) -> + ?hdrt("parse_uri", + [{octet, Octet}, + {uri, URI}, + {curr_sz, CurrSize}, + {max_sz, MaxSizes}, + {result, Result}]), parse_uri(Rest, [Octet | URI], CurrSize + 1, MaxSizes, Result). parse_version(<<>>, Version, MaxSizes, Result) -> diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index fa832cba3f..a9db6e2058 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @@ -101,11 +101,13 @@ init([Manager, ConfigDB, AcceptTimeout]) -> Then = erlang:now(), + ?hdrd("negotiate", []), case http_transport:negotiate(SocketType, Socket, TimeOut) of {error, Error} -> + ?hdrd("negotiation failed", [{error, Error}]), exit(Error); %% Can be 'normal'. ok -> - ?hdrt("negotiated", []), + ?hdrt("negotiation successfull", []), NewTimeout = TimeOut - timer:now_diff(now(),Then) div 1000, continue_init(Manager, ConfigDB, SocketType, Socket, NewTimeout) end. @@ -121,12 +123,9 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> socket = Socket, init_data = InitData}, - MaxHeaderSize = httpd_util:lookup(ConfigDB, max_header_size, - ?HTTP_MAX_HEADER_SIZE), - MaxURISize = httpd_util:lookup(ConfigDB, max_uri_size, - ?HTTP_MAX_URI_SIZE), - NrOfRequest = httpd_util:lookup(ConfigDB, - max_keep_alive_request, infinity), + MaxHeaderSize = max_header_size(ConfigDB), + MaxURISize = max_uri_size(ConfigDB), + NrOfRequest = max_keep_alive_request(ConfigDB), {_, Status} = httpd_manager:new_connection(Manager), @@ -142,9 +141,10 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> ?hdrt("activate request timeout", []), NewState = activate_request_timeout(State), - ?hdrt("update socket options", []), - http_transport:setopts(SocketType, Socket, [binary,{packet, 0}, - {active, once}]), + ?hdrt("set socket options (binary, packet & active)", []), + http_transport:setopts(SocketType, Socket, + [binary, {packet, 0}, {active, once}]), + ?hdrt("init done", []), gen_server:enter_loop(?MODULE, [], NewState). @@ -180,21 +180,29 @@ handle_cast(Msg, State) -> %% {stop, Reason, State} %% Description: Handling all non call/cast messages %%-------------------------------------------------------------------- -handle_info({Proto, Socket, Data}, State = +handle_info({Proto, Socket, Data}, #state{mfa = {Module, Function, Args} = MFA, mod = #mod{socket_type = SockType, socket = Socket} = ModData} = State) when (((Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= dummy)) andalso is_binary(Data)) -> + ?hdrd("received data", [{data, Data}, {proto, Proto}, {socket, Socket}, {socket_type, SockType}, {mfa, MFA}]), - case Module:Function([Data | Args]) of + +%% case (catch Module:Function([Data | Args])) of + PROCESSED = (catch Module:Function([Data | Args])), + + ?hdrt("data processed", [{processing_result, PROCESSED}]), + + case PROCESSED of {ok, Result} -> ?hdrd("data processed", [{result, Result}]), NewState = cancel_request_timeout(State), handle_http_msg(Result, NewState); + {error, {uri_too_long, MaxSize}, Version} -> ?hdrv("uri too long", [{max_size, MaxSize}, {version, Version}]), NewModData = ModData#mod{http_version = Version}, @@ -205,7 +213,8 @@ handle_info({Proto, Socket, Data}, State = {stop, normal, State#state{response_sent = true, mod = NewModData}}; {error, {header_too_long, MaxSize}, Version} -> - ?hdrv("header too long", [{max_size, MaxSize}, {version, Version}]), + ?hdrv("header too long", + [{max_size, MaxSize}, {version, Version}]), NewModData = ModData#mod{http_version = Version}, httpd_response:send_status(NewModData, 413, "Header too long"), Reason = io_lib:format("Header too long, max size is ~p~n", @@ -263,14 +272,16 @@ terminate(Reason, #state{response_sent = false, mod = ModData} = State) -> httpd_response:send_status(ModData, 500, none), error_log(httpd_util:reason_phrase(500), ModData), terminate(Reason, State#state{response_sent = true, mod = ModData}); -terminate(_, State) -> +terminate(_Reason, State) -> do_terminate(State). do_terminate(#state{mod = ModData, manager = Manager} = State) -> catch httpd_manager:done_connection(Manager), cancel_request_timeout(State), + %% receive after 5000 -> ok end, httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket). + %%-------------------------------------------------------------------- %% code_change(OldVsn, State, Extra) -> {ok, NewState} %% @@ -279,6 +290,7 @@ do_terminate(#state{mod = ModData, manager = Manager} = State) -> code_change(_OldVsn, State, _Extra) -> {ok, State}. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -383,9 +395,8 @@ is_host_specified_if_required(_, _, _) -> handle_body(#state{mod = #mod{config_db = ConfigDB}} = State) -> ?hdrt("handle body", []), - MaxHeaderSize = - httpd_util:lookup(ConfigDB, max_header_size, ?HTTP_MAX_HEADER_SIZE), - MaxBodySize = httpd_util:lookup(ConfigDB, max_body_size, nolimit), + MaxHeaderSize = max_header_size(ConfigDB), + MaxBodySize = max_body_size(ConfigDB), case handle_expect(State, MaxBodySize) of ok -> @@ -538,24 +549,23 @@ handle_response(#state{body = Body, {stop, normal, State#state{response_sent = true}}. handle_next_request(#state{mod = #mod{connection = true} = ModData, - max_keep_alive_request = Max} = State, Data) -> + max_keep_alive_request = Max} = State, Data) -> ?hdrt("handle next request", [{max, Max}]), + NewModData = #mod{socket_type = ModData#mod.socket_type, - socket = ModData#mod.socket, - config_db = ModData#mod.config_db, - init_data = ModData#mod.init_data}, - MaxHeaderSize = - httpd_util:lookup(ModData#mod.config_db, - max_header_size, ?HTTP_MAX_HEADER_SIZE), - MaxURISize = httpd_util:lookup(ModData#mod.config_db, max_uri_size, - ?HTTP_MAX_URI_SIZE), - TmpState = State#state{mod = NewModData, - mfa = {httpd_request, parse, [{MaxURISize, - MaxHeaderSize}]}, + socket = ModData#mod.socket, + config_db = ModData#mod.config_db, + init_data = ModData#mod.init_data}, + MaxHeaderSize = max_header_size(ModData#mod.config_db), + MaxURISize = max_uri_size(ModData#mod.config_db), + + MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]}, + TmpState = State#state{mod = NewModData, + mfa = MFA, max_keep_alive_request = decrease(Max), - headers = undefined, - body = undefined, - response_sent = false}, + headers = undefined, + body = undefined, + response_sent = false}, NewState = activate_request_timeout(TmpState), @@ -596,7 +606,7 @@ decrease(N) -> error_log(ReasonString, Info) -> Error = lists:flatten( - io_lib:format("Error reading request:~s",[ReasonString])), + io_lib:format("Error reading request: ~s", [ReasonString])), error_log(mod_log, Info, Error), error_log(mod_disk_log, Info, Error). @@ -609,3 +619,21 @@ error_log(Mod, #mod{config_db = ConfigDB} = Info, String) -> _ -> ok end. + + +%%-------------------------------------------------------------------- +%% Config access wrapper functions +%%-------------------------------------------------------------------- + +max_header_size(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_header_size, ?HTTP_MAX_HEADER_SIZE). + +max_uri_size(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_uri_size, ?HTTP_MAX_URI_SIZE). + +max_body_size(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_body_size, nolimit). + +max_keep_alive_request(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_keep_alive_request, infinity). + diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index ec0a12242f..9c5a8cc1c6 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -103,6 +103,19 @@ real_name(ConfigDB, RequestURI, []) -> httpd_util:split_path(default_index(ConfigDB, RealName)), {ShortPath, Path, AfterPath}; +real_name(ConfigDB, RequestURI, [{MP,Replacement}|Rest]) + when element(1, MP) =:= re_pattern -> + case re:run(RequestURI, MP, [{capture,[]}]) of + match -> + NewURI = re:replace(RequestURI, MP, Replacement, [{return,list}]), + {ShortPath,_} = httpd_util:split_path(NewURI), + {Path,AfterPath} = + httpd_util:split_path(default_index(ConfigDB, NewURI)), + {ShortPath, Path, AfterPath}; + nomatch -> + real_name(ConfigDB, RequestURI, Rest) + end; + real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) -> case inets_regexp:match(RequestURI, "^" ++ FakeName) of {match, _, _} -> @@ -120,6 +133,18 @@ real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) -> real_script_name(_ConfigDB, _RequestURI, []) -> not_a_script; + +real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) + when element(1, MP) =:= re_pattern -> + case re:run(RequestURI, MP, [{capture,[]}]) of + match -> + ActualName = + re:replace(RequestURI, MP, Replacement, [{return,list}]), + httpd_util:split_script_path(default_index(ConfigDB, ActualName)); + nomatch -> + real_script_name(ConfigDB, RequestURI, Rest) + end; + real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) -> case inets_regexp:match(RequestURI, "^" ++ FakeName) of {match,_,_} -> @@ -180,6 +205,8 @@ load("Alias " ++ Alias, []) -> {ok, _} -> {error,?NICE(httpd_conf:clean(Alias)++" is an invalid Alias")} end; +load("ReWrite " ++ Rule, Acc) -> + load_re_write(Rule, Acc, "ReWrite", re_write); load("ScriptAlias " ++ ScriptAlias, []) -> case inets_regexp:split(ScriptAlias, " ") of {ok, [FakeName, RealName]} -> @@ -189,6 +216,24 @@ load("ScriptAlias " ++ ScriptAlias, []) -> {ok, _} -> {error, ?NICE(httpd_conf:clean(ScriptAlias)++ " is an invalid ScriptAlias")} + end; +load("ScriptReWrite " ++ Rule, Acc) -> + load_re_write(Rule, Acc, "ScriptReWrite", script_re_write). + +load_re_write(Rule0, Acc, Type, Tag) -> + case lists:dropwhile( + fun ($\s) -> true; ($\t) -> true; (_) -> false end, + Rule0) of + "" -> + {error, ?NICE(httpd_conf:clean(Rule0)++" is an invalid "++Type)}; + Rule -> + case string:chr(Rule, $\s) of + 0 -> + {ok, Acc, {Tag, {Rule, ""}}}; + N -> + {Re, [_|Replacement]} = lists:split(N-1, Rule), + {ok, Acc, {Tag, {Re, Replacement}}} + end end. store({directory_index, Value} = Conf, _) when is_list(Value) -> @@ -200,16 +245,36 @@ store({directory_index, Value} = Conf, _) when is_list(Value) -> end; store({directory_index, Value}, _) -> {error, {wrong_type, {directory_index, Value}}}; -store({alias, {Fake, Real}} = Conf, _) - when is_list(Fake) andalso is_list(Real) -> +store({alias, {Fake, Real}} = Conf, _) + when is_list(Fake), is_list(Real) -> {ok, Conf}; store({alias, Value}, _) -> {error, {wrong_type, {alias, Value}}}; +store({re_write, {Re, Replacement}} = Conf, _) + when is_list(Re), is_list(Replacement) -> + case re:compile(Re) of + {ok, MP} -> + {ok, {alias, {MP, Replacement}}}; + {error,_} -> + {error, {re_compile, Conf}} + end; +store({re_write, _} = Conf, _) -> + {error, {wrong_type, Conf}}; store({script_alias, {Fake, Real}} = Conf, _) - when is_list(Fake) andalso is_list(Real) -> + when is_list(Fake), is_list(Real) -> {ok, Conf}; store({script_alias, Value}, _) -> - {error, {wrong_type, {script_alias, Value}}}. + {error, {wrong_type, {script_alias, Value}}}; +store({script_re_write, {Re, Replacement}} = Conf, _) + when is_list(Re), is_list(Replacement) -> + case re:compile(Re) of + {ok, MP} -> + {ok, {script_alias, {MP, Replacement}}}; + {error,_} -> + {error, {re_compile, Conf}} + end; +store({script_re_write, _} = Conf, _) -> + {error, {wrong_type, Conf}}. is_directory_index_list([]) -> true; diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index cb33544540..f7877aa9e2 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -29,6 +29,7 @@ -export([do/1, load/2, store/2]). -include("httpd.hrl"). +-include("httpd_internal.hrl"). -define(VMODULE,"ESI"). -define(DEFAULT_ERL_TIMEOUT,15000). @@ -37,6 +38,7 @@ %%%========================================================================= %%% API %%%========================================================================= + %%-------------------------------------------------------------------------- %% deliver(SessionID, Data) -> ok | {error, bad_sessionID} %% SessionID = pid() @@ -48,7 +50,7 @@ %% request handling process so it can forward it to the client. %%------------------------------------------------------------------------- deliver(SessionID, Data) when is_pid(SessionID) -> - SessionID ! {ok, Data}, + SessionID ! {esi_data, Data}, ok; deliver(_SessionID, _Data) -> {error, bad_sessionID}. @@ -65,6 +67,7 @@ deliver(_SessionID, _Data) -> %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS %%------------------------------------------------------------------------- do(ModData) -> + ?hdrt("do", []), case proplists:get_value(status, ModData#mod.data) of {_StatusCode, _PhraseArgs, _Reason} -> {proceed, ModData#mod.data}; @@ -184,6 +187,7 @@ store({erl_script_nocache, Value}, _) -> %%% Internal functions %%%======================================================================== generate_response(ModData) -> + ?hdrt("generate response", []), case scheme(ModData#mod.request_uri, ModData#mod.config_db) of {eval, ESIBody, Modules} -> eval(ModData, ESIBody, Modules); @@ -235,6 +239,7 @@ alias_match_str(Alias, eval_script_alias) -> erl(#mod{method = Method} = ModData, ESIBody, Modules) when (Method =:= "GET") orelse (Method =:= "HEAD") -> + ?hdrt("erl", [{method, Method}]), case httpd_util:split(ESIBody,":|%3A|/",2) of {ok, [ModuleName, FuncAndInput]} -> case httpd_util:split(FuncAndInput,"[\?/]",2) of @@ -260,6 +265,7 @@ erl(#mod{request_uri = ReqUri, method = "PUT", http_version = Version, data = Data}, _ESIBody, _Modules) -> + ?hdrt("erl", [{method, put}]), {proceed, [{status,{501,{"PUT", ReqUri, Version}, ?NICE("Erl mechanism doesn't support method PUT")}}| Data]}; @@ -268,12 +274,14 @@ erl(#mod{request_uri = ReqUri, method = "DELETE", http_version = Version, data = Data}, _ESIBody, _Modules) -> + ?hdrt("erl", [{method, delete}]), {proceed,[{status,{501,{"DELETE", ReqUri, Version}, ?NICE("Erl mechanism doesn't support method DELETE")}}| Data]}; erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) -> + ?hdrt("erl", [{method, post}]), case httpd_util:split(ESIBody,":|%3A|/",2) of {ok,[ModuleName, Function]} -> generate_webpage(ModData, ESIBody, Modules, @@ -289,6 +297,7 @@ generate_webpage(ModData, ESIBody, [all], Module, FunctionName, FunctionName, Input, ScriptElements); generate_webpage(ModData, ESIBody, Modules, Module, FunctionName, Input, ScriptElements) -> + ?hdrt("generate webpage", []), Function = list_to_atom(FunctionName), case lists:member(Module, Modules) of true -> @@ -309,8 +318,9 @@ generate_webpage(ModData, ESIBody, Modules, Module, FunctionName, %% Old API that waits for the dymnamic webpage to be totally generated %% before anythig is sent back to the client. -erl_scheme_webpage_whole(Module, Function, Env, Input, ModData) -> - case (catch Module:Function(Env, Input)) of +erl_scheme_webpage_whole(Mod, Func, Env, Input, ModData) -> + ?hdrt("erl_scheme_webpage_whole", [{module, Mod}, {function, Func}]), + case (catch Mod:Func(Env, Input)) of {'EXIT',{undef, _}} -> {proceed, [{status, {404, ModData#mod.request_uri, "Not found"}} | ModData#mod.data]}; @@ -347,6 +357,7 @@ erl_scheme_webpage_whole(Module, Function, Env, Input, ModData) -> %% in small chunks at the time during generation. erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) -> process_flag(trap_exit, true), + ?hdrt("erl_scheme_webpage_chunk", [{module, Mod}, {function, Func}]), Self = self(), %% Spawn worker that generates the webpage. %% It would be nicer to use erlang:function_exported/3 but if the @@ -372,9 +383,12 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid) -> deliver_webpage_chunk(ModData, Pid, Timeout). deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> + ?hdrt("deliver_webpage_chunk", [{timeout, Timeout}]), case receive_headers(Timeout) of {error, Reason} -> %% Happens when webpage generator callback/3 is undefined + ?hdrv("deliver_webpage_chunk - failed receiving headers", + [{reason, Reason}]), {error, Reason}; {Headers, Body} -> case httpd_esi:handle_headers(Headers) of @@ -399,6 +413,7 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> IsDisableChunkedSend) end; timeout -> + ?hdrv("deliver_webpage_chunk - timeout", []), send_headers(ModData, {504, "Timeout"},[{"connection", "close"}]), httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket), process_flag(trap_exit,false), @@ -407,11 +422,17 @@ deliver_webpage_chunk(#mod{config_db = Db} = ModData, Pid, Timeout) -> receive_headers(Timeout) -> receive + {esi_data, Chunk} -> + ?hdrt("receive_headers - received esi data (esi)", []), + httpd_esi:parse_headers(lists:flatten(Chunk)); {ok, Chunk} -> + ?hdrt("receive_headers - received esi data (ok)", []), httpd_esi:parse_headers(lists:flatten(Chunk)); {'EXIT', Pid, erl_scheme_webpage_chunk_undefined} when is_pid(Pid) -> + ?hdrd("receive_headers - exit:chunk-undef", []), {error, erl_scheme_webpage_chunk_undefined}; {'EXIT', Pid, Reason} when is_pid(Pid) -> + ?hdrv("receive_headers - exit", [{reason, Reason}]), exit({mod_esi_linked_process_died, Pid, Reason}) after Timeout -> timeout @@ -427,19 +448,29 @@ handle_body(_, #mod{method = "HEAD"} = ModData, _, _, Size, _) -> {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]}; handle_body(Pid, ModData, Body, Timeout, Size, IsDisableChunkedSend) -> + ?hdrt("handle_body - send chunk", [{timeout, Timeout}, {size, Size}]), httpd_response:send_chunk(ModData, Body, IsDisableChunkedSend), receive + {esi_data, Data} -> + ?hdrt("handle_body - received data (esi)", []), + handle_body(Pid, ModData, Data, Timeout, Size + length(Data), + IsDisableChunkedSend); {ok, Data} -> + ?hdrt("handle_body - received data (ok)", []), handle_body(Pid, ModData, Data, Timeout, Size + length(Data), IsDisableChunkedSend); {'EXIT', Pid, normal} when is_pid(Pid) -> + ?hdrt("handle_body - exit:normal", []), httpd_response:send_final_chunk(ModData, IsDisableChunkedSend), {proceed, [{response, {already_sent, 200, Size}} | ModData#mod.data]}; {'EXIT', Pid, Reason} when is_pid(Pid) -> + ?hdrv("handle_body - exit", [{reason, Reason}]), httpd_response:send_final_chunk(ModData, IsDisableChunkedSend), exit({mod_esi_linked_process_died, Pid, Reason}) + after Timeout -> + ?hdrv("handle_body - timeout", []), process_flag(trap_exit,false), httpd_response:send_final_chunk(ModData, IsDisableChunkedSend), exit({mod_esi_linked_process_timeout, Pid}) @@ -473,6 +504,7 @@ eval(#mod{request_uri = ReqUri, method = "PUT", http_version = Version, data = Data}, _ESIBody, _Modules) -> + ?hdrt("eval", [{method, put}]), {proceed,[{status,{501,{"PUT", ReqUri, Version}, ?NICE("Eval mechanism doesn't support method PUT")}}| Data]}; @@ -481,6 +513,7 @@ eval(#mod{request_uri = ReqUri, method = "DELETE", http_version = Version, data = Data}, _ESIBody, _Modules) -> + ?hdrt("eval", [{method, delete}]), {proceed,[{status,{501,{"DELETE", ReqUri, Version}, ?NICE("Eval mechanism doesn't support method DELETE")}}| Data]}; @@ -489,12 +522,14 @@ eval(#mod{request_uri = ReqUri, method = "POST", http_version = Version, data = Data}, _ESIBody, _Modules) -> + ?hdrt("eval", [{method, post}]), {proceed,[{status,{501,{"POST", ReqUri, Version}, ?NICE("Eval mechanism doesn't support method POST")}}| Data]}; eval(#mod{method = Method} = ModData, ESIBody, Modules) - when Method == "GET"; Method == "HEAD" -> + when (Method =:= "GET") orelse (Method =:= "HEAD") -> + ?hdrt("eval", [{method, Method}]), case is_authorized(ESIBody, Modules) of true -> case generate_webpage(ESIBody) of diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 33c9e34a3a..4632ff3b68 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -67,18 +67,15 @@ APPUP_TARGET = $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- -# INETS FLAGS -# ---------------------------------------------------- -INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' - - -# ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += $(INETS_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' +include inets.mk + +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include # ---------------------------------------------------- @@ -112,7 +109,8 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/inets_app + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/inets_app $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 04f6365b98..cb036157a5 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -107,5 +107,6 @@ tftp_sup ]}, {registered,[inets_sup, httpc_manager]}, + %% If the "new" ssl is used then 'crypto' must be started before inets. {applications,[kernel,stdlib]}, {mod,{inets_app,[]}}]}. diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 718f37b09e..64fe664006 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,29 +18,24 @@ {"%VSN%", [ + {"5.3.3", + [ + {restart_application, inets} + ] + }, {"5.3.2", [ - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, []} + {restart_application, inets} ] }, {"5.3.1", [ - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, []}, - {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, - {update, httpc_manager, soft, soft_purge, soft_purge, []} + {restart_application, inets} ] }, {"5.3", [ - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, []}, - {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, - {update, httpc_manager, soft, soft_purge, soft_purge, []}, - {load_module, mod_esi, soft_purge, soft_purge, []} + {restart_application, inets} ] }, {"5.2", @@ -60,29 +55,24 @@ } ], [ + {"5.3.3", + [ + {restart_application, inets} + ] + }, {"5.3.2", [ - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, []} + {restart_application, inets} ] }, {"5.3.1", [ - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, []}, - {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, - {update, httpc_manager, soft, soft_purge, soft_purge, []} + {restart_application, inets} ] }, {"5.3", [ - {load_module, http_util, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}, - {load_module, httpc_cookie, soft_purge, soft_purge, []}, - {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, - {update, httpc_manager, soft, soft_purge, soft_purge, []}, - {load_module, mod_esi, soft_purge, soft_purge, []} + {restart_application, inets} ] }, {"5.2", diff --git a/lib/inets/src/inets_app/inets.mk b/lib/inets/src/inets_app/inets.mk new file mode 100644 index 0000000000..b6e9fe1d96 --- /dev/null +++ b/lib/inets/src/inets_app/inets.mk @@ -0,0 +1,45 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +ifeq ($(INETS_TRACE), io) +ERL_COMPILE_FLAGS += -Dinets_trace_io +endif + +ifeq ($(INETS_DEBUG), true) +ERL_COMPILE_FLAGS += -Dinets_debug +endif + +ifeq ($(USE_INETS_HIPE), true) +ERL_COMPILE_FLAGS += +native +endif + +ifeq ($(WARN_UNUSED_WARS), true) +ERL_COMPILE_FLAGS += +warn_unused_vars +endif + +INETS_APP_VSN_COMPILE_FLAGS = \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' + +INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' + +INETS_ERL_COMPILE_FLAGS += \ + -pa $(ERL_TOP)/lib/inets/ebin \ + $(INETS_APP_VSN_COMPILE_FLAGS) + diff --git a/lib/inets/src/inets_app/inets_service.erl b/lib/inets/src/inets_app/inets_service.erl index 3499314d54..e9eb9892f2 100644 --- a/lib/inets/src/inets_app/inets_service.erl +++ b/lib/inets/src/inets_app/inets_service.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -61,5 +61,5 @@ behaviour_info(_) -> %% service_info() -> [{Property, Value}] | {error, Reason} -%% ex: http:service_info() -> [{profile, ProfileName}] +%% ex: httpc:service_info() -> [{profile, ProfileName}] %% httpd:service_info() -> [{host, Host}, {port, Port}] diff --git a/lib/inets/src/tftp/Makefile b/lib/inets/src/tftp/Makefile index b4339da1e2..759b70c8e4 100644 --- a/lib/inets/src/tftp/Makefile +++ b/lib/inets/src/tftp/Makefile @@ -56,17 +56,16 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- -# INETS FLAGS +# FLAGS # ---------------------------------------------------- -INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"' +include ../inets_app/inets.mk -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += $(INETS_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' +ERL_COMPILE_FLAGS += \ + $(INETS_FLAGS) \ + $(INETS_ERL_COMPILE_FLAGS) \ + -I../../include \ + -I../inets_app # ---------------------------------------------------- @@ -87,9 +86,10 @@ docs: include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/tftp + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src/tftp + $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin release_docs_spec: diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 668752da9e..bb7f2186af 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -143,6 +143,8 @@ else INETS_FLAGS += -Dhttpd_security_verbosity=log endif +INETS_FLAGS += -pa ../../inets/ebin + INETS_ROOT = ../../inets MODULES = \ @@ -241,8 +243,11 @@ RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin # The path to the test_server ebin dir is needed when # running the target "targets". # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa ../../../internal_tools/test_server/ebin \ - $(INCLUDES) $(FTP_FLAGS) $(INETS_FLAGS) +ERL_COMPILE_FLAGS += \ + -pa ../../../internal_tools/test_server/ebin \ + $(INCLUDES) \ + $(FTP_FLAGS) \ + $(INETS_FLAGS) # ---------------------------------------------------- # Targets diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index 75e1a5a7f9..5e27bc3a86 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -48,14 +48,17 @@ -ifdef(ftp_debug_client). -define(ftp_open(Host, Flags), - do_ftp_open(Host, [debug, {timeout, timer:seconds(15)}] ++ Flags)). + do_ftp_open(Host, [{debug, debug}, + {timeout, timer:seconds(15)} | Flags])). -else. -ifdef(ftp_trace_client). -define(ftp_open(Host, Flags), - do_ftp_open(Host, [trace, {timeout, timer:seconds(15)}] ++ Flags)). + do_ftp_open(Host, [{debug, trace}, + {timeout, timer:seconds(15)} | Flags])). -else. -define(ftp_open(Host, Flags), - do_ftp_open(Host, [verbose, {timeout, timer:seconds(15)}] ++ Flags)). + do_ftp_open(Host, [{verbose, true}, + {timeout, timer:seconds(15)} | Flags])). -endif. -endif. @@ -113,9 +116,7 @@ get_ftpd_host([Host|Hosts]) -> p("get_ftpd_host -> entry with" "~n Host: ~p" "~n", [Host]), - case (catch ftp:open({option_list, - [{host, Host}, {port, ?FTP_PORT}, - {timeout, 20000}]})) of + case (catch ftp:open(Host, [{port, ?FTP_PORT}, {timeout, 20000}])) of {ok, Pid} -> (catch ftp:close(Pid)), {ok, Host}; @@ -212,7 +213,7 @@ do_init_per_testcase(Case, Config) inets:start(), NewConfig = close_connection(watch_dog(Config)), Host = ftp_host(Config), - case (catch ?ftp_open(Host, [])) of + case (catch ?ftp_open(Host, [{mode, passive}])) of {ok, Pid} -> [{ftp, Pid} | data_dir(NewConfig)]; {skip, _} = SKIP -> @@ -225,9 +226,8 @@ do_init_per_testcase(Case, Config) inets:start(), NewConfig = close_connection(watch_dog(Config)), Host = ftp_host(Config), - case (catch ?ftp_open(Host, [])) of + case (catch ?ftp_open(Host, [{mode, active}])) of {ok, Pid} -> - ok = ftp:force_active(Pid), [{ftp, Pid} | data_dir(NewConfig)]; {skip, _} = SKIP -> SKIP @@ -240,11 +240,10 @@ do_init_per_testcase(Case, Config) io:format(user, "~n~n*** INIT ~w:~w ***~n~n", [?MODULE, Case]), NewConfig = close_connection(watch_dog(Config)), Host = ftp_host(Config), - Opts = [{host, Host}, - {port, ?FTP_PORT}, - {flags, [verbose]}, + Opts = [{port, ?FTP_PORT}, + {verbose, true}, {progress, {?MODULE, progress, #progress{}}}], - case ftp:open({option_list, Opts}) of + case ftp:open(Host, Opts) of {ok, Pid} -> ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS), [{ftp, Pid} | data_dir(NewConfig)]; @@ -257,22 +256,23 @@ do_init_per_testcase(Case, Config) -> inets:start(), NewConfig = close_connection(watch_dog(Config)), Host = ftp_host(Config), - Flags = + Opts1 = if ((Case =:= passive_ip_v6_disabled) orelse (Case =:= active_ip_v6_disabled)) -> - [ip_v6_disabled]; + [{ipfamily, inet}]; true -> [] end, - case (catch ?ftp_open(Host, Flags)) of + Opts2 = + case string:tokens(atom_to_list(Case), [$_]) of + [_, "active" | _] -> + [{mode, active} | Opts1]; + _ -> + [{mode, passive} | Opts1] + end, + case (catch ?ftp_open(Host, Opts2)) of {ok, Pid} -> - case string:tokens(atom_to_list(Case), [$_]) of - [_, "active"|_] -> - ok = ftp:force_active(Pid); - _ -> - ok - end, ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS), [{ftp, Pid} | data_dir(NewConfig)]; {skip, _} = SKIP -> @@ -365,6 +365,7 @@ open(Config) when is_list(Config) -> Host = ftp_host(Config), (catch tc_open(Host)). + tc_open(Host) -> {ok, Pid} = ?ftp_open(Host, []), ok = ftp:close(Pid), @@ -374,8 +375,9 @@ tc_open(Host) -> {flags, [verbose]}, {timeout, 30000}]}), ok = ftp:close(Pid1), - {error, ehost} = ftp:open({option_list, [{port, ?FTP_PORT}, - {flags, [verbose]}]}), + + {error, ehost} = + ftp:open({option_list, [{port, ?FTP_PORT}, {flags, [verbose]}]}), {ok, Pid2} = ftp:open(Host), ok = ftp:close(Pid2), @@ -408,6 +410,15 @@ tc_open(Host) -> {mode, cool}]}), test_server:sleep(100), ok = ftp:close(Pid6), + + {ok, Pid7} = + ftp:open(Host, [{port, ?FTP_PORT}, {verbose, true}, {timeout, 30000}]), + ok = ftp:close(Pid7), + + {ok, Pid8} = + ftp:open(Host, ?FTP_PORT), + ok = ftp:close(Pid8), + ok. @@ -420,7 +431,7 @@ open_port(suite) -> []; open_port(Config) when is_list(Config) -> Host = ftp_host(Config), - {ok, Pid} = ftp:open(Host, ?FTP_PORT), + {ok, Pid} = ftp:open(Host, [{port, ?FTP_PORT}]), ok = ftp:close(Pid), {error, ehost} = ftp:open(?BAD_HOST, []), ok. @@ -954,26 +965,39 @@ api_missuse(doc)-> ["Test that behaviour of the ftp process if the api is abused"]; api_missuse(suite) -> []; api_missuse(Config) when is_list(Config) -> + io:format("api_missuse -> entry~n", []), + Flag = process_flag(trap_exit, true), Pid = ?config(ftp, Config), Host = ftp_host(Config), - + %% Serious programming fault, connetion will be shut down - {error, {connection_terminated, 'API_violation'}} = - gen_server:call(Pid, {self(), foobar, 10}, infinity), + io:format("api_missuse -> verify bad call termination (~p)~n", [Pid]), + case (catch gen_server:call(Pid, {self(), foobar, 10}, infinity)) of + {error, {connection_terminated, 'API_violation'}} -> + ok; + Unexpected1 -> + exit({unexpected_result, Unexpected1}) + end, test_server:sleep(500), undefined = process_info(Pid, status), + io:format("api_missuse -> start new client~n", []), {ok, Pid2} = ?ftp_open(Host, []), %% Serious programming fault, connetion will be shut down + io:format("api_missuse -> verify bad cast termination~n", []), gen_server:cast(Pid2, {self(), foobar, 10}), test_server:sleep(500), undefined = process_info(Pid2, status), + io:format("api_missuse -> start new client~n", []), {ok, Pid3} = ?ftp_open(Host, []), %% Could be an innocent misstake the connection lives. + io:format("api_missuse -> verify bad bang~n", []), Pid3 ! foobar, test_server:sleep(500), {status, _} = process_info(Pid3, status), + process_flag(trap_exit, Flag), + io:format("api_missuse -> done~n", []), ok. @@ -1525,11 +1549,11 @@ split([C| Cs], I, Is) -> split([], I, Is) -> lists:reverse([lists:reverse(I)| Is]). -do_ftp_open(Host, Flags) -> +do_ftp_open(Host, Opts) -> io:format("do_ftp_open -> entry with" - "~n Host: ~p" - "~n Flags: ~p", [Host, Flags]), - case ftp:open(Host, Flags) of + "~n Host: ~p" + "~n Opts: ~p", [Host, Opts]), + case ftp:open(Host, Opts) of {ok, _} = OK -> OK; {error, Reason} -> diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index aa65fb1197..b5fd896001 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -87,8 +87,14 @@ all(suite) -> http_headers_dummy, http_bad_response, ssl_head, + ossl_head, + essl_head, ssl_get, + ossl_get, + essl_get, ssl_trace, + ossl_trace, + essl_trace, http_redirect, http_redirect_loop, http_internal_server_error, @@ -179,49 +185,66 @@ init_per_testcase(otp_8154_1 = Case, Config) -> init_per_testcase(Case, Config) -> init_per_testcase(Case, 2, Config). +init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> + tsp("init_per_testcase_ssl -> stop ssl"), + application:stop(ssl), + Config2 = lists:keydelete(local_ssl_server, 1, Config), + %% Will start inets + tsp("init_per_testcase_ssl -> try start http server (including inets)"), + Server = inets_test_lib:start_http_server( + filename:join(PrivDir, SslConfFile), Tag), + tsp("init_per_testcase -> Server: ~p", [Server]), + [{local_ssl_server, Server} | Config2]. + init_per_testcase(Case, Timeout, Config) -> - io:format(user, "~n~n*** INIT ~w:~w[~w] ***~n~n", + io:format(user, "~n~n*** INIT ~w:[~w][~w] ***~n~n", [?MODULE, Timeout, Case]), - PrivDir = ?config(priv_dir, Config), + PrivDir = ?config(priv_dir, Config), + tsp("init_per_testcase -> stop inets"), application:stop(inets), - Dog = test_server:timetrap(inets_test_lib:minutes(Timeout)), - TmpConfig = lists:keydelete(watchdog, 1, Config), - IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", + Dog = test_server:timetrap(inets_test_lib:minutes(Timeout)), + TmpConfig = lists:keydelete(watchdog, 1, Config), + IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", + %% inets:enable_trace(max, io, httpd), + %% inets:enable_trace(max, io, httpc), + inets:enable_trace(max, io, all), + NewConfig = case atom_to_list(Case) of - "ssl" ++ _ -> - application:stop(ssl), - TmpConfig2 = - lists:keydelete(local_ssl_server, 1, TmpConfig), - %% Will start inets - Server = - inets_test_lib:start_http_server( - filename:join(PrivDir, SslConfFile)), - [{watchdog, Dog}, {local_ssl_server, Server} | TmpConfig2]; + [$s, $s, $l | _] -> + init_per_testcase_ssl(ssl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); + + [$o, $s, $s, $l | _] -> + init_per_testcase_ssl(ossl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); + + [$e, $s, $s, $l | _] -> + init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); + "proxy" ++ Rest -> - case Rest of - "_https_not_supported" -> - inets:start(), - case (catch application:start(ssl)) of - ok -> - [{watchdog, Dog} | TmpConfig]; - _ -> - [{skip, - "SSL does not seem to be supported"} - | TmpConfig] - end; - _ -> - case is_proxy_available(?PROXY, ?PROXY_PORT) of - true -> - inets:start(), - [{watchdog, Dog} | TmpConfig]; - false -> - [{skip, "Failed to contact proxy"} | - TmpConfig] - end - end; + case Rest of + "_https_not_supported" -> + tsp("init_per_testcase -> [proxy case] start inets"), + inets:start(), + tsp("init_per_testcase -> [proxy case] start ssl"), + case (catch application:start(ssl)) of + ok -> + [{watchdog, Dog} | TmpConfig]; + _ -> + [{skip, "SSL does not seem to be supported"} + | TmpConfig] + end; + _ -> + case is_proxy_available(?PROXY, ?PROXY_PORT) of + true -> + inets:start(), + [{watchdog, Dog} | TmpConfig]; + false -> + [{skip, "Failed to contact proxy"} | + TmpConfig] + end + end; _ -> TmpConfig2 = lists:keydelete(local_server, 1, TmpConfig), Server = @@ -231,13 +254,12 @@ init_per_testcase(Case, Timeout, Config) -> [{watchdog, Dog}, {local_server, Server} | TmpConfig2] end, - http:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, - ["localhost", ?IPV6_LOCAL_HOST]}}]), - inets:enable_trace(max, io, httpc), - %% inets:enable_trace(max, io, all), + httpc:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, + ["localhost", ?IPV6_LOCAL_HOST]}}]), %% snmp:set_trace([gen_tcp, inet_tcp, prim_inet]), NewConfig. + %%-------------------------------------------------------------------- %% Function: end_per_testcase(Case, Config) -> _ %% Case - atom() @@ -306,7 +328,7 @@ http_head(Config) when is_list(Config) -> ok -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - case http:request(head, {URL, []}, [], []) of + case httpc:request(head, {URL, []}, [], []) of {ok, {{_,200,_}, [_ | _], []}} -> ok; {ok, WrongReply} -> @@ -337,7 +359,7 @@ http_get(Config) when is_list(Config) -> HttpOptions1 = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], Options1 = [], Body = - case http:request(Method, Request, HttpOptions1, Options1) of + case httpc:request(Method, Request, HttpOptions1, Options1) of {ok, {{_,200,_}, [_ | _], ReplyBody = [_ | _]}} -> ReplyBody; {ok, UnexpectedReply1} -> @@ -346,12 +368,12 @@ http_get(Config) when is_list(Config) -> tsf({bad_reply, Error1}) end, - %% eqvivivalent to http:request(get, {URL, []}, [], []), + %% eqvivivalent to httpc:request(get, {URL, []}, [], []), inets_test_lib:check_body(Body), HttpOptions2 = [], Options2 = [{body_format, binary}], - case http:request(Method, Request, HttpOptions2, Options2) of + case httpc:request(Method, Request, HttpOptions2, Options2) of {ok, {{_,200,_}, [_ | _], Bin}} when is_binary(Bin) -> ok; {ok, {{_,200,_}, [_ | _], BadBin}} -> @@ -390,11 +412,11 @@ http_post(Config) when is_list(Config) -> Body = lists:duplicate(100, "1"), {ok, {{_,200,_}, [_ | _], [_ | _]}} = - http:request(post, {URL, [{"expect","100-continue"}], + httpc:request(post, {URL, [{"expect","100-continue"}], "text/plain", Body}, [], []), {ok, {{_,504,_}, [_ | _], []}} = - http:request(post, {URL, [{"expect","100-continue"}], + httpc:request(post, {URL, [{"expect","100-continue"}], "text/plain", "foobar"}, [], []); _ -> {skip, "Failed to start local http-server"} @@ -411,13 +433,13 @@ http_emulate_lower_versions(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", {ok, Body0} = - http:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), + httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), inets_test_lib:check_body(Body0), {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = - http:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), + httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), inets_test_lib:check_body(Body1), {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = - http:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), + httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), inets_test_lib:check_body(Body2); _-> {skip, "Failed to start local http-server"} @@ -431,24 +453,24 @@ http_relaxed(doc) -> http_relaxed(suite) -> []; http_relaxed(Config) when is_list(Config) -> - ok = http:set_options([{ipv6, disabled}]), % also test the old option - %% ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipv6, disabled}]), % also test the old option + %% ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_reason_phrase.html", {error, Reason} = - http:request(get, {URL, []}, [{relaxed, false}], []), + httpc:request(get, {URL, []}, [{relaxed, false}], []), test_server:format("Not relaxed: ~p~n", [Reason]), {ok, {{_, 200, _}, [_ | _], [_ | _]}} = - http:request(get, {URL, []}, [{relaxed, true}], []), + httpc:request(get, {URL, []}, [{relaxed, true}], []), DummyServerPid ! stop, - ok = http:set_options([{ipv6, enabled}]), - %% ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipv6, enabled}]), + %% ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -458,7 +480,7 @@ http_dummy_pipe(doc) -> http_dummy_pipe(suite) -> []; http_dummy_pipe(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/foobar.html", @@ -466,7 +488,7 @@ http_dummy_pipe(Config) when is_list(Config) -> test_pipeline(URL), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. http_inets_pipe(doc) -> @@ -488,11 +510,11 @@ test_pipeline(URL) -> p("test_pipeline -> entry with" "~n URL: ~p", [URL]), - http:set_options([{pipeline_timeout, 50000}]), + httpc:set_options([{pipeline_timeout, 50000}]), p("test_pipeline -> issue (async) request 1"), {ok, RequestId1} = - http:request(get, {URL, []}, [], [{sync, false}]), + httpc:request(get, {URL, []}, [], [{sync, false}]), test_server:format("RequestId1: ~p~n", [RequestId1]), p("test_pipeline -> RequestId1: ~p", [RequestId1]), @@ -502,13 +524,13 @@ test_pipeline(URL) -> p("test_pipeline -> issue (async) request 2"), {ok, RequestId2} = - http:request(get, {URL, []}, [], [{sync, false}]), + httpc:request(get, {URL, []}, [], [{sync, false}]), tsp("RequestId2: ~p", [RequestId2]), p("test_pipeline -> RequestId2: ~p", [RequestId2]), p("test_pipeline -> issue (sync) request 3"), {ok, {{_,200,_}, [_ | _], [_ | _]}} = - http:request(get, {URL, []}, [], []), + httpc:request(get, {URL, []}, [], []), p("test_pipeline -> expect reply for (async) request 1 or 2"), receive @@ -544,18 +566,18 @@ test_pipeline(URL) -> p("test_pipeline -> issue (async) request 4"), {ok, RequestId3} = - http:request(get, {URL, []}, [], [{sync, false}]), + httpc:request(get, {URL, []}, [], [{sync, false}]), tsp("RequestId3: ~p", [RequestId3]), p("test_pipeline -> RequestId3: ~p", [RequestId3]), p("test_pipeline -> issue (async) request 5"), {ok, RequestId4} = - http:request(get, {URL, []}, [], [{sync, false}]), + httpc:request(get, {URL, []}, [], [{sync, false}]), tsp("RequestId4: ~p~n", [RequestId4]), p("test_pipeline -> RequestId4: ~p", [RequestId4]), p("test_pipeline -> cancel (async) request 4"), - ok = http:cancel_request(RequestId3), + ok = httpc:cancel_request(RequestId3), p("test_pipeline -> expect *no* reply for cancelled (async) request 4 (for 3 secs)"), receive @@ -607,7 +629,7 @@ http_trace(Config) when is_list(Config) -> ok -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - case http:request(trace, {URL, []}, [], []) of + case httpc:request(trace, {URL, []}, [], []) of {ok, {{_,200,_}, [_ | _], "TRACE /dummy.html" ++ _}} -> ok; {ok, {{_,200,_}, [_ | _], WrongBody}} -> @@ -631,7 +653,7 @@ http_async(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", {ok, RequestId} = - http:request(get, {URL, []}, [], [{sync, false}]), + httpc:request(get, {URL, []}, [], [{sync, false}]), Body = receive @@ -644,8 +666,8 @@ http_async(Config) when is_list(Config) -> inets_test_lib:check_body(binary_to_list(Body)), {ok, NewRequestId} = - http:request(get, {URL, []}, [], [{sync, false}]), - ok = http:cancel_request(NewRequestId), + httpc:request(get, {URL, []}, [], [{sync, false}]), + ok = httpc:cancel_request(NewRequestId), receive {http, {NewRequestId, _NewResult}} -> test_server:fail(http_cancel_request_failed) @@ -669,9 +691,9 @@ http_save_to_file(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", {ok, saved_to_file} - = http:request(get, {URL, []}, [], [{stream, FilePath}]), + = httpc:request(get, {URL, []}, [], [{stream, FilePath}]), {ok, Bin} = file:read_file(FilePath), - {ok, {{_,200,_}, [_ | _], Body}} = http:request(URL), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), Bin == Body; _ -> {skip, "Failed to start local http-server"} @@ -690,7 +712,7 @@ http_save_to_file_async(Config) when is_list(Config) -> FilePath = filename:join(PrivDir, "dummy.html"), Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, RequestId} = http:request(get, {URL, []}, [], + {ok, RequestId} = httpc:request(get, {URL, []}, [], [{stream, FilePath}, {sync, false}]), receive @@ -701,7 +723,7 @@ http_save_to_file_async(Config) when is_list(Config) -> end, {ok, Bin} = file:read_file(FilePath), - {ok, {{_,200,_}, [_ | _], Body}} = http:request(URL), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), Bin == Body; _ -> {skip, "Failed to start local http-server"} @@ -731,7 +753,7 @@ http_headers(Config) when is_list(Config) -> Date = httpd_util:rfc1123_date({date(), time()}), {ok, {{_,200,_}, [_ | _], [_ | _]}} = - http:request(get, {URL, [{"If-Modified-Since", + httpc:request(get, {URL, [{"If-Modified-Since", Mod}, {"From","[email protected]"}, {"Date", Date} @@ -742,7 +764,7 @@ http_headers(Config) when is_list(Config) -> CreatedSec+1)), {ok, {{_,200,_}, [_ | _], [_ | _]}} = - http:request(get, {URL, [{"If-UnModified-Since", + httpc:request(get, {URL, [{"If-UnModified-Since", Mod1} ]}, [], []), @@ -750,12 +772,12 @@ http_headers(Config) when is_list(Config) -> {ok, {{_,200,_}, [_ | _], [_ | _]}} = - http:request(get, {URL, [{"If-Match", + httpc:request(get, {URL, [{"If-Match", Tag} ]}, [], []), {ok, {{_,200,_}, [_ | _], _}} = - http:request(get, {URL, [{"If-None-Match", + httpc:request(get, {URL, [{"If-None-Match", "NotEtag,NeihterEtag"}, {"Connection", "Close"} ]}, [], []), @@ -773,7 +795,7 @@ http_headers_dummy(doc) -> http_headers_dummy(suite) -> []; http_headers_dummy(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy_headers.html", @@ -789,7 +811,7 @@ http_headers_dummy(Config) when is_list(Config) -> %% that the client header-handling code. This would not %% be a vaild http-request! {ok, {{_,200,_}, [_ | _], [_|_]}} = - http:request(post, + httpc:request(post, {URL, [{"Via", "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, @@ -828,7 +850,7 @@ http_headers_dummy(Config) when is_list(Config) -> ], "text/plain", FooBar}, [], []), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -838,21 +860,21 @@ http_bad_response(doc) -> http_bad_response(suite) -> []; http_bad_response(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_crlf.html", URL1 = ?URL_START ++ integer_to_list(Port) ++ "/wrong_statusline.html", - {error, timeout} = http:request(get, {URL, []}, [{timeout, 400}], []), + {error, timeout} = httpc:request(get, {URL, []}, [{timeout, 400}], []), - {error, Reason} = http:request(URL1), + {error, Reason} = httpc:request(URL1), test_server:format("Wrong Statusline: ~p~n", [Reason]), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -862,69 +884,168 @@ ssl_head(doc) -> ssl_head(suite) -> []; ssl_head(Config) when is_list(Config) -> + ssl_head(ssl, Config). + +ossl_head(doc) -> + ["Same as http_head/1 but over ssl sockets."]; +ossl_head(suite) -> + []; +ossl_head(Config) when is_list(Config) -> + ssl_head(ossl, Config). + +essl_head(doc) -> + ["Same as http_head/1 but over ssl sockets."]; +essl_head(suite) -> + []; +essl_head(Config) when is_list(Config) -> + ssl_head(essl, Config). + +ssl_head(SslTag, Config) -> + tsp("ssl_head -> entry with" + "~n SslTag: ~p" + "~n Config: ~p", [SslTag, Config]), case ?config(local_ssl_server, Config) of ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + ossl -> + {ossl, SSLOptions}; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_head -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), {ok, {{_,200, _}, [_ | _], []}} = - http:request(head, {URL, []}, [{ssl, SSLOptions}], []); + httpc:request(head, {URL, []}, [{ssl, SSLConfig}], []); {ok, _} -> - {skip, "Failed to start local http-server"}; + {skip, "local http-server not started"}; _ -> - {skip, "Failed to start SSL"} + {skip, "SSL not started"} end. + + %%------------------------------------------------------------------------- ssl_get(doc) -> ["Same as http_get/1 but over ssl sockets."]; ssl_get(suite) -> []; ssl_get(Config) when is_list(Config) -> + ssl_get(ssl, Config). + +ossl_get(doc) -> + ["Same as http_get/1 but over ssl sockets."]; +ossl_get(suite) -> + []; +ossl_get(Config) when is_list(Config) -> + ssl_get(ossl, Config). + +essl_get(doc) -> + ["Same as http_get/1 but over ssl sockets."]; +essl_get(suite) -> + []; +essl_get(Config) when is_list(Config) -> + ssl_get(essl, Config). + +ssl_get(SslTag, Config) when is_list(Config) -> case ?config(local_ssl_server, Config) of ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - {ok, {{_,200, _}, [_ | _], Body = [_ | _]}} = - http:request(get, {URL, []}, [{ssl, SSLOptions}], []), - inets_test_lib:check_body(Body); + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + ossl -> + {ossl, SSLOptions}; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_get -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + {ok, {{_,200, _}, [_ | _], Body = [_ | _]}} = + httpc:request(get, {URL, []}, [{ssl, SSLConfig}], []), + inets_test_lib:check_body(Body); {ok, _} -> {skip, "Failed to start local http-server"}; _ -> {skip, "Failed to start SSL"} end. + + %%------------------------------------------------------------------------- ssl_trace(doc) -> ["Same as http_trace/1 but over ssl sockets."]; ssl_trace(suite) -> []; ssl_trace(Config) when is_list(Config) -> + ssl_trace(ssl, Config). + +ossl_trace(doc) -> + ["Same as http_trace/1 but over ssl sockets."]; +ossl_trace(suite) -> + []; +ossl_trace(Config) when is_list(Config) -> + ssl_trace(ossl, Config). + +essl_trace(doc) -> + ["Same as http_trace/1 but over ssl sockets."]; +essl_trace(suite) -> + []; +essl_trace(Config) when is_list(Config) -> + ssl_trace(essl, Config). + +ssl_trace(SslTag, Config) when is_list(Config) -> case ?config(local_ssl_server, Config) of ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - case http:request(trace, {URL, []}, [{ssl, SSLOptions}], []) of + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + ossl -> + {ossl, SSLOptions}; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_trace -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + case httpc:request(trace, {URL, []}, [{ssl, SSLConfig}], []) of {ok, {{_,200, _}, [_ | _], "TRACE /dummy.html" ++ _}} -> ok; {ok, {{_,200,_}, [_ | _], WrongBody}} -> - test_server:fail({wrong_body, WrongBody}); + tsf({wrong_body, WrongBody}); {ok, WrongReply} -> - test_server:fail({wrong_reply, WrongReply}); + tsf({wrong_reply, WrongReply}); Error -> - test_server:fail({failed, Error}) + tsf({failed, Error}) end; {ok, _} -> {skip, "Failed to start local http-server"}; _ -> {skip, "Failed to start SSL"} end. + + %%------------------------------------------------------------------------- http_redirect(doc) -> ["Test redirect with dummy server as httpd does not implement" @@ -937,7 +1058,7 @@ http_redirect(Config) when is_list(Config) -> case ?config(local_server, Config) of ok -> tsp("http_redirect -> set ipfamily option to inet"), - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), tsp("http_redirect -> start dummy server inet"), {DummyServerPid, Port} = dummy_server(self(), ipv4), @@ -948,29 +1069,29 @@ http_redirect(Config) when is_list(Config) -> tsp("http_redirect -> issue request 1: " "~n ~p", [URL300]), {ok, {{_,200,_}, [_ | _], [_|_]}} - = http:request(get, {URL300, []}, [], []), + = httpc:request(get, {URL300, []}, [], []), tsp("http_redirect -> issue request 2: " "~n ~p", [URL300]), {ok, {{_,300,_}, [_ | _], _}} = - http:request(get, {URL300, []}, [{autoredirect, false}], []), + httpc:request(get, {URL300, []}, [{autoredirect, false}], []), URL301 = ?URL_START ++ integer_to_list(Port) ++ "/301.html", tsp("http_redirect -> issue request 3: " "~n ~p", [URL301]), {ok, {{_,200,_}, [_ | _], [_|_]}} - = http:request(get, {URL301, []}, [], []), + = httpc:request(get, {URL301, []}, [], []), tsp("http_redirect -> issue request 4: " "~n ~p", [URL301]), {ok, {{_,200,_}, [_ | _], []}} - = http:request(head, {URL301, []}, [], []), + = httpc:request(head, {URL301, []}, [], []), tsp("http_redirect -> issue request 5: " "~n ~p", [URL301]), {ok, {{_,301,_}, [_ | _], [_|_]}} - = http:request(post, {URL301, [],"text/plain", "foobar"}, + = httpc:request(post, {URL301, [],"text/plain", "foobar"}, [], []), URL302 = ?URL_START ++ integer_to_list(Port) ++ "/302.html", @@ -978,8 +1099,8 @@ http_redirect(Config) when is_list(Config) -> tsp("http_redirect -> issue request 6: " "~n ~p", [URL302]), {ok, {{_,200,_}, [_ | _], [_|_]}} - = http:request(get, {URL302, []}, [], []), - case http:request(get, {URL302, []}, [], []) of + = httpc:request(get, {URL302, []}, [], []), + case httpc:request(get, {URL302, []}, [], []) of {ok, Reply7} -> case Reply7 of {{_,200,_}, [_ | _], [_|_]} -> @@ -1006,12 +1127,12 @@ http_redirect(Config) when is_list(Config) -> tsp("http_redirect -> issue request 7: " "~n ~p", [URL302]), {ok, {{_,200,_}, [_ | _], []}} - = http:request(head, {URL302, []}, [], []), + = httpc:request(head, {URL302, []}, [], []), tsp("http_redirect -> issue request 8: " "~n ~p", [URL302]), {ok, {{_,302,_}, [_ | _], [_|_]}} - = http:request(post, {URL302, [],"text/plain", "foobar"}, + = httpc:request(post, {URL302, [],"text/plain", "foobar"}, [], []), URL307 = ?URL_START ++ integer_to_list(Port) ++ "/307.html", @@ -1019,23 +1140,23 @@ http_redirect(Config) when is_list(Config) -> tsp("http_redirect -> issue request 9: " "~n ~p", [URL307]), {ok, {{_,200,_}, [_ | _], [_|_]}} - = http:request(get, {URL307, []}, [], []), + = httpc:request(get, {URL307, []}, [], []), tsp("http_redirect -> issue request 10: " "~n ~p", [URL307]), {ok, {{_,200,_}, [_ | _], []}} - = http:request(head, {URL307, []}, [], []), + = httpc:request(head, {URL307, []}, [], []), tsp("http_redirect -> issue request 11: " "~n ~p", [URL307]), {ok, {{_,307,_}, [_ | _], [_|_]}} - = http:request(post, {URL307, [],"text/plain", "foobar"}, + = httpc:request(post, {URL307, [],"text/plain", "foobar"}, [], []), tsp("http_redirect -> stop dummy server"), DummyServerPid ! stop, tsp("http_redirect -> reset ipfamily option (to inet6fb4)"), - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* tsp("http_redirect -> done"), ok; @@ -1051,15 +1172,15 @@ http_redirect_loop(doc) -> http_redirect_loop(suite) -> []; http_redirect_loop(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/redirectloop.html", {ok, {{_,300,_}, [_ | _], _}} - = http:request(get, {URL, []}, [], []), + = httpc:request(get, {URL, []}, [], []), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. %%------------------------------------------------------------------------- @@ -1068,13 +1189,13 @@ http_internal_server_error(doc) -> http_internal_server_error(suite) -> []; http_internal_server_error(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL500 = ?URL_START ++ integer_to_list(Port) ++ "/500.html", {ok, {{_,500,_}, [_ | _], _}} - = http:request(get, {URL500, []}, [], []), + = httpc:request(get, {URL500, []}, [], []), URL503 = ?URL_START ++ integer_to_list(Port) ++ "/503.html", @@ -1084,16 +1205,16 @@ http_internal_server_error(Config) when is_list(Config) -> ets:insert(unavailable, {503, unavailable}), {ok, {{_,200, _}, [_ | _], [_|_]}} = - http:request(get, {URL503, []}, [], []), + httpc:request(get, {URL503, []}, [], []), ets:insert(unavailable, {503, long_unavailable}), {ok, {{_,503, _}, [_ | _], [_|_]}} = - http:request(get, {URL503, []}, [], []), + httpc:request(get, {URL503, []}, [], []), ets:delete(unavailable), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1103,7 +1224,7 @@ http_userinfo(doc) -> http_userinfo(suite) -> []; http_userinfo(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), @@ -1111,16 +1232,16 @@ http_userinfo(Config) when is_list(Config) -> ++ integer_to_list(Port) ++ "/userinfo.html", {ok, {{_,200,_}, [_ | _], _}} - = http:request(get, {URLAuth, []}, [], []), + = httpc:request(get, {URLAuth, []}, [], []), URLUnAuth = "http://alladin:foobar@localhost:" ++ integer_to_list(Port) ++ "/userinfo.html", {ok, {{_,401, _}, [_ | _], _}} = - http:request(get, {URLUnAuth, []}, [], []), + httpc:request(get, {URLUnAuth, []}, [], []), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1130,7 +1251,7 @@ http_cookie(doc) -> http_cookie(suite) -> []; http_cookie(Config) when is_list(Config) -> - ok = http:set_options([{cookies, enabled}, {ipfamily, inet}]), + ok = httpc:set_options([{cookies, enabled}, {ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URLStart = ?URL_START @@ -1139,19 +1260,19 @@ http_cookie(Config) when is_list(Config) -> URLCookie = URLStart ++ "/cookie.html", {ok, {{_,200,_}, [_ | _], [_|_]}} - = http:request(get, {URLCookie, []}, [], []), + = httpc:request(get, {URLCookie, []}, [], []), ets:new(cookie, [named_table, public, set]), ets:insert(cookie, {cookies, true}), {ok, {{_,200,_}, [_ | _], [_|_]}} - = http:request(get, {URLStart ++ "/", []}, [], []), + = httpc:request(get, {URLStart ++ "/", []}, [], []), ets:delete(cookie), - ok = http:set_options([{cookies, disabled}, {ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{cookies, disabled}, {ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6************ + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6************ ok. %%------------------------------------------------------------------------- @@ -1162,7 +1283,7 @@ proxy_options(suite) -> proxy_options(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> - case http:request(options, {?PROXY_URL, []}, [], []) of + case httpc:request(options, {?PROXY_URL, []}, [], []) of {ok, {{_,200,_}, Headers, _}} -> case lists:keysearch("allow", 1, Headers) of {value, {"allow", _}} -> @@ -1186,7 +1307,7 @@ proxy_head(suite) -> proxy_head(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> - case http:request(head, {?PROXY_URL, []}, [], []) of + case httpc:request(head, {?PROXY_URL, []}, [], []) of {ok, {{_,200, _}, [_ | _], []}} -> ok; Unexpected -> @@ -1205,7 +1326,7 @@ proxy_get(suite) -> proxy_get(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> - case http:request(get, {?PROXY_URL, []}, [], []) of + case httpc:request(get, {?PROXY_URL, []}, [], []) of {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} -> inets_test_lib:check_body(Body); Unexpected -> @@ -1257,7 +1378,7 @@ proxy_emulate_lower_versions(Config) when is_list(Config) -> end. pelv_get(Version) -> - http:request(get, {?PROXY_URL, []}, [{version, Version}], []). + httpc:request(get, {?PROXY_URL, []}, [{version, Version}], []). %%------------------------------------------------------------------------- proxy_trace(doc) -> @@ -1266,7 +1387,7 @@ proxy_trace(suite) -> []; proxy_trace(Config) when is_list(Config) -> %%{ok, {{_,200,_}, [_ | _], "TRACE " ++ _}} = - %% http:request(trace, {?PROXY_URL, []}, [], []), + %% httpc:request(trace, {?PROXY_URL, []}, [], []), {skip, "HTTP TRACE is no longer allowed on the ?PROXY_URL server due " "to security reasons"}. @@ -1281,7 +1402,7 @@ proxy_post(suite) -> proxy_post(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> - case http:request(post, {?PROXY_URL, [], + case httpc:request(post, {?PROXY_URL, [], "text/plain", "foobar"}, [],[]) of {ok, {{_,405,_}, [_ | _], [_ | _]}} -> ok; @@ -1303,7 +1424,7 @@ proxy_put(suite) -> proxy_put(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> - case http:request(put, {"http://www.erlang.org/foobar.html", [], + case httpc:request(put, {"http://www.erlang.org/foobar.html", [], "html", "<html> <body><h1> foo </h1>" "<p>bar</p> </body></html>"}, [], []) of {ok, {{_,405,_}, [_ | _], [_ | _]}} -> @@ -1328,7 +1449,7 @@ proxy_delete(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> URL = ?PROXY_URL ++ "/foobar.html", - case http:request(delete, {URL, []}, [], []) of + case httpc:request(delete, {URL, []}, [], []) of {ok, {{_,404,_}, [_ | _], [_ | _]}} -> ok; Unexpected -> @@ -1348,7 +1469,7 @@ proxy_headers(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> {ok, {{_,200,_}, [_ | _], [_ | _]}} - = http:request(get, {?PROXY_URL, + = httpc:request(get, {?PROXY_URL, [ {"Accept", "text/*, text/html," @@ -1383,7 +1504,7 @@ proxy_auth(Config) when is_list(Config) -> %% atleast the code for sending the header does not crash! case ?config(skip, Config) of undefined -> - case http:request(get, {?PROXY_URL, []}, + case httpc:request(get, {?PROXY_URL, []}, [{proxy_auth, {"foo", "bar"}}], []) of {ok, {{_,200, _}, [_ | _], [_|_]}} -> ok; @@ -1403,7 +1524,7 @@ http_server_does_not_exist(suite) -> []; http_server_does_not_exist(Config) when is_list(Config) -> {error, _} = - http:request(get, {"http://localhost:" ++ + httpc:request(get, {"http://localhost:" ++ integer_to_list(?NOT_IN_USE_PORT) ++ "/", []},[], []), ok. @@ -1418,7 +1539,7 @@ page_does_not_exist(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/doesnotexist.html", {ok, {{_,404,_}, [_ | _], [_ | _]}} - = http:request(get, {URL, []}, [], []), + = httpc:request(get, {URL, []}, [], []), ok. @@ -1432,7 +1553,7 @@ proxy_page_does_not_exist(Config) when is_list(Config) -> undefined -> URL = ?PROXY_URL ++ "/doesnotexist.html", {ok, {{_,404,_}, [_ | _], [_ | _]}} = - http:request(get, {URL, []}, [], []), + httpc:request(get, {URL, []}, [], []), ok; Reason -> {skip, Reason} @@ -1446,7 +1567,7 @@ proxy_https_not_supported(doc) -> proxy_https_not_supported(suite) -> []; proxy_https_not_supported(Config) when is_list(Config) -> - Result = http:request(get, {"https://login.yahoo.com", []}, [], []), + Result = httpc:request(get, {"https://login.yahoo.com", []}, [], []), case Result of {error, Reason} -> %% ok so far @@ -1478,10 +1599,10 @@ http_stream(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", {ok, {{_,200,_}, [_ | _], Body}} = - http:request(get, {URL, []}, [], []), + httpc:request(get, {URL, []}, [], []), {ok, RequestId} = - http:request(get, {URL, []}, [], [{sync, false}, + httpc:request(get, {URL, []}, [], [{sync, false}, {stream, self}]), receive @@ -1506,7 +1627,7 @@ http_stream_once(Config) when is_list(Config) -> "~n Config: ~p", [Config]), p("http_stream_once -> set ipfamily to inet", []), - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), p("http_stream_once -> start dummy server", []), {DummyServerPid, Port} = dummy_server(self(), ipv4), @@ -1521,18 +1642,18 @@ http_stream_once(Config) when is_list(Config) -> p("http_stream_once -> stop dummy server", []), DummyServerPid ! stop, p("http_stream_once -> set ipfamily to inet6fb4", []), - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* p("http_stream_once -> done", []), ok. once(URL) -> p("once -> issue sync request for ~p", [URL]), {ok, {{_,200,_}, [_ | _], Body}} = - http:request(get, {URL, []}, [], []), + httpc:request(get, {URL, []}, [], []), p("once -> issue async (self stream) request for ~p", [URL]), {ok, RequestId} = - http:request(get, {URL, []}, [], [{sync, false}, + httpc:request(get, {URL, []}, [], [{sync, false}, {stream, {self, once}}]), p("once -> await stream_start reply for (async) request ~p", [RequestId]), @@ -1576,10 +1697,10 @@ proxy_stream(Config) when is_list(Config) -> case ?config(skip, Config) of undefined -> {ok, {{_,200,_}, [_ | _], Body}} = - http:request(get, {?PROXY_URL, []}, [], []), + httpc:request(get, {?PROXY_URL, []}, [], []), {ok, RequestId} = - http:request(get, {?PROXY_URL, []}, [], + httpc:request(get, {?PROXY_URL, []}, [], [{sync, false}, {stream, self}]), receive @@ -1659,7 +1780,7 @@ ipv6(Config) when is_list(Config) -> URL = "http://[" ++ ?IPV6_LOCAL_HOST ++ "]:" ++ integer_to_list(Port) ++ "/foobar.html", {ok, {{_,200,_}, [_ | _], [_|_]}} = - http:request(get, {URL, []}, [], []), + httpc:request(get, {URL, []}, [], []), DummyServerPid ! stop, ok; @@ -1677,11 +1798,11 @@ headers_as_is(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", {ok, {{_,200,_}, [_|_], [_|_]}} = - http:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, + httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, [], [{headers_as_is, true}]), {ok, {{_,400,_}, [_|_], [_|_]}} = - http:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]), + httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]), ok. @@ -1696,13 +1817,13 @@ options(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", {ok, {{_,200,_}, [_ | _], Bin}} - = http:request(get, {URL, []}, [{foo, bar}], + = httpc:request(get, {URL, []}, [{foo, bar}], %% Ignore unknown options [{body_format, binary}, {foo, bar}]), true = is_binary(Bin), {ok, {200, [_|_]}} - = http:request(get, {URL, []}, [{timeout, infinity}], + = httpc:request(get, {URL, []}, [{timeout, infinity}], [{full_result, false}]); _ -> {skip, "Failed to start local http-server"} @@ -1715,17 +1836,17 @@ http_invalid_http(doc) -> http_invalid_http(suite) -> []; http_invalid_http(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/invalid_http.html", {error, {could_not_parse_as_http, _} = Reason} = - http:request(get, {URL, []}, [], []), + httpc:request(get, {URL, []}, [], []), test_server:format("Parse error: ~p ~n", [Reason]), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1762,7 +1883,7 @@ empty_body_otp_6243(Config) when is_list(Config) -> Port = ?config(local_port, Config), URL = ?URL_START ++ integer_to_list(Port) ++ "/empty.html", {ok, {{_,200,_}, [_ | _], []}} = - http:request(get, {URL, []}, [{timeout, 500}], []). + httpc:request(get, {URL, []}, [{timeout, 500}], []). %%------------------------------------------------------------------------- @@ -1772,14 +1893,14 @@ transfer_encoding_otp_6807(doc) -> transfer_encoding_otp_6807(suite) -> []; transfer_encoding_otp_6807(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/capital_transfer_encoding.html", - {ok, {{_,200,_}, [_|_], [_ | _]}} = http:request(URL), + {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1805,13 +1926,13 @@ empty_response_header_otp_6830(doc) -> empty_response_header_otp_6830(suite) -> []; empty_response_header_otp_6830(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/no_headers.html", - {ok, {{_,200,_}, [], [_ | _]}} = http:request(URL), + {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1822,13 +1943,13 @@ no_content_204_otp_6982(doc) -> no_content_204_otp_6982(suite) -> []; no_content_204_otp_6982(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/no_content.html", - {ok, {{_,204,_}, [], []}} = http:request(URL), + {ok, {{_,204,_}, [], []}} = httpc:request(URL), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1840,13 +1961,13 @@ missing_CR_otp_7304(doc) -> missing_CR_otp_7304(suite) -> []; missing_CR_otp_7304(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_CR.html", - {ok, {{_,200,_}, _, [_ | _]}} = http:request(URL), + {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1860,15 +1981,15 @@ otp_7883_1(doc) -> otp_7883_1(suite) -> []; otp_7883_1(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", - {error, socket_closed_remotely} = http:request(URL), + {error, socket_closed_remotely} = httpc:request(URL), DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. otp_7883_2(doc) -> @@ -1876,7 +1997,7 @@ otp_7883_2(doc) -> otp_7883_2(suite) -> []; otp_7883_2(Config) when is_list(Config) -> - ok = http:set_options([{ipfamily, inet}]), + ok = httpc:set_options([{ipfamily, inet}]), {DummyServerPid, Port} = dummy_server(self(), ipv4), @@ -1885,9 +2006,9 @@ otp_7883_2(Config) when is_list(Config) -> Request = {URL, []}, HttpOptions = [], Options = [{sync, false}], - Profile = http:default_profile(), + Profile = httpc:default_profile(), {ok, RequestId} = - http:request(Method, Request, HttpOptions, Options, Profile), + httpc:request(Method, Request, HttpOptions, Options, Profile), ok = receive {http, {RequestId, {error, socket_closed_remotely}}} -> @@ -1895,7 +2016,7 @@ otp_7883_2(Config) when is_list(Config) -> end, DummyServerPid ! stop, - ok = http:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* + ok = httpc:set_options([{ipfamily, inet6fb4}]), % ********** ipfamily = inet6 ************* ok. @@ -1966,7 +2087,7 @@ run_clients(NumClients, ServerPort, SeqNumServer) -> fun() -> io:format("[~w] client started - " "issue request~n", [Id]), - case http:request(Url) of + case httpc:request(Url) of {ok, {{_,200,_}, _, Resp}} -> io:format("[~w] 200 response: " "~p~n", [Id, Resp]), @@ -2354,7 +2475,7 @@ otp_8352(Config) when is_list(Config) -> ConnOptions = [{max_sessions, MaxSessions}, {max_keep_alive_length, MaxKeepAlive}, {keep_alive_timeout, KeepAliveTimeout}], - http:set_options(ConnOptions), + httpc:set_options(ConnOptions), Method = get, Port = ?config(local_port, Config), @@ -2366,9 +2487,9 @@ otp_8352(Config) when is_list(Config) -> Options1 = [{socket_opts, [{tos, 87}, {recbuf, 16#FFFF}, {sndbuf, 16#FFFF}]}], - case http:request(Method, Request, HttpOptions1, Options1) of + case httpc:request(Method, Request, HttpOptions1, Options1) of {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} -> - %% equivaliant to http:request(get, {URL, []}, [], []), + %% equivaliant to httpc:request(get, {URL, []}, [], []), inets_test_lib:check_body(ReplyBody1); {ok, UnexpectedReply1} -> tsf({unexpected_reply, UnexpectedReply1}); @@ -2382,9 +2503,9 @@ otp_8352(Config) when is_list(Config) -> Options2 = [{socket_opts, [{tos, 84}, {recbuf, 32#1FFFF}, {sndbuf, 32#1FFFF}]}], - case http:request(Method, Request, HttpOptions2, Options2) of + case httpc:request(Method, Request, HttpOptions2, Options2) of {ok, {{_,200,_}, [_ | _], ReplyBody2 = [_ | _]}} -> - %% equivaliant to http:request(get, {URL, []}, [], []), + %% equivaliant to httpc:request(get, {URL, []}, [], []), inets_test_lib:check_body(ReplyBody2); {ok, UnexpectedReply2} -> tsf({unexpected_reply, UnexpectedReply2}); @@ -2406,13 +2527,13 @@ otp_8371(doc) -> otp_8371(suite) -> []; otp_8371(Config) when is_list(Config) -> - ok = http:set_options([{ipv6, disabled}]), % also test the old option + ok = httpc:set_options([{ipv6, disabled}]), % also test the old option {DummyServerPid, Port} = dummy_server(self(), ipv4), URL = ?URL_START ++ integer_to_list(Port) ++ "/ensure_host_header_with_port.html", - case http:request(get, {URL, []}, [], []) of + case httpc:request(get, {URL, []}, [], []) of {ok, Result} -> case Result of {{_, 200, _}, _Headers, Body} -> @@ -2436,7 +2557,7 @@ otp_8371(Config) when is_list(Config) -> end, DummyServerPid ! stop, - ok = http:set_options([{ipv6, enabled}]), + ok = httpc:set_options([{ipv6, enabled}]), ok. @@ -2537,7 +2658,7 @@ receive_streamed_body(RequestId, Body) -> end. receive_streamed_body(RequestId, Body, Pid) -> - http:stream_next(Pid), + httpc:stream_next(Pid), test_server:format("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), receive {http, {RequestId, stream, BinBodyPart}} -> @@ -2921,11 +3042,11 @@ provocate_not_modified_bug(Url) -> Timeout = 15000, %% 15s should be plenty {ok, {{_, 200, _}, ReplyHeaders, _Body}} = - http:request(get, {Url, []}, [{timeout, Timeout}], []), + httpc:request(get, {Url, []}, [{timeout, Timeout}], []), Etag = pick_header(ReplyHeaders, "ETag"), Last = pick_header(ReplyHeaders, "last-modified"), - case http:request(get, {Url, [{"If-None-Match", Etag}, + case httpc:request(get, {Url, [{"If-None-Match", Etag}, {"If-Modified-Since", Last}]}, [{timeout, 15000}], []) of diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 7403d4a643..3c9b5e41a7 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -32,44 +32,176 @@ init_per_suite/1, end_per_suite/1]). %% Test cases must be exported. --export([ip/1, ssl/1, http_1_1_ip/1, http_1_0_ip/1, http_0_9_ip/1, - ipv6/1, tickets/1]). +-export([ + ip/1, + ssl/1, pssl/1, ossl/1, essl/1, + http_1_1_ip/1, + http_1_0_ip/1, + http_0_9_ip/1, + ipv6/1, + tickets/1 + ]). %% Core Server tests --export([ip_mod_alias/1, ip_mod_actions/1, ip_mod_security/1, ip_mod_auth/1, - ip_mod_auth_api/1, ip_mod_auth_mnesia_api/1, - ip_mod_htaccess/1, ip_mod_cgi/1, ip_mod_esi/1, - ip_mod_get/1, ip_mod_head/1, ip_mod_all/1, ip_load_light/1, - ip_load_medium/1, ip_load_heavy/1, ip_dos_hostname/1, - ip_time_test/1, ip_block_disturbing_idle/1, - ip_block_non_disturbing_idle/1, ip_block_503/1, - ip_block_disturbing_active/1, ip_block_non_disturbing_active/1, +-export([ + ip_mod_alias/1, + ip_mod_actions/1, + ip_mod_security/1, + ip_mod_auth/1, + ip_mod_auth_api/1, + ip_mod_auth_mnesia_api/1, + ip_mod_htaccess/1, + ip_mod_cgi/1, + ip_mod_esi/1, + ip_mod_get/1, + ip_mod_head/1, + ip_mod_all/1, + ip_load_light/1, + ip_load_medium/1, + ip_load_heavy/1, + ip_dos_hostname/1, + ip_time_test/1, + ip_block_disturbing_idle/1, + ip_block_non_disturbing_idle/1, + ip_block_503/1, + ip_block_disturbing_active/1, + ip_block_non_disturbing_active/1, ip_block_disturbing_active_timeout_not_released/1, ip_block_disturbing_active_timeout_released/1, ip_block_non_disturbing_active_timeout_not_released/1, ip_block_non_disturbing_active_timeout_released/1, ip_block_disturbing_blocker_dies/1, ip_block_non_disturbing_blocker_dies/1, - ip_restart_no_block/1, ip_restart_disturbing_block/1, + ip_restart_no_block/1, + ip_restart_disturbing_block/1, ip_restart_non_disturbing_block/1 ]). --export([ssl_mod_alias/1, ssl_mod_actions/1, ssl_mod_security/1, - ssl_mod_auth/1, ssl_mod_auth_api/1, - ssl_mod_auth_mnesia_api/1, ssl_mod_htaccess/1, - ssl_mod_cgi/1, ssl_mod_esi/1, ssl_mod_get/1, ssl_mod_head/1, - ssl_mod_all/1, ssl_load_light/1, ssl_load_medium/1, - ssl_load_heavy/1, ssl_dos_hostname/1, ssl_time_test/1, - ssl_restart_no_block/1, ssl_restart_disturbing_block/1, - ssl_restart_non_disturbing_block/1, ssl_block_disturbing_idle/1, - ssl_block_non_disturbing_idle/1, ssl_block_503/1, - ssl_block_disturbing_active/1, ssl_block_non_disturbing_active/1, - ssl_block_disturbing_active_timeout_not_released/1, - ssl_block_disturbing_active_timeout_released/1, - ssl_block_non_disturbing_active_timeout_not_released/1, - ssl_block_non_disturbing_active_timeout_released/1, - ssl_block_disturbing_blocker_dies/1, - ssl_block_non_disturbing_blocker_dies/1]). +-export([ + pssl_mod_alias/1, + ossl_mod_alias/1, + essl_mod_alias/1, + + pssl_mod_actions/1, + ossl_mod_actions/1, + essl_mod_actions/1, + + pssl_mod_security/1, + ossl_mod_security/1, + essl_mod_security/1, + + pssl_mod_auth/1, + ossl_mod_auth/1, + essl_mod_auth/1, + + pssl_mod_auth_api/1, + ossl_mod_auth_api/1, + essl_mod_auth_api/1, + + pssl_mod_auth_mnesia_api/1, + ossl_mod_auth_mnesia_api/1, + essl_mod_auth_mnesia_api/1, + + pssl_mod_htaccess/1, + ossl_mod_htaccess/1, + essl_mod_htaccess/1, + + pssl_mod_cgi/1, + ossl_mod_cgi/1, + essl_mod_cgi/1, + + pssl_mod_esi/1, + ossl_mod_esi/1, + essl_mod_esi/1, + + pssl_mod_get/1, + ossl_mod_get/1, + essl_mod_get/1, + + pssl_mod_head/1, + ossl_mod_head/1, + essl_mod_head/1, + + pssl_mod_all/1, + ossl_mod_all/1, + essl_mod_all/1, + + pssl_load_light/1, + ossl_load_light/1, + essl_load_light/1, + + pssl_load_medium/1, + ossl_load_medium/1, + essl_load_medium/1, + + pssl_load_heavy/1, + ossl_load_heavy/1, + essl_load_heavy/1, + + pssl_dos_hostname/1, + ossl_dos_hostname/1, + essl_dos_hostname/1, + + pssl_time_test/1, + ossl_time_test/1, + essl_time_test/1, + + pssl_restart_no_block/1, + ossl_restart_no_block/1, + essl_restart_no_block/1, + + pssl_restart_disturbing_block/1, + ossl_restart_disturbing_block/1, + essl_restart_disturbing_block/1, + + pssl_restart_non_disturbing_block/1, + ossl_restart_non_disturbing_block/1, + essl_restart_non_disturbing_block/1, + + pssl_block_disturbing_idle/1, + ossl_block_disturbing_idle/1, + essl_block_disturbing_idle/1, + + pssl_block_non_disturbing_idle/1, + ossl_block_non_disturbing_idle/1, + essl_block_non_disturbing_idle/1, + + pssl_block_503/1, + ossl_block_503/1, + essl_block_503/1, + + pssl_block_disturbing_active/1, + ossl_block_disturbing_active/1, + essl_block_disturbing_active/1, + + pssl_block_non_disturbing_active/1, + ossl_block_non_disturbing_active/1, + essl_block_non_disturbing_active/1, + + pssl_block_disturbing_active_timeout_not_released/1, + ossl_block_disturbing_active_timeout_not_released/1, + essl_block_disturbing_active_timeout_not_released/1, + + pssl_block_disturbing_active_timeout_released/1, + ossl_block_disturbing_active_timeout_released/1, + essl_block_disturbing_active_timeout_released/1, + + pssl_block_non_disturbing_active_timeout_not_released/1, + ossl_block_non_disturbing_active_timeout_not_released/1, + essl_block_non_disturbing_active_timeout_not_released/1, + + pssl_block_non_disturbing_active_timeout_released/1, + ossl_block_non_disturbing_active_timeout_released/1, + essl_block_non_disturbing_active_timeout_released/1, + + pssl_block_disturbing_blocker_dies/1, + ossl_block_disturbing_blocker_dies/1, + essl_block_disturbing_blocker_dies/1, + + pssl_block_non_disturbing_blocker_dies/1, + ossl_block_non_disturbing_blocker_dies/1, + essl_block_non_disturbing_blocker_dies/1 + ]). %%% HTTP 1.1 tests -export([ip_host/1, ip_chunked/1, ip_expect/1, ip_range/1, @@ -103,8 +235,8 @@ %% Seconds before successful auths timeout. -define(AUTH_TIMEOUT,5). --record(httpd_user, {user_name, password, user_data}). --record(httpd_group,{group_name, userlist}). +-record(httpd_user, {user_name, password, user_data}). +-record(httpd_group, {group_name, userlist}). %%-------------------------------------------------------------------- @@ -197,9 +329,9 @@ init_per_testcase2(Case, Config) -> "~n Config: ~p" "~n", [?MODULE, Case, Config]), - IpNormal = integer_to_list(?IP_PORT) ++ ".conf", - IpHtacess = integer_to_list(?IP_PORT) ++ "htacess.conf", - SslNormal = integer_to_list(?SSL_PORT) ++ ".conf", + IpNormal = integer_to_list(?IP_PORT) ++ ".conf", + IpHtacess = integer_to_list(?IP_PORT) ++ "htacess.conf", + SslNormal = integer_to_list(?SSL_PORT) ++ ".conf", SslHtacess = integer_to_list(?SSL_PORT) ++ "htacess.conf", DataDir = ?config(data_dir, Config), @@ -210,8 +342,8 @@ init_per_testcase2(Case, Config) -> "~n DataDir: ~p" "~n", [?MODULE, Case, SuiteTopDir, DataDir]), - TcTopDir = filename:join(SuiteTopDir, Case), - ?line ok = file:make_dir(TcTopDir), + TcTopDir = filename:join(SuiteTopDir, Case), + ?line ok = file:make_dir(TcTopDir), io:format(user, "~w:init_per_testcase2(~w) -> " "~n TcTopDir: ~p" @@ -267,9 +399,21 @@ init_per_testcase2(Case, Config) -> %% To be used by SSL test cases io:format(user, "~w:init_per_testcase2(~w) -> ssl testcase setups~n", [?MODULE, Case]), - create_config([{port, ?SSL_PORT}, {sock_type, ssl} | NewConfig], + SocketType = + case atom_to_list(Case) of + [X, $s, $s, $l | _] -> + case X of + $p -> ssl; + $o -> ossl; + $e -> essl + end; + _ -> + ssl + end, + + create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], normal_acess, SslNormal), - create_config([{port, ?SSL_PORT}, {sock_type, ssl} | NewConfig], + create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], mod_htaccess, SslHtacess), %% To be used by IPv6 test cases. Case-clause is so that @@ -300,8 +444,14 @@ init_per_testcase3(Case, Config) -> io:format(user, "~w:init_per_testcase3(~w) -> entry with" "~n Config: ~p", [?MODULE, Case, Config]), + +%% %% Create a new fresh node to be used by the server in this test-case + +%% NodeName = list_to_atom(atom_to_list(Case) ++ "_httpd"), +%% Node = inets_test_lib:start_node(NodeName), + %% Clean up (we do not want this clean up in end_per_testcase - %% if init_per_testcase crases for some testcase it will + %% if init_per_testcase crashes for some testcase it will %% have contaminated the environment and there will be no clean up.) %% This init can take a few different paths so that one crashes %% does not mean that all invocations will. @@ -310,15 +460,26 @@ init_per_testcase3(Case, Config) -> application:stop(inets), application:stop(ssl), cleanup_mnesia(), - - %% TraceLevel = max, - TraceLevel = 70, - TraceDest = io, - inets:enable_trace(TraceLevel, TraceDest), + %% Set trace + case lists:reverse(atom_to_list(Case)) of + "tset_emit" ++ _Rest -> % test-cases ending with time_test + io:format(user, "~w:init_per_testcase3(~w) -> disabling trace", + [?MODULE, Case]), + inets:disable_trace(); + _ -> + %% TraceLevel = max, + io:format(user, "~w:init_per_testcase3(~w) -> enabling trace", + [?MODULE, Case]), + TraceLevel = 70, + TraceDest = io, + inets:enable_trace(TraceLevel, TraceDest, httpd) + end, + %% Start initialization io:format(user, "~w:init_per_testcase3(~w) -> start init", [?MODULE, Case]), + Dog = test_server:timetrap(inets_test_lib:minutes(10)), NewConfig = lists:keydelete(watchdog, 1, Config), @@ -351,22 +512,35 @@ init_per_testcase3(Case, Config) -> filename:join(TcTopDir, integer_to_list(?IP_PORT) ++ ".conf")}]), Rest; - "ssl_mod_htaccess" -> + + [X, $s, $s, $l, $_, $m, $o, $d, $_, $h, $t, $a, $c, $c, $e, $s, $s] -> + SslTag = + case X of + $p -> ssl; % plain + $o -> ossl; % OpenSSL based ssl + $e -> essl % Erlang based ssl + end, case inets_test_lib:start_http_server_ssl( filename:join(TcTopDir, integer_to_list(?SSL_PORT) ++ - "htacess.conf")) of + "htacess.conf"), SslTag) of ok -> "mod_htaccess"; Other -> error_logger:info_report("Other: ~p~n", [Other]), {skip, "SSL does not seem to be supported"} end; - "ssl_" ++ Rest -> + [X, $s, $s, $l, $_ | Rest] -> + SslTag = + case X of + $p -> ssl; + $o -> ossl; + $e -> essl + end, case inets_test_lib:start_http_server_ssl( filename:join(TcTopDir, integer_to_list(?SSL_PORT) ++ - ".conf")) of + ".conf"), SslTag) of ok -> Rest; Other -> @@ -431,6 +605,7 @@ end_per_testcase2(Case, Config) -> application:unset_env(inets, services), application:stop(inets), application:stop(ssl), + application:stop(crypto), % used by the new ssl (essl test cases) cleanup_mnesia(), io:format(user, "~w:end_per_testcase2(~w) -> done~n", [?MODULE, Case]), @@ -461,6 +636,9 @@ ip(suite) -> ip_load_heavy, ip_dos_hostname, ip_time_test, + ip_restart_no_block, + ip_restart_disturbing_block, + ip_restart_non_disturbing_block, ip_block_disturbing_idle, ip_block_non_disturbing_idle, ip_block_503, @@ -471,10 +649,7 @@ ip(suite) -> ip_block_non_disturbing_active_timeout_not_released, ip_block_non_disturbing_active_timeout_released, ip_block_disturbing_blocker_dies, - ip_block_non_disturbing_blocker_dies, - ip_restart_no_block, - ip_restart_disturbing_block, - ip_restart_non_disturbing_block + ip_block_non_disturbing_blocker_dies ]. %%------------------------------------------------------------------------- @@ -482,39 +657,124 @@ ssl(doc) -> ["HTTP test using SSL"]; ssl(suite) -> [ - ssl_mod_alias, - ssl_mod_actions, - ssl_mod_security, - ssl_mod_auth, - ssl_mod_auth_api, - ssl_mod_auth_mnesia_api, - ssl_mod_htaccess, - ssl_mod_cgi, - ssl_mod_esi, - ssl_mod_get, - ssl_mod_head, - ssl_mod_all, - ssl_load_light, - ssl_load_medium, - ssl_load_heavy, - ssl_dos_hostname, - ssl_time_test, - ssl_restart_no_block, - ssl_restart_disturbing_block, - ssl_restart_non_disturbing_block, - ssl_block_disturbing_idle, - ssl_block_non_disturbing_idle, - ssl_block_503, - ssl_block_disturbing_active, - ssl_block_non_disturbing_active, - ssl_block_disturbing_active_timeout_not_released, - ssl_block_disturbing_active_timeout_released, - ssl_block_non_disturbing_active_timeout_not_released, - ssl_block_non_disturbing_active_timeout_released, - ssl_block_disturbing_blocker_dies, - ssl_block_non_disturbing_blocker_dies + pssl, + ossl, + essl + ]. + + +pssl(doc) -> + ["HTTP test using SSL - using old way of configuring SSL"]; +pssl(suite) -> + [ + pssl_mod_alias, + pssl_mod_actions, + pssl_mod_security, + pssl_mod_auth, + pssl_mod_auth_api, + pssl_mod_auth_mnesia_api, + pssl_mod_htaccess, + pssl_mod_cgi, + pssl_mod_esi, + pssl_mod_get, + pssl_mod_head, + pssl_mod_all, + pssl_load_light, + pssl_load_medium, + pssl_load_heavy, + pssl_dos_hostname, + pssl_time_test, + pssl_restart_no_block, + pssl_restart_disturbing_block, + pssl_restart_non_disturbing_block, + pssl_block_disturbing_idle, + pssl_block_non_disturbing_idle, + pssl_block_503, + pssl_block_disturbing_active, + pssl_block_non_disturbing_active, + pssl_block_disturbing_active_timeout_not_released, + pssl_block_disturbing_active_timeout_released, + pssl_block_non_disturbing_active_timeout_not_released, + pssl_block_non_disturbing_active_timeout_released, + pssl_block_disturbing_blocker_dies, + pssl_block_non_disturbing_blocker_dies + ]. + +ossl(doc) -> + ["HTTP test using SSL - using new way of configuring usage of old SSL"]; +ossl(suite) -> + [ + ossl_mod_alias, + ossl_mod_actions, + ossl_mod_security, + ossl_mod_auth, + ossl_mod_auth_api, + ossl_mod_auth_mnesia_api, + ossl_mod_htaccess, + ossl_mod_cgi, + ossl_mod_esi, + ossl_mod_get, + ossl_mod_head, + ossl_mod_all, + ossl_load_light, + ossl_load_medium, + ossl_load_heavy, + ossl_dos_hostname, + ossl_time_test, + ossl_restart_no_block, + ossl_restart_disturbing_block, + ossl_restart_non_disturbing_block, + ossl_block_disturbing_idle, + ossl_block_non_disturbing_idle, + ossl_block_503, + ossl_block_disturbing_active, + ossl_block_non_disturbing_active, + ossl_block_disturbing_active_timeout_not_released, + ossl_block_disturbing_active_timeout_released, + ossl_block_non_disturbing_active_timeout_not_released, + ossl_block_non_disturbing_active_timeout_released, + ossl_block_disturbing_blocker_dies, + ossl_block_non_disturbing_blocker_dies ]. +essl(doc) -> + ["HTTP test using SSL - using new way of configuring usage of new SSL"]; +essl(suite) -> + [ + essl_mod_alias, + essl_mod_actions, + essl_mod_security, + essl_mod_auth, + essl_mod_auth_api, + essl_mod_auth_mnesia_api, + essl_mod_htaccess, + essl_mod_cgi, + essl_mod_esi, + essl_mod_get, + essl_mod_head, + essl_mod_all, + essl_load_light, + essl_load_medium, + essl_load_heavy, + essl_dos_hostname, + essl_time_test, + essl_restart_no_block, + essl_restart_disturbing_block, + essl_restart_non_disturbing_block, + essl_block_disturbing_idle, + essl_block_non_disturbing_idle, + essl_block_503, + essl_block_disturbing_active, + essl_block_non_disturbing_active, + essl_block_disturbing_active_timeout_not_released, + essl_block_disturbing_active_timeout_released, + essl_block_non_disturbing_active_timeout_not_released, + essl_block_non_disturbing_active_timeout_released, + essl_block_disturbing_blocker_dies, + essl_block_non_disturbing_blocker_dies + ]. + + %%------------------------------------------------------------------------- http_1_1_ip(doc) -> ["HTTP/1.1"]; @@ -721,6 +981,8 @@ ip_load_heavy(Config) when is_list(Config) -> ?config(node, Config), get_nof_clients(ip_comm, heavy)), ok. + + %%------------------------------------------------------------------------- ip_dos_hostname(doc) -> ["Denial Of Service (DOS) attack test case"]; @@ -730,6 +992,8 @@ ip_dos_hostname(Config) when is_list(Config) -> dos_hostname(ip_comm, ?IP_PORT, ?config(host, Config), ?config(node, Config), ?MAX_HEADER_SIZE), ok. + + %%------------------------------------------------------------------------- ip_time_test(doc) -> [""]; @@ -966,352 +1230,1042 @@ ip_restart_non_disturbing_block(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- -ssl_mod_alias(doc) -> - ["Module test: mod_alias"]; -ssl_mod_alias(suite) -> + +pssl_mod_alias(doc) -> + ["Module test: mod_alias - old SSL config"]; +pssl_mod_alias(suite) -> + []; +pssl_mod_alias(Config) when is_list(Config) -> + ssl_mod_alias(ssl, Config). + +ossl_mod_alias(doc) -> + ["Module test: mod_alias - using new of configure old SSL"]; +ossl_mod_alias(suite) -> []; -ssl_mod_alias(Config) when is_list(Config) -> - httpd_mod:alias(ssl, ?SSL_PORT, +ossl_mod_alias(Config) when is_list(Config) -> + ssl_mod_alias(ossl, Config). + +essl_mod_alias(doc) -> + ["Module test: mod_alias - using new of configure new SSL"]; +essl_mod_alias(suite) -> + []; +essl_mod_alias(Config) when is_list(Config) -> + ssl_mod_alias(essl, Config). + + +ssl_mod_alias(Tag, Config) -> + httpd_mod:alias(Tag, ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_actions(doc) -> - ["Module test: mod_actions"]; -ssl_mod_actions(suite) -> + +pssl_mod_actions(doc) -> + ["Module test: mod_actions - old SSL config"]; +pssl_mod_actions(suite) -> []; -ssl_mod_actions(Config) when is_list(Config) -> - httpd_mod:actions(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_actions(Config) when is_list(Config) -> + ssl_mod_actions(ssl, Config). + +ossl_mod_actions(doc) -> + ["Module test: mod_actions - using new of configure old SSL"]; +ossl_mod_actions(suite) -> + []; +ossl_mod_actions(Config) when is_list(Config) -> + ssl_mod_actions(ossl, Config). + +essl_mod_actions(doc) -> + ["Module test: mod_actions - using new of configure new SSL"]; +essl_mod_actions(suite) -> + []; +essl_mod_actions(Config) when is_list(Config) -> + ssl_mod_actions(essl, Config). + + +ssl_mod_actions(Tag, Config) -> + httpd_mod:actions(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_security(doc) -> - ["Module test: mod_security"]; -ssl_mod_security(suite) -> + +pssl_mod_security(doc) -> + ["Module test: mod_security - old SSL config"]; +pssl_mod_security(suite) -> + []; +pssl_mod_security(Config) when is_list(Config) -> + ssl_mod_security(ssl, Config). + +ossl_mod_security(doc) -> + ["Module test: mod_security - using new of configure old SSL"]; +ossl_mod_security(suite) -> + []; +ossl_mod_security(Config) when is_list(Config) -> + ssl_mod_security(ossl, Config). + +essl_mod_security(doc) -> + ["Module test: mod_security - using new of configure new SSL"]; +essl_mod_security(suite) -> []; -ssl_mod_security(Config) when is_list(Config) -> +essl_mod_security(Config) when is_list(Config) -> + ssl_mod_security(essl, Config). + +ssl_mod_security(Tag, Config) -> ServerRoot = ?config(server_root, Config), - httpd_mod:security(ServerRoot, ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), + httpd_mod:security(ServerRoot, + Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_auth(doc) -> - ["Module test: mod_auth"]; -ssl_mod_auth(suite) -> + +pssl_mod_auth(doc) -> + ["Module test: mod_auth - old SSL config"]; +pssl_mod_auth(suite) -> []; -ssl_mod_auth(Config) when is_list(Config) -> - httpd_mod:auth(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_auth(Config) when is_list(Config) -> + ssl_mod_auth(ssl, Config). + +ossl_mod_auth(doc) -> + ["Module test: mod_auth - using new of configure old SSL"]; +ossl_mod_auth(suite) -> + []; +ossl_mod_auth(Config) when is_list(Config) -> + ssl_mod_auth(ossl, Config). + +essl_mod_auth(doc) -> + ["Module test: mod_auth - using new of configure new SSL"]; +essl_mod_auth(suite) -> + []; +essl_mod_auth(Config) when is_list(Config) -> + ssl_mod_auth(essl, Config). + +ssl_mod_auth(Tag, Config) -> + httpd_mod:auth(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_auth_api(doc) -> - ["Module test: mod_auth"]; -ssl_mod_auth_api(suite) -> + +pssl_mod_auth_api(doc) -> + ["Module test: mod_auth - old SSL config"]; +pssl_mod_auth_api(suite) -> + []; +pssl_mod_auth_api(Config) when is_list(Config) -> + ssl_mod_auth_api(ssl, Config). + +ossl_mod_auth_api(doc) -> + ["Module test: mod_auth - using new of configure old SSL"]; +ossl_mod_auth_api(suite) -> + []; +ossl_mod_auth_api(Config) when is_list(Config) -> + ssl_mod_auth_api(ossl, Config). + +essl_mod_auth_api(doc) -> + ["Module test: mod_auth - using new of configure new SSL"]; +essl_mod_auth_api(suite) -> []; -ssl_mod_auth_api(Config) when is_list(Config) -> +essl_mod_auth_api(Config) when is_list(Config) -> + ssl_mod_auth_api(essl, Config). + +ssl_mod_auth_api(Tag, Config) -> ServerRoot = ?config(server_root, Config), - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_mod:auth_api(ServerRoot, "", ssl, ?SSL_PORT, Host, Node), - httpd_mod:auth_api(ServerRoot, "dets_", ssl, ?SSL_PORT, Host, Node), - httpd_mod:auth_api(ServerRoot, "mnesia_", ssl, ?SSL_PORT, Host, Node), + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_mod:auth_api(ServerRoot, "", Tag, ?SSL_PORT, Host, Node), + httpd_mod:auth_api(ServerRoot, "dets_", Tag, ?SSL_PORT, Host, Node), + httpd_mod:auth_api(ServerRoot, "mnesia_", Tag, ?SSL_PORT, Host, Node), ok. + %%------------------------------------------------------------------------- -ssl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api"]; -ssl_mod_auth_mnesia_api(suite) -> + +pssl_mod_auth_mnesia_api(doc) -> + ["Module test: mod_auth_mnesia_api - old SSL config"]; +pssl_mod_auth_mnesia_api(suite) -> []; -ssl_mod_auth_mnesia_api(Config) when is_list(Config) -> - httpd_mod:auth_mnesia_api(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_auth_mnesia_api(Config) when is_list(Config) -> + ssl_mod_auth_mnesia_api(ssl, Config). + +ossl_mod_auth_mnesia_api(doc) -> + ["Module test: mod_auth_mnesia_api - using new of configure old SSL"]; +ossl_mod_auth_mnesia_api(suite) -> + []; +ossl_mod_auth_mnesia_api(Config) when is_list(Config) -> + ssl_mod_auth_mnesia_api(ossl, Config). + +essl_mod_auth_mnesia_api(doc) -> + ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; +essl_mod_auth_mnesia_api(suite) -> + []; +essl_mod_auth_mnesia_api(Config) when is_list(Config) -> + ssl_mod_auth_mnesia_api(essl, Config). + +ssl_mod_auth_mnesia_api(Tag, Config) -> + httpd_mod:auth_mnesia_api(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_htaccess(doc) -> - ["Module test: mod_htaccess"]; -ssl_mod_htaccess(suite) -> + +pssl_mod_htaccess(doc) -> + ["Module test: mod_htaccess - old SSL config"]; +pssl_mod_htaccess(suite) -> []; -ssl_mod_htaccess(Config) when is_list(Config) -> - httpd_mod:htaccess(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_htaccess(Config) when is_list(Config) -> + ssl_mod_htaccess(ssl, Config). + +ossl_mod_htaccess(doc) -> + ["Module test: mod_htaccess - using new of configure old SSL"]; +ossl_mod_htaccess(suite) -> + []; +ossl_mod_htaccess(Config) when is_list(Config) -> + ssl_mod_htaccess(ossl, Config). + +essl_mod_htaccess(doc) -> + ["Module test: mod_htaccess - using new of configure new SSL"]; +essl_mod_htaccess(suite) -> + []; +essl_mod_htaccess(Config) when is_list(Config) -> + ssl_mod_htaccess(essl, Config). + +ssl_mod_htaccess(Tag, Config) -> + httpd_mod:htaccess(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_cgi(doc) -> - ["Module test: mod_cgi"]; -ssl_mod_cgi(suite) -> + +pssl_mod_cgi(doc) -> + ["Module test: mod_cgi - old SSL config"]; +pssl_mod_cgi(suite) -> + []; +pssl_mod_cgi(Config) when is_list(Config) -> + ssl_mod_cgi(ssl, Config). + +ossl_mod_cgi(doc) -> + ["Module test: mod_cgi - using new of configure old SSL"]; +ossl_mod_cgi(suite) -> + []; +ossl_mod_cgi(Config) when is_list(Config) -> + ssl_mod_cgi(ossl, Config). + +essl_mod_cgi(doc) -> + ["Module test: mod_cgi - using new of configure new SSL"]; +essl_mod_cgi(suite) -> []; -ssl_mod_cgi(Config) when is_list(Config) -> +essl_mod_cgi(Config) when is_list(Config) -> + ssl_mod_cgi(essl, Config). + +ssl_mod_cgi(Tag, Config) -> case test_server:os_type() of vxworks -> {skip, cgi_not_supported_on_vxwoks}; _ -> - httpd_mod:cgi(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), + httpd_mod:cgi(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok end. + + %%------------------------------------------------------------------------- -ssl_mod_esi(doc) -> - ["Module test: mod_esi"]; -ssl_mod_esi(suite) -> + +pssl_mod_esi(doc) -> + ["Module test: mod_esi - old SSL config"]; +pssl_mod_esi(suite) -> []; -ssl_mod_esi(Config) when is_list(Config) -> - httpd_mod:esi(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_esi(Config) when is_list(Config) -> + ssl_mod_esi(ssl, Config). + +ossl_mod_esi(doc) -> + ["Module test: mod_esi - using new of configure old SSL"]; +ossl_mod_esi(suite) -> + []; +ossl_mod_esi(Config) when is_list(Config) -> + ssl_mod_esi(ossl, Config). + +essl_mod_esi(doc) -> + ["Module test: mod_esi - using new of configure new SSL"]; +essl_mod_esi(suite) -> + []; +essl_mod_esi(Config) when is_list(Config) -> + ssl_mod_esi(essl, Config). + +ssl_mod_esi(Tag, Config) -> + httpd_mod:esi(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + %%------------------------------------------------------------------------- -ssl_mod_get(doc) -> - ["Module test: mod_get"]; -ssl_mod_get(suite) -> + +pssl_mod_get(doc) -> + ["Module test: mod_get - old SSL config"]; +pssl_mod_get(suite) -> []; -ssl_mod_get(Config) when is_list(Config) -> - httpd_mod:get(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_get(Config) when is_list(Config) -> + ssl_mod_get(ssl, Config). + +ossl_mod_get(doc) -> + ["Module test: mod_get - using new of configure old SSL"]; +ossl_mod_get(suite) -> + []; +ossl_mod_get(Config) when is_list(Config) -> + ssl_mod_get(ossl, Config). + +essl_mod_get(doc) -> + ["Module test: mod_get - using new of configure new SSL"]; +essl_mod_get(suite) -> + []; +essl_mod_get(Config) when is_list(Config) -> + ssl_mod_get(essl, Config). + +ssl_mod_get(Tag, Config) -> + httpd_mod:get(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_head(doc) -> - ["Module test: mod_head"]; -ssl_mod_head(suite) -> + +pssl_mod_head(doc) -> + ["Module test: mod_head - old SSL config"]; +pssl_mod_head(suite) -> []; -ssl_mod_head(Config) when is_list(Config) -> - httpd_mod:head(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_head(Config) when is_list(Config) -> + ssl_mod_head(ssl, Config). + +ossl_mod_head(doc) -> + ["Module test: mod_head - using new of configure old SSL"]; +ossl_mod_head(suite) -> + []; +ossl_mod_head(Config) when is_list(Config) -> + ssl_mod_head(ossl, Config). + +essl_mod_head(doc) -> + ["Module test: mod_head - using new of configure new SSL"]; +essl_mod_head(suite) -> + []; +essl_mod_head(Config) when is_list(Config) -> + ssl_mod_head(essl, Config). + +ssl_mod_head(Tag, Config) -> + httpd_mod:head(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_mod_all(doc) -> - ["All modules test"]; -ssl_mod_all(suite) -> + +pssl_mod_all(doc) -> + ["All modules test - old SSL config"]; +pssl_mod_all(suite) -> []; -ssl_mod_all(Config) when is_list(Config) -> - httpd_mod:all(ssl, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), +pssl_mod_all(Config) when is_list(Config) -> + ssl_mod_all(ssl, Config). + +ossl_mod_all(doc) -> + ["All modules test - using new of configure old SSL"]; +ossl_mod_all(suite) -> + []; +ossl_mod_all(Config) when is_list(Config) -> + ssl_mod_all(ossl, Config). + +essl_mod_all(doc) -> + ["All modules test - using new of configure new SSL"]; +essl_mod_all(suite) -> + []; +essl_mod_all(Config) when is_list(Config) -> + ssl_mod_all(essl, Config). + +ssl_mod_all(Tag, Config) -> + httpd_mod:all(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + %%------------------------------------------------------------------------- -ssl_load_light(doc) -> - ["Test light load"]; -ssl_load_light(suite) -> + +pssl_load_light(doc) -> + ["Test light load - old SSL config"]; +pssl_load_light(suite) -> + []; +pssl_load_light(Config) when is_list(Config) -> + ssl_load_light(ssl, Config). + +ossl_load_light(doc) -> + ["Test light load - using new of configure old SSL"]; +ossl_load_light(suite) -> []; -ssl_load_light(Config) when is_list(Config) -> - httpd_load:load_test(ssl, ?SSL_PORT, ?config(host, Config), +ossl_load_light(Config) when is_list(Config) -> + ssl_load_light(ossl, Config). + +essl_load_light(doc) -> + ["Test light load - using new of configure new SSL"]; +essl_load_light(suite) -> + []; +essl_load_light(Config) when is_list(Config) -> + ssl_load_light(essl, Config). + +ssl_load_light(Tag, Config) -> + httpd_load:load_test(Tag, + ?SSL_PORT, + ?config(host, Config), ?config(node, Config), get_nof_clients(ssl, light)), ok. + %%------------------------------------------------------------------------- -ssl_load_medium(doc) -> - ["Test medium load"]; -ssl_load_medium(suite) -> + +pssl_load_medium(doc) -> + ["Test medium load - old SSL config"]; +pssl_load_medium(suite) -> + []; +pssl_load_medium(Config) when is_list(Config) -> + ssl_load_medium(ssl, Config). + +ossl_load_medium(doc) -> + ["Test medium load - using new of configure old SSL"]; +ossl_load_medium(suite) -> + []; +ossl_load_medium(Config) when is_list(Config) -> + ssl_load_medium(ossl, Config). + +essl_load_medium(doc) -> + ["Test medium load - using new of configure new SSL"]; +essl_load_medium(suite) -> []; -ssl_load_medium(Config) when is_list(Config) -> +essl_load_medium(Config) when is_list(Config) -> + ssl_load_medium(essl, Config). + +ssl_load_medium(Tag, Config) -> %% <CONDITIONAL-SKIP> Skippable = [win32], Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, ?NON_PC_TC_MAYBE_SKIP(Config, Condition), %% </CONDITIONAL-SKIP> - httpd_load:load_test(ssl, ?SSL_PORT, ?config(host, Config), + httpd_load:load_test(Tag, + ?SSL_PORT, + ?config(host, Config), ?config(node, Config), get_nof_clients(ssl, medium)), ok. + %%------------------------------------------------------------------------- -ssl_load_heavy(doc) -> - ["Test heavy load"]; -ssl_load_heavy(suite) -> + +pssl_load_heavy(doc) -> + ["Test heavy load - old SSL config"]; +pssl_load_heavy(suite) -> + []; +pssl_load_heavy(Config) when is_list(Config) -> + ssl_load_heavy(ssl, Config). + +ossl_load_heavy(doc) -> + ["Test heavy load - using new of configure old SSL"]; +ossl_load_heavy(suite) -> []; -ssl_load_heavy(Config) when is_list(Config) -> +ossl_load_heavy(Config) when is_list(Config) -> + ssl_load_heavy(ossl, Config). + +essl_load_heavy(doc) -> + ["Test heavy load - using new of configure new SSL"]; +essl_load_heavy(suite) -> + []; +essl_load_heavy(Config) when is_list(Config) -> + ssl_load_heavy(essl, Config). + +ssl_load_heavy(Tag, Config) -> %% <CONDITIONAL-SKIP> Skippable = [win32], Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, ?NON_PC_TC_MAYBE_SKIP(Config, Condition), %% </CONDITIONAL-SKIP> - httpd_load:load_test(ssl, ?SSL_PORT, ?config(host, Config), + httpd_load:load_test(Tag, + ?SSL_PORT, + ?config(host, Config), ?config(node, Config), get_nof_clients(ssl, heavy)), ok. + %%------------------------------------------------------------------------- -ssl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case"]; -ssl_dos_hostname(suite) -> + +pssl_dos_hostname(doc) -> + ["Denial Of Service (DOS) attack test case - old SSL config"]; +pssl_dos_hostname(suite) -> []; -ssl_dos_hostname(Config) when is_list(Config) -> - dos_hostname(ssl, ?SSL_PORT, ?config(host, Config), - ?config(node, Config), ?MAX_HEADER_SIZE), +pssl_dos_hostname(Config) when is_list(Config) -> + ssl_dos_hostname(ssl, Config). + +ossl_dos_hostname(doc) -> + ["Denial Of Service (DOS) attack test case - using new of configure old SSL"]; +ossl_dos_hostname(suite) -> + []; +ossl_dos_hostname(Config) when is_list(Config) -> + ssl_dos_hostname(ossl, Config). + +essl_dos_hostname(doc) -> + ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; +essl_dos_hostname(suite) -> + []; +essl_dos_hostname(Config) when is_list(Config) -> + ssl_dos_hostname(essl, Config). + +ssl_dos_hostname(Tag, Config) -> + dos_hostname(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config), + ?MAX_HEADER_SIZE), ok. + + %%------------------------------------------------------------------------- -ssl_time_test(doc) -> - [""]; -ssl_time_test(suite) -> + +pssl_time_test(doc) -> + ["old SSL config"]; +pssl_time_test(suite) -> + []; +pssl_time_test(Config) when is_list(Config) -> + ssl_time_test(ssl, Config). + +ossl_time_test(doc) -> + ["using new of configure old SSL"]; +ossl_time_test(suite) -> []; -ssl_time_test(Config) when is_list(Config) -> +ossl_time_test(Config) when is_list(Config) -> + ssl_time_test(ossl, Config). + +essl_time_test(doc) -> + ["using new of configure new SSL"]; +essl_time_test(suite) -> + []; +essl_time_test(Config) when is_list(Config) -> + ssl_time_test(essl, Config). + +ssl_time_test(Tag, Config) when is_list(Config) -> %% <CONDITIONAL-SKIP> - Condition = fun() -> true end, + Skippable = [win32], + Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, ?NON_PC_TC_MAYBE_SKIP(Config, Condition), %% </CONDITIONAL-SKIP> - httpd_time_test:t(ssl, ?config(host, Config), ?SSL_PORT), + httpd_time_test:t(Tag, + ?config(host, Config), + ?SSL_PORT), ok. + %%------------------------------------------------------------------------- -ssl_block_503(doc) -> + +pssl_block_503(doc) -> ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked."]; -ssl_block_503(suite) -> + " is blocked and 200 when its not blocked - old SSL config."]; +pssl_block_503(suite) -> + []; +pssl_block_503(Config) when is_list(Config) -> + ssl_block_503(ssl, Config). + +ossl_block_503(doc) -> + ["Check that you will receive status code 503 when the server" + " is blocked and 200 when its not blocked - using new of configure old SSL."]; +ossl_block_503(suite) -> + []; +ossl_block_503(Config) when is_list(Config) -> + ssl_block_503(ossl, Config). + +essl_block_503(doc) -> + ["Check that you will receive status code 503 when the server" + " is blocked and 200 when its not blocked - using new of configure new SSL."]; +essl_block_503(suite) -> []; -ssl_block_503(Config) when is_list(Config) -> - httpd_block:block_503(ssl, ?SSL_PORT, ?config(host, Config), +essl_block_503(Config) when is_list(Config) -> + ssl_block_503(essl, Config). + +ssl_block_503(Tag, Config) -> + httpd_block:block_503(Tag, + ?SSL_PORT, + ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_block_disturbing_idle(doc) -> + +pssl_block_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case."]; -ssl_block_disturbing_idle(suite) -> + "distribing does not really make a difference in this case." + "Old SSL config"]; +pssl_block_disturbing_idle(suite) -> + []; +pssl_block_disturbing_idle(Config) when is_list(Config) -> + ssl_block_disturbing_idle(ssl, Config). + +ossl_block_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "distribing does not really make a difference in this case." + "Using new of configure old SSL"]; +ossl_block_disturbing_idle(suite) -> + []; +ossl_block_disturbing_idle(Config) when is_list(Config) -> + ssl_block_disturbing_idle(ossl, Config). + +essl_block_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "distribing does not really make a difference in this case." + "Using new of configure new SSL"]; +essl_block_disturbing_idle(suite) -> []; -ssl_block_disturbing_idle(Config) when is_list(Config) -> - httpd_block:block_disturbing_idle(ssl, ?SSL_PORT, +essl_block_disturbing_idle(Config) when is_list(Config) -> + ssl_block_disturbing_idle(essl, Config). + +ssl_block_disturbing_idle(Tag, Config) -> + httpd_block:block_disturbing_idle(Tag, + ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_block_non_disturbing_idle(doc) -> + +pssl_block_non_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case."]; -ssl_block_non_disturbing_idle(suite) -> + "non distribing does not really make a difference in this case." + "Old SSL config"]; +pssl_block_non_disturbing_idle(suite) -> []; -ssl_block_non_disturbing_idle(Config) when is_list(Config) -> - httpd_block:block_non_disturbing_idle(ssl, ?SSL_PORT, +pssl_block_non_disturbing_idle(Config) when is_list(Config) -> + ssl_block_non_disturbing_idle(ssl, Config). + +ossl_block_non_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing does not really make a difference in this case." + "Using new of configure old SSL"]; +ossl_block_non_disturbing_idle(suite) -> + []; +ossl_block_non_disturbing_idle(Config) when is_list(Config) -> + ssl_block_non_disturbing_idle(ossl, Config). + +essl_block_non_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing does not really make a difference in this case." + "Using new of configure new SSL"]; +essl_block_non_disturbing_idle(suite) -> + []; +essl_block_non_disturbing_idle(Config) when is_list(Config) -> + ssl_block_non_disturbing_idle(essl, Config). + +ssl_block_non_disturbing_idle(Tag, Config) -> + httpd_block:block_non_disturbing_idle(Tag, + ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_block_disturbing_active(doc) -> + +pssl_block_disturbing_active(doc) -> ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated."]; -ssl_block_disturbing_active(suite) -> + "distribing means ongoing requests should be terminated." + "Old SSL config"]; +pssl_block_disturbing_active(suite) -> + []; +pssl_block_disturbing_active(Config) when is_list(Config) -> + ssl_block_disturbing_active(ssl, Config). + +ossl_block_disturbing_active(doc) -> + ["Check that you can block/unblock an active server. The strategy " + "distribing means ongoing requests should be terminated." + "Using new of configure old SSL"]; +ossl_block_disturbing_active(suite) -> + []; +ossl_block_disturbing_active(Config) when is_list(Config) -> + ssl_block_disturbing_active(ossl, Config). + +essl_block_disturbing_active(doc) -> + ["Check that you can block/unblock an active server. The strategy " + "distribing means ongoing requests should be terminated." + "Using new of configure new SSL"]; +essl_block_disturbing_active(suite) -> []; -ssl_block_disturbing_active(Config) when is_list(Config) -> - httpd_block:block_disturbing_active(ssl, ?SSL_PORT, +essl_block_disturbing_active(Config) when is_list(Config) -> + ssl_block_disturbing_active(essl, Config). + +ssl_block_disturbing_active(Tag, Config) -> + httpd_block:block_disturbing_active(Tag, + ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_block_non_disturbing_active(doc) -> + +pssl_block_non_disturbing_active(doc) -> ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated."]; -ssl_block_non_disturbing_active(suite) -> + "non distribing means the ongoing requests should be compleated." + "Old SSL config"]; +pssl_block_non_disturbing_active(suite) -> + []; +pssl_block_non_disturbing_active(Config) when is_list(Config) -> + ssl_block_non_disturbing_active(ssl, Config). + +ossl_block_non_disturbing_active(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing means the ongoing requests should be compleated." + "Using new of configure old SSL"]; +ossl_block_non_disturbing_active(suite) -> + []; +ossl_block_non_disturbing_active(Config) when is_list(Config) -> + ssl_block_non_disturbing_active(ossl, Config). + +essl_block_non_disturbing_active(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing means the ongoing requests should be compleated." + "Using new of configure new SSL"]; +essl_block_non_disturbing_active(suite) -> []; -ssl_block_non_disturbing_active(Config) when is_list(Config) -> - httpd_block:block_non_disturbing_idle(ssl, ?SSL_PORT, +essl_block_non_disturbing_active(Config) when is_list(Config) -> + ssl_block_non_disturbing_active(essl, Config). + +ssl_block_non_disturbing_active(Tag, Config) -> + httpd_block:block_non_disturbing_idle(Tag, + ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + %%------------------------------------------------------------------------- -ssl_block_disturbing_active_timeout_not_released(doc) -> + +pssl_block_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be compleated" - "if the timeout does not occur."]; -ssl_block_disturbing_active_timeout_not_released(suite) -> + "if the timeout does not occur." + "Old SSL config"]; +pssl_block_disturbing_active_timeout_not_released(suite) -> []; -ssl_block_disturbing_active_timeout_not_released(Config) +pssl_block_disturbing_active_timeout_not_released(Config) when is_list(Config) -> - httpd_block: - block_disturbing_active_timeout_not_released(ssl, - ?SSL_PORT, - ?config(host, - Config), - ?config(node, - Config)), + ssl_block_disturbing_active_timeout_not_released(ssl, Config). + +ossl_block_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be compleated" + "if the timeout does not occur." + "Using new of configure old SSL"]; +ossl_block_disturbing_active_timeout_not_released(suite) -> + []; +ossl_block_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + ssl_block_disturbing_active_timeout_not_released(ossl, Config). + +essl_block_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be compleated" + "if the timeout does not occur." + "Using new of configure new SSL"]; +essl_block_disturbing_active_timeout_not_released(suite) -> + []; +essl_block_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + ssl_block_disturbing_active_timeout_not_released(essl, Config). + +ssl_block_disturbing_active_timeout_not_released(Tag, Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_disturbing_active_timeout_not_released(Tag, + Port, Host, Node), ok. + + %%------------------------------------------------------------------------- -ssl_block_disturbing_active_timeout_released(doc) -> + +pssl_block_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be terminated when" - "the timeout occurs."]; -ssl_block_disturbing_active_timeout_released(suite) -> + "the timeout occurs." + "Old SSL config"]; +pssl_block_disturbing_active_timeout_released(suite) -> []; -ssl_block_disturbing_active_timeout_released(Config) +pssl_block_disturbing_active_timeout_released(Config) when is_list(Config) -> - httpd_block:block_disturbing_active_timeout_released(ssl, - ?SSL_PORT, - ?config(host, - Config), - ?config(node, - Config)), + ssl_block_disturbing_active_timeout_released(ssl, Config). + +ossl_block_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be terminated when" + "the timeout occurs." + "Using new of configure old SSL"]; +ossl_block_disturbing_active_timeout_released(suite) -> + []; +ossl_block_disturbing_active_timeout_released(Config) + when is_list(Config) -> + ssl_block_disturbing_active_timeout_released(ossl, Config). + +essl_block_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be terminated when" + "the timeout occurs." + "Using new of configure new SSL"]; +essl_block_disturbing_active_timeout_released(suite) -> + []; +essl_block_disturbing_active_timeout_released(Config) + when is_list(Config) -> + ssl_block_disturbing_active_timeout_released(essl, Config). + +ssl_block_disturbing_active_timeout_released(Tag, Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_disturbing_active_timeout_released(Tag, + Port, + Host, + Node), ok. + %%------------------------------------------------------------------------- -ssl_block_non_disturbing_active_timeout_not_released(doc) -> + +pssl_block_non_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed."]; -ssl_block_non_disturbing_active_timeout_not_released(suite) -> + "non non distribing means ongoing requests should be completed." + "Old SSL config"]; +pssl_block_non_disturbing_active_timeout_not_released(suite) -> []; -ssl_block_non_disturbing_active_timeout_not_released(Config) +pssl_block_non_disturbing_active_timeout_not_released(Config) when is_list(Config) -> - httpd_block: - block_non_disturbing_active_timeout_not_released(ssl, - ?SSL_PORT, - ?config(host, - Config), - ?config(node, - Config)), + ssl_block_non_disturbing_active_timeout_not_released(ssl, Config). + +ossl_block_non_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "non non distribing means ongoing requests should be completed." + "Using new of configure old SSL"]; +ossl_block_non_disturbing_active_timeout_not_released(suite) -> + []; +ossl_block_non_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + ssl_block_non_disturbing_active_timeout_not_released(ossl, Config). + +essl_block_non_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "non non distribing means ongoing requests should be completed." + "Using new of configure new SSL"]; +essl_block_non_disturbing_active_timeout_not_released(suite) -> + []; +essl_block_non_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + ssl_block_non_disturbing_active_timeout_not_released(essl, Config). + +ssl_block_non_disturbing_active_timeout_not_released(Tag, Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_non_disturbing_active_timeout_not_released(Tag, + Port, + Host, + Node), ok. + + %%------------------------------------------------------------------------- -ssl_block_non_disturbing_active_timeout_released(doc) -> + +pssl_block_non_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." ]; -ssl_block_non_disturbing_active_timeout_released(suite) -> + "non distribing means ongoing requests should be completed. " + "When the timeout occurs the block operation sohould be canceled." + "Old SSL config"]; +pssl_block_non_disturbing_active_timeout_released(suite) -> []; -ssl_block_non_disturbing_active_timeout_released(Config) +pssl_block_non_disturbing_active_timeout_released(Config) when is_list(Config) -> - httpd_block: - block_non_disturbing_active_timeout_released(ssl, - ?SSL_PORT, - ?config(host, - Config), - ?config(node, - Config)), + ssl_block_non_disturbing_active_timeout_released(ssl, Config). + +ossl_block_non_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "non distribing means ongoing requests should be completed. " + "When the timeout occurs the block operation sohould be canceled." + "Using new of configure old SSL"]; +ossl_block_non_disturbing_active_timeout_released(suite) -> + []; +ossl_block_non_disturbing_active_timeout_released(Config) + when is_list(Config) -> + ssl_block_non_disturbing_active_timeout_released(ossl, Config). + +essl_block_non_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "non distribing means ongoing requests should be completed. " + "When the timeout occurs the block operation sohould be canceled." + "Using new of configure new SSL"]; +essl_block_non_disturbing_active_timeout_released(suite) -> + []; +essl_block_non_disturbing_active_timeout_released(Config) + when is_list(Config) -> + ssl_block_non_disturbing_active_timeout_released(essl, Config). + +ssl_block_non_disturbing_active_timeout_released(Tag, Config) + when is_list(Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_non_disturbing_active_timeout_released(Tag, + Port, + Host, + Node), + ok. + %%------------------------------------------------------------------------- -ssl_block_disturbing_blocker_dies(doc) -> + +pssl_block_disturbing_blocker_dies(doc) -> + ["old SSL config"]; +pssl_block_disturbing_blocker_dies(suite) -> + []; +pssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_disturbing_blocker_dies(ssl, Config). + +ossl_block_disturbing_blocker_dies(doc) -> + ["using new of configure old SSL"]; +ossl_block_disturbing_blocker_dies(suite) -> []; -ssl_block_disturbing_blocker_dies(suite) -> +ossl_block_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_disturbing_blocker_dies(ossl, Config). + +essl_block_disturbing_blocker_dies(doc) -> + ["using new of configure new SSL"]; +essl_block_disturbing_blocker_dies(suite) -> []; -ssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - httpd_block:disturbing_blocker_dies(ssl, ?SSL_PORT, +essl_block_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_disturbing_blocker_dies(essl, Config). + +ssl_block_disturbing_blocker_dies(Tag, Config) -> + httpd_block:disturbing_blocker_dies(Tag, + ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_block_non_disturbing_blocker_dies(doc) -> + +pssl_block_non_disturbing_blocker_dies(doc) -> + ["old SSL config"]; +pssl_block_non_disturbing_blocker_dies(suite) -> + []; +pssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_non_disturbing_blocker_dies(ssl, Config). + +ossl_block_non_disturbing_blocker_dies(doc) -> + ["using new of configure old SSL"]; +ossl_block_non_disturbing_blocker_dies(suite) -> []; -ssl_block_non_disturbing_blocker_dies(suite) -> +ossl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_non_disturbing_blocker_dies(ossl, Config). + +essl_block_non_disturbing_blocker_dies(doc) -> + ["using new of configure new SSL"]; +essl_block_non_disturbing_blocker_dies(suite) -> []; -ssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - httpd_block:non_disturbing_blocker_dies(ssl, ?SSL_PORT, +essl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_non_disturbing_blocker_dies(essl, Config). + +ssl_block_non_disturbing_blocker_dies(Tag, Config) -> + httpd_block:non_disturbing_blocker_dies(Tag, + ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_restart_no_block(doc) -> - [""]; -ssl_restart_no_block(suite) -> + +pssl_restart_no_block(doc) -> + ["old SSL config"]; +pssl_restart_no_block(suite) -> + []; +pssl_restart_no_block(Config) when is_list(Config) -> + ssl_restart_no_block(ssl, Config). + +ossl_restart_no_block(doc) -> + ["using new of configure old SSL"]; +ossl_restart_no_block(suite) -> []; -ssl_restart_no_block(Config) when is_list(Config) -> - httpd_block:restart_no_block(ssl, ?SSL_PORT, ?config(host, Config), +ossl_restart_no_block(Config) when is_list(Config) -> + ssl_restart_no_block(ossl, Config). + +essl_restart_no_block(doc) -> + ["using new of configure new SSL"]; +essl_restart_no_block(suite) -> + []; +essl_restart_no_block(Config) when is_list(Config) -> + ssl_restart_no_block(essl, Config). + +ssl_restart_no_block(Tag, Config) -> + httpd_block:restart_no_block(Tag, + ?SSL_PORT, + ?config(host, Config), ?config(node, Config)), ok. + + %%------------------------------------------------------------------------- -ssl_restart_disturbing_block(doc) -> - [""]; -ssl_restart_disturbing_block(suite) -> + +pssl_restart_disturbing_block(doc) -> + ["old SSL config"]; +pssl_restart_disturbing_block(suite) -> + []; +pssl_restart_disturbing_block(Config) when is_list(Config) -> + ssl_restart_disturbing_block(ssl, Config). + +ossl_restart_disturbing_block(doc) -> + ["using new of configure old SSL"]; +ossl_restart_disturbing_block(suite) -> []; -ssl_restart_disturbing_block(Config) when is_list(Config) -> +ossl_restart_disturbing_block(Config) when is_list(Config) -> + ssl_restart_disturbing_block(ossl, Config). + +essl_restart_disturbing_block(doc) -> + ["using new of configure new SSL"]; +essl_restart_disturbing_block(suite) -> + []; +essl_restart_disturbing_block(Config) when is_list(Config) -> + ssl_restart_disturbing_block(essl, Config). + +ssl_restart_disturbing_block(Tag, Config) -> %% <CONDITIONAL-SKIP> Condition = fun() -> @@ -1336,17 +2290,36 @@ ssl_restart_disturbing_block(Config) when is_list(Config) -> ?NON_PC_TC_MAYBE_SKIP(Config, Condition), %% </CONDITIONAL-SKIP> - httpd_block:restart_disturbing_block(ssl, ?SSL_PORT, + httpd_block:restart_disturbing_block(Tag, ?SSL_PORT, ?config(host, Config), ?config(node, Config)), ok. + %%------------------------------------------------------------------------- -ssl_restart_non_disturbing_block(doc) -> - [""]; -ssl_restart_non_disturbing_block(suite) -> + +pssl_restart_non_disturbing_block(doc) -> + ["old SSL config"]; +pssl_restart_non_disturbing_block(suite) -> []; -ssl_restart_non_disturbing_block(Config) when is_list(Config) -> +pssl_restart_non_disturbing_block(Config) when is_list(Config) -> + ssl_restart_non_disturbing_block(ssl, Config). + +ossl_restart_non_disturbing_block(doc) -> + ["using new of configure old SSL"]; +ossl_restart_non_disturbing_block(suite) -> + []; +ossl_restart_non_disturbing_block(Config) when is_list(Config) -> + ssl_restart_non_disturbing_block(ossl, Config). + +essl_restart_non_disturbing_block(doc) -> + ["using new of configure new SSL"]; +essl_restart_non_disturbing_block(suite) -> + []; +essl_restart_non_disturbing_block(Config) when is_list(Config) -> + ssl_restart_non_disturbing_block(essl, Config). + +ssl_restart_non_disturbing_block(Tag, Config) -> %% <CONDITIONAL-SKIP> Condition = fun() -> @@ -1371,11 +2344,13 @@ ssl_restart_non_disturbing_block(Config) when is_list(Config) -> ?NON_PC_TC_MAYBE_SKIP(Config, Condition), %% </CONDITIONAL-SKIP> - httpd_block:restart_non_disturbing_block(ssl, ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), + httpd_block:restart_non_disturbing_block(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), ok. + %%------------------------------------------------------------------------- ip_host(doc) -> ["Control that the server accepts/rejects requests with/ without host"]; @@ -1665,17 +2640,29 @@ dos_hostname(Type, Port, Host, Node, Max) -> %% Other help functions create_config(Config, Access, FileName) -> ServerRoot = ?config(server_root, Config), - TcTopDir = ?config(tc_top_dir, Config), - Port = ?config(port, Config), - Type = ?config(sock_type, Config), - Host = ?config(host, Config), - Mods = io_lib:format("~p", [httpd_mod]), - Funcs = io_lib:format("~p", [ssl_password_cb]), - MaxHdrSz = io_lib:format("~p", [256]), - MaxHdrAct = io_lib:format("~p", [close]), + TcTopDir = ?config(tc_top_dir, Config), + Port = ?config(port, Config), + Type = ?config(sock_type, Config), + Host = ?config(host, Config), + Mods = io_lib:format("~p", [httpd_mod]), + Funcs = io_lib:format("~p", [ssl_password_cb]), + MaxHdrSz = io_lib:format("~p", [256]), + MaxHdrAct = io_lib:format("~p", [close]), + + io:format(user, + "create_config -> " + "~n ServerRoot: ~p" + "~n TcTopDir: ~p" + "~n Type: ~p" + "~n Port: ~p" + "~n Host: ~p" + "~n", [ServerRoot, TcTopDir, Port, Type, Host]), + SSL = - case Type of - ssl -> + if + (Type =:= ssl) orelse + (Type =:= ossl) orelse + (Type =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), cline(["SSLCertificateKeyFile ", @@ -1686,25 +2673,25 @@ create_config(Config, Access, FileName) -> cline(["SSLPasswordCallbackFunction ", Funcs]), cline(["SSLVerifyClient 0"]), cline(["SSLVerifyDepth 1"])]; - _ -> + true -> [] end, - Mod_order = case Access of - mod_htaccess -> - "Modules mod_alias mod_htaccess mod_auth " - "mod_security " - "mod_responsecontrol mod_trace mod_esi " - "mod_actions mod_cgi mod_include mod_dir " - "mod_range mod_get " - "mod_head mod_log mod_disk_log"; - _ -> - "Modules mod_alias mod_auth mod_security " - "mod_responsecontrol mod_trace mod_esi " - "mod_actions mod_cgi mod_include mod_dir " - "mod_range mod_get " - "mod_head mod_log mod_disk_log" - end, - + ModOrder = case Access of + mod_htaccess -> + "Modules mod_alias mod_htaccess mod_auth " + "mod_security " + "mod_responsecontrol mod_trace mod_esi " + "mod_actions mod_cgi mod_include mod_dir " + "mod_range mod_get " + "mod_head mod_log mod_disk_log"; + _ -> + "Modules mod_alias mod_auth mod_security " + "mod_responsecontrol mod_trace mod_esi " + "mod_actions mod_cgi mod_include mod_dir " + "mod_range mod_get " + "mod_head mod_log mod_disk_log" + end, + %% The test suite currently does not handle an explicit BindAddress. %% They assume any has been used, that is Addr is always set to undefined! @@ -1720,7 +2707,7 @@ create_config(Config, Access, FileName) -> cline(["Port ", integer_to_list(Port)]), cline(["ServerName ", Host]), cline(["SocketType ", atom_to_list(Type)]), - cline([Mod_order]), + cline([ModOrder]), %% cline(["LogFormat ", "erlang"]), cline(["ServerAdmin [email protected]"]), cline(["BindAddress ", BindAddress]), @@ -1882,18 +2869,18 @@ start_mnesia(Node) -> ok -> ok; Other -> - test_server:fail({failed_to_cleanup_mnesia, Other}) + tsf({failed_to_cleanup_mnesia, Other}) end, - case rpc:call(Node, ?MODULE, setup_mnesia, []) of + case rpc:call(Node, ?MODULE, setup_mnesia, []) of {atomic, ok} -> ok; Other2 -> - test_server:fail({failed_to_setup_mnesia, Other2}) + tsf({failed_to_setup_mnesia, Other2}) end, ok. setup_mnesia() -> - setup_mnesia([node()]). + setup_mnesia([node()]). setup_mnesia(Nodes) -> ok = mnesia:create_schema(Nodes), @@ -2029,20 +3016,20 @@ dos_hostname_request(Host) -> get_nof_clients(Mode, Load) -> get_nof_clients(test_server:os_type(), Mode, Load). -get_nof_clients(vxworks, _, light) -> 1; +get_nof_clients(vxworks, _, light) -> 1; get_nof_clients(vxworks, ip_comm, medium) -> 3; -get_nof_clients(vxworks, ssl, medium) -> 3; +get_nof_clients(vxworks, ssl, medium) -> 3; get_nof_clients(vxworks, ip_comm, heavy) -> 5; -get_nof_clients(vxworks, ssl, heavy) -> 5; -get_nof_clients(_, ip_comm, light) -> 5; -get_nof_clients(_, ssl, light) -> 2; -get_nof_clients(_, ip_comm, medium) -> 10; -get_nof_clients(_, ssl, medium) -> 4; -get_nof_clients(_, ip_comm, heavy) -> 20; -get_nof_clients(_, ssl, heavy) -> 6. +get_nof_clients(vxworks, ssl, heavy) -> 5; +get_nof_clients(_, ip_comm, light) -> 5; +get_nof_clients(_, ssl, light) -> 2; +get_nof_clients(_, ip_comm, medium) -> 10; +get_nof_clients(_, ssl, medium) -> 4; +get_nof_clients(_, ip_comm, heavy) -> 20; +get_nof_clients(_, ssl, heavy) -> 6. %% Make a file 100 bytes long containing 012...9*10 -create_range_data(Path)-> +create_range_data(Path) -> PathAndFileName=filename:join([Path,"range.txt"]), file:write_file(PathAndFileName,list_to_binary(["12345678901234567890", "12345678901234567890", @@ -2079,3 +3066,6 @@ create_range_data(Path)-> %% {ok, Fd} = file:open(ConfigFile, [write]), %% ok = file:write(Fd, lists:flatten(HttpConfig)), %% ok = file:close(Fd). + +tsf(Reason) -> + test_server:fail(Reason). diff --git a/lib/inets/test/httpd_SUITE_data/server_root/Makefile b/lib/inets/test/httpd_SUITE_data/server_root/Makefile new file mode 100644 index 0000000000..d7a3231068 --- /dev/null +++ b/lib/inets/test/httpd_SUITE_data/server_root/Makefile @@ -0,0 +1,209 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(INETS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +MODULE= + +AUTH_FILES = auth/group \ + auth/passwd +CGI_FILES = cgi-bin/printenv.sh +CONF_FILES = conf/8080.conf \ + conf/8888.conf \ + conf/httpd.conf \ + conf/ssl.conf \ + conf/mime.types +OPEN_FILES = htdocs/open/dummy.html +MNESIA_OPEN_FILES = htdocs/mnesia_open/dummy.html +MISC_FILES = htdocs/misc/friedrich.html \ + htdocs/misc/oech.html +SECRET_FILES = htdocs/secret/dummy.html +MNESIA_SECRET_FILES = htdocs/mnesia_secret/dummy.html +HTDOCS_FILES = htdocs/index.html \ + htdocs/config.shtml \ + htdocs/echo.shtml \ + htdocs/exec.shtml \ + htdocs/flastmod.shtml \ + htdocs/fsize.shtml \ + htdocs/include.shtml +ICON_FILES = icons/README \ + icons/a.gif \ + icons/alert.black.gif \ + icons/alert.red.gif \ + icons/apache_pb.gif \ + icons/back.gif \ + icons/ball.gray.gif \ + icons/ball.red.gif \ + icons/binary.gif \ + icons/binhex.gif \ + icons/blank.gif \ + icons/bomb.gif \ + icons/box1.gif \ + icons/box2.gif \ + icons/broken.gif \ + icons/burst.gif \ + icons/button1.gif \ + icons/button10.gif \ + icons/button2.gif \ + icons/button3.gif \ + icons/button4.gif \ + icons/button5.gif \ + icons/button6.gif \ + icons/button7.gif \ + icons/button8.gif \ + icons/button9.gif \ + icons/buttonl.gif \ + icons/buttonr.gif \ + icons/c.gif \ + icons/comp.blue.gif \ + icons/comp.gray.gif \ + icons/compressed.gif \ + icons/continued.gif \ + icons/dir.gif \ + icons/down.gif \ + icons/dvi.gif \ + icons/f.gif \ + icons/folder.gif \ + icons/folder.open.gif \ + icons/folder.sec.gif \ + icons/forward.gif \ + icons/generic.gif \ + icons/generic.red.gif \ + icons/generic.sec.gif \ + icons/hand.right.gif \ + icons/hand.up.gif \ + icons/htdig.gif \ + icons/icon.sheet.gif \ + icons/image1.gif \ + icons/image2.gif \ + icons/image3.gif \ + icons/index.gif \ + icons/layout.gif \ + icons/left.gif \ + icons/link.gif \ + icons/movie.gif \ + icons/p.gif \ + icons/patch.gif \ + icons/pdf.gif \ + icons/pie0.gif \ + icons/pie1.gif \ + icons/pie2.gif \ + icons/pie3.gif \ + icons/pie4.gif \ + icons/pie5.gif \ + icons/pie6.gif \ + icons/pie7.gif \ + icons/pie8.gif \ + icons/portal.gif \ + icons/poweredby.gif \ + icons/ps.gif \ + icons/quill.gif \ + icons/right.gif \ + icons/screw1.gif \ + icons/screw2.gif \ + icons/script.gif \ + icons/sound1.gif \ + icons/sound2.gif \ + icons/sphere1.gif \ + icons/sphere2.gif \ + icons/star.gif \ + icons/star_blank.gif \ + icons/tar.gif \ + icons/tex.gif \ + icons/text.gif \ + icons/transfer.gif \ + icons/unknown.gif \ + icons/up.gif \ + icons/uu.gif \ + icons/uuencoded.gif \ + icons/world1.gif \ + icons/world2.gif + +SSL_FILES = ssl/ssl_client.pem \ + ssl/ssl_server.pem + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: + +clean: + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/auth + $(INSTALL_DATA) $(AUTH_FILES) $(RELSYSDIR)/examples/server_root/auth + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/cgi-bin + $(INSTALL_SCRIPT) $(CGI_FILES) $(RELSYSDIR)/examples/server_root/cgi-bin + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/conf + $(INSTALL_DATA) $(CONF_FILES) $(RELSYSDIR)/examples/server_root/conf + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/open + $(INSTALL_DATA) $(OPEN_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/open + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open + $(INSTALL_DATA) $(MNESIA_OPEN_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/misc + $(INSTALL_DATA) $(MISC_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/misc + $(INSTALL_DIR) \ + $(RELSYSDIR)/examples/server_root/htdocs/secret/top_secret + $(INSTALL_DIR) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret/top_secret + $(INSTALL_DATA) $(SECRET_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/secret + $(INSTALL_DATA) $(MNESIA_SECRET_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs + $(INSTALL_DATA) $(HTDOCS_FILES) $(RELSYSDIR)/examples/server_root/htdocs + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/icons + $(INSTALL_DATA) $(ICON_FILES) $(RELSYSDIR)/examples/server_root/icons + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/ssl + $(INSTALL_DATA) $(SSL_FILES) $(RELSYSDIR)/examples/server_root/ssl + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/logs + +release_docs_spec: + diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl index f967d8172a..ac1bf43ff5 100644 --- a/lib/inets/test/httpd_block.erl +++ b/lib/inets/test/httpd_block.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -36,6 +36,7 @@ ]). %% Help functions +-export([httpd_block/3, httpd_block/4, httpd_unblock/2, httpd_restart/2]). -export([do_block_server/4, do_block_nd_server/5, do_long_poll/6]). -define(report(Label, Content), @@ -47,18 +48,24 @@ %% Test cases starts here. %%------------------------------------------------------------------------- block_disturbing_idle(_Type, Port, Host, Node) -> - unblocked = get_admin_state(Node, Host, Port), + io:format("block_disturbing_idle -> entry~n", []), + validate_admin_state(Node, Host, Port, unblocked), block_server(Node, Host, Port), - blocked = get_admin_state(Node, Host, Port), + validate_admin_state(Node, Host, Port, blocked), unblock_server(Node, Host, Port), - unblocked = get_admin_state(Node, Host, Port). + validate_admin_state(Node, Host, Port, unblocked), + io:format("block_disturbing_idle -> done~n", []), + ok. + %%-------------------------------------------------------------------- block_non_disturbing_idle(_Type, Port, Host, Node) -> unblocked = get_admin_state(Node, Host, Port), block_nd_server(Node, Host, Port), blocked = get_admin_state(Node, Host, Port), unblock_server(Node, Host, Port), - unblocked = get_admin_state(Node, Host, Port). + unblocked = get_admin_state(Node, Host, Port), + ok. + %%-------------------------------------------------------------------- block_503(Type, Port, Host, Node) -> Req = "GET / HTTP/1.0\r\ndummy-host.ericsson.se:\r\n\r\n", @@ -76,6 +83,7 @@ block_503(Type, Port, Host, Node) -> ok = httpd_test_lib:verify_request(Type, Host, Port, Node, Req, [{statuscode, 200}, {version, "HTTP/1.0"}]). + %%-------------------------------------------------------------------- block_disturbing_active(Type, Port, Host, Node) -> process_flag(trap_exit, true), @@ -87,6 +95,7 @@ block_disturbing_active(Type, Port, Host, Node) -> blocked = get_admin_state(Node, Host, Port), process_flag(trap_exit, false), ok. + %%-------------------------------------------------------------------- block_non_disturbing_active(Type, Port, Host, Node) -> process_flag(trap_exit, true), @@ -219,32 +228,91 @@ do_block_nd_server(Node, Host, Port, Timeout, Reply) -> restart_server(Node, _Host, Port) -> Addr = undefined, - rpc:call(Node, httpd, restart, [Addr, Port]). + rpc:call(Node, ?MODULE, httpd_restart, [Addr, Port]). + block_server(Node, _Host, Port) -> + io:format("block_server -> entry~n", []), Addr = undefined, - rpc:call(Node, httpd, block, [Addr, Port]). + rpc:call(Node, ?MODULE, httpd_block, [Addr, Port, disturbing]). + block_server(Node, _Host, Port, Timeout) -> Addr = undefined, - rpc:call(Node, httpd, block, [Addr, Port, disturbing, Timeout]). + rpc:call(Node, ?MODULE, httpd_block, [Addr, Port, disturbing, Timeout]). + block_nd_server(Node, _Host, Port) -> Addr = undefined, - rpc:call(Node, httpd, block, [Addr, Port, non_disturbing]). + rpc:call(Node, ?MODULE, httpd_block, [Addr, Port, non_disturbing]). block_nd_server(Node, _Host, Port, Timeout) -> Addr = undefined, - rpc:call(Node, httpd, block, [Addr, Port, non_disturbing, Timeout]). + rpc:call(Node, ?MODULE, httpd_block, [Addr, Port, non_disturbing, Timeout]). unblock_server(Node, _Host, Port) -> + io:format("~p:~p:block_server -> entry~n", [node(),self()]), Addr = undefined, - rpc:call(Node, httpd, unblock, [Addr, Port]). + rpc:call(Node, ?MODULE, httpd_unblock, [Addr, Port]). + + +httpd_block(Addr, Port, Mode) -> + io:format("~p:~p:httpd_block -> entry~n", [node(),self()]), + Name = make_name(Addr, Port), + case whereis(Name) of + Pid when is_pid(Pid) -> + httpd_manager:block(Pid, Mode); + _ -> + {error, not_started} + end. + +httpd_block(Addr, Port, Mode, Timeout) -> + Name = make_name(Addr, Port), + case whereis(Name) of + Pid when is_pid(Pid) -> + httpd_manager:block(Pid, Mode, Timeout); + _ -> + {error, not_started} + end. + +httpd_unblock(Addr, Port) -> + io:format("~p:~p:httpd_unblock -> entry~n", [node(),self()]), + Name = make_name(Addr, Port), + case whereis(Name) of + Pid when is_pid(Pid) -> + httpd_manager:unblock(Pid); + _ -> + {error, not_started} + end. + +httpd_restart(Addr, Port) -> + Name = make_name(Addr, Port), + case whereis(Name) of + Pid when is_pid(Pid) -> + httpd_manager:reload(Pid, undefined); + _ -> + {error, not_started} + end. + +make_name(Addr, Port) -> + httpd_util:make_name("httpd", Addr, Port). -get_admin_state(Node,_Host,Port) -> +get_admin_state(Node, _Host, Port) -> Addr = undefined, rpc:call(Node, httpd, get_admin_state, [Addr, Port]). +validate_admin_state(Node, Host, Port, Expect) -> + io:format("try validating server admin state: ~p~n", [Expect]), + case get_admin_state(Node, Host, Port) of + Expect -> + ok; + Unexpected -> + io:format("failed validating server admin state: ~p~n", + [Unexpected]), + exit({unexpected_admin_state, Unexpected, Expect}) + end. + + await_normal_process_exit(Pid, Name, Timeout) -> receive {'EXIT', Pid, normal} -> @@ -260,6 +328,7 @@ await_normal_process_exit(Pid, Name, Timeout) -> test_server:fail("timeout while waiting for " ++ Name) end. + await_suite_failed_process_exit(Pid, Name, Timeout, Why) -> receive {'EXIT', Pid, {suite_failed, Why}} -> diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index b03f842e7c..f2c1fd6a65 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -40,6 +40,13 @@ %% Test cases starts here. %%------------------------------------------------------------------------- alias(Type, Port, Host, Node) -> +%% io:format(user, "~w:alias -> entry with" +%% "~n Type: ~p" +%% "~n Port: ~p" +%% "~n Host: ~p" +%% "~n Node: ~p" +%% "~n", [?MODULE, Type, Port, Host, Node]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /pics/icon.sheet.gif " "HTTP/1.0\r\n\r\n", @@ -82,14 +89,15 @@ actions(Type, Port, Host, Node) -> %%------------------------------------------------------------------------- security(ServerRoot, Type, Port, Host, Node) -> - io:format(user, "~w:security -> entry with" - "~n ServerRoot: ~p" - "~n Type: ~p" - "~n Port: ~p" - "~n Host: ~p" - "~n Node: ~p" - "~n", [?MODULE, ServerRoot, Type, Port, Host, Node]), +%% io:format(user, "~w:security -> entry with" +%% "~n ServerRoot: ~p" +%% "~n Type: ~p" +%% "~n Port: ~p" +%% "~n Host: ~p" +%% "~n Node: ~p" +%% "~n", [?MODULE, ServerRoot, Type, Port, Host, Node]), +%% io:format(user, "~w:security -> register~n", [?MODULE]), global:register_name(mod_security_test, self()), % Receive events test_server:sleep(5000), @@ -99,54 +107,71 @@ security(ServerRoot, Type, Port, Host, Node) -> %% Test blocking / unblocking of users. %% /open, require user one Aladdin +%% io:format(user, "~w:security -> remove user~n", [?MODULE]), remove_users(Node, ServerRoot, Host, Port, "open"), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node, "/open/", "one", "onePassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> await fail security event~n", [?MODULE]), receive_security_event({event, auth_fail, Port, OpenDir, [{user, "one"}, {password, "onePassword"}]}, Node, Port), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type,Host,Port,Node,"/open/", "two", "twoPassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> await fail security event~n", [?MODULE]), receive_security_event({event, auth_fail, Port, OpenDir, [{user, "two"}, {password, "twoPassword"}]}, Node, Port), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "Aladdin", "AladdinPassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> await fail security event~n", [?MODULE]), receive_security_event({event, auth_fail, Port, OpenDir, [{user, "Aladdin"}, {password, "AladdinPassword"}]}, Node, Port), +%% io:format(user, "~w:security -> add users~n", [?MODULE]), add_user(Node, ServerRoot, Port, "open", "one", "onePassword", []), add_user(Node, ServerRoot, Port, "open", "two", "twoPassword", []), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "one", "WrongPassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> await fail security event~n", [?MODULE]), receive_security_event({event, auth_fail, Port, OpenDir, [{user, "one"}, {password, "WrongPassword"}]}, Node, Port), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "one", "WrongPassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> await fail security event~n", [?MODULE]), receive_security_event({event, auth_fail, Port, OpenDir, [{user, "one"}, {password, "WrongPassword"}]}, Node, Port), +%% io:format(user, "~w:security -> await block security event~n", [?MODULE]), receive_security_event({event, user_block, Port, OpenDir, [{user, "one"}]}, Node, Port), +%% io:format(user, "~w:security -> unregister~n", [?MODULE]), global:unregister_name(mod_security_test), % No more events. +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "one", "WrongPassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "one", "onePassword", [{statuscode, 403}]), %% User "one" should be blocked now.. %% [{"one",_, Port, OpenDir,_}] = list_blocked_users(Node,Port), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), case list_blocked_users(Node, Port) of [{"one",_, Port, OpenDir,_}] -> ok; @@ -156,35 +181,54 @@ security(ServerRoot, Type, Port, Host, Node) -> exit({unexpected_blocked, Blocked}) end, +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), [{"one",_, Port, OpenDir,_}] = list_blocked_users(Node,Port,OpenDir), +%% io:format(user, "~w:security -> unblock user~n", [?MODULE]), true = unblock_user(Node, "one", Port, OpenDir), %% User "one" should not be blocked any more.. +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), [] = list_blocked_users(Node, Port), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), [] = list_blocked_users(Node, Port, OpenDir), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "one", "onePassword", [{statuscode, 200}]), %% Test list_auth_users & auth_timeout +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), ["one"] = list_auth_users(Node, Port), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), ["one"] = list_auth_users(Node, Port, OpenDir), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "two", "onePassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), ["one"] = list_auth_users(Node, Port), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), ["one"] = list_auth_users(Node, Port, OpenDir), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "two", "twoPassword", [{statuscode, 401}]), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), ["one"] = list_auth_users(Node, Port), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), ["one"] = list_auth_users(Node, Port, OpenDir), %% Wait for successful auth to timeout. test_server:sleep(?AUTH_TIMEOUT*1001), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), [] = list_auth_users(Node, Port), +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), [] = list_auth_users(Node, Port, OpenDir), %% "two" is blocked. +%% io:format(user, "~w:security -> unblock user~n", [?MODULE]), true = unblock_user(Node, "two", Port, OpenDir), %% Test explicit blocking. Block user 'two'. +%% io:format(user, "~w:security -> list blocked users~n", [?MODULE]), [] = list_blocked_users(Node,Port,OpenDir), +%% io:format(user, "~w:security -> block user~n", [?MODULE]), true = block_user(Node, "two", Port, OpenDir, 10), +%% io:format(user, "~w:security -> auth request~n", [?MODULE]), auth_request(Type, Host, Port, Node,"/open/", "two", "twoPassword", [{statuscode, 401}]). @@ -600,6 +644,11 @@ htaccess(Type, Port, Host, Node) -> {header, "WWW-Authenticate"}]). %%-------------------------------------------------------------------- cgi(Type, Port, Host, Node) -> +%% tsp("cgi -> entry with" +%% "~n Type: ~p" +%% "~n Port: ~p" +%% "~n Host: ~p" +%% "~n Node: ~p", []), {Script, Script2, Script3} = case test_server:os_type() of {win32, _} -> @@ -609,6 +658,7 @@ cgi(Type, Port, Host, Node) -> end, %% The length (> 100) is intentional +%% tsp("cgi -> request 01 with length > 100"), ok = httpd_test_lib: verify_request(Type, Host, Port, Node, "POST /cgi-bin/" ++ Script3 ++ @@ -636,46 +686,55 @@ cgi(Type, Port, Host, Node) -> {version, "HTTP/1.0"}, {header, "content-type", "text/plain"}]), +%% tsp("cgi -> request 02"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /cgi-bin/"++ Script ++ " HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 03"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /cgi-bin/not_there " "HTTP/1.0\r\n\r\n", [{statuscode, 404},{statuscode, 500}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 04"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /cgi-bin/"++ Script ++ "?Nisse:kkk?sss/lll HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 04"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "POST /cgi-bin/"++ Script ++ " HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 05"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /htbin/"++ Script ++ " HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 06"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /htbin/not_there " "HTTP/1.0\r\n\r\n", [{statuscode, 404},{statuscode, 500}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 07"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET /htbin/"++ Script ++ "?Nisse:kkk?sss/lll HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 08"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "POST /htbin/"++ Script ++ " HTTP/1.0\r\n\r\n", [{statuscode, 200}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 09"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "POST /htbin/"++ Script ++ " HTTP/1.0\r\n\r\n", @@ -683,19 +742,24 @@ cgi(Type, Port, Host, Node) -> {version, "HTTP/1.0"}]), %% Execute an existing, but bad CGI script.. +%% tsp("cgi -> request 10 - bad script"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "POST /htbin/"++ Script2 ++ " HTTP/1.0\r\n\r\n", [{statuscode, 404}, {version, "HTTP/1.0"}]), +%% tsp("cgi -> request 11 - bad script"), ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "POST /cgi-bin/"++ Script2 ++ " HTTP/1.0\r\n\r\n", [{statuscode, 404}, {version, "HTTP/1.0"}]), + +%% tsp("cgi -> done"), ok. + %%-------------------------------------------------------------------- esi(Type, Port, Host, Node) -> %% Check "ErlScriptAlias" and "EvalScriptAlias" directives @@ -850,25 +914,44 @@ list_users(Node, Root, _Host, Port, Dir) -> Directory = filename:join([Root, "htdocs", Dir]), rpc:call(Node, mod_auth, list_users, [Addr, Port, Directory]). + receive_security_event(Event, Node, Port) -> - io:format(user, "~w:receive_security_event -> entry with" - "~n Event: ~p" - "~n Node: ~p" - "~n Port: ~p" - "~n", [?MODULE, Event, Node, Port]), +%% io:format(user, "~w:receive_security_event -> entry with" +%% "~n Event: ~p" +%% "~n Node: ~p" +%% "~n Port: ~p" +%% "~n", [?MODULE, Event, Node, Port]), receive Event -> ok; {'EXIT', _, _} -> - receive_security_event(Event, Node, Port); - Other -> - test_server:fail({unexpected_event, - {expected, Event}, {received, Other}}) + receive_security_event(Event, Node, Port) after 5000 -> - test_server:fail(no_event_recived) + %% Flush the message queue, to see if we got something... + Msgs = inets_test_lib:flush(), + tsf({expected_event_not_received, Msgs}) end. +%% receive_security_event(Event, Node, Port) -> +%% io:format(user, "~w:receive_security_event -> entry with" +%% "~n Event: ~p" +%% "~n Node: ~p" +%% "~n Port: ~p" +%% "~n", [?MODULE, Event, Node, Port]), +%% receive +%% Event -> +%% ok; +%% {'EXIT', _, _} -> +%% receive_security_event(Event, Node, Port); +%% Other -> +%% test_server:fail({unexpected_event, +%% {expected, Event}, {received, Other}}) +%% after 5000 -> +%% test_server:fail(no_event_recived) + +%% end. + list_blocked_users(Node,Port) -> Addr = undefined, % Assumed to be on the same host rpc:call(Node, mod_security, list_blocked_users, [Addr,Port]). @@ -945,3 +1028,12 @@ check_lists_members1(L,L) -> ok; check_lists_members1(L1,L2) -> {error,{lists_not_equal,L1,L2}}. + + +%% tsp(F) -> +%% tsp(F, []). +%% tsp(F, A) -> +%% test_server:format("~p ~p:" ++ F ++ "~n", [self(), ?MODULE | A]). + +tsf(Reason) -> + test_server:fail(Reason). diff --git a/lib/inets/test/httpd_poll.erl b/lib/inets/test/httpd_poll.erl index 1cc10365a7..32335cabcf 100644 --- a/lib/inets/test/httpd_poll.erl +++ b/lib/inets/test/httpd_poll.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @@ -27,7 +27,8 @@ %% gen_server exports -export([init/1, - handle_call/3, handle_cast/2, handle_info/2, terminate/2]). + handle_call/3, handle_cast/2, handle_info/2, terminate/2, + code_change/3]). -define(default_verbosity,error). @@ -86,8 +87,8 @@ options(Options) -> options([], Defaults, Options) -> Options ++ Defaults; -options([{Key,Val} = Opt|Opts], Defaults, Options) -> - options(Opts, lists:keydelete(Key, 1, Defaults), [Opt|Options]). +options([{Key, _Val} = Opt|Opts], Defaults, Options) -> + options(Opts, lists:keydelete(Key, 1, Defaults), [Opt | Options]). verbosity(silence) -> @@ -134,10 +135,9 @@ uris(otp) -> uri_top_index(), uri_internal_product1(), uri_internal_product2(), - uri_p7a_test_results(), + uri_r13b03_test_results(), uri_bjorn1(), - uri_bjorn2(), - uri_top_ronja() + uri_bjorn2() ]. uri_top_index() -> @@ -149,9 +149,9 @@ uri_internal_product1() -> uri_internal_product2() -> {"product internal page (2)","/product/internal"}. -uri_p7a_test_results() -> - {"test summery index page", - "/product/internal/test/test_results/progress_P7A/index.html"}. +uri_r13b03_test_results() -> + {"daily build index page", + "/product/internal/test/daily/logs.html"}. uri_bjorn1() -> {"bjorns home page (1)","/~bjorn/"}. @@ -159,9 +159,6 @@ uri_bjorn1() -> uri_bjorn2() -> {"bjorns home page (2)","/~bjorn"}. -uri_top_ronja() -> - {"ronja top page","/ronja/"}. - handle_call(stop, _From, State) -> vlog("stop request"), @@ -199,7 +196,11 @@ handle_info(Info, State) -> {noreply, State}. -terminate(Reason,State) -> +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + + +terminate(_Reason, State) -> tcancel(State#state.tref), log_close(get(log_file)), ok. @@ -287,16 +288,16 @@ trash_the_rest(Socket,N) -> end. -add(N1,N2) when integer(N1),integer(N2) -> +add(N1, N2) when is_integer(N1) andalso is_integer(N2) -> N1 + N2; -add(N1,N2) when integer(N1) -> +add(N1, _N2) when is_integer(N1) -> N1; -add(N1,N2) when integer(N2) -> +add(_N1, N2) when is_integer(N2) -> N2. -sz(L) when list(L) -> +sz(L) when is_list(L) -> length(lists:flatten(L)); -sz(B) when binary(B) -> +sz(B) when is_binary(B) -> size(B); sz(O) -> {unknown_size,O}. @@ -307,9 +308,9 @@ sz(O) -> %% Status code to printable string %% -status_to_message(L) when list(L) -> +status_to_message(L) when is_list(L) -> case (catch list_to_integer(L)) of - I when integer(I) -> + I when is_integer(I) -> status_to_message(I); _ -> io_lib:format("UNKNOWN STATUS CODE: '~p'",[L]) @@ -470,12 +471,12 @@ vlog(F,A) -> vprint(get(verbosity),log,F,A). verror(F) -> vprint(get(verbosity),error,F,[]). verror(F,A) -> vprint(get(verbosity),error,F,A). -vprint(trace,Severity,F,A) -> vprint(Severity,F,A); -vprint(debug,trace,F,A) -> ok; -vprint(debug,Severity,F,A) -> vprint(Severity,F,A); -vprint(log,log,F,A) -> vprint(log,F,A); -vprint(log,error,F,A) -> vprint(log,F,A); -vprint(error,error,F,A) -> vprint(error,F,A); +vprint(trace, Severity, F, A) -> vprint(Severity,F,A); +vprint(debug, trace, _F, _A) -> ok; +vprint(debug, Severity, F, A) -> vprint(Severity,F,A); +vprint(log, log, F, A) -> vprint(log,F,A); +vprint(log, error, F, A) -> vprint(log,F,A); +vprint(error, error, F, A) -> vprint(error,F,A); vprint(_Verbosity,_Severity,_F,_A) -> ok. vprint(Severity,F,A) -> @@ -491,6 +492,3 @@ image_of(trace) -> "TRC: ". local_time() -> calendar:local_time(). - - - diff --git a/lib/inets/test/httpd_test_data/server_root/Makefile b/lib/inets/test/httpd_test_data/server_root/Makefile new file mode 100644 index 0000000000..d7a3231068 --- /dev/null +++ b/lib/inets/test/httpd_test_data/server_root/Makefile @@ -0,0 +1,209 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(INETS_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/inets-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +MODULE= + +AUTH_FILES = auth/group \ + auth/passwd +CGI_FILES = cgi-bin/printenv.sh +CONF_FILES = conf/8080.conf \ + conf/8888.conf \ + conf/httpd.conf \ + conf/ssl.conf \ + conf/mime.types +OPEN_FILES = htdocs/open/dummy.html +MNESIA_OPEN_FILES = htdocs/mnesia_open/dummy.html +MISC_FILES = htdocs/misc/friedrich.html \ + htdocs/misc/oech.html +SECRET_FILES = htdocs/secret/dummy.html +MNESIA_SECRET_FILES = htdocs/mnesia_secret/dummy.html +HTDOCS_FILES = htdocs/index.html \ + htdocs/config.shtml \ + htdocs/echo.shtml \ + htdocs/exec.shtml \ + htdocs/flastmod.shtml \ + htdocs/fsize.shtml \ + htdocs/include.shtml +ICON_FILES = icons/README \ + icons/a.gif \ + icons/alert.black.gif \ + icons/alert.red.gif \ + icons/apache_pb.gif \ + icons/back.gif \ + icons/ball.gray.gif \ + icons/ball.red.gif \ + icons/binary.gif \ + icons/binhex.gif \ + icons/blank.gif \ + icons/bomb.gif \ + icons/box1.gif \ + icons/box2.gif \ + icons/broken.gif \ + icons/burst.gif \ + icons/button1.gif \ + icons/button10.gif \ + icons/button2.gif \ + icons/button3.gif \ + icons/button4.gif \ + icons/button5.gif \ + icons/button6.gif \ + icons/button7.gif \ + icons/button8.gif \ + icons/button9.gif \ + icons/buttonl.gif \ + icons/buttonr.gif \ + icons/c.gif \ + icons/comp.blue.gif \ + icons/comp.gray.gif \ + icons/compressed.gif \ + icons/continued.gif \ + icons/dir.gif \ + icons/down.gif \ + icons/dvi.gif \ + icons/f.gif \ + icons/folder.gif \ + icons/folder.open.gif \ + icons/folder.sec.gif \ + icons/forward.gif \ + icons/generic.gif \ + icons/generic.red.gif \ + icons/generic.sec.gif \ + icons/hand.right.gif \ + icons/hand.up.gif \ + icons/htdig.gif \ + icons/icon.sheet.gif \ + icons/image1.gif \ + icons/image2.gif \ + icons/image3.gif \ + icons/index.gif \ + icons/layout.gif \ + icons/left.gif \ + icons/link.gif \ + icons/movie.gif \ + icons/p.gif \ + icons/patch.gif \ + icons/pdf.gif \ + icons/pie0.gif \ + icons/pie1.gif \ + icons/pie2.gif \ + icons/pie3.gif \ + icons/pie4.gif \ + icons/pie5.gif \ + icons/pie6.gif \ + icons/pie7.gif \ + icons/pie8.gif \ + icons/portal.gif \ + icons/poweredby.gif \ + icons/ps.gif \ + icons/quill.gif \ + icons/right.gif \ + icons/screw1.gif \ + icons/screw2.gif \ + icons/script.gif \ + icons/sound1.gif \ + icons/sound2.gif \ + icons/sphere1.gif \ + icons/sphere2.gif \ + icons/star.gif \ + icons/star_blank.gif \ + icons/tar.gif \ + icons/tex.gif \ + icons/text.gif \ + icons/transfer.gif \ + icons/unknown.gif \ + icons/up.gif \ + icons/uu.gif \ + icons/uuencoded.gif \ + icons/world1.gif \ + icons/world2.gif + +SSL_FILES = ssl/ssl_client.pem \ + ssl/ssl_server.pem + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: + +clean: + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/auth + $(INSTALL_DATA) $(AUTH_FILES) $(RELSYSDIR)/examples/server_root/auth + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/cgi-bin + $(INSTALL_SCRIPT) $(CGI_FILES) $(RELSYSDIR)/examples/server_root/cgi-bin + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/conf + $(INSTALL_DATA) $(CONF_FILES) $(RELSYSDIR)/examples/server_root/conf + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/open + $(INSTALL_DATA) $(OPEN_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/open + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open + $(INSTALL_DATA) $(MNESIA_OPEN_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_open + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs/misc + $(INSTALL_DATA) $(MISC_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/misc + $(INSTALL_DIR) \ + $(RELSYSDIR)/examples/server_root/htdocs/secret/top_secret + $(INSTALL_DIR) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret/top_secret + $(INSTALL_DATA) $(SECRET_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/secret + $(INSTALL_DATA) $(MNESIA_SECRET_FILES) \ + $(RELSYSDIR)/examples/server_root/htdocs/mnesia_secret + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/htdocs + $(INSTALL_DATA) $(HTDOCS_FILES) $(RELSYSDIR)/examples/server_root/htdocs + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/icons + $(INSTALL_DATA) $(ICON_FILES) $(RELSYSDIR)/examples/server_root/icons + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/ssl + $(INSTALL_DATA) $(SSL_FILES) $(RELSYSDIR)/examples/server_root/ssl + $(INSTALL_DIR) $(RELSYSDIR)/examples/server_root/logs + +release_docs_spec: + diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 6abee5be2c..3189a758a5 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% @@ -72,6 +72,8 @@ 'last-modified', other=[] % list() - Key/Value list with other headers }). + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%-------------------------------------------------------------------- @@ -81,7 +83,8 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options) -> verify_request(SocketType, Host, Port, Node, RequestStr, Options, 30000). verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) -> {ok, Socket} = inets_test_lib:connect_bin(SocketType, Host, Port), - inets_test_lib:send(SocketType, Socket, RequestStr), + + _SendRes = inets_test_lib:send(SocketType, Socket, RequestStr), State = case inets_regexp:match(RequestStr, "printenv") of nomatch -> @@ -90,18 +93,26 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) -> #state{print = true} end, - case request(State#state{request = RequestStr, socket = Socket}, TimeOut) of - {error, Reson} -> - {error, Reson}; + case request(State#state{request = RequestStr, + socket = Socket}, TimeOut) of + {error, Reason} -> + tsp("request failed: " + "~n Reason: ~p", [Reason]), + {error, Reason}; NewState -> + tsp("validate reply: " + "~n NewState: ~p", [NewState]), ValidateResult = validate(RequestStr, NewState, Options, Node, Port), + tsp("validation result: " + "~n ~p", [ValidateResult]), inets_test_lib:close(SocketType, Socket), ValidateResult end. request(#state{mfa = {Module, Function, Args}, request = RequestStr, socket = Socket} = State, TimeOut) -> + HeadRequest = lists:sublist(RequestStr, 1, 4), receive {tcp, Socket, Data} -> @@ -109,12 +120,12 @@ request(#state{mfa = {Module, Function, Args}, case Module:Function([Data | Args]) of {ok, Parsed} -> handle_http_msg(Parsed, State); - {_, whole_body, _} when HeadRequest == "HEAD" -> + {_, whole_body, _} when HeadRequest =:= "HEAD" -> State#state{body = <<>>}; NewMFA -> request(State#state{mfa = NewMFA}, TimeOut) end; - {tcp_closed, Socket} when Function == whole_body -> + {tcp_closed, Socket} when Function =:= whole_body -> print(tcp, "closed", State), State#state{body = hd(Args)}; {tcp_closed, Socket} -> @@ -126,12 +137,12 @@ request(#state{mfa = {Module, Function, Args}, case Module:Function([Data | Args]) of {ok, Parsed} -> handle_http_msg(Parsed, State); - {_, whole_body, _} when HeadRequest == "HEAD" -> + {_, whole_body, _} when HeadRequest =:= "HEAD" -> State#state{body = <<>>}; NewMFA -> request(State#state{mfa = NewMFA}, TimeOut) end; - {ssl_closed, Socket} when Function == whole_body -> + {ssl_closed, Socket} when Function =:= whole_body -> print(ssl, "closed", State), State#state{body = hd(Args)}; {ssl_closed, Socket} -> @@ -330,3 +341,9 @@ print(Proto, Data, #state{print = true}) -> print(_, _, #state{print = false}) -> ok. + +%% tsp(F) -> +%% tsp(F, []). +tsp(F, A) -> + test_server:format("~p ~p:" ++ F ++ "~n", [self(), ?MODULE | A]). + diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index 7d6aa08542..f39f9faff0 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -1,25 +1,25 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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(httpd_time_test). --export([t/3, t1/2, t2/2]). +-export([t/3, t1/2, t2/2, t3/2, t4/2]). -export([do/1, do/2, do/3, do/4, do/5]). @@ -29,6 +29,9 @@ -record(stat, {pid, time = undefined, count = undefined, res}). +%% -define(NUM_POLLERS, 10). +-define(NUM_POLLERS, 1). + %%% ----------------------------------------------------------------- %%% Test suite interface @@ -42,9 +45,17 @@ t2(Host, Port) -> t(ssl, Host, Port). +t3(Host, Port) -> + t(ossl, Host, Port). + + +t4(Host, Port) -> + t(essl, Host, Port). + + t(SocketType, Host, Port) -> %% put(dbg,true), - main(1, SocketType, Host, Port, 60000). + main(?NUM_POLLERS, SocketType, Host, Port, 60000). @@ -111,28 +122,40 @@ loop(Pollers, Timeout) -> "~n Timeout: ~p", [Timeout]), Start = t(), receive - {'EXIT', Pid, {poller_stat_failure, Time, Reason}} -> + {'EXIT', Pid, {poller_stat_failure, SocketType, Host, Port, Time, Reason}} -> case is_poller(Pid, Pollers) of true -> error_msg("received unexpected exit from poller ~p~n" "befor completion of test " - "(after ~p micro sec):~n" - "~p~n", [Pid,Time,Reason]), - exit({fail, {poller_exit, Pid, Reason}}); + "after ~p micro sec" + "~n SocketType: ~p" + "~n Host: ~p" + "~n Port: ~p" + "~n~p~n", + [Pid, SocketType, Host, Port, Time, Reason]), + exit({fail, {poller_exit, Pid, Time, Reason}}); false -> error_msg("received unexpected ~p from ~p" "befor completion of test", [Reason, Pid]), loop(Pollers, to(Timeout, Start)) end; - {poller_stat_failure, Pid, {Time, Reason}} -> + {poller_stat_failure, Pid, {SocketType, Host, Port, Time, Reason}} -> error_msg("received stat failure ~p from poller ~p after ~p " - "befor completion of test", [Reason, Pid, Time]), - exit({fail, {poller_failure, Pid, Reason}}); - - {poller_stat_failure, Pid, Reason} -> + "befor completion of test" + "~n SocketType: ~p" + "~n Host: ~p" + "~n Port: ~p", + [Reason, Pid, Time, SocketType, Host, Port]), + exit({fail, {poller_failure, Pid, Time, Reason}}); + + {poller_stat_failure, Pid, SocketType, Host, Port, Reason} -> error_msg("received stat failure ~p from poller ~p " - "befor completion of test", [Reason, Pid]), + "befor completion of test" + "~n SocketType: ~p" + "~n Host: ~p" + "~n Port: ~p", + [Reason, Pid, SocketType, Host, Port]), exit({fail, {poller_failure, Pid, Reason}}); Any -> @@ -250,16 +273,16 @@ is_poller(Pid, [_|Rest]) -> poller_main(Parent, SocketType, Host, Port) -> process_flag(trap_exit,true), - put(sname,poller), + put(sname, poller), case timer:tc(?MODULE, poller_loop, [SocketType, Host, Port, uris()]) of {Time, Count} when is_integer(Time) andalso is_integer(Count) -> Parent ! {poller_statistics, self(), {Time, Count}}; {Time, {'EXIT', Reason}} when is_integer(Time) -> - exit({poller_stat_failure, Time, Reason}); + exit({poller_stat_failure, SocketType, Host, Port, Time, Reason}); {Time, Other} when is_integer(Time) -> - Parent ! {poller_stat_failure, self(), {Time, Other}}; + Parent ! {poller_stat_failure, self(), {SocketType, Host, Port, Time, Other}}; Else -> - Parent ! {poller_stat_failure, self(), Else} + Parent ! {poller_stat_failure, self(), SocketType, Host, Port, Else} end. diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index ba41e0960c..1e701bc074 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -372,11 +372,11 @@ httpc_subtree(Config) when is_list(Config) -> "~n Config: ~p", [Config]), tsp("httpc_subtree -> start inets service httpc with profile foo"), - {ok, Foo} = inets:start(httpc, [{profile, foo}]), + {ok, _Foo} = inets:start(httpc, [{profile, foo}]), tsp("httpc_subtree -> " "start stand-alone inets service httpc with profile bar"), - {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), + {ok, _Bar} = inets:start(httpc, [{profile, bar}], stand_alone), tsp("httpc_subtree -> retreive list of httpc instances"), HttpcChildren = supervisor:which_children(httpc_profile_sup), diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 6af2ad32f7..707b8c026a 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -1,28 +1,30 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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(inets_test_lib). -include("inets_test_lib.hrl"). +-include_lib("inets/src/http_lib/http_internal.hrl"). %% Various small utility functions --export([start_http_server/1, start_http_server_ssl/1]). +-export([start_http_server/1, start_http_server/2]). +-export([start_http_server_ssl/1, start_http_server_ssl/2]). -export([hostname/0]). -export([connect_bin/3, connect_byte/3, send/3, close/2]). -export([copy_file/3, copy_files/2, copy_dirs/2, del_dirs/1]). @@ -30,15 +32,99 @@ -export([check_body/1]). -export([millis/0, millis_diff/2, hours/1, minutes/1, seconds/1, sleep/1]). -export([non_pc_tc_maybe_skip/4, os_based_skip/1]). +-export([flush/0]). +-export([start_node/1, stop_node/1]). + +%% -- Misc node operation wrapper functions -- + +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + Args = case init:get_argument('CC_TEST') of + {ok, [[]]} -> + " -pa /clearcase/otp/libraries/snmp/ebin "; + {ok, [[Path]]} -> + " -pa " ++ Path; + error -> + "" + end, + A = Args ++ " -pa " ++ Pa, + Opts = [{cleanup,false}, {args, A}], + case (catch test_server:start_node(Name, slave, Opts)) of + {ok, Node} -> + Node; + Else -> + exit({failed_starting_node, Name, Else}) + end. + +stop_node(Node) -> + rpc:cast(Node, erlang, halt, []), + await_stopped(Node, 5). + +await_stopped(_, 0) -> + ok; +await_stopped(Node, N) -> + Nodes = erlang:nodes(), + case lists:member(Node, Nodes) of + true -> + sleep(1000), + await_stopped(Node, N-1); + false -> + ok + end. + + +%% ---------------------------------------------------------------- +%% HTTPD starter functions +%% start_http_server(Conf) -> + start_http_server(Conf, ?HTTP_DEFAULT_SSL_KIND). + +start_http_server(Conf, essl = _SslTag) -> + application:start(crypto), + do_start_http_server(Conf); +start_http_server(Conf, _SslTag) -> + do_start_http_server(Conf). + +do_start_http_server(Conf) -> + tsp("start http server with " + "~n Conf: ~p" + "~n", [Conf]), application:load(inets), - ok = application:set_env(inets, services, [{httpd, Conf}]), - ok = application:start(inets). - + case application:set_env(inets, services, [{httpd, Conf}]) of + ok -> + case application:start(inets) of + ok -> + ok; + Error1 -> + test_server:format("<ERROR> Failed starting application: " + "~n Error: ~p" + "~n", [Error1]), + Error1 + end; + Error2 -> + test_server:format("<ERROR> Failed set application env: " + "~n Error: ~p" + "~n", [Error2]), + Error2 + end. + start_http_server_ssl(FileName) -> + start_http_server_ssl(FileName, ?HTTP_DEFAULT_SSL_KIND). + +start_http_server_ssl(FileName, essl = _SslTag) -> + application:start(crypto), + do_start_http_server_ssl(FileName); +start_http_server_ssl(FileName, _SslTag) -> + do_start_http_server_ssl(FileName). + +do_start_http_server_ssl(FileName) -> + tsp("start (ssl) http server with " + "~n FileName: ~p" + "~n", [FileName]), application:start(ssl), - catch start_http_server(FileName). + catch do_start_http_server(FileName). + %% ---------------------------------------------------------------------- %% print functions @@ -84,27 +170,17 @@ copy_files(FromDir, ToDir) -> copy_dirs(FromDirRoot, ToDirRoot) -> -%% io:format("~w:copy_dirs -> entry with" -%% "~n FromDirRoot: ~p" -%% "~n ToDirRoot: ~p" -%% "~n", [?MODULE, FromDirRoot, ToDirRoot]), {ok, Files} = file:list_dir(FromDirRoot), lists:foreach( fun(FileOrDir) -> %% Check if it's a directory or a file -%% io:format("~w:copy_dirs -> check ~p" -%% "~n", [?MODULE, FileOrDir]), case filelib:is_dir(filename:join(FromDirRoot, FileOrDir)) of true -> -%% io:format("~w:copy_dirs -> ~p is a directory" -%% "~n", [?MODULE, FileOrDir]), FromDir = filename:join([FromDirRoot, FileOrDir]), ToDir = filename:join([ToDirRoot, FileOrDir]), ok = file:make_dir(ToDir), copy_dirs(FromDir, ToDir); false -> -%% io:format("~w:copy_dirs -> ~p is a file" -%% "~n", [?MODULE, FileOrDir]), copy_file(FileOrDir, FromDirRoot, ToDirRoot) end end, Files). @@ -133,8 +209,8 @@ check_body(Body) -> 0 -> case string:rstr(Body, "</HTML>") of 0 -> - test_server:format("Body ~p~n", [Body]), - test_server:fail(did_not_receive_whole_body); + tsp("Body ~p", [Body]), + tsf(did_not_receive_whole_body); _ -> ok end; @@ -204,9 +280,31 @@ os_based_skip(_) -> %% Port -> integer() connect_bin(ssl, Host, Port) -> + connect(ssl, Host, Port, [binary, {packet,0}]); +connect_bin(ossl, Host, Port) -> + connect(ssl, Host, Port, [{ssl_imp, old}, binary, {packet,0}]); +connect_bin(essl, Host, Port) -> + connect(ssl, Host, Port, [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true}]); +connect_bin(ip_comm, Host, Port) -> + Opts = [inet6, binary, {packet,0}], + connect(ip_comm, Host, Port, Opts). + + +connect_byte(ssl, Host, Port) -> + connect(ssl, Host, Port, [{packet,0}]); +connect_byte(ossl, Host, Port) -> + connect(ssl, Host, Port, [{ssl_imp, old}, {packet,0}]); +connect_byte(essl, Host, Port) -> + connect(ssl, Host, Port, [{ssl_imp, new}, {packet,0}]); +connect_byte(ip_comm, Host, Port) -> + Opts = [inet6, {packet,0}], + connect(ip_comm, Host, Port, Opts). + + +connect(ssl, Host, Port, Opts) -> ssl:start(), %% Does not support ipv6 in old ssl - case ssl:connect(Host, Port, [binary, {packet,0}]) of + case ssl:connect(Host, Port, Opts) of {ok, Socket} -> {ok, Socket}; {error, Reason} -> @@ -214,61 +312,48 @@ connect_bin(ssl, Host, Port) -> Error -> Error end; -connect_bin(ip_comm, Host, Port) -> - Opts = [inet6, binary, {packet,0}], - connect(ip_comm, Host, Port, Opts). - - connect(ip_comm, Host, Port, Opts) -> - test_server:format("gen_tcp:connect(~p, ~p, ~p) ~n", [Host, Port, Opts]), case gen_tcp:connect(Host,Port, Opts) of {ok, Socket} -> - test_server:format("connect success~n", []), + %% tsp("connect success"), {ok, Socket}; {error, nxdomain} -> - test_server:format("nxdomain opts: ~p~n", [Opts]), + tsp("nxdomain opts: ~p", [Opts]), connect(ip_comm, Host, Port, lists:delete(inet6, Opts)); {error, eafnosupport} -> - test_server:format("eafnosupport opts: ~p~n", [Opts]), + tsp("eafnosupport opts: ~p", [Opts]), connect(ip_comm, Host, Port, lists:delete(inet6, Opts)); {error, {enfile,_}} -> - test_server:format("Error enfile~n", []), + tsp("Error enfile"), {error, enfile}; Error -> - test_server:format("Unexpected error: " - "~n Error: ~p" - "~nwhen" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n", [Error, Host, Port, Opts]), + tsp("Unexpected error: " + "~n Error: ~p" + "~nwhen" + "~n Host: ~p" + "~n Port: ~p" + "~n Opts: ~p" + "~n", [Error, Host, Port, Opts]), Error end. -connect_byte(ip_comm, Host, Port) -> - Opts = [inet6, {packet,0}], - connect(ip_comm, Host, Port, Opts); - -connect_byte(ssl, Host, Port) -> - ssl:start(), - %% Does not support ipv6 in old ssl - case ssl:connect(Host,Port,[{packet,0}]) of - {ok,Socket} -> - {ok,Socket}; - {error,{enfile,_}} -> - {error, enfile}; - Error -> - Error - end. send(ssl, Socket, Data) -> ssl:send(Socket, Data); +send(ossl, Socket, Data) -> + ssl:send(Socket, Data); +send(essl, Socket, Data) -> + ssl:send(Socket, Data); send(ip_comm,Socket,Data) -> gen_tcp:send(Socket,Data). close(ssl,Socket) -> catch ssl:close(Socket); +close(ossl,Socket) -> + catch ssl:close(Socket); +close(essl,Socket) -> + catch ssl:close(Socket); close(ip_comm,Socket) -> catch gen_tcp:close(Socket). @@ -300,3 +385,20 @@ sleep(MSecs) -> skip(Reason, File, Line) -> exit({skipped, {Reason, File, Line}}). + +flush() -> + receive + Msg -> + [Msg | flush()] + after 1000 -> + [] + end. + + +tsp(F) -> + tsp(F, []). +tsp(F, A) -> + test_server:format("~p ~p:" ++ F ++ "~n", [self(), ?MODULE | A]). + +tsf(Reason) -> + test_server:fail(Reason). diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index ac20fa7bb7..57c87e7036 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,11 +18,16 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.3.3 +INETS_VSN = 5.4 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" -TICKETS = OTP-8609 OTP-8610 OTP-8624 +TICKETS = OTP-7907 OTP-8564 OTP-8573 + +TICKETS_5_3_3 = \ + OTP-8609 \ + OTP-8610 \ + OTP-8624 TICKETS_5_3_2 = \ OTP-8542 \ diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index affa5fc0fd..42d4818f08 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -66,6 +66,8 @@ set_primary_archive/3, clash/0]). +-export_type([load_error_rsn/0, load_ret/0]). + -include_lib("kernel/include/file.hrl"). %% User interface. diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 1ba329a12b..cfdd7045bd 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -61,6 +61,9 @@ -export([ipread_s32bu_p32bu_int/3]). +%% Types that can be used from other modules -- alphabetically ordered. +-export_type([date_time/0, fd/0, file_info/0, filename/0, io_device/0, + name/0, posix/0]). %%% Includes and defines -include("file.hrl"). diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index eb503235d8..93d75321ba 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -62,6 +62,8 @@ %% timer interface -export([start_timer/1, timeout/1, timeout/2, stop_timer/1]). +-export_type([ip_address/0, socket/0]). + %% imports -import(lists, [append/1, duplicate/2, filter/2, foldl/3]). diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index cab3a1a4e0..4ef0ed8f18 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -19,7 +19,7 @@ APPLICATION = megaco MEGACO_VSN = 3.14.1 -PRE_VSN =-p03 +PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" TICKETS = OTP-8529 OTP-8561 OTP-8627 OTP-8634 diff --git a/lib/mnesia/examples/mnesia_meter.erl b/lib/mnesia/examples/mnesia_meter.erl index ea74d8691b..68094c4431 100644 --- a/lib/mnesia/examples/mnesia_meter.erl +++ b/lib/mnesia/examples/mnesia_meter.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% @@ -407,7 +407,7 @@ run(Nodes, Config, FunOverhead) -> stop(Nodes), Res. -run_meter(M, Nodes, FunOverhead) when record(M, meter) -> +run_meter(M, Nodes, FunOverhead) when is_record(M, meter) -> io:format(".", []), case catch init_records(M#meter.init, ?TIMES) of {atomic, ok} -> diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 9bc480e619..0298b382a6 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -52,6 +52,7 @@ async_dump_log/1, sync_dump_log/1, connect_nodes/1, + connect_nodes/2, wait_for_schema_commit_lock/0, release_schema_commit_lock/0, create_table/1, @@ -94,7 +95,7 @@ load_and_reply/2, send_and_reply/2, wait_for_tables_init/2, - connect_nodes2/2 + connect_nodes2/3 ]). -import(mnesia_lib, [set/2, add/2]). @@ -420,12 +421,15 @@ try_schedule_late_disc_load(Tabs, Reason, MsgTag) -> [[Tabs, Reason, MsgTag], AbortReason]) end. -connect_nodes(Ns) -> +connect_nodes(Ns) -> + connect_nodes(Ns, fun default_merge/1). + +connect_nodes(Ns, UserFun) -> case mnesia:system_info(is_running) of no -> {error, {node_not_running, node()}}; yes -> - Pid = spawn_link(?MODULE,connect_nodes2,[self(),Ns]), + Pid = spawn_link(?MODULE,connect_nodes2,[self(),Ns, UserFun]), receive {?MODULE, Pid, Res, New} -> case Res of @@ -443,7 +447,7 @@ connect_nodes(Ns) -> end end. -connect_nodes2(Father, Ns) -> +connect_nodes2(Father, Ns, UserFun) -> Current = val({current, db_nodes}), abcast([node()|Ns], {merging_schema, node()}), {NewC, OldC} = mnesia_recover:connect_nodes(Ns), @@ -451,7 +455,7 @@ connect_nodes2(Father, Ns) -> New1 = mnesia_lib:intersect(Ns, Connected), New = New1 -- Current, process_flag(trap_exit, true), - Res = try_merge_schema(New), + Res = try_merge_schema(New, UserFun), Msg = {schema_is_merged, [], late_merge, []}, multicall([node()|Ns], Msg), After = val({current, db_nodes}), @@ -465,7 +469,7 @@ connect_nodes2(Father, Ns) -> merge_schema() -> AllNodes = mnesia_lib:all_nodes(), - case try_merge_schema(AllNodes) of + case try_merge_schema(AllNodes, fun default_merge/1) of ok -> schema_is_merged(); {aborted, {throw, Str}} when is_list(Str) -> @@ -474,8 +478,11 @@ merge_schema() -> fatal("Failed to merge schema: ~p~n", [Else]) end. -try_merge_schema(Nodes) -> - case mnesia_schema:merge_schema() of +default_merge(F) -> + F([]). + +try_merge_schema(Nodes, UserFun) -> + case mnesia_schema:merge_schema(UserFun) of {atomic, not_merged} -> %% No more nodes that we need to merge the schema with ok; @@ -488,11 +495,11 @@ try_merge_schema(Nodes) -> im_running(OldFriends, NewFriends), im_running(NewFriends, OldFriends), - try_merge_schema(Nodes); + try_merge_schema(Nodes, UserFun); {atomic, {"Cannot get cstructs", Node, Reason}} -> dbg_out("Cannot get cstructs, Node ~p ~p~n", [Node, Reason]), timer:sleep(1000), % Avoid a endless loop look alike - try_merge_schema(Nodes); + try_merge_schema(Nodes, UserFun); Other -> Other end. @@ -1842,17 +1849,20 @@ reply(ReplyTo, Reply) -> add_worker(Worker = #dump_log{}, State) -> InitBy = Worker#dump_log.initiated_by, Queue = State#state.dumper_queue, - case lists:keymember(InitBy, #dump_log.initiated_by, Queue) of - true when Worker#dump_log.opt_reply_to == undefined -> - %% The same threshold has been exceeded again, - %% before we have had the possibility to - %% process the older one. - DetectedBy = {dump_log, InitBy}, - Event = {mnesia_overload, DetectedBy}, - mnesia_lib:report_system_event(Event); - _ -> - ignore - end, + Status = + case lists:keymember(InitBy, #dump_log.initiated_by, Queue) of + true when Worker#dump_log.opt_reply_to == undefined -> + %% The same threshold has been exceeded again, + %% before we have had the possibility to + %% process the older one. + DetectedBy = {dump_log, InitBy}, + Event = {mnesia_overload, DetectedBy}, + mnesia_lib:report_system_event(Event), + true; + _ -> + false + end, + mnesia_recover:log_dump_overload(Status), Queue2 = Queue ++ [Worker], State2 = State#state{dumper_queue = Queue2}, opt_start_worker(State2); diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index dba808e66e..3da3dd2f5c 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -113,6 +113,9 @@ mkcore/1, not_active_here/1, other_val/2, + overload_read/0, + overload_read/1, + overload_set/2, pad_name/3, random_time/2, read_counter/1, @@ -551,6 +554,33 @@ cs_to_nodes(Cs) -> Cs#cstruct.disc_only_copies ++ Cs#cstruct.disc_copies ++ Cs#cstruct.ram_copies. + +overload_types() -> + [mnesia_tm, mnesia_dump_log]. + +valid_overload_type(T) -> + case lists:member(T, overload_types()) of + false -> + erlang:error(bad_type); + true -> + true + end. + +overload_set(Type, Bool) when is_boolean(Bool) -> + valid_overload_type(Type), + set({overload, Type}, Bool). + +overload_read() -> + [{T, overload_read(T)} || T <- overload_types()]. + +overload_read(T) -> + case ?catch_val({overload, T}) of + {'EXIT',_} -> + valid_overload_type(T), + false; + Flag when is_boolean(Flag) -> + Flag + end. dist_coredump() -> dist_coredump(all_nodes()). diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index 6c53c2e752..0ca7bf3f7f 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% @@ -36,6 +36,7 @@ incr_trans_tid_serial/0, init/0, log_decision/1, + log_dump_overload/1, log_master_nodes/3, log_mnesia_down/1, log_mnesia_up/1, @@ -70,6 +71,7 @@ unclear_decision, unclear_waitfor, tm_queue_len = 0, + log_dump_overload = false, initiated = false, early_msgs = [] }). @@ -277,6 +279,9 @@ mnesia_down(Node) -> cast({mnesia_down, Node}) end. +log_dump_overload(Flag) when is_boolean(Flag) -> + cast({log_dump_overload, Flag}). + log_master_nodes(Args, UseDir, IsRunning) -> if IsRunning == yes -> @@ -818,6 +823,12 @@ handle_cast({announce_all, Nodes}, State) -> announce_all(Nodes), {noreply, State}; +handle_cast({log_dump_overload, Flag}, State) when is_boolean(Flag) -> + Prev = State#state.log_dump_overload, + Overload = Prev orelse Flag, + mnesia_lib:overload_set(mnesia_dump_log, Overload), + {noreply, State#state{log_dump_overload = Flag}}; + handle_cast(Msg, State) -> error("~p got unexpected cast: ~p~n", [?MODULE, Msg]), {noreply, State}. @@ -851,12 +862,14 @@ handle_info(check_overload, S) -> Len > Threshold, Prev > Threshold -> What = {mnesia_tm, message_queue_len, [Prev, Len]}, mnesia_lib:report_system_event({mnesia_overload, What}), + mnesia_lib:overload_set(mnesia_tm, true), {noreply, S#state{tm_queue_len = 0}}; Len > Threshold -> {noreply, S#state{tm_queue_len = Len}}; true -> + mnesia_lib:overload_set(mnesia_tm, false), {noreply, S#state{tm_queue_len = 0}} end; undefined -> @@ -905,7 +918,23 @@ terminate(Reason, State) -> %% Purpose: Upgrade process when its code is to be changed %% Returns: {ok, NewState} %%---------------------------------------------------------------------- -code_change(_OldVsn, State, _Extra) -> +code_change(_OldVsn, {state, + Supervisor, + Unclear_pid, + Unclear_decision, + Unclear_waitfor, + Tm_queue_len, + Initiated, + Early_msgs + }, _Extra) -> + {ok, #state{supervisor = Supervisor, + unclear_pid = Unclear_pid, + unclear_decision = Unclear_decision, + unclear_waitfor = Unclear_waitfor, + tm_queue_len = Tm_queue_len, + initiated = Initiated, + early_msgs = Early_msgs}}; +code_change(_OldVsn, #state{} = State, _Extra) -> {ok, State}. %%%---------------------------------------------------------------------- diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 354431a296..17e570b881 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -62,6 +62,7 @@ list2cs/1, lock_schema/0, merge_schema/0, + merge_schema/1, move_table/3, opt_create_dir/2, prepare_commit/3, @@ -2650,10 +2651,16 @@ make_dump_tables([]) -> %% Merge the local schema with the schema on other nodes merge_schema() -> - schema_transaction(fun() -> do_merge_schema() end). + schema_transaction(fun() -> do_merge_schema([]) end). + +merge_schema(UserFun) -> + schema_transaction(fun() -> UserFun(fun(Arg) -> do_merge_schema(Arg) end) end). -do_merge_schema() -> + +do_merge_schema(LockTabs0) -> {_Mod, Tid, Ts} = get_tid_ts_and_lock(schema, write), + LockTabs = [{T, tab_to_nodes(T)} || T <- LockTabs0], + [get_tid_ts_and_lock(T,write) || {T,_} <- LockTabs], Connected = val(recover_nodes), Running = val({current, db_nodes}), Store = Ts#tidstore.store, @@ -2665,9 +2672,12 @@ do_merge_schema() -> mnesia:abort({bad_commit, {missing_lock, Miss}}) end, case Connected -- Running of - [Node | _] -> + [Node | _] = OtherNodes -> %% Time for a schema merging party! mnesia_locker:wlock_no_exist(Tid, Store, schema, [Node]), + [mnesia_locker:wlock_no_exist( + Tid, Store, T, mnesia_lib:intersect(Ns, OtherNodes)) + || {T,Ns} <- LockTabs], case rpc:call(Node, mnesia_controller, get_cstructs, []) of {cstructs, Cstructs, RemoteRunning1} -> LockedAlready = Running ++ [Node], @@ -2681,6 +2691,9 @@ do_merge_schema() -> end, NeedsLock = RemoteRunning -- LockedAlready, mnesia_locker:wlock_no_exist(Tid, Store, schema, NeedsLock), + [mnesia_locker:wlock_no_exist(Tid, Store, T, + mnesia_lib:intersect(Ns,NeedsLock)) + || {T,Ns} <- LockTabs], {value, SchemaCs} = lists:keysearch(schema, #cstruct.name, Cstructs), @@ -2714,6 +2727,10 @@ do_merge_schema() -> not_merged end. +tab_to_nodes(Tab) when is_atom(Tab) -> + Cs = val({Tab, cstruct}), + mnesia_lib:cs_to_nodes(Cs). + make_merge_schema(Node, [Cs | Cstructs]) -> Ops = do_make_merge_schema(Node, Cs), Ops ++ make_merge_schema(Node, Cstructs); diff --git a/lib/public_key/test/pkey_test.erl b/lib/public_key/test/pkey_test.erl index 9d596eee4f..4cf20f0174 100644 --- a/lib/public_key/test/pkey_test.erl +++ b/lib/public_key/test/pkey_test.erl @@ -271,7 +271,7 @@ publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. validity(Opts) -> - DefFrom0 = date(), + DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7), {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}), Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end, diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 6a3d6bfcf5..dc1015969a 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -320,12 +320,12 @@ pkix_path_validation(Config) when is_list(Config) -> {org_unit, "testing dep"} ]} ]), - ok = pkey_test:write_pem("/tmp", "cacert", CaK), + ok = pkey_test:write_pem("./", "public_key_cacert", CaK), CertK1 = {Cert1, _} = pkey_test:make_cert([{issuer, CaK}]), CertK2 = {Cert2,_} = pkey_test:make_cert([{issuer, CertK1}, {digest, md5}, {extensions, false}]), - ok = pkey_test:write_pem("/tmp", "cert", CertK2), - + ok = pkey_test:write_pem("./", "public_key_cert", CertK2), + {ok, _} = public_key:pkix_path_validation(Trusted, [Cert1], []), {error, {bad_cert,invalid_issuer}} = public_key:pkix_path_validation(Trusted, [Cert2], []), diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 45e1549de7..3f4954cfbd 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,6 +33,61 @@ </header> <section> + <title>SNMP Development Toolkit 4.17</title> + <p>Version 4.17 supports code replacement in runtime from/to + version 4.16.2, 4.16.1, 4.16, 4.15, 4.14 and 4.13.5.</p> + + <section> + <title>Improvements and new features</title> + <!-- + <p>-</p> + --> + <list type="bulleted"> + <item> + <p>[agent] Added very basic support for multiple SNMPv3 + EngineIDs in a single agent. See + <seealso marker="snmpa#send_notification">send_notification/7</seealso>, + <seealso marker="snmpa_mpd#process_packet">process_packet/7</seealso>, + <seealso marker="snmpa_mpd#generate_response_msg">generate_response_msg/6</seealso> or + <seealso marker="snmpa_mpd#generate_msg">generate_msg/6</seealso> + for more info. </p> + + <p>Own Id: OTP-8478</p> + </item> + + </list> + + </section> + + <section> + <title>Reported Fixed Bugs and Malfunctions</title> + <p>-</p> + + <!-- + <list type="bulleted"> + <item> + <p>The config utility + (<seealso marker="snmp#config">snmp:config/0</seealso>) + generated a default notify.conf + with a bad name for the starndard trap entry (was "stadard trap", + but should have been "standard trap"). This has been corrected. </p> + <p>Kenji Rikitake</p> + <p>Own Id: OTP-8433</p> + </item> + + </list> + --> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + </section> + </section> <!-- 4.17 --> + + + <section> <title>SNMP Development Toolkit 4.16.2</title> <p>Version 4.16.2 supports code replacement in runtime from/to version 4.16.1, 4.16, 4.15, 4.14 and 4.13.5.</p> diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml index 69fe6d62f4..1be6abe6dd 100644 --- a/lib/snmp/doc/src/snmpa.xml +++ b/lib/snmp/doc/src/snmpa.xml @@ -881,6 +881,7 @@ snmp_agent:register_subagent(SA1,[1,2,3], SA2). <name>send_notification(Agent, Notification, Receiver, Varbinds)</name> <name>send_notification(Agent, Notification, Receiver, NotifyName, Varbinds)</name> <name>send_notification(Agent, Notification, Receiver, NotifyName, ContextName, Varbinds) -> void() </name> + <name>send_notification(Agent, Notification, Receiver, NotifyName, ContextName, Varbinds, LocalEngineID) -> void() </name> <fsummary>Send a notification</fsummary> <type> <v>Agent = pid() | atom()</v> @@ -902,6 +903,7 @@ snmp_agent:register_subagent(SA1,[1,2,3], SA2). <v>OID = oid()</v> <v>Value = term()</v> <v>RowIndex = [int()]</v> + <v>LocalEngineID = string()</v> </type> <desc> <p>Sends the notification <c>Notification</c> to the @@ -1041,6 +1043,7 @@ snmp_agent:register_subagent(SA1,[1,2,3], SA2). <item><c>{?sysLocation_instance, "upstairs"}</c> (provided that the generated <c>.hrl</c> file is included)</item> </list> + <p>If a variable in the notification is a table element, the <c>RowIndex</c> for the element must be given in the <c>Varbinds</c> list. In this case, the OBJECT IDENTIFIER sent @@ -1048,15 +1051,27 @@ snmp_agent:register_subagent(SA1,[1,2,3], SA2). element. This OBJECT IDENTIFIER could be used in a get operation later. </p> + <p>This function is asynchronous, and does not return any information. If an error occurs, <c>user_err/2</c> of the error report module is called and the notification is discarded. </p> + <note> + <p>Note that the use of the LocalEngineID argument is only intended + for special cases, if the agent is to "emulate" multiple EngineIDs! + By default, the agent uses the value of <c>SnmpEngineID</c> + (see SNMP-FRAMEWORK-MIB). </p> + </note> + +<!-- <marker id="send_trap"></marker> +--> + <marker id="discovery"></marker> </desc> </func> +<!-- <func> <name>send_trap(Agent,Trap,Community)</name> <name>send_trap(Agent,Trap,Community,Varbinds) -> void()</name> @@ -1128,6 +1143,7 @@ snmp_agent:register_subagent(SA1,[1,2,3], SA2). <marker id="discovery"></marker> </desc> </func> +--> <func> <name>discovery(TargetName, Notification) -> {ok, ManagerEngineID} | {error, Reason}</name> diff --git a/lib/snmp/doc/src/snmpa_mpd.xml b/lib/snmp/doc/src/snmpa_mpd.xml index ea5bde8956..202e6b5661 100644 --- a/lib/snmp/doc/src/snmpa_mpd.xml +++ b/lib/snmp/doc/src/snmpa_mpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2009</year> + <year>1999</year><year>2010</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>snmpa_mpd</title> @@ -63,15 +63,19 @@ </func> <func> - <name>process_packet(Packet, TDomain, TAddress, State) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> + <name>process_packet(Packet, TDomain, TAddress, State, NoteStore, Log) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> + <name>process_packet(Packet, TDomain, TAddress, LocalEngineID, State, NoteStore, Log) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> <fsummary>Process a packet received from the network</fsummary> <type> <v>Packet = binary()</v> <v>TDomain = snmpUDPDomain</v> <v>TAddress = {Ip, Udp}</v> + <v>LocalEngineID = string()</v> <v>Ip = {integer(), integer(), integer(), integer()}</v> <v>Udp = integer()</v> <v>State = mpd_state()</v> + <v>NoteStore = pid()</v> + <v>Log = snmp_log()</v> <v>Vsn = 'version-1' | 'version-2' | 'version-3'</v> <v>Pdu = #pdu</v> <v>PduMs = integer()</v> @@ -84,18 +88,27 @@ decryption as necessary. The return values should be passed the agent.</p> + <note> + <p>Note that the use of the LocalEngineID argument is only intended + for special cases, if the agent is to "emulate" multiple EngineIDs! + By default, the agent uses the value of <c>SnmpEngineID</c> + (see SNMP-FRAMEWORK-MIB). </p> + </note> + <marker id="generate_response_msg"></marker> </desc> </func> <func> - <name>generate_response_msg(Vsn, RePdu, Type, ACMData) -> {ok, Packet} | {discarded, Reason}</name> + <name>generate_response_msg(Vsn, RePdu, Type, ACMData, Log) -> {ok, Packet} | {discarded, Reason}</name> + <name>generate_response_msg(Vsn, RePdu, Type, ACMData, LocalEngineID, Log) -> {ok, Packet} | {discarded, Reason}</name> <fsummary>Generate a response packet to be sent to the network</fsummary> <type> <v>Vsn = 'version-1' | 'version-2' | 'version-3'</v> <v>RePdu = #pdu</v> <v>Type = atom()</v> <v>ACMData = acm_data()</v> + <v>LocalEngineID = string()</v> <v>Packet = binary()</v> </type> <desc> @@ -103,17 +116,27 @@ network. <c>Type</c> is the <c>#pdu.type</c> of the original request.</p> + <note> + <p>Note that the use of the LocalEngineID argument is only intended + for special cases, if the agent is to "emulate" multiple EngineIDs! + By default, the agent uses the value of <c>SnmpEngineID</c> + (see SNMP-FRAMEWORK-MIB). </p> + </note> + <marker id="generate_msg"></marker> </desc> </func> <func> - <name>generate_msg(Vsn, Pdu, MsgData, To) -> {ok, PacketsAndAddresses} | {discarded, Reason}</name> + <name>generate_msg(Vsn, NoteStore, Pdu, MsgData, To) -> {ok, PacketsAndAddresses} | {discarded, Reason}</name> + <name>generate_msg(Vsn, NoteStore, Pdu, MsgData, LocalEngineID, To) -> {ok, PacketsAndAddresses} | {discarded, Reason}</name> <fsummary>Generate a request message to be sent to the network</fsummary> <type> <v>Vsn = 'version-1' | 'version-2' | 'version-3'</v> + <v>NoteStore = pid()</v> <v>Pdu = #pdu</v> <v>MsgData = msg_data()</v> + <v>LocalEngineID = string()</v> <v>To = [dest_addrs()]</v> <v>PacketsAndAddresses = [{TDomain, TAddress, Packet}]</v> <v>TDomain = snmpUDPDomain</v> @@ -136,6 +159,13 @@ also received from the requests mentioned above. </p> + <note> + <p>Note that the use of the LocalEngineID argument is only intended + for special cases, if the agent is to "emulate" multiple EngineIDs! + By default, the agent uses the value of <c>SnmpEngineID</c> + (see SNMP-FRAMEWORK-MIB). </p> + </note> + <marker id="discarded_pdu"></marker> </desc> </func> diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index 1c37d76074..87b191caed 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -61,7 +61,7 @@ register_subagent/3, unregister_subagent/2, send_notification/3, send_notification/4, send_notification/5, - send_notification/6, + send_notification/6, send_notification/7, send_trap/3, send_trap/4, discovery/2, discovery/3, discovery/4, discovery/5, discovery/6, @@ -423,14 +423,23 @@ send_notification(Agent, Notification, Recv, Varbinds) -> send_notification(Agent, Notification, Recv, NotifyName, Varbinds) -> send_notification(Agent, Notification, Recv, NotifyName, "", Varbinds). -send_notification(Agent, Notification, Recv, - NotifyName, ContextName, Varbinds) +send_notification(Agent, Notification, Recv, NotifyName, + ContextName, Varbinds) when (is_list(NotifyName) andalso is_list(ContextName) andalso is_list(Varbinds)) -> snmpa_agent:send_trap(Agent, Notification, NotifyName, ContextName, Recv, Varbinds). +send_notification(Agent, Notification, Recv, + NotifyName, ContextName, Varbinds, LocalEngineID) + when (is_list(NotifyName) andalso + is_list(ContextName) andalso + is_list(Varbinds) andalso + is_list(LocalEngineID)) -> + snmpa_agent:send_trap(Agent, Notification, NotifyName, + ContextName, Recv, Varbinds, LocalEngineID). + %% Kept for backwards compatibility send_trap(Agent, Trap, Community) -> send_notification(Agent, Trap, no_receiver, Community, "", []). diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 648f5b53fa..f70885b2ec 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -30,7 +30,7 @@ -export([subagent_set/2, load_mibs/2, unload_mibs/2, which_mibs/1, whereis_mib/2, info/1, register_subagent/3, unregister_subagent/2, - send_trap/6, + send_trap/6, send_trap/7, register_notification_filter/5, unregister_notification_filter/2, which_notification_filter/1, @@ -65,7 +65,7 @@ %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, tr_var/2, tr_varbind/1, - handle_pdu/7, worker/2, worker_loop/1, do_send_trap/6]). + handle_pdu/7, worker/2, worker_loop/1, do_send_trap/7]). -ifndef(default_verbosity). -define(default_verbosity,silence). @@ -529,14 +529,15 @@ which_notification_filter(Agent) -> send_trap(Agent, Trap, NotifyName, CtxName, Recv, Varbinds) -> ?d("send_trap -> entry with" - "~n self(): ~p" - "~n Agent: ~p [~p]" - "~n Trap: ~p" - "~n NotifyName: ~p" - "~n CtxName: ~p" - "~n Recv: ~p" - "~n Varbinds: ~p", - [self(), Agent, wis(Agent), Trap, NotifyName, CtxName, Recv, Varbinds]), + "~n self(): ~p" + "~n Agent: ~p [~p]" + "~n Trap: ~p" + "~n NotifyName: ~p" + "~n CtxName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p", + [self(), Agent, wis(Agent), + Trap, NotifyName, CtxName, Recv, Varbinds]), Msg = {send_trap, Trap, NotifyName, CtxName, Recv, Varbinds}, case (wis(Agent) =:= self()) of false -> @@ -545,6 +546,27 @@ send_trap(Agent, Trap, NotifyName, CtxName, Recv, Varbinds) -> Agent ! Msg end. +send_trap(Agent, Trap, NotifyName, CtxName, Recv, Varbinds, LocalEngineID) -> + ?d("send_trap -> entry with" + "~n self(): ~p" + "~n Agent: ~p [~p]" + "~n Trap: ~p" + "~n NotifyName: ~p" + "~n CtxName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p" + "~n LocalEngineID: ~p", + [self(), Agent, wis(Agent), + Trap, NotifyName, CtxName, Recv, Varbinds, LocalEngineID]), + Msg = + {send_trap, Trap, NotifyName, CtxName, Recv, Varbinds, LocalEngineID}, + case (wis(Agent) =:= self()) of + false -> + call(Agent, Msg); + true -> + Agent ! Msg + end. + %% -- Discovery functions -- @@ -631,6 +653,7 @@ wis(Pid) when is_pid(Pid) -> wis(Atom) when is_atom(Atom) -> whereis(Atom). + forward_trap(Agent, TrapRecord, NotifyName, CtxName, Recv, Varbinds) -> Agent ! {forward_trap, TrapRecord, NotifyName, CtxName, Recv, Varbinds}. @@ -724,14 +747,36 @@ handle_info(worker_available, S) -> handle_info({send_trap, Trap, NotifyName, ContextName, Recv, Varbinds}, S) -> ?vlog("[handle_info] send trap request:" - "~n Trap: ~p" - "~n NotifyName: ~p" - "~n ContextName: ~p" - "~n Recv: ~p" - "~n Varbinds: ~p", - [Trap,NotifyName,ContextName,Recv,Varbinds]), + "~n Trap: ~p" + "~n NotifyName: ~p" + "~n ContextName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p", + [Trap, NotifyName, ContextName, Recv, Varbinds]), + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + case catch handle_send_trap(S, Trap, NotifyName, ContextName, + Recv, Varbinds, LocalEngineID) of + {ok, NewS} -> + {noreply, NewS}; + {'EXIT', R} -> + ?vinfo("Trap not sent:~n ~p", [R]), + {noreply, S}; + _ -> + {noreply, S} + end; + +handle_info({send_trap, Trap, NotifyName, ContextName, Recv, Varbinds, + LocalEngineID}, S) -> + ?vlog("[handle_info] send trap request:" + "~n Trap: ~p" + "~n NotifyName: ~p" + "~n ContextName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p" + "~n LocalEngineID: ~p", + [Trap, NotifyName, ContextName, Recv, Varbinds, LocalEngineID]), case catch handle_send_trap(S, Trap, NotifyName, ContextName, - Recv, Varbinds) of + Recv, Varbinds, LocalEngineID) of {ok, NewS} -> {noreply, NewS}; {'EXIT', R} -> @@ -741,17 +786,18 @@ handle_info({send_trap, Trap, NotifyName, ContextName, Recv, Varbinds}, S) -> {noreply, S} end; -handle_info({forward_trap, TrapRecord, NotifyName, ContextName, - Recv, Varbinds},S) -> +handle_info({forward_trap, TrapRecord, NotifyName, ContextName, + Recv, Varbinds}, S) -> ?vlog("[handle_info] forward trap request:" - "~n TrapRecord: ~p" - "~n NotifyName: ~p" - "~n ContextName: ~p" - "~n Recv: ~p" - "~n Varbinds: ~p", - [TrapRecord,NotifyName,ContextName,Recv,Varbinds]), + "~n TrapRecord: ~p" + "~n NotifyName: ~p" + "~n ContextName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p", + [TrapRecord, NotifyName, ContextName, Recv, Varbinds]), + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, case (catch maybe_send_trap(S, TrapRecord, NotifyName, ContextName, - Recv, Varbinds)) of + Recv, Varbinds, LocalEngineID)) of {ok, NewS} -> {noreply, NewS}; {'EXIT', R} -> @@ -861,17 +907,29 @@ handle_call(restart_set_worker, _From, #state{set_worker = Pid} = S) -> ok end, {reply, ok, S}; + handle_call({send_trap, Trap, NotifyName, ContextName, Recv, Varbinds}, _From, S) -> ?vlog("[handle_call] send trap request:" - "~n Trap: ~p" - "~n NotifyName: ~p" - "~n ContextName: ~p" - "~n Recv: ~p" - "~n Varbinds: ~p", - [Trap,NotifyName,ContextName,Recv,Varbinds]), + "~n Trap: ~p" + "~n NotifyName: ~p" + "~n ContextName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p", + [Trap, NotifyName, ContextName, Recv, Varbinds]), + LocalEngineID = + case S#state.type of + master_agent -> + ?DEFAULT_LOCAL_ENGINE_ID; + _ -> + %% subagent - + %% we don't need this, eventually the trap sent request + %% will reach the master-agent and then it will look up + %% the proper engine id. + ignore + end, case (catch handle_send_trap(S, Trap, NotifyName, ContextName, - Recv, Varbinds)) of + Recv, Varbinds, LocalEngineID)) of {ok, NewS} -> {reply, ok, NewS}; {'EXIT', Reason} -> @@ -881,8 +939,33 @@ handle_call({send_trap, Trap, NotifyName, ContextName, Recv, Varbinds}, ?vinfo("Trap not sent", []), {reply, {error, send_failed}, S} end; + +handle_call({send_trap, Trap, NotifyName, + ContextName, Recv, Varbinds, LocalEngineID}, + _From, S) -> + ?vlog("[handle_call] send trap request:" + "~n Trap: ~p" + "~n NotifyName: ~p" + "~n ContextName: ~p" + "~n Recv: ~p" + "~n Varbinds: ~p" + "~n LocalEngineID: ~p", + [Trap, NotifyName, ContextName, Recv, Varbinds, LocalEngineID]), + case (catch handle_send_trap(S, Trap, NotifyName, ContextName, + Recv, Varbinds, LocalEngineID)) of + {ok, NewS} -> + {reply, ok, NewS}; + {'EXIT', Reason} -> + ?vinfo("Trap not sent:~n ~p", [Reason]), + {reply, {error, {send_failed, Reason}}, S}; + _ -> + ?vinfo("Trap not sent", []), + {reply, {error, send_failed}, S} + end; + handle_call({discovery, - TargetName, Notification, ContextName, Vbs, DiscoHandler, ExtraInfo}, + TargetName, Notification, ContextName, Vbs, DiscoHandler, + ExtraInfo}, From, #state{disco = undefined} = S) -> ?vlog("[handle_call] initiate discovery process:" @@ -1439,17 +1522,20 @@ spawn_thread(Vsn, Pdu, PduMS, ACMData, Address, Extra) -> Args = [Vsn, Pdu, PduMS, ACMData, Address, Extra, Dict], proc_lib:spawn_link(?MODULE, handle_pdu, Args). -spawn_trap_thread(TrapRec, NotifyName, ContextName, Recv, V) -> +spawn_trap_thread(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID) -> Dict = get(), proc_lib:spawn_link(?MODULE, do_send_trap, - [TrapRec, NotifyName, ContextName, Recv, V, Dict]). + [TrapRec, NotifyName, ContextName, + Recv, Vbs, LocalEngineID, Dict]). -do_send_trap(TrapRec, NotifyName, ContextName, Recv, V, Dict) -> +do_send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID, Dict) -> lists:foreach(fun({Key, Val}) -> put(Key, Val) end, Dict), put(sname,trap_sender_short_name(get(sname))), ?vlog("starting",[]), - snmpa_trap:send_trap(TrapRec, NotifyName, ContextName, Recv, V, - get(net_if)). + snmpa_trap:send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID, get(net_if)). worker(Master, Dict) -> lists:foreach(fun({Key, Val}) -> put(Key, Val) end, Dict), @@ -1464,17 +1550,22 @@ worker_loop(Master) -> handle_pdu(Vsn, Pdu, PduMS, ACMData, Address, Extra), Master ! worker_available; - %% Old style message - {MibView, Vsn, Pdu, PduMS, ACMData, AgentData, Extra} -> - ?vtrace("worker_loop -> received (old) request", []), - do_handle_pdu(MibView, Vsn, Pdu, PduMS, ACMData, AgentData, Extra), + %% We don't trap exits! + {TrapRec, NotifyName, ContextName, Recv, Vbs} -> + ?vtrace("worker_loop -> send trap:" + "~n ~p", [TrapRec]), + snmpa_trap:send_trap(TrapRec, NotifyName, + ContextName, Recv, Vbs, get(net_if)), Master ! worker_available; - {TrapRec, NotifyName, ContextName, Recv, V} -> % We don't trap exits! + %% We don't trap exits! + {send_trap, + TrapRec, NotifyName, ContextName, Recv, Vbs, LocalEngineID} -> ?vtrace("worker_loop -> send trap:" "~n ~p", [TrapRec]), snmpa_trap:send_trap(TrapRec, NotifyName, - ContextName, Recv, V, get(net_if)), + ContextName, Recv, Vbs, LocalEngineID, + get(net_if)), Master ! worker_available; {verbosity, Verbosity} -> @@ -1623,13 +1714,15 @@ handle_acm_error(Vsn, Reason, Pdu, ACMData, Address, Extra) -> end. -handle_send_trap(S, TrapName, NotifyName, ContextName, Recv, Varbinds) -> +handle_send_trap(S, TrapName, NotifyName, ContextName, Recv, Varbinds, + LocalEngineID) -> ?vtrace("handle_send_trap -> entry with" - "~n S#state.type: ~p" - "~n TrapName: ~p" - "~n NotifyName: ~p" - "~n ContextName: ~p", - [S#state.type, TrapName, NotifyName, ContextName]), + "~n S#state.type: ~p" + "~n TrapName: ~p" + "~n NotifyName: ~p" + "~n ContextName: ~p" + "~n LocalEngineID: ~p", + [S#state.type, TrapName, NotifyName, ContextName, LocalEngineID]), case snmpa_trap:construct_trap(TrapName, Varbinds) of {ok, TrapRecord, VarList} -> ?vtrace("handle_send_trap -> construction complete: " @@ -1646,7 +1739,8 @@ handle_send_trap(S, TrapName, NotifyName, ContextName, Recv, Varbinds) -> ?vtrace("handle_send_trap -> " "[master] handle send trap",[]), maybe_send_trap(S, TrapRecord, NotifyName, - ContextName, Recv, VarList) + ContextName, Recv, VarList, + LocalEngineID) end; error -> error @@ -1683,7 +1777,8 @@ maybe_forward_trap(#state{parent = Parent, nfilters = NFs} = S, maybe_send_trap(#state{nfilters = NFs} = S, - TrapRec, NotifyName, ContextName, Recv, Varbinds) -> + TrapRec, NotifyName, ContextName, Recv, Varbinds, + LocalEngineID) -> ?vtrace("maybe_send_trap -> entry with" "~n NFs: ~p", [NFs]), case filter_notification(NFs, [], TrapRec) of @@ -1700,39 +1795,45 @@ maybe_send_trap(#state{nfilters = NFs} = S, ?vtrace("maybe_send_trap -> send trap:" "~n ~p", [TrapRec2]), do_handle_send_trap(S, TrapRec2, - NotifyName, ContextName, Recv, Varbinds); + NotifyName, ContextName, Recv, Varbinds, + LocalEngineID); {send, Removed, TrapRec2} -> ?vtrace("maybe_send_trap -> send trap:" "~n ~p", [TrapRec2]), NFs2 = del_notification_filter(Removed, NFs), do_handle_send_trap(S#state{nfilters = NFs2}, TrapRec2, - NotifyName, ContextName, Recv, Varbinds) + NotifyName, ContextName, Recv, Varbinds, + LocalEngineID) end. -do_handle_send_trap(S, TrapRec, NotifyName, ContextName, Recv, Varbinds) -> - V = snmpa_trap:try_initialise_vars(get(mibserver), Varbinds), +do_handle_send_trap(S, TrapRec, NotifyName, ContextName, Recv, Varbinds, + LocalEngineID) -> + Vbs = snmpa_trap:try_initialise_vars(get(mibserver), Varbinds), case S#state.type of subagent -> forward_trap(S#state.parent, TrapRec, NotifyName, ContextName, - Recv, V), + Recv, Vbs), {ok, S}; master_agent when S#state.multi_threaded =:= false -> ?vtrace("do_handle_send_trap -> send trap:" "~n ~p", [TrapRec]), snmpa_trap:send_trap(TrapRec, NotifyName, ContextName, - Recv, V, get(net_if)), + Recv, Vbs, LocalEngineID, get(net_if)), {ok, S}; master_agent when S#state.worker_state =:= busy -> %% Main worker busy => create new worker ?vtrace("do_handle_send_trap -> main worker busy: " "spawn a trap sender", []), - spawn_trap_thread(TrapRec, NotifyName, ContextName, Recv, V), + spawn_trap_thread(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID), {ok, S}; master_agent -> %% Send to main worker ?vtrace("do_handle_send_trap -> send to main worker",[]), - S#state.worker ! {TrapRec, NotifyName, ContextName, Recv, V}, + S#state.worker ! {send_trap, + TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID}, {ok, S#state{worker_state = busy}} end. diff --git a/lib/snmp/src/agent/snmpa_internal.hrl b/lib/snmp/src/agent/snmpa_internal.hrl index a33a6809dc..9fa874f119 100644 --- a/lib/snmp/src/agent/snmpa_internal.hrl +++ b/lib/snmp/src/agent/snmpa_internal.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -22,6 +22,8 @@ -include_lib("snmp/src/app/snmp_internal.hrl"). +-define(DEFAULT_LOCAL_ENGINE_ID, snmp_framework_mib:get_engine_id()). + -define(snmpa_info(F, A), ?snmp_info("agent", F, A)). -define(snmpa_warning(F, A), ?snmp_warning("agent", F, A)). -define(snmpa_error(F, A), ?snmp_error("agent", F, A)). diff --git a/lib/snmp/src/agent/snmpa_mpd.erl b/lib/snmp/src/agent/snmpa_mpd.erl index 2e09286b87..fd75b98f84 100644 --- a/lib/snmp/src/agent/snmpa_mpd.erl +++ b/lib/snmp/src/agent/snmpa_mpd.erl @@ -1,27 +1,28 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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(snmpa_mpd). -export([init/1, reset/0, inc/1, counters/0, discarded_pdu/1, - process_packet/6, - generate_response_msg/5, generate_msg/5, + process_packet/6, process_packet/7, + generate_response_msg/5, generate_response_msg/6, + generate_msg/5, generate_msg/6, generate_discovery_msg/4, process_taddrs/1, generate_req_id/0]). @@ -34,6 +35,7 @@ -define(VMODULE,"MPD"). -include("snmp_verbosity.hrl"). +-include("snmpa_internal.hrl"). -define(empty_msg_size, 24). @@ -120,6 +122,12 @@ reset() -> %% section 4.2.1 in rfc2272) %%----------------------------------------------------------------- process_packet(Packet, TDomain, TAddress, State, NoteStore, Log) -> + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + process_packet(Packet, TDomain, TAddress, LocalEngineID, + State, NoteStore, Log). + +process_packet(Packet, TDomain, TAddress, LocalEngineID, + State, NoteStore, Log) -> inc(snmpInPkts), case catch snmp_pdus:dec_message_only(binary_to_list(Packet)) of @@ -127,15 +135,17 @@ process_packet(Packet, TDomain, TAddress, State, NoteStore, Log) -> when State#state.v1 =:= true -> ?vlog("v1, community: ~s", [Community]), HS = ?empty_msg_size + length(Community), - v1_v2c_proc('version-1', NoteStore, Community, TDomain, TAddress, - Data, HS, Log, Packet); + v1_v2c_proc('version-1', NoteStore, Community, + TDomain, TAddress, + LocalEngineID, Data, HS, Log, Packet); #message{version = 'version-2', vsn_hdr = Community, data = Data} when State#state.v2c =:= true -> ?vlog("v2c, community: ~s", [Community]), HS = ?empty_msg_size + length(Community), - v1_v2c_proc('version-2', NoteStore, Community, TDomain, TAddress, - Data, HS, Log, Packet); + v1_v2c_proc('version-2', NoteStore, Community, + TDomain, TAddress, + LocalEngineID, Data, HS, Log, Packet); #message{version = 'version-3', vsn_hdr = V3Hdr, data = Data} when State#state.v3 =:= true -> @@ -143,7 +153,9 @@ process_packet(Packet, TDomain, TAddress, State, NoteStore, Log) -> [V3Hdr#v3_hdr.msgID, V3Hdr#v3_hdr.msgFlags, V3Hdr#v3_hdr.msgSecurityModel]), - v3_proc(NoteStore, Packet, TDomain, TAddress, V3Hdr, Data, Log); + v3_proc(NoteStore, Packet, + TDomain, TAddress, + LocalEngineID, V3Hdr, Data, Log); {'EXIT', {bad_version, Vsn}} -> ?vtrace("exit: bad version: ~p",[Vsn]), @@ -170,10 +182,11 @@ discarded_pdu(Variable) -> inc(Variable). %%----------------------------------------------------------------- %% Handles a Community based message (v1 or v2c). %%----------------------------------------------------------------- -v1_v2c_proc(Vsn, NoteStore, Community, snmpUDPDomain, {Ip, Udp}, +v1_v2c_proc(Vsn, NoteStore, Community, snmpUDPDomain, + {Ip, Udp}, LocalEngineID, Data, HS, Log, Packet) -> TAddress = tuple_to_list(Ip) ++ [Udp div 256, Udp rem 256], - AgentMS = snmp_framework_mib:get_engine_max_message_size(), + AgentMS = get_engine_max_message_size(LocalEngineID), MgrMS = snmp_community_mib:get_target_addr_ext_mms(?snmpUDPDomain, TAddress), PduMS = case MgrMS of @@ -220,10 +233,10 @@ v1_v2c_proc(Vsn, NoteStore, Community, snmpUDPDomain, {Ip, Udp}, {discarded, trap_pdu} end; v1_v2c_proc(_Vsn, _NoteStore, _Community, snmpUDPDomain, TAddress, - _Data, _HS, _Log, _Packet) -> + _LocalEngineID, _Data, _HS, _Log, _Packet) -> {discarded, {badarg, TAddress}}; v1_v2c_proc(_Vsn, _NoteStore, _Community, TDomain, _TAddress, - _Data, _HS, _Log, _Packet) -> + _LocalEngineID, _Data, _HS, _Log, _Packet) -> {discarded, {badarg, TDomain}}. sec_model('version-1') -> ?SEC_V1; @@ -234,15 +247,19 @@ sec_model('version-2') -> ?SEC_V2C. %% Handles a SNMPv3 Message, following the procedures in rfc2272, %% section 4.2 and 7.2 %%----------------------------------------------------------------- -v3_proc(NoteStore, Packet, _TDomain, _TAddress, V3Hdr, Data, Log) -> - case (catch v3_proc(NoteStore, Packet, V3Hdr, Data, Log)) of +v3_proc(NoteStore, Packet, _TDomain, _TAddress, LocalEngineID, + V3Hdr, Data, Log) -> + case (catch v3_proc(NoteStore, Packet, LocalEngineID, V3Hdr, Data, Log)) of {'EXIT', Reason} -> exit(Reason); Result -> Result end. -v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> +v3_proc(NoteStore, Packet, LocalEngineID, V3Hdr, Data, Log) -> + ?vtrace("v3_proc -> entry with" + "~n LocalEngineID: ~p", + [LocalEngineID]), %% 7.2.3 #v3_hdr{msgID = MsgID, msgMaxSize = MMS, @@ -250,7 +267,7 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> msgSecurityModel = MsgSecurityModel, msgSecurityParameters = SecParams, hdr_size = HdrSize} = V3Hdr, - ?vdebug("v3_proc -> version 3 message header:" + ?vdebug("v3_proc -> version 3 message header [7.2.3]:" "~n msgID = ~p" "~n msgMaxSize = ~p" "~n msgFlags = ~p" @@ -263,17 +280,19 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> SecLevel = check_sec_level(MsgFlags), IsReportable = snmp_misc:is_reportable(MsgFlags), %% 7.2.6 - ?vtrace("v3_proc -> " + ?vtrace("v3_proc -> [7.2.6]" "~n SecModule = ~p" "~n SecLevel = ~p" "~n IsReportable = ~p", - [SecModule,SecLevel,IsReportable]), + [SecModule, SecLevel, IsReportable]), SecRes = (catch SecModule:process_incoming_msg(Packet, Data, - SecParams, SecLevel)), + SecParams, SecLevel, + LocalEngineID)), ?vtrace("v3_proc -> message processing result: " "~n SecRes: ~p", [SecRes]), {SecEngineID, SecName, ScopedPDUBytes, SecData, DiscoOrPlain} = - check_sec_module_result(SecRes, V3Hdr, Data, IsReportable, Log), + check_sec_module_result(SecRes, V3Hdr, Data, + LocalEngineID, IsReportable, Log), ?vtrace("v3_proc -> " "~n DiscoOrPlain: ~w" "~n SecEngineID: ~w" @@ -311,7 +330,7 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> Log(PDU#pdu.type, Packet) end, %% Make sure a get_bulk doesn't get too big. - AgentMS = snmp_framework_mib:get_engine_max_message_size(), + AgentMS = get_engine_max_message_size(LocalEngineID), %% PduMMS is supposed to be the maximum total length of the response %% PDU we can send. From the MMS, we need to subtract everything before %% the PDU, i.e. Message and ScopedPDU. @@ -415,8 +434,8 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> throw({discarded, received_v2_trap}); Type -> %% 7.2.13 - SnmpEngineID = snmp_framework_mib:get_engine_id(), - ?vtrace("v3_proc -> SnmpEngineID = ~w", [SnmpEngineID]), + SnmpEngineID = LocalEngineID, + ?vtrace("v3_proc -> 7.2.13", []), case SecEngineID of SnmpEngineID when (DiscoOrPlain =:= discovery) -> %% This is a discovery step 2 message! @@ -429,6 +448,7 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> ContextName, SecData, PDU, + LocalEngineID, Log); SnmpEngineID when (DiscoOrPlain =:= plain) -> @@ -444,17 +464,18 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> %% 4.2.2.1.2 NIsReportable = snmp_misc:is_reportable_pdu(Type), Val = inc(snmpUnknownPDUHandlers), - ErrorInfo = {#varbind{oid = ?snmpUnknownPDUHandlers, - variabletype = 'Counter32', - value = Val}, - SecName, - [{securityLevel, SecLevel}, - {contextEngineID, ContextEngineID}, - {contextName, ContextName}]}, + ErrorInfo = + {#varbind{oid = ?snmpUnknownPDUHandlers, + variabletype = 'Counter32', + value = Val}, + SecName, + [{securityLevel, SecLevel}, + {contextEngineID, ContextEngineID}, + {contextName, ContextName}]}, case generate_v3_report_msg(MsgID, MsgSecurityModel, - Data, ErrorInfo, - Log) of + Data, LocalEngineID, + ErrorInfo, Log) of {ok, Report} when NIsReportable =:= true -> {discarded, snmpUnknownPDUHandlers, Report}; _ -> @@ -473,6 +494,7 @@ v3_proc(NoteStore, Packet, V3Hdr, Data, Log) -> ContextName, SecData, PDU, + LocalEngineID, Log); _ -> @@ -501,7 +523,7 @@ check_sec_level(Unknown) -> inc(snmpInvalidMsgs), throw({discarded, snmpInvalidMsgs}). -check_sec_module_result(Res, V3Hdr, Data, IsReportable, Log) -> +check_sec_module_result(Res, V3Hdr, Data, LocalEngineID, IsReportable, Log) -> case Res of {ok, X} -> X; @@ -516,7 +538,7 @@ check_sec_module_result(Res, V3Hdr, Data, IsReportable, Log) -> #v3_hdr{msgID = MsgID, msgSecurityModel = MsgSecModel} = V3Hdr, Pdu = get_scoped_pdu(Data), case generate_v3_report_msg(MsgID, MsgSecModel, Pdu, - ErrorInfo, Log) of + LocalEngineID, ErrorInfo, Log) of {ok, Report} -> throw({discarded, {securityError, Reason}, Report}); {discarded, _SomeOtherReason} -> @@ -545,8 +567,15 @@ get_scoped_pdu(D) -> generate_response_msg(Vsn, RePdu, Type, ACMData, Log) -> generate_response_msg(Vsn, RePdu, Type, ACMData, Log, 1). +generate_response_msg(Vsn, RePdu, Type, ACMData, Log, N) when is_integer(N) -> + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + generate_response_msg(Vsn, RePdu, Type, ACMData, LocalEngineID, Log, N); +generate_response_msg(Vsn, RePdu, Type, ACMData, LocalEngineID, Log) -> + generate_response_msg(Vsn, RePdu, Type, ACMData, LocalEngineID, Log, 1). + generate_response_msg(Vsn, RePdu, Type, {community, _SecModel, Community, _IpUdp}, + LocalEngineID, Log, _) -> case catch snmp_pdus:enc_pdu(RePdu) of {'EXIT', Reason} -> @@ -555,8 +584,9 @@ generate_response_msg(Vsn, RePdu, Type, [RePdu, Community, Reason]), {discarded, Reason}; PduBytes -> - Message = #message{version = Vsn, vsn_hdr = Community, - data = PduBytes}, + Message = #message{version = Vsn, + vsn_hdr = Community, + data = PduBytes}, case catch list_to_binary( snmp_pdus:enc_message_only(Message)) of {'EXIT', Reason} -> @@ -565,7 +595,7 @@ generate_response_msg(Vsn, RePdu, Type, [RePdu, Community, Reason]), {discarded, Reason}; Packet -> - MMS = snmp_framework_mib:get_engine_max_message_size(), + MMS = get_engine_max_message_size(LocalEngineID), case size(Packet) of Len when Len =< MMS -> Log(Type, Packet), @@ -584,6 +614,7 @@ generate_response_msg(Vsn, RePdu, Type, generate_response_msg(Vsn, RePdu, Type, {v3, MsgID, MsgSecurityModel, SecName, SecLevel, ContextEngineID, ContextName, SecData}, + LocalEngineID, Log, N) -> %% rfc2272: 7.1 steps 6-8 ScopedPDU = #scopedPdu{contextEngineID = ContextEngineID, @@ -596,7 +627,7 @@ generate_response_msg(Vsn, RePdu, Type, [RePdu, ContextName, Reason]), {discarded, Reason}; ScopedPDUBytes -> - AgentMS = snmp_framework_mib:get_engine_max_message_size(), + AgentMS = get_engine_max_message_size(LocalEngineID), V3Hdr = #v3_hdr{msgID = MsgID, msgMaxSize = AgentMS, msgFlags = snmp_misc:mk_msg_flags(Type, SecLevel), @@ -611,13 +642,14 @@ generate_response_msg(Vsn, RePdu, Type, ?SEC_USM -> snmpa_usm end, - SecEngineID = snmp_framework_mib:get_engine_id(), + SecEngineID = LocalEngineID, ?vtrace("generate_response_msg -> SecEngineID: ~w", [SecEngineID]), case (catch SecModule:generate_outgoing_msg(Message, SecEngineID, SecName, SecData, - SecLevel)) of + SecLevel, + LocalEngineID)) of {'EXIT', Reason} -> config_err("~p (message: ~p)", [Reason, Message]), {discarded, Reason}; @@ -668,12 +700,14 @@ generate_response_msg(Vsn, RePdu, Type, SecName, SecLevel, ContextEngineID, ContextName, - SecData}, Log, N+1) + SecData}, + LocalEngineID, Log, N+1) end end end. -generate_v3_report_msg(MsgID, MsgSecurityModel, Data, ErrorInfo, Log) -> +generate_v3_report_msg(MsgID, MsgSecurityModel, Data, LocalEngineID, + ErrorInfo, Log) -> {Varbind, SecName, Opts} = ErrorInfo, ReqId = if @@ -689,7 +723,7 @@ generate_v3_report_msg(MsgID, MsgSecurityModel, Data, ErrorInfo, Log) -> error_index = 0, varbinds = [Varbind]}, SecLevel = snmp_misc:get_option(securityLevel, Opts, 0), - SnmpEngineID = snmp_framework_mib:get_engine_id(), + SnmpEngineID = LocalEngineID, ContextEngineID = snmp_misc:get_option(contextEngineID, Opts, SnmpEngineID), ContextName = snmp_misc:get_option(contextName, Opts, ""), @@ -697,7 +731,8 @@ generate_v3_report_msg(MsgID, MsgSecurityModel, Data, ErrorInfo, Log) -> generate_response_msg('version-3', Pdu, report, {v3, MsgID, MsgSecurityModel, SecName, SecLevel, - ContextEngineID, ContextName, SecData}, Log). + ContextEngineID, ContextName, SecData}, + LocalEngineID, Log). %% req_id(#scopedPdu{data = #pdu{request_id = ReqId}}) -> %% ?vtrace("Report ReqId: ~p",[ReqId]), @@ -719,7 +754,8 @@ generate_discovery1_report_msg(MsgID, MsgSecurityModel, SecName, SecLevel, ContextEngineID, ContextName, {SecData, Oid, Value}, - #pdu{request_id = ReqId}, Log) -> + #pdu{request_id = ReqId}, + LocalEngineID, Log) -> ?vtrace("generate_discovery1_report_msg -> entry with" "~n ReqId: ~p" "~n Value: ~p", [ReqId, Value]), @@ -734,7 +770,8 @@ generate_discovery1_report_msg(MsgID, MsgSecurityModel, varbinds = [Varbind]}, case generate_response_msg('version-3', PduOut, report, {v3, MsgID, MsgSecurityModel, SecName, SecLevel, - ContextEngineID, ContextName, SecData}, Log) of + ContextEngineID, ContextName, SecData}, + LocalEngineID, Log) of {ok, Packet} -> {discovery, Packet}; Error -> @@ -745,7 +782,8 @@ generate_discovery1_report_msg(MsgID, MsgSecurityModel, generate_discovery2_report_msg(MsgID, MsgSecurityModel, SecName, SecLevel, ContextEngineID, ContextName, - SecData, #pdu{request_id = ReqId}, Log) -> + SecData, #pdu{request_id = ReqId}, + LocalEngineID, Log) -> ?vtrace("generate_discovery2_report_msg -> entry with" "~n ReqId: ~p", [ReqId]), SecModule = get_security_module(MsgSecurityModel), @@ -757,7 +795,8 @@ generate_discovery2_report_msg(MsgID, MsgSecurityModel, varbinds = [Vb]}, case generate_response_msg('version-3', PduOut, report, {v3, MsgID, MsgSecurityModel, SecName, SecLevel, - ContextEngineID, ContextName, SecData}, Log) of + ContextEngineID, ContextName, SecData}, + LocalEngineID, Log) of {ok, Packet} -> {discovery, Packet}; Error -> @@ -816,7 +855,11 @@ set_vb_null([]) -> %% Executed when a message that isn't a response is generated, i.e. %% a trap or an inform. %%----------------------------------------------------------------- -generate_msg(Vsn, _NoteStore, Pdu, {community, Community}, To) -> +generate_msg(Vsn, NoteStore, Pdu, ACMData, To) -> + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + generate_msg(Vsn, NoteStore, Pdu, ACMData, LocalEngineID, To). + +generate_msg(Vsn, _NoteStore, Pdu, {community, Community}, LocalEngineID, To) -> Message = #message{version = Vsn, vsn_hdr = Community, data = Pdu}, case catch list_to_binary(snmp_pdus:enc_message(Message)) of {'EXIT', Reason} -> @@ -825,7 +868,7 @@ generate_msg(Vsn, _NoteStore, Pdu, {community, Community}, To) -> [Pdu, Community, Reason]), {discarded, Reason}; Packet -> - AgentMax = snmp_framework_mib:get_engine_max_message_size(), + AgentMax = get_engine_max_message_size(LocalEngineID), case size(Packet) of Len when Len =< AgentMax -> {ok, mk_v1_v2_packet_list(To, Packet, Len, Pdu)}; @@ -838,9 +881,9 @@ generate_msg(Vsn, _NoteStore, Pdu, {community, Community}, To) -> end end; generate_msg('version-3', NoteStore, Pdu, - {v3, ContextEngineID, ContextName}, To) -> - %% rfc2272: 7.1.6 - ScopedPDU = #scopedPdu{contextEngineID = ContextEngineID, + {v3, ContextEngineID, ContextName}, LocalEngineID, To) -> + %% rfc2272: 7.1 step 6 + ScopedPDU = #scopedPdu{contextEngineID = LocalEngineID, contextName = ContextName, data = Pdu}, case (catch snmp_pdus:enc_scoped_pdu(ScopedPDU)) of @@ -851,7 +894,8 @@ generate_msg('version-3', NoteStore, Pdu, {discarded, Reason}; ScopedPDUBytes -> {ok, mk_v3_packet_list(NoteStore, To, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName)} + ContextEngineID, ContextName, + LocalEngineID)} end. @@ -1094,17 +1138,21 @@ mk_msg_flags(PduType, SecLevel) -> mk_v3_packet_entry(NoteStore, Domain, Addr, {SecModel, SecName, SecLevel, TargetAddrName}, - ScopedPDUBytes, Pdu, ContextEngineID, ContextName) -> - %% 7.1.7 - ?vtrace("mk_v3_packet_entry -> entry - 7.1.7", []), - MsgID = generate_msg_id(), - PduType = Pdu#pdu.type, - MsgFlags = mk_msg_flags(PduType, SecLevel), + ScopedPDUBytes, Pdu, _ContextEngineID, ContextName, + LocalEngineID) -> + %% rfc2272 7.1 step 77 + ?vtrace("mk_v3_packet_entry -> entry - RFC2272-7.1:7", []), + MsgVersion = 'version-3', % 7.1:7a + MsgID = generate_msg_id(), % 7.1:7b + MaxMsgSz = get_max_message_size(), % 7.1:7c + PduType = Pdu#pdu.type, + MsgFlags = mk_msg_flags(PduType, SecLevel), % 7.1:7d + MsgSecModel = SecModel, % 7.1:7e V3Hdr = #v3_hdr{msgID = MsgID, - msgMaxSize = get_max_message_size(), + msgMaxSize = MaxMsgSz, msgFlags = MsgFlags, - msgSecurityModel = SecModel}, - Message = #message{version = 'version-3', + msgSecurityModel = MsgSecModel}, + Message = #message{version = MsgVersion, vsn_hdr = V3Hdr, data = ScopedPDUBytes}, SecModule = @@ -1113,12 +1161,21 @@ mk_v3_packet_entry(NoteStore, Domain, Addr, snmpa_usm end, + %% + %% 7.1:8 - If the PDU is from the Response Class or the Internal Class + %% securityEngineID = snmpEngineID (local/source) + %% 7.1:9 - If the PDU is from the Unconfirmed Class + %% securityEngineID = snmpEngineID (local/source) + %% else + %% securityEngineID = targetEngineID (remote/destination) + %% + %% 7.1.9a ?vtrace("mk_v3_packet_entry -> sec engine id - 7.1.9a", []), SecEngineID = case PduType of 'snmpv2-trap' -> - snmp_framework_mib:get_engine_id(); + LocalEngineID; _ -> %% This is the implementation dependent target engine id %% procedure. @@ -1141,8 +1198,9 @@ mk_v3_packet_entry(NoteStore, Domain, Addr, ?vdebug("mk_v3_packet_entry -> secEngineID: ~p", [SecEngineID]), %% 7.1.9b - case catch SecModule:generate_outgoing_msg(Message, SecEngineID, - SecName, [], SecLevel) of + case (catch SecModule:generate_outgoing_msg(Message, SecEngineID, + SecName, [], SecLevel, + LocalEngineID)) of {'EXIT', Reason} -> config_err("~p (message: ~p)", [Reason, Message]), skip; @@ -1169,7 +1227,7 @@ mk_v3_packet_entry(NoteStore, Domain, Addr, sec_model = SecModel, sec_name = SecName, sec_level = SecLevel, - ctx_engine_id = ContextEngineID, + ctx_engine_id = LocalEngineID, ctx_name = ContextName, disco = false, req_id = Pdu#pdu.request_id}, @@ -1180,15 +1238,16 @@ mk_v3_packet_entry(NoteStore, Domain, Addr, mk_v3_packet_list(NoteStore, To, - ScopedPDUBytes, Pdu, ContextEngineID, ContextName) -> + ScopedPDUBytes, Pdu, ContextEngineID, ContextName, + LocalEngineID) -> mk_v3_packet_list(NoteStore, To, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName, []). + ContextEngineID, ContextName, LocalEngineID, []). mk_v3_packet_list(_, [], _ScopedPDUBytes, _Pdu, _ContextEngineID, _ContextName, - Acc) -> + _LocalEngineID, Acc) -> lists:reverse(Acc); %% This clause is for backward compatibillity reasons @@ -1196,20 +1255,21 @@ mk_v3_packet_list(_, [], mk_v3_packet_list(NoteStore, [{{?snmpUDPDomain, [A,B,C,D,U1,U2]}, SecData} | T], ScopedPDUBytes, Pdu, ContextEngineID, ContextName, - Acc) -> + LocalEngineID, Acc) -> case mk_v3_packet_entry(NoteStore, snmpUDPDomain, {{A,B,C,D}, U1 bsl 8 + U2}, SecData, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName) of + ContextEngineID, ContextName, LocalEngineID) of skip -> mk_v3_packet_list(NoteStore, T, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName, + ContextEngineID, ContextName, LocalEngineID, Acc); {ok, Entry} -> mk_v3_packet_list(NoteStore, T, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName, [Entry | Acc]) + ContextEngineID, ContextName, LocalEngineID, + [Entry | Acc]) end; %% This is the new clause @@ -1218,11 +1278,11 @@ mk_v3_packet_list(NoteStore, mk_v3_packet_list(NoteStore, [{{Domain, Addr}, SecData} | T], ScopedPDUBytes, Pdu, ContextEngineID, ContextName, - Acc) -> + LocalEngineID, Acc) -> case mk_v3_packet_entry(NoteStore, Domain, Addr, SecData, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName) of + ContextEngineID, ContextName, LocalEngineID) of skip -> mk_v3_packet_list(NoteStore, T, ScopedPDUBytes, Pdu, @@ -1230,7 +1290,8 @@ mk_v3_packet_list(NoteStore, {ok, Entry} -> mk_v3_packet_list(NoteStore, T, ScopedPDUBytes, Pdu, - ContextEngineID, ContextName, [Entry | Acc]) + ContextEngineID, ContextName, + LocalEngineID, [Entry | Acc]) end. @@ -1253,6 +1314,9 @@ gen(Id) -> get_target_engine_id(TargetAddrName) -> snmp_target_mib:get_target_engine_id(TargetAddrName). +get_engine_max_message_size(_LocalEngineID) -> + snmp_framework_mib:get_engine_max_message_size(). + sec_module(?SEC_USM) -> snmpa_usm. diff --git a/lib/snmp/src/agent/snmpa_trap.erl b/lib/snmp/src/agent/snmpa_trap.erl index b1096b1135..450cb2e9f4 100644 --- a/lib/snmp/src/agent/snmpa_trap.erl +++ b/lib/snmp/src/agent/snmpa_trap.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(snmpa_trap). @@ -23,14 +23,18 @@ %%%----------------------------------------------------------------- %% External exports -export([construct_trap/2, - try_initialise_vars/2, send_trap/6]). + try_initialise_vars/2, + send_trap/6, send_trap/7]). -export([send_discovery/5]). %% Internal exports --export([init_v2_inform/9, init_v3_inform/9, send_inform/6]). +-export([init_v2_inform/9, + init_v3_inform/9, init_v3_inform/10, + send_inform/6]). -export([init_discovery_inform/12, send_discovery_inform/5]). -include("snmp_types.hrl"). +-include("snmpa_internal.hrl"). -include("SNMPv2-MIB.hrl"). -include("SNMPv2-TM.hrl"). -include("SNMPv2-TC.hrl"). @@ -331,13 +335,20 @@ make_varbind_list(Varbinds) -> %% SnmpTargetAddrTable (using the Tag). %%----------------------------------------------------------------- send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, NetIf) -> - (catch do_send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, NetIf)). + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID, NetIf). + +send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, LocalEngineID, NetIf) -> + (catch do_send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID, NetIf)). -do_send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, NetIf) -> +do_send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, + LocalEngineID, NetIf) -> VarbindList = make_varbind_list(Vbs), Dests = find_dests(NotifyName), send_trap_pdus(Dests, ContextName, {TrapRec, VarbindList}, [], [], [], - Recv, NetIf). + Recv, LocalEngineID, NetIf). send_discovery(TargetName, Record, ContextName, Vbs, NetIf) -> case find_dest(TargetName) of @@ -619,7 +630,9 @@ send_discovery_inform(Parent, Timeout, Retry, Msg, NetIf) -> %%----------------------------------------------------------------- send_trap_pdus([{DestAddr, TargetName, {MpModel, SecModel, SecName, SecLevel}, Type} | T], - ContextName,{TrapRec, Vbs}, V1Res, V2Res, V3Res, Recv, NetIf) -> + ContextName, + {TrapRec, Vbs}, V1Res, V2Res, V3Res, Recv, + LocalEngineID, NetIf) -> ?vdebug("send trap pdus: " "~n Destination address: ~p" "~n Target name: ~p" @@ -634,7 +647,7 @@ send_trap_pdus([{DestAddr, TargetName, {MpModel, SecModel, SecName, SecLevel}, case check_all_varbinds(TrapRec, Vbs, MibView) of true when MpModel =:= ?MP_V1 -> ?vtrace("send_trap_pdus -> v1 mp model",[]), - ContextEngineId = snmp_framework_mib:get_engine_id(), + ContextEngineId = LocalEngineID, case snmp_community_mib:vacm2community({SecName, ContextEngineId, ContextName}, @@ -644,16 +657,18 @@ send_trap_pdus([{DestAddr, TargetName, {MpModel, SecModel, SecName, SecLevel}, [element(2, DestAddr)]), send_trap_pdus(T, ContextName, {TrapRec, Vbs}, [{DestAddr, Community} | V1Res], - V2Res, V3Res, Recv, NetIf); + V2Res, V3Res, Recv, + LocalEngineID, NetIf); undefined -> ?vdebug("No community found for v1 dest: ~p", [element(2, DestAddr)]), send_trap_pdus(T, ContextName, {TrapRec, Vbs}, - V1Res, V2Res, V3Res, Recv, NetIf) + V1Res, V2Res, V3Res, Recv, + LocalEngineID, NetIf) end; true when MpModel =:= ?MP_V2C -> ?vtrace("send_trap_pdus -> v2c mp model",[]), - ContextEngineId = snmp_framework_mib:get_engine_id(), + ContextEngineId = LocalEngineID, case snmp_community_mib:vacm2community({SecName, ContextEngineId, ContextName}, @@ -664,12 +679,13 @@ send_trap_pdus([{DestAddr, TargetName, {MpModel, SecModel, SecName, SecLevel}, send_trap_pdus(T, ContextName, {TrapRec, Vbs}, V1Res, [{DestAddr, Community, Type}|V2Res], - V3Res, Recv, NetIf); + V3Res, Recv, LocalEngineID, NetIf); undefined -> ?vdebug("No community found for v2c dest: ~p", [element(2, DestAddr)]), send_trap_pdus(T, ContextName, {TrapRec, Vbs}, - V1Res, V2Res, V3Res, Recv, NetIf) + V1Res, V2Res, V3Res, Recv, + LocalEngineID, NetIf) end; true when MpModel =:= ?MP_V3 -> ?vtrace("send_trap_pdus -> v3 mp model",[]), @@ -678,18 +694,20 @@ send_trap_pdus([{DestAddr, TargetName, {MpModel, SecModel, SecName, SecLevel}, send_trap_pdus(T, ContextName, {TrapRec, Vbs}, V1Res, V2Res, [{DestAddr, MsgData, Type} | V3Res], - Recv, NetIf); + Recv, LocalEngineID, NetIf); true -> ?vlog("bad MpModel ~p for dest ~p", [MpModel, element(2, DestAddr)]), send_trap_pdus(T, ContextName, {TrapRec, Vbs}, - V1Res, V2Res, V3Res, Recv, NetIf); + V1Res, V2Res, V3Res, Recv, + LocalEngineID, NetIf); _ -> ?vlog("no access for dest: " "~n ~p in target ~p", [element(2, DestAddr), TargetName]), send_trap_pdus(T, ContextName, {TrapRec, Vbs}, - V1Res, V2Res, V3Res, Recv, NetIf) + V1Res, V2Res, V3Res, Recv, + LocalEngineID, NetIf) end; {discarded, Reason} -> ?vlog("mib view error ~p for" @@ -697,10 +715,10 @@ send_trap_pdus([{DestAddr, TargetName, {MpModel, SecModel, SecName, SecLevel}, "~n SecName: ~w", [Reason, element(2, DestAddr), SecName]), send_trap_pdus(T, ContextName, {TrapRec, Vbs}, - V1Res, V2Res, V3Res, Recv, NetIf) + V1Res, V2Res, V3Res, Recv, LocalEngineID, NetIf) end; send_trap_pdus([], ContextName, {TrapRec, Vbs}, V1Res, V2Res, V3Res, - Recv, NetIf) -> + Recv, LocalEngineID, NetIf) -> SysUpTime = snmp_standard_mib:sys_up_time(), ?vdebug("send trap pdus with sysUpTime ~p", [SysUpTime]), InformRecvs = get_inform_recvs(V2Res ++ V3Res), @@ -708,7 +726,8 @@ send_trap_pdus([], ContextName, {TrapRec, Vbs}, V1Res, V2Res, V3Res, deliver_recv(Recv, snmp_targets, InformTargets), send_v1_trap(TrapRec, V1Res, Vbs, NetIf, SysUpTime), send_v2_trap(TrapRec, V2Res, Vbs, Recv, NetIf, SysUpTime), - send_v3_trap(TrapRec, V3Res, Vbs, Recv, NetIf, SysUpTime, ContextName). + send_v3_trap(TrapRec, V3Res, Vbs, Recv, LocalEngineID, NetIf, + SysUpTime, ContextName). send_v1_trap(_TrapRec, [], _Vbs, _NetIf, _SysUpTime) -> ok; @@ -762,21 +781,25 @@ send_v2_trap(TrapRec, V2Res, Vbs, Recv, NetIf, SysUpTime) -> do_send_v2_trap(TrapRecvs, IVbs, NetIf), do_send_v2_inform(InformRecvs, IVbs, Recv, NetIf). -send_v3_trap(_TrapRec, [], _Vbs, _Recv, _NetIf, _SysUpTime, _ContextName) -> +send_v3_trap(_TrapRec, [], _Vbs, _Recv, _LocalEngineID, + _NetIf, _SysUpTime, _ContextName) -> ok; -send_v3_trap(TrapRec, V3Res, Vbs, Recv, NetIf, SysUpTime, ContextName) -> +send_v3_trap(TrapRec, V3Res, Vbs, Recv, LocalEngineID, + NetIf, SysUpTime, ContextName) -> ?vdebug("prepare to send v3 trap",[]), {_Oid, IVbs} = mk_v2_trap(TrapRec, Vbs, SysUpTime), % v2 refers to SMIv2; - TrapRecvs = get_trap_recvs(V3Res), % same SMI for v3 + TrapRecvs = get_trap_recvs(V3Res), % same SMI for v3 InformRecvs = get_inform_recvs(V3Res), do_send_v3_trap(TrapRecvs, ContextName, IVbs, NetIf), - do_send_v3_inform(InformRecvs, ContextName, IVbs, Recv, NetIf). + do_send_v3_inform(InformRecvs, ContextName, IVbs, Recv, + LocalEngineID, NetIf). mk_v2_trap(#notification{oid = Oid}, Vbs, SysUpTime) -> ?vtrace("make v2 notification '~p'",[Oid]), mk_v2_notif(Oid, Vbs, SysUpTime); -mk_v2_trap(#trap{enterpriseoid = Enter, specificcode = Spec}, Vbs, SysUpTime) -> +mk_v2_trap(#trap{enterpriseoid = Enter, specificcode = Spec}, + Vbs, SysUpTime) -> %% Use alg. in rfc1908 to map a v1 trap to a v2 trap ?vtrace("make v2 trap for '~p' with ~p",[Enter,Spec]), {Oid,Enterp} = @@ -845,16 +868,16 @@ do_send_v3_trap(Recvs, ContextName, Vbs, NetIf) -> end, Recvs), ok. -do_send_v3_inform([], _ContextName, _Vbs, _Recv, _NetIf) -> +do_send_v3_inform([], _ContextName, _Vbs, _Recv, _LocalEngineID, _NetIf) -> ok; -do_send_v3_inform(Recvs, ContextName, Vbs, Recv, NetIf) -> +do_send_v3_inform(Recvs, ContextName, Vbs, Recv, LocalEngineID, NetIf) -> lists:foreach( fun({Addr, MsgData, Timeout, Retry}) -> ?vtrace("~n start inform sender to send v3 inform to ~p", [Addr]), proc_lib:spawn_link(?MODULE, init_v3_inform, [{Addr, MsgData}, Timeout, Retry, Vbs, - Recv, NetIf, ContextName, + Recv, LocalEngineID, NetIf, ContextName, get(verbosity), get(sname)]) end, Recvs). @@ -874,7 +897,13 @@ init_v2_inform(Addr, Timeout, Retry, Vbs, Recv, NetIf, Community,V,S) -> %% New process -init_v3_inform(Addr, Timeout, Retry, Vbs, Recv, NetIf, ContextName,V,S) -> +init_v3_inform(Addr, Timeout, Retry, Vbs, Recv, NetIf, ContextName, V, S) -> + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + init_v3_inform(Addr, Timeout, Retry, Vbs, Recv, LocalEngineID, + NetIf, ContextName, V, S). + +init_v3_inform(Addr, Timeout, Retry, Vbs, Recv, LocalEngineID, + NetIf, ContextName, V, S) -> %% Make a new Inform for each recipient; they need unique %% request-ids! put(verbosity,V), @@ -882,7 +911,7 @@ init_v3_inform(Addr, Timeout, Retry, Vbs, Recv, NetIf, ContextName,V,S) -> ?vdebug("~n starting with timeout = ~p and retry = ~p", [Timeout,Retry]), InformPdu = make_v2_notif_pdu(Vbs, 'inform-request'), % Yes, v2 - ContextEngineId = snmp_framework_mib:get_engine_id(), + ContextEngineId = LocalEngineID, Msg = {send_pdu_req, 'version-3', InformPdu, {v3, ContextEngineId, ContextName}, [Addr], self()}, ?MODULE:send_inform(Addr, Timeout*10, Retry, Msg, Recv, NetIf). diff --git a/lib/snmp/src/agent/snmpa_usm.erl b/lib/snmp/src/agent/snmpa_usm.erl index b94294844b..ae584bb3c1 100644 --- a/lib/snmp/src/agent/snmpa_usm.erl +++ b/lib/snmp/src/agent/snmpa_usm.erl @@ -19,8 +19,8 @@ -module(snmpa_usm). -export([ - process_incoming_msg/4, - generate_outgoing_msg/5, + process_incoming_msg/4, process_incoming_msg/5, + generate_outgoing_msg/5, generate_outgoing_msg/6, generate_discovery_msg/4, generate_discovery_msg/5, current_statsNotInTimeWindows_vb/0 ]). @@ -33,6 +33,7 @@ -define(VMODULE,"A-USM"). -include("snmp_verbosity.hrl"). +-include("snmpa_internal.hrl"). %%----------------------------------------------------------------- @@ -58,7 +59,11 @@ %%----------------------------------------------------------------- process_incoming_msg(Packet, Data, SecParams, SecLevel) -> - TermDiscoEnabled = is_terminating_discovery_enabled(), + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + process_incoming_msg(Packet, Data, SecParams, SecLevel, LocalEngineID). + +process_incoming_msg(Packet, Data, SecParams, SecLevel, LocalEngineID) -> + TermDiscoEnabled = is_terminating_discovery_enabled(), TermTriggerUsername = terminating_trigger_username(), %% 3.2.1 ?vtrace("process_incoming_msg -> check security parms: 3.2.1",[]), @@ -124,7 +129,7 @@ process_incoming_msg(Packet, Data, SecParams, SecLevel) -> "~n ~p",[UsmUser]), DiscoOrPlain = authenticate_incoming(Packet, UsmSecParams, UsmUser, - SecLevel), + SecLevel, LocalEngineID), %% 3.2.8 ?vtrace("process_incoming_msg -> " "decrypt scoped data: 3.2.8",[]), @@ -166,7 +171,8 @@ process_discovery_msg(MsgAuthEngineID, Data, SecLevel) -> end. -authenticate_incoming(Packet, UsmSecParams, UsmUser, SecLevel) -> +authenticate_incoming(Packet, UsmSecParams, UsmUser, SecLevel, + LocalEngineID) -> %% 3.2.6 ?vtrace("authenticate_incoming -> 3.2.6", []), AuthProtocol = element(?usmUserAuthProtocol, UsmUser), @@ -190,7 +196,8 @@ authenticate_incoming(Packet, UsmSecParams, UsmUser, SecLevel) -> SecName, MsgAuthEngineID, MsgAuthEngineBoots, - MsgAuthEngineTime) of + MsgAuthEngineTime, + LocalEngineID) of discovery -> discovery; true -> @@ -205,15 +212,15 @@ authenticate_incoming(Packet, UsmSecParams, UsmUser, SecLevel) -> plain end. -authoritative(SecName, MsgAuthEngineBoots, MsgAuthEngineTime) -> +authoritative(SecName, MsgAuthEngineBoots, MsgAuthEngineTime, LocalEngineID) -> ?vtrace("authoritative -> entry with" "~n SecName: ~p" "~n MsgAuthEngineBoots: ~p" "~n MsgAuthEngineTime: ~p", [SecName, MsgAuthEngineBoots, MsgAuthEngineTime]), - SnmpEngineBoots = snmp_framework_mib:get_engine_boots(), + SnmpEngineBoots = get_local_engine_boots(LocalEngineID), ?vtrace("authoritative -> SnmpEngineBoots: ~p", [SnmpEngineBoots]), - SnmpEngineTime = snmp_framework_mib:get_engine_time(), + SnmpEngineTime = get_local_engine_time(LocalEngineID), ?vtrace("authoritative -> SnmpEngineTime: ~p", [SnmpEngineTime]), InTimeWindow = if @@ -320,11 +327,12 @@ non_authoritative(SecName, end. -is_auth(?usmNoAuthProtocol, _, _, _, SecName, _, _, _) -> % 3.2.5 +is_auth(?usmNoAuthProtocol, _, _, _, SecName, _, _, _, _) -> % 3.2.5 error(usmStatsUnsupportedSecLevels, ?usmStatsUnsupportedSecLevels_instance, SecName); % OTP-5464 is_auth(AuthProtocol, AuthKey, AuthParams, Packet, SecName, - MsgAuthEngineID, MsgAuthEngineBoots, MsgAuthEngineTime) -> + MsgAuthEngineID, MsgAuthEngineBoots, MsgAuthEngineTime, + LocalEngineID) -> TermDiscoEnabled = is_terminating_discovery_enabled(), TermDiscoStage2 = terminating_discovery_stage2(), IsAuth = auth_in(AuthProtocol, AuthKey, AuthParams, Packet), @@ -334,7 +342,7 @@ is_auth(AuthProtocol, AuthKey, AuthParams, Packet, SecName, %% 3.2.7 ?vtrace("is_auth -> " "retrieve EngineBoots and EngineTime: 3.2.7",[]), - SnmpEngineID = snmp_framework_mib:get_engine_id(), + SnmpEngineID = LocalEngineID, ?vtrace("is_auth -> SnmpEngineID: ~p", [SnmpEngineID]), case MsgAuthEngineID of SnmpEngineID when ((MsgAuthEngineBoots =:= 0) andalso @@ -351,12 +359,14 @@ is_auth(AuthProtocol, AuthKey, AuthParams, Packet, SecName, %% This will *always* result in the manager *not* %% beeing in timewindow authoritative(SecName, - MsgAuthEngineBoots, MsgAuthEngineTime); + MsgAuthEngineBoots, MsgAuthEngineTime, + LocalEngineID); SnmpEngineID -> %% 3.2.7a ?vtrace("is_auth -> we are authoritative: 3.2.7a", []), authoritative(SecName, - MsgAuthEngineBoots, MsgAuthEngineTime); + MsgAuthEngineBoots, MsgAuthEngineTime, + LocalEngineID); _ -> %% 3.2.7b - we're non-authoritative ?vtrace("is_auth -> we are non-authoritative: 3.2.7b",[]), @@ -418,12 +428,19 @@ try_decrypt(?usmAesCfb128Protocol, generate_outgoing_msg(Message, SecEngineID, SecName, SecData, SecLevel) -> + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + generate_outgoing_msg(Message, SecEngineID, SecName, SecData, SecLevel, + LocalEngineID). + +generate_outgoing_msg(Message, SecEngineID, SecName, SecData, SecLevel, + LocalEngineID) -> %% 3.1.1 ?vtrace("generate_outgoing_msg -> [3.1.1] entry with" - "~n SecEngineID: ~p" - "~n SecName: ~p" - "~n SecLevel: ~w", - [SecEngineID, SecName, SecLevel]), + "~n SecEngineID: ~p" + "~n SecName: ~p" + "~n SecLevel: ~w" + "~n LocalEngineID: ~p", + [SecEngineID, SecName, SecLevel, LocalEngineID]), {UserName, AuthProtocol, PrivProtocol, AuthKey, PrivKey} = case SecData of [] -> % 3.1.1b @@ -439,7 +456,7 @@ generate_outgoing_msg(Message, SecEngineID, SecName, SecData, SecLevel) -> element(?usmUserPrivKey, User)}; {_, Name,_,_,_,_,_,_,_,_,_,_,_, RowStatus,_,_} -> ?vdebug("generate_outgoing_msg -> " - "found user ~p with wrong row status: ~p", + "found not active user ~p: ~p", [Name, RowStatus]), error(unknownSecurityName); _ -> @@ -460,7 +477,7 @@ generate_outgoing_msg(Message, SecEngineID, SecName, SecData, SecLevel) -> ScopedPduBytes = Message#message.data, {ScopedPduData, MsgPrivParams} = encrypt(ScopedPduBytes, PrivProtocol, PrivKey, SecLevel), - SnmpEngineID = snmp_framework_mib:get_engine_id(), + SnmpEngineID = LocalEngineID, ?vtrace("generate_outgoing_msg -> SnmpEngineID: ~p [3.1.6]", [SnmpEngineID]), %% 3.1.6 @@ -474,8 +491,8 @@ generate_outgoing_msg(Message, SecEngineID, SecName, SecData, SecLevel) -> {get_engine_boots(SecEngineID), get_engine_time(SecEngineID)}; _ -> - {snmp_framework_mib:get_engine_boots(), - snmp_framework_mib:get_engine_time()} + {get_local_engine_boots(SnmpEngineID), + get_local_engine_time(SnmpEngineID)} end, %% 3.1.5 - 3.1.7 ?vtrace("generate_outgoing_msg -> [3.1.5 - 3.1.7]",[]), @@ -681,6 +698,19 @@ current_statsNotInTimeWindows_vb() -> value = get_counter(usmStatsNotInTimeWindows)}. + +%%----------------------------------------------------------------- +%% Future profing... +%%----------------------------------------------------------------- + +get_local_engine_boots(_LocalEngineID) -> + snmp_framework_mib:get_engine_boots(). + +get_local_engine_time(_LocalEngineID) -> + snmp_framework_mib:get_engine_time(). + + + %%----------------------------------------------------------------- %% We cache the local values of all non-auth engines we know. %% Keep the values in the snmp_agent_table. diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index a138a2dfd1..9ad16ffad2 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,44 +22,68 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.16.2", + [ + {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + + {load_module, snmpm_mpd, soft_purge, soft_purge, []} + ] + }, {"4.16.1", [ + {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, []}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.16", [ - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.15", [ - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmp_log, snmpa_agent]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpm_config, snmp_log]}, {update, snmpm_config, soft, soft_purge, soft_purge, []}, @@ -68,18 +92,21 @@ }, {"4.14", [ - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmp_log, snmpa_agent]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, - soft_purge, soft_purge, [snmpa_agent, snmp_log]}, + soft_purge, soft_purge, [snmp_log, snmpa_agent]}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, @@ -91,19 +118,22 @@ }, {"4.13.5", [ - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmp_log, snmpa_agent]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, {update, snmpm_net_if, {advanced, upgrade_from_pre_4_14}, @@ -119,45 +149,69 @@ %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.16.2", + [ + {load_module, snmp_log, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + + {load_module, snmpm_mpd, soft_purge, soft_purge, []} + ] + }, {"4.16.1", [ + {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, []}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.16", [ - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, - {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.15", [ - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpm_config, snmp_log]}, {update, snmpm_config, soft, soft_purge, soft_purge, []}, @@ -166,18 +220,21 @@ }, {"4.14", [ - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {update, snmpa_mib, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, @@ -189,19 +246,22 @@ }, {"4.13.5", [ - {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + + {load_module, snmpa, soft_purge, soft_purge, [snmp_log, snmpa_agent]}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, + {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, + {load_module, snmpa_mpd, soft_purge, soft_purge, [snmpa_usm]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, - {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, - {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, {update, snmpm_net_if, {advanced, downgrade_to_pre_4_14}, diff --git a/lib/snmp/src/manager/snmpm_mpd.erl b/lib/snmp/src/manager/snmpm_mpd.erl index d76ad20051..7712370d28 100644 --- a/lib/snmp/src/manager/snmpm_mpd.erl +++ b/lib/snmp/src/manager/snmpm_mpd.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -257,11 +257,11 @@ process_v3_msg(NoteStore, Msg, Hdr, Data, Addr, Port, Log) -> end, ?vlog("7.2.7" - "~n ContextEngineID: \"~s\" " + "~n ContextEngineID: ~p " "~n context: \"~s\" ", [CtxEngineID, CtxName]), if - SecLevel == 3 -> % encrypted message - log decrypted pdu + SecLevel =:= 3 -> % encrypted message - log decrypted pdu Log({Hdr, ScopedPDUBytes}); true -> % otherwise, log binary Log(Msg) @@ -338,7 +338,8 @@ process_v3_msg(NoteStore, Msg, Hdr, Data, Addr, Port, Log) -> SnmpEngineID = get_engine_id(), case SecEngineID of SnmpEngineID -> % 7.2.13.b - ?vtrace("valid securityEngineID: ~p", [SecEngineID]), + ?vtrace("7.2.13d - valid securityEngineID: ~p", + [SecEngineID]), %% 4.2.2.1.1 - we don't handle proxys yet => we only %% handle CtxEngineID to ourselves %% Check that we actually know of an agent with this @@ -353,7 +354,9 @@ process_v3_msg(NoteStore, Msg, Hdr, Data, Addr, Port, Log) -> {MsgID, MsgSecModel, SecName, SecLevel, CtxEngineID, CtxName, SecData}, {ok, 'version-3', PDU, PduMMS, ACMData}; - _ -> + UnknownEngineID -> + ?vtrace("4.2.2.1.2 - UnknownEngineId: ~p", + [UnknownEngineID]), %% 4.2.2.1.2 NIsReportable = snmp_misc:is_reportable_pdu(Type), Val = inc(snmpUnknownPDUHandlers), @@ -377,7 +380,8 @@ process_v3_msg(NoteStore, Msg, Hdr, Data, Addr, Port, Log) -> end end; _ -> % 7.2.13.a - ?vinfo("invalid securityEngineID: ~p",[SecEngineID]), + ?vinfo("7.2.13a - invalid securityEngineID: ~p", + [SecEngineID]), discard({badSecurityEngineID, SecEngineID}) end; diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index af0581150a..2534147769 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1046,7 +1046,7 @@ v1_cases() -> sparse_table, cnt_64, opaque, - + change_target_addr_config ]. @@ -1977,7 +1977,8 @@ inform_i(Config) -> ?P1("unload TestTrap & TestTrapv2..."), ?line unload_master("TestTrap"), - ?line unload_master("TestTrapv2"). + ?line unload_master("TestTrapv2"), + ok. v3_inform_i(X) -> %% <CONDITIONAL-SKIP> @@ -3446,7 +3447,7 @@ do_mul_set_err() -> ?line ?v1_2(expect(2, noSuchName, 1, any), expect(2, [{[friendsEntry, [2,3]], noSuchInstance}])), g([NewKeyc4]), - ?line ?v1_2(expect(3, noSuchName, 1, any), + ?line ?v1_2(expect(3, noSuchName, 1, any), expect(3, [{NewKeyc4, noSuchInstance}])). %% Req. SA-MIB @@ -3457,10 +3458,10 @@ sa_mib() -> ?line expect(2, [{[sa, [1,0]], "sa_test"}]). ma_trap1(MA) -> - snmpa:send_trap(MA, testTrap2, "standard trap"), + ok = snmpa:send_trap(MA, testTrap2, "standard trap"), ?line expect(1, trap, [system], 6, 1, [{[system, [4,0]], "{mbj,eklas}@erlang.ericsson.se"}]), - snmpa:send_trap(MA, testTrap1, "standard trap"), + ok = snmpa:send_trap(MA, testTrap1, "standard trap"), ?line expect(2, trap, [1,2,3] , 1, 0, [{[system, [4,0]], "{mbj,eklas}@erlang.ericsson.se"}]). @@ -3509,7 +3510,8 @@ ma_v2_trap1(MA) -> ?DBG("ma_v2_traps -> send standard trap: testTrapv21",[]), snmpa:send_trap(MA, testTrapv21, "standard trap"), ?line expect(2, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?snmp ++ [1]}]). + {[snmpTrapOID, 0], ?snmp ++ [1]}]), + ok. ma_v2_trap2(MA) -> snmpa:send_trap(MA,testTrapv22,"standard trap",[{sysContact,"pelle"}]), @@ -3517,7 +3519,7 @@ ma_v2_trap2(MA) -> {[snmpTrapOID, 0], ?system ++ [0,1]}, {[system, [4,0]], "pelle"}]). -%% Note: This test case takes a while... actually a couple of minutes. +%% Note: This test case takes a while... actually a couple of minutes. ma_v2_inform1(MA) -> ?DBG("ma_v2_inform1 -> entry with" "~n MA = ~p => " @@ -6219,12 +6221,15 @@ verify_old_info([Key|Keys], Info) -> is(S) -> [length(S) | S]. try_test(Func) -> + ?P2("try test ~w...", [Func]), snmp_agent_test_lib:try_test(?MODULE, Func). try_test(Func, A) -> + ?P2("try test ~w...", [Func]), snmp_agent_test_lib:try_test(?MODULE, Func, A). try_test(Func, A, Opts) -> + ?P2("try test ~w...", [Func]), snmp_agent_test_lib:try_test(?MODULE, Func, A, Opts). diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 31b375efa9..9e89aa889c 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -421,7 +421,7 @@ start_agent(Config, Vsns, Opts) -> ?LOG("start_agent -> entry (~p) with" "~n Config: ~p" "~n Vsns: ~p" - "~n Opts: ~p",[node(), Config, Vsns, Opts]), + "~n Opts: ~p", [node(), Config, Vsns, Opts]), ?line AgentDir = ?config(agent_dir, Config), ?line SaNode = ?config(snmp_sa, Config), diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index c3704bf6c9..4ca1fb7901 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -17,11 +17,19 @@ # # %CopyrightEnd% -SNMP_VSN = 4.16.2 +SNMP_VSN = 4.17 PRE_VSN = APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)" -TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 OTP-8646 OTP-8648 +TICKETS = OTP-8478 + +TICKETS_4_16_2 = \ + OTP-8563 \ + OTP-8574 \ + OTP-8594 \ + OTP-8595 \ + OTP-8646 \ + OTP-8648 TICKETS_4_16_1 = \ OTP-8480 \ @@ -32,149 +40,18 @@ TICKETS_4_16 = \ OTP-8433 \ OTP-8442 -TICKETS_4_15 = OTP-8229 OTP-8249 - -TICKETS_4_14 = OTP-8223 OTP-8228 OTP-8237 - -TICKETS_4_13_5 = OTP-8116 OTP-8120 OTP-8181 OTP-8182 - -TICKETS_4_13_4 = OTP-8044 OTP-8062 OTP-8098 - -TICKETS_4_13_3 = OTP-8015 OTP-8020 - -TICKETS_4_13_2 = OTP-7961 OTP-7977 OTP-7983 OTP-7989 - -TICKETS_4_13_1 = OTP-7902 - -TICKETS_4_13 = OTP-7571 OTP-7735 OTP-7836 OTP-7851 - -TICKETS_4_12_2 = OTP-7868 - -TICKETS_4_12_1 = OTP-7695 OTP-7698 - -TICKETS_4_12 = OTP-7346 OTP-7525 - -TICKETS_4_11_2 = OTP-7570 OTP-7575 - -TICKETS_4_11_1 = OTP-7390 OTP-7412 OTP-7426 OTP-7432 - -TICKETS_4_11 = OTP-7201 OTP-7287 OTP-7319 OTP-7369 OTP-7371 OTP-7377 OTP-7381 - -TICKETS_4_10_3 = OTP-7219 - -TICKETS_4_10_2 = OTP-7152 OTP-7153 OTP-7157 OTP-7158 OTP-7159 OTP-7160 - -TICKETS_4_10_1 = OTP-7083 OTP-7109 OTP-7110 OTP-7119 OTP-7121 OTP-7123 - -TICKETS_4_10 = OTP-6649 OTP-6841 OTP-6898 OTP-6945 - -TICKETS_4_9_6 = OTP-6840 OTP-6843 - -TICKETS_4_9_5 = OTP-6805 OTP-6815 - -TICKETS_4_9_4 = OTP-6784 OTP-6771 - -TICKETS_4_9_3 = OTP-6605 OTP-6712 OTP-6713 - -TICKETS_4_9_2 = OTP-6571 - -TICKETS_4_9_1 = OTP-6566 OTP-6569 - -TICKETS_4_9 = \ - OTP-6317 \ - OTP-6318 \ - OTP-6383 \ - OTP-6487 \ - OTP-6515 \ - OTP-6518 \ - OTP-6529 \ - OTP-6532 \ - OTP-6533 \ - OTP-6540 - -TICKETS_4_8_4 = OTP-6408 - -TICKETS_4_8_3 = OTP-6337 OTP-6340 - -TICKETS_4_8_2 = OTP-6214 OTP-6247 OTP-6293 - -TICKETS_4_8_1 = OTP-6176 OTP-6177 - -TICKETS_4_8 = OTP-6137 OTP-6149 OTP-6150 OTP-6164 - -TICKETS_4_7_4 = \ - OTP-6042 \ - OTP-6044 \ - OTP-6049 \ - OTP-6062 \ - OTP-6068 \ - OTP-6074 \ - OTP-6077 \ - OTP-6081 - -TICKETS_4_7_3 = \ - OTP-6031 \ - OTP-6032 - -TICKETS_4_7_2 = \ - OTP-5992 \ - OTP-6024 - -TICKETS_4_7_1 = \ - OTP-5963 \ - OTP-5968 \ - OTP-5969 - -TICKETS_4_7 = \ - OTP-5870 \ - OTP-5934 \ - OTP-5935 \ - OTP-5937 - -TICKETS_4_6_1 = \ - OTP-5834 \ - OTP-5838 - -TICKETS_4_6 = \ - OTP-5763 \ - OTP-5771 \ - OTP-5787 \ - OTP-5797 \ - OTP-5829 - -TICKETS_4_5 = \ - OTP-5581 \ - OTP-5726 \ - OTP-5727 \ - OTP-5732 \ - OTP-5733 \ - OTP-5740 \ - OTP-5742 - -TICKETS_4_4_1 = \ - OTP-5719 \ - OTP-5720 - -TICKETS_4_4 = \ - OTP-5666 \ - OTP-5668 \ - OTP-5669 \ - OTP-5675 \ - OTP-5676 \ - OTP-5678 \ - OTP-5703 +TICKETS_4_15 = \ + OTP-8229 \ + OTP-8249 -TICKETS_4_3 = \ - OTP-5636 \ - OTP-5637 \ - OTP-5490 +TICKETS_4_14 = \ + OTP-8223 \ + OTP-8228 \ + OTP-8237 -TICKETS_4_2 = \ - OTP-5574 \ - OTP-5578 \ - OTP-5579 \ - OTP-5580 \ - OTP-5590 \ - OTP-5591 \ - OTP-5592 +TICKETS_4_13_5 = \ + OTP-8116 \ + OTP-8120 \ + OTP-8181 \ + OTP-8182 diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 644c2772b2..9b51c68e86 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -65,6 +65,7 @@ ssl_options, % #ssl_options{} socket_options, % #socket_options{} connection_states, % #connection_states{} from ssl_record.hrl + tls_packets = [], % Not yet handled decode ssl/tls packets. tls_record_buffer, % binary() buffer of incomplete records tls_handshake_buffer, % binary() buffer of incomplete handshakes %% {{md5_hash, sha_hash}, {prev_md5, prev_sha}} (binary()) @@ -1727,9 +1728,23 @@ opposite_role(server) -> send_user(Pid, Msg) -> Pid ! Msg. +handle_tls_handshake(Handle, StateName, #state{tls_packets = [Packet]} = State) -> + FsmReturn = {next_state, StateName, State#state{tls_packets = []}}, + Handle(Packet, FsmReturn); + +handle_tls_handshake(Handle, StateName, #state{tls_packets = [Packet | Packets]} = State0) -> + FsmReturn = {next_state, StateName, State0#state{tls_packets = Packets}}, + case Handle(Packet, FsmReturn) of + {next_state, NextStateName, State} -> + handle_tls_handshake(Handle, NextStateName, State); + {stop, _,_} = Stop -> + Stop + end. + next_state(_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> handle_own_alert(Alert, Version, decipher_error, State), {stop, normal, State}; + next_state(Next, no_record, State) -> {next_state, Next, State}; @@ -1764,8 +1779,8 @@ next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, end, try {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0, KeyAlg,Version), - Start = {next_state, StateName, State0#state{tls_handshake_buffer = Buf}}, - lists:foldl(Handle, Start, Packets) + State = State0#state{tls_packets = Packets, tls_handshake_buffer = Buf}, + handle_tls_handshake(Handle, StateName, State) catch throw:#alert{} = Alert -> handle_own_alert(Alert, Version, StateName, State0), {stop, normal, State0} @@ -1802,17 +1817,19 @@ next_tls_record(Data, #state{tls_record_buffer = Buf0, Alert end. -next_record(#state{tls_cipher_texts = [], socket = Socket} = State) -> +next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket} = State) -> inet:setopts(Socket, [{active,once}]), {no_record, State}; -next_record(#state{tls_cipher_texts = [CT | Rest], +next_record(#state{tls_packets = [], tls_cipher_texts = [CT | Rest], connection_states = ConnStates0} = State) -> case ssl_record:decode_cipher_text(CT, ConnStates0) of {Plain, ConnStates} -> {Plain, State#state{tls_cipher_texts = Rest, connection_states = ConnStates}}; #alert{} = Alert -> {Alert, State} - end. + end; +next_record(State) -> + {no_record, State}. next_record_if_active(State = #state{socket_options = diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index c71dad6163..91ff2438c6 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -41,6 +41,8 @@ terminate/2,code_change/3]). -export([make_crypto_key/2, get_crypto_key/1]). %Utilities used by compiler +-export_type([attrib_entry/0, compinfo_entry/0, labeled_entry/0]). + -import(lists, [append/1, delete/2, foreach/2, keysort/2, member/2, reverse/1, sort/1, splitwith/2]). diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 7f1c13770b..4584b8184f 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(dets). @@ -88,6 +88,7 @@ %% Not documented, or not ready for publication. -export([lookup_keys/2]). +-export_type([tab_name/0]). -compile({inline, [{einval,2},{badarg,2},{undefined,1}, {badarg_exit,2},{lookup_reply,2}]}). diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index 9bdea671a9..b5f52da921 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(digraph). @@ -36,6 +36,8 @@ -export([get_short_path/3, get_short_cycle/2]). +-export_type([d_type/0, vertex/0]). + -record(digraph, {vtab = notable :: ets:tab(), etab = notable :: ets:tab(), ntab = notable :: ets:tab(), diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index d9d15e05f8..abff37e4bc 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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(erl_compile). @@ -23,6 +23,8 @@ -export([compile_cmdline/1]). +-export_type([cmd_line_arg/0]). + %% Mapping from extension to {M,F} to run the correct compiler. compiler(".erl") -> {compile, compile}; diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 18c467db81..61ce41f714 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -97,7 +97,7 @@ forms([], St) -> {[],St}. clauses([{clause,Line,H0,G0,B0} | Cs0], St0) -> {H1,St1} = head(H0, St0), {G1,St2} = guard(G0, St1), - {H,G} = optimize_is_record(H1, G1), + {H,G} = optimize_is_record(H1, G1, St2), {B,St3} = exprs(B0, St2), {Cs,St4} = clauses(Cs0, St3), {[{clause,Line,H,G,B} | Cs],St4}; @@ -805,14 +805,19 @@ imported(F, A, St) -> %%% Replace is_record/3 in guards with matching if possible. %%% -optimize_is_record(H0, G0) -> +optimize_is_record(H0, G0, #exprec{compile=Opts}) -> case opt_rec_vars(G0) of [] -> {H0,G0}; Rs0 -> - {H,Rs} = opt_pattern_list(H0, Rs0), - G = opt_remove(G0, Rs), - {H,G} + case lists:member(no_is_record_optimization, Opts) of + true -> + {H0,G0}; + false -> + {H,Rs} = opt_pattern_list(H0, Rs0), + G = opt_remove(G0, Rs), + {H,G} + end end. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 229d455e06..6bbb52ebae 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -40,7 +40,7 @@ %% Value. %% The option handling functions. --spec bool_option(atom(), atom(), boolean(), [_]) -> boolean(). +-spec bool_option(atom(), atom(), boolean(), [compile:option()]) -> boolean(). bool_option(On, Off, Default, Opts) -> foldl(fun (Opt, _Def) when Opt =:= On -> true; @@ -72,6 +72,10 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). +-type line() :: erl_scan:line(). % a convenient alias +-type fa() :: {atom(), arity()}. % function+arity +-type ta() :: {atom(), arity()}. % type+arity + %% Usage of records, functions, and imports. The variable table, which %% is passed on as an argument, holds the usage of variables. -record(usage, { @@ -97,8 +101,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> locals=gb_sets:empty() :: gb_set(), %All defined functions (prescanned) no_auto=gb_sets:empty() :: gb_set(), %Functions explicitly not autoimported defined=gb_sets:empty() :: gb_set(), %Defined fuctions - on_load=[] :: [{atom(),integer()}], %On-load function - on_load_line=0 :: integer(), %Line for on_load + on_load=[] :: [fa()], %On-load function + on_load_line=0 :: line(), %Line for on_load clashes=[], %Exported functions named as BIFs not_deprecated=[], %Not considered deprecated func=[], %Current function @@ -112,13 +116,14 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %outside any fun or lc xqlc= false :: boolean(), %true if qlc.hrl included new = false :: boolean(), %Has user-defined 'new/N' - called= [], %Called functions + called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, specs = dict:new() :: dict(), %Type specifications - types = dict:new() :: dict() %Type definitions + types = dict:new() :: dict(), %Type definitions + exp_types=gb_sets:empty():: gb_set() %Exported types }). -%% -type lint_state() :: #lint{}. +-type lint_state() :: #lint{}. %% format_error(Error) %% Return a string describing the error. @@ -303,6 +308,8 @@ format_error({ill_defined_behaviour_callbacks,Behaviour}) -> %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); +format_error({duplicated_export_type, {T, A}}) -> + io_lib:format("type ~w/~w already exported", [T, A]); format_error({undefined_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]); format_error({unused_type, {TypeName, Arity}}) -> @@ -684,6 +691,8 @@ attribute_state({attribute,L,extends,_M}, St) -> add_error(L, invalid_extends, St); attribute_state({attribute,L,export,Es}, St) -> export(L, Es, St); +attribute_state({attribute,L,export_type,Es}, St) -> + export_type(L, Es, St); attribute_state({attribute,L,import,Is}, St) -> import(L, Is, St); attribute_state({attribute,L,record,{Name,Fields}}, St) -> @@ -1093,7 +1102,7 @@ check_unused_records(Forms, St0) -> %% For storing the import list we use the orddict module. %% We know an empty set is []. -%% export(Line, Exports, State) -> State. +-spec export(line(), [fa()], lint_state()) -> lint_state(). %% Mark functions as exported, also as called from the export line. export(Line, Es, #lint{exports = Es0, called = Called} = St0) -> @@ -1101,7 +1110,8 @@ export(Line, Es, #lint{exports = Es0, called = Called} = St0) -> foldl(fun (NA, {E,C,St2}) -> St = case gb_sets:is_element(NA, E) of true -> - add_warning(Line, {duplicated_export, NA}, St2); + Warn = {duplicated_export,NA}, + add_warning(Line, Warn, St2); false -> St2 end, @@ -1110,8 +1120,27 @@ export(Line, Es, #lint{exports = Es0, called = Called} = St0) -> {Es0,Called,St0}, Es), St1#lint{exports = Es1, called = C1}. -%% import(Line, Imports, State) -> State. -%% imported(Name, Arity, State) -> {yes,Module} | no. +-spec export_type(line(), [ta()], lint_state()) -> lint_state(). +%% Mark types as exported; also mark them as used from the export line. + +export_type(Line, ETs, #lint{usage = Usage, exp_types = ETs0} = St0) -> + UTs0 = Usage#usage.used_types, + {ETs1,UTs1,St1} = + foldl(fun (TA, {E,U,St2}) -> + St = case gb_sets:is_element(TA, E) of + true -> + Warn = {duplicated_export_type,TA}, + add_warning(Line, Warn, St2); + false -> + St2 + end, + {gb_sets:add_element(TA, E), dict:store(TA, Line, U), St} + end, + {ETs0,UTs0,St0}, ETs), + St1#lint{usage = Usage#usage{used_types = UTs1}, exp_types = ETs1}. + +-type import() :: {module(), [fa()]} | module(). +-spec import(line(), import(), lint_state()) -> lint_state(). import(Line, {Mod,Fs}, St) -> Mod1 = package_to_string(Mod), @@ -1200,13 +1229,15 @@ check_imports(_Line, Fs, Is) -> add_imports(Mod, Fs, Is) -> foldl(fun (F, Is0) -> orddict:store(F, Mod, Is0) end, Is, Fs). +-spec imported(atom(), arity(), lint_state()) -> {'yes',module()} | 'no'. + imported(F, A, St) -> case orddict:find({F,A}, St#lint.imports) of {ok,Mod} -> {yes,Mod}; error -> no end. -%% on_load(Line, Val, State) -> State. +-spec on_load(line(), fa(), lint_state()) -> lint_state(). %% Check an on_load directive and remember it. on_load(Line, {Name,Arity}=Fa, #lint{on_load=OnLoad0}=St0) @@ -1238,7 +1269,7 @@ check_on_load(#lint{defined=Defined,on_load=[{_,0}=Fa], end; check_on_load(St) -> St. -%% call_function(Line, Name, Arity, State) -> State. +-spec call_function(line(), atom(), arity(), lint_state()) -> lint_state(). %% Add to both called and calls. call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func}=St) -> @@ -1258,7 +1289,7 @@ function(Line, Name, Arity, Cs, St0) -> St1 = define_function(Line, Name, Arity, St0#lint{func={Name,Arity}}), clauses(Cs, St1#lint.global_vt, St1). -%% define_function(Line, Name, Arity, State) -> State. +-spec define_function(line(), atom(), arity(), lint_state()) -> lint_state(). define_function(Line, Name, Arity, St0) -> St1 = keyword_warning(Line, Name, St0), @@ -2744,10 +2775,12 @@ add_missing_spec_warnings(Forms, St0, Type) -> add_warning(L, {missing_spec,FA}, St) end, St0, Warns). -check_unused_types(Forms, St = #lint{usage=Usage, types=Types}) -> +check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> case [File || {attribute,_L,file,{File,_Line}} <- Forms] of [FirstFile|_] -> - UsedTypes = Usage#usage.used_types, + D = Usage#usage.used_types, + L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), + UsedTypes = gb_sets:from_list(L), FoldFun = fun(_Type, -1, AccSt) -> %% Default type @@ -2755,19 +2788,18 @@ check_unused_types(Forms, St = #lint{usage=Usage, types=Types}) -> (Type, FileLine, AccSt) -> case loc(FileLine) of {FirstFile, _} -> - case dict:is_key(Type, UsedTypes) of + case gb_sets:is_member(Type, UsedTypes) of true -> AccSt; false -> - add_warning(FileLine, - {unused_type, Type}, - AccSt) + Warn = {unused_type,Type}, + add_warning(FileLine, Warn, AccSt) end; _ -> - %% Don't warn about unused types in include file + %% No warns about unused types in include files AccSt end end, - dict:fold(FoldFun, St, Types); + dict:fold(FoldFun, St, Ts); [] -> St end. diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index c179c3d067..18f64c46d0 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -55,18 +55,13 @@ token_info/1,token_info/2, attributes_info/1,attributes_info/2,set_attribute/3]). -%%% Local record. --record(erl_scan, - {resword_fun=fun reserved_word/1, - ws=false, - comment=false, - text=false}). +-export_type([error_info/0, line/0, tokens_result/0]). %%% -%%% Exported functions +%%% Defines and type definitions %%% --define(COLUMN(C), is_integer(C), C >= 1). +-define(COLUMN(C), (is_integer(C) andalso C >= 1)). %% Line numbers less than zero have always been allowed: -define(ALINE(L), is_integer(L)). -define(STRING(S), is_list(S)). @@ -95,6 +90,15 @@ -type error_description() :: term(). -type error_info() :: {location(), module(), error_description()}. +%%% Local record. +-record(erl_scan, + {resword_fun = fun reserved_word/1 :: resword_fun(), + ws = false :: boolean(), + comment = false :: boolean(), + text = false :: boolean()}). + +%%---------------------------------------------------------------------------- + -spec format_error(Error :: term()) -> string(). format_error({string,Quote,Head}) -> lists:flatten(["unterminated " ++ string_thing(Quote) ++ @@ -307,10 +311,10 @@ options(Opt) -> options([Opt]). opts(Options, [Key|Keys], L) -> - V = case lists:keysearch(Key, 1, Options) of - {value,{reserved_word_fun,F}} when ?RESWORDFUN(F) -> + V = case lists:keyfind(Key, 1, Options) of + {reserved_word_fun,F} when ?RESWORDFUN(F) -> {ok,F}; - {value,{Key,_}} -> + {Key,_} -> badarg; false -> {ok,default_option(Key)} @@ -333,12 +337,13 @@ expand_opt(O, Os) -> [O|Os]. attr_info(Attrs, Item) -> - case catch lists:keysearch(Item, 1, Attrs) of - {value,{Item,Value}} -> - {Item,Value}; + try lists:keyfind(Item, 1, Attrs) of + {_Item, _Value} = T -> + T; false -> - undefined; - _ -> + undefined + catch + _:_ -> erlang:error(badarg, [Attrs, Item]) end. diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index d7b5dbc636..b0a197d784 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -42,6 +42,8 @@ -export([i/0, i/1, i/2, i/3]). +-export_type([tab/0]). + %%------------------------------------------------------------------------------ -type tab() :: atom() | tid(). diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 1f8076e864..1d0f9374bc 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(io). @@ -32,6 +32,7 @@ parse_erl_form/1,parse_erl_form/2,parse_erl_form/3]). -export([request/1,request/2,requests/1,requests/2]). +-export_type([device/0, format/0]). %%------------------------------------------------------------------------- diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 26f6ec8931..4ca9d079b7 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -75,6 +75,8 @@ collect_line/2, collect_line/3, collect_line/4, get_until/3, get_until/4]). +-export_type([chars/0]). + %%---------------------------------------------------------------------- %% XXX: overapproximates a deep list of (unicode) characters diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index 74316dc730..33553692bc 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(io_lib_fread). @@ -22,6 +22,8 @@ -export([fread/2,fread/3]). +-export_type([continuation/0, fread_2_ret/0, fread_3_ret/0]). + -import(lists, [reverse/1,reverse/2]). %%----------------------------------------------------------------------- diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 9aa5e0a71e..4fb64a3353 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(proc_lib). @@ -34,6 +34,8 @@ %% Internal exports. -export([wake_up/3]). +-export_type([spawn_option/0]). + %%----------------------------------------------------------------------------- -type priority_level() :: 'high' | 'low' | 'max' | 'normal'. diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl index 35d14891f1..6a45e0f868 100644 --- a/lib/stdlib/src/proplists.erl +++ b/lib/stdlib/src/proplists.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %% ===================================================================== @@ -49,6 +49,8 @@ %% --------------------------------------------------------------------- +-export_type([property/0]). + -type property() :: atom() | tuple(). -type aliases() :: [{any(), any()}]. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 22269a8d1b..f5d5441184 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -21,7 +21,7 @@ -behaviour(gen_server). %% External exports --export([start_link/2,start_link/3, +-export([start_link/2, start_link/3, start_child/2, restart_child/2, delete_child/2, terminate_child/2, which_children/1, count_children/1, @@ -33,25 +33,47 @@ -export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). -export([handle_cast/2]). +-export_type([child_spec/0, strategy/0]). + +%%-------------------------------------------------------------------------- + +-type child_id() :: pid() | 'undefined'. +-type mfargs() :: {module(), atom(), [term()]}. +-type modules() :: [module()] | 'dynamic'. +-type restart() :: 'permanent' | 'transient' | 'temporary'. +-type shutdown() :: 'brutal_kill' | timeout(). +-type worker() :: 'worker' | 'supervisor'. +-type sup_name() :: {'local', atom()} | {'global', atom()}. +-type sup_ref() :: atom() | {atom(), atom()} | {'global', atom()} | pid(). +-type child_spec() :: {term(),mfargs(),restart(),shutdown(),worker(),modules()}. + +-type strategy() :: 'one_for_all' | 'one_for_one' + | 'rest_for_one' | 'simple_one_for_one'. + +%%-------------------------------------------------------------------------- + +-record(child, {% pid is undefined when child is not running + pid = undefined :: child_id(), + name, + mfargs :: mfargs(), + restart_type :: restart(), + shutdown :: shutdown(), + child_type :: worker(), + modules = [] :: modules()}). +-type child() :: #child{}. + -define(DICT, dict). -record(state, {name, - strategy, - children = [], - dynamics = ?DICT:new(), - intensity, - period, + strategy :: strategy(), + children = [] :: [child()], + dynamics = ?DICT:new() :: ?DICT(), + intensity :: non_neg_integer(), + period :: pos_integer(), restarts = [], module, args}). - --record(child, {pid = undefined, % pid is undefined when child is not running - name, - mfa, - restart_type, - shutdown, - child_type, - modules = []}). +-type state() :: #state{}. -define(is_simple(State), State#state.strategy =:= simple_one_for_one). @@ -65,21 +87,40 @@ behaviour_info(_Other) -> %%% Servers/processes should/could also be built using gen_server.erl. %%% SupName = {local, atom()} | {global, atom()}. %%% --------------------------------------------------- + +-type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). +-type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. + +-spec start_link(module(), term()) -> startlink_ret(). start_link(Mod, Args) -> gen_server:start_link(supervisor, {self, Mod, Args}, []). +-spec start_link(sup_name(), module(), term()) -> startlink_ret(). start_link(SupName, Mod, Args) -> gen_server:start_link(SupName, supervisor, {SupName, Mod, Args}, []). %%% --------------------------------------------------- %%% Interface functions. %%% --------------------------------------------------- + +-type info() :: term(). +-type startchild_err() :: 'already_present' + | {'already_started', child_id()} | term(). +-type startchild_ret() :: {'ok', child_id()} | {'ok', child_id(), info()} + | {'error', startchild_err()}. + +-spec start_child(sup_ref(), child_spec() | [term()]) -> startchild_ret(). start_child(Supervisor, ChildSpec) -> call(Supervisor, {start_child, ChildSpec}). +-type restart_err() :: 'running' | 'not_found' | 'simple_one_for_one' | term(). +-spec restart_child(sup_ref(), term()) -> + {'ok', child_id()} | {'ok', child_id(), info()} | {'error', restart_err()}. restart_child(Supervisor, Name) -> call(Supervisor, {restart_child, Name}). +-type del_err() :: 'running' | 'not_found' | 'simple_one_for_one'. +-spec delete_child(sup_ref(), term()) -> 'ok' | {'error', del_err()}. delete_child(Supervisor, Name) -> call(Supervisor, {delete_child, Name}). @@ -89,9 +130,13 @@ delete_child(Supervisor, Name) -> %% Note that the child is *always* terminated in some %% way (maybe killed). %%----------------------------------------------------------------- + +-type term_err() :: 'not_found' | 'simple_one_for_one'. +-spec terminate_child(sup_ref(), term()) -> 'ok' | {'error', term_err()}. terminate_child(Supervisor, Name) -> call(Supervisor, {terminate_child, Name}). +-spec which_children(sup_ref()) -> [{term(), child_id(), worker(), modules()}]. which_children(Supervisor) -> call(Supervisor, which_children). @@ -101,6 +146,7 @@ count_children(Supervisor) -> call(Supervisor, Req) -> gen_server:call(Supervisor, Req, infinity). +-spec check_childspecs([child_spec()]) -> 'ok' | {'error', term()}. check_childspecs(ChildSpecs) when is_list(ChildSpecs) -> case check_startspec(ChildSpecs) of {ok, _} -> ok; @@ -113,6 +159,14 @@ check_childspecs(X) -> {error, {badarg, X}}. %%% Initialize the supervisor. %%% %%% --------------------------------------------------- + +-type stop_rsn() :: 'shutdown' | {'bad_return', {module(),'init', term()}} + | {'bad_start_spec', term()} | {'start_spec', term()} + | {'supervisor_data', term()}. + +-spec init({sup_name(), module(), [term()]}) -> + {'ok', state()} | 'ignore' | {'stop', stop_rsn()}. + init({SupName, Mod, Args}) -> process_flag(trap_exit, true), case Mod:init(Args) of @@ -158,12 +212,12 @@ init_dynamic(_State, StartSpec) -> %%----------------------------------------------------------------- %% Func: start_children/2 -%% Args: Children = [#child] in start order -%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Args: Children = [child()] in start order +%% SupName = {local, atom()} | {global, atom()} | {pid(), Mod} %% Purpose: Start all children. The new list contains #child's %% with pids. %% Returns: {ok, NChildren} | {error, NChildren} -%% NChildren = [#child] in termination order (reversed +%% NChildren = [child()] in termination order (reversed %% start order) %%----------------------------------------------------------------- start_children(Children, SupName) -> start_children(Children, [], SupName). @@ -182,8 +236,8 @@ start_children([], NChildren, _SupName) -> {ok, NChildren}. do_start_child(SupName, Child) -> - #child{mfa = {M, F, A}} = Child, - case catch apply(M, F, A) of + #child{mfargs = {M, F, Args}} = Child, + case catch apply(M, F, Args) of {ok, Pid} when is_pid(Pid) -> NChild = Child#child{pid = Pid}, report_progress(NChild, SupName), @@ -192,7 +246,7 @@ do_start_child(SupName, Child) -> NChild = Child#child{pid = Pid}, report_progress(NChild, SupName), {ok, Pid, Extra}; - ignore -> + ignore -> {ok, undefined}; {error, What} -> {error, What}; What -> {error, What} @@ -211,15 +265,17 @@ do_start_child_i(M, F, A) -> What -> {error, What} end. - %%% --------------------------------------------------- %%% %%% Callback functions. %%% %%% --------------------------------------------------- +-type call() :: 'which_children' | 'count_children' | {_, _}. % XXX: refine +-spec handle_call(call(), term(), state()) -> {'reply', term(), state()}. + handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> - #child{mfa = {M, F, A}} = hd(State#state.children), + #child{mfargs = {M, F, A}} = hd(State#state.children), Args = A ++ EArgs, case do_start_child_i(M, F, Args) of {ok, Pid} -> @@ -235,7 +291,7 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> end; %%% The requests terminate_child, delete_child and restart_child are -%%% invalid for simple_one_for_one supervisors. +%%% invalid for simple_one_for_one supervisors. handle_call({_Req, _Data}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; @@ -297,7 +353,7 @@ handle_call(which_children, _From, State) -> Resp = lists:map(fun(#child{pid = Pid, name = Name, child_type = ChildType, modules = Mods}) -> - {Name, Pid, ChildType, Mods} + {Name, Pid, ChildType, Mods} end, State#state.children), {reply, Resp, State}; @@ -318,7 +374,6 @@ handle_call(count_children, _From, State) when ?is_simple(State) -> {reply, Reply, State}; handle_call(count_children, _From, State) -> - %% Specs and children are together on the children list... {Specs, Active, Supers, Workers} = lists:foldl(fun(Child, Counts) -> @@ -347,15 +402,19 @@ count_child(#child{pid = Pid, child_type = supervisor}, %%% Hopefully cause a function-clause as there is no API function %%% that utilizes cast. +-spec handle_cast('null', state()) -> {'noreply', state()}. + handle_cast(null, State) -> error_logger:error_msg("ERROR: Supervisor received cast-message 'null'~n", []), - {noreply, State}. %% %% Take care of terminated children. %% +-spec handle_info(term(), state()) -> + {'noreply', state()} | {'stop', 'shutdown', state()}. + handle_info({'EXIT', Pid, Reason}, State) -> case restart_child(Pid, Reason, State) of {ok, State1} -> @@ -368,9 +427,12 @@ handle_info(Msg, State) -> error_logger:error_msg("Supervisor received unexpected message: ~p~n", [Msg]), {noreply, State}. + %% %% Terminate this server. %% +-spec terminate(term(), state()) -> 'ok'. + terminate(_Reason, State) -> terminate_children(State#state.children, State#state.name), ok. @@ -384,6 +446,9 @@ terminate(_Reason, State) -> %% NOTE: This requires that the init function of the call-back module %% does not have any side effects. %% +-spec code_change(term(), state(), term()) -> + {'ok', state()} | {'error', term()}. + code_change(_, State, _) -> case (State#state.module):init(State#state.args) of {ok, {SupFlags, StartSpec}} -> @@ -411,7 +476,7 @@ check_flags({Strategy, MaxIntensity, Period}) -> check_flags(What) -> {bad_flags, What}. -update_childspec(State, StartSpec) when ?is_simple(State) -> +update_childspec(State, StartSpec) when ?is_simple(State) -> case check_startspec(StartSpec) of {ok, [Child]} -> {ok, State#state{children = [Child]}}; @@ -437,7 +502,7 @@ update_childspec1([Child|OldC], Children, KeepOld) -> update_childspec1(OldC, Children, [Child|KeepOld]) end; update_childspec1([], Children, KeepOld) -> - % Return them in (keeped) reverse start order. + %% Return them in (kept) reverse start order. lists:reverse(Children ++ KeepOld). update_chsp(OldCh, Children) -> @@ -482,7 +547,7 @@ handle_start_child(Child, State) -> %%% --------------------------------------------------- %%% Restart. A process has terminated. -%%% Returns: {ok, #state} | {shutdown, #state} +%%% Returns: {ok, state()} | {shutdown, state()} %%% --------------------------------------------------- restart_child(Pid, Reason, State) when ?is_simple(State) -> @@ -490,19 +555,19 @@ restart_child(Pid, Reason, State) when ?is_simple(State) -> {ok, Args} -> [Child] = State#state.children, RestartType = Child#child.restart_type, - {M, F, _} = Child#child.mfa, - NChild = Child#child{pid = Pid, mfa = {M, F, Args}}, + {M, F, _} = Child#child.mfargs, + NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, do_restart(RestartType, Reason, NChild, State); error -> {ok, State} end; restart_child(Pid, Reason, State) -> Children = State#state.children, - case lists:keysearch(Pid, #child.pid, Children) of - {value, Child} -> + case lists:keyfind(Pid, #child.pid, Children) of + #child{} = Child -> RestartType = Child#child.restart_type, do_restart(RestartType, Reason, Child, State); - _ -> + false -> {ok, State} end. @@ -534,7 +599,7 @@ restart(Child, State) -> end. restart(simple_one_for_one, Child, State) -> - #child{mfa = {M, F, A}} = Child, + #child{mfargs = {M, F, A}} = Child, Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics), case do_start_child_i(M, F, A) of {ok, Pid} -> @@ -580,9 +645,9 @@ restart(one_for_all, Child, State) -> %%----------------------------------------------------------------- %% Func: terminate_children/2 -%% Args: Children = [#child] in termination order +%% Args: Children = [child()] in termination order %% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} -%% Returns: NChildren = [#child] in +%% Returns: NChildren = [child()] in %% startup order (reversed termination order) %%----------------------------------------------------------------- terminate_children(Children, SupName) -> @@ -617,7 +682,6 @@ do_terminate(Child, _SupName) -> %% Returns: ok | {error, OtherReason} (this should be reported) %%----------------------------------------------------------------- shutdown(Pid, brutal_kill) -> - case monitor_child(Pid) of ok -> exit(Pid, kill), @@ -630,9 +694,7 @@ shutdown(Pid, brutal_kill) -> {error, Reason} -> {error, Reason} end; - shutdown(Pid, Time) -> - case monitor_child(Pid) of ok -> exit(Pid, shutdown), %% Try to shutdown gracefully @@ -738,9 +800,9 @@ remove_child(Child, State) -> %% MaxIntensity = integer() %% Period = integer() %% Mod :== atom() -%% Arsg :== term() +%% Args :== term() %% Purpose: Check that Type is of correct type (!) -%% Returns: {ok, #state} | Error +%% Returns: {ok, state()} | Error %%----------------------------------------------------------------- init_state(SupName, Type, Mod, Args) -> case catch init_state1(SupName, Type, Mod, Args) of @@ -755,11 +817,11 @@ init_state1(SupName, {Strategy, MaxIntensity, Period}, Mod, Args) -> validIntensity(MaxIntensity), validPeriod(Period), {ok, #state{name = supname(SupName,Mod), - strategy = Strategy, - intensity = MaxIntensity, - period = Period, - module = Mod, - args = Args}}; + strategy = Strategy, + intensity = MaxIntensity, + period = Period, + module = Mod, + args = Args}}; init_state1(_SupName, Type, _, _) -> {invalid_type, Type}. @@ -771,26 +833,26 @@ validStrategy(What) -> throw({invalid_strategy, What}). validIntensity(Max) when is_integer(Max), Max >= 0 -> true; -validIntensity(What) -> throw({invalid_intensity, What}). +validIntensity(What) -> throw({invalid_intensity, What}). validPeriod(Period) when is_integer(Period), Period > 0 -> true; validPeriod(What) -> throw({invalid_period, What}). -supname(self,Mod) -> {self(),Mod}; -supname(N,_) -> N. +supname(self, Mod) -> {self(), Mod}; +supname(N, _) -> N. %%% ------------------------------------------------------ %%% Check that the children start specification is valid. %%% Shall be a six (6) tuple %%% {Name, Func, RestartType, Shutdown, ChildType, Modules} %%% where Name is an atom -%%% Func is {Mod, Fun, Args} == {atom, atom, list} +%%% Func is {Mod, Fun, Args} == {atom(), atom(), list()} %%% RestartType is permanent | temporary | transient %%% Shutdown = integer() | infinity | brutal_kill %%% ChildType = supervisor | worker %%% Modules = [atom()] | dynamic -%%% Returns: {ok, [#child]} | Error +%%% Returns: {ok, [child()]} | Error %%% ------------------------------------------------------ check_startspec(Children) -> check_startspec(Children, []). @@ -818,14 +880,14 @@ check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods) -> validChildType(ChildType), validShutdown(Shutdown, ChildType), validMods(Mods), - {ok, #child{name = Name, mfa = Func, restart_type = RestartType, + {ok, #child{name = Name, mfargs = Func, restart_type = RestartType, shutdown = Shutdown, child_type = ChildType, modules = Mods}}. validChildType(supervisor) -> true; validChildType(worker) -> true; validChildType(What) -> throw({invalid_child_type, What}). -validName(_Name) -> true. +validName(_Name) -> true. validFunc({M, F, A}) when is_atom(M), is_atom(F), @@ -923,7 +985,7 @@ report_error(Error, Reason, Child, SupName) -> extract_child(Child) -> [{pid, Child#child.pid}, {name, Child#child.name}, - {mfa, Child#child.mfa}, + {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, {child_type, Child#child.child_type}]. diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index e2c6976a2b..108ab3bffd 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -26,6 +26,7 @@ -export([file/1, join_lines/1, scan_lines/1, string/1]). +-export_type([comment/0]). %% ===================================================================== diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 9a2967d550..a40bf83c5a 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -309,6 +309,7 @@ data/1, is_tree/1]). +-export_type([forms/0, syntaxTree/0, syntaxTreeAttributes/0]). %% ===================================================================== %% IMPLEMENTATION NOTES: diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 1c0367c3d9..4808971a59 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -46,6 +46,8 @@ new_variable_names/2, new_variable_names/3, strip_comments/1, to_comment/1, to_comment/2, to_comment/3, variables/1]). +-export_type([info_pair/0]). + %% ===================================================================== -type ordset(X) :: [X]. % XXX: TAKE ME OUT diff --git a/lib/syntax_tools/src/prettypr.erl b/lib/syntax_tools/src/prettypr.erl index 1868f63e54..c13fa30998 100644 --- a/lib/syntax_tools/src/prettypr.erl +++ b/lib/syntax_tools/src/prettypr.erl @@ -48,6 +48,8 @@ nest/2, par/1, par/2, sep/1, text/1, null_text/1, text_par/1, text_par/2]). +-export_type([document/0]). + %% --------------------------------------------------------------------- -type deep_string() :: [char() | deep_string()]. diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index 970afe2e9f..f2c0db67dd 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -23,8 +23,22 @@ (eval-when-compile (require 'cl)) -(defvar erlang-eunit-separate-src-and-test-directories t - "*Whether or not to keep source and EUnit test files in separate directories") +(defvar erlang-eunit-src-candidate-dirs '("../src" ".") + "*Name of directories which to search for source files matching +an EUnit test file. The first directory in the list will be used, +if there is no match.") + +(defvar erlang-eunit-test-candidate-dirs '("../test" ".") + "*Name of directories which to search for EUnit test files matching +a source file. The first directory in the list will be used, +if there is no match.") + +(defvar erlang-eunit-autosave nil + "*Set to non-nil to automtically save unsaved buffers before running tests. +This is useful, reducing the save-compile-load-test cycle to one keychord.") + +(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil)) + "Info about the most recent running of an EUnit test representation.") ;;; ;;; Switch between src/EUnit test buffers @@ -44,7 +58,6 @@ buffer and vice versa" "Open the EUnit test file which corresponds to a src file" (find-file-other-window (erlang-eunit-test-filename src-file-path))) - ;;; ;;; Open the src file which corresponds to the an EUnit test file ;;; @@ -55,37 +68,55 @@ buffer and vice versa" ;;; Return the name and path of the EUnit test file ;;, (input may be either the source filename itself or the EUnit test filename) (defun erlang-eunit-test-filename (file-path) - (erlang-eunit-rewrite-filename file-path "test" "_tests")) + (if (erlang-eunit-test-file-p file-path) + file-path + (erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs))) ;;; Return the name and path of the source file ;;, (input may be either the source filename itself or the EUnit test filename) (defun erlang-eunit-src-filename (file-path) - (erlang-eunit-rewrite-filename file-path "src" "")) + (if (erlang-eunit-src-file-p file-path) + file-path + (erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs))) ;;; Rewrite a filename from the src or test filename to the other -(defun erlang-eunit-rewrite-filename (orig-file-path dest-dirname dest-suffix) - (let* ((root-dir-name (erlang-eunit-file-root-dir-name orig-file-path)) - (src-module-name (erlang-eunit-source-module-name orig-file-path)) - (dest-base-name (concat src-module-name dest-suffix ".erl")) - (dest-dir-name-1 (file-name-directory orig-file-path)) - (dest-dir-name-2 (filename-join root-dir-name dest-dirname)) - (dest-file-name-1 (filename-join dest-dir-name-1 dest-base-name)) - (dest-file-name-2 (filename-join dest-dir-name-2 dest-base-name))) - ;; This function tries to be a bit intelligent: - ;; * if there already is a test (or source) file in the same - ;; directory as a source (or test) file, it'll be picked - ;; * if there already is a test (or source) file in a separate - ;; test (or src) directory, it'll be picked - ;; * otherwise it'll resort to whatever alternative (same or - ;; separate directories) that the user has chosen - (cond ((file-readable-p dest-file-name-1) - dest-file-name-1) - ((file-readable-p dest-file-name-2) - dest-file-name-2) - (erlang-eunit-separate-src-and-test-directories - dest-file-name-2) - (t - dest-file-name-1)))) +(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs) + (or (erlang-eunit-locate-buddy orig-file-path candidate-dirs) + (erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs)))) + +;;; Search for a file's buddy file (a source file's EUnit test file, +;;; or an EUnit test file's source file) in a list of candidate +;;; directories. +(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs) + (when candidate-dirs + (let ((buddy-file-path (erlang-eunit-buddy-file-path + orig-file-path + (car candidate-dirs)))) + (if (file-readable-p buddy-file-path) + buddy-file-path + (erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs)))))) + +(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name) + (let* ((orig-dir-name (file-name-directory orig-file-path)) + (buddy-dir-name (file-truename + (filename-join orig-dir-name buddy-dir-name))) + (buddy-base-name (erlang-eunit-buddy-basename orig-file-path))) + (filename-join buddy-dir-name buddy-base-name))) + +;;; Return the basename of the buddy file: +;;; /tmp/foo/src/x.erl --> x_tests.erl +;;; /tmp/foo/test/x_tests.erl --> x.erl +(defun erlang-eunit-buddy-basename (file-path) + (let ((src-module-name (erlang-eunit-source-module-name file-path))) + (cond + ((erlang-eunit-src-file-p file-path) + (concat src-module-name "_tests.erl")) + ((erlang-eunit-test-file-p file-path) + (concat src-module-name ".erl"))))) + +;;; Checks whether a file is a source file or not +(defun erlang-eunit-src-file-p (file-path) + (not (erlang-eunit-test-file-p file-path))) ;;; Checks whether a file is a EUnit test file or not (defun erlang-eunit-test-file-p (file-path) @@ -96,11 +127,10 @@ buffer and vice versa" ;;; /tmp/foo/test/x_tests.erl --> x (defun erlang-eunit-source-module-name (file-path) (interactive) - (let* ((file-name (file-name-nondirectory file-path)) - (base-name (file-name-sans-extension file-name))) - (if (string-match "^\\(.+\\)_tests$" base-name) - (substring base-name (match-beginning 1) (match-end 1)) - base-name))) + (let ((module-name (erlang-eunit-module-name file-path))) + (if (string-match "^\\(.+\\)_tests$" module-name) + (substring module-name (match-beginning 1) (match-end 1)) + module-name))) ;;; Return the module name of the file ;;; /tmp/foo/src/x.erl --> x @@ -109,18 +139,6 @@ buffer and vice versa" (interactive) (file-name-sans-extension (file-name-nondirectory file-path))) -;;; Return the directory name which is common to both src and test -;;; /tmp/foo/src/x.erl --> /tmp/foo -;;; /tmp/foo/test/x_tests.erl --> /tmp/foo -(defun erlang-eunit-file-root-dir-name (file-path) - (erlang-eunit-dir-parent-dirname (file-name-directory file-path))) - -;;; Return the parent directory name of a directory -;;; /tmp/foo/ --> /tmp -;;; /tmp/foo --> /tmp -(defun erlang-eunit-dir-parent-dirname (dir-name) - (file-name-directory (directory-file-name dir-name))) - ;;; Older emacsen don't have string-match-p. (defun erlang-eunit-string-match-p (regexp string &optional start) (if (fboundp 'string-match-p) ;; appeared in emacs 23 @@ -135,12 +153,28 @@ buffer and vice versa" (concat dir file) (concat dir "/" file))) +;;; Get info about the most recent running of EUnit +(defun erlang-eunit-recent (key) + (cdr (assq key erlang-eunit-recent-info))) + +;;; Record info about the most recent running of EUnit +;;; Known modes are 'module-mode and 'test-mode +(defun erlang-eunit-record-recent (mode module test) + (setcdr (assq 'mode erlang-eunit-recent-info) mode) + (setcdr (assq 'module erlang-eunit-recent-info) module) + (setcdr (assq 'test erlang-eunit-recent-info) test)) + +;;; Record whether the most recent running of EUnit included cover +;;; compilation +(defun erlang-eunit-record-recent-compile (under-cover) + (setcdr (assq 'cover erlang-eunit-recent-info) under-cover)) + ;;; Determine options for EUnit. (defun erlang-eunit-opts () (if current-prefix-arg ", [verbose]" "")) ;;; Determine current test function -(defun erlang-eunit-test-name () +(defun erlang-eunit-current-test () (save-excursion (erlang-end-of-function 1) (erlang-beginning-of-function 1) @@ -152,45 +186,125 @@ buffer and vice versa" (defun erlang-eunit-test-generator-p (test-name) (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil)) -;;; Run the current EUnit test -(defun erlang-eunit-run-current-test () - (let* ((module-name (erlang-add-quotes-if-needed - (erlang-eunit-module-name buffer-file-name))) - (test-name (erlang-eunit-test-name)) - (command - (cond ((erlang-eunit-simple-test-p test-name) - (format "eunit:test({%s, %s}%s)." - module-name test-name (erlang-eunit-opts))) - ((erlang-eunit-test-generator-p test-name) - (format "eunit:test({generator, %s, %s}%s)." - module-name test-name (erlang-eunit-opts))) - (t (format "%% WARNING: '%s' is not a test function" test-name))))) +;;; Run one EUnit test +(defun erlang-eunit-run-test (module-name test-name) + (let ((command + (cond ((erlang-eunit-simple-test-p test-name) + (format "eunit:test({%s, %s}%s)." + module-name test-name (erlang-eunit-opts))) + ((erlang-eunit-test-generator-p test-name) + (format "eunit:test({generator, %s, %s}%s)." + module-name test-name (erlang-eunit-opts))) + (t (format "%% WARNING: '%s' is not a test function" test-name))))) + (erlang-eunit-record-recent 'test-mode module-name test-name) (erlang-eunit-inferior-erlang-send-command command))) ;;; Run EUnit tests for the current module -(defun erlang-eunit-run-module-tests () - (let* ((module-name (erlang-add-quotes-if-needed - (erlang-eunit-source-module-name buffer-file-name))) - (command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts)))) +(defun erlang-eunit-run-module-tests (module-name) + (let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts)))) + (erlang-eunit-record-recent 'module-mode module-name nil) (erlang-eunit-inferior-erlang-send-command command))) +(defun erlang-eunit-compile-and-run-recent () + "Compile the source and test files and repeat the most recent EUnit test run. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (case (erlang-eunit-recent 'mode) + ('test-mode + (erlang-eunit-compile-and-test + 'erlang-eunit-run-test (list (erlang-eunit-recent 'module) + (erlang-eunit-recent 'test)))) + ('module-mode + (erlang-eunit-compile-and-test + 'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module)) + (erlang-eunit-recent 'cover))) + (t (error "EUnit has not yet been run. Please run a test first.")))) + +(defun erlang-eunit-cover-compile () + "Cover compile current module." + (interactive) + (let* ((erlang-compile-extra-opts + (append (list 'debug_info) erlang-compile-extra-opts)) + (module-name + (erlang-add-quotes-if-needed + (erlang-eunit-module-name buffer-file-name))) + (compile-command + (format "cover:compile_beam(%s)." module-name))) + (erlang-compile) + (if (erlang-eunit-last-compilation-successful-p) + (erlang-eunit-inferior-erlang-send-command compile-command)))) + +(defun erlang-eunit-analyze-coverage () + "Analyze the data collected by cover tool for the module in the +current buffer. + +Assumes that the module has been cover compiled prior to this +call. This function will do two things: print the number of +covered and uncovered functions in the erlang shell and display a +new buffer called *<module name> coverage* which shows the source +code along with the coverage analysis results." + (interactive) + (let* ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-module-name buffer-file-name))) + (tmp-filename (make-temp-file "cover")) + (analyze-command (format "cover:analyze_to_file(%s, \"%s\"). " + module-name tmp-filename)) + (buf-name (format "*%s coverage*" module-name))) + (erlang-eunit-inferior-erlang-send-command analyze-command) + ;; The purpose of the following snippet is to get the result of the + ;; analysis from a file into a new buffer (or an old, if one with + ;; the specified name already exists). Also we want the erlang-mode + ;; *and* view-mode to be enabled. + (save-excursion + (let ((buf (get-buffer-create (format "*%s coverage*" module-name)))) + (set-buffer buf) + (setq buffer-read-only nil) + (insert-file-contents tmp-filename nil nil nil t) + (if (= (buffer-size) 0) + (kill-buffer buf) + ;; FIXME: this would be a good place to enable (emacs-mode) + ;; to get some nice syntax highlighting in the + ;; coverage report, but it doesn't play well with + ;; flymake. Leave it off for now. + (view-buffer buf)))) + (delete-file tmp-filename))) + (defun erlang-eunit-compile-and-run-current-test () "Compile the source and test files and run the current EUnit test. With prefix arg, compiles for debug and runs tests with the verbose flag set." (interactive) - (erlang-eunit-compile-and-test 'erlang-eunit-run-current-test)) + (let ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-module-name buffer-file-name))) + (test-name (erlang-eunit-current-test))) + (erlang-eunit-compile-and-test + 'erlang-eunit-run-test (list module-name test-name)))) (defun erlang-eunit-compile-and-run-module-tests () "Compile the source and test files and run all EUnit tests in the module. With prefix arg, compiles for debug and runs tests with the verbose flag set." (interactive) - (erlang-eunit-compile-and-test 'erlang-eunit-run-module-tests)) + (let ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-source-module-name buffer-file-name)))) + (erlang-eunit-compile-and-test + 'erlang-eunit-run-module-tests (list module-name)))) ;;; Compile source and EUnit test file and finally run EUnit tests for ;;; the current module -(defun erlang-eunit-compile-and-test (run-tests) +(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover) + "Compile the source and test files and run the EUnit test suite. + +If under-cover is set to t, the module under test is compile for +code coverage analysis. If under-cover is left out or not set, +coverage analysis is disabled. The result of the code coverage +is both printed to the erlang shell (the number of covered vs +uncovered functions in a module) and written to a buffer called +*<module> coverage* (which shows the source code for the module +and the number of times each line is covered). +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (erlang-eunit-record-recent-compile under-cover) (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) (test-filename (erlang-eunit-test-filename buffer-file-name))) @@ -198,7 +312,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;; below, is to ask the question about saving buffers only once, ;; instead of possibly several: one for each file to compile, ;; for instance for both x.erl and x_tests.erl. - (save-some-buffers) + (save-some-buffers erlang-eunit-autosave) (flet ((save-some-buffers (&optional any) nil)) ;; Compilation of the source file is mandatory (the file must @@ -206,23 +320,56 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;; test file on the other hand, is optional, since eunit tests may ;; be placed in the source file instead. Any compilation error ;; will prevent the subsequent steps to be run (hence the `and') - (and (erlang-eunit-compile-file src-filename) + (and (erlang-eunit-compile-file src-filename under-cover) (if (file-readable-p test-filename) (erlang-eunit-compile-file test-filename) t) - (funcall run-tests))))) + (apply test-fun test-args) + (if under-cover + (save-excursion + (set-buffer (find-file-noselect src-filename)) + (erlang-eunit-analyze-coverage))))))) -(defun erlang-eunit-compile-file (file-path) +(defun erlang-eunit-compile-and-run-module-tests-under-cover () + "Compile the source and test files and run the EUnit test suite and measure +code coverage. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (let ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-source-module-name buffer-file-name)))) + (erlang-eunit-compile-and-test + 'erlang-eunit-run-module-tests (list module-name) t))) + +(defun erlang-eunit-compile-file (file-path &optional under-cover) (if (file-readable-p file-path) (save-excursion - (set-buffer (find-file-noselect file-path)) - (erlang-compile) - (erlang-eunit-last-compilation-successful-p)) + (set-buffer (find-file-noselect file-path)) + ;; In order to run a code coverage analysis on a + ;; module, we have two options: + ;; + ;; * either compile the module with cover:compile instead of the + ;; regular compiler + ;; + ;; * or first compile the module with the regular compiler (but + ;; *with* debug_info) and then compile it for coverage + ;; analysis using cover:compile_beam. + ;; + ;; We could accomplish the first by changing the + ;; erlang-compile-erlang-function to cover:compile, but there's + ;; a risk that that's used for other purposes. Therefore, a + ;; safer alternative (although with more steps) is to add + ;; debug_info to the list of compiler options and go for the + ;; second alternative. + (if under-cover + (erlang-eunit-cover-compile) + (erlang-compile)) + (erlang-eunit-last-compilation-successful-p)) (let ((msg (format "Could not read %s" file-path))) - (erlang-eunit-inferior-erlang-send-command + (erlang-eunit-inferior-erlang-send-command (format "%% WARNING: %s" msg)) (error msg)))) - + (defun erlang-eunit-last-compilation-successful-p () (save-excursion (set-buffer inferior-erlang-buffer) @@ -231,7 +378,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (lambda (re) (let ((continue t) (result t)) (while continue ; ignore warnings, stop at errors - (if (re-search-forward re (point-max) t) + (if (re-search-forward re (point-max) t) (if (erlang-eunit-is-compilation-warning) t (setq result nil) @@ -242,7 +389,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (mapcar (lambda (e) (car e)) erlang-error-regexp-alist)))) (defun erlang-eunit-is-compilation-warning () - (erlang-eunit-string-match-p + (erlang-eunit-string-match-p "[0-9]+: Warning:" (buffer-substring (line-beginning-position) (line-end-position)))) @@ -271,7 +418,11 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (defconst erlang-eunit-key-bindings '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window) ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests) - ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test))) + ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test) + ("\C-c\C-el" erlang-eunit-compile-and-run-recent) + ("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover) + ("\C-c\C-ev" erlang-eunit-cover-compile) + ("\C-c\C-ea" erlang-eunit-analyze-coverage))) (defun erlang-eunit-add-key-bindings () (dolist (binding erlang-eunit-key-bindings) diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index 207f6fdf16..0403fbca27 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -50,6 +50,14 @@ Own Id: OTP-8537 </p> </item> + <item> + <p> + An empty element declared as a simpleContent was not properly validated. + </p> + <p> + Own Id: OTP-8599 + </p> + </item> </list> </section> diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index c7bca86205..1aedc9e270 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -2687,13 +2687,16 @@ check_element_type(XML=[E=#xmlElement{name=Name}|Rest], _ -> {error,{error_path(E,Name),?MODULE,{element_bad_match,E,Any,Env}}} end; -check_element_type([],CM,_Env,_Block,_S,Checked) -> +check_element_type([],CM,_Env,_Block,S,Checked) -> %% #schema_complex_type, any, #schema_group, anyType and lists are %% catched above. case CM of + #schema_simple_type{} -> + {NewVal,S2} = check_type(CM,[],unapplied,S), + {NewVal,[],S2}; {simpleType,_} -> - {error,{error_path(Checked,undefined),?MODULE, - {empty_content_not_allowed,CM}}}; + {NewVal,S2} = check_type(CM,[],unapplied,S), + {NewVal,[],S2}; _ -> {error,{error_path(Checked,undefined),?MODULE, {empty_content_not_allowed,CM}}} |