diff options
Diffstat (limited to 'lib')
159 files changed, 5344 insertions, 3646 deletions
diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 872c39de04..9ef6ec6e23 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -37,7 +37,7 @@ -record(options, {username, password, boot_timeout, init_timeout, startup_timeout, startup_functions, monitor_master, - kill_if_fail, erl_flags, env}). + kill_if_fail, erl_flags, env, ssh_port, ssh_opts}). %%%----------------------------------------------------------------- %%% @spec start(Node) -> Result @@ -254,11 +254,13 @@ fetch_options(Options) -> KillIfFail = get_option_value(kill_if_fail, Options, true), ErlFlags = get_option_value(erl_flags, Options, []), EnvVars = get_option_value(env, Options, []), + SSHPort = get_option_value(ssh_port, Options, []), + SSHOpts = get_option_value(ssh_opts, Options, []), #options{username=UserName, password=Password, boot_timeout=BootTimeout, init_timeout=InitTimeout, startup_timeout=StartupTimeout, startup_functions=StartupFunctions, monitor_master=Monitor, kill_if_fail=KillIfFail, - erl_flags=ErlFlags, env=EnvVars}. + erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts}. % send a message when slave node is started % @hidden @@ -399,27 +401,18 @@ spawn_local_node(Node, Options) -> Cmd = get_cmd(Node, ErlFlags), open_port({spawn, Cmd}, [stream,{env,Env}]). -% start crypto and ssh if not yet started -check_for_ssh_running() -> - case application:get_application(crypto) of - undefined-> - application:start(crypto), - case application:get_application(ssh) of - undefined-> - application:start(ssh); - {ok, ssh}-> - ok - end; - {ok, crypto}-> - ok - end. - % spawn node remotely spawn_remote_node(Host, Node, Options) -> #options{username=Username, password=Password, erl_flags=ErlFlags, - env=Env} = Options, + env=Env, + ssh_port=MaybeSSHPort, + ssh_opts=SSHOpts} = Options, + SSHPort = case MaybeSSHPort of + [] -> 22; % Use default SSH port + A -> A + end, SSHOptions = case {Username, Password} of {[], []}-> []; @@ -427,14 +420,13 @@ spawn_remote_node(Host, Node, Options) -> [{user, Username}]; {_, _}-> [{user, Username}, {password, Password}] - end ++ [{silently_accept_hosts, true}], - check_for_ssh_running(), - {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), 22, SSHOptions), + end ++ [{silently_accept_hosts, true}] ++ SSHOpts, + application:ensure_all_started(ssh), + {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), SSHPort, SSHOptions), {ok, SSHChannelId} = ssh_connection:session_channel(SSHConnRef, infinity), ssh_setenv(SSHConnRef, SSHChannelId, Env), ssh_connection:exec(SSHConnRef, SSHChannelId, get_cmd(Node, ErlFlags), infinity). - ssh_setenv(SSHConnRef, SSHChannelId, [{Var, Value} | Vars]) when is_list(Var), is_list(Value) -> success = ssh_connection:setenv(SSHConnRef, SSHChannelId, diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 102a6951e8..7f4184fd30 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1130,11 +1130,23 @@ let_substs_1(Vs, #c_values{es=As}, Sub) -> let_substs_1([V], A, Sub) -> let_subst_list([V], [A], Sub); let_substs_1(Vs, A, _) -> {Vs,A,[]}. -let_subst_list([V|Vs0], [A|As0], Sub) -> +let_subst_list([V|Vs0], [A0|As0], Sub) -> {Vs1,As1,Ss} = let_subst_list(Vs0, As0, Sub), - case is_subst(A) of - true -> {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss}; - false -> {[V|Vs1],[A|As1],Ss} + case is_subst(A0) of + true -> + A = case is_compiler_generated(V) andalso + not is_compiler_generated(A0) of + true -> + %% Propagate the 'compiler_generated' annotation + %% along with the value. + Ann = [compiler_generated|cerl:get_ann(A0)], + cerl:set_ann(A0, Ann); + false -> + A0 + end, + {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss}; + false -> + {[V|Vs1],[A0|As1],Ss} end; let_subst_list([], [], _) -> {[],[],[]}. @@ -1900,8 +1912,8 @@ case_data_pat_alias(P, BindTo0, TypeSig, Bs0) -> %% Here we will need to actually build the data and bind %% it to the variable. {Type,Arity} = TypeSig, - Vars = make_vars([], Arity), Ann = [compiler_generated], + Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), Bs = [{BindTo0,P},{P,Data}|Bs0], {Vars,Bs}; @@ -2393,8 +2405,9 @@ delay_build_1(Core0, TypeSig) -> try delay_build_expr(Core0, TypeSig) of Core -> {Type,Arity} = TypeSig, - Vars = make_vars([], Arity), - Data = cerl:ann_make_data([compiler_generated], Type, Vars), + Ann = [compiler_generated], + Vars = make_vars(Ann, Arity), + Data = cerl:ann_make_data(Ann, Type, Vars), {yes,Vars,Core,Data} catch throw:impossible -> @@ -2481,7 +2494,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)) end; @@ -2489,7 +2502,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% No variables left. Body; {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), E = case Ctxt of effect -> %% Throw away the literal body. @@ -2508,7 +2521,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> @@ -2518,7 +2531,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2529,10 +2542,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, _, _, effect) -> - %% Don't suppress any warnings in effect context. - Arg; -maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> +maybe_suppress_warnings(Arg, Vs, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. @@ -2556,8 +2566,16 @@ suppress_warning([H|T]) -> true -> suppress_warning(cerl:data_es(H) ++ T); false -> - Arg = cerl:set_ann(H, [compiler_generated]), - cerl:c_seq(Arg, suppress_warning(T)) + %% Some other thing, such as a function call. + %% This cannot be the compiler's fault, so the + %% warning should not be suppressed. We must + %% be careful not to destroy tail-recursion. + case T of + [] -> + H; + [_|_] -> + cerl:c_seq(H, suppress_warning(T)) + end end end; suppress_warning([]) -> void(). diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 5742b7e6cf..4e266875ee 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -283,6 +283,7 @@ bad_arith(Config) when is_list(Config) -> {3,sys_core_fold,{eval_failure,badarith}}, {9,sys_core_fold,nomatch_guard}, {9,sys_core_fold,{eval_failure,badarith}}, + {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, {10,sys_core_fold,nomatch_guard}, {10,sys_core_fold,{eval_failure,badarith}}, {15,sys_core_fold,{eval_failure,badarith}} @@ -371,7 +372,7 @@ files(Config) when is_list(Config) -> %% Test warnings for term construction and BIF calls in effect context. effect(Config) when is_list(Config) -> - Ts = [{lc, + Ts = [{effect, <<" t(X) -> case X of @@ -477,6 +478,19 @@ effect(Config) when is_list(Config) -> m9(Bs) -> [{B,ok} = {B,foo:bar(B)} || B <- Bs], ok. + + m10(ConfigTableSize) -> + case ConfigTableSize of + apa -> + CurrentConfig = {id(camel_phase3),id(sms)}, + case CurrentConfig of + {apa, bepa} -> ok; + _ -> ok + end + end, + ok. + + id(I) -> I. ">>, [], {warnings,[{5,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, @@ -754,6 +768,14 @@ no_warnings(Config) when is_list(Config) -> case R0 of {r,V1,_V2,V3} -> {r,V1,\"def\",V3} end. + + d(In0, Bool) -> + {In1,Int} = case id(Bool) of + false -> {In0,0} + end, + [In1,Int]. + + id(I) -> I. ">>, [], []}], diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 4438466bb0..ffdfc46496 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -140,7 +140,7 @@ init(Pid, Parent, Meta, TraceWin, BackTrace, Strings) -> int:meta(Meta, trace, State3#state.trace), - gui_enable_updown(stack_trace, {1,1}), + gui_enable_updown(State3#state.stack_trace, {1,1}), gui_enable_btrace(false, false), dbg_wx_trace_win:display(Win,idle), diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index 33954ca82c..6f84ca3bca 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -365,7 +365,7 @@ stop() -> %% function will receive the following messages: %% {int, {interpret, Mod}} %% {int, {no_interpret, Mod}} -%% {int, {new_process, Pid, Function, Status, Info}} +%% {int, {new_process, {Pid, Function, Status, Info}}} %% {int, {new_status, Pid, Status, Info}} %% {int, {new_break, {Point, Options}}} %% {int, {delete_break, Point}} diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 90495eebd6..32e0e0e2d8 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -202,6 +202,9 @@ typedef enum { <desc> <p>Encodes a double-precision (64 bit) floating point number in the binary format.</p> + <p> + The function returns <c><![CDATA[-1]]></c> if the floating point number is not finite. + </p> </desc> </func> <func> diff --git a/lib/erl_interface/doc/src/erl_eterm.xml b/lib/erl_interface/doc/src/erl_eterm.xml index 429f77501c..2152192696 100644 --- a/lib/erl_interface/doc/src/erl_eterm.xml +++ b/lib/erl_interface/doc/src/erl_eterm.xml @@ -371,9 +371,11 @@ iohead ::= Binary <p><c><![CDATA[f]]></c> is a value to be converted to an Erlang float.</p> <p></p> <p>The function returns an Erlang float object with the value - specified in <c><![CDATA[f]]></c>.</p> + specified in <c><![CDATA[f]]></c> or <c><![CDATA[NULL]]></c> if + <c><![CDATA[f]]></c> is not finite. + </p> <p><c><![CDATA[ERL_FLOAT_VALUE(t)]]></c> can be used to retrieve the - value from an Erlang float.</p> + value from an Erlang float.</p> </desc> </func> <func> diff --git a/lib/erl_interface/src/decode/decode_big.c b/lib/erl_interface/src/decode/decode_big.c index 477880b331..016ed2eac2 100644 --- a/lib/erl_interface/src/decode/decode_big.c +++ b/lib/erl_interface/src/decode/decode_big.c @@ -150,27 +150,6 @@ int ei_big_comp(erlang_big *x, erlang_big *y) #define INLINED_FP_CONVERSION 1 #endif -#ifdef USE_ISINF_ISNAN /* simulate finite() */ -# define isfinite(f) (!isinf(f) && !isnan(f)) -# define HAVE_ISFINITE -#elif defined(__GNUC__) && defined(HAVE_FINITE) -/* We use finite in gcc as it emits assembler instead of - the function call that isfinite emits. The assembler is - significantly faster. */ -# ifdef isfinite -# undef isfinite -# endif -# define isfinite finite -# ifndef HAVE_ISFINITE -# define HAVE_ISFINITE -# endif -#elif defined(isfinite) && !defined(HAVE_ISFINITE) -# define HAVE_ISFINITE -#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) -# define isfinite finite -# define HAVE_ISFINITE -#endif - #ifdef NO_FPE_SIGNALS # define ERTS_FP_CHECK_INIT() do {} while (0) # define ERTS_FP_ERROR(f, Action) if (!isfinite(f)) { Action; } else {} diff --git a/lib/erl_interface/src/encode/encode_double.c b/lib/erl_interface/src/encode/encode_double.c index 148a49f73a..72a1c60808 100644 --- a/lib/erl_interface/src/encode/encode_double.c +++ b/lib/erl_interface/src/encode/encode_double.c @@ -21,12 +21,24 @@ #include "eidef.h" #include "eiext.h" #include "putget.h" +#if defined(HAVE_ISFINITE) +#include <math.h> +#endif int ei_encode_double(char *buf, int *index, double p) { char *s = buf + *index; char *s0 = s; + /* Erlang does not handle Inf and NaN, so we return an error rather + * than letting the Erlang VM complain about a bad external + * term. */ +#if defined(HAVE_ISFINITE) + if(!isfinite(p)) { + return -1; + } +#endif + if (!buf) s += 9; else { diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 636d26b24b..66cca7decf 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -26,6 +26,9 @@ #include <stdlib.h> #include <string.h> #include <ctype.h> +#if defined(HAVE_ISFINITE) +#include <math.h> +#endif #include "ei_locking.h" #include "ei_resolve.h" @@ -125,6 +128,15 @@ ETERM *erl_mk_float (double d) { ETERM *ep; +#if defined(HAVE_ISFINITE) + /* Erlang does not handle Inf and NaN, so we return an error + * rather than letting the Erlang VM complain about a bad external + * term. */ + if(!isfinite(d)) { + return NULL; + } +#endif + ep = erl_alloc_eterm(ERL_FLOAT); ERL_COUNT(ep) = 1; ERL_FLOAT_VALUE(ep) = d; diff --git a/lib/erl_interface/src/misc/eidef.h b/lib/erl_interface/src/misc/eidef.h index bd3d0bf631..e0dc325b48 100644 --- a/lib/erl_interface/src/misc/eidef.h +++ b/lib/erl_interface/src/misc/eidef.h @@ -41,6 +41,27 @@ typedef int socklen_t; #endif +#ifdef USE_ISINF_ISNAN /* simulate finite() */ +# define isfinite(f) (!isinf(f) && !isnan(f)) +# define HAVE_ISFINITE +#elif defined(__GNUC__) && defined(HAVE_FINITE) +/* We use finite in gcc as it emits assembler instead of + the function call that isfinite emits. The assembler is + significantly faster. */ +# ifdef isfinite +# undef isfinite +# endif +# define isfinite finite +# ifndef HAVE_ISFINITE +# define HAVE_ISFINITE +# endif +#elif defined(isfinite) && !defined(HAVE_ISFINITE) +# define HAVE_ISFINITE +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +# define isfinite finite +# define HAVE_ISFINITE +#endif + typedef unsigned char uint8; /* FIXME use configure */ typedef unsigned short uint16; typedef unsigned int uint32; diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 50dc8b6a3c..86e0d8cd08 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -174,7 +174,7 @@ test_ei_encode_ulonglong(Config) when is_list(Config) -> %% ######################################################################## %% -%% A "character" for us is an 8 bit integer, alwasy positive, i.e. +%% A "character" for us is an 8 bit integer, always positive, i.e. %% it is unsigned. %% FIXME maybe the API should change to use "unsigned char" to be clear?! diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl index 53d291430d..88e9d6c19b 100644 --- a/lib/eunit/include/eunit.hrl +++ b/lib/eunit/include/eunit.hrl @@ -15,11 +15,14 @@ %% %% Copyright (C) 2004-2006 Mickaël Rémond, Richard Carlsson +-ifndef(EUNIT_HRL). +-define(EUNIT_HRL, true). + %% Including this file turns on testing and defines TEST, unless NOTEST %% is defined before the file is included. If both NOTEST and TEST are %% already defined, then TEST takes precedence, and NOTEST will become %% undefined. -%% +%% %% If NODEBUG is defined before this file is included, the debug macros %% are disabled, unless DEBUG is also defined, in which case NODEBUG %% will become undefined. NODEBUG also implies NOASSERT, unless testing @@ -31,14 +34,10 @@ %% even if NODEBUG is defined. If both ASSERT and NOASSERT are defined %% before the file is included, then ASSERT takes precedence, and NOASSERT %% will become undefined regardless of TEST. -%% +%% %% After including this file, EUNIT will be defined if and only if TEST %% is defined. --ifndef(EUNIT_HRL). --define(EUNIT_HRL, true). - - %% allow defining TEST to override NOTEST -ifdef(TEST). -undef(NOTEST). @@ -49,13 +48,6 @@ -undef(NODEBUG). -endif. -%% allow NODEBUG to imply NOASSERT, unless overridden below --ifdef(NODEBUG). --ifndef(NOASSERT). --define(NOASSERT, true). --endif. --endif. - %% note that the main switch used within this file is NOTEST; however, %% both TEST and EUNIT may be used to check whether testing is enabled -ifndef(NOTEST). @@ -70,10 +62,8 @@ -undef(EUNIT). -endif. -%% allow ASSERT to override NOASSERT (regardless of TEST/NOTEST) --ifdef(ASSERT). --undef(NOASSERT). --endif. +%% include the assert macros; ASSERT overrides NOASSERT if defined +-include_lib("stdlib/include/assert.hrl"). %% Parse transforms for automatic exporting/stripping of test functions. %% (Note that although automatic stripping is convenient, it will make @@ -91,7 +81,7 @@ %% All macros should be available even if testing is turned off, and %% should preferably not require EUnit to be present at runtime. -%% +%% %% We must use fun-call wrappers ((fun () -> ... end)()) to avoid %% exporting local variables, and furthermore we only use variable names %% prefixed with "__", that hopefully will not be bound outside the fun. @@ -128,211 +118,24 @@ current_function)))). -endif. -%% The plain assert macro should be defined to do nothing if this file -%% is included when debugging/testing is turned off. --ifdef(NOASSERT). --ifndef(assert). --define(assert(BoolExpr),ok). --endif. --else. -%% The assert macro is written the way it is so as not to cause warnings -%% for clauses that cannot match, even if the expression is a constant. --undef(assert). --define(assert(BoolExpr), - begin - ((fun () -> - case (BoolExpr) of - true -> ok; - __V -> erlang:error({assertion_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??BoolExpr)}, - {expected, true}, - {value, case __V of false -> __V; - _ -> {not_a_boolean,__V} - end}]}) - end - end)()) - end). --endif. --define(assertNot(BoolExpr), ?assert(not (BoolExpr))). +%% General test macros -define(_test(Expr), {?LINE, fun () -> (Expr) end}). - -define(_assert(BoolExpr), ?_test(?assert(BoolExpr))). - -define(_assertNot(BoolExpr), ?_assert(not (BoolExpr))). - -%% This is mostly a convenience which gives more detailed reports. -%% Note: Guard is a guarded pattern, and can not be used for value. --ifdef(NOASSERT). --define(assertMatch(Guard, Expr), ok). --else. --define(assertMatch(Guard, Expr), - begin - ((fun () -> - case (Expr) of - Guard -> ok; - __V -> erlang:error({assertMatch_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, (??Guard)}, - {value, __V}]}) - end - end)()) - end). --endif. -define(_assertMatch(Guard, Expr), ?_test(?assertMatch(Guard, Expr))). - -%% This is the inverse case of assertMatch, for convenience. --ifdef(NOASSERT). --define(assertNotMatch(Guard, Expr), ok). --else. --define(assertNotMatch(Guard, Expr), - begin - ((fun () -> - __V = (Expr), - case __V of - Guard -> erlang:error({assertNotMatch_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, (??Guard)}, - {value, __V}]}); - _ -> ok - end - end)()) - end). --endif. -define(_assertNotMatch(Guard, Expr), ?_test(?assertNotMatch(Guard, Expr))). - -%% This is a convenience macro which gives more detailed reports when -%% the expected LHS value is not a pattern, but a computed value --ifdef(NOASSERT). --define(assertEqual(Expect, Expr), ok). --else. --define(assertEqual(Expect, Expr), - begin - ((fun (__X) -> - case (Expr) of - __X -> ok; - __V -> erlang:error({assertEqual_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {expected, __X}, - {value, __V}]}) - end - end)(Expect)) - end). --endif. -define(_assertEqual(Expect, Expr), ?_test(?assertEqual(Expect, Expr))). - -%% This is the inverse case of assertEqual, for convenience. --ifdef(NOASSERT). --define(assertNotEqual(Unexpected, Expr), ok). --else. --define(assertNotEqual(Unexpected, Expr), - begin - ((fun (__X) -> - case (Expr) of - __X -> erlang:error({assertNotEqual_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {value, __X}]}); - _ -> ok - end - end)(Unexpected)) - end). --endif. -define(_assertNotEqual(Unexpected, Expr), ?_test(?assertNotEqual(Unexpected, Expr))). - -%% Note: Class and Term are patterns, and can not be used for value. -%% Term can be a guarded pattern, but Class cannot. --ifdef(NOASSERT). --define(assertException(Class, Term, Expr), ok). --else. --define(assertException(Class, Term, Expr), - begin - ((fun () -> - try (Expr) of - __V -> erlang:error({assertException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , "++(??Term) - ++" , [...] }"}, - {unexpected_success, __V}]}) - catch - Class:Term -> ok; - __C:__T -> - erlang:error({assertException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , "++(??Term) - ++" , [...] }"}, - {unexpected_exception, - {__C, __T, - erlang:get_stacktrace()}}]}) - end - end)()) - end). --endif. - --define(assertError(Term, Expr), ?assertException(error, Term, Expr)). --define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). --define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). - -define(_assertException(Class, Term, Expr), ?_test(?assertException(Class, Term, Expr))). -define(_assertError(Term, Expr), ?_assertException(error, Term, Expr)). -define(_assertExit(Term, Expr), ?_assertException(exit, Term, Expr)). -define(_assertThrow(Term, Expr), ?_assertException(throw, Term, Expr)). - -%% This is the inverse case of assertException, for convenience. -%% Note: Class and Term are patterns, and can not be used for value. -%% Both Class and Term can be guarded patterns. --ifdef(NOASSERT). --define(assertNotException(Class, Term, Expr), ok). --else. --define(assertNotException(Class, Term, Expr), - begin - ((fun () -> - try (Expr) of - _ -> ok - catch - __C:__T -> - case __C of - Class -> - case __T of - Term -> - erlang:error({assertNotException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , " - ++(??Term)++" , [...] }"}, - {unexpected_exception, - {__C, __T, - erlang:get_stacktrace() - }}]}); - _ -> ok - end; - _ -> ok - end - end - end)()) - end). --endif. -define(_assertNotException(Class, Term, Expr), ?_test(?assertNotException(Class, Term, Expr))). +-define(_assertReceive(Guard, Expr), ?_test(?assertReceive(Guard, Expr))). %% Macros for running operating system commands. (Note that these %% require EUnit to be present at runtime, or at least eunit_lib.) @@ -364,18 +167,18 @@ -else. -define(assertCmdStatus(N, Cmd), begin - ((fun () -> - case ?_cmd_(Cmd) of - {(N), _} -> ok; - {__N, _} -> erlang:error({assertCmd_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {command, (Cmd)}, - {expected_status,(N)}, - {status,__N}]}) - end - end)()) - end). + ((fun () -> + case ?_cmd_(Cmd) of + {(N), _} -> ok; + {__N, _} -> erlang:error({assertCmd_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {command, (Cmd)}, + {expected_status,(N)}, + {status,__N}]}) + end + end)()) + end). -endif. -define(assertCmd(Cmd), ?assertCmdStatus(0, Cmd)). @@ -384,17 +187,17 @@ -else. -define(assertCmdOutput(T, Cmd), begin - ((fun () -> - case ?_cmd_(Cmd) of - {_, (T)} -> ok; - {_, __T} -> erlang:error({assertCmdOutput_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {command,(Cmd)}, - {expected_output,(T)}, - {output,__T}]}) - end - end)()) + ((fun () -> + case ?_cmd_(Cmd) of + {_, (T)} -> ok; + {_, __T} -> erlang:error({assertCmdOutput_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {command,(Cmd)}, + {expected_output,(T)}, + {output,__T}]}) + end + end)()) end). -endif. @@ -439,5 +242,4 @@ end). -endif. - -endif. % EUNIT_HRL diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index 47aef104ff..86a6d8831e 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -24,7 +24,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN) EBIN = ../ebin INCLUDE=../include -ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard +ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard PARSE_TRANSFORM = eunit_autoexport.erl diff --git a/lib/eunit/src/eunit_server.erl b/lib/eunit/src/eunit_server.erl index 2002930abb..387976eba1 100644 --- a/lib/eunit/src/eunit_server.erl +++ b/lib/eunit/src/eunit_server.erl @@ -200,7 +200,7 @@ server_command(From, stop, St) -> server(St#state{stopped = true}); server_command(From, {watch, Target, _Opts}, St) -> %% the code watcher is only started on demand - %% FIXME: this is disabled for now in the OTP distribution + %% TODO: this is disabled for now %%code_monitor:monitor(self()), %% TODO: propagate options to testing stage St1 = add_watch(Target, St), diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index d6684f33cb..f3e58a3d1c 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -203,10 +203,9 @@ handle_cancel(test, Data, St) -> testcases=[TestCase|TestSuite#testsuite.testcases] }, St#state{testsuites=store_suite(NewTestSuite, TestSuites)}. -format_name({Module, Function, Arity}, Line) -> - lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/", - integer_to_list(Arity), "_", integer_to_list(Line)]). - +format_name({Module, Function, _Arity}, Line) -> + lists:flatten([atom_to_list(Module), ":", integer_to_list(Line), " ", + atom_to_list(Function)]). format_desc(undefined) -> ""; format_desc(Desc) when is_binary(Desc) -> @@ -335,12 +334,11 @@ write_testcase( FileDescriptor) -> DescriptionAttr = case Description of [] -> []; - _ -> [<<" description=\"">>, escape_attr(Description), <<"\"">>] + _ -> [<<" (">>, escape_attr(Description), <<")">>] end, StartTag = [ ?INDENT, <<"<testcase time=\"">>, format_time(Time), - <<"\" name=\"">>, escape_attr(Name), <<"\"">>, - DescriptionAttr], + <<"\" name=\"">>, escape_attr(Name), DescriptionAttr, <<"\"">>], ContentAndEndTag = case {Result, Output} of {ok, <<>>} -> [<<"/>">>, ?NEWLINE]; _ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"</testcase>">>, ?NEWLINE] diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index 0e50c9539b..3c24425828 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -465,7 +465,7 @@ remove_temp_folder(Dir, Options) -> end. unique_id(FunName, Arity) -> - integer_to_list(erlang:phash2({FunName, Arity, now()})). + integer_to_list(erlang:phash2({FunName, Arity, erlang:unique_integer()})). unique_folder(FunName, Arity, Options) -> DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 539ce883c0..b614f5f1ab 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -649,8 +649,9 @@ run_compiler_1(DisasmFun, IcodeFun, Options) -> %% The full option expansion is not done %% until the DisasmFun returns. {Code, CompOpts} = DisasmFun(Options), - Opts0 = expand_options(Options ++ CompOpts), - Opts = + Opts0 = expand_options(Options ++ CompOpts, + get(hipe_target_arch)), + Opts = case proplists:get_bool(to_llvm, Opts0) andalso not llvm_support_available() of true -> @@ -895,8 +896,7 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); code:load_native_sticky(Mod, Bin, Beam); false -> %% Normal loading of a whole module - Architecture = erlang:system_info(hipe_architecture), - ChunkName = hipe_unified_loader:chunk_name(Architecture), + ChunkName = hipe_unified_loader:chunk_name(HostArch), {ok, _, Chunks0} = beam_lib:all_chunks(BeamBinOrPath), Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)], {ok, BeamPlusNative} = beam_lib:build_module(Chunks), @@ -933,9 +933,9 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% but can be overridden by passing an option {target, Target}. set_architecture(Options) -> - put(hipe_host_arch, erlang:system_info(hipe_architecture)), - put(hipe_target_arch, - proplists:get_value(target, Options, get(hipe_host_arch))), + HostArch = erlang:system_info(hipe_architecture), + put(hipe_host_arch, HostArch), + put(hipe_target_arch, proplists:get_value(target, Options, HostArch)), ok. %% This sets up some globally accessed stuff that are needed by the @@ -943,7 +943,7 @@ set_architecture(Options) -> %% Therefore, this expands the current set of options for local use. pre_init(Opts) -> - Options = expand_options(Opts), + Options = expand_options(Opts, get(hipe_target_arch)), %% Initialise some counters used for measurements and benchmarking. If %% the option 'measure_regalloc' is given the compilation will return %% a keylist with the counter values. @@ -1105,10 +1105,10 @@ help_hiper() -> -spec help_options() -> 'ok'. help_options() -> - set_architecture([]), %% needed for target-specific option expansion - O1 = expand_options([o1]), - O2 = expand_options([o2]), - O3 = expand_options([o3]), + HostArch = erlang:system_info(hipe_architecture), + O1 = expand_options([o1], HostArch), + O2 = expand_options([o2], HostArch), + O3 = expand_options([o3], HostArch), io:format("HiPE Compiler Options\n" ++ " Boolean-valued options generally have corresponding " ++ "aliases `no_...',\n" ++ @@ -1134,7 +1134,7 @@ help_options() -> [ordsets:from_list([verbose, debug, time, load, pp_beam, pp_icode, pp_rtl, pp_native, pp_asm, timeout]), - expand_options([pp_all]), + expand_options([pp_all], HostArch), O1 -- [o1], (O2 -- O1) -- [o2], (O3 -- O2) -- [o3]]), @@ -1232,8 +1232,8 @@ option_text(Opt) when is_atom(Opt) -> -spec help_option(comp_option()) -> 'ok'. help_option(Opt) -> - set_architecture([]), %% needed for target-specific option expansion - case expand_options([Opt]) of + HostArch = erlang:system_info(hipe_architecture), + case expand_options([Opt], HostArch) of [Opt] -> Name = if is_atom(Opt) -> Opt; tuple_size(Opt) =:= 2 -> element(1, Opt) @@ -1364,11 +1364,11 @@ opt_keys() -> %% verbose_spills, x87]. -%% Definitions: +%% Definitions: -o1_opts() -> +o1_opts(TargetArch) -> Common = [inline_fp, pmatch, peephole], - case get(hipe_target_arch) of + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1385,13 +1385,13 @@ o1_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o2_opts() -> +o2_opts(TargetArch) -> Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse, icode_type, icode_inline_bifs, rtl_lcm, rtl_ssa, rtl_ssa_const_prop, - spillmin_color, use_indexing, remove_comments, - concurrent_comp, binary_opt | o1_opts()], - case get(hipe_target_arch) of + spillmin_color, use_indexing, remove_comments, + concurrent_comp, binary_opt | o1_opts(TargetArch)], + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1409,9 +1409,9 @@ o2_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o3_opts() -> - Common = [icode_range, {regalloc,coalescing} | o2_opts()], - case get(hipe_target_arch) of +o3_opts(TargetArch) -> + Common = [icode_range, {regalloc,coalescing} | o2_opts(TargetArch)], + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1489,18 +1489,18 @@ opt_aliases() -> opt_basic_expansions() -> [{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}]. -opt_expansions() -> - [{o1, o1_opts()}, - {o2, o2_opts()}, - {o3, o3_opts()}, +opt_expansions(TargetArch) -> + [{o1, o1_opts(TargetArch)}, + {o2, o2_opts(TargetArch)}, + {o3, o3_opts(TargetArch)}, {to_llvm, llvm_opts(o3)}, {{to_llvm, o0}, llvm_opts(o0)}, {{to_llvm, o1}, llvm_opts(o1)}, {{to_llvm, o2}, llvm_opts(o2)}, {{to_llvm, o3}, llvm_opts(o3)}, {x87, [x87, inline_fp]}, - {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 - x86 -> [x87, inline_fp]; %% has sse2 + {inline_fp, case TargetArch of %% XXX: Temporary until x86 has sse2 + x86 -> [x87, inline_fp]; _ -> [inline_fp] end}]. llvm_opts(O) -> @@ -1523,18 +1523,18 @@ expand_kt2(Opts) -> [{use_callgraph, fixpoint}, core, {core_transform, cerl_typean}]}]}]). -%% Note that set_architecture/1 must be called first, and that the given +%% Note that the given %% list should contain the total set of options, since things like 'o2' %% are expanded here. Basic expansions are processed here also, since %% this function is called from the help functions. --spec expand_options(comp_options()) -> comp_options(). +-spec expand_options(comp_options(), hipe_architecture()) -> comp_options(). -expand_options(Opts) -> +expand_options(Opts, TargetArch) -> proplists:normalize(Opts, [{negations, opt_negations()}, {aliases, opt_aliases()}, {expand, opt_basic_expansions()}, - {expand, opt_expansions()}]). + {expand, opt_expansions(TargetArch)}]). -spec check_options(comp_options()) -> 'ok'. diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 4178cb7d4c..6984408932 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -366,7 +366,7 @@ filename() = string() <tag><c><![CDATA[receiver]]></c></tag> <item> <p>Defines how the client will deliver the result of an - asynchroneous request (<c>sync</c> has the value + asynchronous request (<c>sync</c> has the value <c>false</c>). </p> <taglist> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 435f99ee23..e6aa8d5e07 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -162,6 +162,20 @@ in the apache like configuration file. </p> </item> + <marker id="profile"></marker> + <tag>{profile, atom()}</tag> + <item> + <p>Used together with <seealso marker="prop_bind_address"><c>bind_address</c></seealso> + and <seealso marker="prop_port"><c>port</c></seealso> to uniquely identify + a HTTP server. This can be useful in a virtualized environment, + where there can + be more that one server that has the same bind_address and port. + If this property is not explicitly set, it is assumed that the + <seealso marker="prop_bind_address"><c>bind_address</c></seealso> and + <seealso marker="prop_port"><c>port</c></seealso>uniquely identifies the HTTP server. + </p> + </item> + <marker id="prop_socket_type"></marker> <tag>{socket_type, ip_comm | {essl, Config::proplist()}}</tag> <item> @@ -176,6 +190,8 @@ <p>Note that this option is only used when the option <c>socket_type</c> has the value <c>ip_comm</c>. </p> </item> + + <marker id="prop_minimum_bytes_per_second"></marker> <tag>{minimum_bytes_per_second, integer()}</tag> <item> @@ -935,19 +951,22 @@ bytes <func> <marker id="info2"></marker> <name>info(Address, Port) -> </name> + <name>info(Address, Port, Profile) -> </name> + <name>info(Address, Port, Profile, Properties) -> [{Option, Value}] </name> <name>info(Address, Port, Properties) -> [{Option, Value}] </name> <fsummary>Fetches information about the HTTP server</fsummary> <type> <v>Address = ip_address()</v> <v>Port = integer()</v> + <v>Profile = atom()</v> <v>Properties = [property()]</v> <v>Option = property()</v> <v>Value = term()</v> </type> <desc> <p>Fetches information about the HTTP server. When called with - only the Address and Port all properties are fetched, when - called with a list of specific properties they are fetched. + only the Address, Port and Profile, if relevant, all properties are fetched. + When called with a list of specific properties they are fetched. Available properties are the same as the server's start options. </p> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index f4f0c37570..9d832ef18b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1330,7 +1330,7 @@ handle_keep_alive_queue(#state{status = keep_alive, Session, <<>>, State#state{keep_alive = KeepAlive}); {error, Reason} -> - {stop, shutdown, {keepalive_failed, Reason}, State} + {stop, {shutdown, {keepalive_failed, Reason}}, State} end end end. diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index e8148ea362..71be6dde00 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -23,6 +23,7 @@ -behaviour(inets_service). -include("httpd.hrl"). +-include("httpd_internal.hrl"). %% Behavior callbacks -export([ @@ -61,18 +62,27 @@ info(Pid, Properties) when is_pid(Pid) andalso is_list(Properties) -> {ok, ServiceInfo} = service_info(Pid), Address = proplists:get_value(bind_address, ServiceInfo), Port = proplists:get_value(port, ServiceInfo), + Profile = proplists:get_value(profile, ServiceInfo, default), case Properties of [] -> - info(Address, Port); + info(Address, Port, Profile); _ -> - info(Address, Port, Properties) + info(Address, Port, Profile, Properties) end; + info(Address, Port) when is_integer(Port) -> - httpd_conf:get_config(Address, Port). + info(Address, Port, default). + +info(Address, Port, Profile) when is_integer(Port), is_atom(Profile) -> + httpd_conf:get_config(Address, Port, Profile); info(Address, Port, Properties) when is_integer(Port) andalso is_list(Properties) -> - httpd_conf:get_config(Address, Port, Properties). + httpd_conf:get_config(Address, Port, default, Properties). + +info(Address, Port, Profile, Properties) when is_integer(Port) andalso + is_atom(Profile) andalso is_list(Properties) -> + httpd_conf:get_config(Address, Port, Profile, Properties). %%%======================================================================== @@ -86,14 +96,16 @@ start_service(Conf) -> httpd_sup:start_child(Conf). stop_service({Address, Port}) -> - httpd_sup:stop_child(Address, Port); - + stop_service({Address, Port, ?DEFAULT_PROFILE}); +stop_service({Address, Port, Profile}) -> + httpd_sup:stop_child(Address, Port, Profile); stop_service(Pid) when is_pid(Pid) -> case service_info(Pid) of {ok, Info} -> Address = proplists:get_value(bind_address, Info), Port = proplists:get_value(port, Info), - stop_service({Address, Port}); + Profile = proplists:get_value(profile, Info, ?DEFAULT_PROFILE), + stop_service({Address, Port, Profile}); Error -> Error end. @@ -101,7 +113,6 @@ stop_service(Pid) when is_pid(Pid) -> services() -> [{httpd, ChildPid} || {_, ChildPid, _, _} <- supervisor:which_children(httpd_sup)]. - service_info(Pid) -> try [{ChildName, ChildPid} || @@ -114,7 +125,6 @@ service_info(Pid) -> {error, service_not_available} end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -128,12 +138,12 @@ child_name(Pid, [_ | Children]) -> child_name2info(undefined) -> {error, no_such_service}; -child_name2info({httpd_instance_sup, any, Port}) -> +child_name2info({httpd_instance_sup, any, Port, Profile}) -> {ok, Host} = inet:gethostname(), - Info = info(any, Port, [server_name]), + Info = info(any, Port, Profile, [server_name]), {ok, [{bind_address, any}, {host, Host}, {port, Port} | Info]}; -child_name2info({httpd_instance_sup, Address, Port}) -> - Info = info(Address, Port, [server_name]), +child_name2info({httpd_instance_sup, Address, Port, Profile}) -> + Info = info(Address, Port, Profile, [server_name]), case inet:gethostbyaddr(Address) of {ok, {_, Host, _, _,_, _}} -> {ok, [{bind_address, Address}, @@ -143,8 +153,8 @@ child_name2info({httpd_instance_sup, Address, Port}) -> end. -reload(Config, Address, Port) -> - Name = make_name(Address,Port), +reload(Config, Address, Port, Profile) -> + Name = make_name(Address,Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> httpd_manager:reload(Pid, Config); @@ -191,51 +201,19 @@ reload(Config, Address, Port) -> %%% Timeout -> integer() %%% -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) -> - case get_addr_and_port(ConfigFile) of - {ok, Addr, Port} -> - block(Addr, Port, Mode, Timeout); - Error -> - Error - end. - - -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, disturbing, Timeout). - -do_block(Addr, Port, Mode) when is_integer(Port) andalso is_atom(Mode) -> - Name = make_name(Addr,Port), +block(Addr, Port, Profile, disturbing) when is_integer(Port) -> + do_block(Addr, Port, Profile, disturbing); +block(Addr, Port, Profile, non_disturbing) when is_integer(Port) -> + do_block(Addr, Port, Profile, non_disturbing). +do_block(Addr, Port, Profile, Mode) when is_integer(Port) andalso is_atom(Mode) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> - httpd_manager:block(Pid,Mode); + httpd_manager:block(Pid, Mode); _ -> {error,not_started} end. - -do_block(Addr, Port, Mode, Timeout) - when is_integer(Port) andalso is_atom(Mode) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:block(Pid,Mode,Timeout); - _ -> - {error,not_started} - end. - - %%% ========================================================= %%% Function: unblock/2 %%% unblock(Addr, Port) @@ -248,8 +226,8 @@ do_block(Addr, Port, Mode, Timeout) %%% ConfigFile -> string() %%% -unblock(Addr, Port) when is_integer(Port) -> - Name = make_name(Addr,Port), +unblock(Addr, Port, Profile) when is_integer(Port) -> + Name = make_name(Addr,Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> httpd_manager:unblock(Pid); @@ -269,24 +247,9 @@ foreach([KeyValue|Rest]) -> foreach(Rest) end. -get_addr_and_port(ConfigFile) -> - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - case (catch httpd_conf:validate_properties(ConfigList)) of - {ok, Config} -> - Address = proplists:get_value(bind_address, Config, any), - Port = proplists:get_value(port, Config, 80), - {ok, Address, Port}; - Error -> - Error - end; - Error -> - Error - end. - -make_name(Addr, Port) -> - httpd_util:make_name("httpd", Addr, Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd", Addr, Port, Profile). do_reload_config(ConfigList, Mode) -> @@ -294,10 +257,11 @@ do_reload_config(ConfigList, Mode) -> {ok, Config} -> Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - case block(Address, Port, Mode) of + Profile = proplists:get_value(profile, Config, default), + case block(Address, Port, Profile, Mode) of ok -> - reload(Config, Address, Port), - unblock(Address, Port); + reload(Config, Address, Port, Profile), + unblock(Address, Port, Profile); Error -> Error end; diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl index cc2b582b52..a6a0fe2eea 100644 --- a/lib/inets/src/http_server/httpd_acceptor_sup.erl +++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl @@ -26,6 +26,8 @@ -behaviour(supervisor). +-include("httpd_internal.hrl"). + %% API -export([start_link/1]). %%, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). @@ -36,8 +38,9 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link([Addr, Port| _] = Args) -> - SupName = make_name(Addr, Port), +start_link([Addr, Port, Config| _] = Args) -> + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), + SupName = make_name(Addr, Port, Profile), supervisor:start_link({local, SupName}, ?MODULE, [Args]). %%%========================================================================= @@ -54,20 +57,23 @@ init([Args]) -> %%% Internal functions %%%========================================================================= child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> - Name = id(Address, Port), - Manager = httpd_util:make_name("httpd", Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = id(Address, Port, Profile), + Manager = httpd_util:make_name("httpd", Address, Port, Profile), SockType = proplists:get_value(socket_type, ConfigList, ip_comm), IpFamily = proplists:get_value(ipfamily, ConfigList, inet), StartFunc = case ListenInfo of undefined -> - {httpd_acceptor, start_link, [Manager, SockType, Address, Port, IpFamily, - httpd_util:make_name("httpd_conf", Address, Port), - AcceptTimeout]}; + {httpd_acceptor, start_link, + [Manager, SockType, Address, Port, IpFamily, + httpd_util:make_name("httpd_conf", Address, Port, Profile), + AcceptTimeout]}; _ -> - {httpd_acceptor, start_link, [Manager, SockType, Address, Port, ListenInfo, - IpFamily, - httpd_util:make_name("httpd_conf", Address, Port), - AcceptTimeout]} + {httpd_acceptor, start_link, + [Manager, SockType, Address, Port, ListenInfo, + IpFamily, + httpd_util:make_name("httpd_conf", Address, Port, Profile), + AcceptTimeout]} end, Restart = transient, Shutdown = brutal_kill, @@ -75,9 +81,9 @@ child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {httpd_acceptor_sup, Address, Port}. +id(Address, Port, Profile) -> + {httpd_acceptor_sup, Address, Port, Profile}. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_acceptor_sup", Addr, Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index a21eb915d4..9c70f8d1b8 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -25,7 +25,7 @@ %% Application internal API -export([load/1, load/2, load_mime_types/1, store/1, store/2, - remove/1, remove_all/1, get_config/2, get_config/3, + remove/1, remove_all/1, get_config/3, get_config/4, lookup_socket_type/1, lookup/2, lookup/3, lookup/4, validate_properties/1]). @@ -757,8 +757,9 @@ store(ConfigList0) -> ?hdrt("store", [{modules, Modules}]), Port = proplists:get_value(port, ConfigList0), Addr = proplists:get_value(bind_address, ConfigList0, any), + Profile = proplists:get_value(profile, ConfigList0, default), ConfigList = fix_mime_types(ConfigList0), - Name = httpd_util:make_name("httpd_conf", Addr, Port), + Name = httpd_util:make_name("httpd_conf", Addr, Port, Profile), ConfigDB = ets:new(Name, [named_table, bag, protected]), store(ConfigDB, ConfigList, lists:append(Modules, [?MODULE]), @@ -909,15 +910,15 @@ remove(ConfigDB) -> %% end. -get_config(Address, Port) -> - Tab = httpd_util:make_name("httpd_conf", Address, Port), +get_config(Address, Port, Profile) -> + Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile), Properties = ets:tab2list(Tab), MimeTab = proplists:get_value(mime_types, Properties), NewProperties = proplists:delete(mime_types, Properties), [{mime_types, ets:tab2list(MimeTab)} | NewProperties]. -get_config(Address, Port, Properties) -> - Tab = httpd_util:make_name("httpd_conf", Address, Port), +get_config(Address, Port, Profile, Properties) -> + Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile), Config = lists:map(fun(Prop) -> {Prop, httpd_util:lookup(Tab, Prop)} end, Properties), diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl index b95be44b2a..90800f2724 100644 --- a/lib/inets/src/http_server/httpd_instance_sup.erl +++ b/lib/inets/src/http_server/httpd_instance_sup.erl @@ -27,6 +27,8 @@ -behaviour(supervisor). +-include("httpd_internal.hrl"). + %% Internal application API -export([start_link/3, start_link/4]). @@ -41,7 +43,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> {ok, Config2} -> Address = proplists:get_value(bind_address, Config2), Port = proplists:get_value(port, Config2), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [undefined, Config2, AcceptTimeout, @@ -54,7 +57,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> start_link(ConfigFile, AcceptTimeout, Debug) -> case file_2_config(ConfigFile) of {ok, ConfigList, Address, Port} -> - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [ConfigFile, ConfigList, AcceptTimeout, @@ -70,7 +74,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> {ok, Config2} -> Address = proplists:get_value(bind_address, Config2), Port = proplists:get_value(port, Config2), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [undefined, Config2, AcceptTimeout, @@ -83,7 +88,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> case file_2_config(ConfigFile) of {ok, ConfigList, Address, Port} -> - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [ConfigFile, ConfigList, AcceptTimeout, @@ -99,22 +105,24 @@ start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> %%%========================================================================= init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port]) -> httpd_util:enable_debug(Debug), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), Flags = {one_for_one, 0, 1}, - Children = [httpd_connection_sup_spec(Address, Port), - httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, + Children = [httpd_connection_sup_spec(Address, Port, Profile), + httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, undefined), - sup_spec(httpd_misc_sup, Address, Port), - worker_spec(httpd_manager, Address, Port, + sup_spec(httpd_misc_sup, Address, Port, Profile), + worker_spec(httpd_manager, Address, Port, Profile, ConfigFile, ConfigList,AcceptTimeout)], {ok, {Flags, Children}}; init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) -> httpd_util:enable_debug(Debug), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), Flags = {one_for_one, 0, 1}, - Children = [httpd_connection_sup_spec(Address, Port), - httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, - ListenInfo), - sup_spec(httpd_misc_sup, Address, Port), - worker_spec(httpd_manager, Address, Port, ListenInfo, + Children = [httpd_connection_sup_spec(Address, Port, Profile), + httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, + ListenInfo), + sup_spec(httpd_misc_sup, Address, Port, Profile), + worker_spec(httpd_manager, Address, Port, Profile, ListenInfo, ConfigFile, ConfigList, AcceptTimeout)], {ok, {Flags, Children}}. @@ -122,8 +130,8 @@ init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) %%%========================================================================= %%% Internal functions %%%========================================================================= -httpd_connection_sup_spec(Address, Port) -> - Name = {httpd_connection_sup, Address, Port}, +httpd_connection_sup_spec(Address, Port, Profile) -> + Name = {httpd_connection_sup, Address, Port, Profile}, StartFunc = {httpd_connection_sup, start_link, [[Address, Port]]}, Restart = permanent, Shutdown = 5000, @@ -131,8 +139,8 @@ httpd_connection_sup_spec(Address, Port) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> - Name = {httpd_acceptor_sup, Address, Port}, +httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, ListenInfo) -> + Name = {httpd_acceptor_sup, Address, Port, Profile}, StartFunc = {httpd_acceptor_sup, start_link, [[Address, Port, ConfigList, AcceptTimeout, ListenInfo]]}, Restart = permanent, Shutdown = infinity, @@ -140,18 +148,18 @@ httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -sup_spec(SupModule, Address, Port) -> - Name = {SupModule, Address, Port}, - StartFunc = {SupModule, start_link, [Address, Port]}, +sup_spec(SupModule, Address, Port, Profile) -> + Name = {SupModule, Address, Port, Profile}, + StartFunc = {SupModule, start_link, [Address, Port, Profile]}, Restart = permanent, Shutdown = infinity, Modules = [SupModule], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -worker_spec(WorkerModule, Address, Port, ConfigFile, +worker_spec(WorkerModule, Address, Port, Profile, ConfigFile, ConfigList, AcceptTimeout) -> - Name = {WorkerModule, Address, Port}, + Name = {WorkerModule, Address, Port, Profile}, StartFunc = {WorkerModule, start_link, [ConfigFile, ConfigList, AcceptTimeout]}, Restart = permanent, @@ -160,9 +168,9 @@ worker_spec(WorkerModule, Address, Port, ConfigFile, Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile, +worker_spec(WorkerModule, Address, Port, Profile, ListenInfo, ConfigFile, ConfigList, AcceptTimeout) -> - Name = {WorkerModule, Address, Port}, + Name = {WorkerModule, Address, Port, Profile}, StartFunc = {WorkerModule, start_link, [ConfigFile, ConfigList, AcceptTimeout, ListenInfo]}, Restart = permanent, @@ -171,8 +179,8 @@ worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile, Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -make_name(Address,Port) -> - httpd_util:make_name("httpd_instance_sup", Address, Port). +make_name(Address, Port, Profile) -> + httpd_util:make_name("httpd_instance_sup", Address, Port, Profile). file_2_config(ConfigFile) -> diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl index 108469ea0a..9829ca255c 100644 --- a/lib/inets/src/http_server/httpd_internal.hrl +++ b/lib/inets/src/http_server/httpd_internal.hrl @@ -31,6 +31,8 @@ -define(SOCKET_MAX_POLL,25). -define(FILE_CHUNK_SIZE,64*1024). -define(GATEWAY_INTERFACE,"CGI/1.1"). +-define(DEFAULT_PROFILE, default). + -define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)). -define(DEFAULT_CONTEXT, [{errmsg,"[an error occurred while processing this directive]"}, diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index 3da0343401..995316d5e8 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -28,7 +28,7 @@ -export([start/2, start_link/2, start_link/3, start_link/4, stop/1, reload/2]). -export([new_connection/1]). --export([config_match/2, config_match/3]). +-export([config_match/3, config_match/4]). -export([block/2, block/3, unblock/1]). %% gen_server exports @@ -54,7 +54,8 @@ start(ConfigFile, ConfigList) -> Port = proplists:get_value(port,ConfigList,80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr,Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start({local,Name},?MODULE, [ConfigFile, ConfigList, 15000, Addr, Port],[]). @@ -65,7 +66,8 @@ start_link(ConfigFile, ConfigList) -> start_link(ConfigFile, ConfigList, AcceptTimeout) -> Port = proplists:get_value(port, ConfigList, 80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, @@ -74,7 +76,8 @@ start_link(ConfigFile, ConfigList, AcceptTimeout) -> start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) -> Port = proplists:get_value(port, ConfigList, 80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, AcceptTimeout, Addr, @@ -97,10 +100,10 @@ unblock(ServerRef) -> new_connection(Manager) -> call(Manager, {new_connection, self()}). -config_match(Port, Pattern) -> - config_match(undefined,Port,Pattern). -config_match(Addr, Port, Pattern) -> - Name = httpd_util:make_name("httpd",Addr,Port), +config_match(Port, Profile, Pattern) -> + config_match(undefined,Port, Profile, Pattern). +config_match(Addr, Port, Profile, Pattern) -> + Name = httpd_util:make_name("httpd",Addr,Port, Profile), call(whereis(Name), {config_match, Pattern}). %%%-------------------------------------------------------------------- @@ -446,8 +449,8 @@ get_ustate(ConnectionCnt,State) -> active end. -make_name(Addr,Port) -> - httpd_util:make_name("httpd",Addr,Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd", Addr, Port, Profile). report_error(State,String) -> diff --git a/lib/inets/src/http_server/httpd_misc_sup.erl b/lib/inets/src/http_server/httpd_misc_sup.erl index fd7c28bd7d..e5de66d773 100644 --- a/lib/inets/src/http_server/httpd_misc_sup.erl +++ b/lib/inets/src/http_server/httpd_misc_sup.erl @@ -27,8 +27,8 @@ -behaviour(supervisor). %% API --export([start_link/2, start_auth_server/2, stop_auth_server/2, - start_sec_server/2, stop_sec_server/2]). +-export([start_link/3, start_auth_server/3, stop_auth_server/3, + start_sec_server/3, stop_sec_server/3]). %% Supervisor callback -export([init/1]). @@ -37,26 +37,26 @@ %%% API %%%========================================================================= -start_link(Addr, Port) -> - SupName = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + SupName = make_name(Addr, Port, Profile), supervisor:start_link({local, SupName}, ?MODULE, []). %%---------------------------------------------------------------------- %% Function: [start|stop]_[auth|sec]_server/3 %% Description: Starts a [auth | security] worker (child) process %%---------------------------------------------------------------------- -start_auth_server(Addr, Port) -> - start_permanent_worker(mod_auth_server, Addr, Port, [gen_server]). +start_auth_server(Addr, Port, Profile) -> + start_permanent_worker(mod_auth_server, Addr, Port, Profile, [gen_server]). -stop_auth_server(Addr, Port) -> - stop_permanent_worker(mod_auth_server, Addr, Port). +stop_auth_server(Addr, Port, Profile) -> + stop_permanent_worker(mod_auth_server, Addr, Port, Profile). -start_sec_server(Addr, Port) -> - start_permanent_worker(mod_security_server, Addr, Port, [gen_server]). +start_sec_server(Addr, Port, Profile) -> + start_permanent_worker(mod_security_server, Addr, Port, Profile, [gen_server]). -stop_sec_server(Addr, Port) -> - stop_permanent_worker(mod_security_server, Addr, Port). +stop_sec_server(Addr, Port, Profile) -> + stop_permanent_worker(mod_security_server, Addr, Port, Profile). %%%========================================================================= @@ -70,15 +70,15 @@ init(_) -> %%%========================================================================= %%% Internal functions %%%========================================================================= -start_permanent_worker(Mod, Addr, Port, Modules) -> - SupName = make_name(Addr, Port), +start_permanent_worker(Mod, Addr, Port, Profile, Modules) -> + SupName = make_name(Addr, Port, Profile), Spec = {{Mod, Addr, Port}, - {Mod, start_link, [Addr, Port]}, + {Mod, start_link, [Addr, Port, Profile]}, permanent, timer:seconds(1), worker, [Mod] ++ Modules}, supervisor:start_child(SupName, Spec). -stop_permanent_worker(Mod, Addr, Port) -> - SupName = make_name(Addr, Port), +stop_permanent_worker(Mod, Addr, Port, Profile) -> + SupName = make_name(Addr, Port, Profile), Name = {Mod, Addr, Port}, case supervisor:terminate_child(SupName, Name) of ok -> @@ -87,5 +87,5 @@ stop_permanent_worker(Mod, Addr, Port) -> Error end. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_misc_sup",Addr,Port). +make_name(Addr,Port, Profile) -> + httpd_util:make_name("httpd_misc_sup",Addr,Port, Profile). diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl index 3b1e16cf78..b45742136a 100644 --- a/lib/inets/src/http_server/httpd_sup.erl +++ b/lib/inets/src/http_server/httpd_sup.erl @@ -28,7 +28,7 @@ %% Internal application API -export([start_link/1, start_link/2]). --export([start_child/1, restart_child/2, stop_child/2]). +-export([start_child/1, restart_child/3, stop_child/3]). %% Supervisor callback -export([init/1]). @@ -37,7 +37,6 @@ -define(TIMEOUT, 15000). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). %%%========================================================================= %%% API @@ -64,33 +63,32 @@ start_child(Config) -> end. -restart_child(Address, Port) -> - Name = id(Address, Port), +restart_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(?MODULE, Name) of - ok -> - supervisor:restart_child(?MODULE, Name); - Error -> - Error - end. - -stop_child(Address, Port) -> - Name = id(Address, Port), + ok -> + supervisor:restart_child(?MODULE, Name); + Error -> + Error + end. + +stop_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(?MODULE, Name) of - ok -> - supervisor:delete_child(?MODULE, Name); - Error -> + ok -> + supervisor:delete_child(?MODULE, Name); + Error -> Error end. - -id(Address, Port) -> - {httpd_instance_sup, Address, Port}. + +id(Address, Port, Profile) -> + {httpd_instance_sup, Address, Port, Profile}. %%%========================================================================= %%% Supervisor callback %%%========================================================================= init([HttpdServices]) -> - ?hdrd("starting", [{httpd_service, HttpdServices}]), RestartStrategy = one_for_one, MaxR = 10, MaxT = 3600, @@ -118,23 +116,18 @@ init([HttpdServices]) -> child_specs([], Acc) -> Acc; child_specs([{httpd, HttpdService} | Rest], Acc) -> - ?hdrd("child specs", [{httpd, HttpdService}]), NewHttpdService = (catch mk_tuple_list(HttpdService)), - ?hdrd("child specs", [{new_httpd, NewHttpdService}]), case catch child_spec(NewHttpdService) of {error, Reason} -> - ?hdri("failed generating child spec", [{reason, Reason}]), error_msg("Failed to start service: ~n~p ~n due to: ~p~n", [HttpdService, Reason]), child_specs(Rest, Acc); Spec -> - ?hdrt("child spec", [{child_spec, Spec}]), child_specs(Rest, [Spec | Acc]) end. child_spec(HttpdService) -> {ok, Config} = httpd_config(HttpdService), - ?hdrt("child spec", [{config, Config}]), Debug = proplists:get_value(debug, Config, []), AcceptTimeout = proplists:get_value(accept_timeout, Config, 15000), httpd_util:valid_options(Debug, AcceptTimeout, Config), @@ -162,32 +155,27 @@ httpd_config([Value| _] = Config) when is_tuple(Value) -> httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug) when is_tuple(Value) -> - ?hdrt("httpd_child_spec - entry", [{accept_timeout, AcceptTimeout}, - {debug, Debug}]), Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port); + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), + httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port, Profile); %% In this case the AcceptTimeout and Debug will only have default values... httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> - ?hdrt("httpd_child_spec - entry", [{config_file, ConfigFile}, - {accept_timeout_def, AcceptTimeoutDef}, - {debug_def, DebugDef}]), case httpd_conf:load(ConfigFile) of {ok, ConfigList} -> - ?hdrt("httpd_child_spec - loaded", [{config_list, ConfigList}]), case (catch httpd_conf:validate_properties(ConfigList)) of {ok, Config} -> - ?hdrt("httpd_child_spec - validated", [{config, Config}]), Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), AcceptTimeout = proplists:get_value(accept_timeout, Config, AcceptTimeoutDef), Debug = proplists:get_value(debug, Config, DebugDef), httpd_child_spec([{file, ConfigFile} | Config], - AcceptTimeout, Debug, Address, Port); + AcceptTimeout, Debug, Address, Port, Profile); Error -> Error end; @@ -195,19 +183,19 @@ httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> Error end. -httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) -> +httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> Fd = proplists:get_value(fd, Config, undefined), case Port == 0 orelse Fd =/= undefined of true -> - httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port); + httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile); false -> - httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) + httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) end. -httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) -> +httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> case start_listen(Addr, Port, Config) of {Pid, {NewPort, NewConfig, ListenSocket}} -> - Name = {httpd_instance_sup, Addr, NewPort}, + Name = {httpd_instance_sup, Addr, NewPort, Profile}, StartFunc = {httpd_instance_sup, start_link, [NewConfig, AcceptTimeout, {Pid, ListenSocket}, Debug]}, @@ -221,8 +209,8 @@ httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) -> {error, Reason} end. -httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) -> - Name = {httpd_instance_sup, Addr, Port}, +httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> + Name = {httpd_instance_sup, Addr, Port, Profile}, StartFunc = {httpd_instance_sup, start_link, [Config, AcceptTimeout, Debug]}, Restart = permanent, diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index 0d04a75205..b1ddc1abbb 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -572,7 +572,10 @@ make_name(Prefix,Port) -> make_name(Prefix,Addr,Port) -> make_name(Prefix,Addr,Port,""). - + +make_name(Prefix, Addr,Port,Postfix) when is_atom(Postfix)-> + make_name(Prefix, Addr,Port, atom_to_list(Postfix)); + make_name(Prefix,"*",Port,Postfix) -> make_name(Prefix,undefined,Port,Postfix); @@ -595,15 +598,7 @@ make_name2({A,B,C,D}) -> io_lib:format("~w_~w_~w_~w", [A,B,C,D]); make_name2({A, B, C, D, E, F, G, H}) -> - io_lib:format("~s_~s_~s_~s_~s_~s_~s_~s", [integer_to_hexlist(A), - integer_to_hexlist(B), - integer_to_hexlist(C), - integer_to_hexlist(D), - integer_to_hexlist(E), - integer_to_hexlist(F), - integer_to_hexlist(G), - integer_to_hexlist(H) - ]); + io_lib:format("~w_~w_~w_~w_~w_~w_~w_~w", [A,B,C,D,E,F,G,H]); make_name2(Addr) -> search_and_replace(Addr,$.,$_). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index 85a87ab884..1f4470622d 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -38,15 +38,16 @@ -include("httpd.hrl"). -include("mod_auth.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"AUTH"). -define(NOPASSWORD,"NoPassword"). -%% do +%%==================================================================== +%% Internal application API +%%==================================================================== + do(Info) -> - ?hdrt("do", [{info, Info}]), case proplists:get_value(status,Info#mod.data) of %% A status code has been generated! {_StatusCode, _PhraseArgs, _Reason} -> @@ -61,22 +62,15 @@ do(Info) -> %% Is it a secret area? case secretp(Path,Info#mod.config_db) of {yes, {Directory, DirectoryData}} -> - ?hdrt("secret area", - [{directory, Directory}, - {directory_data, DirectoryData}]), - - %% Authenticate (allow) case allow((Info#mod.init_data)#init_data.peername, Info#mod.socket_type,Info#mod.socket, DirectoryData) of allowed -> - ?hdrt("allowed", []), case deny((Info#mod.init_data)#init_data.peername, Info#mod.socket_type, Info#mod.socket, DirectoryData) of not_denied -> - ?hdrt("not denied", []), case proplists:get_value(auth_type, DirectoryData) of undefined -> @@ -90,15 +84,13 @@ do(Info) -> AuthType) end; {denied, Reason} -> - ?hdrt("denied", [{reason, Reason}]), {proceed, [{status, {403, - Info#mod.request_uri, - Reason}}| + Info#mod.request_uri, + Reason}}| Info#mod.data]} end; {not_allowed, Reason} -> - ?hdrt("not allowed", [{reason, Reason}]), {proceed,[{status,{403, Info#mod.request_uri, Reason}} | @@ -114,18 +106,299 @@ do(Info) -> end. -do_auth(Info, Directory, DirectoryData, AuthType) -> +%% mod_auth recognizes the following Configuration Directives: +%% <Directory /path/to/directory> +%% AuthDBType +%% AuthName +%% AuthUserFile +%% AuthGroupFile +%% AuthAccessPassword +%% require +%% allow +%% </Directory> + +%% When a <Directory> directive is found, a new context is set to +%% [{directory, Directory, DirData}|OtherContext] +%% DirData in this case is a key-value list of data belonging to the +%% directory in question. +%% +%% When the </Directory> statement is found, the Context created earlier +%% will be returned as a ConfigList and the context will return to the +%% state it was previously. + +load("<Directory " ++ Directory,[]) -> + Dir = httpd_conf:custom_clean(Directory,"",">"), + {ok,[{directory, {Dir, [{path, Dir}]}}]}; +load(eof,[{directory, {Directory, _DirData}}|_]) -> + {error, ?NICE("Premature end-of-file in "++ Directory)}; + +load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> + {ok, [{directory, {Directory, + [{auth_name, httpd_conf:clean(AuthName)} | DirData]}} + | Rest ]}; +load("AuthUserFile " ++ AuthUserFile0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthUserFile = httpd_conf:clean(AuthUserFile0), + {ok, [{directory, {Directory, + [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; +load("AuthGroupFile " ++ AuthGroupFile0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthGroupFile = httpd_conf:clean(AuthGroupFile0), + {ok,[{directory, {Directory, + [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; + +load("AuthAccessPassword " ++ AuthAccessPassword0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), + {ok,[{directory, {Directory, + [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; + +load("AuthDBType " ++ Type, + [{directory, {Dir, DirData}}|Rest]) -> + case httpd_conf:clean(Type) of + "plain" -> + {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; + "mnesia" -> + {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; + "dets" -> + {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; + _ -> + {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")} + end; + +load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Require," ") of + {ok,["user"|Users]} -> + {ok,[{directory, {Directory, + [{require_user,Users}|DirData]}} | Rest]}; + {ok,["group"|Groups]} -> + {ok,[{directory, {Directory, + [{require_group,Groups}|DirData]}} | Rest]}; + {ok,_} -> + {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")} + end; + +load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Allow," ") of + {ok,["from","all"]} -> + {ok,[{directory, {Directory, + [{allow_from,all}|DirData]}} | Rest]}; + {ok,["from"|Hosts]} -> + {ok,[{directory, {Directory, + [{allow_from,Hosts}|DirData]}} | Rest]}; + {ok,_} -> + {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")} + end; + +load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Deny," ") of + {ok, ["from", "all"]} -> + {ok,[{{directory, Directory, + [{deny_from, all}|DirData]}} | Rest]}; + {ok, ["from"|Hosts]} -> + {ok,[{{directory, Directory, + [{deny_from, Hosts}|DirData]}} | Rest]}; + {ok, _} -> + {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")} + end; + +load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> + {ok, Rest, {directory, {Directory, DirData}}}; + +load("AuthMnesiaDB " ++ AuthMnesiaDB, + [{directory, {Dir, DirData}}|Rest]) -> + case httpd_conf:clean(AuthMnesiaDB) of + "On" -> + {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; + "Off" -> + {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; + _ -> + {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++ + " is an invalid AuthMnesiaDB")} + end. + +store({directory, {Directory, DirData}}, ConfigList) + when is_list(Directory) andalso is_list(DirData) -> + try directory_config_check(Directory, DirData) of + ok -> + store_directory(Directory, DirData, ConfigList) + catch + throw:Error -> + {error, Error, {directory, Directory, DirData}} + end; +store({directory, {Directory, DirData}}, _) -> + {error, {wrong_type, {directory, {Directory, DirData}}}}. + +remove(ConfigDB) -> + lists:foreach(fun({directory, {_Dir, DirData}}) -> + AuthMod = auth_mod_name(DirData), + (catch apply(AuthMod, remove, [DirData])) + end, + ets:match_object(ConfigDB,{directory,{'_','_'}})), + + Addr = httpd_util:lookup(ConfigDB, bind_address, undefined), + Port = httpd_util:lookup(ConfigDB, port), + Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), + mod_auth_server:stop(Addr, Port, Profile), + ok. + +add_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd}-> + case get_options(Opt, userData) of + {error, Reason}-> + {error, Reason}; + {UserData, Password}-> + User = [#httpd_user{username = UserName, + password = Password, + user_data = UserData}], + mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd) + end + end. + + +add_user(UserName, Password, UserData, Port, Dir) -> + add_user(UserName, Password, UserData, undefined, Port, Dir). +add_user(UserName, Password, UserData, Addr, Port, Dir) -> + User = [#httpd_user{username = UserName, + password = Password, + user_data = UserData}], + mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD). + +get_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +get_user(UserName, Port, Dir) -> + get_user(UserName, undefined, Port, Dir). +get_user(UserName, Addr, Port, Dir) -> + mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). + +add_group_member(GroupName, UserName, Opt)-> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd}-> + mod_auth_server:add_group_member(Addr, Port, Dir, + GroupName, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +add_group_member(GroupName, UserName, Port, Dir) -> + add_group_member(GroupName, UserName, undefined, Port, Dir). + +add_group_member(GroupName, UserName, Addr, Port, Dir) -> + mod_auth_server:add_group_member(Addr, Port, Dir, + GroupName, UserName, ?NOPASSWORD). + +delete_group_member(GroupName, UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_group_member(Addr, Port, Dir, + GroupName, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_group_member(GroupName, UserName, Port, Dir) -> + delete_group_member(GroupName, UserName, undefined, Port, Dir). +delete_group_member(GroupName, UserName, Addr, Port, Dir) -> + mod_auth_server:delete_group_member(Addr, Port, Dir, + GroupName, UserName, ?NOPASSWORD). + +list_users(Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_users(Addr, Port, Dir, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_users(Port, Dir) -> + list_users(undefined, Port, Dir). +list_users(Addr, Port, Dir) -> + mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD). + +delete_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_user(UserName, Port, Dir) -> + delete_user(UserName, undefined, Port, Dir). +delete_user(UserName, Addr, Port, Dir) -> + mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD). + +delete_group(GroupName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_group(GroupName, Port, Dir) -> + delete_group(GroupName, undefined, Port, Dir). +delete_group(GroupName, Addr, Port, Dir) -> + mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD). + +list_groups(Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_groups(Port, Dir) -> + list_groups(undefined, Port, Dir). +list_groups(Addr, Port, Dir) -> + mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD). + +list_group_members(GroupName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, + AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_group_members(GroupName, Port, Dir) -> + list_group_members(GroupName, undefined, Port, Dir). +list_group_members(GroupName, Addr, Port, Dir) -> + mod_auth_server:list_group_members(Addr, Port, Dir, + GroupName, ?NOPASSWORD). + +update_password(Port, Dir, Old, New, New)-> + update_password(undefined, Port, Dir, Old, New, New). + +update_password(Addr, Port, Dir, Old, New, New) when is_list(New) -> + mod_auth_server:update_password(Addr, Port, Dir, Old, New); + +update_password(_Addr, _Port, _Dir, _Old, _New, _New) -> + {error, badtype}; +update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> + {error, notqeual}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +do_auth(Info, Directory, DirectoryData, _AuthType) -> %% Authenticate (require) - ?hdrt("authenticate", [{auth_type, AuthType}]), case require(Info, Directory, DirectoryData) of authorized -> - ?hdrt("authorized", []), {proceed,Info#mod.data}; {authorized, User} -> - ?hdrt("authorized", [{user, User}]), {proceed, [{remote_user,User}|Info#mod.data]}; {authorization_required, Realm} -> - ?hdrt("authorization required", [{realm, Realm}]), ReasonPhrase = httpd_util:reason_phrase(401), Message = httpd_util:message(401,none,Info#mod.config_db), {proceed, @@ -142,8 +415,6 @@ do_auth(Info, Directory, DirectoryData, AuthType) -> Info#mod.data]} end. -%% require - require(Info, Directory, DirectoryData) -> ParsedHeader = Info#mod.parsed_header, ValidUsers = proplists:get_value(require_user, DirectoryData), @@ -270,13 +541,6 @@ auth_mod_name(DirData) -> dets -> mod_auth_dets end. - -%% -%% Is it a secret area? -%% - -%% secretp - secretp(Path,ConfigDB) -> Directories = ets:match(ConfigDB,{directory, {'$1','_'}}), case secret_path(Path, Directories) of @@ -307,12 +571,6 @@ secret_path(Path, [[NewDirectory] | Rest], Directory) -> secret_path(Path, Rest, Directory) end. -%% -%% Authenticate -%% - -%% allow - allow({_,RemoteAddr}, _SocketType, _Socket, DirectoryData) -> Hosts = proplists:get_value(allow_from, DirectoryData, all), case validate_addr(RemoteAddr, Hosts) of @@ -336,8 +594,6 @@ validate_addr(RemoteAddr, [HostRegExp | Rest]) -> validate_addr(RemoteAddr,Rest) end. -%% deny - deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> Hosts = proplists:get_value(deny_from, DirectoryData, none), case validate_addr(RemoteAddr,Hosts) of @@ -347,124 +603,6 @@ deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> not_denied end. -%% -%% Configuration -%% - -%% load/2 -%% - -%% mod_auth recognizes the following Configuration Directives: -%% <Directory /path/to/directory> -%% AuthDBType -%% AuthName -%% AuthUserFile -%% AuthGroupFile -%% AuthAccessPassword -%% require -%% allow -%% </Directory> - -%% When a <Directory> directive is found, a new context is set to -%% [{directory, Directory, DirData}|OtherContext] -%% DirData in this case is a key-value list of data belonging to the -%% directory in question. -%% -%% When the </Directory> statement is found, the Context created earlier -%% will be returned as a ConfigList and the context will return to the -%% state it was previously. - -load("<Directory " ++ Directory,[]) -> - Dir = httpd_conf:custom_clean(Directory,"",">"), - {ok,[{directory, {Dir, [{path, Dir}]}}]}; -load(eof,[{directory, {Directory, _DirData}}|_]) -> - {error, ?NICE("Premature end-of-file in "++ Directory)}; - -load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> - {ok, [{directory, {Directory, - [{auth_name, httpd_conf:clean(AuthName)} | DirData]}} - | Rest ]}; -load("AuthUserFile " ++ AuthUserFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthUserFile = httpd_conf:clean(AuthUserFile0), - {ok, [{directory, {Directory, - [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; -load("AuthGroupFile " ++ AuthGroupFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthGroupFile = httpd_conf:clean(AuthGroupFile0), - {ok,[{directory, {Directory, - [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; - -%AuthAccessPassword -load("AuthAccessPassword " ++ AuthAccessPassword0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), - {ok,[{directory, {Directory, - [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; - -load("AuthDBType " ++ Type, - [{directory, {Dir, DirData}}|Rest]) -> - case httpd_conf:clean(Type) of - "plain" -> - {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; - "mnesia" -> - {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; - "dets" -> - {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; - _ -> - {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")} - end; - -load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Require," ") of - {ok,["user"|Users]} -> - {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - {ok,["group"|Groups]} -> - {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - {ok,_} -> - {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")} - end; - -load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Allow," ") of - {ok,["from","all"]} -> - {ok,[{directory, {Directory, - [{allow_from,all}|DirData]}} | Rest]}; - {ok,["from"|Hosts]} -> - {ok,[{directory, {Directory, - [{allow_from,Hosts}|DirData]}} | Rest]}; - {ok,_} -> - {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")} - end; - -load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Deny," ") of - {ok, ["from", "all"]} -> - {ok,[{{directory, Directory, - [{deny_from, all}|DirData]}} | Rest]}; - {ok, ["from"|Hosts]} -> - {ok,[{{directory, Directory, - [{deny_from, Hosts}|DirData]}} | Rest]}; - {ok, _} -> - {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")} - end; - -load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> - {ok, Rest, {directory, {Directory, DirData}}}; - -load("AuthMnesiaDB " ++ AuthMnesiaDB, - [{directory, {Dir, DirData}}|Rest]) -> - case httpd_conf:clean(AuthMnesiaDB) of - "On" -> - {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; - "Off" -> - {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; - _ -> - {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++ - " is an invalid AuthMnesiaDB")} - end. directory_config_check(Directory, DirData) -> case proplists:get_value(auth_type, DirData) of @@ -482,25 +620,7 @@ check_filename_present(Dir,AuthFile,DirData) -> throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}}) end. -%% store - -store({directory, {Directory, DirData}}, ConfigList) - when is_list(Directory) andalso is_list(DirData) -> - ?hdrt("store", - [{directory, Directory}, {dir_data, DirData}]), - try directory_config_check(Directory, DirData) of - ok -> - store_directory(Directory, DirData, ConfigList) - catch - throw:Error -> - {error, Error, {directory, Directory, DirData}} - end; -store({directory, {Directory, DirData}}, _) -> - {error, {wrong_type, {directory, {Directory, DirData}}}}. - store_directory(Directory0, DirData0, ConfigList) -> - ?hdrt("store directory - entry", - [{directory, Directory0}, {dir_data, DirData0}]), Port = proplists:get_value(port, ConfigList), DirData = case proplists:get_value(bind_address, ConfigList) of undefined -> @@ -522,9 +642,7 @@ store_directory(Directory0, DirData0, ConfigList) -> dets -> mod_auth_dets; plain -> mod_auth_plain; _ -> no_module_at_all - end, - ?hdrt("store directory", - [{directory, Directory}, {dir_data, DirData}, {auth_mod, AuthMod}]), + end, case AuthMod of no_module_at_all -> {ok, {directory, {Directory, DirData}}}; @@ -560,204 +678,10 @@ store_directory(Directory0, DirData0, ConfigList) -> add_auth_password(Dir, Pwd0, ConfigList) -> Addr = proplists:get_value(bind_address, ConfigList), Port = proplists:get_value(port, ConfigList), - mod_auth_server:start(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + mod_auth_server:start(Addr, Port, Profile), mod_auth_server:add_password(Addr, Port, Dir, Pwd0). -%% remove - - -remove(ConfigDB) -> - lists:foreach(fun({directory, {_Dir, DirData}}) -> - AuthMod = auth_mod_name(DirData), - (catch apply(AuthMod, remove, [DirData])) - end, - ets:match_object(ConfigDB,{directory,{'_','_'}})), - Addr = case lookup(ConfigDB, bind_address) of - [] -> - undefined; - [{bind_address, Address}] -> - Address - end, - [{port, Port}] = lookup(ConfigDB, port), - mod_auth_server:stop(Addr, Port), - ok. - -%% -------------------------------------------------------------------- - -%% update_password - -update_password(Port, Dir, Old, New, New)-> - update_password(undefined, Port, Dir, Old, New, New). - -update_password(Addr, Port, Dir, Old, New, New) when is_list(New) -> - mod_auth_server:update_password(Addr, Port, Dir, Old, New); - -update_password(_Addr, _Port, _Dir, _Old, _New, _New) -> - {error, badtype}; -update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> - {error, notqeual}. - - -%% add_user - -add_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd}-> - case get_options(Opt, userData) of - {error, Reason}-> - {error, Reason}; - {UserData, Password}-> - User = [#httpd_user{username = UserName, - password = Password, - user_data = UserData}], - mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd) - end - end. - - -add_user(UserName, Password, UserData, Port, Dir) -> - add_user(UserName, Password, UserData, undefined, Port, Dir). -add_user(UserName, Password, UserData, Addr, Port, Dir) -> - User = [#httpd_user{username = UserName, - password = Password, - user_data = UserData}], - mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD). - - -%% get_user - -get_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -get_user(UserName, Port, Dir) -> - get_user(UserName, undefined, Port, Dir). -get_user(UserName, Addr, Port, Dir) -> - mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - - -%% add_group_member - -add_group_member(GroupName, UserName, Opt)-> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd}-> - mod_auth_server:add_group_member(Addr, Port, Dir, - GroupName, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -add_group_member(GroupName, UserName, Port, Dir) -> - add_group_member(GroupName, UserName, undefined, Port, Dir). - -add_group_member(GroupName, UserName, Addr, Port, Dir) -> - mod_auth_server:add_group_member(Addr, Port, Dir, - GroupName, UserName, ?NOPASSWORD). - - -%% delete_group_member - -delete_group_member(GroupName, UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_group_member(Addr, Port, Dir, - GroupName, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_group_member(GroupName, UserName, Port, Dir) -> - delete_group_member(GroupName, UserName, undefined, Port, Dir). -delete_group_member(GroupName, UserName, Addr, Port, Dir) -> - mod_auth_server:delete_group_member(Addr, Port, Dir, - GroupName, UserName, ?NOPASSWORD). - - -%% list_users - -list_users(Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_users(Addr, Port, Dir, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_users(Port, Dir) -> - list_users(undefined, Port, Dir). -list_users(Addr, Port, Dir) -> - mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD). - - -%% delete_user - -delete_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_user(UserName, Port, Dir) -> - delete_user(UserName, undefined, Port, Dir). -delete_user(UserName, Addr, Port, Dir) -> - mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - - -%% delete_group - -delete_group(GroupName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_group(GroupName, Port, Dir) -> - delete_group(GroupName, undefined, Port, Dir). -delete_group(GroupName, Addr, Port, Dir) -> - mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD). - - -%% list_groups - -list_groups(Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_groups(Port, Dir) -> - list_groups(undefined, Port, Dir). -list_groups(Addr, Port, Dir) -> - mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD). - - -%% list_group_members - -list_group_members(GroupName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, - AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_group_members(GroupName, Port, Dir) -> - list_group_members(GroupName, undefined, Port, Dir). -list_group_members(GroupName, Addr, Port, Dir) -> - mod_auth_server:list_group_members(Addr, Port, Dir, - GroupName, ?NOPASSWORD). - %% Opt = [{port, Port}, %% {addr, Addr}, %% {dir, Dir}, @@ -792,7 +716,3 @@ get_options(Opt, userData)-> {UserData, Pwd} end end. - - -lookup(Db, Key) -> - ets:lookup(Db, Key). diff --git a/lib/inets/src/http_server/mod_auth_dets.erl b/lib/inets/src/http_server/mod_auth_dets.erl index a48725d5d9..4220f46166 100644 --- a/lib/inets/src/http_server/mod_auth_dets.erl +++ b/lib/inets/src/http_server/mod_auth_dets.erl @@ -38,23 +38,23 @@ -include("httpd_internal.hrl"). -include("mod_auth.hrl"). -store_directory_data(_Directory, DirData, Server_root) -> - ?CDEBUG("store_directory_data -> ~n" - " Directory: ~p~n" - " DirData: ~p", - [_Directory, DirData]), +%%==================================================================== +%% Internal application API +%%==================================================================== +store_directory_data(_Directory, DirData, Server_root) -> {PWFile, Absolute_pwdfile} = absolute_file_name(auth_user_file, DirData, Server_root), {GroupFile, Absolute_groupfile} = absolute_file_name(auth_group_file, DirData, Server_root), Addr = proplists:get_value(bind_address, DirData), Port = proplists:get_value(port, DirData), + Profile = proplists:get_value(profile, DirData, ?DEFAULT_PROFILE), - PWName = httpd_util:make_name("httpd_dets_pwdb",Addr,Port), + PWName = httpd_util:make_name("httpd_dets_pwdb", Addr, Port, Profile), case dets:open_file(PWName,[{type,set},{file,Absolute_pwdfile},{repair,true}]) of {ok, PWDB} -> - GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port), + GDBName = httpd_util:make_name("httpd_dets_groupdb", Addr, Port, Profile), case dets:open_file(GDBName,[{type,set},{file,Absolute_groupfile},{repair,true}]) of {ok, GDB} -> NDD1 = lists:keyreplace(auth_user_file, 1, DirData, @@ -69,11 +69,8 @@ store_directory_data(_Directory, DirData, Server_root) -> {error, {{file, PWFile},Err2}} end. -%% %% Storage format of users in the dets table: %% {{UserName, Addr, Port, Dir}, Password, UserData} -%% - add_user(DirData, UStruct) -> {Addr, Port, Dir} = lookup_common(DirData), PWDB = proplists:get_value(auth_user_file, DirData), @@ -99,21 +96,15 @@ get_user(DirData, UserName) -> end. list_users(DirData) -> - ?DEBUG("list_users -> ~n" - " DirData: ~p", [DirData]), {Addr, Port, Dir} = lookup_common(DirData), PWDB = proplists:get_value(auth_user_file, DirData), - case dets:traverse(PWDB, fun(X) -> {continue, X} end) of %% SOOOO Ugly ! + case dets:traverse(PWDB, fun(X) -> {continue, X} end) of Records when is_list(Records) -> - ?DEBUG("list_users -> ~n" - " Records: ~p", [Records]), {ok, [UserName || {{UserName, AnyAddr, AnyPort, AnyDir}, _Password, _Data} <- Records, AnyAddr == Addr, AnyPort == Port, AnyDir == Dir]}; _O -> - ?DEBUG("list_users -> ~n" - " O: ~p", [_O]), {ok, []} end. @@ -134,10 +125,8 @@ delete_user(DirData, UserName) -> {error, no_such_user} end. -%% %% Storage of groups in the dets table: %% {Group, UserList} where UserList is a list of strings. -%% add_group_member(DirData, GroupName, UserName) -> {Addr, Port, Dir} = lookup_common(DirData), GDB = proplists:get_value(auth_group_file, DirData), @@ -215,16 +204,7 @@ delete_group(DirData, GroupName) -> {error, no_such_group} end. -lookup_common(DirData) -> - Dir = proplists:get_value(path, DirData), - Port = proplists:get_value(port, DirData), - Addr = proplists:get_value(bind_address, DirData), - {Addr, Port, Dir}. - -%% remove/1 -%% %% Closes dets tables used by this auth mod. -%% remove(DirData) -> PWDB = proplists:get_value(auth_user_file, DirData), GDB = proplists:get_value(auth_group_file, DirData), @@ -232,8 +212,9 @@ remove(DirData) -> dets:close(PWDB), ok. -%% absolute_file_name/2 -%% +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- %% Return the absolute path name of File_type. absolute_file_name(File_type, DirData, Server_root) -> Path = proplists:get_value(File_type, DirData), @@ -253,3 +234,8 @@ absolute_file_name(File_type, DirData, Server_root) -> end, {Path, Absolute_path}. +lookup_common(DirData) -> + Dir = proplists:get_value(path, DirData), + Port = proplists:get_value(port, DirData), + Addr = proplists:get_value(bind_address, DirData), + {Addr, Port, Dir}. diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl index c0a83711ba..7bb86fc812 100644 --- a/lib/inets/src/http_server/mod_auth_plain.erl +++ b/lib/inets/src/http_server/mod_auth_plain.erl @@ -22,15 +22,11 @@ -include("httpd.hrl"). -include("mod_auth.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). - -define(VMODULE,"AUTH_PLAIN"). %% Internal API -export([store_directory_data/3]). - - -export([get_user/2, list_group_members/2, add_user/2, @@ -42,17 +38,13 @@ delete_group/2, remove/1]). -%% -%% API -%% +%%==================================================================== +%% Internal application API +%%==================================================================== -%% %% Storage format of users in the ets table: %% {UserName, Password, UserData} -%% - add_user(DirData, #httpd_user{username = User} = UStruct) -> - ?hdrt("add user", [{user, UStruct}]), PWDB = proplists:get_value(auth_user_file, DirData), Record = {User, UStruct#httpd_user.password, @@ -66,7 +58,6 @@ add_user(DirData, #httpd_user{username = User} = UStruct) -> end. get_user(DirData, User) -> - ?hdrt("get user", [{dir_data, DirData}, {user, User}]), PWDB = proplists:get_value(auth_user_file, DirData), case ets:lookup(PWDB, User) of [{User, PassWd, Data}] -> @@ -84,7 +75,6 @@ list_users(DirData) -> [], lists:flatten(Records))}. delete_user(DirData, UserName) -> - ?hdrt("delete user", [{dir_data, DirData}, {user, UserName}]), PWDB = proplists:get_value(auth_user_file, DirData), case ets:lookup(PWDB, UserName) of [{UserName, _SomePassword, _SomeData}] -> @@ -98,11 +88,8 @@ delete_user(DirData, UserName) -> {error, no_such_user} end. -%% %% Storage of groups in the ets table: %% {Group, UserList} where UserList is a list of strings. -%% - add_group_member(DirData, Group, UserName) -> GDB = proplists:get_value(auth_group_file, DirData), case ets:lookup(GDB, Group) of @@ -163,17 +150,12 @@ delete_group(DirData, Group) -> end. store_directory_data(_Directory, DirData, Server_root) -> - ?hdrt("store directory data", - [{dir_data, DirData}, {server_root, Server_root}]), PWFile = absolute_file_name(auth_user_file, DirData, Server_root), GroupFile = absolute_file_name(auth_group_file, DirData, Server_root), case load_passwd(PWFile) of {ok, PWDB} -> - ?hdrt("password file loaded", [{file, PWFile}, {pwdb, PWDB}]), case load_group(GroupFile) of {ok, GRDB} -> - ?hdrt("group file loaded", - [{file, GroupFile}, {grdb, GRDB}]), %% Address and port is included in the file names... Addr = proplists:get_value(bind_address, DirData), Port = proplists:get_value(port, DirData), @@ -191,9 +173,83 @@ store_directory_data(_Directory, DirData, Server_root) -> {error, Err2} end. +%% Deletes ets tables used by this auth mod. +remove(DirData) -> + PWDB = proplists:get_value(auth_user_file, DirData), + GDB = proplists:get_value(auth_group_file, DirData), + ets:delete(PWDB), + ets:delete(GDB). +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +%% Return the absolute path name of File_type. +absolute_file_name(File_type, DirData, Server_root) -> + Path = proplists:get_value(File_type, DirData), + case filename:pathtype(Path) of + relative -> + case Server_root of + undefined -> + {error, + ?NICE(Path++ + " is an invalid file name because " + "ServerRoot is not defined")}; + _ -> + filename:join(Server_root,Path) + end; + _ -> + Path + end. -%% load_passwd +store_group(Addr,Port,GroupList) -> + %% Not a named table so not importante to add Profile to name + Name = httpd_util:make_name("httpd_group",Addr,Port), + GroupDB = ets:new(Name, [set, public]), + store_group(GroupDB, GroupList). + +store_group(GroupDB,[]) -> + {ok, GroupDB}; +store_group(GroupDB, [User|Rest]) -> + ets:insert(GroupDB, User), + store_group(GroupDB, Rest). + +store_passwd(Addr,Port,PasswdList) -> + %% Not a named table so not importante to add Profile to name + Name = httpd_util:make_name("httpd_passwd",Addr,Port), + PasswdDB = ets:new(Name, [set, public]), + store_passwd(PasswdDB, PasswdList). + +store_passwd(PasswdDB, []) -> + {ok, PasswdDB}; +store_passwd(PasswdDB, [User|Rest]) -> + ets:insert(PasswdDB, User), + store_passwd(PasswdDB, Rest). + +parse_group(Stream, GroupList) -> + Line = + case io:get_line(Stream,'') of + eof -> + eof; + String -> + httpd_conf:clean(String) + end, + parse_group(Stream, GroupList, Line). + +parse_group(Stream, GroupList, eof) -> + file:close(Stream), + {ok, GroupList}; +parse_group(Stream, GroupList, "") -> + parse_group(Stream, GroupList); +parse_group(Stream, GroupList, [$#|_]) -> + parse_group(Stream, GroupList); +parse_group(Stream, GroupList, Line) -> + case inets_regexp:split(Line, ":") of + {ok, [Group,Users]} -> + {ok, UserList} = inets_regexp:split(Users," "), + parse_group(Stream, [{Group,UserList}|GroupList]); + {ok, _} -> + {error, ?NICE(Line)} + end. load_passwd(AuthUserFile) -> case file:open(AuthUserFile, [read]) of @@ -228,8 +284,6 @@ parse_passwd(Stream, PasswdList, Line) -> {error, ?NICE(Line)} end. -%% load_group - load_group(AuthGroupFile) -> case file:open(AuthGroupFile, [read]) of {ok, Stream} -> @@ -237,91 +291,3 @@ load_group(AuthGroupFile) -> {error, _} -> {error, ?NICE("Can't open " ++ AuthGroupFile)} end. - -parse_group(Stream, GroupList) -> - Line = - case io:get_line(Stream,'') of - eof -> - eof; - String -> - httpd_conf:clean(String) - end, - parse_group(Stream, GroupList, Line). - -parse_group(Stream, GroupList, eof) -> - file:close(Stream), - {ok, GroupList}; -parse_group(Stream, GroupList, "") -> - parse_group(Stream, GroupList); -parse_group(Stream, GroupList, [$#|_]) -> - parse_group(Stream, GroupList); -parse_group(Stream, GroupList, Line) -> - case inets_regexp:split(Line, ":") of - {ok, [Group,Users]} -> - {ok, UserList} = inets_regexp:split(Users," "), - parse_group(Stream, [{Group,UserList}|GroupList]); - {ok, _} -> - {error, ?NICE(Line)} - end. - - -%% store_passwd - -store_passwd(Addr,Port,PasswdList) -> - Name = httpd_util:make_name("httpd_passwd",Addr,Port), - PasswdDB = ets:new(Name, [set, public]), - store_passwd(PasswdDB, PasswdList). - -store_passwd(PasswdDB, []) -> - {ok, PasswdDB}; -store_passwd(PasswdDB, [User|Rest]) -> - ets:insert(PasswdDB, User), - store_passwd(PasswdDB, Rest). - -%% store_group - -store_group(Addr,Port,GroupList) -> - Name = httpd_util:make_name("httpd_group",Addr,Port), - GroupDB = ets:new(Name, [set, public]), - store_group(GroupDB, GroupList). - - -store_group(GroupDB,[]) -> - {ok, GroupDB}; -store_group(GroupDB, [User|Rest]) -> - ets:insert(GroupDB, User), - store_group(GroupDB, Rest). - - -%% remove/1 -%% -%% Deletes ets tables used by this auth mod. -%% -remove(DirData) -> - PWDB = proplists:get_value(auth_user_file, DirData), - GDB = proplists:get_value(auth_group_file, DirData), - ets:delete(PWDB), - ets:delete(GDB). - - - -%% absolute_file_name/2 -%% -%% Return the absolute path name of File_type. -absolute_file_name(File_type, DirData, Server_root) -> - Path = proplists:get_value(File_type, DirData), - case filename:pathtype(Path) of - relative -> - case Server_root of - undefined -> - {error, - ?NICE(Path++ - " is an invalid file name because " - "ServerRoot is not defined")}; - _ -> - filename:join(Server_root,Path) - end; - _ -> - Path - end. - diff --git a/lib/inets/src/http_server/mod_auth_server.erl b/lib/inets/src/http_server/mod_auth_server.erl index 947273bd9e..2a45f402d7 100644 --- a/lib/inets/src/http_server/mod_auth_server.erl +++ b/lib/inets/src/http_server/mod_auth_server.erl @@ -22,246 +22,184 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -behaviour(gen_server). - %% mod_auth exports --export([start/2, stop/2, +-export([start/3, stop/3, add_password/4, update_password/5, add_user/5, delete_user/5, get_user/5, list_users/4, add_group_member/6, delete_group_member/6, list_group_members/5, delete_group/5, list_groups/4]). %% gen_server exports --export([start_link/2, init/1, +-export([start_link/3, init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {tab}). +%%==================================================================== +%% Internal application API +%%==================================================================== -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% External API %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% start_link/3 -%% %% NOTE: This is called by httpd_misc_sup when the process is started %% -start_link(Addr, Port) -> - ?hdrt("start_link", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]). - -%% start/2 - -start(Addr, Port) -> - ?hdrd("start", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> - httpd_misc_sup:start_auth_server(Addr, Port); + httpd_misc_sup:start_auth_server(Addr, Port, Profile); _ -> %% Already started... ok end. - -%% stop/2 - -stop(Addr, Port) -> - ?hdrd("stop", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +stop(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> %% Already stopped ok; _ -> - (catch httpd_misc_sup:stop_auth_server(Addr, Port)) + (catch httpd_misc_sup:stop_auth_server(Addr, Port, Profile)) end. -%% add_password/4 - add_password(Addr, Port, Dir, Password) -> - ?hdrt("add password", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), + add_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +add_password(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr, Port, Profile), Req = {add_password, Dir, Password}, call(Name, Req). - -%% update_password/6 - -update_password(Addr, Port, Dir, Old, New) when is_list(New) -> - ?hdrt("update password", - [{address, Addr}, {port, Port}, {dir, Dir}, {old, Old}, {new, New}]), - Name = make_name(Addr, Port), +update_password(Addr, Port, Dir, Old, New) -> + update_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Old, New). +update_password(Addr, Port, Profile, Dir, Old, New) when is_list(New) -> + Name = make_name(Addr, Port, Profile), Req = {update_password, Dir, Old, New}, call(Name, Req). - - -%% add_user/5 add_user(Addr, Port, Dir, User, Password) -> - ?hdrt("add user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, User}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {add_user, Addr, Port, Dir, User, Password}, + add_user(Addr, Port, ?DEFAULT_PROFILE, Dir, User, Password). +add_user(Addr, Port, Profile, Dir, User, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {add_user, Addr, Port, Profile, Dir, User, Password}, call(Name, Req). - -%% delete_user/5 - delete_user(Addr, Port, Dir, UserName, Password) -> - ?hdrt("delete user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {delete_user, Addr, Port, Dir, UserName, Password}, + delete_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password). +delete_user(Addr, Port, Profile, Dir, UserName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {delete_user, Addr, Port, Profile, Dir, UserName, Password}, call(Name, Req). - -%% get_user/5 - get_user(Addr, Port, Dir, UserName, Password) -> - ?hdrt("get user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {get_user, Addr, Port, Dir, UserName, Password}, + get_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password). +get_user(Addr, Port, Profile,Dir, UserName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {get_user, Addr, Port, Profile, Dir, UserName, Password}, call(Name, Req). - -%% list_users/4 - list_users(Addr, Port, Dir, Password) -> - ?hdrt("list users", - [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {list_users, Addr, Port, Dir, Password}, + list_users(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +list_users(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr,Port, Profile), + Req = {list_users, Addr, Port, Profile, Dir, Password}, call(Name, Req). - -%% add_group_member/6 - add_group_member(Addr, Port, Dir, GroupName, UserName, Password) -> - ?hdrt("add group member", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {add_group_member, Addr, Port, Dir, GroupName, UserName, Password}, + add_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password). +add_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) -> + Name = make_name(Addr,Port, Profile), + Req = {add_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password}, call(Name, Req). - -%% delete_group_member/6 - delete_group_member(Addr, Port, Dir, GroupName, UserName, Password) -> - ?hdrt("delete group member", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {delete_group_member, Addr, Port, Dir, GroupName, UserName, Password}, + delete_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password). +delete_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) -> + Name = make_name(Addr,Port,Profile), + Req = {delete_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password}, call(Name, Req). - -%% list_group_members/4 - list_group_members(Addr, Port, Dir, Group, Password) -> - ?hdrt("list group members", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, Group}, {passwd, Password}]), - Name = make_name(Addr, Port), + list_group_members(Addr, Port, ?DEFAULT_PROFILE, Dir, Group, Password). +list_group_members(Addr, Port, Profile, Dir, Group, Password) -> + Name = make_name(Addr, Port, Profile), Req = {list_group_members, Addr, Port, Dir, Group, Password}, call(Name, Req). - -%% delete_group/5 - delete_group(Addr, Port, Dir, GroupName, Password) -> - ?hdrt("delete group", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {delete_group, Addr, Port, Dir, GroupName, Password}, + delete_group(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, Password). +delete_group(Addr, Port, Profile, Dir, GroupName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {delete_group, Addr, Port, Profile, Dir, GroupName, Password}, call(Name, Req). - -%% list_groups/4 - list_groups(Addr, Port, Dir, Password) -> - ?hdrt("list groups", - [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {list_groups, Addr, Port, Dir, Password}, + list_groups(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +list_groups(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {list_groups, Addr, Port,Profile, Dir, Password}, call(Name, Req). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Server call-back functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% init - +%%==================================================================== +%% Behavior call backs +%%==================================================================== init(_) -> - ?hdrv("initiating", []), {ok,#state{tab = ets:new(auth_pwd,[set,protected])}}. %% handle_call %% Add a user -handle_call({add_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, add_user, User, AuthPwd, State), - ?hdrt("add user", [{reply, Reply}]), +handle_call({add_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, add_user, User, AuthPwd, State), {reply, Reply, State}; %% Get data about a user -handle_call({get_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, get_user, [User], AuthPwd, State), +handle_call({get_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, get_user, [User], AuthPwd, State), {reply, Reply, State}; %% Add a group member -handle_call({add_group_member, Addr, Port, Dir, Group, User, AuthPwd}, +handle_call({add_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, add_group_member, [Group, User], + Reply = api_call(Addr, Port, Profile, Dir, add_group_member, [Group, User], AuthPwd, State), {reply, Reply, State}; %% delete a group -handle_call({delete_group_member, Addr, Port, Dir, Group, User, AuthPwd}, +handle_call({delete_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_group_member, [Group, User], + Reply = api_call(Addr, Port, Profile, Dir, delete_group_member, [Group, User], AuthPwd, State), {reply, Reply, State}; %% List all users thats standalone users -handle_call({list_users, Addr, Port, Dir, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_users, [], AuthPwd, State), +handle_call({list_users, Addr, Port, Profile, Dir, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, list_users, [], AuthPwd, State), {reply, Reply, State}; %% Delete a user -handle_call({delete_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_user, [User], AuthPwd, State), +handle_call({delete_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, delete_user, [User], AuthPwd, State), {reply, Reply, State}; %% Delete a group -handle_call({delete_group, Addr, Port, Dir, Group, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_group, [Group], AuthPwd, State), +handle_call({delete_group, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, delete_group, [Group], AuthPwd, State), {reply, Reply, State}; %% List the current groups -handle_call({list_groups, Addr, Port, Dir, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_groups, [], AuthPwd, State), +handle_call({list_groups, Addr, Port, Profile, Dir, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, list_groups, [], AuthPwd, State), {reply, Reply, State}; %% List the members of the given group -handle_call({list_group_members, Addr, Port, Dir, Group, AuthPwd}, +handle_call({list_group_members, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_group_members, [Group], + Reply = api_call(Addr, Port, Profile, Dir, list_group_members, [Group], AuthPwd, State), {reply, Reply, State}; @@ -306,26 +244,16 @@ terminate(_Reason,State) -> ets:delete(State#state.tab), ok. - -%% code_change(Vsn, State, Extra) -%% code_change(_Vsn, State, _Extra) -> {ok, State}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that really changes the data in the database %% -%% of users to different directories %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API gateway - -api_call(Addr, Port, Dir, Func, Args,Password,State) -> +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +api_call(Addr, Port, Profile, Dir, Func, Args,Password,State) -> case controlPassword(Password, State, Dir) of ok-> - ConfigName = httpd_util:make_name("httpd_conf", Addr, Port), + ConfigName = httpd_util:make_name("httpd_conf", Addr, Port, Profile), case ets:match_object(ConfigName, {directory, {Dir, '$1'}}) of [{directory, {Dir, DirData}}] -> AuthMod = auth_mod_name(DirData), @@ -386,8 +314,8 @@ lookup(Db, Key) -> ets:lookup(Db, Key). -make_name(Addr,Port) -> - httpd_util:make_name("httpd_auth",Addr,Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name(?MODULE, Addr, Port, Profile). call(Name, Req) -> @@ -397,5 +325,3 @@ call(Name, Req) -> Reply -> Reply end. - - diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl index 41988732ad..a85383a921 100644 --- a/lib/inets/src/http_server/mod_security.erl +++ b/lib/inets/src/http_server/mod_security.erl @@ -32,14 +32,13 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"SEC"). - -%% do/1 +%%==================================================================== +%% Internal application API +%%==================================================================== do(Info) -> - ?hdrt("do", [{info, Info}]), %% Check and see if any user has been authorized. case proplists:get_value(remote_user, Info#mod.data,not_defined_user) of not_defined_user -> @@ -84,151 +83,66 @@ do(Info) -> {_Dir, SDirData} = secretp(Path, Info#mod.config_db), Addr = httpd_util:lookup(Info#mod.config_db, bind_address), Port = httpd_util:lookup(Info#mod.config_db, port), + Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE), case mod_security_server:check_blocked_user(Info, User, SDirData, - Addr, Port) of + Addr, Port, Profile) of true -> report_failed(Info, User ,"User Blocked"), {proceed, [{status, {403, Info#mod.request_uri, ""}} | Info#mod.data]}; false -> report_failed(Info, User,"Authentication Succedded"), - mod_security_server:store_successful_auth(Addr, Port, + mod_security_server:store_successful_auth(Addr, Port, Profile, User, SDirData), {proceed, Info#mod.data} end end. -report_failed(Info, Auth, Event) -> - Request = Info#mod.request_line, - {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername, - String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ - " : " ++ Auth, - mod_disk_log:security_log(Info,String), - mod_log:security_log(Info, String). - -take_failed_action(Info, Auth) -> - ?hdrd("take failed action", [{auth, Auth}]), - Path = mod_alias:path(Info#mod.data, Info#mod.config_db, - Info#mod.request_uri), - {_Dir, SDirData} = secretp(Path, Info#mod.config_db), - Addr = httpd_util:lookup(Info#mod.config_db, bind_address), - Port = httpd_util:lookup(Info#mod.config_db, port), - mod_security_server:store_failed_auth(Info, Addr, Port, - Auth, SDirData). - -secretp(Path, ConfigDB) -> - Directories = ets:match(ConfigDB,{directory,{'$1','_'}}), - case secret_path(Path, Directories) of - {yes, Directory} -> - ?hdrd("secretp - yes", [{dir, Directory}]), - SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory), - [SDir] = lists:filter(fun({Directory0, _}) - when Directory0 == Directory -> - true; - (_) -> - false - end, SDirs0), - SDir; - no -> - {[], []} - end. - -secret_path(Path,Directories) -> - secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found). - -secret_path(_Path, [], to_be_found) -> - no; -secret_path(_Path, [], Dir) -> - {yes, Dir}; -secret_path(Path, [[NewDir]|Rest], Dir) -> - case inets_regexp:match(Path, NewDir) of - {match, _, _} when Dir =:= to_be_found -> - secret_path(Path, Rest, NewDir); - {match, _, Length} when Length > length(Dir) -> - secret_path(Path, Rest, NewDir); - {match, _, _} -> - secret_path(Path, Rest, Dir); - nomatch -> - secret_path(Path, Rest, Dir) - end. - - load("<Directory " ++ Directory, []) -> - ?hdrt("load security directory - begin", [{directory, Directory}]), Dir = httpd_conf:custom_clean(Directory,"",">"), {ok, [{security_directory, {Dir, [{path, Dir}]}}]}; load(eof,[{security_directory, {Directory, _DirData}}|_]) -> {error, ?NICE("Premature end-of-file in "++Directory)}; load("SecurityDataFile " ++ FileName, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{file, FileName}, {dir, Dir}, {dir_data, DirData}]), File = httpd_conf:clean(FileName), {ok, [{security_directory, {Dir, [{data_file, File}|DirData]}}]}; load("SecurityCallbackModule " ++ ModuleName, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{module, ModuleName}, {dir, Dir}, {dir_data, DirData}]), Mod = list_to_atom(httpd_conf:clean(ModuleName)), {ok, [{security_directory, {Dir, [{callback_module, Mod}|DirData]}}]}; load("SecurityMaxRetries " ++ Retries, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{max_retries, Retries}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityMaxRetries", max_retries, httpd_conf:clean(Retries), Dir, DirData); load("SecurityBlockTime " ++ Time, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{block_time, Time}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityBlockTime", block_time, httpd_conf:clean(Time), Dir, DirData); load("SecurityFailExpireTime " ++ Time, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{expire_time, Time}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityFailExpireTime", fail_expire_time, httpd_conf:clean(Time), Dir, DirData); load("SecurityAuthTimeout " ++ Time0, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{auth_timeout, Time0}, {dir, Dir}, {dir_data, DirData}]), Time = httpd_conf:clean(Time0), load_return_int_tag("SecurityAuthTimeout", auth_timeout, httpd_conf:clean(Time), Dir, DirData); load("AuthName " ++ Name0, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{name, Name0}, {dir, Dir}, {dir_data, DirData}]), Name = httpd_conf:clean(Name0), {ok, [{security_directory, {Dir, [{auth_name, Name}|DirData]}}]}; load("</Directory>",[{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory - end", - [{dir, Dir}, {dir_data, DirData}]), {ok, [], {security_directory, {Dir, DirData}}}. -load_return_int_tag(Name, Atom, Time, Dir, DirData) -> - case Time of - "infinity" -> - {ok, [{security_directory, {Dir, - [{Atom, 99999999999999999999999999999} | DirData]}}]}; - _Int -> - case catch list_to_integer(Time) of - {'EXIT', _} -> - {error, Time++" is an invalid "++Name}; - Val -> - {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]} - end - end. - store({security_directory, {Dir, DirData}}, ConfigList) when is_list(Dir) andalso is_list(DirData) -> - ?hdrt("store security directory", [{dir, Dir}, {dir_data, DirData}]), Addr = proplists:get_value(bind_address, ConfigList), Port = proplists:get_value(port, ConfigList), - mod_security_server:start(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + mod_security_server:start(Addr, Port, Profile), SR = proplists:get_value(server_root, ConfigList), case proplists:get_value(data_file, DirData, no_data_file) of no_data_file -> @@ -241,7 +155,7 @@ store({security_directory, {Dir, DirData}}, ConfigList) _ -> DataFile0 end, - case mod_security_server:new_table(Addr, Port, DataFile) of + case mod_security_server:new_table(Addr, Port, Profile, DataFile) of {ok, TwoTables} -> NewDirData0 = lists:keyreplace(data_file, 1, DirData, {data_file, TwoTables}), @@ -261,45 +175,35 @@ store({directory, {Directory, DirData}}, _) -> {error, {wrong_type, {security_directory, {Directory, DirData}}}}. remove(ConfigDB) -> - Addr = case ets:lookup(ConfigDB, bind_address) of - [] -> - undefined; - [{bind_address, Address}] -> - Address - end, - [{port, Port}] = ets:lookup(ConfigDB, port), - mod_security_server:delete_tables(Addr, Port), - mod_security_server:stop(Addr, Port). + Addr = httpd_util:lookup(ConfigDB, bind_address, undefined), + Port = httpd_util:lookup(ConfigDB, port), + Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), + mod_security_server:delete_tables(Addr, Port, Profile), + mod_security_server:stop(Addr, Port, Profile). -%% -%% User API -%% - -%% list_blocked_users - list_blocked_users(Port) -> list_blocked_users(undefined, Port). list_blocked_users(Port, Dir) when is_integer(Port) -> list_blocked_users(undefined,Port,Dir); list_blocked_users(Addr, Port) when is_integer(Port) -> - mod_security_server:list_blocked_users(Addr, Port). + lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) -> + {User, Addr0, Port0, Dir0,Time} + end, + mod_security_server:list_blocked_users(Addr, Port)). list_blocked_users(Addr, Port, Dir) -> - mod_security_server:list_blocked_users(Addr, Port, Dir). - - -%% block_user + lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) -> + {User, Addr0, Port0, Dir0,Time} + end, + mod_security_server:list_blocked_users(Addr, Port, Dir)). block_user(User, Port, Dir, Time) -> block_user(User, undefined, Port, Dir, Time). block_user(User, Addr, Port, Dir, Time) -> mod_security_server:block_user(User, Addr, Port, Dir, Time). - -%% unblock_user - unblock_user(User, Port) -> unblock_user(User, undefined, Port). @@ -311,9 +215,6 @@ unblock_user(User, Addr, Port) when is_integer(Port) -> unblock_user(User, Addr, Port, Dir) -> mod_security_server:unblock_user(User, Addr, Port, Dir). - -%% list_auth_users - list_auth_users(Port) -> list_auth_users(undefined,Port). @@ -324,3 +225,76 @@ list_auth_users(Addr, Port) when is_integer(Port) -> list_auth_users(Addr, Port, Dir) -> mod_security_server:list_auth_users(Addr, Port, Dir). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +report_failed(Info, Auth, Event) -> + Request = Info#mod.request_line, + {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername, + String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ + " : " ++ Auth, + mod_disk_log:security_log(Info,String), + mod_log:security_log(Info, String). + +take_failed_action(Info, Auth) -> + Path = mod_alias:path(Info#mod.data, Info#mod.config_db, + Info#mod.request_uri), + {_Dir, SDirData} = secretp(Path, Info#mod.config_db), + Addr = httpd_util:lookup(Info#mod.config_db, bind_address), + Port = httpd_util:lookup(Info#mod.config_db, port), + Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE), + mod_security_server:store_failed_auth(Info, Addr, Port, Profile, + Auth, SDirData). + +secretp(Path, ConfigDB) -> + Directories = ets:match(ConfigDB,{directory,{'$1','_'}}), + case secret_path(Path, Directories) of + {yes, Directory} -> + SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory), + [SDir] = lists:filter(fun({Directory0, _}) + when Directory0 == Directory -> + true; + (_) -> + false + end, SDirs0), + SDir; + no -> + {[], []} + end. + +secret_path(Path,Directories) -> + secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found). + +secret_path(_Path, [], to_be_found) -> + no; +secret_path(_Path, [], Dir) -> + {yes, Dir}; +secret_path(Path, [[NewDir]|Rest], Dir) -> + case inets_regexp:match(Path, NewDir) of + {match, _, _} when Dir =:= to_be_found -> + secret_path(Path, Rest, NewDir); + {match, _, Length} when Length > length(Dir) -> + secret_path(Path, Rest, NewDir); + {match, _, _} -> + secret_path(Path, Rest, Dir); + nomatch -> + secret_path(Path, Rest, Dir) + end. + + + +load_return_int_tag(Name, Atom, Time, Dir, DirData) -> + case Time of + "infinity" -> + {ok, [{security_directory, {Dir, + [{Atom, 99999999999999999999999999999} | DirData]}}]}; + _Int -> + case catch list_to_integer(Time) of + {'EXIT', _} -> + {error, Time++" is an invalid "++Name}; + Val -> + {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]} + end + end. diff --git a/lib/inets/src/http_server/mod_security_server.erl b/lib/inets/src/http_server/mod_security_server.erl index 784b3eba70..4f37dff18c 100644 --- a/lib/inets/src/http_server/mod_security_server.erl +++ b/lib/inets/src/http_server/mod_security_server.erl @@ -45,7 +45,6 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -behaviour(gen_server). @@ -57,129 +56,105 @@ list_auth_users/2, list_auth_users/3]). %% Internal exports (for mod_security only) --export([start/2, stop/1, stop/2, - new_table/3, delete_tables/2, - store_failed_auth/5, store_successful_auth/4, - check_blocked_user/5]). +-export([start/3, stop/2, stop/3, + new_table/4, delete_tables/3, + store_failed_auth/6, store_successful_auth/5, + check_blocked_user/6]). %% gen_server exports --export([start_link/2, init/1, +-export([start_link/3, init/1, handle_info/2, handle_call/3, handle_cast/2, terminate/2, code_change/3]). +%%==================================================================== +%% Internal application API +%%==================================================================== -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% External API %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% start_link/3 -%% %% NOTE: This is called by httpd_misc_sup when the process is started -%% - -start_link(Addr, Port) -> - ?hdrt("start_link", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]). - -%% start/2 %% Called by the mod_security module. - -start(Addr, Port) -> - ?hdrt("start", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> - httpd_misc_sup:start_sec_server(Addr, Port); + httpd_misc_sup:start_sec_server(Addr, Port, Profile); _ -> %% Already started... ok end. - -%% stop - -stop(Port) -> - stop(undefined, Port). -stop(Addr, Port) -> - ?hdrt("stop", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +stop(Port, Profile) -> + stop(undefined, Port, Profile). +stop(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> ok; _ -> - httpd_misc_sup:stop_sec_server(Addr, Port) + httpd_misc_sup:stop_sec_server(Addr, Port, Profile) end. - addr(undefined) -> any; addr(Addr) -> Addr. - -%% list_blocked_users - list_blocked_users(Addr, Port) -> - Name = make_name(Addr, Port), - Req = {list_blocked_users, addr(Addr), Port, '_'}, - call(Name, Req). - + list_blocked_users(Addr, Port, ?DEFAULT_PROFILE). +list_blocked_users(Addr, Port, Profile) when is_atom(Profile)-> + Name = make_name(Addr, Port, Profile), + Req = {list_blocked_users, addr(Addr), Port, Profile,'_'}, + call(Name, Req); list_blocked_users(Addr, Port, Dir) -> - Name = make_name(Addr, Port), - Req = {list_blocked_users, addr(Addr), Port, Dir}, + list_blocked_users(Addr, Port, ?DEFAULT_PROFILE, Dir). +list_blocked_users(Addr, Port, Profile, Dir) -> + Name = make_name(Addr, Port, Profile), + Req = {list_blocked_users, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% block_user - block_user(User, Addr, Port, Dir, Time) -> - Name = make_name(Addr, Port), - Req = {block_user, User, addr(Addr), Port, Dir, Time}, + block_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir, Time). +block_user(User, Addr, Port, Profile, Dir, Time) -> + Name = make_name(Addr, Port, Profile), + Req = {block_user, User, addr(Addr), Port, Profile, Dir, Time}, call(Name, Req). - -%% unblock_user - unblock_user(User, Addr, Port) -> - Name = make_name(Addr, Port), - Req = {unblock_user, User, addr(Addr), Port, '_'}, - call(Name, Req). - + unblock_user(User, Addr, Port, ?DEFAULT_PROFILE). +unblock_user(User, Addr, Port, Profile) when is_atom(Profile)-> + Name = make_name(Addr, Port, Profile), + Req = {unblock_user, User, addr(Addr), Port, Profile, '_'}, + call(Name, Req); unblock_user(User, Addr, Port, Dir) -> - Name = make_name(Addr, Port), - Req = {unblock_user, User, addr(Addr), Port, Dir}, + unblock_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir). +unblock_user(User, Addr, Port, Profile, Dir) -> + Name = make_name(Addr, Port, Profile), + Req = {unblock_user, User, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% list_auth_users - list_auth_users(Addr, Port) -> - Name = make_name(Addr, Port), - Req = {list_auth_users, addr(Addr), Port, '_'}, - call(Name, Req). - + list_auth_users(Addr, Port, ?DEFAULT_PROFILE). +list_auth_users(Addr, Port, Profile) when is_atom(Profile) -> + Name = make_name(Addr, Port, Profile), + Req = {list_auth_users, addr(Addr), Port, Profile, '_'}, + call(Name, Req); list_auth_users(Addr, Port, Dir) -> - Name = make_name(Addr,Port), - Req = {list_auth_users, addr(Addr), Port, Dir}, + list_auth_users(Addr, Port, ?DEFAULT_PROFILE, Dir). +list_auth_users(Addr, Port, Profile, Dir) -> + Name = make_name(Addr,Port, Profile), + Req = {list_auth_users, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% new_table - -new_table(Addr, Port, TabName) -> - Name = make_name(Addr,Port), - Req = {new_table, addr(Addr), Port, TabName}, +new_table(Addr, Port, Profile, TabName) -> + Name = make_name(Addr,Port, Profile), + Req = {new_table, addr(Addr), Port, Profile, TabName}, call(Name, Req). - -%% delete_tables - -delete_tables(Addr, Port) -> - Name = make_name(Addr, Port), +delete_tables(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> ok; @@ -187,79 +162,53 @@ delete_tables(Addr, Port) -> call(Name, delete_tables) end. - -%% store_failed_auth - -store_failed_auth(Info, Addr, Port, DecodedString, SDirData) -> - ?hdrv("store failed auth", - [{addr, Addr}, {port, Port}, - {decoded_string, DecodedString}, {sdir_data, SDirData}]), - Name = make_name(Addr,Port), - Msg = {store_failed_auth,[Info,DecodedString,SDirData]}, +store_failed_auth(Info, Addr, Port, Profile, DecodedString, SDirData) -> + Name = make_name(Addr, Port, Profile), + Msg = {store_failed_auth, Profile, [Info,DecodedString,SDirData]}, cast(Name, Msg). - -%% store_successful_auth - -store_successful_auth(Addr, Port, User, SDirData) -> - Name = make_name(Addr,Port), - Msg = {store_successful_auth, [User,Addr,Port,SDirData]}, +store_successful_auth(Addr, Port, Profile, User, SDirData) -> + Name = make_name(Addr,Port, Profile), + Msg = {store_successful_auth, [User,Addr,Port, Profile, SDirData]}, cast(Name, Msg). - - -%% check_blocked_user - -check_blocked_user(Info, User, SDirData, Addr, Port) -> - Name = make_name(Addr, Port), - Req = {check_blocked_user, [Info, User, SDirData]}, + +check_blocked_user(Info, User, SDirData, Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), + Req = {check_blocked_user, Profile, [Info, User, SDirData]}, call(Name, Req). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Server call-back functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - +%%==================================================================== +%% Behavior call backs +%%==================================================================== init(_) -> - ?hdrv("initiating", []), process_flag(trap_exit, true), {ok, []}. handle_call(stop, _From, _Tables) -> {stop, normal, ok, []}; -handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) -> - ?hdrv("block user", - [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}, - {time, Time}]), - Ret = block_user_int(User, Addr, Port, Dir, Time), +handle_call({block_user, User, Addr, Port, Profile, Dir, Time}, _From, Tables) -> + Ret = block_user_int(User, Addr, Port, Profile, Dir, Time), {reply, Ret, Tables}; -handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("list blocked users", - [{addr, Addr}, {port, Port}, {dir, Dir}]), - Blocked = list_blocked(Tables, Addr, Port, Dir, []), +handle_call({list_blocked_users, Addr, Port, Profile, Dir}, _From, Tables) -> + Blocked = list_blocked(Tables, Addr, Port, Profile, Dir, []), {reply, Blocked, Tables}; -handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("block user", - [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}]), - Ret = unblock_user_int(User, Addr, Port, Dir), +handle_call({unblock_user, User, Addr, Port, Profile, Dir}, _From, Tables) -> + Ret = unblock_user_int(User, Addr, Port, Profile,Dir), {reply, Ret, Tables}; -handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("list auth users", - [{addr, Addr}, {port, Port}, {dir, Dir}]), - Auth = list_auth(Tables, Addr, Port, Dir, []), +handle_call({list_auth_users, Addr, Port, Profile, Dir}, _From, Tables) -> + Auth = list_auth(Tables, Addr, Port, Profile, Dir, []), {reply, Auth, Tables}; -handle_call({new_table, Addr, Port, Name}, _From, Tables) -> +handle_call({new_table, Addr, Port, Profile, Name}, _From, Tables) -> case lists:keysearch(Name, 1, Tables) of {value, {Name, {Ets, Dets}}} -> {reply, {ok, {Ets, Dets}}, Tables}; false -> - TName = make_name(Addr,Port,length(Tables)), + TName = make_name(Addr,Port, Profile, length(Tables)), case dets:open_file(TName, [{type, bag}, {file, Name}, {repair, true}, {access, read_write}]) of @@ -280,7 +229,7 @@ handle_call(delete_tables, _From, Tables) -> end, Tables), {reply, ok, []}; -handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) -> +handle_call({check_blocked_user, Profile, [Info, User, SDirData]}, _From, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), Dir = proplists:get_value(path, SDirData), Addr = proplists:get_value(bind_address, SDirData), @@ -288,27 +237,24 @@ handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) -> CBModule = proplists:get_value(callback_module, SDirData, no_module_at_all), Ret = - check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule), + check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule), {reply, Ret, Tables}; handle_call(_Request,_From,Tables) -> {reply,ok,Tables}. - -%% handle_cast - -handle_cast({store_failed_auth, [_, _, []]}, Tables) -> +handle_cast({store_failed_auth, _,[_, _, []]}, Tables) -> %% Some other authentication scheme than mod_auth (example mod_htacess) %% was the source for the authentication failure so we should ignor it! {noreply, Tables}; -handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> +handle_cast({store_failed_auth, Profile, [Info, DecodedString, SDirData]}, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), Dir = proplists:get_value(path, SDirData), Addr = proplists:get_value(bind_address, SDirData), Port = proplists:get_value(port, SDirData), {ok, [User,Password]} = httpd_util:split(DecodedString,":",2), Seconds = universal_time(), - Key = {User, Dir, Addr, Port}, + Key = {User, Dir, Addr, Port, Profile}, %% Event CBModule = proplists:get_value(callback_module, SDirData, no_module_at_all), @@ -363,7 +309,7 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '$1'}}), BlockRecord = {blocked_user, - {User, Addr, Port, Dir, Future}}, + {User, Addr, Port, Profile, Dir, Future}}, ets:insert(ETS, BlockRecord), dets:insert(DETS, BlockRecord), %% Remove previous failed requests. @@ -374,11 +320,11 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> end, {noreply, Tables}; -handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) -> +handle_cast({store_successful_auth, [User, Addr, Port, Profile, SDirData]}, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), AuthTimeOut = proplists:get_value(auth_timeout, SDirData, 30), Dir = proplists:get_value(path, SDirData), - Key = {User, Dir, Addr, Port}, + Key = {User, Dir, Addr, Port, Profile}, %% Remove failed entries for this Key dets:match_delete(DETS, {failed, {Key, '_', '_'}}), @@ -396,33 +342,22 @@ handle_cast(Req, Tables) -> error_msg("security server got unknown cast: ~p",[Req]), {noreply, Tables}. - -%% handle_info - handle_info(_Info, State) -> {noreply, State}. - -%% terminate - terminate(_Reason, _Tables) -> ok. - -%% code_change({down, ToVsn}, State, Extra) -%% -code_change({down, _}, State, _Extra) -> - {ok, State}; - - -%% code_change(FromVsn, State, Extra) -%% code_change(_, State, _Extra) -> {ok, State}. +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + %% block_user_int/5 -block_user_int(User, Addr, Port, Dir, Time) -> - Dirs = httpd_manager:config_match(Addr, Port, +block_user_int(User, Addr, Port, Profile, Dir, Time) -> + Dirs = httpd_manager:config_match(Addr, Port, Profile, {security_directory, {'_', '_'}}), case find_dirdata(Dirs, Dir) of {ok, DirData, {ETS, DETS}} -> @@ -434,11 +369,11 @@ block_user_int(User, Addr, Port, Dir, Time) -> Time end, Future = universal_time()+Time1, - ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}), + ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Profile, Dir,'_'}}), dets:match_delete(DETS, {blocked_user, - {User,Addr,Port,Dir,'_'}}), - ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}), - dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}), + {User,Addr,Port,Profile, Dir,'_'}}), + ets:insert(ETS, {blocked_user, {User,Addr,Port, Profile, Dir,Future}}), + dets:insert(DETS, {blocked_user, {User,Addr,Port,Profile, Dir,Future}}), CBModule = proplists:get_value(callback_module, DirData, no_module_at_all), user_block_event(CBModule,Addr,Port,Dir,User), @@ -447,7 +382,6 @@ block_user_int(User, Addr, Port, Dir, Time) -> {error, no_such_directory} end. - find_dirdata([], _Dir) -> false; find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) -> @@ -460,21 +394,20 @@ find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) -> find_dirdata(SDirs, Dir) end. -%% unblock_user_int/4 -unblock_user_int(User, Addr, Port, Dir) -> - Dirs = httpd_manager:config_match(Addr, Port, +unblock_user_int(User, Addr, Port, Profile, Dir) -> + Dirs = httpd_manager:config_match(Addr, Port, Profile, {security_directory, {'_', '_'}}), case find_dirdata(Dirs, Dir) of {ok, DirData, {ETS, DETS}} -> case ets:match_object(ETS, - {blocked_user,{User,Addr,Port,Dir,'_'}}) of + {blocked_user,{User,Addr,Port,Profile,Dir,'_'}}) of [] -> {error, not_blocked}; _Objects -> ets:match_delete(ETS, {blocked_user, - {User, Addr, Port, Dir, '_'}}), + {User, Addr, Port, Profile, Dir, '_'}}), dets:match_delete(DETS, {blocked_user, - {User, Addr, Port, Dir, '_'}}), + {User, Addr, Port, Profile, Dir, '_'}}), CBModule = proplists:get_value(callback_module, DirData, no_module_at_all), @@ -485,63 +418,51 @@ unblock_user_int(User, Addr, Port, Dir) -> {error, no_such_directory} end. - - -%% list_auth/2 - -list_auth([], _Addr, _Port, _Dir, Acc) -> +list_auth([], _, _, _, _, Acc) -> Acc; -list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) -> - case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of +list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Profile, Dir, Acc) -> + case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port, Profile}, '_'}}) of [] -> - list_auth(Tables, Addr, Port, Dir, Acc); + list_auth(Tables, Addr, Port, Profile, Dir, Acc); List -> TN = universal_time(), - NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) -> + NewAcc = lists:foldr(fun({success,{{U,Ad,P, Pr,D},T}},Ac) -> if T-TN > 0 -> [U|Ac]; true -> Rec = {success, - {{U,Ad,P,D},T}}, + {{U,Ad,P,Pr,D},T}}, ets:match_delete(ETS,Rec), dets:match_delete(DETS,Rec), Ac end end, Acc, List), - list_auth(Tables, Addr, Port, Dir, NewAcc) + list_auth(Tables, Addr, Port, Profile, Dir, NewAcc) end. - -%% list_blocked/2 - -list_blocked([], _Addr, _Port, _Dir, Acc) -> - ?hdrv("list blocked", [{acc, Acc}]), +list_blocked([], _, _, _, _, Acc) -> TN = universal_time(), - lists:foldl(fun({U,Ad,P,D,T}, Ac) -> + lists:foldl(fun({U,Ad,P,Pr,D,T}, Ac) -> if T-TN > 0 -> - [{U,Ad,P,D,local_time(T)}|Ac]; + [{U,Ad,P, Pr,D,local_time(T)}|Ac]; true -> Ac end end, [], Acc); -list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Dir, Acc) -> - ?hdrv("list blocked", [{ets, ETS}, {tab2list, ets:tab2list(ETS)}]), +list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Profile, Dir, Acc) -> List = ets:match_object(ETS, {blocked_user, - {'_',Addr,Port,Dir,'_'}}), + {'_',Addr,Port,Profile, Dir,'_'}}), NewBlocked = lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, Acc, List), - list_blocked(Tables, Addr, Port, Dir, NewBlocked). + list_blocked(Tables, Addr, Port, Profile, Dir, NewBlocked). -%% -%% sync_dets_to_ets/2 -%% %% Reads dets-table DETS and syncronizes it with the ets-table ETS. %% sync_dets_to_ets(DETS, ETS) -> @@ -550,68 +471,62 @@ sync_dets_to_ets(DETS, ETS) -> continue end). -%% -%% check_blocked_user/7 -> true | false -%% %% Check if a specific user is blocked from access. %% %% The sideeffect of this routine is that it unblocks also other users %% whos blocking time has expired. This to keep the tables as small %% as possible. %% -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) -> TN = universal_time(), - BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}), + BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_', '_'}}), Blocked = lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, [], BlockList), check_blocked_user(Info,User,Dir, - Addr,Port,ETS,DETS,TN,Blocked,CBModule). + Addr,Port, Profile, ETS,DETS,TN,Blocked,CBModule). -check_blocked_user(_Info, _User, _Dir, _Addr, _Port, _ETS, _DETS, _TN, - [], _CBModule) -> +check_blocked_user(_Info, _, _, _, _, _, _, _, _,[], _CBModule) -> false; -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, - [{User,Addr,Port,Dir,T}| _], CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, + [{User,Addr,Port,Profile, Dir,T}| _], CBModule) -> TD = T-TN, if TD =< 0 -> %% Blocking has expired, remove and grant access. - unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule), + unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule), false; true -> true end; -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, - [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, + [{OUser,ODir,OAddr,OPort, OProfile, T}|Ls], CBModule) -> TD = T-TN, if TD =< 0 -> %% Blocking has expired, remove. - unblock_user(Info, OUser, ODir, OAddr, OPort, + unblock_user(Info, OUser, ODir, OAddr, OPort, OProfile, ETS, DETS, CBModule); true -> true end, - check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, + check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, Ls, CBModule). -unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) -> +unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) -> Reason = io_lib:format("User ~s was removed from the block list for dir ~s", [User, Dir]), mod_log:security_log(Info, lists:flatten(Reason)), user_unblock_event(CBModule,Addr,Port,Dir,User), - dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}), - ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}). + dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}), + ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}). +make_name(Addr,Port, Profile) -> + httpd_util:make_name(?MODULE,Addr,Port, Profile). -make_name(Addr,Port) -> - httpd_util:make_name("httpd_security",Addr,Port). - -make_name(Addr,Port,Num) -> - httpd_util:make_name("httpd_security",Addr,Port, - "__" ++ integer_to_list(Num)). - +make_name(Addr,Port, Profile, Num) -> + httpd_util:make_name(?MODULE,Addr,Port, + atom_to_list(Profile) ++ "__" ++ integer_to_list(Num)). auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) -> event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]). @@ -623,17 +538,10 @@ user_unblock_event(Mod,Addr,Port,Dir,User) -> event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]). event(Event, Mod, undefined, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Port,Dir,Info)); event(Event, Mod, any, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Port,Dir,Info)); event(Event, Mod, Addr, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, - {addr, Addr}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Addr,Port,Dir,Info)). universal_time() -> @@ -643,11 +551,9 @@ local_time(T) -> calendar:universal_time_to_local_time( calendar:gregorian_seconds_to_datetime(T)). - error_msg(F, A) -> error_logger:error_msg(F, A). - call(Name, Req) -> case (catch gen_server:call(Name, Req)) of {'EXIT', Reason} -> @@ -656,7 +562,6 @@ call(Name, Req) -> Reply end. - cast(Name, Msg) -> case (catch gen_server:cast(Name, Msg)) of {'EXIT', Reason} -> diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl index ddd23d0c65..fbd85e9e42 100644 --- a/lib/inets/test/httpc_proxy_SUITE.erl +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -79,7 +79,7 @@ local_proxy_cases() -> %%-------------------------------------------------------------------- init_per_suite(Config0) -> - case init_apps([crypto,public_key], Config0) of + case init_apps(suite_apps(), Config0) of Config when is_list(Config) -> make_cert_files(dsa, "server-", Config), Config; @@ -94,7 +94,7 @@ end_per_suite(_Config) -> %% internal functions suite_apps() -> - [crypto,public_key]. + [asn1,crypto,public_key]. %%-------------------------------------------------------------------- diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index bc6b0d5c79..c90887bcf3 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1368,9 +1368,9 @@ start_apps(Group) when Group == http_basic; Group == http_auth_api; Group == http_auth_api_dets; Group == http_auth_api_mnesia; - Group == https_htaccess; - Group == https_security; - Group == https_reload; + Group == http_htaccess; + Group == http_security; + Group == http_reload; Group == http_mime_types-> inets_test_lib:start_apps([inets]). diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl index 9790623b6f..a95a5ee62d 100644 --- a/lib/inets/test/httpd_block.erl +++ b/lib/inets/test/httpd_block.erl @@ -292,7 +292,7 @@ httpd_restart(Addr, Port) -> end. make_name(Addr, Port) -> - httpd_util:make_name("httpd", Addr, Port). + httpd_util:make_name("httpd", Addr, Port, default). get_admin_state(_, _Host, Port) -> Name = make_name(undefined, Port), diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index 60979278fc..1479681e30 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -22,14 +22,14 @@ -include_lib("common_test/include/ct.hrl"). - %% Note: This directive should only be used in test suites. -compile(export_all). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [default_tree, ftpc_worker, tftpd_worker, httpd_subtree, + [default_tree, ftpc_worker, tftpd_worker, + httpd_subtree, httpd_subtree_profile, httpc_subtree]. groups() -> @@ -41,54 +41,29 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(_) -> inets:stop(), ok. -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_testcase(httpd_subtree, Config) -> Dog = test_server:timetrap(?t:minutes(1)), NewConfig = lists:keydelete(watchdog, 1, Config), PrivDir = ?config(priv_dir, Config), - + Dir = filename:join(PrivDir, "root"), + ok = file:make_dir(Dir), + SimpleConfig = [{port, 0}, {server_name,"www.test"}, {modules, [mod_get]}, - {server_root, PrivDir}, - {document_root, PrivDir}, + {server_root, Dir}, + {document_root, Dir}, {bind_address, any}, {ipfamily, inet}], try + inets:stop(), inets:start(), inets:start(httpd, SimpleConfig), [{watchdog, Dog} | NewConfig] @@ -97,7 +72,33 @@ init_per_testcase(httpd_subtree, Config) -> inets:stop(), exit({failed_starting_inets, Reason}) end; - + +init_per_testcase(httpd_subtree_profile, Config) -> + Dog = test_server:timetrap(?t:minutes(1)), + NewConfig = lists:keydelete(watchdog, 1, Config), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "root"), + ok = file:make_dir(Dir), + + SimpleConfig = [{port, 0}, + {server_name,"www.test"}, + {modules, [mod_get]}, + {server_root, Dir}, + {document_root, Dir}, + {bind_address, any}, + {profile, test_profile}, + {ipfamily, inet}], + try + inets:stop(), + inets:start(), + {ok, _} = inets:start(httpd, SimpleConfig), + [{watchdog, Dog} | NewConfig] + catch + _:Reason -> + inets:stop(), + exit({failed_starting_inets, Reason}) + end; + init_per_testcase(_Case, Config) -> Dog = test_server:timetrap(?t:minutes(5)), @@ -106,20 +107,13 @@ init_per_testcase(_Case, Config) -> ok = inets:start(), [{watchdog, Dog} | NewConfig]. - -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- -end_per_testcase(httpd_subtree, Config) -> +end_per_testcase(Case, Config) when Case == httpd_subtree; + Case == httpd_subtree_profile -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), - PrivDir = ?config(priv_dir, Config), - inets_test_lib:del_dirs(PrivDir), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "root"), + inets_test_lib:del_dirs(Dir), ok; end_per_testcase(_, Config) -> @@ -131,16 +125,9 @@ end_per_testcase(_, Config) -> %%------------------------------------------------------------------------- %% Test cases starts here. %%------------------------------------------------------------------------- - - -%%------------------------------------------------------------------------- -%% default_tree -%%------------------------------------------------------------------------- -default_tree(doc) -> - ["Makes sure the correct processes are started and linked," - "in the default case."]; -default_tree(suite) -> - []; +default_tree() -> + [{doc, "Makes sure the correct processes are started and linked," + "in the default case."}]. default_tree(Config) when is_list(Config) -> TopSupChildren = supervisor:which_children(inets_sup), 4 = length(TopSupChildren), @@ -173,15 +160,9 @@ default_tree(Config) when is_list(Config) -> ok. - -%%------------------------------------------------------------------------- -%% ftpc_worker -%%------------------------------------------------------------------------- -ftpc_worker(doc) -> - ["Makes sure the ftp worker processes are added and removed " - "appropriatly to/from the supervison tree."]; -ftpc_worker(suite) -> - []; +ftpc_worker() -> + [{doc, "Makes sure the ftp worker processes are added and removed " + "appropriatly to/from the supervison tree."}]. ftpc_worker(Config) when is_list(Config) -> [] = supervisor:which_children(ftp_sup), try @@ -207,14 +188,8 @@ ftpc_worker(Config) when is_list(Config) -> {skip, "No available FTP servers"} end. - -%%------------------------------------------------------------------------- -%% tftpd_worker -%%------------------------------------------------------------------------- -tftpd_worker(doc) -> - ["Makes sure the tftp sub tree is correct."]; -tftpd_worker(suite) -> - []; +tftpd_worker() -> + [{doc, "Makes sure the tftp sub tree is correct."}]. tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), {ok, Pid0} = inets:start(tftpd, [{host, inets_test_lib:hostname()}, @@ -228,22 +203,63 @@ tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), ok. +httpd_subtree() -> + [{doc, "Makes sure the httpd sub tree is correct."}]. +httpd_subtree(Config) when is_list(Config) -> + do_httpd_subtree(Config, default). + +httpd_subtree_profile(doc) -> + ["Makes sure the httpd sub tree is correct when using a profile"]; +httpd_subtree_profile(Config) when is_list(Config) -> + do_httpd_subtree(Config, test_profile). + +httpc_subtree() -> + [{doc, "Makes sure the httpd sub tree is correct."}]. +httpc_subtree(Config) when is_list(Config) -> + {ok, Foo} = inets:start(httpc, [{profile, foo}]), + + {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), + + HttpcChildren = supervisor:which_children(httpc_profile_sup), + + {value, {httpc_manager, _, worker, [httpc_manager]}} = + lists:keysearch(httpc_manager, 1, HttpcChildren), + + {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = + lists:keysearch({httpc, foo}, 1, HttpcChildren), + false = lists:keysearch({httpc, bar}, 1, HttpcChildren), + + inets:stop(httpc, Foo), + exit(Bar, normal). %%------------------------------------------------------------------------- -%% httpd_subtree +%% Internal functions %%------------------------------------------------------------------------- -httpd_subtree(doc) -> - ["Makes sure the httpd sub tree is correct."]; -httpd_subtree(suite) -> - []; -httpd_subtree(Config) when is_list(Config) -> - %% Check that we have the httpd top supervisor + +verify_child(Parent, Child, Type) -> + Children = supervisor:which_children(Parent), + verify_child(Children, Parent, Child, Type). + +verify_child([], Parent, Child, _Type) -> + {error, {child_not_found, Child, Parent}}; +verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> + case lists:member(Child, Mods) of + true when (Type2 =:= Type) -> + {ok, Id}; + true when (Type2 =/= Type) -> + {error, {wrong_type, Type2, Child, Parent}}; + false -> + verify_child(Children, Parent, Child, Type) + end. + +do_httpd_subtree(_Config, Profile) -> + %% Check that we have the httpd top supervisor {ok, _} = verify_child(inets_sup, httpd_sup, supervisor), %% Check that we have the httpd instance supervisor {ok, Id} = verify_child(httpd_sup, httpd_instance_sup, supervisor), - {httpd_instance_sup, Addr, Port} = Id, - Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port), + {httpd_instance_sup, Addr, Port, Profile} = Id, + Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port, Profile), %% Check that we have the expected httpd instance children {ok, _} = verify_child(Instance, httpd_connection_sup, supervisor), @@ -252,7 +268,7 @@ httpd_subtree(Config) when is_list(Config) -> {ok, _} = verify_child(Instance, httpd_manager, worker), %% Check that the httpd instance acc supervisor has children - InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port), + InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile), case supervisor:which_children(InstanceAcc) of [_ | _] -> ok; @@ -263,7 +279,7 @@ httpd_subtree(Config) when is_list(Config) -> %% Check that the httpd instance misc supervisor has no children io:format("httpd_subtree -> verify misc~n", []), - InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port), + InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port, Profile), case supervisor:which_children(InstanceMisc) of [] -> ok; @@ -273,45 +289,3 @@ httpd_subtree(Config) when is_list(Config) -> end, io:format("httpd_subtree -> done~n", []), ok. - - -verify_child(Parent, Child, Type) -> - Children = supervisor:which_children(Parent), - verify_child(Children, Parent, Child, Type). - -verify_child([], Parent, Child, _Type) -> - {error, {child_not_found, Child, Parent}}; -verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> - case lists:member(Child, Mods) of - true when (Type2 =:= Type) -> - {ok, Id}; - true when (Type2 =/= Type) -> - {error, {wrong_type, Type2, Child, Parent}}; - false -> - verify_child(Children, Parent, Child, Type) - end. - -%%------------------------------------------------------------------------- -%% httpc_subtree -%%------------------------------------------------------------------------- -httpc_subtree(doc) -> - ["Makes sure the httpc sub tree is correct."]; -httpc_subtree(suite) -> - []; -httpc_subtree(Config) when is_list(Config) -> - {ok, Foo} = inets:start(httpc, [{profile, foo}]), - - {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), - - HttpcChildren = supervisor:which_children(httpc_profile_sup), - - {value, {httpc_manager, _, worker, [httpc_manager]}} = - lists:keysearch(httpc_manager, 1, HttpcChildren), - - {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = - lists:keysearch({httpc, foo}, 1, HttpcChildren), - false = lists:keysearch({httpc, bar}, 1, HttpcChildren), - - inets:stop(httpc, Foo), - exit(Bar, normal). - diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 820ecd1e30..71ef5cd48f 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -347,11 +347,22 @@ do_recv(Sock, Bs) -> </func> <func> <name name="shutdown" arity="2"/> - <fsummary>Immediately close a socket</fsummary> + <fsummary>Asynchronously close a socket</fsummary> <desc> - <p>Immediately close a socket in one or two directions.</p> + <p>Close a socket in one or two directions.</p> <p><c><anno>How</anno> == write</c> means closing the socket for writing, reading from it is still possible.</p> + <p>If <c><anno>How</anno> == read</c>, or there is no outgoing + data buffered in the <c><anno>Socket</anno></c> port, + then the socket is shutdown immediately and any error encountered + is returned in <c><anno>Reason</anno></c>.</p> + <p>If there is data buffered in the socket port, then the attempt + to shutdown the socket is postponed until that data is written to the + kernel socket send buffer. Any errors encountered will result + in the socket being closed and <c>{error, closed}</c> being returned + on the next + <seealso marker="gen_tcp#recv/2">recv/2</seealso> or + <seealso marker="gen_tcp#send/2">send/2</seealso>.</p> <p>To be able to handle that the peer has done a shutdown on the write side, the <c>{exit_on_close, false}</c> option is useful.</p> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 65045666ec..580c070389 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -339,7 +339,8 @@ do_start(Flags) -> ok end, %% Quietly load native code for all modules loaded so far - load_native_code_for_all_loaded(), + Architecture = erlang:system_info(hipe_architecture), + load_native_code_for_all_loaded(Architecture), Ok2; Other -> Other @@ -554,9 +555,9 @@ has_ext(Ext, Extlen, File) -> %%% Silently load native code for all modules loaded so far. %%% --spec load_native_code_for_all_loaded() -> ok. -load_native_code_for_all_loaded() -> - Architecture = erlang:system_info(hipe_architecture), +load_native_code_for_all_loaded(undefined) -> + ok; +load_native_code_for_all_loaded(Architecture) -> try hipe_unified_loader:chunk_name(Architecture) of ChunkTag -> Loaded = all_loaded(), diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 819554ce74..eecd26863a 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -324,12 +324,15 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) -> do_load_binary(Mod, File, Bin, Caller, S); handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load(Mod, Bin)), + Architecture = erlang:system_info(hipe_architecture), + Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)), Status = hipe_result_to_status(Result), {reply,Status,S}; handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule)), + Architecture = erlang:system_info(hipe_architecture), + Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule, + Architecture)), Status = hipe_result_to_status(Result), {reply,Status,S}; @@ -1256,33 +1259,43 @@ try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) -> case is_sticky(Mod, Db) of true -> %% Sticky file reject the load - error_msg("Can't load module that resides in sticky dir\n",[]), + error_msg("Can't load module '~w' that resides in sticky dir\n",[Mod]), {reply,{error,sticky_directory},St}; false -> - case catch load_native_code(Mod, Bin) of - {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), - {reply,Module,St}; - no_native -> - case erlang:load_module(Mod, Bin) of - {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), - post_beam_load(Mod), - {reply,Module,St}; - {error,on_load} -> - handle_on_load(Mod, File, Caller, St); - {error,What} = Error -> - error_msg("Loading of ~ts failed: ~p\n", [File, What]), - {reply,Error,St} - end; - Error -> - error_msg("Native loading of ~ts failed: ~p\n", - [File,Error]), - {reply,ok,St} - end + Architecture = erlang:system_info(hipe_architecture), + try_load_module_2(File, Mod, Bin, Caller, Architecture, St) + end. + +try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> + try_load_module_3(File, Mod, Bin, Caller, undefined, St); +try_load_module_2(File, Mod, Bin, Caller, Architecture, + #state{moddb=Db}=St) -> + case catch load_native_code(Mod, Bin, Architecture) of + {module,Mod} = Module -> + ets:insert(Db, {Mod,File}), + {reply,Module,St}; + no_native -> + try_load_module_3(File, Mod, Bin, Caller, Architecture, St); + Error -> + error_msg("Native loading of ~ts failed: ~p\n", [File,Error]), + {reply,ok,St} + end. + +try_load_module_3(File, Mod, Bin, Caller, Architecture, + #state{moddb=Db}=St) -> + case erlang:load_module(Mod, Bin) of + {module,Mod} = Module -> + ets:insert(Db, {Mod,File}), + post_beam_load(Mod, Architecture), + {reply,Module,St}; + {error,on_load} -> + handle_on_load(Mod, File, Caller, St); + {error,What} = Error -> + error_msg("Loading of ~ts failed: ~p\n", [File, What]), + {reply,Error,St} end. -load_native_code(Mod, Bin) -> +load_native_code(Mod, Bin, Architecture) -> %% During bootstrapping of Open Source Erlang, we don't have any hipe %% loader modules, but the Erlang emulator might be hipe enabled. %% Therefore we must test for that the loader modules are available @@ -1291,7 +1304,8 @@ load_native_code(Mod, Bin) -> false -> no_native; true -> - Result = hipe_unified_loader:load_native_code(Mod, Bin), + Result = hipe_unified_loader:load_native_code(Mod, Bin, + Architecture), case Result of {module,_} -> put(?ANY_NATIVE_CODE_LOADED, true); @@ -1310,12 +1324,12 @@ hipe_result_to_status(Result) -> {error,Result} end. -post_beam_load(Mod) -> - %% post_beam_load/1 can potentially be very expensive because it +post_beam_load(Mod, Architecture) -> + %% post_beam_load/2 can potentially be very expensive because it %% blocks multi-scheduling; thus we want to avoid the call if we %% know that it is not needed. case get(?ANY_NATIVE_CODE_LOADED) of - true -> hipe_unified_loader:post_beam_load(Mod); + true -> hipe_unified_loader:post_beam_load(Mod, Architecture); false -> ok end. diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index 49d4a8fe54..ddbbc548dd 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -43,10 +43,10 @@ -export([chunk_name/1, %% Only the code and code_server modules may call the entries below! - load_native_code/2, - post_beam_load/1, - load_module/3, - load/2]). + load_native_code/3, + post_beam_load/2, + load_module/4, + load/3]). %%-define(DEBUG,true). -define(DO_ASSERT,true). @@ -82,58 +82,57 @@ chunk_name(Architecture) -> %% HW32 %% HiPE, x86, Win32 end. +word_size(Architecture) -> + case Architecture of + amd64 -> 8; + ppc64 -> 8; + _ -> 4 + end. + %%======================================================================== --spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod} - when Mod :: atom(). +-spec load_native_code(Mod, binary(), hipe_architecture()) -> + 'no_native' | {'module', Mod} when Mod :: atom(). %% @doc %% Loads the native code of a module Mod. %% Returns {module,Mod} on success (for compatibility with %% code:load_file/1) and the atom `no_native' on failure. -load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) -> - Architecture = erlang:system_info(hipe_architecture), - try chunk_name(Architecture) of - ChunkTag -> - %% patch_to_emu(Mod), - case code:get_chunk(Bin, ChunkTag) of - undefined -> no_native; - NativeCode when is_binary(NativeCode) -> - erlang:system_flag(multi_scheduling, block), - try - OldReferencesToPatch = patch_to_emu_step1(Mod), - case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of - bad_crc -> no_native; - Result -> Result - end - after - erlang:system_flag(multi_scheduling, unblock) - end +load_native_code(_Mod, _Bin, undefined) -> + no_native; +load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) -> + %% patch_to_emu(Mod), + case code:get_chunk(Bin, chunk_name(Architecture)) of + undefined -> no_native; + NativeCode when is_binary(NativeCode) -> + erlang:system_flag(multi_scheduling, block), + try + OldReferencesToPatch = patch_to_emu_step1(Mod), + case load_module(Mod, NativeCode, Bin, OldReferencesToPatch, + Architecture) of + bad_crc -> no_native; + Result -> Result + end + after + erlang:system_flag(multi_scheduling, unblock) end - catch - _:_ -> - %% Unknown HiPE architecture. Can't happen (in principle). - no_native end. %%======================================================================== --spec post_beam_load(atom()) -> 'ok'. +-spec post_beam_load(atom(), hipe_architecture()) -> 'ok'. -post_beam_load(Mod) when is_atom(Mod) -> - Architecture = erlang:system_info(hipe_architecture), - try chunk_name(Architecture) of - _ChunkTag -> - erlang:system_flag(multi_scheduling, block), - try - patch_to_emu(Mod) - after - erlang:system_flag(multi_scheduling, unblock) - end - catch - _:_ -> - ok - end. +%% does nothing on a hipe-disabled system +post_beam_load(_Mod, undefined) -> + ok; +post_beam_load(Mod, _) when is_atom(Mod) -> + erlang:system_flag(multi_scheduling, block), + try + patch_to_emu(Mod) + after + erlang:system_flag(multi_scheduling, unblock) + end, + ok. %%======================================================================== @@ -148,46 +147,48 @@ version_check(Version, Mod) when is_atom(Mod) -> %%======================================================================== --spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module', Mod} - when Mod :: atom(). -load_module(Mod, Bin, Beam) -> +-spec load_module(Mod, binary(), _, hipe_architecture()) -> + 'bad_crc' | {'module', Mod} when Mod :: atom(). + +load_module(Mod, Bin, Beam, Architecture) -> erlang:system_flag(multi_scheduling, block), try - load_module_nosmp(Mod, Bin, Beam) + load_module_nosmp(Mod, Bin, Beam, Architecture) after erlang:system_flag(multi_scheduling, unblock) end. -load_module_nosmp(Mod, Bin, Beam) -> - load_module(Mod, Bin, Beam, []). +load_module_nosmp(Mod, Bin, Beam, Architecture) -> + load_module(Mod, Bin, Beam, [], Architecture). -load_module(Mod, Bin, Beam, OldReferencesToPatch) -> +load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> ?debug_msg("************ Loading Module ~w ************\n",[Mod]), %% Loading a whole module, let the BEAM loader patch closures. put(hipe_patch_closures, false), - load_common(Mod, Bin, Beam, OldReferencesToPatch). + load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture). %%======================================================================== --spec load(Mod, binary()) -> 'bad_crc' | {'module', Mod} when Mod :: atom(). +-spec load(Mod, binary(), hipe_architecture()) -> + 'bad_crc' | {'module', Mod} when Mod :: atom(). -load(Mod, Bin) -> +load(Mod, Bin, Architecture) -> erlang:system_flag(multi_scheduling, block), try - load_nosmp(Mod, Bin) + load_nosmp(Mod, Bin, Architecture) after erlang:system_flag(multi_scheduling, unblock) end. -load_nosmp(Mod, Bin) -> +load_nosmp(Mod, Bin, Architecture) -> ?debug_msg("********* Loading funs in module ~w *********\n",[Mod]), %% Loading just some functions in a module; patch closures separately. put(hipe_patch_closures, true), - load_common(Mod, Bin, [], []). + load_common(Mod, Bin, [], [], Architecture). %%------------------------------------------------------------------------ -load_common(Mod, Bin, Beam, OldReferencesToPatch) -> +load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> %% Unpack the binary. [{Version, CheckSum}, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, @@ -212,18 +213,21 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> bad_crc; true -> put(closures_to_patch, []), + WordSize = word_size(Architecture), + WriteWord = write_word_fun(WordSize), %% Create data segment {ConstAddr,ConstMap2} = - create_data_segment(ConstAlign, ConstSize, ConstMap), + create_data_segment(ConstAlign, ConstSize, ConstMap, WriteWord), %% Find callees for which we may need trampolines. - CalleeMFAs = find_callee_mfas(Refs), + CalleeMFAs = find_callee_mfas(Refs, Architecture), %% Write the code to memory. {CodeAddress,Trampolines} = enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam), %% Construct CalleeMFA-to-trampoline mapping. - TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines), + TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines, + Architecture), %% Patch references to code labels in data seg. - ok = patch_consts(LabelMap, ConstAddr, CodeAddress), + ok = patch_consts(LabelMap, ConstAddr, CodeAddress, WriteWord), %% Find out which functions are being loaded (and where). %% Note: Addresses are sorted descending. {MFAs,Addresses} = exports(ExportMap, CodeAddress), @@ -275,14 +279,26 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> %% Scan the list of patches and build a set (returned as a tuple) %% of the callees for which we may need trampolines. %% -find_callee_mfas(Patches) when is_list(Patches) -> - case erlang:system_info(hipe_architecture) of - amd64 -> []; - arm -> find_callee_mfas(Patches, gb_sets:empty(), false); - powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true); - ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true); - ultrasparc -> []; - x86 -> [] +find_callee_mfas(Patches, Architecture) when is_list(Patches) -> + case needs_trampolines(Architecture) of + true -> find_callee_mfas(Patches, gb_sets:empty(), + no_erts_trampolines(Architecture)); + _ -> [] + end. + +needs_trampolines(Architecture) -> + case Architecture of + arm -> true; + powerpc -> true; + ppc64 -> true; + _ -> false + end. + +no_erts_trampolines(Architecture) -> + case Architecture of + powerpc -> true; + ppc64 -> true; + _ -> false end. find_callee_mfas([{Type,Data}|Patches], MFAs, SkipErtsSyms) -> @@ -318,14 +334,9 @@ add_callee_mfas([], MFAs, _SkipErtsSyms) -> MFAs. %%---------------------------------------------------------------- %% -mk_trampoline_map([], []) -> []; % archs not using trampolines -mk_trampoline_map(CalleeMFAs, Trampolines) -> - SizeofLong = - case erlang:system_info(hipe_architecture) of - amd64 -> 8; - ppc64 -> 8; - _ -> 4 - end, +mk_trampoline_map([], [], _) -> []; % archs not using trampolines +mk_trampoline_map(CalleeMFAs, Trampolines, Architecture) -> + SizeofLong = word_size(Architecture), mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs, Trampolines, SizeofLong, gb_trees:empty()). @@ -621,22 +632,24 @@ patch_load_mfa(CodeAddress, DestMFA, Addresses, RemoteOrLocal) -> %%---------------------------------------------------------------- %% Patch references to code labels in the data segment. %% -patch_consts(Labels, DataAddress, CodeAddress) -> +patch_consts(Labels, DataAddress, CodeAddress, WriteWord) -> lists:foreach(fun (L) -> - patch_label_or_labels(L, DataAddress, CodeAddress) + patch_label_or_labels(L, DataAddress, CodeAddress, + WriteWord) end, Labels). -patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress) -> +patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress, WriteWord) -> ?ASSERT(assert_local_patch(CodeAddress+Offset)), - write_word(DataAddress+Pos, CodeAddress+Offset); -patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress) -> - sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress). + WriteWord(DataAddress+Pos, CodeAddress+Offset); +patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress, + WriteWord) -> + sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord). -sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress) -> +sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord) -> WriteAndInc = fun ({_, Offset}, DataPos) -> ?ASSERT(assert_local_patch(CodeAddress+Offset)), - write_word(DataPos, CodeAddress+Offset) + WriteWord(DataPos, CodeAddress+Offset) end, lists:foldl(WriteAndInc, DataAddress+Base, sort_on_representation(UnOrderdList)). @@ -662,17 +675,18 @@ patch_instr(Address, Value, Type) -> %% XXX: It appears this is used for inserting both code addresses %% and other data. In HiPE, code addresses are still 32-bit on %% some 64-bit machines. -write_word(DataAddress, DataWord) -> - case erlang:system_info(hipe_architecture) of - amd64 -> - hipe_bifs:write_u64(DataAddress, DataWord), - DataAddress+8; - ppc64 -> - hipe_bifs:write_u64(DataAddress, DataWord), - DataAddress+8; - _ -> - hipe_bifs:write_u32(DataAddress, DataWord), - DataAddress+4 +write_word_fun(WordSize) -> + case WordSize of + 8 -> + fun (DataAddress, DataWord) -> + hipe_bifs:write_u64(DataAddress, DataWord), + DataAddress+8 + end; + 4 -> + fun (DataAddress, DataWord) -> + hipe_bifs:write_u32(DataAddress, DataWord), + DataAddress+4 + end end. %%-------------------------------------------------------------------- @@ -688,30 +702,31 @@ bif_address(Name) when is_atom(Name) -> %% memory, and produces a ConstMap2 mapping each constant's ConstNo to %% its runtime address, tagged if the constant is a term. %% -create_data_segment(DataAlign, DataSize, DataList) -> +create_data_segment(DataAlign, DataSize, DataList, WriteWord) -> %%io:format("create_data_segment: \nDataAlign: ~p\nDataSize: ~p\nDataList: ~p\n",[DataAlign,DataSize,DataList]), DataAddress = hipe_bifs:alloc_data(DataAlign, DataSize), - enter_data(DataList, [], DataAddress, DataSize). + enter_data(DataList, [], DataAddress, DataSize, WriteWord). -enter_data(List, ConstMap2, DataAddress, DataSize) -> +enter_data(List, ConstMap2, DataAddress, DataSize, WriteWord) -> case List of [ConstNo,Offset,Type,Data|Rest] when is_integer(Offset) -> %%?msg("Const ~w\n",[[ConstNo,Offset,Type,Data]]), ?ASSERT((Offset >= 0) and (Offset =< DataSize)), - Res = enter_datum(Type, Data, DataAddress+Offset), - enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize); + Res = enter_datum(Type, Data, DataAddress+Offset, WriteWord), + enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize, + WriteWord); [] -> {DataAddress, ConstMap2} end. -enter_datum(Type, Data, Address) -> +enter_datum(Type, Data, Address, WriteWord) -> case ?EXT2CONST_TYPE(Type) of term -> %% Address is unused for terms hipe_bifs:term_to_word(hipe_bifs:merge_term(Data)); sorted_block -> L = lists:sort([hipe_bifs:term_to_word(Term) || Term <- Data]), - write_words(L, Address), + write_words(L, Address, WriteWord), Address; block -> case Data of @@ -719,7 +734,7 @@ enter_datum(Type, Data, Address) -> write_bytes(Lbls, Address); {Lbls, SortOrder} -> SortedLbls = [Lbl || {_,Lbl} <- lists:sort(group(Lbls, SortOrder))], - write_words(SortedLbls, Address); + write_words(SortedLbls, Address, WriteWord); Lbls -> write_bytes(Lbls, Address) end, @@ -734,9 +749,9 @@ group([B1,B2,B3,B4|Ls], [O|Os]) -> bytes_to_32(B4,B3,B2,B1) -> (B4 bsl 24) bor (B3 bsl 16) bor (B2 bsl 8) bor B1. -write_words([W|Rest], Addr) -> - write_words(Rest, write_word(Addr, W)); -write_words([], Addr) when is_integer(Addr) -> true. +write_words([W|Rest], Addr, WriteWord) -> + write_words(Rest, WriteWord(Addr, W), WriteWord); +write_words([], Addr, _) when is_integer(Addr) -> true. write_bytes([B|Rest], Addr) -> hipe_bifs:write_u8(Addr, B), @@ -812,7 +827,7 @@ address_to_mfa_lth(_Address, [], Prev) -> %%---------------------------------------------------------------- %% Change callers of the given module to instead trap to BEAM. -%% load_native_code/2 calls this just before loading native code. +%% load_native_code/3 calls this just before loading native code. %% patch_to_emu(Mod) -> patch_to_emu_step2(patch_to_emu_step1(Mod)). diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index abe207295f..535c11271e 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1372,7 +1372,7 @@ cache_rr(_Db, Cache, RR) -> ets:insert(Cache, RR). times() -> - erlang:monotonic_time(1). + erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time),native,seconds). %% lookup and remove old entries diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 4901206c8e..59efe85480 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -2699,10 +2699,7 @@ node_names(Names, Config) -> node_name(Name, Config) -> U = "_", - {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), - Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", - [Y,M,D, H,Min,S]), - L = lists:flatten(Date), + L = integer_to_list(erlang:unique_integer([positive])), lists:concat([Name,U,?testcase,U,U,L]). stop_node_nice(Node) when is_atom(Node) -> diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index c82aaf0582..be55e25811 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -810,14 +810,6 @@ check_funs({'$M_EXPR','$F_EXPR',_}, {unicode,characters_to_binary,3}, {filename,filename_string_to_binary,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, - [{code_server,load_native_code,4}, - {code_server,load_native_code_1,2}, - {code_server,load_native_code,2}, - {code_server,try_load_module,4}, - {code_server,do_load_binary,4}, - {code_server,handle_call,3}, - {code_server,loop,1}|_]) -> 0; -check_funs({'$M_EXPR','$F_EXPR',_}, [{code_server,do_mod_call,4}, {code_server,handle_call,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, @@ -866,8 +858,14 @@ check_funs({'$M_EXPR','$F_EXPR',_}, check_funs({'$M_EXPR',module_info,1}, [{hipe_unified_loader,patch_to_emu_step1,1} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, + [{hipe_unified_loader,write_words,3} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{hipe_unified_loader,patch_label_or_labels,4} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{hipe_unified_loader,sort_and_write,5} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, [{lists,foldl,3}, - {hipe_unified_loader,sort_and_write,4} | _]) -> 0; + {hipe_unified_loader,sort_and_write,5} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,foreach,2}, {hipe_unified_loader,patch_consts,3} | _]) -> 0; diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 15c2adc957..76564d4b0e 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -235,11 +235,10 @@ do_test_setuptime(Setuptime) when is_list(Setuptime) -> Res. time_ping(Node) -> - T0 = erlang:now(), + T0 = erlang:monotonic_time(), pang = net_adm:ping(Node), - T1 = erlang:now(), - time_diff(T0,T1). - + T1 = erlang:monotonic_time(), + erlang:convert_time_unit(T1 - T0, native, milli_seconds). %% Keep the connection with the client node up. %% This is neccessary as the client node runs with much shorter @@ -276,13 +275,15 @@ tick_cli_test1(Node) -> erlang:monitor_node(Node, true), sleep(2), rpc:call(Node, erlang, time, []), %% simulate action on the connection - T1 = now(), + T1 = erlang:monotonic_time(), receive {nodedown, Node} -> - T2 = now(), + T2 = erlang:monotonic_time(), receive {whats_the_result, From} -> - case time_diff(T1, T2) of + Diff = erlang:convert_time_unit(T2-T1, native, + milli_seconds), + case Diff of T when T > 8000, T < 16000 -> From ! {tick_test, T}; T -> @@ -1208,19 +1209,6 @@ print_my_messages() -> ?line ?t:format("Messages: ~p~n", [Messages]), ?line ok. -%% Time difference in milliseconds !! -time_diff({TimeM, TimeS, TimeU}, {CurM, CurS, CurU}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000000) + sec_diff({TimeS, TimeU}, {CurS, CurU}); -time_diff({_, TimeS, TimeU}, {_, CurS, CurU}) -> - sec_diff({TimeS, TimeU}, {CurS, CurU}). - -sec_diff({TimeS, TimeU}, {CurS, CurU}) when CurS > TimeS -> - ((CurS - TimeS) * 1000) + micro_diff(TimeU, CurU); -sec_diff({_, TimeU}, {_, CurU}) -> - micro_diff(TimeU, CurU). - -micro_diff(TimeU, CurU) -> - trunc(CurU/1000) - trunc(TimeU/1000). sleep(T) -> receive after T * 1000 -> ok end. @@ -1267,16 +1255,12 @@ get_nodenames(N, T) -> get_nodenames(0, _, Acc) -> Acc; get_nodenames(N, T, Acc) -> - {A, B, C} = now(), + U = erlang:unique_integer([positive]), get_nodenames(N-1, T, [list_to_atom(atom_to_list(T) ++ "-" - ++ atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) + ++ ?MODULE_STRING ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(U)) | Acc]). get_numbered_nodenames(N, T) -> get_numbered_nodenames(N, T, []). @@ -1284,16 +1268,12 @@ get_numbered_nodenames(N, T) -> get_numbered_nodenames(0, _, Acc) -> Acc; get_numbered_nodenames(N, T, Acc) -> - {A, B, C} = now(), + U = erlang:unique_integer([positive]), NL = [list_to_atom(atom_to_list(T) ++ integer_to_list(N) ++ "-" - ++ atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ ?MODULE_STRING ++ "-" - ++ integer_to_list(C)) | Acc], + ++ integer_to_list(U)) | Acc], get_numbered_nodenames(N-1, T, NL). wait_until(Fun) -> diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index 3b8b2d9150..8e2bbf5b64 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -451,11 +451,8 @@ close_pair({Client, Server}) -> %% MD5 hashing %% -%% This is no proper random number, but that is not really important in -%% this test gen_challenge() -> - {_,_,N} = erlang:now(), - N. + rand:uniform(1000000). %% Generate a message digest from Challenge number and Cookie gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> @@ -712,13 +709,9 @@ get_nodenames(N, T) -> get_nodenames(0, _, Acc) -> Acc; get_nodenames(N, T, Acc) -> - {A, B, C} = now(), - get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE) + U = erlang:unique_integer([positive]), + get_nodenames(N-1, T, [list_to_atom(?MODULE_STRING ++ "-" ++ atom_to_list(T) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(U)) | Acc]). diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl index fb576d77a3..16e0286593 100644 --- a/lib/kernel/test/error_logger_warn_SUITE.erl +++ b/lib/kernel/test/error_logger_warn_SUITE.erl @@ -69,7 +69,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> - ?line Dog = ?t:timetrap(?default_timeout), + Dog = ?t:timetrap(?default_timeout), [{watchdog, Dog} | Config]. end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), @@ -184,83 +184,81 @@ nn() -> basic() -> - ?line Node = start_node(nn(),[]), - ?line ok = install_relay(Node), - ?line Self = self(), - ?line GL = group_leader(), - ?line warning = warning_map(Node), - ?line format(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), - ?line error_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), - ?line warning_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{warning_msg,GL,{_,"~p~n",[Self]}}}), - ?line info_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line error_report(Node,Report), - ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), - ?line warning_report(Node,Report), - ?line ?EXPECT({handle_event,{warning_report,GL,{_,std_warning,Report}}}), - ?line info_report(Node,Report), - ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), - - ?line stop_node(Node), + Node = start_node(nn(),[]), + ok = install_relay(Node), + Self = self(), + GL = group_leader(), + warning = warning_map(Node), + format(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + error_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + warning_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{warning_msg,GL,{_,"~p~n",[Self]}}}), + info_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), + Report = [{self,Self},{gl,GL},make_ref()], + error_report(Node,Report), + ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), + warning_report(Node,Report), + ?EXPECT({handle_event,{warning_report,GL,{_,std_warning,Report}}}), + info_report(Node,Report), + ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), + stop_node(Node), ok. warnings_info() -> - ?line Node = start_node(nn(),"+Wi"), - ?line ok = install_relay(Node), - ?line Self = self(), - ?line GL = group_leader(), - ?line info = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line warning_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), - ?line warning_report(Node,Report), - ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), - ?line stop_node(Node), + Node = start_node(nn(),"+Wi"), + ok = install_relay(Node), + Self = self(), + GL = group_leader(), + info = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + warning_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), + warning_report(Node,Report), + ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), + stop_node(Node), ok. warnings_errors() -> - ?line Node = start_node(nn(),"+We"), - ?line ok = install_relay(Node), - ?line Self = self(), - ?line GL = group_leader(), - ?line error = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line warning_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), - ?line warning_report(Node,Report), - ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), - ?line stop_node(Node), + Node = start_node(nn(),"+We"), + ok = install_relay(Node), + Self = self(), + GL = group_leader(), + error = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + warning_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + warning_report(Node,Report), + ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), + stop_node(Node), ok. - - + % RB... quote(String) -> case os:type() of - {win32,_} -> - "\\\""++String++"\\\""; - _ -> - "'\""++String++"\"'" + {win32,_} -> + "\\\""++String++"\\\""; + _ -> + "'\""++String++"\"'" end. iquote(String) -> case os:type() of - {win32,_} -> - "\\\""++String++"\\\""; - _ -> - "\""++String++"\"" + {win32,_} -> + "\\\""++String++"\\\""; + _ -> + "\""++String++"\"" end. oquote(String) -> case os:type() of - {win32,_} -> - "\""++String++"\""; - _ -> - "'"++String++"'" + {win32,_} -> + "\""++String++"\""; + _ -> + "'"++String++"'" end. @@ -270,18 +268,18 @@ findstr(String,FileName) -> findstrc(String,File) -> case string:str(File,String) of - N when is_integer(N), - N > 0 -> - S2 = lists:sublist(File,N,length(File)), - case string:str(S2,"\n") of - 0 -> - 1; - M -> - S3 = lists:sublist(S2,M,length(S2)), - 1 + findstrc(String,S3) - end; - _ -> - 0 + N when is_integer(N), + N > 0 -> + S2 = lists:sublist(File,N,length(File)), + case string:str(S2,"\n") of + 0 -> + 1; + M -> + S3 = lists:sublist(S2,M,length(S2)), + 1 + findstrc(String,S3) + end; + _ -> + 0 end. % Doesn't count empty lines @@ -355,182 +353,182 @@ one_rb_findstr(Param,String) -> % Tests rb_basic() -> - ?line clean_rd(), + clean_rd(), % Behold, the magic parameters to activate rb logging... - ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line warning = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) =:= 0), - ?line true = (one_rb_lines([error_report]) =:= 0), - ?line 0 = one_rb_findstr([error],pid_to_list(Self)), - ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 1 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 2 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + warning = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) =:= 0), + true = (one_rb_lines([error_report]) =:= 0), + 0 = one_rb_findstr([error],pid_to_list(Self)), + 0 = one_rb_findstr([error_report],pid_to_list(Self)), + 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 1 = one_rb_findstr([warning_report],pid_to_list(Self)), + 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + 0 = one_rb_findstr([info_report],pid_to_list(Self)), + 2 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_warnings_info() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"+W i -boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line info = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) =:= 0), - ?line true = (one_rb_lines([error_report]) =:= 0), - ?line 0 = one_rb_findstr([error],pid_to_list(Self)), - ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 1 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 2 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"+W i -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + info = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) =:= 0), + true = (one_rb_lines([error_report]) =:= 0), + 0 = one_rb_findstr([error],pid_to_list(Self)), + 0 = one_rb_findstr([error_report],pid_to_list(Self)), + 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + 1 = one_rb_findstr([info_msg],pid_to_list(Self)), + 1 = one_rb_findstr([info_report],pid_to_list(Self)), + 2 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_warnings_errors() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"+W e -boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line error = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) > 1), - ?line true = (one_rb_lines([error_report]) > 1), - ?line 1 = one_rb_findstr([error],pid_to_list(Self)), - ?line 1 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 2 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"+W e -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + error = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) > 1), + true = (one_rb_lines([error_report]) > 1), + 1 = one_rb_findstr([error],pid_to_list(Self)), + 1 = one_rb_findstr([error_report],pid_to_list(Self)), + 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + 0 = one_rb_findstr([info_report],pid_to_list(Self)), + 2 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_trunc() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line {ok,File} = file:read_file(rf()), - ?line S=byte_size(File)-2, - ?line <<TFile:S/binary,_/binary>>=File, - ?line file:write_file(rf(),TFile), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) =:= 0), - ?line true = (one_rb_lines([error_report]) =:= 0), - ?line 0 = one_rb_findstr([error],pid_to_list(Self)), - ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + {ok,File} = file:read_file(rf()), + S=byte_size(File)-2, + <<TFile:S/binary,_/binary>>=File, + file:write_file(rf(),TFile), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) =:= 0), + true = (one_rb_lines([error_report]) =:= 0), + 0 = one_rb_findstr([error],pid_to_list(Self)), + 0 = one_rb_findstr([error_report],pid_to_list(Self)), + 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + 0 = one_rb_findstr([info_report],pid_to_list(Self)), + 1 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_utc() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5 -sasl utc_log true"), - ?line Self = self(), - ?line GL = group_leader(), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:stop(sasl), - ?line UtcLog=case application:get_env(sasl,utc_log) of - {ok,true} -> - true; - _AllOthers -> - application:set_env(sasl,utc_log,true), - false - end, - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line Pr=one_rb_findstr([progress],"==="), - ?line Wm=one_rb_findstr([warning_msg],"==="), - ?line Wr=one_rb_findstr([warning_report],"==="), - ?line Sum=Pr+Wm+Wr, - ?line Sum=one_rb_findstr([],"UTC"), - ?line rb:stop(), - ?line application:stop(sasl), - ?line application:set_env(sasl,utc_log,UtcLog), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5 -sasl utc_log true"), + Self = self(), + GL = group_leader(), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:stop(sasl), + UtcLog=case application:get_env(sasl,utc_log) of + {ok,true} -> + true; + _AllOthers -> + application:set_env(sasl,utc_log,true), + false + end, + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + Pr=one_rb_findstr([progress],"==="), + Wm=one_rb_findstr([warning_msg],"==="), + Wr=one_rb_findstr([warning_report],"==="), + Sum=Pr+Wm+Wr, + Sum=one_rb_findstr([],"UTC"), + rb:stop(), + application:stop(sasl), + application:set_env(sasl,utc_log,UtcLog), + stop_node(Node), ok. file_utc() -> - ?line file:delete(lf()), - ?line SS="-stdlib utc_log true -kernel error_logger "++ oquote("{file,"++iquote(lf())++"}"), + file:delete(lf()), + SS="-stdlib utc_log true -kernel error_logger "++ oquote("{file,"++iquote(lf())++"}"), %erlang:display(SS), - ?line Node = start_node(nn(),SS), + Node = start_node(nn(),SS), %erlang:display(rpc:call(Node,application,get_env,[kernel,error_logger])), - ?line Self = self(), - ?line GL = group_leader(), - ?line fake_gl(Node,error_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,info_msg,"~p~n",[Self]), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,error_report,Report), - ?line fake_gl(Node,warning_report,Report), - ?line fake_gl(Node,info_report,Report), - ?line nice_stop_node(Node), - ?line receive after 5000 -> ok end, % Let the node die, needed - ?line 6 = findstr("UTC",lf()), - ?line 2 = findstr("WARNING",lf()), - ?line 2 = findstr("ERROR",lf()), - ?line 2 = findstr("INFO",lf()), - ?line stop_node(Node), + Self = self(), + GL = group_leader(), + fake_gl(Node,error_msg,"~p~n",[Self]), + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,info_msg,"~p~n",[Self]), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,error_report,Report), + fake_gl(Node,warning_report,Report), + fake_gl(Node,info_report,Report), + nice_stop_node(Node), + receive after 5000 -> ok end, % Let the node die, needed + 6 = findstr("UTC",lf()), + 2 = findstr("WARNING",lf()), + 2 = findstr("ERROR",lf()), + 2 = findstr("INFO",lf()), + stop_node(Node), ok. diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 1213d8e37e..48abc92e4c 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -3914,7 +3914,7 @@ response_analysis(Module, Function, Arguments) -> receive {Parent, start, Ts} -> ok end, Stat = iterate(response_stat(response_stat(init, Ts), - erlang:now()), + micro_ts()), done, fun (S) -> erlang:yield(), @@ -3922,12 +3922,12 @@ response_analysis(Module, Function, Arguments) -> {Parent, stop} -> done after 0 -> - response_stat(S, erlang:now()) + response_stat(S, micro_ts()) end end), - Parent ! {self(), stopped, response_stat(Stat, erlang:now())} + Parent ! {self(), stopped, response_stat(Stat, micro_ts())} end), - ?line Child ! {Parent, start, erlang:now()}, + Child ! {Parent, start, micro_ts()}, ?line Result = apply(Module, Function, Arguments), ?line Child ! {Parent, stop}, ?line {N, Sum, _, M, Max} = receive {Child, stopped, X} -> X end, @@ -3941,12 +3941,13 @@ response_analysis(Module, Function, Arguments) -> [Mean_ms, Max_ms, M, (N-1)])), ?line {Result, Comment}. - +micro_ts() -> + erlang:monotonic_time(micro_seconds). response_stat(init, Ts) -> {0, 0, Ts, 0, 0}; -response_stat({N, Sum, {A1, B1, C1}, M, Max}, {A2, B2, C2} = Ts) -> - D = C2-C1 + 1000000*((B2-B1) + 1000000*(A2-A1)), +response_stat({N, Sum, Ts0, M, Max}, Ts) -> + D = Ts - Ts0, if D > Max -> {N+1, Sum+D, Ts, N, D}; true -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index c27d265550..4a527e2f51 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -32,6 +32,7 @@ t_connect_bad/1, t_recv_timeout/1, t_recv_eof/1, t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1, + t_shutdown_async/1, t_fdopen/1, t_fdconnect/1, t_implicit_inet6/1]). -export([getsockfd/0,closesockfd/1]). @@ -41,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, t_accept}, {group, t_connect}, {group, t_recv}, t_shutdown_write, t_shutdown_both, t_shutdown_error, - t_fdopen, t_fdconnect, t_implicit_inet6]. + t_shutdown_async, t_fdopen, t_fdconnect, t_implicit_inet6]. groups() -> [{t_accept, [], [t_accept_timeout]}, @@ -155,7 +156,34 @@ t_shutdown_error(Config) when is_list(Config) -> ?line ok = gen_tcp:close(L), ?line {error, closed} = gen_tcp:shutdown(L, read_write), ok. - + +t_shutdown_async(Config) when is_list(Config) -> + ?line {OS, _} = os:type(), + ?line {ok, L} = gen_tcp:listen(0, [{sndbuf, 4096}]), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, + [{recbuf, 4096}, + {active, false}]), + ?line {ok, S} = gen_tcp:accept(L), + ?line PayloadSize = 1024 * 1024, + ?line Payload = lists:duplicate(PayloadSize, $.), + ?line ok = gen_tcp:send(S, Payload), + ?line case erlang:port_info(S, queue_size) of + {queue_size, N} when N > 0 -> ok; + {queue_size, 0} when OS =:= win32 -> ok; + {queue_size, 0} = T -> ?t:fail({unexpected, T}) + end, + + ?line ok = gen_tcp:shutdown(S, write), + ?line {ok, Buf} = gen_tcp:recv(Client, PayloadSize), + ?line {error, closed} = gen_tcp:recv(Client, 0), + ?line case length(Buf) of + PayloadSize -> ok; + Sz -> ?t:fail({payload_size, + {expected, PayloadSize}, + {received, Sz}}) + end. + %%% gen_tcp:fdopen/2 diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 4e4aeb67e2..76a9708a58 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -38,7 +38,9 @@ % Accept tests primitive_accept/1,multi_accept_close_listen/1,accept_timeout/1, accept_timeouts_in_order/1,accept_timeouts_in_order2/1, - accept_timeouts_in_order3/1,accept_timeouts_mixed/1, + accept_timeouts_in_order3/1,accept_timeouts_in_order4/1, + accept_timeouts_in_order5/1,accept_timeouts_in_order6/1, + accept_timeouts_in_order7/1,accept_timeouts_mixed/1, killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1, several_accepts_in_one_go/1, accept_system_limit/1, active_once_closed/1, send_timeout/1, send_timeout_active/1, @@ -60,19 +62,19 @@ init_per_testcase(wrapping_oct, Config) when is_list(Config) -> [{watchdog, Dog}|Config]; init_per_testcase(iter_max_socks, Config) when is_list(Config) -> Dog = case os:type() of - {win32,_} -> - test_server:timetrap(test_server:minutes(30)); - _Else -> - test_server:timetrap(test_server:seconds(240)) - end, + {win32,_} -> + test_server:timetrap(test_server:minutes(30)); + _Else -> + test_server:timetrap(test_server:seconds(240)) + end, [{watchdog, Dog}|Config]; init_per_testcase(accept_system_limit, Config) when is_list(Config) -> case os:type() of - {ose,_} -> - {skip,"Skip in OSE"}; - _ -> - Dog = test_server:timetrap(test_server:seconds(240)), - [{watchdog,Dog}|Config] + {ose,_} -> + {skip,"Skip in OSE"}; + _ -> + Dog = test_server:timetrap(test_server:seconds(240)), + [{watchdog,Dog}|Config] end; init_per_testcase(wrapping_oct, Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:seconds(600)), @@ -99,7 +101,9 @@ all() -> so_priority, primitive_accept, multi_accept_close_listen, accept_timeout, accept_timeouts_in_order, accept_timeouts_in_order2, - accept_timeouts_in_order3, accept_timeouts_mixed, + accept_timeouts_in_order3, accept_timeouts_in_order4, + accept_timeouts_in_order5, accept_timeouts_in_order6, + accept_timeouts_in_order7, accept_timeouts_mixed, killing_acceptor, killing_multi_acceptors, killing_multi_acceptors2, several_accepts_in_one_go, accept_system_limit, active_once_closed, send_timeout, send_timeout_active, otp_7731, @@ -121,8 +125,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - - default_options(doc) -> ["Tests kernel application variables inet_default_listen_options and " "inet_default_connect_options"]; @@ -130,69 +132,68 @@ default_options(suite) -> []; default_options(Config) when is_list(Config) -> %% First check the delay_send option - ?line {true,true,true}=do_delay_send_1(), - ?line {false,false,false}=do_delay_send_2(), - ?line {true,false,false}=do_delay_send_3(), - ?line {false,false,false}=do_delay_send_4(), - ?line {false,false,false}=do_delay_send_5(), - ?line {false,true,true}=do_delay_send_6(), + {true,true,true}=do_delay_send_1(), + {false,false,false}=do_delay_send_2(), + {true,false,false}=do_delay_send_3(), + {false,false,false}=do_delay_send_4(), + {false,false,false}=do_delay_send_5(), + {false,true,true}=do_delay_send_6(), %% Now lets start some nodes with different combinations of options: - ?line {true,true,true} = do_delay_on_other_node("", - fun do_delay_send_1/0), - ?line {true,false,false} = + {true,true,true} = do_delay_on_other_node("", fun do_delay_send_1/0), + {true,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_2/0), - ?line {false,true,true} = + {false,true,true} = do_delay_on_other_node("-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_2/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_3/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_6/0), - ?line {false,false,false} = + {false,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_5/0), - ?line {false,true,true} = + {false,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_5/0), - ?line {true,false,false} = + {true,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_4/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"{delay_send,true}\" " "-kernel inet_default_listen_options " "\"{delay_send,true}\"", fun do_delay_send_2/0), %% Active is to dangerous and is supressed - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"{active,false}\" " "-kernel inet_default_listen_options " "\"{active,false}\"", fun do_delay_send_7/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{active,false},{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{active,false},{delay_send,true}]\"", fun do_delay_send_7/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{active,false},{delay_send,true}]\" " "-kernel inet_default_listen_options " @@ -204,12 +205,10 @@ default_options(Config) when is_list(Config) -> do_delay_on_other_node(XArgs, Function) -> Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir ++ " " ++ - XArgs}]), + [{args,"-pa " ++ Dir ++ " " ++ XArgs}]), Res = rpc:call(Node,erlang,apply,[Function,[]]), test_server:stop_node(Node), Res. - do_delay_send_1() -> {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]), @@ -301,8 +300,6 @@ do_delay_send_7() -> gen_tcp:close(S), gen_tcp:close(LS), {B1,B2,B3}. - - controlling_process(doc) -> ["Open a listen port and change controlling_process for it", @@ -313,18 +310,18 @@ controlling_process(Config) when is_list(Config) -> {ok,S} = gen_tcp:listen(0,[]), Pid2 = spawn(?MODULE,not_owner,[S]), Pid2 ! {self(),2,control}, - ?line {error, E} = receive {2,_E} -> + {error, E} = receive {2,_E} -> _E after 10000 -> timeout end, io:format("received ~p~n",[E]), Pid = spawn(?MODULE,not_owner,[S]), - ?line ok = gen_tcp:controlling_process(S,Pid), + ok = gen_tcp:controlling_process(S,Pid), Pid ! {self(),1,control}, - ?line ok = receive {1,ok} -> - ok - after 1000 -> timeout - end, + ok = receive {1,ok} -> + ok + after 1000 -> timeout + end, Pid ! close. not_owner(S) -> @@ -377,7 +374,7 @@ no_accept(Config) when is_list(Config) -> {tcp_closed, Client} -> ok after 5000 -> - ?line test_server:fail(never_closed) + test_server:fail(never_closed) end. @@ -386,30 +383,30 @@ close_with_pending_output(doc) -> "to the other end."]; close_with_pending_output(suite) -> []; close_with_pending_output(Config) when is_list(Config) -> - ?line {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), - ?line {ok, {_, Port}} = inet:sockname(L), - ?line Packets = 16, - ?line Total = 2048*Packets, + {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), + {ok, {_, Port}} = inet:sockname(L), + Packets = 16, + Total = 2048*Packets, case start_remote(close_pending) of {ok, Node} -> - ?line {ok, Host} = inet:gethostname(), - ?line spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), - ?line {ok, A} = gen_tcp:accept(L), - ?line case gen_tcp:recv(A, Total) of + {ok, Host} = inet:gethostname(), + spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), + {ok, A} = gen_tcp:accept(L), + case gen_tcp:recv(A, Total) of {ok, Bin} when byte_size(Bin) == Total -> gen_tcp:close(A), gen_tcp:close(L); {ok, Bin} -> - ?line test_server:fail({small_packet, + test_server:fail({small_packet, byte_size(Bin)}); Error -> - ?line test_server:fail({unexpected, Error}) + test_server:fail({unexpected, Error}) end, ok; {error, no_remote_hosts} -> {skipped,"No remote hosts"}; {error, Other} -> - ?line ?t:fail({failed_to_start_slave_node, Other}) + ?t:fail({failed_to_start_slave_node, Other}) end. sender(Port, Packets, Host) -> @@ -556,63 +553,62 @@ otp_3924(Config) when is_list(Config) -> otp_3924_1(MaxDelay). otp_3924_1(MaxDelay) -> - ?line {ok, Node} = start_node(otp_3924), - ?line DataLen = 100*1024, - ?line Data = otp_3924_data(DataLen), + {ok, Node} = start_node(otp_3924), + DataLen = 100*1024, + Data = otp_3924_data(DataLen), % Repeat the test a couple of times to prevent the test from passing % by chance. - repeat(10, - fun (N) -> - ?line ok = otp_3924(MaxDelay, Node, Data, DataLen, N) - end), - ?line test_server:stop_node(Node), + repeat(10, fun(N) -> + ok = otp_3924(MaxDelay, Node, Data, DataLen, N) + end), + test_server:stop_node(Node), ok. otp_3924(MaxDelay, Node, Data, DataLen, N) -> - ?line {ok, L} = gen_tcp:listen(0, [list, {active, false}]), - ?line {ok, {_, Port}} = inet:sockname(L), - ?line {ok, Host} = inet:gethostname(), - ?line Sender = spawn_link(Node, - ?MODULE, - otp_3924_sender, - [self(), Host, Port, Data]), - ?line Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), - ?line ok = gen_tcp:close(L). + {ok, L} = gen_tcp:listen(0, [list, {active, false}]), + {ok, {_, Port}} = inet:sockname(L), + {ok, Host} = inet:gethostname(), + Sender = spawn_link(Node, + ?MODULE, + otp_3924_sender, + [self(), Host, Port, Data]), + Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), + ok = gen_tcp:close(L). otp_3924_receive_data(LSock, Sender, MaxDelay, Len, N) -> - ?line OP = process_flag(priority, max), - ?line OTE = process_flag(trap_exit, true), - ?line TimeoutRef = make_ref(), - ?line Data = (catch begin - ?line Sender ! start, - ?line {ok, Sock} = gen_tcp:accept(LSock), - ?line D = otp_3924_receive_data(Sock, - TimeoutRef, - MaxDelay, - Len, - [], - 0), - ?line ok = gen_tcp:close(Sock), - D - end), - ?line unlink(Sender), - ?line process_flag(trap_exit, OTE), - ?line process_flag(priority, OP), + OP = process_flag(priority, max), + OTE = process_flag(trap_exit, true), + TimeoutRef = make_ref(), + Data = (catch begin + Sender ! start, + {ok, Sock} = gen_tcp:accept(LSock), + D = otp_3924_receive_data(Sock, + TimeoutRef, + MaxDelay, + Len, + [], + 0), + ok = gen_tcp:close(Sock), + D + end), + unlink(Sender), + process_flag(trap_exit, OTE), + process_flag(priority, OP), receive {'EXIT', _, TimeoutRef} -> - ?line test_server:fail({close_not_fast_enough,MaxDelay,N}); + test_server:fail({close_not_fast_enough,MaxDelay,N}); {'EXIT', Sender, Reason} -> - ?line test_server:fail({sender_exited, Reason}); + test_server:fail({sender_exited, Reason}); {'EXIT', _Other, Reason} -> - ?line test_server:fail({linked_process_exited, Reason}) + test_server:fail({linked_process_exited, Reason}) after 0 -> case Data of {'EXIT', {A,B}} -> - ?line test_server:fail({A,B,N}); + test_server:fail({A,B,N}); {'EXIT', Failure} -> - ?line test_server:fail(Failure); + test_server:fail(Failure); _ -> - ?line Data + Data end end. @@ -623,12 +619,12 @@ otp_3924_receive_data(Sock, TimeoutRef, MaxDelay, Len, Acc, AccLen) -> NewAccLen = AccLen + length(Data), if NewAccLen == Len -> - ?line {ok, TRef} = timer:exit_after(MaxDelay, + {ok, TRef} = timer:exit_after(MaxDelay, self(), TimeoutRef), - ?line {error, closed} = gen_tcp:recv(Sock, 0), - ?line timer:cancel(TRef), - ?line lists:flatten([Acc, Data]); + {error, closed} = gen_tcp:recv(Sock, 0), + timer:cancel(TRef), + lists:flatten([Acc, Data]); NewAccLen > Len -> exit({received_too_much, NewAccLen}); true -> @@ -713,8 +709,8 @@ get_status(doc) -> "is called."]; get_status(suite) -> []; get_status(Config) when is_list(Config) -> - ?line {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), - ?line {status,Pid,_,_} = sys:get_status(Pid). + {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), + {status,Pid,_,_} = sys:get_status(Pid). -define(RECOVER_SLEEP, 60000). -define(RETRY_SLEEP, 15000). @@ -744,19 +740,19 @@ do_iter_max_socks(N, failed) -> MS = max_socks(), [MS|do_iter_max_socks(N-1, failed)]; do_iter_max_socks(N, First) when is_integer(First) -> - ?line MS = max_socks(), + MS = max_socks(), if MS == First -> - ?line [MS|do_iter_max_socks(N-1, First)]; + [MS|do_iter_max_socks(N-1, First)]; true -> - ?line io:format("Sleeping for ~p seconds...~n", + io:format("Sleeping for ~p seconds...~n", [?RETRY_SLEEP/1000]), - ?line ?t:sleep(?RETRY_SLEEP), - ?line io:format("Trying again...~n", []), - ?line RetryMS = max_socks(), - ?line if RetryMS == First -> - ?line [RetryMS|do_iter_max_socks(N-1, First)]; + ?t:sleep(?RETRY_SLEEP), + io:format("Trying again...~n", []), + RetryMS = max_socks(), + if RetryMS == First -> + [RetryMS|do_iter_max_socks(N-1, First)]; true -> - ?line [RetryMS|do_iter_max_socks(N-1, failed)] + [RetryMS|do_iter_max_socks(N-1, failed)] end end. @@ -768,7 +764,7 @@ all_equal([Rule | T]) -> all_equal(Rule, [Rule | T]) -> all_equal(Rule, T); all_equal(_, [_ | _]) -> - ?line ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll + ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll % recover so other tests won't be % affected. ?t:fail(max_socket_mismatch); @@ -776,9 +772,9 @@ all_equal(_Rule, []) -> ok. max_socks() -> - ?line Socks = open_socks(), - ?line N = length(Socks), - ?line lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), + Socks = open_socks(), + N = length(Socks), + lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), io:format("Got ~p sockets", [N]), N. @@ -817,18 +813,18 @@ passive_sockets(doc) -> ["Tests that when 'the other side' on a passive socket closes, the connecting", "side still can read until the end of data."]; passive_sockets(Config) when is_list(Config) -> - ?line spawn_link(?MODULE, passive_sockets_server, - [[{active,false}],self()]), - ?line receive - {socket,Port} -> ok - end, + spawn_link(?MODULE, passive_sockets_server, + [[{active,false}],self()]), + receive + {socket,Port} -> ok + end, ?t:sleep(500), - ?line case gen_tcp:connect("localhost", Port, [{active, false}]) of - {ok, Sock} -> - passive_sockets_read(Sock); - Error -> - ?t:fail({"Could not connect to server", Error}) - end. + case gen_tcp:connect("localhost", Port, [{active, false}]) of + {ok, Sock} -> + passive_sockets_read(Sock); + Error -> + ?t:fail({"Could not connect to server", Error}) + end. %% %% Read until we get an {error, closed}. If we get another error, this test case @@ -847,58 +843,58 @@ passive_sockets_read(Sock) -> end. passive_sockets_server(Opts, Parent) -> - ?line case gen_tcp:listen(0, Opts) of - {ok, LSock} -> - {ok,{_,Port}} = inet:sockname(LSock), - Parent ! {socket,Port}, - passive_sockets_server_accept(LSock); - Error -> - ?t:fail({"Could not create listen socket", Error}) - end. + case gen_tcp:listen(0, Opts) of + {ok, LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + Parent ! {socket,Port}, + passive_sockets_server_accept(LSock); + Error -> + ?t:fail({"Could not create listen socket", Error}) + end. passive_sockets_server_accept(Sock) -> - ?line case gen_tcp:accept(Sock) of - {ok, Socket} -> - ?t:sleep(500), % Simulate latency - passive_sockets_server_send(Socket, 5), - passive_sockets_server_accept(Sock); - Error -> - ?t:fail({"Could not accept connection", Error}) - end. + case gen_tcp:accept(Sock) of + {ok, Socket} -> + ?t:sleep(500), % Simulate latency + passive_sockets_server_send(Socket, 5), + passive_sockets_server_accept(Sock); + Error -> + ?t:fail({"Could not accept connection", Error}) + end. passive_sockets_server_send(Socket, 0) -> io:format("Closing other end..~n", []), gen_tcp:close(Socket); passive_sockets_server_send(Socket, X) -> - ?line Data = lists:duplicate(1024*X, $a), - ?line case gen_tcp:send(Socket, Data) of - ok -> - ?t:sleep(50), % Simulate some processing. - passive_sockets_server_send(Socket, X-1); - {error, _Reason} -> - ?t:fail("Failed to send data") - end. + Data = lists:duplicate(1024*X, $a), + case gen_tcp:send(Socket, Data) of + ok -> + ?t:sleep(50), % Simulate some processing. + passive_sockets_server_send(Socket, X-1); + {error, _Reason} -> + ?t:fail("Failed to send data") + end. accept_closed_by_other_process(doc) -> ["Tests the return value from gen_tcp:accept when ", "the socket is closed from another process. (OTP-3817)"]; accept_closed_by_other_process(Config) when is_list(Config) -> - ?line Parent = self(), - ?line {ok, ListenSocket} = gen_tcp:listen(0, []), - ?line Child = + Parent = self(), + {ok, ListenSocket} = gen_tcp:listen(0, []), + Child = spawn_link( fun() -> Parent ! {self(), gen_tcp:accept(ListenSocket)} end), - ?line receive after 1000 -> ok end, - ?line ok = gen_tcp:close(ListenSocket), - ?line receive - {Child, {error, closed}} -> - ok; - {Child, Other} -> - ?t:fail({"Wrong result of gen_tcp:accept", Other}) - end. + receive after 1000 -> ok end, + ok = gen_tcp:close(ListenSocket), + receive + {Child, {error, closed}} -> + ok; + {Child, Other} -> + ?t:fail({"Wrong result of gen_tcp:accept", Other}) + end. repeat(N, Fun) -> repeat(N, N, Fun). @@ -915,9 +911,9 @@ closed_socket(suite) -> closed_socket(doc) -> ["Tests the response when using a closed socket as argument"]; closed_socket(Config) when is_list(Config) -> - ?line {ok, LS1} = gen_tcp:listen(0, []), - ?line erlang:yield(), - ?line ok = gen_tcp:close(LS1), + {ok, LS1} = gen_tcp:listen(0, []), + erlang:yield(), + ok = gen_tcp:close(LS1), %% If the following delay is uncommented, the result error values %% below will change from {error, einval} to {error, closed} since %% inet_db then will have noticed that the socket is closed. @@ -925,19 +921,18 @@ closed_socket(Config) when is_list(Config) -> %% in inet_db processes the 'EXIT' message from the port, %% the socket is unregistered. %% - %% ?line test_server:sleep(test_server:seconds(2)), + %% test_server:sleep(test_server:seconds(2)), %% - ?line {error, R_send} = gen_tcp:send(LS1, "data"), - ?line {error, R_recv} = gen_tcp:recv(LS1, 17), - ?line {error, R_accept} = gen_tcp:accept(LS1), - ?line {error, R_controlling_process} = + {error, R_send} = gen_tcp:send(LS1, "data"), + {error, R_recv} = gen_tcp:recv(LS1, 17), + {error, R_accept} = gen_tcp:accept(LS1), + {error, R_controlling_process} = gen_tcp:controlling_process(LS1, self()), %% - ?line ok = io:format("R_send = ~p~n", [R_send]), - ?line ok = io:format("R_recv = ~p~n", [R_recv]), - ?line ok = io:format("R_accept = ~p~n", [R_accept]), - ?line ok = io:format("R_controlling_process = ~p~n", - [R_controlling_process]), + ok = io:format("R_send = ~p~n", [R_send]), + ok = io:format("R_recv = ~p~n", [R_recv]), + ok = io:format("R_accept = ~p~n", [R_accept]), + ok = io:format("R_controlling_process = ~p~n", [R_controlling_process]), ok. %%% @@ -945,28 +940,27 @@ closed_socket(Config) when is_list(Config) -> %%% shutdown_active(Config) when is_list(Config) -> - ?line shutdown_common(true). + shutdown_common(true). shutdown_passive(Config) when is_list(Config) -> - ?line shutdown_common(false). + shutdown_common(false). shutdown_common(Active) -> - ?line P = sort_server(Active), + P = sort_server(Active), io:format("Sort server port: ~p\n", [P]), - ?line do_sort(P, []), - ?line do_sort(P, ["glurf"]), - ?line do_sort(P, ["abc","nisse","dum"]), - - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), - ?line do_sort(P, []), - ?line do_sort(P, ["apa"]), - ?line do_sort(P, ["kluns","gorilla"]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), - ?line do_sort(P, []), - + do_sort(P, []), + do_sort(P, ["glurf"]), + do_sort(P, ["abc","nisse","dum"]), + + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), + do_sort(P, []), + do_sort(P, ["apa"]), + do_sort(P, ["kluns","gorilla"]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), + do_sort(P, []), receive Any -> ?t:fail({unexpected_message,Any}) @@ -985,14 +979,14 @@ do_sort(P, List0) -> sort_server(Active) -> Opts = [{exit_on_close,false},{packet,line},{active,Active}], - ?line {ok,L} = gen_tcp:listen(0, Opts), + {ok,L} = gen_tcp:listen(0, Opts), Go = make_ref(), - ?line Pid = spawn_link(fun() -> - receive Go -> sort_server_1(L, Active) end - end), - ?line ok = gen_tcp:controlling_process(L, Pid), - ?line Pid ! Go, - ?line {ok,Port} = inet:port(L), + Pid = spawn_link(fun() -> + receive Go -> sort_server_1(L, Active) end + end), + ok = gen_tcp:controlling_process(L, Pid), + Pid ! Go, + {ok,Port} = inet:port(L), Port. sort_server_1(L, Active) -> @@ -1042,17 +1036,17 @@ shutdown_pending(Config) when is_list(Config) -> Data = [<<N:32>>,ones(N),42], P = a_server(), io:format("Server port: ~p\n", [P]), - ?line {ok,S} = gen_tcp:connect(localhost, P, []), - ?line gen_tcp:send(S, Data), - ?line gen_tcp:shutdown(S, write), - ?line receive - {tcp,S,Msg} -> - io:format("~p\n", [Msg]), - ?line N = list_to_integer(Msg) - 5; - Other -> - ?t:fail({unexpected,Other}) - end, - ok. + {ok,S} = gen_tcp:connect(localhost, P, []), + gen_tcp:send(S, Data), + gen_tcp:shutdown(S, write), + receive + {tcp,S,Msg} -> + io:format("~p\n", [Msg]), + N = list_to_integer(Msg) - 5; + Other -> + ?t:fail({unexpected,Other}) + end, + ok. ones(0) -> []; ones(1) -> [1]; @@ -1065,10 +1059,10 @@ shutdown_pending(Config) when is_list(Config) -> end. a_server() -> - ?line {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), - ?line Pid = spawn_link(fun() -> a_server(L) end), - ?line ok = gen_tcp:controlling_process(L, Pid), - ?line {ok,Port} = inet:port(L), + {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), + Pid = spawn_link(fun() -> a_server(L) end), + ok = gen_tcp:controlling_process(L, Pid), + {ok,Port} = inet:port(L), Port. a_server(L) -> @@ -1090,19 +1084,18 @@ shutdown_pending(Config) when is_list(Config) -> %% corrupt data. The testcase will be killed by the timetrap timeout %% if the bug is present. http_bad_packet(Config) when is_list(Config) -> - ?line {ok,L} = gen_tcp:listen(0, - [{active, false}, - binary, - {reuseaddr, true}, - {packet, http}]), - ?line {ok,Port} = inet:port(L), - ?line spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), - ?line case gen_tcp:accept(L) of - {ok,S} -> - http_worker(S); - Err -> - exit({accept,Err}) - end. + {ok,L} = gen_tcp:listen(0, [{active, false}, + binary, + {reuseaddr, true}, + {packet, http}]), + {ok,Port} = inet:port(L), + spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), + case gen_tcp:accept(L) of + {ok,S} -> + http_worker(S); + Err -> + exit({accept,Err}) + end. http_worker(S) -> case gen_tcp:recv(S, 0, 30000) of @@ -1122,9 +1115,9 @@ http_bad_client(Port) -> %% Fill send queue and then start receiving. %% busy_send(Config) when is_list(Config) -> - ?line Master = self(), - ?line Msg = <<"the quick brown fox jumps over a lazy dog~n">>, - ?line Server = + Master = self(), + Msg = <<"the quick brown fox jumps over a lazy dog~n">>, + Server = spawn_link(fun () -> {ok,L} = gen_tcp:listen (0, [{active,false},binary, @@ -1134,45 +1127,42 @@ busy_send(Config) when is_list(Config) -> busy_send_client(Port, Master, Msg)}, busy_send_srv(L, Master, Msg) end), - ?line io:format("~p Server~n", [Server]), - ?line receive - {Server,client,Client} -> - ?line io:format("~p Client~n", [Client]), - ?line busy_send_loop(Server, Client, 0) - end. + io:format("~p Server~n", [Server]), + receive + {Server,client,Client} -> + io:format("~p Client~n", [Client]), + busy_send_loop(Server, Client, 0) + end. busy_send_loop(Server, Client, N) -> %% Master %% - ?line receive {Server,send} -> + receive {Server,send} -> busy_send_loop(Server, Client, N+1) after 2000 -> %% Send queue full, sender blocked %% -> stop sender and release client - ?line io:format("Send timeout, time to receive...~n", []), - ?line Server ! {self(),close}, - ?line Client ! {self(),recv,N+1}, - ?line receive - {Server,send} -> - ?line busy_send_2(Server, Client, N+1) - after 10000 -> - %% If this happens, see busy_send_srv - ?t:fail({timeout,{server,not_send,flush([])}}) - end - end. + io:format("Send timeout, time to receive...~n", []), + Server ! {self(),close}, + Client ! {self(),recv,N+1}, + receive + {Server,send} -> + busy_send_2(Server, Client, N+1) + after 10000 -> + %% If this happens, see busy_send_srv + ?t:fail({timeout,{server,not_send,flush([])}}) + end + end. busy_send_2(Server, Client, _N) -> %% Master %% - ?line receive - {Server,[closed]} -> - ?line receive - {Client,[0,{error,closed}]} -> - ok - end - after 10000 -> - ?t:fail({timeout,{server,not_closed,flush([])}}) - end. + receive + {Server,[closed]} -> + receive {Client,[0,{error,closed}]} -> ok end + after 10000 -> + ?t:fail({timeout,{server,not_closed,flush([])}}) + end. busy_send_srv(L, Master, Msg) -> %% Server @@ -1228,7 +1218,7 @@ busy_send_client_loop(Socket, Master, Msg, N) -> busy_disconnect_passive(Config) when is_list(Config) -> MuchoData = list_to_binary(ones(64*1024)), - ?line [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], + [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], ok. do_busy_disconnect_passive(MuchoData) -> @@ -1236,8 +1226,8 @@ do_busy_disconnect_passive(MuchoData) -> busy_disconnect_passive_send(S, MuchoData). busy_disconnect_passive_send(S, Data) -> - ?line case gen_tcp:send(S, Data) of - ok -> ?line busy_disconnect_passive_send(S, Data); + case gen_tcp:send(S, Data) of + ok -> busy_disconnect_passive_send(S, Data); {error,closed} -> ok end. @@ -1248,7 +1238,7 @@ busy_disconnect_passive_send(S, Data) -> %%% busy_disconnect_active(Config) when is_list(Config) -> MuchoData = list_to_binary(ones(64*1024)), - ?line [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], + [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], ok. do_busy_disconnect_active(MuchoData) -> @@ -1256,21 +1246,21 @@ do_busy_disconnect_active(MuchoData) -> busy_disconnect_active_send(S, MuchoData). busy_disconnect_active_send(S, Data) -> - ?line case gen_tcp:send(S, Data) of - ok -> ?line busy_disconnect_active_send(S, Data); + case gen_tcp:send(S, Data) of + ok -> busy_disconnect_active_send(S, Data); {error,closed} -> receive {tcp_closed,S} -> ok; - _Other -> ?line ?t:fail() + _Other -> ?t:fail() end end. busy_disconnect_prepare_server(ConnectOpts) -> - ?line Sender = self(), - ?line Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), + Sender = self(), + Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), receive {port,Server,Port} -> ok end, - ?line {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), + {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), Server ! {Sender,sending}, S. @@ -1304,8 +1294,8 @@ busy_disconnect_server_wait_for_busy(Sender, S) -> %%% Fill send queue %%% fill_sendq(Config) when is_list(Config) -> - ?line Master = self(), - ?line Server = + Master = self(), + Server = spawn_link(fun () -> {ok,L} = gen_tcp:listen (0, [{active,false},binary, @@ -1315,12 +1305,12 @@ fill_sendq(Config) when is_list(Config) -> fill_sendq_client(Port, Master)}, fill_sendq_srv(L, Master) end), - ?line io:format("~p Server~n", [Server]), - ?line receive {Server,client,Client} -> - ?line io:format("~p Client~n", [Client]), - ?line receive {Server,reader,Reader} -> - ?line io:format("~p Reader~n", [Reader]), - ?line fill_sendq_loop(Server, Client, Reader) + io:format("~p Server~n", [Server]), + receive {Server,client,Client} -> + io:format("~p Client~n", [Client]), + receive {Server,reader,Reader} -> + io:format("~p Reader~n", [Reader]), + fill_sendq_loop(Server, Client, Reader) end end. @@ -1331,21 +1321,21 @@ fill_sendq_loop(Server, Client, Reader) -> fill_sendq_loop(Server, Client, Reader) after 2000 -> %% Send queue full, sender blocked -> close client. - ?line io:format("Send timeout, closing Client...~n", []), - ?line Client ! {self(),close}, - ?line receive {Server,[{error,closed}]} -> - ?line io:format("Got server closed.~n"), - ?line receive {Reader,[{error,closed}]} -> - ?line io:format + io:format("Send timeout, closing Client...~n", []), + Client ! {self(),close}, + receive {Server,[{error,closed}]} -> + io:format("Got server closed.~n"), + receive {Reader,[{error,closed}]} -> + io:format ("Got reader closed.~n"), ok after 3000 -> ?t:fail({timeout,{closed,reader}}) end; {Reader,[{error,closed}]} -> - ?line io:format("Got reader closed.~n"), - ?line receive {Server,[{error,closed}]} -> - ?line io:format("Got server closed~n"), + io:format("Got reader closed.~n"), + receive {Server,[{error,closed}]} -> + io:format("Got server closed~n"), ok after 3000 -> ?t:fail({timeout,{closed,server}}) @@ -1416,39 +1406,39 @@ fill_sendq_client(Port, Master) -> %%% a closed socket. %%% partial_recv_and_close(Config) when is_list(Config) -> - ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", - ?line Len = length(Msg), - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {ok,P} = inet:port(L), - ?line {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), - ?line {ok,A} = gen_tcp:accept(L), - ?line ok = gen_tcp:send(S, Msg), - ?line ok = gen_tcp:close(S), - ?line {error,closed} = gen_tcp:recv(A, Len+1), + Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + Len = length(Msg), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,P} = inet:port(L), + {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), + {ok,A} = gen_tcp:accept(L), + ok = gen_tcp:send(S, Msg), + ok = gen_tcp:close(S), + {error,closed} = gen_tcp:recv(A, Len+1), ok. %%% Try to receive more than available number of bytes from %%% a closed socket, this time waiting in the recv before closing. %%% partial_recv_and_close_2(Config) when is_list(Config) -> - ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", - ?line Len = length(Msg), - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {ok,P} = inet:port(L), - ?line Server = self(), - ?line Client = + Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + Len = length(Msg), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,P} = inet:port(L), + Server = self(), + Client = spawn_link( fun () -> receive after 2000 -> ok end, {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), - ?line ok = gen_tcp:send(S, Msg), + ok = gen_tcp:send(S, Msg), receive {Server,close} -> ok end, receive after 2000 -> ok end, - ?line ok = gen_tcp:close(S) + ok = gen_tcp:close(S) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line Client ! {Server,close}, - ?line {error,closed} = gen_tcp:recv(A, Len+1), + {ok,A} = gen_tcp:accept(L), + Client ! {Server,close}, + {error,closed} = gen_tcp:recv(A, Len+1), ok. %%% Here we tests that gen_tcp:recv/2 will return {error,closed} following @@ -1471,151 +1461,151 @@ do_partial_recv_and_close_3() -> receive {port,Port} -> ok end, - ?line Much = ones(8*64*1024), - ?line {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), + Much = ones(8*64*1024), + {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), %% Send a lot of data (most of it will be queued). The receiver will read one byte %% and close the connection. The write operation will fail. - ?line gen_tcp:send(S, Much), + gen_tcp:send(S, Much), %% We should always get {error,closed} here. - ?line {error,closed} = gen_tcp:recv(S, 0). + {error,closed} = gen_tcp:recv(S, 0). test_prio_put_get() -> Tos = 3 bsl 5, - ?line {ok,L1} = gen_tcp:listen(0, [{active,false}]), - ?line ok = inet:setopts(L1,[{priority,3}]), - ?line ok = inet:setopts(L1,[{tos,Tos}]), - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line gen_tcp:close(L1), + {ok,L1} = gen_tcp:listen(0, [{active,false}]), + ok = inet:setopts(L1,[{priority,3}]), + ok = inet:setopts(L1,[{tos,Tos}]), + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + gen_tcp:close(L1), ok. test_prio_accept() -> - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), - ?line {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), - ?line {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), + {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), + {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept2() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}, - {tos,Tos2}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), - ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept3() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {tos,Tos2}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), - ?line {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {tos,Tos2}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept_async() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, Ref = make_ref(), - ?line spawn(?MODULE,priority_server,[{self(),Ref}]), - ?line Port = receive - {Ref,P} -> P - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - ?line receive - after 3000 -> ok - end, - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}, - {tos,Tos2}]), - ?line receive - {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> - ok ; - {Ref,Error} -> - ?t:fail({missmatch,Error}) - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - ?line receive - {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> - ok ; - {Ref,Error2} -> - ?t:fail({missmatch,Error2}) - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - - ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line catch gen_tcp:close(Sock2), + spawn(?MODULE,priority_server,[{self(),Ref}]), + Port = receive + {Ref,P} -> P + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + receive + after 3000 -> ok + end, + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok; + {Ref,Error} -> + ?t:fail({missmatch,Error}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok; + {Ref,Error2} -> + ?t:fail({missmatch,Error2}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + + {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + catch gen_tcp:close(Sock2), ok. priority_server({Parent,Ref}) -> Tos1 = 4 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), Parent ! {Ref,Port}, - ?line {ok,Sock3}=gen_tcp:accept(Sock), + {ok,Sock3}=gen_tcp:accept(Sock), Parent ! {Ref, inet:getopts(Sock,[priority,tos])}, Parent ! {Ref, inet:getopts(Sock3,[priority,tos])}, ok. test_prio_fail() -> - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {error,_} = inet:setopts(L,[{priority,1000}]), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {error,_} = inet:setopts(L,[{priority,1000}]), % This error could only happen in linux kernels earlier than 2.6.24.4 % Privilege check is now disabled and IP_TOS can never fail (only silently % be masked). -% ?line {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), - ?line gen_tcp:close(L), +% {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), + gen_tcp:close(L), ok. test_prio_udp() -> Tos = 3 bsl 5, - ?line {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, - {priority,3}]), - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), - ?line gen_udp:close(S), + {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, + {priority,3}]), + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), + gen_udp:close(S), ok. so_priority(doc) -> @@ -1623,9 +1613,9 @@ so_priority(doc) -> so_priority(suite) -> []; so_priority(Config) when is_list(Config) -> - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line ok = inet:setopts(L,[{priority,1}]), - ?line case inet:getopts(L,[priority]) of + {ok,L} = gen_tcp:listen(0, [{active,false}]), + ok = inet:setopts(L,[{priority,1}]), + case inet:getopts(L,[priority]) of {ok,[{priority,1}]} -> gen_tcp:close(L), test_prio_put_get(), @@ -1641,7 +1631,7 @@ so_priority(Config) when is_list(Config) -> {unix,linux} -> case os:version() of {X,Y,_} when (X > 2) or ((X =:= 2) and (Y >= 4)) -> - ?line ?t:fail({error, + ?t:fail({error, "so_priority should work on this " "OS, but does not"}); _ -> @@ -1655,21 +1645,21 @@ so_priority(Config) when is_list(Config) -> %% Accept test utilities (suites are below) millis() -> - {A,B,C}=erlang:now(), - (A*1000000*1000)+(B*1000)+(C div 1000). + erlang:monotonic_time(milli_seconds). -collect_accepts(Tmo) -> +collect_accepts(0,_) -> []; +collect_accepts(N,Tmo) -> A = millis(), receive {accepted,P,Msg} -> - [{P,Msg}] ++ collect_accepts(Tmo-(millis() - A)) + [{P,Msg}] ++ collect_accepts(N-1,Tmo-(millis() - A)) after Tmo -> [] end. --define(EXPECT_ACCEPTS(Pattern,Timeout), +-define(EXPECT_ACCEPTS(Pattern,N,Timeout), (fun() -> - case collect_accepts(Timeout) of + case collect_accepts(if N =:= infinity -> -1; true -> N end,Timeout) of Pattern -> ok; Other -> @@ -1705,20 +1695,20 @@ primitive_accept(suite) -> primitive_accept(doc) -> ["Test singular accept"]; primitive_accept(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line {ok,PortNo}=inet:port(LS), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line P = spawn(F), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line receive - {accepted,P,{ok,P0}} when is_port(P0) -> - ok; - {accepted,P,Other0} -> - {error,Other0} - after 500 -> - {error,timeout} - end. + {ok,LS}=gen_tcp:listen(0,[]), + {ok,PortNo}=inet:port(LS), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + P = spawn(F), + gen_tcp:connect("localhost",PortNo,[]), + receive + {accepted,P,{ok,P0}} when is_port(P0) -> + ok; + {accepted,P,Other0} -> + {error,Other0} + after 500 -> + {error,timeout} + end. multi_accept_close_listen(suite) -> @@ -1726,111 +1716,175 @@ multi_accept_close_listen(suite) -> multi_accept_close_listen(doc) -> ["Closing listen socket when multi-accepting"]; multi_accept_close_listen(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line spawn(F), - ?line spawn(F), - ?line spawn(F), - ?line spawn(F), - ?line gen_tcp:close(LS), - ?line ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, - {_,{error,closed}},{_,{error,closed}}], 500). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + spawn(F), + spawn(F), + spawn(F), + spawn(F), + gen_tcp:close(LS), + ok = ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, + {_,{error,closed}},{_,{error,closed}}],4,500). accept_timeout(suite) -> []; accept_timeout(doc) -> ["Single accept with timeout"]; accept_timeout(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, - ?line P = spawn(F), - ?line ?EXPECT_ACCEPTS([{P,{error,timeout}}],2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, + P = spawn(F), + ok = ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000). accept_timeouts_in_order(suite) -> []; accept_timeouts_in_order(doc) -> ["Check that multi-accept timeouts happen in the correct order"]; accept_timeouts_in_order(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1000,Parent,LS)), - ?line P2 = spawn(mktmofun(1200,Parent,LS)), - ?line P3 = spawn(mktmofun(1300,Parent,LS)), - ?line P4 = spawn(mktmofun(1400,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, - {P3,{error,timeout}},{P4,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(1200,Parent,LS)), + P3 = spawn(mktmofun(1300,Parent,LS)), + P4 = spawn(mktmofun(1400,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, + {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000). accept_timeouts_in_order2(suite) -> []; accept_timeouts_in_order2(doc) -> ["Check that multi-accept timeouts happen in the correct order (more)"]; accept_timeouts_in_order2(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1400,Parent,LS)), - ?line P2 = spawn(mktmofun(1300,Parent,LS)), - ?line P3 = spawn(mktmofun(1200,Parent,LS)), - ?line P4 = spawn(mktmofun(1000,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, - {P2,{error,timeout}},{P1,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1400,Parent,LS)), + P2 = spawn(mktmofun(1300,Parent,LS)), + P3 = spawn(mktmofun(1200,Parent,LS)), + P4 = spawn(mktmofun(1000,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, + {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000). accept_timeouts_in_order3(suite) -> []; accept_timeouts_in_order3(doc) -> ["Check that multi-accept timeouts happen in the correct order (even more)"]; accept_timeouts_in_order3(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1200,Parent,LS)), - ?line P2 = spawn(mktmofun(1400,Parent,LS)), - ?line P3 = spawn(mktmofun(1300,Parent,LS)), - ?line P4 = spawn(mktmofun(1000,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, - {P3,{error,timeout}},{P2,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1200,Parent,LS)), + P2 = spawn(mktmofun(1400,Parent,LS)), + P3 = spawn(mktmofun(1300,Parent,LS)), + P4 = spawn(mktmofun(1000,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, + {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order4(suite) -> + []; +accept_timeouts_in_order4(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts"]; +accept_timeouts_in_order4(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(200,Parent,LS)), + P2 = spawn(mktmofun(400,Parent,LS)), + P3 = spawn(mktmofun(1000,Parent,LS)), + P4 = spawn(mktmofun(600,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, + {P4,{error,timeout}},{P3,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order5(suite) -> + []; +accept_timeouts_in_order5(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts (more)"]; +accept_timeouts_in_order5(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(400,Parent,LS)), + P2 = spawn(mktmofun(1000,Parent,LS)), + P3 = spawn(mktmofun(600,Parent,LS)), + P4 = spawn(mktmofun(200,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, + {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order6(suite) -> + []; +accept_timeouts_in_order6(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts (even more)"]; +accept_timeouts_in_order6(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(400,Parent,LS)), + P3 = spawn(mktmofun(600,Parent,LS)), + P4 = spawn(mktmofun(200,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P2,{error,timeout}}, + {P3,{error,timeout}},{P1,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order7(suite) -> + []; +accept_timeouts_in_order7(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts (even more++)"]; +accept_timeouts_in_order7(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(200,Parent,LS)), + P3 = spawn(mktmofun(1200,Parent,LS)), + P4 = spawn(mktmofun(600,Parent,LS)), + P5 = spawn(mktmofun(400,Parent,LS)), + P6 = spawn(mktmofun(800,Parent,LS)), + P7 = spawn(mktmofun(1600,Parent,LS)), + P8 = spawn(mktmofun(1400,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P2,{error,timeout}},{P5,{error,timeout}}, + {P4,{error,timeout}},{P6,{error,timeout}}, + {P1,{error,timeout}},{P3,{error,timeout}}, + {P8,{error,timeout}},{P7,{error,timeout}}],infinity,2000). accept_timeouts_mixed(suite) -> []; accept_timeouts_mixed(doc) -> ["Check that multi-accept timeouts behave correctly when mixed with successful timeouts"]; accept_timeouts_mixed(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line P1 = spawn(mktmofun(1000,Parent,LS)), - ?line wait_until_accepting(P1,500), - ?line P2 = spawn(mktmofun(2000,Parent,LS)), - ?line wait_until_accepting(P2,500), - ?line P3 = spawn(mktmofun(3000,Parent,LS)), - ?line wait_until_accepting(P3,500), - ?line P4 = spawn(mktmofun(4000,Parent,LS)), - ?line wait_until_accepting(P4,500), - ?line ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],1500), - ?line {ok,_}=gen_tcp:connect("localhost",PortNo,[]), - ?line ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),100), - ?line ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],2000), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),100). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + P1 = spawn(mktmofun(1000,Parent,LS)), + wait_until_accepting(P1,500), + P2 = spawn(mktmofun(2000,Parent,LS)), + wait_until_accepting(P2,500), + P3 = spawn(mktmofun(3000,Parent,LS)), + wait_until_accepting(P3,500), + P4 = spawn(mktmofun(4000,Parent,LS)), + wait_until_accepting(P4,500), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],infinity,1500), + {ok,_}=gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),infinity,100), + ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],infinity,2000), + gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100). killing_acceptor(suite) -> []; killing_acceptor(doc) -> ["Check that single acceptor behaves as expected when killed"]; killing_acceptor(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L2), + {ok,LS}=gen_tcp:listen(0,[]), + Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + false = lists:member(accepting, L2), ok. killing_multi_acceptors(suite) -> @@ -1838,26 +1892,24 @@ killing_multi_acceptors(suite) -> killing_multi_acceptors(doc) -> ["Check that multi acceptors behaves as expected when killed"]; killing_multi_acceptors(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = mktmofun(1000,Parent,LS), - ?line Pid = spawn(F), - ?line Pid2 = spawn(F2), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L2), - ?line ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1000), - ?line {ok,L3} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L3), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = mktmofun(1000,Parent,LS), + Pid = spawn(F), + Pid2 = spawn(F2), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + true = lists:member(accepting, L2), + ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1,1000), + {ok,L3} = prim_inet:getstatus(LS), + false = lists:member(accepting, L3), ok. killing_multi_acceptors2(suite) -> @@ -1865,40 +1917,36 @@ killing_multi_acceptors2(suite) -> killing_multi_acceptors2(doc) -> ["Check that multi acceptors behaves as expected when killed (more)"]; killing_multi_acceptors2(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = mktmofun(1000,Parent,LS), - ?line Pid = spawn(F), - ?line Pid2 = spawn(F), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L2), - ?line exit(Pid2,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L3} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L3), - ?line Pid3 = spawn(F2), - ?line receive after 100 -> - ok - end, - ?line {ok,L4} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L4), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),100), - ?line {ok,L5} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L5), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = mktmofun(1000,Parent,LS), + Pid = spawn(F), + Pid2 = spawn(F), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + true = lists:member(accepting, L2), + exit(Pid2,kill), + receive after 100 -> ok + end, + {ok,L3} = prim_inet:getstatus(LS), + false = lists:member(accepting, L3), + Pid3 = spawn(F2), + receive after 100 -> ok + end, + {ok,L4} = prim_inet:getstatus(LS), + true = lists:member(accepting, L4), + gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),1,100), + {ok,L5} = prim_inet:getstatus(LS), + false = lists:member(accepting, L5), ok. several_accepts_in_one_go(suite) -> @@ -1907,33 +1955,19 @@ several_accepts_in_one_go(doc) -> ["checks that multi-accept works when more than one accept can be " "done at once (wb test of inet_driver)"]; several_accepts_in_one_go(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line ok = ?EXPECT_ACCEPTS([],500), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],15000), - ?line ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, + Ns = lists:seq(1,8), + _ = [spawn(F1) || _ <- Ns], + ok = ?EXPECT_ACCEPTS([],1,500), % wait for tmo + _ = [spawn(F2) || _ <- Ns], + ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],8,15000), + ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), ok. - flush(Msgs) -> erlang:yield(), receive Msg -> flush([Msg|Msgs]) @@ -1968,13 +2002,13 @@ accept_system_limit(doc) -> ["Check that accept returns {error, system_limit} " "(and not {error, enfile}) when running out of ports"]; accept_system_limit(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, []), - ?line {ok, TcpPort} = inet:port(LS), + {ok, LS} = gen_tcp:listen(0, []), + {ok, TcpPort} = inet:port(LS), Me = self(), - ?line Connector = spawn_link(fun () -> connector(TcpPort, Me) end), + Connector = spawn_link(fun () -> connector(TcpPort, Me) end), receive {Connector, sync} -> Connector ! {self(), continue} end, - ?line ok = acceptor(LS, false, []), - ?line Connector ! stop, + ok = acceptor(LS, false, []), + Connector ! stop, ok. acceptor(LS, GotSL, A) -> @@ -2021,49 +2055,49 @@ active_once_closed(doc) -> ["Check that active once and tcp_close messages behave as expected"]; active_once_closed(Config) when is_list(Config) -> (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,false}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end, - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end + ok = inet:setopts(A,[{active,false}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end, + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end end)(). send_timeout(suite) -> @@ -2072,10 +2106,10 @@ send_timeout(doc) -> ["Test the send_timeout socket option"]; send_timeout(Config) when is_list(Config) -> %% Basic - BasicFun = + BasicFun = fun(AutoClose) -> - ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), - ?line {error,timeout} = + {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + {error,timeout} = Loop(fun() -> Res = gen_tcp:send(A,<<1:10000>>), %%erlang:display(Res), @@ -2083,64 +2117,63 @@ send_timeout(Config) when is_list(Config) -> end), %% Check that the socket is not busy/closed... Error = after_send_timeout(AutoClose), - ?line {error,Error} = gen_tcp:send(A,<<"Hej">>), - ?line test_server:stop_node(RNode) + {error,Error} = gen_tcp:send(A,<<"Hej">>), + test_server:stop_node(RNode) end, BasicFun(false), BasicFun(true), %% Check timeout length - ?line Self = self(), - ?line Pid = - spawn(fun() -> - {Loop,A,RNode} = setup_timeout_sink(1000, true), - {error,timeout} = - Loop(fun() -> - Res = gen_tcp:send(A,<<1:10000>>), - %%erlang:display(Res), - Self ! Res, - Res - end), - test_server:stop_node(RNode) - end), - ?line Diff = get_max_diff(), - ?line io:format("Max time for send: ~p~n",[Diff]), - ?line true = (Diff > 500) and (Diff < 1500), + Self = self(), + Pid = spawn(fun() -> + {Loop,A,RNode} = setup_timeout_sink(1000, true), + {error,timeout} = Loop(fun() -> + Res = gen_tcp:send(A,<<1:10000>>), + %%erlang:display(Res), + Self ! Res, + Res + end), + test_server:stop_node(RNode) + end), + Diff = get_max_diff(), + io:format("Max time for send: ~p~n",[Diff]), + true = (Diff > 500) and (Diff < 1500), %% Let test_server slave die... - ?line Mon = erlang:monitor(process, Pid), - ?line receive {'DOWN',Mon,process,Pid,_} -> ok end, + Mon = erlang:monitor(process, Pid), + receive {'DOWN',Mon,process,Pid,_} -> ok end, %% Check that parallell writers do not hang forever - ParaFun = + ParaFun = fun(AutoClose) -> - ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), SenderFun = fun() -> - {error,Error} = + {error,Error} = Loop(fun() -> gen_tcp:send(A, <<1:10000>>) end), Self ! {error,Error} end, - ?line spawn_link(SenderFun), - ?line spawn_link(SenderFun), - ?line receive - {error,timeout} -> ok - after 10000 -> - ?line exit(timeout) - end, + spawn_link(SenderFun), + spawn_link(SenderFun), + receive + {error,timeout} -> ok + after 10000 -> + exit(timeout) + end, NextErr = after_send_timeout(AutoClose), - ?line receive - {error,NextErr} -> ok - after 10000 -> - ?line exit(timeout) - end, - ?line {error,NextErr} = gen_tcp:send(A,<<"Hej">>), - ?line test_server:stop_node(RNode) + receive + {error,NextErr} -> ok + after 10000 -> + exit(timeout) + end, + {error,NextErr} = gen_tcp:send(A,<<"Hej">>), + test_server:stop_node(RNode) end, ParaFun(false), ParaFun(true), ok. + mad_sender(S) -> - {_, _, USec} = now(), - case gen_tcp:send(S, integer_to_list(USec)) of + U = rand:uniform(1000000), + case gen_tcp:send(S, integer_to_list(U)) of ok -> mad_sender(S); Err -> @@ -2166,25 +2199,25 @@ send_timeout_active(Config) when is_list(Config) -> %% Basic BasicFun = fun(AutoClose) -> - ?line {Loop,A,RNode,C} = setup_active_timeout_sink(1, AutoClose), + {Loop,A,RNode,C} = setup_active_timeout_sink(1, AutoClose), inet:setopts(A, [{active, once}]), - ?line Mad = spawn_link(RNode,fun() -> mad_sender(C) end), - ?line {error,timeout} = - Loop(fun() -> - receive - {tcp, _Sock, _Data} -> - inet:setopts(A, [{active, once}]), - Res = gen_tcp:send(A,lists:duplicate(1000, $a)), - %erlang:display(Res), - Res; - Err -> - io:format("sock closed: ~p~n", [Err]), - Err - end - end), - unlink(Mad), + Mad = spawn_link(RNode,fun() -> mad_sender(C) end), + {error,timeout} = + Loop(fun() -> + receive + {tcp, _Sock, _Data} -> + inet:setopts(A, [{active, once}]), + Res = gen_tcp:send(A,lists:duplicate(1000, $a)), + %erlang:display(Res), + Res; + Err -> + io:format("sock closed: ~p~n", [Err]), + Err + end + end), + unlink(Mad), exit(Mad,kill), - ?line test_server:stop_node(RNode) + test_server:stop_node(RNode) end, BasicFun(false), flush(), @@ -2208,10 +2241,10 @@ get_max_diff() -> end. get_max_diff(Max) -> - T1 = millistamp(), + T1 = millis(), receive ok -> - Diff = millistamp() - T1, + Diff = millis() - T1, if Diff > Max -> get_max_diff(Diff); @@ -2219,7 +2252,7 @@ get_max_diff(Max) -> get_max_diff(Max) end; {error,timeout} -> - Diff = millistamp() - T1, + Diff = millis() - T1, if Diff > Max -> Diff; @@ -2227,29 +2260,29 @@ get_max_diff(Max) -> Max end after 10000 -> - exit(timeout) + exit(timeout) end. setup_closed_ao() -> Dir = filename:dirname(code:which(?MODULE)), {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), + [{args,"-pa " ++ Dir}]), Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}]), - Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), {ok, Port} = inet:port(L), - Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end - end, + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end + end, {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, [{active,false},{packet,2}]) @@ -2257,113 +2290,109 @@ setup_closed_ao() -> {ok,A} = gen_tcp:accept(L), gen_tcp:send(A,"Hello"), {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), - ok = Remote(fun() -> gen_tcp:close(C) end), - Loop2 = fun(_,_,_,0) -> + ok = Remote(fun() -> gen_tcp:close(C) end), + Loop2 = fun(_,_,_,0) -> {failure, timeout}; - (L2,{MA,MB},F2,N) -> - case F2() of - MA -> MA; - MB -> MB; - Other -> io:format("~p~n",[Other]), - receive after 1000 -> ok end, - L2(L2,{MA,MB},F2,N-1) - end + (L2,{MA,MB},F2,N) -> + case F2() of + MA -> MA; + MB -> MB; + Other -> io:format("~p~n",[Other]), + receive after 1000 -> ok end, + L2(L2,{MA,MB},F2,N-1) + end end, Loop = fun(Match2,F3) -> Loop2(Loop2,Match2,F3,10) end, test_server:stop_node(R), {Loop,A}. setup_timeout_sink(Timeout, AutoClose) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), - ?line Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), - ?line {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, {send_timeout,Timeout}, {send_timeout_close,AutoClose}]), - ?line Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, - ?line Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), - ?line {ok, Port} = inet:port(L), - ?line Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end end, - ?line {ok, C} = Remote(fun() -> + {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, - [{active,false},{packet,2}]) + [{active,false},{packet,2}]) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line gen_tcp:send(A,"Hello"), - ?line {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), - ?line Loop2 = fun(_,_,0) -> - {failure, timeout}; - (L2,F2,N) -> + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> Ret = F2(), io:format("~p~n",[Ret]), case Ret of - ok -> receive after 1 -> ok end, + ok -> receive after 1 -> ok end, L2(L2,F2,N-1); Other -> Other - end + end end, - ?line Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, {Loop,A,R}. setup_active_timeout_sink(Timeout, AutoClose) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), - ?line Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), - ?line {ok, L} = gen_tcp:listen(0, [binary,{active,false},{packet,0},{nodelay, true},{keepalive, true}, + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [binary,{active,false},{packet,0},{nodelay, true},{keepalive, true}, {send_timeout,Timeout}, {send_timeout_close,AutoClose}]), - ?line Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, - ?line Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), - ?line {ok, Port} = inet:port(L), - ?line Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end end, - ?line {ok, C} = Remote(fun() -> + {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, - [{active,false}]) + [{active,false}]) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line gen_tcp:send(A,"Hello"), - ?line {ok, "H"++_} = Remote(fun() -> gen_tcp:recv(C,0) end), - ?line Loop2 = fun(_,_,0) -> - {failure, timeout}; - (L2,F2,N) -> + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "H"++_} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> Ret = F2(), io:format("~p~n",[Ret]), case Ret of - ok -> receive after 1 -> ok end, + ok -> receive after 1 -> ok end, L2(L2,F2,N-1); Other -> Other - end + end end, - ?line Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, {Loop,A,R,C}. -millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. - has_superfluous_schedulers() -> case {erlang:system_info(schedulers), erlang:system_info(logical_processors)} of @@ -2378,22 +2407,22 @@ otp_7731(doc) -> "Leaking message from inet_drv {inet_reply,P,ok} " "when a socket sending resumes working after a send_timeout"; otp_7731(Config) when is_list(Config) -> - ?line ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), - ?line receive {ServerPid, ready, PortNum} -> ok end, + ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), + receive {ServerPid, ready, PortNum} -> ok end, - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, raw}, - {send_timeout, 1000}]), + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}, + {send_timeout, 1000}]), otp_7731_send(Socket), io:format("Sending complete...\n",[]), ServerPid ! {self(), recv}, - receive {ServerPid, ok} -> ok end, - + receive {ServerPid, ok} -> ok end, + io:format("Client waiting for leaking messages...\n",[]), %% Now make sure inet_drv does not leak any internal messages. receive Msg -> - ?line test_server:fail({unexpected, Msg}) + test_server:fail({unexpected, Msg}) after 1000 -> ok end, @@ -2403,15 +2432,15 @@ otp_7731(Config) when is_list(Config) -> otp_7731_send(Socket) -> Bin = <<1:10000>>, io:format("Client sending ~p bytes...\n",[size(Bin)]), - ?line case gen_tcp:send(Socket, Bin) of - ok -> otp_7731_send(Socket); - {error,timeout} -> ok - end. + case gen_tcp:send(Socket, Bin) of + ok -> otp_7731_send(Socket); + {error,timeout} -> ok + end. otp_7731_server(ClientPid) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, - {active, false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}]), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), ClientPid ! {self(), ready, PortNum}, @@ -2433,7 +2462,7 @@ otp_7731_server(ClientPid) -> otp_7731_recv(Socket) -> - ?line case gen_tcp:recv(Socket, 0, 1000) of + case gen_tcp:recv(Socket, 0, 1000) of {ok, Bin} -> io:format("Server received ~p bytes\n",[size(Bin)]), otp_7731_recv(Socket); @@ -2452,21 +2481,21 @@ zombie_sockets(Config) when is_list(Config) -> register(zombie_collector,self()), Calls = 10, Server = spawn_link(?MODULE, zombie_server,[self(), Calls]), - ?line {Server, ready, PortNum} = receive Msg -> Msg end, + {Server, ready, PortNum} = receive Msg -> Msg end, io:format("Ports before = ~p\n",[lists:sort(erlang:ports())]), zombie_client_loop(Calls, PortNum), Ports = lists:sort(zombie_collector(Calls,[])), Server ! terminate, io:format("Collected ports = ~p\n",[Ports]), - ?line [] = zombies_alive(Ports, 10), + [] = zombies_alive(Ports, 10), timer:sleep(1000), ok. zombie_client_loop(0, _) -> ok; zombie_client_loop(N, PortNum) when is_integer(PortNum) -> - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, raw}]), - ?line gen_tcp:close(Socket), % to make server recv fail + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}]), + gen_tcp:close(Socket), % to make server recv fail zombie_client_loop(N-1, PortNum). @@ -2495,19 +2524,19 @@ zombies_alive(Ports, WaitSec) -> end. zombie_server(Pid, Calls) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, - {active, false}, {backlog, Calls}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}, {backlog, Calls}]), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), BigBin = list_to_binary(lists:duplicate(100*1024, 77)), Pid ! {self(), ready, PortNum}, zombie_accept_loop(LSocket, BigBin, Calls), - ?line terminate = receive Msg -> Msg end. + terminate = receive Msg -> Msg end. zombie_accept_loop(_, _, 0) -> ok; zombie_accept_loop(Socket, BigBin, Calls) -> - ?line case gen_tcp:accept(Socket) of + case gen_tcp:accept(Socket) of {ok, NewSocket} -> spawn_link(fun() -> zombie_serve_client(NewSocket, BigBin) end), zombie_accept_loop(Socket, BigBin, Calls-1); @@ -2517,29 +2546,27 @@ zombie_accept_loop(Socket, BigBin, Calls) -> zombie_serve_client(Socket, Bin) -> %%io:format("Got connection on ~p\n",[Socket]), - ?line gen_tcp:send(Socket, Bin), + gen_tcp:send(Socket, Bin), %%io:format("Sent data, waiting for reply on ~p\n",[Socket]), - ?line case gen_tcp:recv(Socket, 4) of + case gen_tcp:recv(Socket, 4) of {error,closed} -> ok; {error,econnaborted} -> ok % may be returned on Windows end, %%io:format("Closing ~p\n",[Socket]), - ?line gen_tcp:close(Socket), + gen_tcp:close(Socket), zombie_collector ! {closed, Socket}. - - otp_7816(suite) -> []; otp_7816(doc) -> "Hanging send on windows when sending iolist with more than 16 binaries."; otp_7816(Config) when is_list(Config) -> Client = self(), - ?line Server = spawn_link(fun()-> otp_7816_server(Client) end), - ?line receive {Server, ready, PortNum} -> ok end, + Server = spawn_link(fun()-> otp_7816_server(Client) end), + receive {Server, ready, PortNum} -> ok end, - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, 4}, - {send_timeout, 10}]), + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, 4}, + {send_timeout, 10}]), %% We use the undocumented feature that sending can be resumed after %% a send_timeout without any data loss if the peer starts to receive data. %% Unless of course the 7816-bug is in affect, in which case the write event @@ -2549,9 +2576,9 @@ otp_7816(Config) when is_list(Config) -> io:format("Sending complete...\n",[]), - ?line ok = gen_tcp:close(Socket), + ok = gen_tcp:close(Socket), Server ! {self(), closed}, - ?line {Server, closed} = receive M -> M end. + {Server, closed} = receive M -> M end. otp_7816_send(Socket, BinNr, BinSize, Server) -> @@ -2559,7 +2586,7 @@ otp_7816_send(Socket, BinNr, BinSize, Server) -> SentBytes = otp_7816_send_data(Socket, Data, 0) * BinNr * BinSize, io:format("Client sent ~p bytes...\n",[SentBytes]), Server ! {self(),recv,SentBytes}, - ?line {Server, ok} = receive M -> M end. + {Server, ok} = receive M -> M end. @@ -2574,15 +2601,15 @@ otp_7816_send_data(Socket, Data, Loops) -> otp_7816_server(Client) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, {active, false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), Client ! {self(), ready, PortNum}, - ?line {ok, CSocket} = gen_tcp:accept(LSocket), + {ok, CSocket} = gen_tcp:accept(LSocket), io:format("Server got connection...\n",[]), - ?line gen_tcp:close(LSocket), + gen_tcp:close(LSocket), otp_7816_server_loop(CSocket), @@ -2596,13 +2623,13 @@ otp_7816_server_loop(CSocket) -> {Client, recv, RecvBytes} -> io:format("Server start receiving...\n",[]), - ?line ok = otp_7816_recv(CSocket, RecvBytes), + ok = otp_7816_recv(CSocket, RecvBytes), Client ! {self(), ok}, otp_7816_server_loop(CSocket); {Client, closed} -> - ?line {error, closed} = gen_tcp:recv(CSocket, 0, 1000), + {error, closed} = gen_tcp:recv(CSocket, 0, 1000), Client ! {self(), closed} end. @@ -2611,7 +2638,7 @@ otp_7816_recv(_, 0) -> io:format("Server got all.\n",[]), ok; otp_7816_recv(CSocket, BytesLeft) -> - ?line case gen_tcp:recv(CSocket, 0, 1000) of + case gen_tcp:recv(CSocket, 0, 1000) of {ok, Bin} when byte_size(Bin) =< BytesLeft -> io:format("Server received ~p of ~p bytes.\n",[size(Bin), BytesLeft]), otp_7816_recv(CSocket, BytesLeft - byte_size(Bin)); @@ -2623,8 +2650,8 @@ otp_7816_recv(CSocket, BytesLeft) -> otp_8102(doc) -> ["Receive a packet with a faulty packet header"]; otp_8102(suite) -> []; otp_8102(Config) when is_list(Config) -> - ?line {ok, LSocket} = gen_tcp:listen(0, []), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, []), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), [otp_8102_do(LSocket, PortNum, otp_8102_packet(Type,Size)) @@ -2644,18 +2671,18 @@ otp_8102_packet({cdr,little}, Size) -> otp_8102_do(LSocket, PortNum, {Bin,PType}) -> io:format("Connect with packet option ~p ...\n",[PType]), - ?line {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, + {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, {packet,PType}, {active,true}]), - ?line {ok, SSocket} = gen_tcp:accept(LSocket), + {ok, SSocket} = gen_tcp:accept(LSocket), io:format("Got connection, sending ~p...\n",[Bin]), - ?line ok = gen_tcp:send(SSocket, Bin), + ok = gen_tcp:send(SSocket, Bin), io:format("Sending complete...\n",[]), - ?line {tcp_error,RSocket,emsgsize} = receive M -> M end, + {tcp_error,RSocket,emsgsize} = receive M -> M end, io:format("Got error msg, ok.\n",[]), gen_tcp:close(SSocket), @@ -2664,61 +2691,61 @@ otp_8102_do(LSocket, PortNum, {Bin,PType}) -> otp_9389(doc) -> ["Verify packet_size handles long HTTP header lines"]; otp_9389(suite) -> []; otp_9389(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, [{active,false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LS), + {ok, LS} = gen_tcp:listen(0, [{active,false}]), + {ok, {_, PortNum}} = inet:sockname(LS), io:format("Listening on ~w with port number ~p\n", [LS, PortNum]), OrigLinkHdr = "/" ++ string:chars($S, 8192), _Server = spawn_link( fun() -> - ?line {ok, S} = gen_tcp:accept(LS), - ?line ok = inet:setopts(S, [{packet_size, 16384}]), - ?line ok = otp_9389_loop(S, OrigLinkHdr), - ?line ok = gen_tcp:close(S) + {ok, S} = gen_tcp:accept(LS), + ok = inet:setopts(S, [{packet_size, 16384}]), + ok = otp_9389_loop(S, OrigLinkHdr), + ok = gen_tcp:close(S) end), - ?line {ok, S} = gen_tcp:connect("localhost", PortNum, + {ok, S} = gen_tcp:connect("localhost", PortNum, [binary, {active, false}]), Req = "GET / HTTP/1.1\r\n" ++ "Host: localhost\r\n" ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", - ?line ok = gen_tcp:send(S, Req), - ?line ok = inet:setopts(S, [{packet, http}]), - ?line {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), - ?line ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), - ?line {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), - ?line {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), - ?line true = (LinkHdr == OrigLinkHdr), + ok = gen_tcp:send(S, Req), + ok = inet:setopts(S, [{packet, http}]), + {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), + ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), + {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), + {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), + true = (LinkHdr == OrigLinkHdr), ok = gen_tcp:close(S), ok = gen_tcp:close(LS), ok. otp_9389_loop(S, OrigLinkHdr) -> - ?line ok = inet:setopts(S, [{active,once},{packet,http}]), + ok = inet:setopts(S, [{active,once},{packet,http}]), receive {http, S, {http_request, 'GET', _, _}} -> - ?line ok = otp_9389_loop(S, OrigLinkHdr, undefined) + ok = otp_9389_loop(S, OrigLinkHdr, undefined) after 3000 -> - ?line error({timeout,request_line}) + error({timeout,request_line}) end. otp_9389_loop(S, OrigLinkHdr, ok) -> - ?line Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ + Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", - ?line ok = gen_tcp:send(S, Resp); + ok = gen_tcp:send(S, Resp); otp_9389_loop(S, OrigLinkHdr, State) -> - ?line ok = inet:setopts(S, [{active,once}, {packet,httph}]), + ok = inet:setopts(S, [{active,once}, {packet,httph}]), receive {http, S, http_eoh} -> - ?line otp_9389_loop(S, OrigLinkHdr, ok); + otp_9389_loop(S, OrigLinkHdr, ok); {http, S, {http_header, _, "Link", _, LinkHdr}} -> - ?line LinkHdr = OrigLinkHdr, - ?line otp_9389_loop(S, OrigLinkHdr, State); + LinkHdr = OrigLinkHdr, + otp_9389_loop(S, OrigLinkHdr, State); {http, S, {http_header, _, _Hdr, _, _Val}} -> - ?line otp_9389_loop(S, OrigLinkHdr, State); + otp_9389_loop(S, OrigLinkHdr, State); {http, S, {http_error, Err}} -> - ?line error({error, Err}) + error({error, Err}) after 3000 -> - ?line error({timeout,header}) + error({timeout,header}) end. wrapping_oct(doc) -> @@ -2729,7 +2756,7 @@ wrapping_oct(Config) when is_list(Config) -> {ok,Sock} = gen_tcp:listen(0,[{active,false},{mode,binary}]), {ok,Port} = inet:port(Sock), spawn_link(?MODULE,oct_acceptor,[Sock]), - Res = oct_datapump(Port,16#1FFFFFFFF), + Res = oct_datapump(Port,16#10000FFFF), gen_tcp:close(Sock), ok = Res, ok. diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 3fb7c68886..89c574b025 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -718,8 +718,7 @@ toerl_loop(Port,Acc) -> end. millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. + erlang:monotonic_time(milli_seconds). get_data_within(Port, X, Acc) when X =< 0 -> ?dbg({get_data_within, X, Acc, ?LINE}), diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index 7adef49014..867b448b36 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -456,32 +456,33 @@ called_throws(Config) when is_list(Config) -> call_benchmark(Config) when is_list(Config) -> Timetrap = ?t:timetrap(?t:seconds(120)), - ?line PA = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, - [{args, "-pa " ++ PA}]), + PA = filename:dirname(code:which(?MODULE)), + {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, + [{args, "-pa " ++ PA}]), Iter = case erlang:system_info(modified_timing_level) of undefined -> 10000; - _ -> 500 %Moified timing - spawn is slower + _ -> 500 %Modified timing - spawn is slower end, - ?line do_call_benchmark(Node, Iter), + Res = do_call_benchmark(Node, Iter), + ?t:stop_node(Node), ?t:timetrap_cancel(Timetrap), - ok. + Res. do_call_benchmark(Node, M) when is_integer(M), M > 0 -> - do_call_benchmark(Node, erlang:now(), 0, M). - -do_call_benchmark(Node, {A,B,C}, M, M) -> - ?line {D,E,F} = erlang:now(), - ?line T = float(D-A)*1000000.0 + float(E-B) + float(F-C)*0.000001, - ?line Q = 3.0 * float(M) / T, - ?line ?t:stop_node(Node), - {comment, - lists:flatten([float_to_list(Q)," RPC calls per second"])}; -do_call_benchmark(Node, Then, I, M) -> - ?line Node = rpc:call(Node, erlang, node, []), - ?line _ = rpc:call(Node, erlang, whereis, [rex]), - ?line 3 = rpc:call(Node, erlang, '+', [1,2]), - ?line do_call_benchmark(Node, Then, I+1, M). + {Micros,ok} = timer:tc(fun() -> + do_call_benchmark(Node, 0, M) + end), + Calls = 3*M, + S = io_lib:format("~p RPC calls/second", [Calls*1000000 div Micros]), + {comment,lists:flatten(S)}. + +do_call_benchmark(_Node, M, M) -> + ok; +do_call_benchmark(Node, I, M) -> + Node = rpc:call(Node, erlang, node, []), + _ = rpc:call(Node, erlang, whereis, [rex]), + 3 = rpc:call(Node, erlang, '+', [1,2]), + do_call_benchmark(Node, I+1, M). async_call(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(120)), diff --git a/lib/megaco/doc/src/megaco.xml b/lib/megaco/doc/src/megaco.xml index dff1c3afc6..0a8dfe8a13 100644 --- a/lib/megaco/doc/src/megaco.xml +++ b/lib/megaco/doc/src/megaco.xml @@ -336,7 +336,7 @@ megaco_incr_timer() = #megaco_incr_timer{} <tag><c><![CDATA[request_keep_alive_timeout]]></c></tag> <item> <p>Specifies the timeout time for the request-keep-alive timer. </p> - <p>This timer is started when the <em>first</em> reply to an asynchroneous + <p>This timer is started when the <em>first</em> reply to an asynchronous request (issued using the <seealso marker="megaco#cast">megaco:cast/3</seealso> function) arrives. As long as this timer is running, replies will @@ -837,7 +837,7 @@ megaco_incr_timer() = #megaco_incr_timer{} <tag><c><![CDATA[request_keep_alive_timeout]]></c></tag> <item> <p>Specifies the timeout time for the request-keep-alive timer. </p> - <p>This timer is started when the <em>first</em> reply to an asynchroneous + <p>This timer is started when the <em>first</em> reply to an asynchronous request (issued using the <seealso marker="megaco#cast">megaco:cast/3</seealso> function) arrives. As long as this timer is running, replies will diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 21ad0ffdb6..8620949dc0 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -349,6 +349,8 @@ open_log(Name, Header, Fname, Exists, Repair, Mode) -> mnesia_lib:important("Data may be missing, log ~p repaired: Lost ~p bytes~n", [Fname, BadBytes]), Log; + {error, Reason = {file_error, _Fname, emfile}} -> + fatal("Cannot open log file ~p: ~p~n", [Fname, Reason]); {error, Reason} when Repair == true -> file:delete(Fname), mnesia_lib:important("Data may be missing, Corrupt logfile deleted: ~p, ~p ~n", diff --git a/lib/observer/doc/src/crashdump_ug.xml b/lib/observer/doc/src/crashdump_ug.xml index d22fb4cc40..ccd4d8a5b3 100644 --- a/lib/observer/doc/src/crashdump_ug.xml +++ b/lib/observer/doc/src/crashdump_ug.xml @@ -228,20 +228,17 @@ <p>The <em>ETS Tables</em> panel shows all ETS table information found in the dump. The 'Id' is the same as the 'Table' field found in the raw crashdump, and 'Memory' is the 'Words' field from the - raw crashdump translated into bytes. 'Type' is the type of table, - and it can be either "hash" or "tree". For tree tables there will - be no value in the 'Bucket' field.</p> + raw crashdump translated into bytes. For tree tables there will + be no value in the 'Objects' field.</p> + + <p>To open the detailed information page about the table, double + click or right click the row and select "Properties for + 'Identifier'".</p> <p>To open the detailed information page about the owner process of an ETS table, right click the row and select "Properties for <pid>".</p> - <p>Double clicking a row in the ETS Tables panel has no - effect.</p> - - <p>From the left hand menu you can also select to see internal ETS - tables.</p> - <p> <seealso marker="erts:crash_dump#ets_tables"> More...</seealso> @@ -267,6 +264,22 @@ </section> <section> + <marker id="schedulers"/> + <title>Schedulers</title> + + <p>The <em>Schedulers</em> panel shows all scheduler information + found in the dump.</p> + + <p>To open the detailed information page about the scheduler, + double click or right click the row and select "Properties for + 'Identifier'".</p> + + <p> + <seealso marker="erts:crash_dump">More...</seealso> + </p> + </section> + + <section> <marker id="funs"/> <title>Funs</title> diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index a42967644a..8c6606d0a6 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -51,6 +51,7 @@ MODULES= \ cdv_multi_wx \ cdv_port_cb \ cdv_proc_cb \ + cdv_sched_cb \ cdv_table_wx \ cdv_term_cb \ cdv_timer_cb \ diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index d5fbceff1e..8b427e92b7 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -17,14 +17,14 @@ %% %CopyrightEnd% -module(cdv_bin_cb). --export([get_details/1, +-export([get_details/2, detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({Type, {T,Key}}) -> +get_details({Type, {T,Key}}, _) -> [{Key,Term}] = ets:lookup(T,Key), {ok,{"Expanded Binary", {Type, Term}, []}}; -get_details({cdv, Id}) -> +get_details({cdv, Id}, _) -> {ok,Bin} = crashdump_viewer:expand_binary(Id), {ok,{"Expanded Binary", {cvd, Bin}, []}}. diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index dc93507a36..ec0d877d87 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -19,7 +19,7 @@ -behaviour(wx_object). --export([start_link/3]). +-export([start_link/4]). -export([init/1, handle_event/2, handle_cast/2, terminate/2, code_change/3, handle_call/3, handle_info/2]). @@ -38,13 +38,13 @@ -define(ID_NOTEBOOK, 604). %% Detail view -start_link(Id, ParentFrame, Callback) -> - wx_object:start_link(?MODULE, [Id, ParentFrame, Callback, self()], []). +start_link(Id, Data, ParentFrame, Callback) -> + wx_object:start_link(?MODULE, [Id, Data, ParentFrame, Callback, self()], []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([Id, ParentFrame, Callback, Parent]) -> - case Callback:get_details(Id) of +init([Id, Data, ParentFrame, Callback, Parent]) -> + case Callback:get_details(Id, Data) of {ok,Details} -> init(Id,ParentFrame,Callback,Parent,Details); {yes_no, Info, Fun} -> diff --git a/lib/observer/src/cdv_dist_cb.erl b/lib/observer/src/cdv_dist_cb.erl index f7e6c9aded..f45fb1f524 100644 --- a/lib/observer/src/cdv_dist_cb.erl +++ b/lib/observer/src/cdv_dist_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -55,10 +55,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_CH,?COL_CTRL],true}. + {[{node, ?COL_CH},{port,?COL_CTRL}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> case crashdump_viewer:node_info(Id) of {ok,Info,TW} -> Proplist = crashdump_viewer:to_proplist(record_info(fields,nod),Info), diff --git a/lib/observer/src/cdv_ets_cb.erl b/lib/observer/src/cdv_ets_cb.erl index 2a5c170e58..371c7f0b32 100644 --- a/lib/observer/src/cdv_ets_cb.erl +++ b/lib/observer/src/cdv_ets_cb.erl @@ -20,7 +20,10 @@ -export([col_to_elem/1, col_spec/0, get_info/1, - get_detail_cols/1]). + get_details/2, + get_detail_cols/1, + detail_pages/0 + ]). -include_lib("wx/include/wx.hrl"). -include("crashdump_viewer.hrl"). @@ -41,7 +44,7 @@ col_to_elem(?COL_ID) -> #ets_table.id; col_to_elem(?COL_NAME) -> #ets_table.name; col_to_elem(?COL_SLOT) -> #ets_table.slot; col_to_elem(?COL_OWNER) -> #ets_table.pid; -col_to_elem(?COL_TYPE) -> #ets_table.type; +col_to_elem(?COL_TYPE) -> #ets_table.data_type; col_to_elem(?COL_BUCK) -> #ets_table.buckets; col_to_elem(?COL_OBJ) -> #ets_table.size; col_to_elem(?COL_MEM) -> #ets_table.memory. @@ -50,18 +53,68 @@ col_spec() -> [{"Id", ?wxLIST_FORMAT_LEFT, 200}, {"Name", ?wxLIST_FORMAT_LEFT, 200}, {"Slot", ?wxLIST_FORMAT_RIGHT, 50}, - {"Owner", ?wxLIST_FORMAT_CENTRE, 90}, - {"Buckets", ?wxLIST_FORMAT_RIGHT, 50}, - {"Objects", ?wxLIST_FORMAT_RIGHT, 50}, - {"Memory", ?wxLIST_FORMAT_RIGHT, 80}, - {"Type", ?wxLIST_FORMAT_LEFT, 50} + {"Owner", ?wxLIST_FORMAT_CENTRE, 120}, + {"Objects", ?wxLIST_FORMAT_RIGHT, 80}, + {"Memory", ?wxLIST_FORMAT_RIGHT, 80} +% {"Type", ?wxLIST_FORMAT_LEFT, 50} ]. get_info(Owner) -> {ok,Info,TW} = crashdump_viewer:ets_tables(Owner), {Info,TW}. +%% Callbacks for cdv_detail_wx +get_details(_Id, not_found) -> + Info = "The table you are searching for could not be found.", + {info,Info}; +get_details(Id, Data) -> + Proplist = crashdump_viewer:to_proplist(record_info(fields,ets_table),Data), + {ok,{"Table:" ++ Id,Proplist,""}}. + get_detail_cols(all) -> - {[?COL_OWNER],false}; -get_detail_cols(_) -> - {[],false}. + {[{ets, ?COL_ID}, {process, ?COL_OWNER}],true}; +get_detail_cols(_W) -> + {[],true}. + + +%%%%%%%%%%%%%%%%%%%%%%%% + +detail_pages() -> + [{"Table Information", fun init_gen_page/2}]. + +init_gen_page(Parent, Info0) -> + Fields = info_fields(), + Details = proplists:get_value(details, Info0), + Info = if is_map(Details) -> Info0 ++ maps:to_list(Details); + true -> Info0 + end, + cdv_info_wx:start_link(Parent,{Fields,Info,[]}). + +%%% Internal +info_fields() -> + [{"Overview", + [{"Id", id}, + {"Name", name}, + {"Slot", slot}, + {"Owner", owner}, + {"Data Structure", data_type} + ]}, + {"Settings", + [{"Type", type}, + {"Protection", protection}, + {"Compressed", compressed}, + {"Fixed", fixed}, + {"Lock write concurrency", write_c}, + {"Lock read concurrency", read_c} + ]}, + {"Memory Usage", + [{"Buckets", buckets}, + {"Size", size}, + {"Memory", memory}, + {"Min Chain Length", chain_min}, + {"Avg Chain Length", chain_avg}, + {"Max Chain Length", chain_max}, + {"Chain Length Std Dev", chain_stddev}, + {"Chain Length Expected Std Dev", chain_exp_stddev} + ]} + ]. diff --git a/lib/observer/src/cdv_fun_cb.erl b/lib/observer/src/cdv_fun_cb.erl index 689ef0e3bb..067377254a 100644 --- a/lib/observer/src/cdv_fun_cb.erl +++ b/lib/observer/src/cdv_fun_cb.erl @@ -55,4 +55,4 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_MOD],false}. + {[{module, ?COL_MOD}],false}. diff --git a/lib/observer/src/cdv_gen_cb.erl b/lib/observer/src/cdv_gen_cb.erl index 6be717d76d..aa5e7c5182 100644 --- a/lib/observer/src/cdv_gen_cb.erl +++ b/lib/observer/src/cdv_gen_cb.erl @@ -42,4 +42,6 @@ info_fields() -> {"Processes",num_procs}, {"ETS tables",num_ets}, {"Timers",num_timers}, - {"Funs",num_fun}]}]. + {"Funs",num_fun}, + {"Calling Thread", thread} + ]}]. diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index b79c647f63..6d19589f5d 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -126,7 +126,7 @@ expand(Id,Callback,#state{expand_wins=Opened0}=State) -> Opened = case lists:keyfind(Id,1,Opened0) of false -> - EW = cdv_detail_wx:start_link(Id,State#state.panel,Callback), + EW = cdv_detail_wx:start_link(Id,[],State#state.panel,Callback), wx_object:get_pid(EW) ! active, [{Id,EW}|Opened0]; {_,EW} -> diff --git a/lib/observer/src/cdv_mod_cb.erl b/lib/observer/src/cdv_mod_cb.erl index e829ff4fca..8d33f9da9d 100644 --- a/lib/observer/src/cdv_mod_cb.erl +++ b/lib/observer/src/cdv_mod_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -49,10 +49,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID],true}. + {[{module, ?COL_ID}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> {ok,Info,TW} = crashdump_viewer:loaded_mod_details(Id), Proplist = crashdump_viewer:to_proplist(record_info(fields,loaded_mod),Info), Title = io_lib:format("~s",[Info#loaded_mod.mod]), diff --git a/lib/observer/src/cdv_port_cb.erl b/lib/observer/src/cdv_port_cb.erl index 08488d3e34..409431218b 100644 --- a/lib/observer/src/cdv_port_cb.erl +++ b/lib/observer/src/cdv_port_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -57,10 +57,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID,?COL_CONN],true}. + {[{port, ?COL_ID},{process, ?COL_CONN}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _Data) -> case crashdump_viewer:port(Id) of {ok,Info,TW} -> Proplist = @@ -70,7 +70,7 @@ get_details(Id) -> Info = "The port you are searching for was residing on " "a remote node. No port information is available. " "Show information about the remote node?", - Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId) end, + Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId, node) end, {yes_no, Info, Fun}; {error,not_found} -> Info = "The port you are searching for could not be found.", diff --git a/lib/observer/src/cdv_proc_cb.erl b/lib/observer/src/cdv_proc_cb.erl index d1549f79eb..0af6a9c235 100644 --- a/lib/observer/src/cdv_proc_cb.erl +++ b/lib/observer/src/cdv_proc_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0]). -include_lib("wx/include/wx.hrl"). @@ -57,10 +57,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID],true}. + {[{process, ?COL_ID}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> case crashdump_viewer:proc_details(Id) of {ok,Info,TW} -> %% The following table is used by observer_html_lib @@ -76,7 +76,7 @@ get_details(Id) -> Info = "The process you are searching for was residing on " "a remote node. No process information is available. " "Show information about the remote node?", - Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId) end, + Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId, port) end, {yes_no, Info, Fun}; {error,not_found} -> Info = "The process you are searching for could not be found.", @@ -126,11 +126,13 @@ info_fields() -> {dynamic, current_func}, {"Registered Name", name}, {"Status", state}, + {"Internal State", int_state}, {"Started", start_time}, {"Parent", {click,parent}}, {"Message Queue Len",msg_q_len}, {"Run queue", run_queue}, {"Reductions", reds}, + {"Program counter", prog_count}, {"Continuation pointer",cp}, {"Arity",arity}]}, diff --git a/lib/observer/src/cdv_sched_cb.erl b/lib/observer/src/cdv_sched_cb.erl new file mode 100644 index 0000000000..6ef4886c5e --- /dev/null +++ b/lib/observer/src/cdv_sched_cb.erl @@ -0,0 +1,117 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2014. 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(cdv_sched_cb). + +-export([col_to_elem/1, + col_spec/0, + get_info/1, + get_details/2, + get_detail_cols/1, + detail_pages/0 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("crashdump_viewer.hrl"). + +%% Columns +-define(COL_ID, 0). +-define(COL_PROC, ?COL_ID+1). +-define(COL_PORT, ?COL_PROC+1). +-define(COL_RQL, ?COL_PORT+1). +-define(COL_PQL, ?COL_RQL+1). + +%% Callbacks for cdv_virtual_list_wx +col_to_elem(id) -> col_to_elem(?COL_ID); +col_to_elem(?COL_ID) -> #sched.name; +col_to_elem(?COL_PROC) -> #sched.process; +col_to_elem(?COL_PORT) -> #sched.port; +col_to_elem(?COL_RQL) -> #sched.run_q; +col_to_elem(?COL_PQL) -> #sched.port_q. + +col_spec() -> + [{"Id", ?wxLIST_FORMAT_RIGHT, 50}, + {"Current Process", ?wxLIST_FORMAT_CENTER, 130}, + {"Current Port", ?wxLIST_FORMAT_CENTER, 130}, + {"Run Queue Length", ?wxLIST_FORMAT_RIGHT, 180}, + {"Port Queue Length", ?wxLIST_FORMAT_RIGHT, 180}]. + +get_info(_) -> + {ok,Info,TW} = crashdump_viewer:schedulers(), + {Info,TW}. + +get_details(_Id, not_found) -> + Info = "The scheduler you are searching for could not be found.", + {info,Info}; +get_details(Id, Data) -> + Proplist = crashdump_viewer:to_proplist(record_info(fields,sched),Data), + {ok,{"Scheduler: " ++ Id,Proplist,""}}. + +get_detail_cols(all) -> + {[{sched, ?COL_ID}, {process, ?COL_PROC}, {process, ?COL_PORT}],true}; +get_detail_cols(_) -> + {[],false}. + +%%%%%%%%%%%%%%%%%%%%%%%% + +detail_pages() -> + [{"Scheduler Information", fun init_gen_page/2}]. + +init_gen_page(Parent, Info0) -> + Fields = info_fields(), + Details = proplists:get_value(details, Info0), + Info = if is_map(Details) -> Info0 ++ maps:to_list(Details); + true -> Info0 + end, + cdv_info_wx:start_link(Parent,{Fields,Info,[]}). + +%%% Internal +info_fields() -> + [{"Scheduler Overview", + [{"Id", id}, + {"Current Process",process}, + {"Current Port", port}, + {"Sleep Info Flags", sleep_info}, + {"Sleep Aux Work", sleep_aux} + ]}, + {"Run Queues", + [{"Flags", runq_flags}, + {"Priority Max Length", runq_max}, + {"Priority High Length", runq_high}, + {"Priority Normal Length", runq_norm}, + {"Priority Low Length", runq_low}, + {"Port Length", port_q} + ]}, + {"Current Process", + [{"State", currp_state}, + {"Internal State", currp_int_state}, + {"Program Counter", currp_prg_cnt}, + {"CP", currp_cp}, + {"Stack", {currp_stack, 0}}, + {" ", {currp_stack, 1}}, + {" ", {currp_stack, 2}}, + {" ", {currp_stack, 3}}, + {" ", {currp_stack, 4}}, + {" ", {currp_stack, 5}}, + {" ", {currp_stack, 6}}, + {" ", {currp_stack, 7}}, + {" ", {currp_stack, 8}}, + {" ", {currp_stack, 9}}, + {" ", {currp_stack, 10}}, + {" ", {currp_stack, 11}} + ]} + ]. diff --git a/lib/observer/src/cdv_term_cb.erl b/lib/observer/src/cdv_term_cb.erl index 4451045012..6db6d54514 100644 --- a/lib/observer/src/cdv_term_cb.erl +++ b/lib/observer/src/cdv_term_cb.erl @@ -17,11 +17,11 @@ %% %CopyrightEnd% -module(cdv_term_cb). --export([get_details/1, +-export([get_details/2, detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({Type, {T,Key}}) -> +get_details({Type, {T,Key}}, _) -> [{Key,Term}] = ets:lookup(T,Key), {ok,{"Expanded Term", {Type,[Term, T]}, []}}. diff --git a/lib/observer/src/cdv_timer_cb.erl b/lib/observer/src/cdv_timer_cb.erl index d44592cf18..b4564941ea 100644 --- a/lib/observer/src/cdv_timer_cb.erl +++ b/lib/observer/src/cdv_timer_cb.erl @@ -49,6 +49,6 @@ get_info(Owner) -> {Info,TW}. get_detail_cols(all) -> - {[?COL_OWNER],false}; + {[{process, ?COL_OWNER}],false}; get_detail_cols(_) -> {[],false}. diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl index bfe115a42e..c0bc7018cb 100644 --- a/lib/observer/src/cdv_virtual_list_wx.erl +++ b/lib/observer/src/cdv_virtual_list_wx.erl @@ -19,7 +19,8 @@ -behaviour(wx_object). --export([start_link/2, start_link/3, start_detail_win/1]). +-export([start_link/2, start_link/3, + start_detail_win/1, start_detail_win/2]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -65,22 +66,31 @@ start_link(ParentWin, Callback, Owner) -> wx_object:start_link(?MODULE, [ParentWin, Callback, Owner], []). start_detail_win(Id) -> - Callback = - case Id of - "<"++_ -> - cdv_proc_cb; - "#Port"++_ -> - cdv_port_cb; - _ -> - case catch list_to_integer(Id) of - NodeId when is_integer(NodeId) -> - cdv_dist_cb; - _ -> - cdv_mod_cb - end - end, - start_detail_win(Callback,Id). -start_detail_win(Callback,Id) -> + case Id of + "<"++_ -> + start_detail_win(Id, process); + "#Port"++_ -> + start_detail_win(Id, port); + _ -> + io:format("cdv: unknown identifier: ~p~n",[Id]), + ignore + end. + +start_detail_win(Id, process) -> + start_detail_win_2(cdv_proc_cb, Id); +start_detail_win(Id, port) -> + start_detail_win_2(cdv_port_cb, Id); +start_detail_win(Id, node) -> + start_detail_win_2(cdv_dist_cb, Id); +start_detail_win(Id, module) -> + start_detail_win_2(cdv_mod_cb, Id); +start_detail_win(Id, ets) -> + start_detail_win_2(cdv_ets_cb, Id); +start_detail_win(Id, sched) -> + start_detail_win_2(cdv_sched_cb, Id). + + +start_detail_win_2(Callback,Id) -> wx_object:cast(Callback,{start_detail_win,Id}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -158,15 +168,14 @@ create_list_box(Panel, Holder, Callback, Owner) -> do_start_detail_win(undefined, State) -> State; do_start_detail_win(Id, #state{panel=Panel,detail_wins=Opened, - callback=Callback}=State) -> + holder=Holder,callback=Callback}=State) -> NewOpened = case lists:keyfind(Id, 1, Opened) of false -> - case cdv_detail_wx:start_link(Id, Panel, Callback) of - {error, _} -> - Opened; - IW -> - [{Id, IW} | Opened] + Data = call(Holder, {get_data, self(), Id}), + case cdv_detail_wx:start_link(Id, Data, Panel, Callback) of + {error, _} -> Opened; + IW -> [{Id, IW} | Opened] end; {_, IW} -> wxFrame:raise(IW), @@ -247,8 +256,8 @@ handle_event(#wx{id=MenuId, event=#wxCommand{type = command_menu_selected}}, #state{menu_items=MenuItems} = State) -> case lists:keyfind(MenuId,1,MenuItems) of - {MenuId,Id} -> - start_detail_win(Id); + {MenuId,Type,Id} -> + start_detail_win(Id, Type); false -> ok end, @@ -265,7 +274,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, Menu = wxMenu:new(), MenuItems = lists:flatmap( - fun(Col) -> + fun({Type, Col}) -> MenuId = ?ID_DETAILS + Col, ColText = call(Holder, {get_row, self(), Row, Col}), case ColText of @@ -273,14 +282,15 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, _ -> What = case catch list_to_integer(ColText) of - NodeId when is_integer(NodeId) -> + NodeId when is_integer(NodeId), + Type =:= node -> "node " ++ ColText; _ -> ColText end, Text = "Properties for " ++ What, wxMenu:append(Menu, MenuId, Text), - [{MenuId,ColText}] + [{MenuId,Type,ColText}] end end, MenuCols), @@ -300,9 +310,14 @@ handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Row}}, - #state{holder=Holder} = State) -> - Id = call(Holder, {get_row, self(), Row, id}), - start_detail_win(Id), + #state{holder=Holder, menu_cols=MenuCols} = State) -> + case MenuCols of + [{Type, _}|_] -> + Id = call(Holder, {get_row, self(), Row, id}), + start_detail_win(Id, Type); + _ -> + ignore + end, {noreply, State}; handle_event(Event, State) -> @@ -346,7 +361,7 @@ init_table_holder(Parent, Attrs, Callback, InfoList0) -> attrs=Attrs, callback=Callback}). -table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> +table_holder(#holder{callback=Callback, attrs=Attrs, info=Info}=S0) -> receive _M={get_row, From, Row, Col} -> %% erlang:display(_M), @@ -360,6 +375,9 @@ table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> %% erlang:display(_M), State = change_sort(Callback:col_to_elem(Col), S0), table_holder(State); + _M={get_data, From, Id} -> + search_id(From, Id, Callback, Info), + table_holder(S0); stop -> ok; What -> @@ -367,6 +385,21 @@ table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> table_holder(S0) end. +search_id(From, Id, Callback, Info) -> + Find = fun(_, RowInfo, _) -> + search_id(Callback, RowInfo, Id) + end, + Res = try array:foldl(Find, not_found, Info) + catch Data -> Data end, + From ! {self(), Res}, + ok. + +search_id(Callback, RowInfo, Id) -> + case observer_lib:to_str(get_cell_data(Callback, id, RowInfo)) of + Id -> throw(RowInfo); + _Str -> not_found + end. + change_sort(Col, S0=#holder{parent=Parent, info=Info0, sort=Sort0}) -> NRows = array:size(Info0), InfoList0 = array:to_list(Info0), diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index 26df60b0a6..ec0c652a27 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -44,6 +44,7 @@ -define(PORT_STR, "Ports"). -define(ETS_STR, "ETS Tables"). -define(TIMER_STR, "Timers"). +-define(SCHEDULER_STR, "Schedulers"). -define(FUN_STR, "Funs"). -define(ATOM_STR, "Atoms"). -define(DIST_STR, "Nodes"). @@ -66,6 +67,7 @@ port_panel, ets_panel, timer_panel, + sched_panel, fun_panel, atom_panel, dist_panel, @@ -171,6 +173,9 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> %% Timer Panel TimerPanel = add_page(Notebook, ?TIMER_STR, cdv_virtual_list_wx,cdv_timer_cb), + %% Scheduler Panel + SchedPanel = add_page(Notebook, ?SCHEDULER_STR, cdv_virtual_list_wx, cdv_sched_cb), + %% Fun Panel FunPanel = add_page(Notebook, ?FUN_STR, cdv_virtual_list_wx, cdv_fun_cb), @@ -202,6 +207,7 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> port_panel = PortPanel, ets_panel = EtsPanel, timer_panel = TimerPanel, + sched_panel = SchedPanel, fun_panel = FunPanel, atom_panel = AtomPanel, dist_panel = DistPanel, @@ -335,7 +341,8 @@ check_page_title(Notebook) -> get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, port_panel=Ports, ets_panel=Ets, timer_panel=Timers, fun_panel=Funs, atom_panel=Atoms, dist_panel=Dist, - mod_panel=Mods, mem_panel=Mem, int_panel=Int + mod_panel=Mods, mem_panel=Mem, int_panel=Int, + sched_panel=Sched }) -> Panel = case check_page_title(Notebook) of ?GEN_STR -> Gen; @@ -343,6 +350,7 @@ get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, ?PORT_STR -> Ports; ?ETS_STR -> Ets; ?TIMER_STR -> Timers; + ?SCHEDULER_STR -> Sched; ?FUN_STR -> Funs; ?ATOM_STR -> Atoms; ?DIST_STR -> Dist; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index ef14ba46e2..007fc74279 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -63,6 +63,7 @@ allocator_info/0, hash_tables/0, index_tables/0, + schedulers/0, expand_binary/1]). %% Library function @@ -114,6 +115,7 @@ -define(proc_heap,proc_heap). -define(proc_messages,proc_messages). -define(proc_stack,proc_stack). +-define(scheduler,scheduler). -define(timer,timer). -define(visible_node,visible_node). @@ -267,6 +269,8 @@ hash_tables() -> call(hash_tables). index_tables() -> call(index_tables). +schedulers() -> + call(schedulers). %%%----------------------------------------------------------------- %%% Called when a link to a process (Pid) is clicked. @@ -431,7 +435,11 @@ handle_call(hash_tables,_From,State=#state{file=File}) -> handle_call(index_tables,_From,State=#state{file=File}) -> IndexTables=index_tables(File), TW = truncated_warning([?hash_table,?index_table]), - {reply,{ok,IndexTables,TW},State}. + {reply,{ok,IndexTables,TW},State}; +handle_call(schedulers,_From,State=#state{file=File}) -> + Schedulers=schedulers(File), + TW = truncated_warning([?scheduler]), + {reply,{ok,Schedulers,TW},State}. @@ -677,9 +685,11 @@ skip(Fd,<<>>) -> val(Fd) -> + val(Fd, "-1"). +val(Fd, NoExist) -> case get_rest_of_line(Fd) of - {eof,[]} -> "-1"; - [] -> "-1"; + {eof,[]} -> NoExist; + [] -> NoExist; {eof,Val} -> Val; Val -> Val end. @@ -967,6 +977,8 @@ get_general_info(Fd,GenInfo) -> get_general_info(Fd,GenInfo#general_info{taints=Val}); "Atoms" -> get_general_info(Fd,GenInfo#general_info{num_atoms=val(Fd)}); + "Calling Thread" -> + get_general_info(Fd,GenInfo#general_info{thread=val(Fd)}); "=" ++ _next_tag -> GenInfo; Other -> @@ -1135,6 +1147,8 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> get_procinfo(Fd,Fun,Proc#proc{arity=Arity--"\r\n"},WS); "Run queue" -> get_procinfo(Fd,Fun,Proc#proc{run_queue=val(Fd)},WS); + "Internal State" -> + get_procinfo(Fd,Fun,Proc#proc{int_state=val(Fd)},WS); "=" ++ _next_tag -> Proc; Other -> @@ -1238,17 +1252,23 @@ maybe_other_node(Id) -> {"<" ++ N, _Rest} -> N; {"#Port<" ++ N, _Rest} -> - N + N; + {_, []} -> + not_found end, + maybe_other_node2(Channel). + +maybe_other_node2(not_found) -> not_found; +maybe_other_node2(Channel) -> Ms = ets:fun2ms( - fun({{Tag,Start},Ch}) when Tag=:=?visible_node, Ch=:=Channel -> + fun({{Tag,Start},Ch}) when Tag=:=?visible_node, Ch=:=Channel -> {"Visible Node",Start}; ({{Tag,Start},Ch}) when Tag=:=?hidden_node, Ch=:=Channel -> {"Hidden Node",Start}; - ({{Tag,Start},Ch}) when Tag=:=?not_connected, Ch=:=Channel -> + ({{Tag,Start},Ch}) when Tag=:=?not_connected, Ch=:=Channel -> {"Not Connected Node",Start} end), - + case ets:select(cdv_dump_index_table,Ms) of [] -> not_found; @@ -1503,7 +1523,7 @@ get_ets_tables(File,Pid,WS) -> end, lookup_and_parse_index(File,{?ets,Pid},ParseFun,"ets"). -get_etsinfo(Fd,EtsTable,WS) -> +get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> case line_head(Fd) of "Slot" -> get_etsinfo(Fd,EtsTable#ets_table{slot=list_to_integer(val(Fd))},WS); @@ -1513,7 +1533,7 @@ get_etsinfo(Fd,EtsTable,WS) -> get_etsinfo(Fd,EtsTable#ets_table{name=val(Fd)},WS); "Ordered set (AVL tree), Elements" -> skip_rest_of_line(Fd), - get_etsinfo(Fd,EtsTable#ets_table{type="tree",buckets="-"},WS); + get_etsinfo(Fd,EtsTable#ets_table{data_type="tree"},WS); "Buckets" -> %% A bug in erl_db_hash.c prints a space after the buckets %% - need to strip the string to make list_to_integer/1 happy. @@ -1528,9 +1548,42 @@ get_etsinfo(Fd,EtsTable,WS) -> -1 -> -1; % probably truncated _ -> Words * WS end, - get_etsinfo(Fd,EtsTable#ets_table{memory=Bytes},WS); + get_etsinfo(Fd,EtsTable#ets_table{memory={bytes,Bytes}},WS); "=" ++ _next_tag -> EtsTable; + "Chain Length Min" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_min=>Val}},WS); + "Chain Length Avg" -> + Val = try list_to_float(string:strip(val(Fd))) catch _:_ -> "-" end, + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_avg=>Val}},WS); + "Chain Length Max" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_max=>Val}},WS); + "Chain Length Std Dev" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_stddev=>Val}},WS); + "Chain Length Expected Std Dev" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_exp_stddev=>Val}},WS); + "Fixed" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{fixed=>Val}},WS); + "Type" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{data_type=>Val}},WS); + "Protection" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{protection=>Val}},WS); + "Compressed" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{compressed=>Val}},WS); + "Write Concurrency" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{write_c=>Val}},WS); + "Read Concurrency" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{read_c=>Val}},WS); Other -> unexpected(Fd,Other,"ETS info"), EtsTable @@ -2270,6 +2323,89 @@ get_indextableinfo1(Fd,IndexTable) -> IndexTable end. + +%%----------------------------------------------------------------- +%% Page with scheduler table information +schedulers(File) -> + case lookup_index(?scheduler) of + [] -> + []; + Schedulers -> + Fd = open(File), + R = lists:map(fun({Name,Start}) -> + get_schedulerinfo(Fd,Name,Start) + end, + Schedulers), + close(Fd), + R + end. + +get_schedulerinfo(Fd,Name,Start) -> + pos_bof(Fd,Start), + get_schedulerinfo1(Fd,#sched{name=Name}). + +get_schedulerinfo1(Fd,Sched=#sched{details=Ds}) -> + case line_head(Fd) of + "Current Process" -> + get_schedulerinfo1(Fd,Sched#sched{process=val(Fd, "None")}); + "Current Port" -> + get_schedulerinfo1(Fd,Sched#sched{port=val(Fd, "None")}); + "Run Queue Max Length" -> + RQMax = list_to_integer(val(Fd)), + RQ = RQMax + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_max=>RQMax}}); + "Run Queue High Length" -> + RQHigh = list_to_integer(val(Fd)), + RQ = RQHigh + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_high=>RQHigh}}); + "Run Queue Normal Length" -> + RQNorm = list_to_integer(val(Fd)), + RQ = RQNorm + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_norm=>RQNorm}}); + "Run Queue Low Length" -> + RQLow = list_to_integer(val(Fd)), + RQ = RQLow + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_low=>RQLow}}); + "Run Queue Port Length" -> + RQ = list_to_integer(val(Fd)), + get_schedulerinfo1(Fd,Sched#sched{port_q=RQ}); + + "Scheduler Sleep Info Flags" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_info=>val(Fd, "None")}}); + "Scheduler Sleep Info Aux Work" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_aux=>val(Fd, "None")}}); + + "Run Queue Flags" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{runq_flags=>val(Fd, "None")}}); + + "Current Process State" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_state=>val(Fd)}}); + "Current Process Internal State" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_int_state=>val(Fd)}}); + "Current Process Program counter" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_prg_cnt=>val(Fd)}}); + "Current Process CP" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_cp=>val(Fd)}}); + "Current Process Limited Stack Trace" -> + %% If there shall be last in scheduler information block + Sched#sched{details=get_limited_stack(Fd, 0, Ds)}; + "=" ++ _next_tag -> + Sched; + Other -> + unexpected(Fd,Other,"scheduler information"), + Sched + end. + +get_limited_stack(Fd, N, Ds) -> + case val(Fd) of + Addr = "0x" ++ _ -> + get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Addr}); + "=" ++ _next_tag -> + Ds; + Line -> + get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Line}) + end. + %%%----------------------------------------------------------------- %%% Parse memory in crashdump version 0.1 and newer %%% @@ -2572,6 +2708,7 @@ tag_to_atom("proc_dictionary") -> ?proc_dictionary; tag_to_atom("proc_heap") -> ?proc_heap; tag_to_atom("proc_messages") -> ?proc_messages; tag_to_atom("proc_stack") -> ?proc_stack; +tag_to_atom("scheduler") -> ?scheduler; tag_to_atom("timer") -> ?timer; tag_to_atom("visible_node") -> ?visible_node; tag_to_atom(UnknownTag) -> diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl index 47705d0da7..9515e74114 100644 --- a/lib/observer/src/crashdump_viewer.hrl +++ b/lib/observer/src/crashdump_viewer.hrl @@ -36,7 +36,9 @@ num_fun, mem_tot, mem_max, - instr_info}). + instr_info, + thread + }). -record(proc, %% Initial data according to the follwoing: @@ -86,7 +88,8 @@ old_heap_end, memory, stack_dump, - run_queue=?unknown + run_queue=?unknown, + int_state }). -record(port, @@ -98,15 +101,28 @@ monitors, controls}). +-record(sched, + {name, + process, + port, + run_q=0, + port_q=0, + details=#{} + }). + + + -record(ets_table, {pid, slot, id, name, - type="hash", - buckets, + data_type="hash", + buckets="-", size, - memory}). + memory, + details= #{} + }). -record(timer, {pid, diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index e293990d64..c12353f9e1 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -37,6 +37,7 @@ cdv_proc_cb, cdv_table_wx, cdv_term_cb, + cdv_sched_cb, cdv_timer_cb, cdv_virtual_list_wx, cdv_wx, diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 9592ab5977..40a3eb8831 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -173,12 +173,17 @@ fill_info([{Str,SubStructure}|Rest], Data) when is_list(SubStructure) -> [{Str, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; fill_info([{Str,Attrib,SubStructure}|Rest], Data) -> [{Str, Attrib, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; +fill_info([{Str, Key = {K,N}}|Rest], Data) when is_atom(K), is_integer(N) -> + case get_value(Key, Data) of + undefined -> [undefined | fill_info(Rest, Data)]; + Value -> [{Str, Value} | fill_info(Rest, Data)] + end; fill_info([], _) -> []. -get_value(Key, Data) when is_atom(Key) -> - proplists:get_value(Key,Data); get_value(Fun, Data) when is_function(Fun) -> - Fun(Data). + Fun(Data); +get_value(Key, Data) -> + proplists:get_value(Key,Data). update_info([Fields|Fs], [{_Header, SubStructure}| Rest]) -> update_info2(Fields, SubStructure), @@ -269,6 +274,8 @@ to_str(Pid) when is_pid(Pid) -> pid_to_list(Pid); to_str(No) when is_integer(No) -> integer_to_list(No); +to_str(Float) when is_float(Float) -> + io_lib:format("~.3f", [Float]); to_str(Term) -> io_lib:format("~w", [Term]). diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 2a840dc49e..d724cd9e96 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -150,7 +150,7 @@ handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, Opened = case lists:keyfind(Id,1,Opened0) of false -> - Win = cdv_detail_wx:start_link(Id,Frame,Callback), + Win = cdv_detail_wx:start_link(Id,[],Frame,Callback), [{Id,Win}|Opened0]; {_,Win} -> wxFrame:raise(Win), diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index 20bb9ce391..9e217db105 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -53,7 +53,6 @@ #endif #if defined(__linux__) -#include <string.h> /* strlen */ #define PROCSTAT "/proc/stat" #define BUFFERSIZE (256) @@ -73,6 +72,13 @@ typedef struct { #endif +#if defined(__FreeBSD__) +#include <sys/resource.h> +#include <sys/sysctl.h> +#define CU_BSD_VALUES (6) +#endif + + #define FD_IN (0) #define FD_OUT (1) #define FD_ERR (2) @@ -157,12 +163,16 @@ static int processors_online() { } #endif +#if defined(__FreeBSD__) +void getsysctl(const char *, void *, size_t); +#endif + int main(int argc, char** argv) { char cmd; int rc; int sz; unsigned int *rv; -#if defined(__linux__) +#if defined(__linux__) || defined(__FreeBSD__) unsigned int no_of_cpus = 0; #endif @@ -175,7 +185,14 @@ int main(int argc, char** argv) { #if defined(__linux__) no_of_cpus = processors_online(); if ( (rv = (unsigned int*)malloc(sizeof(unsigned int)*(2 + 2*no_of_cpus*CU_VALUES))) == NULL) { - error("cpu_cup: malloc error"); + error("cpu_sup: malloc error"); + } +#endif + +#if defined(__FreeBSD__) + getsysctl("hw.ncpu", &no_of_cpus, sizeof(int)); + if ( (rv = (unsigned int*)malloc(sizeof(unsigned int)*(2 + 2*no_of_cpus*CU_BSD_VALUES))) == NULL) { + error("cpu_sup: malloc error"); } #endif @@ -204,14 +221,14 @@ int main(int argc, char** argv) { case AVG5: bsd_loadavg(1); break; case AVG15: bsd_loadavg(2); break; #endif -#if defined(__sun__) || defined(__linux__) +#if defined(__sun__) || defined(__linux__) || defined(__FreeBSD__) case UTIL: util_measure(&rv,&sz); sendv(rv, sz); break; #endif case QUIT: free((void*)rv); return 0; default: error("Bad command"); break; } } - return 0; /* supress warnings */ + return 0; /* suppress warnings */ } /* ---------------------------- * @@ -520,6 +537,71 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { #endif /* ---------------------------- * + * FreeBSD stat functions * + * ---------------------------- */ + +#if defined(__FreeBSD__) + +#define EXIT_WITH(msg) (rich_error(msg, __FILE__, __LINE__)) +#define RICH_BUFLEN (213) /* left in error(char*) */ + +void rich_error(const char *reason, const char *file, const int line) { + char buf[RICH_BUFLEN]; + snprintf(buf, RICH_BUFLEN, "%s (%s:%i)", reason, file, line); + error(buf); +} +#undef RICH_BUFLEN + +static void util_measure(unsigned int **result_vec, int *result_sz) { + int no_of_cpus; + size_t size_cpu_times; + unsigned long *cpu_times; + unsigned int *rv = NULL; + int i; + + getsysctl("hw.ncpu", &no_of_cpus, sizeof(int)); + /* Header constant CPUSTATES = #long values per cpu. */ + size_cpu_times = sizeof(long) * CPUSTATES * no_of_cpus; + cpu_times = malloc(size_cpu_times); + if (!cpu_times) { + EXIT_WITH("badalloc"); + } + getsysctl("kern.cp_times", cpu_times, size_cpu_times); + + rv = *result_vec; + rv[0] = no_of_cpus; + rv[1] = CU_BSD_VALUES; + ++rv; /* first value is number of cpus */ + ++rv; /* second value is number of entries */ + + for (i = 0; i < no_of_cpus; ++i) { + int offset = i * CPUSTATES; + rv[ 0] = CU_CPU_ID; rv[ 1] = i; + rv[ 2] = CU_USER; rv[ 3] = cpu_times[CP_USER + offset]; + rv[ 4] = CU_NICE_USER; rv[ 5] = cpu_times[CP_NICE + offset]; + rv[ 6] = CU_KERNEL; rv[ 7] = cpu_times[CP_SYS + offset]; + rv[ 8] = CU_IDLE; rv[ 9] = cpu_times[CP_IDLE + offset]; + rv[10] = CU_HARD_IRQ; rv[11] = cpu_times[CP_INTR + offset]; + rv += CU_BSD_VALUES*2; + } + + *result_sz = 2 + 2*CU_BSD_VALUES * no_of_cpus; +} + +void getsysctl(const char *name, void *ptr, size_t len) +{ + size_t gotlen = len; + if (sysctlbyname(name, ptr, &gotlen, NULL, 0) != 0) { + EXIT_WITH("sysctlbyname failed"); + } + if (gotlen != len) { + EXIT_WITH("sysctlbyname: unexpected length"); + } +} +#endif + + +/* ---------------------------- * * Generic functions * * ---------------------------- */ @@ -581,5 +663,3 @@ static void error(char* err_msg) { ; exit(-1); } - - diff --git a/lib/os_mon/doc/src/cpu_sup.xml b/lib/os_mon/doc/src/cpu_sup.xml index 59da876208..4a8f5bffa0 100644 --- a/lib/os_mon/doc/src/cpu_sup.xml +++ b/lib/os_mon/doc/src/cpu_sup.xml @@ -34,7 +34,7 @@ and CPU utilization. It is part of the OS_Mon application, see <seealso marker="os_mon_app">os_mon(6)</seealso>. Available for Unix, although CPU utilization values (<c>util/0,1</c>) are only - available for Solaris and Linux.</p> + available for Solaris, Linux and FreeBSD.</p> <p>The load values are proportional to how long time a runnable Unix process has to spend in the run queue before it is scheduled. Accordingly, higher values mean more system load. The returned diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index b4ad8e2aa0..d8cfd845bc 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -160,7 +160,8 @@ handle_call(?quit, _From, State) -> handle_call({?util, D, PC}, {Client, _Tag}, #state{os_type = {unix, Flavor}} = State) when Flavor == sunos; - Flavor == linux -> + Flavor == linux; + Flavor == freebsd -> case measurement_server_call(State#state.server, {?util, D, PC, Client}) of {error, Reason} -> { reply, diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index 9f58e043db..7da819379c 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -64,6 +64,8 @@ all() -> [load_api, util_api, util_values, port, unavailable]; {unix, linux} -> [load_api, util_api, util_values, port, unavailable]; + {unix, freebsd} -> + [load_api, util_api, util_values, port, unavailable]; {unix, _OSname} -> [load_api]; _OS -> [unavailable] end. diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 86f0981988..e36908a5b9 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -587,7 +587,7 @@ <marker id="manager_server_timeout"></marker> <tag><c><![CDATA[server_timeout() = integer() <optional>]]></c></tag> <item> - <p>Asynchroneous request cleanup time. For every requests, + <p>Asynchronous request cleanup time. For every requests, some info is stored internally, in order to be able to deliver the reply (when it arrives) to the proper destination. If the reply arrives, this info will be deleted. But if diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index 0ec8bb91cf..d1ee6545dd 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -616,7 +616,7 @@ in so far as it will be converted to the new format if found. <marker id="manager_server_timeout"></marker> <tag><c><![CDATA[server_timeout() = integer() <optional>]]></c></tag> <item> - <p>Asynchroneous request cleanup time. For every requests, + <p>Asynchronous request cleanup time. For every requests, some info is stored internally, in order to be able to deliver the reply (when it arrives) to the proper destination. If the reply arrives, this info will be deleted. But if diff --git a/lib/snmp/src/manager/snmpm.erl b/lib/snmp/src/manager/snmpm.erl index 8976322c4e..96e3d55b46 100644 --- a/lib/snmp/src/manager/snmpm.erl +++ b/lib/snmp/src/manager/snmpm.erl @@ -520,7 +520,7 @@ sync_get(UserId, TargetName, Context, Oids, Timeout, ExtraInfo) -> -%% --- asynchroneous get-request --- +%% --- asynchronous get-request --- %% %% The reply will be delivered to the user %% through a call to handle_pdu/5 @@ -588,7 +588,7 @@ sync_get_next(UserId, TargetName, Context, Oids, Timeout, ExtraInfo) -> %% </BACKWARD-COMPAT> -%% --- asynchroneous get_next-request --- +%% --- asynchronous get_next-request --- %% async_get_next2(UserId, TargetName, Oids) -> @@ -654,7 +654,7 @@ sync_set(UserId, TargetName, Context, VarsAndVals, Timeout, ExtraInfo) -> %% </BACKWARD-COMPAT> -%% --- asynchroneous set-request --- +%% --- asynchronous set-request --- %% async_set2(UserId, TargetName, VarsAndVals) -> @@ -746,7 +746,7 @@ sync_get_bulk(UserId, TargetName, NonRep, MaxRep, Context, Oids, Timeout, %% </BACKWARD-COMPAT> -%% --- asynchroneous get-bulk --- +%% --- asynchronous get-bulk --- %% async_get_bulk2(UserId, TargetName, NonRep, MaxRep, Oids) -> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index cf58806aa8..c1235715cc 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -175,6 +175,19 @@ to use from a security point of view.</p> </item> + <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag> + <item> + <p>Provides a fun to implement your own logging when a server disconnects the client.</p> + </item> + + <tag><c><![CDATA[{unexpectedfun, fun(Message:term(), Peer) -> report | skip }]]></c></tag> + <item> + <p>Provides a fun to implement your own logging or other action when an unexpected message arrives. + If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no + report is generated.</p> + <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p> + </item> + <tag><c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag> <item> <note> @@ -355,7 +368,7 @@ kex is implicit but public_key is set explicitly.</p> an own CLI channel. If set to <c>no_cli</c>, the CLI channels are disabled and only subsystem channels are allowed.</p> </item> - <tag><c><![CDATA[{user_dir, String}]]></c></tag> + <tag><c><![CDATA[{user_dir, string()}]]></c></tag> <item> <p>Sets the user directory. That is, the directory containing <c>ssh</c> configuration files for the user, such as @@ -372,6 +385,7 @@ kex is implicit but public_key is set explicitly.</p> <c><![CDATA[/etc/ssh]]></c>. For security reasons, this directory is normally accessible only to the root user.</p> </item> + <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> <item> <p>Comma-separated string that determines which @@ -379,6 +393,19 @@ kex is implicit but public_key is set explicitly.</p> in what order they are tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> </item> + + <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]> + <br/>where: + <br/>PromptTexts = kb_int_tuple() | fun(Peer::{IP::tuple(),Port::integer()}, User::string(), Service::string()) -> kb_int_tuple() + <br/>kb_int_tuple() = {Name::string(), Instruction::string(), Prompt::string(), Echo::boolean()}</c> + </tag> + <item> + <p>Sets the text strings that the daemon sends to the client for presentation to the user when using <c>keyboar-interactive</c> authentication. If the fun/3 is used, it is called when the actual authentication occurs and may therefore return dynamic data like time, remote ip etc.</p> + <p>The parameter <c>Echo</c> guides the client about need to hide the password.</p> + <p>The default value is: + <c>{auth_method_kb_interactive_data, {"SSH server", "Enter password for \""++User++"\"", "password: ", false}></c></p> + </item> + <tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag> <item> @@ -495,6 +522,19 @@ kex is implicit but public_key is set explicitly.</p> Can be used to customize the handling of public keys. </p> </item> + + <tag><c>{profile, atom()}</c></tag> + <item> + <p>Used together with <c>ip-address</c> and <c>port</c> to + uniquely identify a ssh daemon. This can be useful in a + virtualized environment, where there can be more that one + server that has the same <c>ip-address</c> and + <c>port</c>. If this property is not explicitly set, it is + assumed that the the <c>ip-address</c> and <c>port</c> + uniquely identifies the SSH daemon. + </p> + </item> + <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> <p>Allows an existing file-descriptor to be used @@ -514,6 +554,14 @@ kex is implicit but public_key is set explicitly.</p> <p>Provides a fun to implement your own logging when a user disconnects from the server.</p> </item> + <tag><c><![CDATA[{unexpectedfun, fun(Message:term(), Peer) -> report | skip }]]></c></tag> + <item> + <p>Provides a fun to implement your own logging or other action when an unexpected message arrives. + If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no + report is generated.</p> + <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p> + </item> + <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag> <item> <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p> diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 90d71107ad..a06d8acfd4 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -75,7 +75,7 @@ MODULES= \ ssh_transport \ ssh_xfer -PUBLIC_HRL_FILES= ssh.hrl ssh_userauth.hrl ssh_xfer.hrl +HRL_FILES = ERL_FILES= \ $(MODULES:%=%.erl) \ @@ -95,7 +95,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) -INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl +INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl # ---------------------------------------------------- # FLAGS @@ -140,7 +140,7 @@ release_spec: opt $(INSTALL_DATA) $(BEHAVIOUR_TARGET_FILES) $(TARGET_FILES) $(APP_TARGET) \ $(APPUP_TARGET) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(PUBLIC_HRL_FILES) "$(RELSYSDIR)/include" + release_docs_spec: diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 4a07473f74..86c042781c 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -24,12 +24,14 @@ -include("ssh.hrl"). -include("ssh_connect.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include_lib("kernel/include/file.hrl"). -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, default_algorithms/0, - stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, + stop_listener/1, stop_listener/2, stop_listener/3, + stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3]). %%-------------------------------------------------------------------- @@ -158,7 +160,9 @@ daemon(HostAddr, Port, Options0) -> stop_listener(SysSup) -> ssh_system_sup:stop_listener(SysSup). stop_listener(Address, Port) -> - ssh_system_sup:stop_listener(Address, Port). + stop_listener(Address, Port, ?DEFAULT_PROFILE). +stop_listener(Address, Port, Profile) -> + ssh_system_sup:stop_listener(Address, Port, Profile). %%-------------------------------------------------------------------- -spec stop_daemon(pid()) -> ok. @@ -170,8 +174,9 @@ stop_listener(Address, Port) -> stop_daemon(SysSup) -> ssh_system_sup:stop_system(SysSup). stop_daemon(Address, Port) -> - ssh_system_sup:stop_system(Address, Port). - + ssh_system_sup:stop_system(Address, Port, ?DEFAULT_PROFILE). +stop_daemon(Address, Port, Profile) -> + ssh_system_sup:stop_system(Address, Port, Profile). %%-------------------------------------------------------------------- -spec shell(string()) -> _. -spec shell(string(), proplists:proplist()) -> _. @@ -232,7 +237,8 @@ start_daemon(Host, Port, Options, Inet) -> end. do_start_daemon(Host, Port, Options, SocketOptions) -> - case ssh_system_sup:system_supervisor(Host, Port) of + Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE), + case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> %% It would proably make more sense to call the %% address option host but that is a too big change at the @@ -339,6 +345,8 @@ handle_option([{connectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{disconnectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{unexpectedfun, _} = Opt | Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{failfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{ssh_msg_debug_fun, _} = Opt | Rest], SocketOptions, SshOptions) -> @@ -382,6 +390,8 @@ handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, S handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{profile, _ID} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions). @@ -389,9 +399,9 @@ handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 -> Opt; handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) -> - Opt; + check_dir(Opt); handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) -> - Opt; + check_dir(Opt); handle_ssh_option({user_dir_fun, Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -> @@ -442,7 +452,9 @@ handle_ssh_option({infofun, Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({connectfun, Value} = Opt) when is_function(Value) -> Opt; -handle_ssh_option({disconnectfun , Value} = Opt) when is_function(Value) -> +handle_ssh_option({disconnectfun, Value} = Opt) when is_function(Value) -> + Opt; +handle_ssh_option({unexpectedfun, Value} = Opt) when is_function(Value,2) -> Opt; handle_ssh_option({failfun, Value} = Opt) when is_function(Value) -> Opt; @@ -476,6 +488,8 @@ handle_ssh_option({id_string, random}) -> {id_string, {random,2,5}}; %% 2 - 5 random characters handle_ssh_option({id_string, ID} = Opt) when is_list(ID) -> Opt; +handle_ssh_option({profile, Value} = Opt) when is_atom(Value) -> + Opt; handle_ssh_option(Opt) -> throw({error, {eoptions, Opt}}). @@ -581,4 +595,31 @@ handle_ip(Inet) -> %% Default to ipv4 [inet | Inet] end end. - + +check_dir({_,Dir} = Opt) -> + case directory_exist_readable(Dir) of + ok -> + Opt; + {error,Error} -> + throw({error, {eoptions,{Opt,Error}}}) + end. + +directory_exist_readable(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type = directory, + access = Access}} -> + case Access of + read -> ok; + read_write -> ok; + _ -> {error, eacces} + end; + + {ok, #file_info{}}-> + {error, enotdir}; + + {error, Error} -> + {error, Error} + end. + + + diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 0c4d34f89c..a02c87505d 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -31,6 +31,7 @@ -define(SSH_LENGHT_INDICATOR_SIZE, 4). -define(REKEY_TIMOUT, 3600000). -define(REKEY_DATA_TIMOUT, 60000). +-define(DEFAULT_PROFILE, default). -define(FALSE, 0). -define(TRUE, 1). @@ -127,8 +128,10 @@ user, service, userauth_quiet_mode, % boolean() - userauth_supported_methods , % - userauth_methods, + userauth_supported_methods, % string() eg "keyboard-interactive,password" + userauth_methods, % list( string() ) eg ["keyboard-interactive", "password"] + kb_tries_left = 0, % integer(), num tries left for "keyboard-interactive" + kb_data, userauth_preference, available_host_keys, authenticated = false diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 34988f17b6..6c431af270 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -21,6 +21,8 @@ -module(ssh_acceptor). +-include("ssh.hrl"). + %% Internal application API -export([start_link/5, number_of_connections/1]). @@ -82,8 +84,10 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> end. handle_connection(Callback, Address, Port, Options, Socket) -> - SystemSup = ssh_system_sup:system_supervisor(Address, Port), SSHopts = proplists:get_value(ssh_opts, Options, []), + Profile = proplists:get_value(profile, SSHopts, ?DEFAULT_PROFILE), + SystemSup = ssh_system_sup:system_supervisor(Address, Port, Profile), + MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity), case number_of_connections(SystemSup) < MaxSessions of true -> diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 46fdef07d0..e101ce8b39 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -26,7 +26,9 @@ -module(ssh_acceptor_sup). -behaviour(supervisor). --export([start_link/1, start_child/2, stop_child/3]). +-include("ssh.hrl"). + +-export([start_link/1, start_child/2, stop_child/4]). %% Supervisor callback -export([init/1]). @@ -45,14 +47,16 @@ start_child(AccSup, ServerOpts) -> {error, already_present} -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - stop_child(AccSup, Address, Port), + Profile = proplists:get_value(profile, + proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + stop_child(AccSup, Address, Port, Profile), supervisor:start_child(AccSup, Spec); Reply -> Reply end. -stop_child(AccSup, Address, Port) -> - Name = id(Address, Port), +stop_child(AccSup, Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(AccSup, Name) of ok -> supervisor:delete_child(AccSup, Name); @@ -77,7 +81,8 @@ child_spec(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), Timeout = proplists:get_value(timeout, ServerOpts, ?DEFAULT_TIMEOUT), - Name = id(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(Address, Port, Profile), SocketOpts = proplists:get_value(socket_opts, ServerOpts), StartFunc = {ssh_acceptor, start_link, [Port, Address, [{active, false}, @@ -89,6 +94,11 @@ child_spec(ServerOpts) -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {ssh_acceptor_sup, Address, Port}. +id(Address, Port, Profile) -> + case is_list(Address) of + true -> + {ssh_acceptor_sup, any, Port, Profile}; + false -> + {ssh_acceptor_sup, Address, Port, Profile} + end. diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index df9a97c8f8..020fb06530 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -169,7 +169,8 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "password", data = <<?FALSE, ?UINT32(Sz), BinPwd:Sz/binary>>}, _, - #ssh{opts = Opts} = Ssh) -> + #ssh{opts = Opts, + userauth_supported_methods = Methods} = Ssh) -> Password = unicode:characters_to_list(BinPwd), case check_password(User, Password, Opts) of true -> @@ -178,7 +179,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, false -> {not_authorized, {User, {error,"Bad user or password"}}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications = "", + authentications = Methods, partial_success = false}, Ssh)} end; @@ -191,7 +192,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, %% ?UINT32(Sz2), NewBinPwd:Sz2/binary >> }, _, - Ssh) -> + #ssh{userauth_supported_methods = Methods} = Ssh) -> %% Password change without us having sent SSH_MSG_USERAUTH_PASSWD_CHANGEREQ (because we never do) %% RFC 4252 says: %% SSH_MSG_USERAUTH_FAILURE without partial success - The password @@ -200,7 +201,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, {not_authorized, {User, {error,"Password change not supported"}}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications = "", + authentications = Methods, partial_success = false}, Ssh)}; handle_userauth_request(#ssh_msg_userauth_request{user = User, @@ -216,7 +217,9 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "publickey", data = Data}, - SessionId, #ssh{opts = Opts} = Ssh) -> + SessionId, + #ssh{opts = Opts, + userauth_supported_methods = Methods} = Ssh) -> <<?BYTE(HaveSig), ?UINT32(ALen), BAlg:ALen/binary, ?UINT32(KLen), KeyBlob:KLen/binary, SigWLen/binary>> = Data, Alg = binary_to_list(BAlg), @@ -231,7 +234,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, false -> {not_authorized, {User, undefined}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications="publickey,password", + authentications = Methods, partial_success = false}, Ssh)} end; ?FALSE -> @@ -245,49 +248,60 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "keyboard-interactive", data = _}, - _, #ssh{opts = Opts} = Ssh) -> - %% RFC4256 - %% The data field contains: - %% - language tag (deprecated). If =/=[] SHOULD use it however. We skip - %% it for simplicity. - %% - submethods. "... the user can give a hint of which actual methods - %% he wants to use. ...". It's a "MAY use" so we skip - %% it. It also needs an understanding between the client - %% and the server. - %% - %% "The server MUST reply with an SSH_MSG_USERAUTH_SUCCESS, - %% SSH_MSG_USERAUTH_FAILURE, or SSH_MSG_USERAUTH_INFO_REQUEST message." - Default = {"SSH server", - "Enter password for \""++User++"\"", - "pwd: ", - false}, - - {Name, Instruction, Prompt, Echo} = - case proplists:get_value(auth_method_kb_interactive_data, Opts) of - undefined -> - Default; - {_,_,_,_}=V -> - V; - F when is_function(F) -> - {_,PeerName} = Ssh#ssh.peer, - F(PeerName, User, "ssh-connection") - end, - EchoEnc = case Echo of - true -> <<?TRUE>>; - false -> <<?FALSE>> - end, - Msg = #ssh_msg_userauth_info_request{name = unicode:characters_to_list(Name), - instruction = unicode:characters_to_list(Instruction), - language_tag = "", - num_prompts = 1, - data = <<?STRING(unicode:characters_to_binary(Prompt)), - EchoEnc/binary - >> - }, - {not_authorized, {User, undefined}, - ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, - opts = [{max_kb_tries,3},{kb_userauth_info_msg,Msg}|Opts] - })}; + _, #ssh{opts = Opts, + kb_tries_left = KbTriesLeft, + userauth_supported_methods = Methods} = Ssh) -> + case KbTriesLeft of + N when N<1 -> + {not_authorized, {User, {authmethod, "keyboard-interactive"}}, + ssh_transport:ssh_packet( + #ssh_msg_userauth_failure{authentications = Methods, + partial_success = false}, Ssh)}; + + _ -> + %% RFC4256 + %% The data field contains: + %% - language tag (deprecated). If =/=[] SHOULD use it however. We skip + %% it for simplicity. + %% - submethods. "... the user can give a hint of which actual methods + %% he wants to use. ...". It's a "MAY use" so we skip + %% it. It also needs an understanding between the client + %% and the server. + %% + %% "The server MUST reply with an SSH_MSG_USERAUTH_SUCCESS, + %% SSH_MSG_USERAUTH_FAILURE, or SSH_MSG_USERAUTH_INFO_REQUEST message." + Default = {"SSH server", + "Enter password for \""++User++"\"", + "password: ", + false}, + + {Name, Instruction, Prompt, Echo} = + case proplists:get_value(auth_method_kb_interactive_data, Opts) of + undefined -> + Default; + {_,_,_,_}=V -> + V; + F when is_function(F) -> + {_,PeerName} = Ssh#ssh.peer, + F(PeerName, User, "ssh-connection") + end, + EchoEnc = case Echo of + true -> <<?TRUE>>; + false -> <<?FALSE>> + end, + Msg = #ssh_msg_userauth_info_request{name = unicode:characters_to_list(Name), + instruction = unicode:characters_to_list(Instruction), + language_tag = "", + num_prompts = 1, + data = <<?STRING(unicode:characters_to_binary(Prompt)), + EchoEnc/binary + >> + }, + {not_authorized, {User, undefined}, + ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, + kb_data = Msg + })} + end; handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", @@ -314,33 +328,37 @@ handle_userauth_info_request( handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, data = <<?UINT32(Sz), Password:Sz/binary>>}, - #ssh{opts = Opts0, - user = User} = Ssh) -> - NumTriesLeft = proplists:get_value(max_kb_tries, Opts0, 0) - 1, - Opts = lists:keydelete(max_kb_tries,1,Opts0), + #ssh{opts = Opts, + kb_tries_left = KbTriesLeft0, + kb_data = InfoMsg, + user = User, + userauth_supported_methods = Methods} = Ssh) -> + KbTriesLeft = KbTriesLeft0 - 1, case check_password(User, unicode:characters_to_list(Password), Opts) of true -> {authorized, User, ssh_transport:ssh_packet(#ssh_msg_userauth_success{}, Ssh)}; - false when NumTriesLeft > 0 -> + false when KbTriesLeft > 0 -> UserAuthInfoMsg = - (proplists:get_value(kb_userauth_info_msg,Opts)) - #ssh_msg_userauth_info_request{name = "", - instruction = - lists:concat( - ["Bad user or password, try again. ", - integer_to_list(NumTriesLeft), - " tries left."])}, + InfoMsg#ssh_msg_userauth_info_request{ + name = "", + instruction = + lists:concat( + ["Bad user or password, try again. ", + integer_to_list(KbTriesLeft), + " tries left."]) + }, {not_authorized, {User, undefined}, ssh_transport:ssh_packet(UserAuthInfoMsg, - Ssh#ssh{opts = [{max_kb_tries,NumTriesLeft}|Opts]})}; + Ssh#ssh{kb_tries_left = KbTriesLeft})}; false -> {not_authorized, {User, {error,"Bad user or password"}}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications = "", + authentications = Methods, partial_success = false}, - Ssh#ssh{opts = lists:keydelete(kb_userauth_info_msg,1,Opts)} + Ssh#ssh{kb_data = undefined, + kb_tries_left = 0} )} end; @@ -483,22 +501,16 @@ keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos, NumPrompts) -> end. decode_public_key_v2(<<?UINT32(Len0), _:Len0/binary, - ?UINT32(Len1), BinE:Len1/binary, - ?UINT32(Len2), BinN:Len2/binary>> + ?UINT32(Len1), E:Len1/big-signed-integer-unit:8, + ?UINT32(Len2), N:Len2/big-signed-integer-unit:8>> ,"ssh-rsa") -> - E = ssh_bits:erlint(Len1, BinE), - N = ssh_bits:erlint(Len2, BinN), {ok, #'RSAPublicKey'{publicExponent = E, modulus = N}}; decode_public_key_v2(<<?UINT32(Len0), _:Len0/binary, - ?UINT32(Len1), BinP:Len1/binary, - ?UINT32(Len2), BinQ:Len2/binary, - ?UINT32(Len3), BinG:Len3/binary, - ?UINT32(Len4), BinY:Len4/binary>> + ?UINT32(Len1), P:Len1/big-signed-integer-unit:8, + ?UINT32(Len2), Q:Len2/big-signed-integer-unit:8, + ?UINT32(Len3), G:Len3/big-signed-integer-unit:8, + ?UINT32(Len4), Y:Len4/big-signed-integer-unit:8>> , "ssh-dss") -> - P = ssh_bits:erlint(Len1, BinP), - Q = ssh_bits:erlint(Len2, BinQ), - G = ssh_bits:erlint(Len3, BinG), - Y = ssh_bits:erlint(Len4, BinY), {ok, {Y, #'Dss-Parms'{p = P, q = Q, g = G}}}; decode_public_key_v2(_, _) -> diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 8aaff93b9f..d5f8df6fe4 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -26,7 +26,7 @@ -include("ssh.hrl"). -export([encode/2]). --export([mpint/1, erlint/2, string/1, name_list/1]). +-export([mpint/1, string/1, name_list/1]). -export([random/1]). -define(name_list(X), @@ -145,11 +145,7 @@ enc(Xs, ['...'| []], _Offset) -> enc([], [],_) -> []. -erlint(Len, BinInt) -> - Sz = Len*8, - <<Int:Sz/big-signed-integer>> = BinInt, - Int. - + %% %% Create a binary with constant bytes %% diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 3bdca4ba94..e6e5749e07 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -483,17 +483,22 @@ userauth(#ssh_msg_userauth_request{service = "ssh-connection", service = "ssh-connection", peer = {_, Address}} = Ssh0, opts = Opts, starter = Pid} = State) -> - case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of - {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, Method, Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + case lists:member(Method, Ssh0#ssh.userauth_methods) of + true -> + case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of + {authorized, User, {Reply, Ssh}} -> + send_msg(Reply, State), + Pid ! ssh_connected, + connected_fun(User, Address, Method, Opts), + {next_state, connected, + next_packet(State#state{auth_user = User, ssh_params = Ssh})}; + {not_authorized, {User, Reason}, {Reply, Ssh}} -> + retry_fun(User, Address, Reason, Opts), + send_msg(Reply, State), + {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + end; + false -> + userauth(Msg#ssh_msg_userauth_request{method="none"}, State) end; userauth(#ssh_msg_userauth_info_request{} = Msg, @@ -750,15 +755,12 @@ handle_sync_event({info, ChannelPid}, _From, StateName, {reply, {ok, Result}, StateName, State}; handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0, - role = Role, - opts = Opts} = State0) -> - {disconnect, Reason, {{replies, Replies}, Connection}} = + role = Role} = State0) -> + {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, description = "User closed down connection", language = "en"}, Connection0, Role), State = send_replies(Replies, State0), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, normal, ok, State#state{connection_state = Connection}}; @@ -987,15 +989,38 @@ handle_info({check_cache, _ , _}, #connection{channel_cache = Cache}} = State) -> {next_state, StateName, check_cache(State, Cache)}; -handle_info(UnexpectedMessage, StateName, #state{ssh_params = SshParams} = State) -> - Msg = lists:flatten(io_lib:format( - "Unexpected message '~p' received in state '~p'\n" - "Role: ~p\n" - "Peer: ~p\n" - "Local Address: ~p\n", [UnexpectedMessage, StateName, - SshParams#ssh.role, SshParams#ssh.peer, - proplists:get_value(address, SshParams#ssh.opts)])), - error_logger:info_report(Msg), +handle_info(UnexpectedMessage, StateName, #state{opts = Opts, + ssh_params = SshParams} = State) -> + case unexpected_fun(UnexpectedMessage, Opts, SshParams) of + report -> + Msg = lists:flatten( + io_lib:format( + "Unexpected message '~p' received in state '~p'\n" + "Role: ~p\n" + "Peer: ~p\n" + "Local Address: ~p\n", [UnexpectedMessage, StateName, + SshParams#ssh.role, SshParams#ssh.peer, + proplists:get_value(address, SshParams#ssh.opts)])), + error_logger:info_report(Msg); + + skip -> + ok; + + Other -> + Msg = lists:flatten( + io_lib:format("Call to fun in 'unexpectedfun' failed:~n" + "Return: ~p\n" + "Message: ~p\n" + "Role: ~p\n" + "Peer: ~p\n" + "Local Address: ~p\n", [Other, UnexpectedMessage, + SshParams#ssh.role, + element(2,SshParams#ssh.peer), + proplists:get_value(address, SshParams#ssh.opts)] + )), + + error_logger:error_report(Msg) + end, {next_state, StateName, State}. %%-------------------------------------------------------------------- @@ -1151,9 +1176,9 @@ init_ssh(client = Role, Vsn, Version, Options, Socket) -> }; init_ssh(server = Role, Vsn, Version, Options, Socket) -> - AuthMethods = proplists:get_value(auth_methods, Options, ?SUPPORTED_AUTH_METHODS), + AuthMethodsAsList = string:tokens(AuthMethods, ","), {ok, PeerAddr} = inet:peername(Socket), KeyCb = proplists:get_value(key_cb, Options, ssh_file), @@ -1164,6 +1189,8 @@ init_ssh(server = Role, Vsn, Version, Options, Socket) -> io_cb = proplists:get_value(io_cb, Options, ssh_io), opts = Options, userauth_supported_methods = AuthMethods, + userauth_methods = AuthMethodsAsList, + kb_tries_left = 3, peer = {undefined, PeerAddr}, available_host_keys = supported_host_keys(Role, KeyCb, Options) }. @@ -1275,7 +1302,6 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, #state{ role = Role, starter = User, - opts = Opts, renegotiate = Renegotiation, connection_state = Connection0} = State0, EncData) when Byte == ?SSH_MSG_GLOBAL_REQUEST; @@ -1315,21 +1341,17 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, User ! {self(), not_connected, Reason}, {stop, {shutdown, normal}, next_packet(State#state{connection_state = Connection})}; - {disconnect, Reason, {{replies, Replies}, Connection}} -> + {disconnect, _Reason, {{replies, Replies}, Connection}} -> State = send_replies(Replies, State1#state{connection_state = Connection}), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, {shutdown, normal}, State#state{connection_state = Connection}} catch _:Error -> - {disconnect, Reason, {{replies, Replies}, Connection}} = + {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg( #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, description = "Internal error", language = "en"}, Connection0, Role), State = send_replies(Replies, State1#state{connection_state = Connection}), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; @@ -1576,12 +1598,14 @@ handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), State = send_replies(disconnect_replies(Type, Msg, Replies), State0), + disconnect_fun(Desc, State#state.opts), {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0, ErrorMsg) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), State = send_replies(disconnect_replies(Type, Msg, Replies), State0), + disconnect_fun(Desc, State#state.opts), {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. disconnect_replies(own, Msg, Replies) -> @@ -1700,6 +1724,8 @@ send_reply({flow_control, Cache, Channel, From, Msg}) -> send_reply({flow_control, From, Msg}) -> gen_fsm:reply(From, Msg). +disconnect_fun({disconnect,Msg}, Opts) -> + disconnect_fun(Msg, Opts); disconnect_fun(_, undefined) -> ok; disconnect_fun(Reason, Opts) -> @@ -1710,6 +1736,15 @@ disconnect_fun(Reason, Opts) -> catch Fun(Reason) end. +unexpected_fun(UnexpectedMessage, Opts, #ssh{peer={_,Peer}}) -> + case proplists:get_value(unexpectedfun, Opts) of + undefined -> + report; + Fun -> + catch Fun(UnexpectedMessage, Peer) + end. + + check_cache(#state{opts = Opts} = State, Cache) -> %% Check the number of entries in Cache case proplists:get_value(size, ets:info(Cache)) of diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 66e7717095..483c6cb4aa 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -421,8 +421,8 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?UINT32(Num), Data/binary>>) -> decode(<<?BYTE(?SSH_MSG_KEXINIT), Cookie:128, Data/binary>>) -> decode_kex_init(Data, [Cookie, ssh_msg_kexinit], 10); -decode(<<?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/binary>>) -> - #ssh_msg_kexdh_init{e = erlint(Len, E) +decode(<<?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/big-signed-integer-unit:8>>) -> + #ssh_msg_kexdh_init{e = E }; decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST), ?UINT32(Min), ?UINT32(N), ?UINT32(Max)>>) -> #ssh_msg_kex_dh_gex_request{ @@ -442,11 +442,11 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP), g = Generator }; decode(<<?BYTE(?SSH_MSG_KEXDH_REPLY), ?UINT32(Len0), Key:Len0/binary, - ?UINT32(Len1), F:Len1/binary, + ?UINT32(Len1), F:Len1/big-signed-integer-unit:8, ?UINT32(Len2), Hashsign:Len2/binary>>) -> #ssh_msg_kexdh_reply{ public_host_key = decode_host_key(Key), - f = erlint(Len1, F), + f = F, h_sig = decode_sign(Hashsign) }; @@ -514,10 +514,7 @@ decode_kex_init(<<?UINT32(Len), Data:Len/binary, Rest/binary>>, Acc, N) -> Names = string:tokens(unicode:characters_to_list(Data), ","), decode_kex_init(Rest, [Names | Acc], N -1). -erlint(MPIntSize, MPIntValue) -> - Bits = MPIntSize * 8, - <<Integer:Bits/integer>> = MPIntValue, - Integer. + decode_sign(<<?UINT32(Len), _Alg:Len/binary, ?UINT32(_), Signature/binary>>) -> Signature. @@ -525,18 +522,19 @@ decode_sign(<<?UINT32(Len), _Alg:Len/binary, ?UINT32(_), Signature/binary>>) -> decode_host_key(<<?UINT32(Len), Alg:Len/binary, Rest/binary>>) -> decode_host_key(Alg, Rest). -decode_host_key(<<"ssh-rsa">>, <<?UINT32(Len0), E:Len0/binary, - ?UINT32(Len1), N:Len1/binary>>) -> - #'RSAPublicKey'{publicExponent = erlint(Len0, E), - modulus = erlint(Len1, N)}; +decode_host_key(<<"ssh-rsa">>, <<?UINT32(Len0), E:Len0/big-signed-integer-unit:8, + ?UINT32(Len1), N:Len1/big-signed-integer-unit:8>>) -> + #'RSAPublicKey'{publicExponent = E, + modulus = N}; decode_host_key(<<"ssh-dss">>, - <<?UINT32(Len0), P:Len0/binary, - ?UINT32(Len1), Q:Len1/binary, - ?UINT32(Len2), G:Len2/binary, - ?UINT32(Len3), Y:Len3/binary>>) -> - {erlint(Len3, Y), #'Dss-Parms'{p = erlint(Len0, P), q = erlint(Len1, Q), - g = erlint(Len2, G)}}. + <<?UINT32(Len0), P:Len0/big-signed-integer-unit:8, + ?UINT32(Len1), Q:Len1/big-signed-integer-unit:8, + ?UINT32(Len2), G:Len2/big-signed-integer-unit:8, + ?UINT32(Len3), Y:Len3/big-signed-integer-unit:8>>) -> + {Y, #'Dss-Parms'{p = P, + q = Q, + g = G}}. encode_host_key(#'RSAPublicKey'{modulus = N, publicExponent = E}) -> ssh_bits:encode(["ssh-rsa", E, N], [string, mpint, mpint]); diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 660fe8bb65..acf94b4b73 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -28,13 +28,15 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, stop_listener/1, - stop_listener/2, stop_system/1, - stop_system/2, system_supervisor/2, + stop_listener/3, stop_system/1, + stop_system/3, system_supervisor/3, subsystem_supervisor/1, channel_supervisor/1, connection_supervisor/1, - acceptor_supervisor/1, start_subsystem/2, restart_subsystem/2, - restart_acceptor/2, stop_subsystem/2]). + acceptor_supervisor/1, start_subsystem/2, restart_subsystem/3, + restart_acceptor/3, stop_subsystem/2]). %% Supervisor callback -export([init/1]). @@ -45,14 +47,15 @@ start_link(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), supervisor:start_link({local, Name}, ?MODULE, [ServerOpts]). stop_listener(SysSup) -> stop_acceptor(SysSup). -stop_listener(Address, Port) -> - Name = make_name(Address, Port), +stop_listener(Address, Port, Profile) -> + Name = make_name(Address, Port, Profile), stop_acceptor(whereis(Name)). stop_system(SysSup) -> @@ -60,12 +63,12 @@ stop_system(SysSup) -> spawn(fun() -> sshd_sup:stop_child(Name) end), ok. -stop_system(Address, Port) -> - spawn(fun() -> sshd_sup:stop_child(Address, Port) end), +stop_system(Address, Port, Profile) -> + spawn(fun() -> sshd_sup:stop_child(Address, Port, Profile) end), ok. -system_supervisor(Address, Port) -> - Name = make_name(Address, Port), +system_supervisor(Address, Port, Profile) -> + Name = make_name(Address, Port, Profile), whereis(Name). subsystem_supervisor(SystemSup) -> @@ -103,9 +106,9 @@ stop_subsystem(SystemSup, SubSys) -> end. -restart_subsystem(Address, Port) -> - SysSupName = make_name(Address, Port), - SubSysName = id(ssh_subsystem_sup, Address, Port), +restart_subsystem(Address, Port, Profile) -> + SysSupName = make_name(Address, Port, Profile), + SubSysName = id(ssh_subsystem_sup, Address, Port, Profile), case supervisor:terminate_child(SysSupName, SubSysName) of ok -> supervisor:restart_child(SysSupName, SubSysName); @@ -113,9 +116,9 @@ restart_subsystem(Address, Port) -> Error end. -restart_acceptor(Address, Port) -> - SysSupName = make_name(Address, Port), - AcceptorName = id(ssh_acceptor_sup, Address, Port), +restart_acceptor(Address, Port, Profile) -> + SysSupName = make_name(Address, Port, Profile), + AcceptorName = id(ssh_acceptor_sup, Address, Port, Profile), supervisor:restart_child(SysSupName, AcceptorName). %%%========================================================================= @@ -137,7 +140,8 @@ child_specs(ServerOpts) -> ssh_acceptor_child_spec(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = id(ssh_acceptor_sup, Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(ssh_acceptor_sup, Address, Port, Profile), StartFunc = {ssh_acceptor_sup, start_link, [ServerOpts]}, Restart = transient, Shutdown = infinity, @@ -155,12 +159,23 @@ ssh_subsystem_child_spec(ServerOpts) -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Sup, Address, Port) -> - {Sup, Address, Port}. - -make_name(Address, Port) -> - list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_sup", - [Address, Port]))). +id(Sup, Address, Port, Profile) -> + case is_list(Address) of + true -> + {Sup, any, Port, Profile}; + false -> + {Sup, Address, Port, Profile} + end. + +make_name(Address, Port, Profile) -> + case is_list(Address) of + true -> + list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", + [any, Port, Profile]))); + false -> + list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", + [Address, Port, Profile]))) + end. ssh_subsystem_sup([{_, Child, _, [ssh_subsystem_sup]} | _]) -> Child; @@ -178,3 +193,4 @@ stop_acceptor(Sup) -> supervisor:which_children(Sup)], supervisor:terminate_child(AcceptorSup, Name). + diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index 60222f5172..e879629ccb 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -26,8 +26,10 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, start_child/1, stop_child/1, - stop_child/2, system_name/1]). + stop_child/3, system_name/1]). %% Supervisor callback -export([init/1]). @@ -40,13 +42,14 @@ start_link(Servers) -> start_child(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - case ssh_system_sup:system_supervisor(Address, Port) of + Port = proplists:get_value(port, ServerOpts), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + case ssh_system_sup:system_supervisor(Address, Port, Profile) of undefined -> Spec = child_spec(Address, Port, ServerOpts), case supervisor:start_child(?MODULE, Spec) of {error, already_present} -> - Name = id(Address, Port), + Name = id(Address, Port, Profile), supervisor:delete_child(?MODULE, Name), supervisor:start_child(?MODULE, Spec); Reply -> @@ -60,8 +63,8 @@ start_child(ServerOpts) -> stop_child(Name) -> supervisor:terminate_child(?MODULE, Name). -stop_child(Address, Port) -> - Name = id(Address, Port), +stop_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), stop_child(Name). system_name(SysSup) -> @@ -87,7 +90,8 @@ init([Servers]) -> %%% Internal functions %%%========================================================================= child_spec(Address, Port, ServerOpts) -> - Name = id(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(Address, Port,Profile), StartFunc = {ssh_system_sup, start_link, [ServerOpts]}, Restart = temporary, Shutdown = infinity, @@ -95,8 +99,13 @@ child_spec(Address, Port, ServerOpts) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {server, ssh_system_sup, Address, Port}. +id(Address, Port, Profile) -> + case is_list(Address) of + true -> + {server, ssh_system_sup, any, Port, Profile}; + false -> + {server, ssh_system_sup, Address, Port, Profile} + end. system_name([], _ ) -> undefined; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 39b2f57d26..50efc33f98 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -32,11 +32,13 @@ VSN=$(GS_VSN) MODULES= \ ssh_test_lib \ + ssh_sup_SUITE \ ssh_basic_SUITE \ ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ + ssh_upgrade_SUITE \ ssh_connection_SUITE \ ssh_echo_server \ ssh_peername_sockname_server \ diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index cff695681e..873e9a42b1 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -23,6 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). +-include_lib("kernel/include/file.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -45,10 +46,13 @@ all() -> {group, dsa_pass_key}, {group, rsa_pass_key}, {group, internal_error}, + connectfun_disconnectfun_server, + connectfun_disconnectfun_client, {group, renegotiate}, daemon_already_started, server_password_option, server_userpassword_option, + {group, dir_options}, double_close, ssh_connect_timeout, ssh_connect_arg4_timeout, @@ -56,6 +60,10 @@ all() -> ssh_daemon_minimal_remote_max_packet_size_option, ssh_msg_debug_fun_option_client, ssh_msg_debug_fun_option_server, + disconnectfun_option_server, + disconnectfun_option_client, + unexpectedfun_option_server, + unexpectedfun_option_client, preferred_algorithms, id_string_no_opt_client, id_string_own_string_client, @@ -81,7 +89,9 @@ groups() -> max_sessions_ssh_connect_sequential, max_sessions_sftp_start_channel_parallel, max_sessions_sftp_start_channel_sequential - ]} + ]}, + {dir_options, [], [user_dir_option, + system_dir_option]} ]. @@ -132,6 +142,30 @@ init_per_group(internal_error, Config) -> ssh_test_lib:setup_dsa(DataDir, PrivDir), file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), Config; +init_per_group(dir_options, Config) -> + PrivDir = ?config(priv_dir, Config), + %% Make unreadable dir: + Dir_unreadable = filename:join(PrivDir, "unread"), + ok = file:make_dir(Dir_unreadable), + {ok,F1} = file:read_file_info(Dir_unreadable), + ok = file:write_file_info(Dir_unreadable, + F1#file_info{mode = F1#file_info.mode band (bnot 8#00444)}), + %% Make readable file: + File_readable = filename:join(PrivDir, "file"), + ok = file:write_file(File_readable, <<>>), + %% Check: + case {file:read_file_info(Dir_unreadable), + file:read_file_info(File_readable)} of + {{ok, #file_info{type=directory, access=Md}}, + {ok, #file_info{type=regular, access=Mf}}} when Md=/=read, Md=/=read_write -> + %% Save: + [{unreadable_dir, Dir_unreadable}, + {readable_file, File_readable} + | Config]; + X -> + ct:log("#file_info : ~p",[X]), + {skip, "File or dir mode settings failed"} + end; init_per_group(_, Config) -> Config. @@ -383,28 +417,28 @@ rekey_limit(Config) -> Kex1 = get_kex_init(ConnectionRef), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex1 = get_kex_init(ConnectionRef), Data = lists:duplicate(9000,1), ok = ssh_sftp:write_file(SftpPid, DataFile, Data), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), false = (Kex2 == Kex1), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), false = (Kex2 == Kex1), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), @@ -446,7 +480,7 @@ renegotiate1(Config) -> ssh_connection_handler:renegotiate(ConnectionRef), spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), - ct:sleep(2000), + timer:sleep(2000), Kex2 = get_kex_init(ConnectionRef), @@ -494,7 +528,7 @@ renegotiate2(Config) -> ssh_connection_handler:renegotiate(ConnectionRef), ssh_relay:release(RelayPid, rx), - ct:sleep(2000), + timer:sleep(2000), Kex2 = get_kex_init(ConnectionRef), @@ -650,6 +684,48 @@ server_userpassword_option(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +system_dir_option(Config) -> + DirUnread = proplists:get_value(unreadable_dir,Config), + FileRead = proplists:get_value(readable_file,Config), + + case ssh_test_lib:daemon([{system_dir, DirUnread}]) of + {error,{eoptions,{{system_dir,DirUnread},eacces}}} -> + ok; + {Pid1,_Host1,Port1} when is_pid(Pid1),is_integer(Port1) -> + ssh:stop_daemon(Pid1), + ct:fail("Didn't detect that dir is unreadable", []) + end, + + case ssh_test_lib:daemon([{system_dir, FileRead}]) of + {error,{eoptions,{{system_dir,FileRead},enotdir}}} -> + ok; + {Pid2,_Host2,Port2} when is_pid(Pid2),is_integer(Port2) -> + ssh:stop_daemon(Pid2), + ct:fail("Didn't detect that option is a plain file", []) + end. + + +user_dir_option(Config) -> + DirUnread = proplists:get_value(unreadable_dir,Config), + FileRead = proplists:get_value(readable_file,Config), + %% Any port will do (beware, implementation knowledge!): + Port = 65535, + + case ssh:connect("localhost", Port, [{user_dir, DirUnread}]) of + {error,{eoptions,{{user_dir,DirUnread},eacces}}} -> + ok; + {error,econnrefused} -> + ct:fail("Didn't detect that dir is unreadable", []) + end, + + case ssh:connect("localhost", Port, [{user_dir, FileRead}]) of + {error,{eoptions,{{user_dir,FileRead},enotdir}}} -> + ok; + {error,econnrefused} -> + ct:fail("Didn't detect that option is a plain file", []) + end. + +%%-------------------------------------------------------------------- ssh_msg_debug_fun_option_client() -> [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. ssh_msg_debug_fun_option_client(Config) -> @@ -692,6 +768,74 @@ ssh_msg_debug_fun_option_client(Config) -> end. %%-------------------------------------------------------------------- +connectfun_disconnectfun_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + Ref = make_ref(), + ConnFun = fun(_,_,_) -> Parent ! {connect,Ref} end, + DiscFun = fun(R) -> Parent ! {disconnect,Ref,R} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {disconnectfun, DiscFun}, + {connectfun, ConnFun}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + receive + {connect,Ref} -> + ssh:close(ConnectionRef), + receive + {disconnect,Ref,R} -> + ct:log("Disconnect result: ~p",[R]), + ssh:stop_daemon(Pid) + after 2000 -> + {fail, "No disconnectfun action"} + end + after 2000 -> + {fail, "No connectfun action"} + end. + +%%-------------------------------------------------------------------- +connectfun_disconnectfun_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + Ref = make_ref(), + DiscFun = fun(R) -> Parent ! {disconnect,Ref,R} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {disconnectfun, DiscFun}, + {user_interaction, false}]), + ssh:stop_daemon(Pid), + receive + {disconnect,Ref,R} -> + ct:log("Disconnect result: ~p",[R]) + after 2000 -> + {fail, "No disconnectfun action"} + end. + +%%-------------------------------------------------------------------- ssh_msg_debug_fun_option_server() -> [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. ssh_msg_debug_fun_option_server(Config) -> @@ -738,6 +882,157 @@ ssh_msg_debug_fun_option_server(Config) -> end. %%-------------------------------------------------------------------- +disconnectfun_option_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {disconnectfun, DisConnFun}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + ssh:close(ConnectionRef), + receive + {disconnect,Reason} -> + ct:log("Server detected disconnect: ~p",[Reason]), + ssh:stop_daemon(Pid), + ok + after 3000 -> + receive + X -> ct:log("received ~p",[X]) + after 0 -> ok + end, + {fail,"Timeout waiting for disconnect"} + end. + +%%-------------------------------------------------------------------- +disconnectfun_option_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {disconnectfun, DisConnFun}]), + ssh:stop_daemon(Pid), + receive + {disconnect,Reason} -> + ct:log("Client detected disconnect: ~p",[Reason]), + ok + after 3000 -> + receive + X -> ct:log("received ~p",[X]) + after 0 -> ok + end, + {fail,"Timeout waiting for disconnect"} + end. + +%%-------------------------------------------------------------------- +unexpectedfun_option_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + ConnFun = fun(_,_,_) -> Parent ! {connection_pid,self()} end, + UnexpFun = fun(Msg,Peer) -> + Parent ! {unexpected,Msg,Peer,self()}, + skip + end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {connectfun, ConnFun}, + {unexpectedfun, UnexpFun}]), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + receive + {connection_pid,Server} -> + %% Beware, implementation knowledge: + Server ! unexpected_message, + receive + {unexpected, unexpected_message, {{_,_,_,_},_}, _} -> ok; + {unexpected, unexpected_message, Peer, _} -> ct:fail("Bad peer ~p",[Peer]); + M = {unexpected, _, _, _} -> ct:fail("Bad msg ~p",[M]) + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout2} + end + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout1} + end. + +%%-------------------------------------------------------------------- +unexpectedfun_option_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + UnexpFun = fun(Msg,Peer) -> + Parent ! {unexpected,Msg,Peer,self()}, + skip + end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {unexpectedfun, UnexpFun}]), + %% Beware, implementation knowledge: + ConnectionRef ! unexpected_message, + + receive + {unexpected, unexpected_message, {{_,_,_,_},_}, ConnectionRef} -> + ok; + {unexpected, unexpected_message, Peer, ConnectionRef} -> + ct:fail("Bad peer ~p",[Peer]); + M = {unexpected, _, _, _} -> + ct:fail("Bad msg ~p",[M]) + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout} + end. + +%%-------------------------------------------------------------------- known_hosts() -> [{doc, "check that known_hosts is updated correctly"}]. known_hosts(Config) when is_list(Config) -> @@ -1199,8 +1494,10 @@ ssh_connect_negtimeout(Config, Parallel) -> {failfun, fun ssh_test_lib:failfun/2}]), {ok,Socket} = gen_tcp:connect(Host, Port, []), - ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), - receive after round(1.2 * NegTimeOut) -> ok end, + + Factor = 2, + ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), + ct:sleep(round(Factor * NegTimeOut)), case inet:sockname(Socket) of {ok,_} -> ct:fail("Socket not closed"); @@ -1243,8 +1540,11 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) -> ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]), one_shell_op(IO, NegTimeOut), one_shell_op(IO, NegTimeOut), - ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), - receive after round(1.2 * NegTimeOut) -> ok end, + + Factor = 2, + ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), + ct:sleep(round(Factor * NegTimeOut)), + one_shell_op(IO, NegTimeOut) end, exit(Shell, kill). @@ -1372,6 +1672,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% This is expected %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), + receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice... try Connect(Host,Port) of _ConnectionRef1 -> diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl new file mode 100644 index 0000000000..6e1595f9fa --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -0,0 +1,192 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. 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(ssh_sup_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(WAIT_FOR_SHUTDOWN, 500). +-define(USER, "Alladin"). +-define(PASSWD, "Sesame"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +all() -> + [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_suite(Config) -> + Port = ssh_test_lib:inet_port(node()), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + [{userdir, UserDir},{port, Port}, {host, "localhost"}, {host_ip, any} | Config]. + +end_per_suite(_) -> + ok. + +init_per_testcase(sshc_subtree, Config) -> + ssh:start(), + SystemDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), + [{server, {Pid, Host, Port}} | Config]; +init_per_testcase(Case, Config) -> + end_per_testcase(Case, Config), + ssh:start(), + Config. +end_per_testcase(sshc_subtree, Config) -> + {Pid,_,_} = ?config(server, Config), + ssh:stop_daemon(Pid), + ssh:stop(); +end_per_testcase(_, _Config) -> + ssh:stop(). + +%%------------------------------------------------------------------------- +%% Test cases +%%------------------------------------------------------------------------- +default_tree() -> + [{doc, "Makes sure the correct processes are started and linked," + "in the default case."}]. +default_tree(Config) when is_list(Config) -> + TopSupChildren = supervisor:which_children(ssh_sup), + 2 = length(TopSupChildren), + {value, {sshc_sup, _, supervisor,[sshc_sup]}} = + lists:keysearch(sshc_sup, 1, TopSupChildren), + {value, {sshd_sup, _,supervisor,[sshd_sup]}} = + lists:keysearch(sshd_sup, 1, TopSupChildren), + [] = supervisor:which_children(sshc_sup), + [] = supervisor:which_children(sshd_sup). + +sshc_subtree() -> + [{doc, "Make sure the sshc subtree is correct"}]. +sshc_subtree(Config) when is_list(Config) -> + {_Pid, Host, Port} = ?config(server, Config), + UserDir = ?config(userdir, Config), + + [] = supervisor:which_children(sshc_sup), + {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + [{_, _,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), + [{_,_,supervisor,[ssh_connection_handler]}, + {_,_,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + ssh:close(Pid1), + [{_,_,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + ssh:close(Pid2), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshc_sup). + +sshd_subtree() -> + [{doc, "Make sure the sshd subtree is correct"}]. +sshd_subtree(Config) when is_list(Config) -> + HostIP = ?config(host_ip, Config), + Port = ?config(port, Config), + SystemDir = ?config(data_dir, Config), + ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), + [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + Daemon, supervisor, + [ssh_system_sup]}] = + supervisor:which_children(sshd_sup), + check_sshd_system_tree(Daemon, Config), + ssh:stop_daemon(HostIP, Port), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshd_sup). + +sshd_subtree_profile() -> + [{doc, "Make sure the sshd subtree using profile option is correct"}]. +sshd_subtree_profile(Config) when is_list(Config) -> + HostIP = ?config(host_ip, Config), + Port = ?config(port, Config), + Profile = ?config(profile, Config), + SystemDir = ?config(data_dir, Config), + + {ok, _} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}, + {profile, Profile}]), + [{{server,ssh_system_sup, HostIP,Port,Profile}, + Daemon, supervisor, + [ssh_system_sup]}] = + supervisor:which_children(sshd_sup), + check_sshd_system_tree(Daemon, Config), + ssh:stop_daemon(HostIP, Port, Profile), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshd_sup). + + +check_sshd_system_tree(Daemon, Config) -> + Host = ?config(host, Config), + Port = ?config(port, Config), + UserDir = ?config(userdir, Config), + {ok, Client} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + + [{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}] + = supervisor:which_children(Daemon), + + [{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}] = supervisor:which_children(SubSysSup), + + [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] = + supervisor:which_children(AccSup), + + [{_, _, worker,[ssh_connection_handler]}] = + supervisor:which_children(ConnectionSup), + + [] = supervisor:which_children(ChannelSup), + + ssh_sftp:start_channel(Client), + + [{_, _,worker,[ssh_channel]}] = + supervisor:which_children(ChannelSup), + ssh:close(Client). + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_dsa b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_rsa b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 8ca05746db..d08afdfb90 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -361,7 +361,7 @@ do_inet_port(Node) -> openssh_sanity_check(Config) -> ssh:start(), - case ssh:connect("localhost", 22, []) of + case ssh:connect("localhost", 22, [{password,""}]) of {ok, Pid} -> ssh:close(Pid), ssh:stop(), diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl new file mode 100644 index 0000000000..861c7ab3dd --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -0,0 +1,206 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. 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/.2 +%% +%% 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(ssh_upgrade_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-record(state, { + config, + root_dir, + server, + client, + connection, + soft + }). + + +%%%================================================================ +%%% +%%% CommonTest callbacks +%%% +all() -> + [ + minor_upgrade, + major_upgrade + ]. + +init_per_suite(Config0) -> + catch crypto:stop(), + try {crypto:start(), erlang:system_info({wordsize, internal}) == + erlang:system_info({wordsize, external})} of + {ok, true} -> + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + ssh:start(), + Config + end; + {ok, false} -> + {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(Config) -> + ct_release_test:cleanup(Config), + ssh:stop(), + crypto:stop(), + UserDir = ?config(priv_dir, Config), + ssh_test_lib:clean_rsa(UserDir). + +init_per_testcase(_TestCase, Config) -> + Config. +end_per_testcase(_TestCase, Config) -> + Config. + +%%%================================================================ +%%% +%%% Test cases +%%% +major_upgrade(Config) when is_list(Config) -> + ct_release_test:upgrade(ssh, major,{?MODULE, #state{config = Config}}, Config). + +minor_upgrade(Config) when is_list(Config) -> + ct_release_test:upgrade(ssh, minor,{?MODULE, #state{config = Config}}, Config). + +%%%================================================================ +%%% +%%% ct_release_test callbacks +%%% + +%%%---------------------------------------------------------------- +%%% Initialyze system before upgrade test starts. +%%% Called by ct_release_test:upgrade/4 +upgrade_init(CTData, State) -> + {ok, AppUp={_, _, Up, _Down}} = ct_release_test:get_appup(CTData, ssh), + ct:pal("AppUp: ~p", [AppUp]), + ct:pal("Up: ~p", [Up]), + case Soft = is_soft(Up) of + %% It is symmetrical, if upgrade is soft so is downgrade + true -> + setup_server_client(State#state{soft = Soft}); + false -> + State#state{soft = Soft} + end. + +%%%---------------------------------------------------------------- +%%% Check that upgrade was successful +%%% Called by ct_release_test:upgrade/4 +upgrade_upgraded(_, #state{soft=false} = State) -> + test_hard(State, "upgrade"); + +upgrade_upgraded(_, State) -> + test_soft(State, "upgrade1"). + +%%%---------------------------------------------------------------- +%%% Check that downgrade was successful. +%%% Called by ct_release_test:upgrade/4 +upgrade_downgraded(_, #state{soft=false} = State) -> + test_hard(State, "downgrade"); + +upgrade_downgraded(_, #state{soft=true} = State) -> + test_soft(State, "downgrade1"). + +%%%================================================================ +%%% +%%% Private functions +%%% + +is_soft([{restart_application, ssh}]) -> + false; +is_soft(_) -> + true. + + +test_hard(State0, FileName) -> + ct:pal("test_hard State0=~p, FileName=~p",[State0, FileName]), + State = setup_server_client(State0), + test_connection(FileName, random_contents(), State). + +test_soft(State0, FileName) -> + ct:pal("test_soft State0=~p, FileName=~p",[State0, FileName]), + State = test_connection(FileName, random_contents(), State0), + setup_server_client( close(State) ). + + +setup_server_client(#state{config=Config} = State) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + + FtpRootDir = filename:join(PrivDir, "ftp_root"), + catch file:make_dir(FtpRootDir), + + SFTP = ssh_sftpd:subsystem_spec([{root,FtpRootDir},{cwd,FtpRootDir}]), + + {Server,Host,Port} = ssh_test_lib:daemon([{system_dir,DataDir}, + {user_passwords,[{"hej","hopp"}]}, + {subsystems,[SFTP]}]), + + {ok, ChannelPid, Connection} = + ssh_sftp:start_channel(Host, Port, [{user_interaction,false}, + {silently_accept_hosts,true}, + {user_dir,DataDir}, + {user,"hej"}, + {password,"hopp"}]), + State#state{server = Server, + client = ChannelPid, + connection = Connection}. + + +test_connection(FileName, FileContents, + #state{client = ChannelPid, + root_dir = FtpRootDir} = State) -> + ct:pal("test_connection Writing with ssh_sftp:write_file",[]), + case ssh_sftp:write_file(ChannelPid, FileName, FileContents) of + ok -> + case ssh_sftp:read_file(ChannelPid, FileName) of + {ok,FileContents} -> + State; + {ok,Unexpected} -> + ct:fail("Expected ~p but got ~p from sftp:read_file(~p,..) in RootDir ~p", + [FileContents,Unexpected,FileName,FtpRootDir] + ); + Other -> + ct:fail("ssh_sftp:read_file(~p,~p) -> ~p~n" + "ssh_sftp:list_dir(~p,\".\") -> ~p", + [ChannelPid,FileName,Other, + ChannelPid, catch ssh_sftp:list_dir(ChannelPid, ".")]) + end; + + Other -> + ct:fail("ssh_sftp:write_file(~p,~p,~p) -> ~p",[ChannelPid,FileName,FileContents,Other]) + end. + + +close(#state{server = Server, + connection = Connection} = State) -> + ssh:close(Connection), + ssh:stop_daemon(Server), + State#state{server = undefined, + client = undefined, + connection = undefined}. + + +random_contents() -> list_to_binary( random_chars(3) ). + +random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa b/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa b/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts b/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts @@ -0,0 +1 @@ + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 18d98e5efb..9122066787 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -650,6 +650,27 @@ fun(srp, Username :: string(), UserState :: term()) -> The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> + <tag><c>{client_renegotiation, boolean()}</c></tag> + <item>In protocols that support client-initiated renegotiation, the cost + of resources of such an operation is higher for the server than the + client. This can act as a vector for denial of service attacks. The SSL + application already takes measures to counter-act such attempts, + but client-initiated renegotiation can be stricly disabled by setting + this option to <c>false</c>. The default value is <c>true</c>. + Note that disabling renegotiation can result in long-lived connections + becoming unusable due to limits on the number of messages the underlying + cipher suite can encipher. + </item> + + <tag><c>{psk_identity, string()}</c></tag> + <item>Specifies the server identity hint the server presents to the client. + </item> + <tag><c>{log_alert, boolean()}</c></tag> + <item>If false, error reports will not be displayed.</item> + <tag><c>{honor_cipher_order, boolean()}</c></tag> + <item>If true, use the server's preference for cipher selection. If false + (the default), use the client's preference. + </item> </taglist> </section> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 610e2c4e41..0c73a49a04 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -514,6 +514,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, + allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, send_queue = queue:new(), protocol_cb = ?MODULE diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index d100e41930..1476336039 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,16 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]}, - {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]}, - {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ] diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 225a9be66f..f8ddfba7e3 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -685,6 +685,7 @@ handle_options(Opts0) -> reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), + client_renegotiation = handle_option(client_renegotiation, Opts, true), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), @@ -715,7 +716,7 @@ handle_options(Opts0) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, user_lookup_fun, psk_identity, srp_identity, ciphers, - reuse_session, reuse_sessions, ssl_imp, + reuse_session, reuse_sessions, ssl_imp, client_renegotiation, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, alpn_advertised_protocols, sni_hosts, sni_fun, alpn_preferred_protocols, next_protocols_advertised, @@ -857,6 +858,8 @@ validate_option(reuse_sessions, Value) when is_boolean(Value) -> validate_option(secure_renegotiate, Value) when is_boolean(Value) -> Value; +validate_option(client_renegotiation, Value) when is_boolean(Value) -> + Value; validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); @@ -1226,6 +1229,8 @@ new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordC new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB); new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); +new_ssl_options([{client_renegotiation, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{client_renegotiation = validate_option(client_renegotiation, Value)}, RecordCB); new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index baeae68bc4..40eb3d0284 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -110,6 +110,7 @@ reuse_sessions :: boolean(), renegotiate_at, secure_renegotiate, + client_renegotiation, %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 3304ffcddb..ed7ccb3d70 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -392,6 +392,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, + allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, send_queue = queue:new(), protocol_cb = ?MODULE, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index e1a36dbbd4..e131c363d1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -162,7 +162,8 @@ renegotiate_tests() -> client_no_wrap_sequence_number, server_no_wrap_sequence_number, renegotiate_dos_mitigate_active, - renegotiate_dos_mitigate_passive]. + renegotiate_dos_mitigate_passive, + renegotiate_dos_mitigate_absolute]. cipher_tests() -> [cipher_suites, @@ -2998,8 +2999,36 @@ renegotiate_dos_mitigate_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +renegotiate_dos_mitigate_absolute() -> + [{doc, "Mitigate DOS computational attack by not allowing client to initiate renegotiation"}]. +renegotiate_dos_mitigate_absolute(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{client_renegotiation, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + renegotiate_rejected, + []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- tcp_error_propagation_in_active_mode() -> - [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error ocurres"}]. + [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error occurs"}]. tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), @@ -3433,12 +3462,12 @@ renegotiate_reuse_session(Socket, Data) -> renegotiate(Socket, Data). renegotiate_immediately(Socket) -> - receive + receive {ssl, Socket, "Hello world"} -> ok; %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast {ssl, Socket, "H"} -> - receive + receive {ssl, Socket, "ello world"} -> ok end @@ -3450,6 +3479,26 @@ renegotiate_immediately(Socket) -> ct:log("Renegotiated again"), ssl:send(Socket, "Hello world"), ok. + +renegotiate_rejected(Socket) -> + receive + {ssl, Socket, "Hello world"} -> + ok; + %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast + {ssl, Socket, "H"} -> + receive + {ssl, Socket, "ello world"} -> + ok + end + end, + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + ct:sleep(?RENEGOTIATION_DISABLE_TIME +1), + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + ct:log("Failed to renegotiate again"), + ssl:send(Socket, "Hello world"), + ok. + new_config(PrivDir, ServerOpts0) -> CaCertFile = proplists:get_value(cacertfile, ServerOpts0), diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index aca34cb6e9..21ce4c4a29 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1036,7 +1036,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) -> erlang_server_alpn_openssl_client(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_with_opts(Config, - [{alpn_advertised_protocols, [<<"spdy/2">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>]}], "", Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index a4a2ed9931..d41f91250e 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -102,7 +102,7 @@ XML_REF3_FILES = \ XML_REF6_FILES = stdlib_app.xml XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml -XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml +XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml BOOK_FILES = book.xml diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml new file mode 100644 index 0000000000..d812ee16dc --- /dev/null +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -0,0 +1,160 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE fileref SYSTEM "fileref.dtd"> + +<fileref> + <header> + <copyright> + <year>2012</year><year>2015</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>assert.hrl</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <file>assert.hrl</file> + <filesummary>Assert Macros</filesummary> + <description> + <p>The include file <c>assert.hrl</c> provides macros for inserting + assertions in your program code.</p> + <p>These macros are defined in the Stdlib include file + <c>assert.hrl</c>. Include the following directive in the module + from which the function is called:</p> + <code type="none"> +-include_lib("stdlib/include/assert.hrl").</code> + <p>When an assertion succeeds, the assert macro yields the atom + <c>ok</c>. When an assertion fails, an exception of type <c>error</c> is + instead generated. The associated error term will have the form + <c>{Macro, Info}</c>, where <c>Macro</c> is the name of the macro, for + example <c>assertEqual</c>, and <c>Info</c> will be a list of tagged + values such as <c>[{module, M}, {line, L}, ...]</c> giving more + information about the location and cause of the exception. All entries + in the <c>Info</c> list are optional, and you should not rely + programatically on any of them being present.</p> + + <p>If the macro <c>NOASSERT</c> is defined when the <c>assert.hrl</c> + include file is read by the compiler, the macros will be defined as + equivalent to the atom <c>ok</c>. The test will not be performed, and + there will be no cost at runtime.</p> + + <p>For example, using <c>erlc</c> to compile your modules, the following + will disable all assertions:</p> + <code type="none"> +erlc -DNOASSERT=true *.erl</code> + <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it + is defined.)</p> + <p>A few other macros also have effect on the enabling or disabling of + assertions:</p> + <list type="bulleted"> + <item>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless + <c>DEBUG</c> is also defined, which is assumed to take + precedence.</item> + <item>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that + is, the assertions will remain enabled.</item> + </list> + <p>If you prefer, you can thus use only <c>DEBUG</c>/<c>NODEBUG</c> as + the main flags to control the behaviour of the assertions (which is + useful if you have other compiler conditionals or debugging macros + controlled by those flags), or you can use <c>ASSERT</c>/<c>NOASSERT</c> + to control only the assert macros.</p> + + </description> + + <section> + </section> + + <section> + <title>Macros</title> + <taglist> + <tag><c>assert(BoolExpr)</c></tag> + <item><p>Tests that <c>BoolExpr</c> completes normally returning + <c>true</c>.</p> + </item> + + <tag><c>assertNot(BoolExpr)</c></tag> + <item><p>Tests that <c>BoolExpr</c> completes normally returning + <c>false</c>.</p> + </item> + + <tag><c>assertMatch(GuardedPattern, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that matches <c>GuardedPattern</c>. For example: + <code type="none"> + ?assertMatch({bork, _}, f())</code></p> + <p>Note that a guard <c>when ...</c> can be included: + <code type="none"> + ?assertMatch({bork, X} when X > 0, f())</code></p> + </item> + + <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that does not match <c>GuardedPattern</c>.</p> + <p>As in <c>assertMatch</c>, <c>GuardedPattern</c> can have a + <c>when</c> part.</p> + </item> + + <tag><c>assertEqual(ExpectedValue, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that is exactly equal to <c>ExpectedValue</c>.</p> + </item> + + <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that is not exactly equal to <c>ExpectedValue</c>.</p> + </item> + + <tag><c>assertException(Class, Term, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes abnormally with an exception + of type <c>Class</c> and with the associated <c>Term</c>. The + assertion fails if <c>Expr</c> raises a different exception or if it + completes normally returning any value.</p> + <p>Note that both <c>Class</c> and <c>Term</c> can be guarded + patterns, as in <c>assertMatch</c>.</p> + </item> + + <tag><c>assertNotException(Class, Term, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> does not evaluate abnormally with an + exception of type <c>Class</c> and with the associated <c>Term</c>. + The assertion succeeds if <c>Expr</c> raises a different exception or + if it completes normally returning any value.</p> + <p>As in <c>assertException</c>, both <c>Class</c> and <c>Term</c> + can be guarded patterns.</p> + </item> + + <tag><c>assertError(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(error, Term, + Expr)</c></p> + </item> + + <tag><c>assertExit(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(exit, Term, Expr)</c></p> + </item> + + <tag><c>assertThrow(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(throw, Term, Expr)</c></p> + </item> + + </taglist> + </section> + + <section> + <title>SEE ALSO</title> + <p><seealso marker="compiler:compile">compile(3)</seealso></p> + <p><seealso marker="erts:erlc">erlc(3)</seealso></p> + </section> +</fileref> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index eee4a68ca1..cae62612aa 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -35,6 +35,7 @@ </description> <xi:include href="stdlib_app.xml"/> <xi:include href="array.xml"/> + <xi:include href="assert_hrl.xml"/> <xi:include href="base64.xml"/> <xi:include href="beam_lib.xml"/> <xi:include href="binary.xml"/> diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl new file mode 100644 index 0000000000..239d19a6dc --- /dev/null +++ b/lib/stdlib/include/assert.hrl @@ -0,0 +1,260 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond +%% +%% 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(ASSERT_HRL). +-define(ASSERT_HRL, true). + +%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to +%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes +%% precedence, and NOASSERT will become undefined. +%% +%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or +%% ASSERT are defined. +%% +%% If asserts are disabled, all assert macros are defined to be the atom +%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok' +%% as the result if the test succeeds, and raise an error exception if the +%% test fails. The error term will then have the form {Name, Info} where +%% Name is the name of the macro and Info is a list of tagged tuples. + +%% allow NODEBUG to imply NOASSERT, unless DEBUG +-ifdef(NODEBUG). +-ifndef(DEBUG). +-ifndef(NOASSERT). +-define(NOASSERT, true). +-endif. +-endif. +-endif. + +%% allow ASSERT to override NOASSERT +-ifdef(ASSERT). +-undef(NOASSERT). +-endif. + +%% Assert macros must not depend on any non-kernel or stdlib libraries. +%% +%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid +%% exporting local variables, and furthermore we only use variable names +%% prefixed with "__", that hopefully will not be bound outside the fun. +%% It is not possible to nest assert macros. + +-ifdef(NOASSERT). +-define(assert(BoolExpr),ok). +-else. +%% The assert macro is written the way it is so as not to cause warnings +%% for clauses that cannot match, even if the expression is a constant. +-define(assert(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + true -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, true}, + case __V of false -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assert, for convenience. +-ifdef(NOASSERT). +-define(assertNot(BoolExpr),ok). +-else. +-define(assertNot(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + false -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, false}, + case __V of true -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is mostly a convenience which gives more detailed reports. +%% Note: Guard is a guarded pattern, and can not be used for value. +-ifdef(NOASSERT). +-define(assertMatch(Guard, Expr), ok). +-else. +-define(assertMatch(Guard, Expr), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assertMatch, for convenience. +-ifdef(NOASSERT). +-define(assertNotMatch(Guard, Expr), ok). +-else. +-define(assertNotMatch(Guard, Expr), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). +-endif. + +%% This is a convenience macro which gives more detailed reports when +%% the expected LHS value is not a pattern, but a computed value +-ifdef(NOASSERT). +-define(assertEqual(Expect, Expr), ok). +-else. +-define(assertEqual(Expect, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)(Expect)) + end). +-endif. + +%% This is the inverse case of assertEqual, for convenience. +-ifdef(NOASSERT). +-define(assertNotEqual(Unexpected, Expr), ok). +-else. +-define(assertNotEqual(Unexpected, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)(Unexpected)) + end). +-endif. + +%% Note: Class and Term are patterns, and can not be used for value. +%% Term can be a guarded pattern, but Class cannot. +-ifdef(NOASSERT). +-define(assertException(Class, Term, Expr), ok). +-else. +-define(assertException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). +-endif. + +-define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). + +%% This is the inverse case of assertException, for convenience. +%% Note: Class and Term are patterns, and can not be used for value. +%% Both Class and Term can be guarded patterns. +-ifdef(NOASSERT). +-define(assertNotException(Class, Term, Expr), ok). +-else. +-define(assertNotException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). +-endif. + +-endif. % ASSERT_HRL diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 55bda60da5..344a5dc099 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -122,6 +122,7 @@ MODULES= \ zip HRL_FILES= \ + ../include/assert.hrl \ ../include/erl_compile.hrl \ ../include/erl_bits.hrl \ ../include/ms_transform.hrl \ diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 61eb34d565..d4ab674486 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -107,7 +107,8 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test ERL_MAKE_FLAGS += ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/kernel/include + -I$(ERL_TOP)/lib/kernel/include \ + -I$(ERL_TOP)/lib/stdlib/include EBIN = . diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 206eb4fd74..8ab30eb62b 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test, {group,upgrade}]. + [app_test, appup_test, assert_test, {group,upgrade}]. groups() -> [{upgrade,[minor_upgrade,major_upgrade]}]. @@ -185,3 +185,68 @@ upgrade_upgraded(_CtData,State) -> State. upgrade_downgraded(_CtData,State) -> State. + + +-include_lib("stdlib/include/assert.hrl"). +-include_lib("stdlib/include/assert.hrl"). % test repeated inclusion +assert_test(suite) -> + []; +assert_test(doc) -> + ["Assert macros test."]; +assert_test(_Config) -> + ok = ?assert(true), + {'EXIT',{{assert, _},_}} = (catch ?assert(false)), + {'EXIT',{{assert, Info1},_}} = (catch ?assert(0)), + {not_boolean,0} = lists:keyfind(not_boolean,1,Info1), + + ok = ?assertNot(false), + {'EXIT',{{assert, _},_}} = (catch ?assertNot(true)), + {'EXIT',{{assert, Info2},_}} = (catch ?assertNot(0)), + {not_boolean,0} = lists:keyfind(not_boolean,1,Info2), + + ok = ?assertMatch({foo,_}, {foo,bar}), + {'EXIT',{{assertMatch,_},_}} = + (catch ?assertMatch({foo,_}, {foo})), + + ok = ?assertMatch({foo,N} when N > 0, {foo,1}), + {'EXIT',{{assertMatch,_},_}} = + (catch ?assertMatch({foo,N} when N > 0, {foo,0})), + + ok = ?assertNotMatch({foo,_}, {foo,bar,baz}), + {'EXIT',{{assertNotMatch,_},_}} = + (catch ?assertNotMatch({foo,_}, {foo,baz})), + + ok = ?assertNotMatch({foo,N} when N > 0, {foo,0}), + {'EXIT',{{assertNotMatch,_},_}} = + (catch ?assertNotMatch({foo,N} when N > 0, {foo,1})), + + ok = ?assertEqual(1.0, 1.0), + {'EXIT',{{assertEqual,_},_}} = (catch ?assertEqual(1, 1.0)), + + ok = ?assertNotEqual(1, 1.0), + {'EXIT',{{assertNotEqual,_},_}} = (catch ?assertNotEqual(1.0, 1.0)), + + ok = ?assertException(error, badarith, 1/0), + ok = ?assertException(exit, foo, exit(foo)), + ok = ?assertException(throw, foo, throw(foo)), + ok = ?assertException(throw, {foo,_}, throw({foo,bar})), + ok = ?assertException(throw, {foo,N} when N > 0, throw({foo,1})), + {'EXIT',{{assertException,Why1},_}} = + (catch ?assertException(error, badarith, 0/1)), + true = lists:keymember(unexpected_success,1,Why1), + {'EXIT',{{assertException,Why2},_}} = + (catch ?assertException(error, badarith, 1/length(0))), + true = lists:keymember(unexpected_exception,1,Why2), + {'EXIT',{{assertException,Why3},_}} = + (catch ?assertException(throw, {foo,N} when N > 0, throw({foo,0}))), + true = lists:keymember(unexpected_exception,1,Why3), + + ok = ?assertNotException(throw, {foo,baz}, throw({foo,bar})), + {'EXIT',{{assertNotException,Why4},_}} = + (catch ?assertNotException(throw, {foo,bar}, throw({foo,bar}))), + true = lists:keymember(unexpected_exception,1,Why4), + + ok = ?assertError(badarith, 1/0), + ok = ?assertExit(foo, exit(foo)), + ok = ?assertThrow(foo, throw(foo)), + ok. diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 71e17e0ba1..3cffa093dc 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1017,14 +1017,24 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> %% Make sure the #bump{} records are available *before* the %% module is loaded. insert_initial_data(InitialTable), - NewAcc = - case code:load_binary(Module, ?TAG, Binary) of - {module,Module} -> - add_compiled(Module, File, Acc); - _ -> - do_clear(Module), - Acc - end, + Sticky = case code:is_sticky(Module) of + true -> + code:unstick_mod(Module), + true; + false -> + false + end, + NewAcc = case code:load_binary(Module, ?TAG, Binary) of + {module,Module} -> + add_compiled(Module, File, Acc); + _ -> + do_clear(Module), + Acc + end, + case Sticky of + true -> code:stick_mod(Module); + false -> ok + end, load_compiled(Compiled,NewAcc); load_compiled([],Acc) -> Acc. diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 8e32aeddc8..8cbc448563 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -207,7 +207,7 @@ gen_funcs(Defs) -> " }~n"), w(" case WXE_BIN_INCR:~n driver_binary_inc_refc(Ecmd.bin[0]->bin);~n break;~n",[]), w(" case WXE_BIN_DECR:~n driver_binary_dec_refc(Ecmd.bin[0]->bin);~n break;~n",[]), - w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(rt, bp);~n break;~n",[]), + w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(&rt, bp);~n break;~n",[]), Res = [gen_class(Class) || Class <- Defs], @@ -910,11 +910,24 @@ is_dc(Class) -> Parents = wx_gen_erl:parents(Class), lists:member("wxDC", Parents) orelse lists:member("wxGraphicsContext", Parents). -build_return_vals(Type,Ps) -> +build_return_vals(Type,Ps0) -> + Ps = [P || P = #param{in=In} <- Ps0, In =/= true], HaveType = case Type of void -> 0; _ -> 1 end, - NoOut = lists:sum([1 || #param{in=In} <- Ps, In =/= true]) + HaveType, + NoOut = length(Ps) + HaveType, OutTupSz = if NoOut > 1 -> NoOut; true -> 0 end, + CountFloats = fun(#param{type=#type{base=Float, single=true}}, Acc) + when Float =:= float; Float =:= double -> + Acc + 1; + (_, Acc) -> + Acc + end, + NofFloats = lists:foldl(CountFloats, 1, Ps), + case NofFloats > 1 of + true -> %%io:format("Floats ~p:~p ~p ~n",[get(current_class),get(current_func), NofFloats]); + w(" rt.ensureFloatCount(~p);~n",[NofFloats]); + false -> ignore + end, build_ret_types(Type,Ps), if OutTupSz > 1 -> w(" rt.addTupleCount(~p);~n",[OutTupSz]); @@ -923,12 +936,11 @@ build_return_vals(Type,Ps) -> Ps. build_ret_types(void,Ps) -> - Calc = fun(#param{name=N,in=False,type=T}, Free) when False =/= true -> - case build_ret(N, {arg, False}, T) of + Calc = fun(#param{name=N,in=In,type=T}, Free) -> + case build_ret(N, {arg, In}, T) of ok -> Free; Other -> [Other|Free] - end; - (_, Free) -> Free + end end, lists:foldl(Calc, [], Ps); build_ret_types(Type,Ps) -> @@ -936,12 +948,11 @@ build_ret_types(Type,Ps) -> ok -> []; FreeStr -> [FreeStr] end, - Calc = fun(#param{name=N,in=False,type=T}, FreeAcc) when False =/= true -> - case build_ret(N, {arg, False}, T) of + Calc = fun(#param{name=N,in=In,type=T}, FreeAcc) -> + case build_ret(N, {arg, In}, T) of ok -> FreeAcc; FreeMe -> [FreeMe|FreeAcc] - end; - (_, FreeAcc) -> FreeAcc + end end, lists:foldl(Calc, Free, Ps). @@ -1016,7 +1027,6 @@ build_ret(Name,_,#type{name="wxArrayTreeItemIds"}) -> w(" rt.endList(~s.GetCount());~n",[Name]); build_ret(Name,_,#type{base=float,single=true}) -> -%% w(" double Temp~s = ~s;~n", [Name,Name]), w(" rt.addFloat(~s);~n",[Name]); build_ret(Name,_,#type{base=double,single=true}) -> w(" rt.addFloat(~s);~n",[Name]); diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 3b11c0642e..01a7ad7f70 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -60,13 +60,13 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) break; } case WXE_BIN_INCR: - driver_binary_inc_refc(Ecmd.bin[0]->bin); + driver_binary_inc_refc(Ecmd.bin[0].bin); break; case WXE_BIN_DECR: - driver_binary_dec_refc(Ecmd.bin[0]->bin); + driver_binary_dec_refc(Ecmd.bin[0].bin); break; case WXE_INIT_OPENGL: - wxe_initOpenGL(rt, bp); + wxe_initOpenGL(&rt, bp); break; case 100: { // wxEvtHandler::Connect @@ -81,7 +81,7 @@ case 100: { // wxEvtHandler::Connect int * class_nameLen = (int *) bp; bp += 4; if(*haveUserData) { - userData = new wxeErlTerm(Ecmd.bin[0]); + userData = new wxeErlTerm(&Ecmd.bin[0]); } int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; @@ -5533,6 +5533,7 @@ case wxDC_GetUserScale: { // wxDC::GetUserScale wxDC *This = (wxDC *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->GetUserScale(&x,&y); + rt.ensureFloatCount(3); rt.addFloat(x); rt.addFloat(y); rt.addTupleCount(2); @@ -6430,6 +6431,7 @@ case wxGraphicsContext_GetTextExtent: { // wxGraphicsContext::GetTextExtent bp += *textLen+((8-((0+ *textLen) & 7)) & 7); if(!This) throw wxe_badarg(0); This->GetTextExtent(text,&width,&height,&descent,&externalLeading); + rt.ensureFloatCount(5); rt.addFloat(width); rt.addFloat(height); rt.addFloat(descent); @@ -6575,6 +6577,7 @@ case wxGraphicsMatrix_Get: { // wxGraphicsMatrix::Get wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->Get(&a,&b,&c,&d,&tx,&ty); + rt.ensureFloatCount(7); rt.addFloat(a); rt.addFloat(b); rt.addFloat(c); @@ -6676,6 +6679,7 @@ case wxGraphicsMatrix_TransformPoint: { // wxGraphicsMatrix::TransformPoint wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->TransformPoint(&x,&y); + rt.ensureFloatCount(3); rt.addFloat(x); rt.addFloat(y); rt.addTupleCount(2); @@ -6687,6 +6691,7 @@ case wxGraphicsMatrix_TransformDistance: { // wxGraphicsMatrix::TransformDistanc wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->TransformDistance(&dx,&dy); + rt.ensureFloatCount(3); rt.addFloat(dx); rt.addFloat(dy); rt.addTupleCount(2); @@ -7348,7 +7353,7 @@ case wxControlWithItems_Append_2: { // wxControlWithItems::Append int * itemLen = (int *) bp; bp += 4; wxString item = wxString(bp, wxConvUTF8); bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7); - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); int Result = This->Append(item,clientData); rt.addInt(Result); @@ -7410,7 +7415,7 @@ case wxControlWithItems_getClientData: { // wxControlWithItems::GetClientObject case wxControlWithItems_setClientData: { // wxControlWithItems::SetClientObject wxControlWithItems *This = (wxControlWithItems *) getPtr(bp,memenv); bp += 4; unsigned int * n = (unsigned int *) bp; bp += 4; - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); This->SetClientObject(*n,clientData); break; @@ -7461,7 +7466,7 @@ case wxControlWithItems_Insert_3: { // wxControlWithItems::Insert wxString item = wxString(bp, wxConvUTF8); bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7); unsigned int * pos = (unsigned int *) bp; bp += 4; - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); int Result = This->Insert(item,*pos,clientData); rt.addInt(Result); @@ -8985,7 +8990,7 @@ case wxBitmap_new_3: { // wxBitmap::wxBitmap } case wxBitmap_new_4: { // wxBitmap::wxBitmap int depth=1; - const char * bits = (const char*) Ecmd.bin[0]->base; + const char * bits = (const char*) Ecmd.bin[0].base; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; while( * (int*) bp) { switch (* (int*) bp) { @@ -9325,7 +9330,7 @@ case wxCursor_new_1_1: { // wxCursor::wxCursor case wxCursor_new_4: { // wxCursor::wxCursor int hotSpotX=-1; int hotSpotY=-1; - const char * bits = (const char*) Ecmd.bin[0]->base; + const char * bits = (const char*) Ecmd.bin[0].base; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; while( * (int*) bp) { switch (* (int*) bp) { @@ -9436,13 +9441,13 @@ case wxImage_new_4: { // wxImage::wxImage bool static_data=false; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; wxImage * Result = new EwxImage(*width,*height,data,static_data); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxImage"); @@ -9452,14 +9457,14 @@ case wxImage_new_5: { // wxImage::wxImage bool static_data=false; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; - unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base; while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);}; + if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);}; wxImage * Result = new EwxImage(*width,*height,data,alpha,static_data); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxImage"); @@ -9603,14 +9608,14 @@ case wxImage_Create_4: { // wxImage::Create wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); bool Result = This->Create(*width,*height,data,static_data); rt.addBool(Result); @@ -9621,15 +9626,15 @@ case wxImage_Create_5: { // wxImage::Create wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; - unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);}; + if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);}; if(!This) throw wxe_badarg(0); bool Result = This->Create(*width,*height,data,alpha,static_data); rt.addBool(Result); @@ -10142,14 +10147,14 @@ case wxImage_SetAlpha_3: { // wxImage::SetAlpha case wxImage_SetAlpha_2: { // wxImage::SetAlpha bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * alpha = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(alpha,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(alpha,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetAlpha(alpha,static_data); break; @@ -10157,14 +10162,14 @@ case wxImage_SetAlpha_2: { // wxImage::SetAlpha case wxImage_SetData_2: { // wxImage::SetData bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetData(data,static_data); break; @@ -10172,7 +10177,7 @@ case wxImage_SetData_2: { // wxImage::SetData case wxImage_SetData_4: { // wxImage::SetData bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; int * new_width = (int *) bp; bp += 4; int * new_height = (int *) bp; bp += 4; bp += 4; /* Align */ @@ -10181,7 +10186,7 @@ case wxImage_SetData_4: { // wxImage::SetData static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetData(data,*new_width,*new_height,static_data); break; @@ -18546,7 +18551,7 @@ case wxTreeCtrl_AddRoot: { // wxTreeCtrl::AddRoot selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -18573,7 +18578,7 @@ case wxTreeCtrl_AppendItem: { // wxTreeCtrl::AppendItem selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -18975,7 +18980,7 @@ case wxTreeCtrl_InsertItem: { // wxTreeCtrl::InsertItem selImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -19054,7 +19059,7 @@ case wxTreeCtrl_PrependItem: { // wxTreeCtrl::PrependItem selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -19138,7 +19143,7 @@ case wxTreeCtrl_SetItemData: { // wxTreeCtrl::SetItemData wxTreeCtrl *This = (wxTreeCtrl *) getPtr(bp,memenv); bp += 4; bp += 4; /* Align */ wxTreeItemId item = wxTreeItemId((void *) *(wxUint64 *) bp); bp += 8; - wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); if(!This) throw wxe_badarg(0); This->SetItemData(item,data); break; @@ -20593,21 +20598,21 @@ case wxPalette_new_0: { // wxPalette::wxPalette break; } case wxPalette_new_4: { // wxPalette::wxPalette - const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base; - const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base; - const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base; - wxPalette * Result = new EwxPalette(Ecmd.bin[0]->size,red,green,blue); + const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base; + const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base; + const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base; + wxPalette * Result = new EwxPalette(Ecmd.bin[0].size,red,green,blue); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPalette"); break; } case wxPalette_Create: { // wxPalette::Create wxPalette *This = (wxPalette *) getPtr(bp,memenv); bp += 4; - const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base; - const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base; - const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base; + const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base; + const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base; + const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base; if(!This) throw wxe_badarg(0); - bool Result = This->Create(Ecmd.bin[0]->size,red,green,blue); + bool Result = This->Create(Ecmd.bin[0].size,red,green,blue); rt.addBool(Result); break; } @@ -23746,6 +23751,7 @@ case wxAuiManager_GetDockSizeConstraint: { // wxAuiManager::GetDockSizeConstrain wxAuiManager *This = (wxAuiManager *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->GetDockSizeConstraint(&width_pct,&height_pct); + rt.ensureFloatCount(3); rt.addFloat(width_pct); rt.addFloat(height_pct); rt.addTupleCount(2); @@ -30254,7 +30260,7 @@ case wxStyledTextCtrl_GetUseAntiAliasing: { // wxStyledTextCtrl::GetUseAntiAlias } case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->AddTextRaw(text); break; @@ -30262,7 +30268,7 @@ case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw case wxStyledTextCtrl_InsertTextRaw: { // wxStyledTextCtrl::InsertTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; int * pos = (int *) bp; bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->InsertTextRaw(*pos,text); break; @@ -30311,7 +30317,7 @@ case wxStyledTextCtrl_GetTextRangeRaw: { // wxStyledTextCtrl::GetTextRangeRaw } case wxStyledTextCtrl_SetTextRaw: { // wxStyledTextCtrl::SetTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->SetTextRaw(text); break; @@ -30327,7 +30333,7 @@ case wxStyledTextCtrl_GetTextRaw: { // wxStyledTextCtrl::GetTextRaw } case wxStyledTextCtrl_AppendTextRaw: { // wxStyledTextCtrl::AppendTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->AppendTextRaw(text); break; diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c index ec1ba7f566..3b71f49196 100644 --- a/lib/wx/c_src/wxe_driver.c +++ b/lib/wx/c_src/wxe_driver.c @@ -118,7 +118,11 @@ wxe_driver_start(ErlDrvPort port, char *buff) ErlDrvTermData term_port = driver_mk_port(port); set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); data->driver_data = NULL; - data->bin = NULL; + data->bin = (WXEBinRef*) driver_alloc(sizeof(WXEBinRef)*DEF_BINS); + data->bin[0].from = 0; + data->bin[1].from = 0; + data->bin[2].from = 0; + data->max_bins = DEF_BINS; data->port_handle = port; data->port = term_port; data->pdl = driver_pdl_create(port); @@ -208,26 +212,40 @@ static void standard_outputv(ErlDrvData drv_data, ErlIOVec* ev) { wxe_data* sd = (wxe_data *) drv_data; - WXEBinRef * binref; + WXEBinRef * binref = NULL; ErlDrvBinary* bin; - + int i, max; + + for(i = 0; i < sd->max_bins; i++) { + if(sd->bin[i].from == 0) { + binref = &sd->bin[i]; + break; + } + } + + if(binref == NULL) { /* realloc */ + max = sd->max_bins + DEF_BINS; + driver_realloc(sd->bin, sizeof(WXEBinRef)*max); + for(i=sd->max_bins; i < max; i++) { + sd->bin[i].from = 0; + } + binref = &sd->bin[sd->max_bins]; + sd->max_bins = max; + } + if(ev->vsize == 2) { - binref = driver_alloc(sizeof(WXEBinRef)); binref->base = ev->iov[1].iov_base; binref->size = ev->iov[1].iov_len; binref->from = driver_caller(sd->port_handle); bin = ev->binv[1]; driver_binary_inc_refc(bin); /* Otherwise it could get deallocated */ binref->bin = bin; - binref->next = sd->bin; - sd->bin = binref; - } else { /* Empty binary (becomes NULL) */ - binref = driver_alloc(sizeof(WXEBinRef)); + sd->bin = binref; + } else { /* Empty binary (becomes NULL) */ binref->base = NULL; binref->size = 0; binref->from = driver_caller(sd->port_handle); binref->bin = NULL; - binref->next = sd->bin; sd->bin = binref; } } diff --git a/lib/wx/c_src/wxe_driver.h b/lib/wx/c_src/wxe_driver.h index e35bbe2118..9682f33e95 100644 --- a/lib/wx/c_src/wxe_driver.h +++ b/lib/wx/c_src/wxe_driver.h @@ -37,12 +37,12 @@ typedef struct wxe_bin_ref { size_t size; ErlDrvBinary* bin; ErlDrvTermData from; - WXEBinRefptr next; } WXEBinRef; -typedef struct wxe_data_def { +typedef struct wxe_data_def { void * driver_data; WXEBinRef * bin; /* Argument binaries */ + Uint32 max_bins; ErlDrvPort port_handle; ErlDrvTermData port; int is_cbport; @@ -50,6 +50,9 @@ typedef struct wxe_data_def { } wxe_data; +/* Number of bins per port should be small */ +#define DEF_BINS 3 + void init_glexts(wxe_data*); int load_native_gui(); diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp index 26b45d219e..347718ab14 100644 --- a/lib/wx/c_src/wxe_gl.cpp +++ b/lib/wx/c_src/wxe_gl.cpp @@ -67,7 +67,7 @@ void dlclose(HMODULE Lib) { typedef void * DL_LIB_P; #endif -void wxe_initOpenGL(wxeReturn rt, char *bp) { +void wxe_initOpenGL(wxeReturn *rt, char *bp) { DL_LIB_P LIBhandle; int (*init_opengl)(void *); #ifdef _WIN32 @@ -82,9 +82,9 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) { wxe_gl_dispatch = (WXE_GL_DISPATCH) dlsym(LIBhandle, "egl_dispatch"); if(init_opengl && wxe_gl_dispatch) { (*init_opengl)(erlCallbacks); - rt.addAtom((char *) "ok"); - rt.add(wxString::FromAscii("initiated")); - rt.addTupleCount(2); + rt->addAtom((char *) "ok"); + rt->add(wxString::FromAscii("initiated")); + rt->addTupleCount(2); erl_gl_initiated = TRUE; } else { wxString msg; @@ -95,24 +95,24 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) { msg += wxT("egl_init_opengl "); if(!wxe_gl_dispatch) msg += wxT("egl_dispatch "); - rt.addAtom((char *) "error"); - rt.add(msg); - rt.addTupleCount(2); + rt->addAtom((char *) "error"); + rt->add(msg); + rt->addTupleCount(2); } } else { wxString msg; msg.Printf(wxT("Could not load dll: ")); msg += wxString::FromAscii(bp); - rt.addAtom((char *) "error"); - rt.add(msg); - rt.addTupleCount(2); + rt->addAtom((char *) "error"); + rt->add(msg); + rt->addTupleCount(2); } } else { - rt.addAtom((char *) "ok"); - rt.add(wxString::FromAscii("already initilized")); - rt.addTupleCount(2); + rt->addAtom((char *) "ok"); + rt->add(wxString::FromAscii("already initilized")); + rt->addTupleCount(2); } - rt.send(); + rt->send(); } void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas) @@ -132,7 +132,7 @@ void deleteActiveGL(wxGLCanvas *canvas) } } -void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ +void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins){ if(caller != gl_active) { wxGLCanvas * current = glc[caller]; if(current) { @@ -153,12 +153,12 @@ void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ char * bs[3]; int bs_sz[3]; for(int i=0; i<3; i++) { - if(bins[i]) { - bs[i] = bins[i]->base; - bs_sz[i] = bins[i]->size; + if(bins[i].from) { + bs[i] = bins[i].base; + bs_sz[i] = bins[i].size; } - else - bs[i] = NULL; + else + break; } wxe_gl_dispatch(op, bp, WXE_DRV_PORT_HANDLE, caller, bs, bs_sz); } diff --git a/lib/wx/c_src/wxe_gl.h b/lib/wx/c_src/wxe_gl.h index dc117bf610..69095036a0 100644 --- a/lib/wx/c_src/wxe_gl.h +++ b/lib/wx/c_src/wxe_gl.h @@ -26,8 +26,8 @@ void activateGL(ErlDrvTermData caller); void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas); void deleteActiveGL(wxGLCanvas *canvas); -void wxe_initOpenGL(wxeReturn, char*); -void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins[]); +void wxe_initOpenGL(wxeReturn *, char*); +void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins); WX_DECLARE_HASH_MAP(ErlDrvTermData, wxGLCanvas*, wxIntegerHash, wxIntegerEqual, wxeGLC); extern wxeGLC glc; diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp index 120919e7aa..528c541403 100644 --- a/lib/wx/c_src/wxe_helpers.cpp +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -38,10 +38,10 @@ void wxeCommand::Delete() int n = 0; if(buffer) { - while(bin[n]) { - if(bin[n]->bin) - driver_free_binary(bin[n]->bin); - driver_free(bin[n++]); + while(bin[n].from) { + if(bin[n].bin) + driver_free_binary(bin[n].bin); + n++; } if(len > 64) driver_free(buffer); @@ -89,7 +89,6 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) unsigned int pos; wxeCommand *curr; - WXEBinRef *temp, *start, *prev; int n = 0; if(m_n == (m_max-1)) { // resize @@ -104,9 +103,9 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) curr->port = sd->port; curr->op = fc; curr->len = buflen; - curr->bin[0] = NULL; - curr->bin[1] = NULL; - curr->bin[2] = NULL; + curr->bin[0].from = 0; + curr->bin[1].from = 0; + curr->bin[2].from = 0; if(cbuf) { if(buflen > 64) @@ -115,26 +114,16 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) curr->buffer = curr->c_buf; memcpy((void *) curr->buffer, (void *) cbuf, buflen); - temp = sd->bin; - - prev = NULL; - start = temp; - - while(temp) { - if(curr->caller == temp->from) { - curr->bin[n++] = temp; - if(prev) { - prev->next = temp->next; - } else { - start = temp->next; - } - temp = temp->next; - } else { - prev = temp; - temp = temp->next; + for(unsigned int i=0; i<sd->max_bins; i++) { + if(curr->caller == sd->bin[i].from) { + sd->bin[i].from = 0; // Mark copied + curr->bin[n].bin = sd->bin[i].bin; + curr->bin[n].base = sd->bin[i].base; + curr->bin[n].size = sd->bin[i].size; + curr->bin[n].from = 1; + n++; } } - sd->bin = start; } else { // No-op only PING currently curr->buffer = NULL; } @@ -167,7 +156,7 @@ void wxeFifo::Append(wxeCommand *orig) } orig->op = -1; orig->buffer = NULL; - orig->bin[0] = NULL; + orig->bin[0].from = 0; } void wxeFifo::Realloc() diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h index ec3a5debdb..61d385641f 100644 --- a/lib/wx/c_src/wxe_helpers.h +++ b/lib/wx/c_src/wxe_helpers.h @@ -50,7 +50,7 @@ class wxeCommand ErlDrvTermData caller; ErlDrvTermData port; - WXEBinRef * bin[3]; + WXEBinRef bin[3]; char * buffer; int len; int op; diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 2fd5f0c52c..b75775ff34 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -58,7 +58,7 @@ extern int wxe_status; wxeFifo * wxe_queue = NULL; wxeFifo * wxe_queue_cb_saved = NULL; -int wxe_batch_caller = 0; // inside batch if larger than 0 +unsigned int wxe_needs_signal = 0; // inside batch if larger than 0 /* ************************************************************ * Commands from erlang @@ -72,26 +72,21 @@ void push_command(int op,char * buf,int len, wxe_data *sd) erl_drv_mutex_lock(wxe_batch_locker_m); wxe_queue->Add(op, buf, len, sd); - if(wxe_batch_caller > 0) { + if(wxe_needs_signal) { // wx-thread is waiting on batch end in cond_wait erl_drv_cond_signal(wxe_batch_locker_c); erl_drv_mutex_unlock(wxe_batch_locker_m); } else { // wx-thread is waiting gui-events - if(op == WXE_BATCH_BEGIN) { - wxe_batch_caller = 1; - } - erl_drv_cond_signal(wxe_batch_locker_c); erl_drv_mutex_unlock(wxe_batch_locker_m); wxWakeUpIdle(); } - } void meta_command(int what, wxe_data *sd) { if(what == PING_PORT && wxe_status == WXE_INITIATED) { erl_drv_mutex_lock(wxe_batch_locker_m); - if(wxe_batch_caller > 0) { + if(wxe_needs_signal) { wxe_queue->Add(WXE_DEBUG_PING, NULL, 0, sd); erl_drv_cond_signal(wxe_batch_locker_c); } @@ -102,6 +97,7 @@ void meta_command(int what, wxe_data *sd) { wxeMetaCommand Cmd(sd, what); wxTheApp->AddPendingEvent(Cmd); if(what == DELETE_PORT) { + driver_free(sd->bin); free(sd); } } @@ -211,14 +207,11 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) // Is thread safe if pdl have been incremented if(driver_monitor_process(port, process, &monitor) == 0) { // Should we be able to handle commands when recursing? probably - erl_drv_mutex_lock(wxe_batch_locker_m); // fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); app->recurse_level++; app->dispatch_cb(wxe_queue, wxe_queue_cb_saved, process); app->recurse_level--; // fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); - wxe_batch_caller = 0; - erl_drv_mutex_unlock(wxe_batch_locker_m); driver_demonitor_process(port, &monitor); } } @@ -227,17 +220,11 @@ void WxeApp::dispatch_cmds() { if(wxe_status != WXE_INITIATED) return; - erl_drv_mutex_lock(wxe_batch_locker_m); recurse_level++; int level = dispatch(wxe_queue_cb_saved, 0, WXE_STORED); dispatch(wxe_queue, level, WXE_NORMAL); recurse_level--; - wxe_batch_caller = 0; - if(wxe_queue->m_old) { - driver_free(wxe_queue->m_old); - wxe_queue->m_old = NULL; - } - erl_drv_mutex_unlock(wxe_batch_locker_m); + // Cleanup old memenv's and deleted objects if(recurse_level == 0) { wxeCommand *curr; @@ -265,16 +252,14 @@ void WxeApp::dispatch_cmds() } } -// Should have erl_drv_mutex_lock(wxe_batch_locker_m); -// when entering this function and it should be released -// afterwards int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) { int ping = 0; - // erl_drv_mutex_lock(wxe_batch_locker_m); must be locked already wxeCommand *event; + if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { while((event = batch->Get()) != NULL) { + if(list_type == WXE_NORMAL) erl_drv_mutex_unlock(wxe_batch_locker_m); switch(event->op) { case -1: break; @@ -292,8 +277,6 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) blevel = 0; break; case WXE_CB_RETURN: - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary if(event->len > 0) { cb_buff = (char *) driver_alloc(event->len); memcpy(cb_buff, event->buffer, event->len); @@ -301,36 +284,43 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) event->Delete(); return blevel; default: - erl_drv_mutex_unlock(wxe_batch_locker_m); if(event->op < OPENGL_START) { // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); wxe_dispatch(*event); } else { gl_dispatch(event->op,event->buffer,event->caller,event->bin); } - erl_drv_mutex_lock(wxe_batch_locker_m); break; } event->Delete(); + if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m); } - if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary + if(list_type == WXE_STORED) + return blevel; + if(blevel <= 0) { // list_type == WXE_NORMAL + if(wxe_queue->m_old) { + driver_free(wxe_queue->m_old); + wxe_queue->m_old = NULL; + } + erl_drv_mutex_unlock(wxe_batch_locker_m); return blevel; } // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->size(), blevel);fflush(stderr); - wxe_batch_caller++; + //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel);fflush(stderr); + wxe_needs_signal = 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } + wxe_needs_signal = 0; } } void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process) { wxeCommand *event; + erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { while((event = batch->Get()) != NULL) { + erl_drv_mutex_unlock(wxe_batch_locker_m); wxeMemEnv *memenv = getMemEnv(event->port); // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); if(event->caller == process || // Callbacks from CB process only @@ -357,7 +347,6 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process process = event->caller; break; default: - erl_drv_mutex_unlock(wxe_batch_locker_m); size_t start=temp->m_n; if(event->op < OPENGL_START) { // fprintf(stderr, " cb %d \r\n", event->op); @@ -365,8 +354,8 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process } else { gl_dispatch(event->op,event->buffer,event->caller,event->bin); } - erl_drv_mutex_lock(wxe_batch_locker_m); if(temp->m_n > start) { + erl_drv_mutex_lock(wxe_batch_locker_m); // We have recursed dispatch_cb and messages for this // callback may be saved on temp list move them // to orig list @@ -376,6 +365,7 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process batch->Append(ev); } } + erl_drv_mutex_unlock(wxe_batch_locker_m); } break; } @@ -384,13 +374,16 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process // fprintf(stderr, " save %d %lu\r\n", event->op, event->caller); temp->Append(event); } + erl_drv_mutex_lock(wxe_batch_locker_m); } // sleep until something happens // fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, // batch->m_n, temp->m_n);fflush(stderr); + wxe_needs_signal = 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } + wxe_needs_signal = 0; } } /* Memory handling */ diff --git a/lib/wx/c_src/wxe_return.cpp b/lib/wx/c_src/wxe_return.cpp index aebf6bae1b..f29c8eff4a 100644 --- a/lib/wx/c_src/wxe_return.cpp +++ b/lib/wx/c_src/wxe_return.cpp @@ -19,11 +19,6 @@ #include "wxe_return.h" -// see http://docs.wxwidgets.org/stable/wx_wxarray.html#arraymacros -// this is a magic incantation which must be done! -#include <wx/arrimpl.cpp> -WX_DEFINE_OBJARRAY(wxErlDrvTermDataArray); - #define INLINE wxeReturn::wxeReturn (ErlDrvTermData _port, @@ -31,79 +26,87 @@ wxeReturn::wxeReturn (ErlDrvTermData _port, bool _isResult) { port = _port; caller = _caller; - + isResult = _isResult; - - if (isResult) { - addAtom("_wxe_result_"); - } + rtb = buff; + rt_max = RT_BUFF_SZ; + rt_n = 0; + if (isResult) { + addAtom("_wxe_result_"); + } +} + +//clear everything so we can re-use if we want +void wxeReturn::reset() { + rt_n = 0; + temp_float.empty(); } wxeReturn::~wxeReturn () { - //depending on which version of wxArray we use, we may have to clear it ourselves. + if(rtb != buff) + driver_free(rtb); } -int wxeReturn::send() { - if ((rt.GetCount() == 2 && isResult) || rt.GetCount() == 0) - return 1; // not a call bail out - - if (isResult) { - addTupleCount(2); - } +int wxeReturn::send() { + if ((rt_n == 2 && isResult) || rt_n == 0) + return 1; // not a call bail out - // rt to array - unsigned int rtLength = rt.GetCount(); //signed int + if (isResult) { + addTupleCount(2); + } - size_t size = sizeof(ErlDrvTermData)*(rtLength); - - ErlDrvTermData* rtData = (ErlDrvTermData *) driver_alloc(size); - for (unsigned int i=0; i < rtLength; i++) { - rtData[i] = rt[i]; - } - - int res = erl_drv_send_term(port, caller, rtData, rtLength); - driver_free(rtData); + int res = erl_drv_send_term(port, caller, rtb, rt_n); #ifdef DEBUG - if(res == -1) { - fprintf(stderr, "Failed to send return or event msg\r\n"); - } + if(res == -1) { + fprintf(stderr, "Failed to send return or event msg\r\n"); + } #endif - reset(); - return res; + reset(); + return res; } -//clear everything so we can re-use if we want - void wxeReturn::reset() { - rt.empty(); - temp_float.empty(); +INLINE +unsigned int wxeReturn::size() { + return rt_n; } + INLINE -unsigned int wxeReturn::size() { - return rt.GetCount(); - } - +void wxeReturn::ensureFloatCount(size_t n) { + temp_float.Alloc(n); +} + INLINE -void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) { - rt.Add(type); - rt.Add(data); +void wxeReturn::do_add(ErlDrvTermData val) { + if(rt_n >= rt_max) { // realloc + rt_max += RT_BUFF_SZ; + if(rtb == buff) { + rtb = (ErlDrvTermData *) driver_alloc(rt_max * sizeof(ErlDrvTermData)); + for(int i = 0; i < RT_BUFF_SZ; i++) + rtb[i] = buff[i]; + } else { + rtb = (ErlDrvTermData *) driver_realloc(rtb, rt_max * sizeof(ErlDrvTermData)); + } + } + rtb[rt_n++] = val; } -// INLINE -// void wxeReturn::addRef(const void *ptr, const char* className) { -// unsigned int ref_idx = wxe_app->getRef((void *)ptr, memEnv); -// addRef(ref_idx, className); -// } +INLINE +void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) { + do_add(type); + do_add(data); +} + INLINE void wxeReturn::addRef(const unsigned int ref, const char* className) { addAtom("wx_ref"); addUint(ref); addAtom(className); - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); addTupleCount(4); } @@ -115,30 +118,30 @@ void wxeReturn::addAtom(const char* atomName) { INLINE void wxeReturn::addBinary(const char* buf, const size_t size) { - rt.Add(ERL_DRV_BUF2BINARY); - rt.Add((ErlDrvTermData)buf); - rt.Add((ErlDrvTermData)size); + do_add(ERL_DRV_BUF2BINARY); + do_add((ErlDrvTermData)buf); + do_add((ErlDrvTermData)size); } INLINE void wxeReturn::addExt2Term(wxeErlTerm *term) { if(term) { - rt.Add(ERL_DRV_EXT2TERM); - rt.Add((ErlDrvTermData)term->bin); - rt.Add((ErlDrvTermData)term->size); + do_add(ERL_DRV_EXT2TERM); + do_add((ErlDrvTermData)term->bin); + do_add((ErlDrvTermData)term->size); } else { - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); } } INLINE void wxeReturn::addExt2Term(wxETreeItemData *val) { if(val) { - rt.Add(ERL_DRV_EXT2TERM); - rt.Add((ErlDrvTermData)(val->bin)); - rt.Add((ErlDrvTermData)(val->size)); + do_add(ERL_DRV_EXT2TERM); + do_add((ErlDrvTermData)(val->bin)); + do_add((ErlDrvTermData)(val->size)); } else - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); } INLINE @@ -168,8 +171,8 @@ void wxeReturn::addTupleCount(unsigned int n) { INLINE void wxeReturn::endList(unsigned int n) { - rt.Add(ERL_DRV_NIL); - add(ERL_DRV_LIST, (ErlDrvTermData)(n+1)); + do_add(ERL_DRV_NIL); + add(ERL_DRV_LIST, (ErlDrvTermData)(n+1)); } INLINE @@ -222,6 +225,7 @@ INLINE void wxeReturn::add(wxArrayDouble val) { unsigned int len = val.GetCount(); + temp_float.Alloc(len); for (unsigned int i = 0; i< len; i++) { addFloat(val[i]); } diff --git a/lib/wx/c_src/wxe_return.h b/lib/wx/c_src/wxe_return.h index 80946e2dc6..6729789116 100644 --- a/lib/wx/c_src/wxe_return.h +++ b/lib/wx/c_src/wxe_return.h @@ -40,10 +40,7 @@ extern "C" { #include <wx/html/htmlcell.h> -// #define send() send_term(__FILE__, __LINE__) - -// see http://docs.wxwidgets.org/stable/wx_wxarray.html -WX_DECLARE_OBJARRAY(ErlDrvTermData, wxErlDrvTermDataArray); +#define RT_BUFF_SZ 64 class wxeReturn { @@ -57,7 +54,6 @@ public: void add(ErlDrvTermData type, ErlDrvTermData data); - // void addRef(const void *ptr, const char* className); void addRef(const unsigned int ref, const char* className); void addAtom(const char* atomName); @@ -65,8 +61,8 @@ public: void addExt2Term(wxeErlTerm * term); void addExt2Term(wxETreeItemData * term); - void addNil() { rt.Add(ERL_DRV_NIL); }; - + void addNil() { do_add(ERL_DRV_NIL); }; + void addUint(unsigned int n); void addInt(int n); @@ -116,6 +112,10 @@ public: void add(const wxHtmlLinkInfo &val); + void do_add(ErlDrvTermData val); + + void ensureFloatCount(size_t n); + int send(); void reset(); @@ -127,15 +127,17 @@ private: inline void addDate(wxDateTime dateTime); inline void addTime(wxDateTime dateTime); - -// WxeApp* wxe_app; + ErlDrvTermData caller; ErlDrvTermData port; -// wxeMemEnv *memEnv; - wxErlDrvTermDataArray rt; wxArrayDouble temp_float; wxMBConvUTF32 utfConverter; bool isResult; + + unsigned int rt_max; + unsigned int rt_n; + ErlDrvTermData *rtb; + ErlDrvTermData buff[RT_BUFF_SZ]; }; #endif /* _WXE_RETURN_H */ diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index e3bbb21a23..2a17cc3ab9 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -271,13 +271,19 @@ wx_misc(_Config) -> wx:destroy(). -%% Check that all the data_types works in communication +%% Check that all the data_types works in communication %% between erlang and c++ thread. data_types(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); data_types(_Config) -> Wx = ?mr(wx_ref, wx:new()), - + Frame = wxFrame:new(Wx, 1, "Data Types"), + wxFrame:connect(Frame, show), + wxFrame:show(Frame), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, + CDC = wxClientDC:new(Frame), %% From wx.erl @@ -292,16 +298,31 @@ data_types(_Config) -> ?m(ok, wxDC:setUserScale(CDC, 123.45, 234.67)), ?m({123.45,234.67}, wxDC:getUserScale(CDC)), + %% Array of doubles + try wxGraphicsContext:create(CDC) of + GC -> + wxGraphicsContext:setFont(GC, ?wxITALIC_FONT, {0, 0, 50}), + Ws = wxGraphicsContext:getPartialTextExtents(GC, "a String With More Than 16 Characters"), + _ = lists:foldl(fun(Width, {Index, Acc}) -> + if Width >= Acc, Width < 500 -> {Index+1, Width}; + true -> throw({bad_float, Width, Index, Acc}) + end + end, {0,0.0}, Ws), + ok + catch _:_ -> %% GC not supported on this platform + ok + end, + %% Colors input is 3 or 4 tuple, returns are 4 tuples ?m(ok, wxDC:setTextForeground(CDC, {100,10,1})), ?m({100,10,1,255}, wxDC:getTextForeground(CDC)), ?m(ok, wxDC:setTextForeground(CDC, {100,10,1,43})), ?m({100,10,1,43}, wxDC:getTextForeground(CDC)), - %% Bool + %% Bool ?m(ok, wxDC:setAxisOrientation(CDC, true, false)), ?m(true, is_boolean(wxDC:isOk(CDC))), - + %% wxCoord ?m(true, is_integer(wxDC:maxX(CDC))), @@ -309,7 +330,7 @@ data_types(_Config) -> ?m({_,_}, wxWindow:getSize(Frame)), %% DateTime - DateTime = {Date, _Time} = calendar:now_to_datetime(erlang:now()), + DateTime = {Date, _Time} = calendar:now_to_datetime(os:timestamp()), io:format("DateTime ~p ~n",[DateTime]), Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Frame, ?wxID_ANY, [{date,DateTime}])), ?m({Date,_}, wxCalendarCtrl:getDate(Cal)), diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index 45ab0f3a32..50b045a30b 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -71,7 +71,7 @@ calendarCtrl(Config) -> Panel = wxPanel:new(Frame), Sz = wxBoxSizer:new(?wxVERTICAL), - {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(erlang:now()), + {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(os:timestamp()), Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Panel, ?wxID_ANY, [{date,DateTime} ])), @@ -287,10 +287,13 @@ helpFrame(Config) -> MFrame = wx:batch(fun() -> MFrame = wxFrame:new(Wx, ?wxID_ANY, "Main Frame"), wxPanel:new(MFrame, [{size, {600,400}}]), + wxFrame:connect(MFrame, show), wxWindow:show(MFrame), MFrame end), - timer:sleep(9), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, {X0, Y0} = wxWindow:getScreenPosition(MFrame), {X, Y, W,H} = wxWindow:getScreenRect(MFrame), @@ -441,15 +444,16 @@ radioBox(Config) -> Frame = wxFrame:new(Wx, ?wxID_ANY, "Frame"), TrSortRadioBox = wxRadioBox:new(Frame, ?wxID_ANY, "Sort by:", - {100, 100},{100, 100}, ["Timestamp"]), + {100, 100},{100, 100}, + ["Timestamp", "Session", "FooBar"]), io:format("TrSortRadioBox ~p ~n", [TrSortRadioBox]), - %% If I uncomment any of these lines, it will crash - - io:format("~p~n", [catch wxControlWithItems:setClientData(TrSortRadioBox, 0, timestamp)]), - %?m(_, wxListBox:append(TrSortRadioBox, "Session Id", session_id)), - %?m(_, wxListBox:insert(TrSortRadioBox, "Session Id", 0, session_id)), - + wxRadioBox:setSelection(TrSortRadioBox, 2), + wxRadioBox:setItemToolTip(TrSortRadioBox, 2, "Test"), + TT0 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 0)), + TT1 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 2)), + ?m(true, wx:is_null(TT0)), + ?m("Test", wxToolTip:getTip(TT1)), wxWindow:show(Frame), wx_test_lib:wx_destroy(Frame,Config). @@ -530,7 +534,7 @@ popup(Config) -> [{shortHelp, "Press Me"}]), Log = fun(#wx{id=Id, event=Ev}, Obj) -> - io:format("Got ~p from ~p~n", [Id, Ev]), + io:format("Got ~p from ~p~n", [Ev, Id]), wxEvent:skip(Obj) end, CreatePopup = fun() -> @@ -553,7 +557,11 @@ popup(Config) -> Pop end, wxFrame:connect(Frame, command_menu_selected, [{id, 747}]), + wxFrame:connect(Frame, show), wxFrame:show(Frame), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, Pop = CreatePopup(), Scale = case wx_test_lib:user_available(Config) of diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 88eaefc492..d27e101fe2 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -40,6 +40,7 @@ callbacks/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). %% @spec export(Content, Callback) -> ExportedFormat @@ -273,7 +274,7 @@ tagdef(Tag,Pos,Parents,Args,CBs) -> callbacks(Module) -> Result = check_inheritance(Module, []), -%%% io:format("callbacks = ~p~n", [lists:reverse(Result)]), +%%% ?dbg("callbacks = ~p~n", [lists:reverse(Result)]), lists:reverse(Result). callbacks([M|Mods], Visited) -> @@ -288,7 +289,7 @@ callbacks([], Visited) -> Visited. check_inheritance(M, Visited) -> -%%% io:format("calling ~p:'#xml-inheritance#'()~n", [M]), +%%% ?dbg("calling ~p:'#xml-inheritance#'()~n", [M]), case M:'#xml-inheritance#'() of [] -> [M|Visited]; diff --git a/lib/xmerl/src/xmerl_eventp.erl b/lib/xmerl/src/xmerl_eventp.erl index ad5c3cbc47..beeab3fa5c 100644 --- a/lib/xmerl/src/xmerl_eventp.erl +++ b/lib/xmerl/src/xmerl_eventp.erl @@ -80,17 +80,17 @@ stream_sax(Fname, CallBack, UserState,Options) -> HookF= fun(ParsedEntity, S) -> {CBs,Arg}=xmerl_scan:user_state(S), -% io:format("stream_sax Arg=~p~n",[Arg]), +% ?dbg("stream_sax Arg=~p~n",[Arg]), case ParsedEntity of #xmlComment{} -> % Toss away comments... {[],S}; _ -> % Use callback module for the rest -% io:format("stream_sax ParsedEntity=~p~n",[ParsedEntity]), +% ?dbg("stream_sax ParsedEntity=~p~n",[ParsedEntity]), case xmerl:export_element(ParsedEntity,CBs,Arg) of {error,Reason} -> throw({error,Reason}); Resp -> -% io:format("stream_sax Resp=~p~n",[Resp]), +% ?dbg("stream_sax Resp=~p~n",[Resp]), {Resp,xmerl_scan:user_state({CBs,Resp},S)} end end diff --git a/lib/xmerl/src/xmerl_otpsgml.erl b/lib/xmerl/src/xmerl_otpsgml.erl index 38688e788f..b9649ecbad 100644 --- a/lib/xmerl/src/xmerl_otpsgml.erl +++ b/lib/xmerl/src/xmerl_otpsgml.erl @@ -34,6 +34,7 @@ export_text/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). '#xml-inheritance#'() -> [xmerl_sgml]. @@ -58,7 +59,7 @@ %% the scope of a markup is not extended by mistake.) '#element#'(Tag, Data, Attrs, _Parents, _E) -> -% io:format("parents:\n~p\n",[_Parents]), +% ?dbg("parents:\n~p\n",[_Parents]), case convert_tag(Tag,Attrs) of {false,NewTag,NewAttrs} -> markup(NewTag, NewAttrs, Data); @@ -108,7 +109,7 @@ convert_aref([#xmlAttribute{name = href, value = V}|_Rest]) -> seealso end; convert_aref([#xmlAttribute{name = K}|Rest]) -> - io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]), + error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]), convert_aref(Rest). convert_aref_attrs(url,Attrs) -> Attrs; @@ -130,7 +131,7 @@ html_content([_H|T]) -> % convert_seealso_attrs([#xmlAttribute{name = href, value = V} = A|Rest]) -> % [A#xmlAttribute{name=marker,value=normalize_web_ref(V)}|convert_seealso_attrs(Rest)]; % convert_seealso_attrs([#xmlAttribute{name = K}|Rest]) -> -% io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]), +% error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]), % convert_seealso_attrs(Rest); % convert_seealso_attrs([]) -> % []. diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl index 9303bdb125..b41f55ec3d 100644 --- a/lib/xmerl/src/xmerl_regexp.erl +++ b/lib/xmerl/src/xmerl_regexp.erl @@ -41,6 +41,8 @@ -export([setup/1,compile_proc/2]). +-include("xmerl_internal.hrl"). + setup(RE0) -> RE = setup(RE0, [$^]), Pid = spawn(?MODULE,compile_proc,[self(),RE]), @@ -844,7 +846,7 @@ parse_error(E) -> throw({error,E}). re_apply(S, St, {RE,Sc}) -> Subs = erlang:make_tuple(Sc, none), %Make a sub-regexp table. Res = re_apply(RE, [], S, St, Subs), - %% io:format("~p x ~p -> ~p\n", [RE,S,Res]), + %% ?dbg("~p x ~p -> ~p\n", [RE,S,Res]), Res. re_apply(epsilon, More, S, P, Subs) -> %This always matches @@ -900,7 +902,7 @@ re_apply({comp_class,Cc}, More, [C|S], P, Subs) -> re_apply(C, More, [C|S], P, Subs) when is_integer(C) -> re_apply_more(More, S, P+1, Subs); re_apply(_RE, _More, _S, _P, _Subs) -> - %% io:format("~p : ~p\n", [_RE,_S]), + %% ?dbg("~p : ~p\n", [_RE,_S]), nomatch. %% re_apply_more([RegExp], String, Length, SubsExprs) -> @@ -1121,7 +1123,7 @@ build_nfa(C, N, S, NFA) when is_integer(C) -> nfa_char_class(Cc) -> Crs = lists:foldl(fun({C1,C2}, Set) -> add_element({C1,C2}, Set); (C, Set) -> add_element({C,C}, Set) end, [], Cc), - %% io:fwrite("cc: ~p\n", [Crs]), + %% ?dbg("cc: ~p\n", [Crs]), pack_crs(Crs). pack_crs([{C1,C2}=Cr,{C3,C4}|Crs]) when C1 =< C3, C2 >= C4 -> @@ -1141,7 +1143,7 @@ pack_crs([]) -> []. nfa_comp_class(Cc) -> Crs = nfa_char_class(Cc), - %% io:fwrite("comp: ~p\n", [Crs]), + %% ?dbg("comp: ~p\n", [Crs]), comp_crs(Crs, 0). comp_crs([{C1,C2}|Crs], Last) -> @@ -1192,7 +1194,7 @@ build_dfa(Set, Us, N, Ts, Ms, NFA) -> Crs1 = lists:usort(Crs0), %Must remove duplicates! %% Build list of disjoint test ranges. Test = disjoint_crs(Crs1), - %% io:fwrite("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]), + %% ?dbg("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]), build_dfa(Test, Set, Us, N, Ts, Ms, NFA). %% disjoint_crs([CharRange]) -> [CharRange]. @@ -1263,7 +1265,7 @@ move(Sts, Cr, NFA) -> {Crs,St} <- (element(N, NFA))#nfa_state.edges, is_list(Crs), %% begin -%% io:fwrite("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]), +%% ?dbg("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]), %% true %% end, in_crs(Cr, Crs) ]. @@ -1413,7 +1415,7 @@ build_trans(Ts0, NoAccept) -> %% Have transitions, convert to tuple. Ts2 = keysort(1, Ts1), {Tmin,Smin,Ts3} = min_trans(Ts2, NoAccept), - %% io:fwrite("exptr: ~p\n", [{Ts3,Tmin}]), + %% ?dbg("exptr: ~p\n", [{Ts3,Tmin}]), {Trans,Tmax,Smax} = expand_trans(Ts3, Tmin, NoAccept), {list_to_tuple(Trans),Tmin,Smin,Tmax,Smax,Sp1} end. diff --git a/lib/xmerl/src/xmerl_sax_old_dom.erl b/lib/xmerl/src/xmerl_sax_old_dom.erl index c357816a1e..08b20fffcd 100644 --- a/lib/xmerl/src/xmerl_sax_old_dom.erl +++ b/lib/xmerl/src/xmerl_sax_old_dom.erl @@ -28,6 +28,7 @@ %% Include files %%---------------------------------------------------------------------- -include("xmerl_sax_old_dom.hrl"). +-include("xmerl_internal.hrl"). %%---------------------------------------------------------------------- %% External exports @@ -126,7 +127,7 @@ build_dom(endDocument, content=lists:reverse(C) }]}; _ -> - io:format("~p\n", [D]), + %%?dbg("~p\n", [D]), ?error("we're not at end the document when endDocument event is encountered.") end; diff --git a/lib/xmerl/src/xmerl_sax_simple_dom.erl b/lib/xmerl/src/xmerl_sax_simple_dom.erl index 58a11f70fe..4fcd6b2372 100644 --- a/lib/xmerl/src/xmerl_sax_simple_dom.erl +++ b/lib/xmerl/src/xmerl_sax_simple_dom.erl @@ -28,6 +28,7 @@ %% Include files %%---------------------------------------------------------------------- -include("xmerl_sax_old_dom.hrl"). +-include("xmerl_internal.hrl"). %%---------------------------------------------------------------------- %% External exports @@ -127,7 +128,7 @@ build_dom(endDocument, State#xmerl_sax_simple_dom_state{dom=[Decl, {Tag, Attributes, lists:reverse(Content)}]}; _ -> - io:format("~p\n", [D]), + ?dbg("~p\n", [D]), ?error("we're not at end the document when endDocument event is encountered.") end; diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 8dfbc2b89e..c15188191a 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -147,7 +147,8 @@ S#xmerl_scanner.quiet -> ok; true -> - ok=io:format("~p- fatal: ~p~n", [?LINE, Reason]) + error_logger:error_msg("~p- fatal: ~p~n", [?LINE, Reason]), + ok end, fatal(Reason, S)). @@ -255,7 +256,7 @@ file(F, Options) -> end. int_file(F, Options,_ExtCharset) -> - %%io:format("int_file F=~p~n",[F]), + %%?dbg("int_file F=~p~n",[F]), case file:read_file(F) of {ok, Bin} -> int_string(binary_to_list(Bin), Options, filename:dirname(F),F); @@ -264,7 +265,7 @@ int_file(F, Options,_ExtCharset) -> end. int_file_decl(F, Options,_ExtCharset) -> -% io:format("int_file_decl F=~p~n",[F]), +% ?dbg("int_file_decl F=~p~n",[F]), case file:read_file(F) of {ok, Bin} -> int_string_decl(binary_to_list(Bin), Options, filename:dirname(F),F); @@ -294,7 +295,7 @@ int_string(Str, Options,FileName) -> int_string(Str, Options, XMLBase, FileName) -> S0=initial_state0(Options,XMLBase), S = S0#xmerl_scanner{filename=FileName}, - %%io:format("int_string1, calling xmerl_lib:detect_charset~n",[]), + %%?dbg("int_string1, calling xmerl_lib:detect_charset~n",[]), %% In case of no encoding attribute in document utf-8 is default, but %% another character set may be detected with help of Byte Order Marker or @@ -559,20 +560,20 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, Str0 end, %% M1 = erlang:memory(), -%% io:format("Memory status before prolog: ~p~n",[M1]), +%% ?dbg("Memory status before prolog: ~p~n",[M1]), {Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1), %% M2 = erlang:memory(), -%% io:format("Memory status after prolog: ~p~n",[M2]), - %%io:format("scan_document 2, prolog parsed~n",[]), +%% ?dbg("Memory status after prolog: ~p~n",[M2]), + %%?dbg("scan_document 2, prolog parsed~n",[]), T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag), %% M3 = erlang:memory(), -%% io:format("Memory status before element: ~p~n",[M3]), +%% ?dbg("Memory status before element: ~p~n",[M3]), {Res, T3, S3} = scan_element(T2,S2,Pos), %% M4 = erlang:memory(), -%% io:format("Memory status after element: ~p~n",[M4]), +%% ?dbg("Memory status after element: ~p~n",[M4]), {Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1), %% M5 = erlang:memory(), -%% io:format("Memory status after misc: ~p~n",[M5]), +%% ?dbg("Memory status after misc: ~p~n",[M5]), S5 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, line = S4#xmerl_scanner.line, @@ -604,7 +605,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, case schemaLocations(Res, S5) of {ok, Schemas} -> cleanup(S5), - %%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", + %%?dbg("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", %% [Schemas,Res,inherit_options(S5)]), XSDRes = xmerl_xsd:process_validate(Schemas, Res, inherit_options(S5)), @@ -1373,7 +1374,7 @@ fetch_not_parse(ExtSpec,S=#xmerl_scanner{fetch_fun=Fetch}) -> end. get_file(F,S) -> -% io:format("get_file F=~p~n",[F]), +% ?dbg("get_file F=~p~n",[F]), case file:read_file(F) of {ok,Bin} -> binary_to_list(Bin); @@ -4088,7 +4089,7 @@ schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) -> end. inherit_options(S) -> - %%io:format("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]), + %%?dbg("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]), [{xsdbase,S#xmerl_scanner.xmlbase}]. handle_schema_result({XSDRes=#xmlElement{},_},S5) -> @@ -4227,7 +4228,7 @@ string_to_char_set(_,Str) -> %% NewTot = %% case {lists:keysearch(total,1,Mem),OldTot*1.1} of %% {{_,{_,Tot}},Tot110} when Tot > Tot110 -> -%% io:format("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]), +%% ?dbg("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]), %% Tot; %% {{_,{_,Tot}},_} -> %% Tot diff --git a/lib/xmerl/src/xmerl_ucs.erl b/lib/xmerl/src/xmerl_ucs.erl index 6550a9d954..48ae24b1de 100644 --- a/lib/xmerl/src/xmerl_ucs.erl +++ b/lib/xmerl/src/xmerl_ucs.erl @@ -227,7 +227,7 @@ from_ucs4be(<<Ch:32/big-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs4be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs4be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs4be}. char_to_ucs4le(Ch) -> @@ -247,7 +247,7 @@ from_ucs4le(<<Ch:32/little-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs4le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs4le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs4le}. @@ -269,7 +269,7 @@ from_ucs2be(<<Ch:16/big-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs2be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs2be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs2be}. char_to_ucs2le(Ch) -> @@ -287,7 +287,7 @@ from_ucs2le(<<Ch:16/little-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs2le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs2le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs2le}. @@ -331,7 +331,7 @@ from_utf16be(<<Hi:16/big-unsigned-integer, Lo:16/big-unsigned-integer, from_utf16be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_utf16be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_utf16be}. char_to_utf16le(Ch) when is_integer(Ch), Ch >= 0 -> @@ -363,7 +363,7 @@ from_utf16le(<<Hi:16/little-unsigned-integer, Lo:16/little-unsigned-integer, from_utf16le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_utf16le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_utf16le}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -571,3 +571,6 @@ test_charset(Fun,Input) -> false end. +ucs_error(Bin,Acc,Tail) -> + error_logger:error_msg("~w: Bin=~p~n Acc=~p~n Tail=~p~n", + [?MODULE,Bin,Acc,Tail]). diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl index 60f228474b..e1d71aa818 100644 --- a/lib/xmerl/src/xmerl_validate.erl +++ b/lib/xmerl/src/xmerl_validate.erl @@ -23,7 +23,7 @@ -include("xmerl.hrl"). % record def, macros - +-include("xmerl_internal.hrl"). %% +type validate(xmerl_scanner(),xmlElement())-> @@ -300,7 +300,7 @@ test_attribute_value('NMTOKEN',#xmlAttribute{name=Name,value=V}=Attr, true-> ok; false-> - %%io:format("Warning*** nmtoken,value_incorrect: ~p~n",[V]), + %%?dbg("nmtoken,value_incorrect: ~p~n",[V]), exit({error,{invalid_value_nmtoken,Name,V}}) end end, @@ -381,7 +381,7 @@ test_attribute_value({Type,L},#xmlAttribute{value=Value}=Attr,Default,_S) exit({error,{duplicate_tokens_not_allowed,{list,L}}}) end; test_attribute_value(_Rule,Attr,_,_) -> -% io:format("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]), +% ?dbg("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]), Attr. @@ -423,11 +423,11 @@ parse({'+',SubRule}, XMLS, Rules, WSaction, S) -> parse({choice,CHOICE}, XMLS, Rules, WSaction, S)-> % case XMLS of % [] -> -% io:format("~p~n",[{choice,CHOICE,[]}]); +% ?dbg("~p~n",[{choice,CHOICE,[]}]); % [#xmlElement{name=Name,pos=Pos}|_] -> -% io:format("~p~n",[{choice,CHOICE,{Name,Pos}}]); +% ?dbg("~p~n",[{choice,CHOICE,{Name,Pos}}]); % [#xmlText{value=V}|_] -> -% io:format("~p~n",[{choice,CHOICE,{text,V}}]) +% ?dbg("~p~n",[{choice,CHOICE,{text,V}}]) % end, choice(CHOICE, XMLS, Rules, WSaction, S); parse(empty, [], _Rules, _WSaction, _S) -> @@ -550,10 +550,10 @@ star(Rule,XMLS,Rules,WSaction,Tree,S) -> {WS,XMLS1} = whitespace_action(XMLS,WSaction), case parse(Rule,XMLS1,Rules,WSaction,S) of {error, _E, {{next,N},{act,A}}}-> - %%io:format("Error~p~n",[_E]), + %%?dbg("Error~p~n",[_E]), {WS++Tree++A,N}; {error, _E}-> - %%io:format("Error~p~n",[_E]), + %%?dbg("Error~p~n",[_E]), % {WS++[Tree],[]}; case whitespace_action(XMLS,ws_action(WSaction,remove)) of {[],_} -> diff --git a/lib/xmerl/src/xmerl_xml.erl b/lib/xmerl/src/xmerl_xml.erl index 702a654629..3354592cf1 100644 --- a/lib/xmerl/src/xmerl_xml.erl +++ b/lib/xmerl/src/xmerl_xml.erl @@ -31,6 +31,7 @@ -import(xmerl_lib, [markup/3, empty_tag/2, export_text/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). '#xml-inheritance#'() -> []. @@ -39,7 +40,7 @@ %% The '#text#' function is called for every text segment. '#text#'(Text) -> -%io:format("Text=~p~n",[Text]), +%?dbg("Text=~p~n",[Text]), export_text(Text). @@ -55,8 +56,8 @@ %% The '#element#' function is the default handler for XML elements. '#element#'(Tag, [], Attrs, _Parents, _E) -> -%io:format("Empty Tag=~p~n",[Tag]), +%?dbg("Empty Tag=~p~n",[Tag]), empty_tag(Tag, Attrs); '#element#'(Tag, Data, Attrs, _Parents, _E) -> -%io:format("Tag=~p~n",[Tag]), +%?dbg("Tag=~p~n",[Tag]), markup(Tag, Attrs, Data). diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index be0e863ce4..bce2a199f4 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -128,18 +128,18 @@ string(Str, Node, Parents, Doc, Options) -> [{H, P}|_] when is_atom(H), is_integer(P) -> full_parents(Parents, Doc) end, -%io:format("string FullParents=~p~n",[FullParents]), +%?dbg("string FullParents=~p~n",[FullParents]), ContextNode=#xmlNode{type = node_type(Node), node = Node, parents = FullParents}, -%io:format("string ContextNode=~p~n",[ContextNode]), +%?dbg("string ContextNode=~p~n",[ContextNode]), WholeDoc = whole_document(Doc), -%io:format("string WholeDoc=~p~n",[WholeDoc]), +%?dbg("string WholeDoc=~p~n",[WholeDoc]), Context=(new_context(Options))#xmlContext{context_node = ContextNode, whole_document = WholeDoc}, -%io:format("string Context=~p~n",[Context]), +%?dbg("string Context=~p~n",[Context]), #state{context = NewContext} = match(Str, #state{context = Context}), -%io:format("string NewContext=~p~n",[NewContext]), +%?dbg("string NewContext=~p~n",[NewContext]), case NewContext#xmlContext.nodeset of ScalObj = #xmlObj{type=Scalar} when Scalar == boolean; Scalar == number; Scalar == string -> @@ -274,7 +274,7 @@ eval_pred(Predicate, S = #state{context = C = NewNodeSet = lists:filter( fun(Node) -> - %io:format("current node: ~p~n", [write_node(Node)]), + %?dbg("current node: ~p~n", [write_node(Node)]), ThisContext = C#xmlContext{context_node = Node}, xmerl_xpath_pred:eval(Predicate, ThisContext) end, NodeSet), @@ -461,7 +461,7 @@ match_descendant_or_self(Tok, N, Acc, Context) -> match_child(Tok, N, Acc, Context) -> - %io:format("match_child(~p)~n", [write_node(N)]), + %?dbg("match_child(~p)~n", [write_node(N)]), #xmlNode{parents = Ps, node = Node, type = Type} = N, case Type of El when El == element; El == root_node -> @@ -738,7 +738,7 @@ node_test({prefix_test, Prefix}, #xmlNode{node = N}, Context) -> end; node_test({name, {Tag, _Prefix, _Local}}, #xmlNode{node = #xmlElement{name = Tag}}=_N, _Context) -> - %io:format("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]), + %?dbg("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]), true; node_test({name, {Tag, Prefix, Local}}, #xmlNode{node = #xmlElement{name = Name, @@ -816,7 +816,7 @@ node_test({processing_instruction, Name1}, #xmlNode{node = #xmlPI{name = Name2}}, _Context) -> Name1 == atom_to_list(Name2); node_test(_Other, _N, _Context) -> - %io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), + %?dbg("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), false. diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl index b94f3bb14d..acefa68f7e 100644 --- a/lib/xmerl/src/xmerl_xpath_pred.erl +++ b/lib/xmerl/src/xmerl_xpath_pred.erl @@ -58,6 +58,7 @@ -export([core_function/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). -include("xmerl_xpath.hrl"). %% -record(obj, {type, @@ -88,7 +89,7 @@ eval(Expr, C = #xmlContext{context_node = #xmlNode{pos = Pos}}) -> _ -> mk_boolean(C, Obj) end, -% io:format("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]), +% ?dbg("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]), Res. diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index 16d02f571d..c84cb93bb8 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -381,7 +381,7 @@ initiate_state2(S,[{target_namespace,_NS}|T]) -> %% initiate_state2(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T); initiate_state2(S,T); %% used in validation phase initiate_state2(S,[H|T]) -> - error_msg("Invalid option: ~p~n",[H]), + error_msg("~w: invalid option: ~p~n",[?MODULE, H]), initiate_state2(S,T). validation_options(S,[{target_namespace,NS}|T]) -> @@ -5391,7 +5391,7 @@ search_attribute(_,{Name,_,_},SchemaAtts) -> end. error_msg(Format,Args) -> - io:format(Format,Args). + error_logger:error_msg(Format,Args). add_once(El,L) -> @@ -5425,7 +5425,7 @@ add_key_once(Key,N,El,L) -> %% "/"++filename:join(L). %% mk_xml_path(Parents,Type,Pos) -> -%% %% io:format("mk_xml_path: Parents = ~p~n",[Parents]), +%% %% ?dbg("mk_xml_path: Parents = ~p~n",[Parents]), %% {filename:join([[io_lib:format("/~w(~w)",[X,Y])||{X,Y}<-Parents],Type]),Pos}. %% @spec format_error(Errors) -> Result diff --git a/lib/xmerl/src/xmerl_xsd_type.erl b/lib/xmerl/src/xmerl_xsd_type.erl index 0f46b1f9aa..acb988b9bc 100644 --- a/lib/xmerl/src/xmerl_xsd_type.erl +++ b/lib/xmerl/src/xmerl_xsd_type.erl @@ -29,6 +29,7 @@ -export([compare_durations/2,compare_dateTime/2]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). -include("xmerl_xsd.hrl"). @@ -687,7 +688,8 @@ facet_fun(Type,{fractionDigits,V}) -> fractionDigits_fun(Type,list_to_integer(V)); facet_fun(Type,F) -> fun(_X_) -> - io:format("Warning: not valid facet on ~p ~p~n",[Type,F]) + error_logger:warning_msg("~w: not valid facet on ~p ~p~n", + [?MODULE,Type,F]) end. @@ -1075,7 +1077,7 @@ compare_floats(F1,F2) when F1=="-INF";F2=="INF" -> compare_floats(Str1,Str2) -> F1={S1,_B1,_D1,_E1} = str_to_float(Str1), F2={S2,_B2,_D2,_E2} = str_to_float(Str2), -% io:format("F1: ~p~nF2: ~p~n",[F1,F2]), +% ?dbg("F1: ~p~nF2: ~p~n",[F1,F2]), if S1=='-',S2=='+' -> lt; S1=='+',S2=='-' -> gt; |