diff options
86 files changed, 5212 insertions, 1939 deletions
diff --git a/lib/kernel/src/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl index aea1ab81ba..aea1ab81ba 100644 --- a/lib/kernel/src/dist.hrl +++ b/bootstrap/lib/kernel/include/dist.hrl diff --git a/lib/kernel/src/dist_util.hrl b/bootstrap/lib/kernel/include/dist_util.hrl index f2b0598532..f2b0598532 100644 --- a/lib/kernel/src/dist_util.hrl +++ b/bootstrap/lib/kernel/include/dist_util.hrl diff --git a/lib/kernel/src/net_address.hrl b/bootstrap/lib/kernel/include/net_address.hrl index 5342076507..5342076507 100644 --- a/lib/kernel/src/net_address.hrl +++ b/bootstrap/lib/kernel/include/net_address.hrl diff --git a/erts/configure.in b/erts/configure.in index 3dbf98b876..88337e79fd 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -3725,7 +3725,7 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_RUNTIME_LIBDIR="$rdir/lib" SSL_LIBDIR="$dir/lib" SSL_CRYPTO_LIBNAME=libeay32 - SSL_CRYPTO_LIBNAME=ssleay32 + SSL_SSL_LIBNAME=ssleay32 elif test -f "$dir/lib/openssl.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib" SSL_LIBDIR="$dir/lib" @@ -3907,7 +3907,7 @@ dnl so it is - be adoptable elif test -f "$with_ssl/lib/libeay32.lib"; then SSL_LIBDIR="$with_ssl/lib" SSL_CRYPTO_LIBNAME=libeay32 - SSL_CRYPTO_LIBNAME=ssleay32 + SSL_SSL_LIBNAME=ssleay32 else # This probably wont work, but that's what the user said, so... SSL_LIBDIR="$with_ssl/lib" diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 79dc6838a6..7fba12aae0 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1026,6 +1026,56 @@ b</pre> </desc> </func> <func> + <name>erlang:external_size(Term) -> integer() >= 0</name> + <fsummary>Calculate the maximum size for a term encoded in the Erlang + external term format</fsummary> + <type> + <v>Term = term()</v> + </type> + <desc> + <p>Calculates, without doing the encoding, the maximum byte size for + a term encoded in the Erlang external term format. The following + condition applies always:</p> + <p> + <pre> +> <input>Size1 = byte_size(term_to_binary(Term)),</input> +> <input>Size2 = erlang:external_size(Term),</input> +> <input>true = Size1 =< Size2.</input> +true + </pre> + </p> + <p>This is equivalent to a call to: <code>erlang:external_size(Term, []) + </code></p> + </desc> + </func> + <func> + <name>erlang:external_size(Term, [Option]) -> integer() >= 0</name> + <fsummary>Calculate the maximum size for a term encoded in the Erlang + external term format</fsummary> + <type> + <v>Term = term()</v> + <v>Option = {minor_version, Version}</v> + </type> + <desc> + <p>Calculates, without doing the encoding, the maximum byte size for + a term encoded in the Erlang external term format. The following + condition applies always:</p> + <p> + <pre> +> <input>Size1 = byte_size(term_to_binary(Term, Options)),</input> +> <input>Size2 = erlang:external_size(Term, Options),</input> +> <input>true = Size1 =< Size2.</input> +true + </pre> + </p> + <p>The option <c>{minor_version, Version}</c> specifies how floats + are encoded. See + <seealso marker="#term_to_binary/2">term_to_binary/2</seealso> for + a more detailed description. + </p> + </desc> + </func> + <func> <name>float(Number) -> float()</name> <fsummary>Convert a number to a float</fsummary> <type> diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index b171e99e03..831c0b1ce6 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -87,6 +87,8 @@ bif erlang:exit/2 bif 'erl.lang.proc':signal/2 ebif_signal_2 exit_2 bif erlang:external_size/1 bif 'erl.lang.term':external_size/1 ebif_external_size_1 +bif erlang:external_size/2 +bif 'erl.lang.term':external_size/2 ebif_external_size_2 ubif erlang:float/1 ubif 'erl.lang.number':to_float/1 ebif_to_float_1 float_1 bif erlang:float_to_list/1 diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index ea781a6cd0..f3db3f9326 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -578,7 +578,15 @@ int enif_is_identical(Eterm lhs, Eterm rhs) int enif_compare(Eterm lhs, Eterm rhs) { - return CMP(lhs,rhs); + Sint result = CMP(lhs,rhs); + + if (result < 0) { + return -1; + } else if (result > 0) { + return 1; + } + + return result; } int enif_get_tuple(ErlNifEnv* env, Eterm tpl, int* arity, const Eterm** array) diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 1a102f7187..6953e7fe7d 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -459,6 +459,12 @@ Uint erts_encode_ext_size(Eterm term) + 1 /* VERSION_MAGIC */; } +Uint erts_encode_ext_size_2(Eterm term, unsigned dflags) +{ + return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS|dflags) + + 1 /* VERSION_MAGIC */; +} + Uint erts_encode_ext_size_ets(Eterm term) { return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS|DFLAGS_INTERNAL_TAGS); @@ -1262,6 +1268,49 @@ external_size_1(Process* p, Eterm Term) } Eterm +external_size_2(Process* p, Eterm Term, Eterm Flags) +{ + Uint size; + Uint flags = TERM_TO_BINARY_DFLAGS; + + while (is_list(Flags)) { + Eterm arg = CAR(list_val(Flags)); + Eterm* tp; + + if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) { + if (tp[1] == am_minor_version && is_small(tp[2])) { + switch (signed_val(tp[2])) { + case 0: + break; + case 1: + flags |= DFLAG_NEW_FLOATS; + break; + default: + goto error; + } + } else { + goto error; + } + } else { + error: + BIF_ERROR(p, BADARG); + } + Flags = CDR(list_val(Flags)); + } + if (is_not_nil(Flags)) { + goto error; + } + + size = erts_encode_ext_size_2(Term, flags); + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + +Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { Uint size; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index d8287b96a4..72fe74baf2 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -160,6 +160,7 @@ Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); Uint erts_encode_ext_size(Eterm); +Uint erts_encode_ext_size_2(Eterm, unsigned); Uint erts_encode_ext_size_ets(Eterm); void erts_encode_ext(Eterm, byte **); byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap); diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 459dc84565..d9fc876482 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -441,6 +441,11 @@ terms(Config) when is_list(Config) -> Sz when is_integer(Sz), size(Bin) =< Sz -> ok end, + Bin1 = term_to_binary(Term, [{minor_version, 1}]), + case erlang:external_size(Bin1, [{minor_version, 1}]) of + Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 -> + ok + end, Term = binary_to_term(Bin), Term = binary_to_term(Bin, [safe]), Unaligned = make_unaligned_sub_binary(Bin), @@ -473,7 +478,12 @@ terms_float(Config) when is_list(Config) -> Term = binary_to_term(Bin0), Bin1 = term_to_binary(Term, [{minor_version,1}]), Term = binary_to_term(Bin1), - true = size(Bin1) < size(Bin0) + true = size(Bin1) < size(Bin0), + Size0 = erlang:external_size(Term), + Size00 = erlang:external_size(Term, [{minor_version, 0}]), + Size1 = erlang:external_size(Term, [{minor_version, 1}]), + true = (Size0 =:= Size00), + true = Size1 < Size0 end). external_size(Config) when is_list(Config) -> @@ -489,7 +499,9 @@ external_size(Config) when is_list(Config) -> io:format(" Aligned size: ~p\n", [Sz1]), io:format("Unaligned size: ~p\n", [Sz2]), ?line ?t:fail() - end. + end, + ?line erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}]), + ?line erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}]). external_size_1(Term, Size0, Limit) when Size0 < Limit -> case erlang:external_size(Term) of diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 9c31b7f78d..d95789fa6e 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -281,6 +281,12 @@ types(Config) when is_list(Config) -> end, int_list()), ?line verify_tmpmem(TmpMem), + ?line true = (compare(-1294536544000, -1178704800000) < 0), + ?line true = (compare(-1178704800000, -1294536544000) > 0), + ?line true = (compare(-295147905179352825856, -36893488147419103232) < 0), + ?line true = (compare(-36893488147419103232, -295147905179352825856) > 0), + ?line true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0), + ?line true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0), ok. int_list() -> diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 5debae26b6..da575affa1 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -102,7 +102,8 @@ void run(EpmdVars *g) dbg_printf(g,2,"try to initiate listening port %d", g->port); - if (g->addresses != NULL) + if (g->addresses != NULL && /* String contains non-separator characters if: */ + g->addresses[strspn(g->addresses," ,")] != '\000') { char *tmp; char *token; diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c index 35b148990a..5e94ff19db 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -55,6 +55,12 @@ # ifdef HAVE_UNISTD_H # include <unistd.h> # endif +# if defined(_SC_NPROC_CONF) && !defined(_SC_NPROCESSORS_CONF) +# define _SC_NPROCESSORS_CONF _SC_NPROC_CONF +# endif +# if defined(_SC_NPROC_ONLN) && !defined(_SC_NPROCESSORS_ONLN) +# define _SC_NPROCESSORS_ONLN _SC_NPROC_ONLN +# endif # if (defined(NO_SYSCONF) || !defined(_SC_NPROCESSORS_CONF)) # ifdef HAVE_SYS_SYSCTL_H # include <sys/sysctl.h> diff --git a/erts/test/autoimport_SUITE.erl b/erts/test/autoimport_SUITE.erl index 0e4708e046..71ed5204b1 100644 --- a/erts/test/autoimport_SUITE.erl +++ b/erts/test/autoimport_SUITE.erl @@ -87,10 +87,21 @@ autoimports(Config) when is_list(Config) -> xml(XMLFile) -> {ok,File} = file:open(XMLFile,[read]), + xskip_to_funcs(file:read_line(File),File), DocData = xloop(file:read_line(File),File), + true = DocData =/= [], file:close(File), analyze(DocData). +%% Skip lines up to and including the <funcs> tag. +xskip_to_funcs({ok,Line},File) -> + case re:run(Line,"\\<funcs\\>",[{capture,none}]) of + nomatch -> + xskip_to_funcs(file:read_line(File),File); + match -> + ok + end. + xloop({ok,Line},File) -> case re:run(Line,"\\<name\\>",[{capture,none}]) of nomatch -> diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index 62e0e6813d..2b5cb11f02 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -213,13 +213,34 @@ deep_cwd_1(PrivDir) -> arg_overflow(Config) when is_list(Config) -> ?line {SrcDir, _OutDir, Cmd} = get_cmd(Config), ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), - ?line Args = lists:flatten([ ["-D", integer_to_list(N), "=1 "] || - N <- lists:seq(1,10000) ]), + %% Each -D option will be expanded to three arguments when + %% invoking 'erl'. + ?line NumDOptions = num_d_options(), + ?line Args = lists:flatten([ ["-D", integer_to_list(N, 36), "=1 "] || + N <- lists:seq(1, NumDOptions) ]), ?line run(Config, Cmd, FileName, Args, ["Warning: function foo/0 is unused\$", "_OK_"]), ok. +num_d_options() -> + case {os:type(),os:version()} of + {{win32,_},_} -> + %% The maximum size of a command line in the command + %% shell on Windows is 8191 characters. + %% Each -D option is expanded to "@dv NN 1", i.e. + %% 8 characters. (Numbers up to 1295 can be expressed + %% as two 36-base digits.) + 1000; + {{unix,linux},Version} when Version < {2,6,23} -> + %% On some older 64-bit versions of Linux, the maximum number + %% of arguments is 16383. + %% See: http://www.in-ulm.de/~mascheck/various/argmax/ + 5440; + {_,_} -> + 12000 + end. + erlc() -> case os:find_executable("erlc") of false -> diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index 775e5a9b89..285537643e 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -41,6 +41,7 @@ CFLAGS = $(DED_CFLAGS) SSL_LIBDIR = @SSL_LIBDIR@ SSL_INCLUDE = @SSL_INCLUDE@ SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@ +SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@ INCLUDES = $(SSL_INCLUDE) $(DED_INCLUDES) @@ -84,7 +85,7 @@ DYNAMIC_CRYPTO_LIB=@SSL_DYNAMIC_ONLY@ ifeq ($(DYNAMIC_CRYPTO_LIB),yes) SSL_DED_LD_RUNTIME_LIBRARY_PATH = @SSL_DED_LD_RUNTIME_LIBRARY_PATH@ -CRYPTO_LINK_LIB=$(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -l$(SSL_CRYPTO_LIBNAME) +CRYPTO_LINK_LIB=$(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) else SSL_DED_LD_RUNTIME_LIBRARY_PATH= CRYPTO_LINK_LIB=$(SSL_LIBDIR)/lib$(SSL_CRYPTO_LIBNAME).a @@ -108,7 +109,7 @@ $(LIBDIR)/crypto$(TYPEMARKER).so: $(OBJS) $(LIBDIR)/crypto$(TYPEMARKER).dll: $(OBJS) $(INSTALL_DIR) $(LIBDIR) - $(LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(OBJS) -l$(SSL_CRYPTO_LIBNAME) + $(LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) clean: ifeq ($(findstring win32,$(TARGET)), win32) diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 8cb16d8f09..659297f993 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -528,7 +528,7 @@ handle_apply(Tree, Map, State) -> {CallSitesKnown, FunList} = case state__lookup_call_site(Tree, State2) of error -> {false, []}; - {ok, [external]} -> {false, {}}; + {ok, [external]} -> {false, []}; {ok, List} -> {true, List} end, case CallSitesKnown of @@ -554,7 +554,13 @@ handle_apply(Tree, Map, State) -> {State3, enter_type(Op, OpType1, Map2), t_none()}; false -> Map3 = enter_type_lists(Args, NewArgs, Map2), - {State2, enter_type(Op, OpType1, Map3), t_fun_range(OpType1)} + Range0 = t_fun_range(OpType1), + Range = + case t_is_unit(Range0) of + true -> t_none(); + false -> Range0 + end, + {State2, enter_type(Op, OpType1, Map3), Range} end end; true -> @@ -2946,7 +2952,7 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, %% Check if the function has a contract that allows this. Warn = case Contract of - none -> true; + none -> not parent_allows_this(FunLbl, State); {value, C} -> GenRet = dialyzer_contracts:get_contract_return(C), not t_is_unit(GenRet) @@ -3434,6 +3440,33 @@ map_pats(Pats) -> end, cerl_trees:map(Fun, Pats). +parent_allows_this(FunLbl, #state{callgraph = Callgraph, plt = Plt} =State) -> + case state__is_escaping(FunLbl, State) of + false -> false; % if it isn't escaping it can't be a return value + true -> + case state__lookup_name(FunLbl, State) of + {_M, _F, _A} -> false; % if it has a name it is not a fun + _ -> + case dialyzer_callgraph:in_neighbours(FunLbl, Callgraph) of + [Parent] -> + case state__lookup_name(Parent, State) of + {_M, _F, _A} = PMFA -> + case dialyzer_plt:lookup_contract(Plt, PMFA) of + none -> false; + {value, C} -> + GenRet = dialyzer_contracts:get_contract_return(C), + case erl_types:t_is_fun(GenRet) of + false -> false; % element of structure? far-fetched... + true -> t_is_unit(t_fun_range(GenRet)) + end + end; + _ -> false % parent should have a name to have a contract + end; + _ -> false % called in other funs? far-fetched... + end + end + end. + classify_returns(Tree) -> case find_terminals(cerl:fun_body(Tree)) of {false, false} -> no_match; diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 65c2ff76bb..06863d89a7 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -62,7 +62,8 @@ -type dep() :: integer(). %% type variable names used as constraint ids -type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_} --record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()]}). +-record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()], + origin :: integer()}). -type constr_op() :: 'eq' | 'sub'. -type fvar_or_type() :: #fun_var{} | erl_types:erl_type(). @@ -121,8 +122,10 @@ -ifdef(DEBUG). -define(debug(__String, __Args), io:format(__String, __Args)). +-define(mk_fun_var(Fun, Vars), mk_fun_var(?LINE, Fun, Vars)). -else. -define(debug(__String, __Args), ok). +-define(mk_fun_var(Fun, Vars), mk_fun_var(Fun, Vars)). -endif. %% ============================================================================ @@ -218,10 +221,10 @@ traverse(Tree, DefinedVars, State) -> binary -> {State1, SegTypes} = traverse_list(cerl:binary_segments(Tree), DefinedVars, State), - Type = mk_fun_var(fun(Map) -> - TmpSegTypes = lookup_type_list(SegTypes, Map), - t_bitstr_concat(TmpSegTypes) - end, SegTypes), + Type = ?mk_fun_var(fun(Map) -> + TmpSegTypes = lookup_type_list(SegTypes, Map), + t_bitstr_concat(TmpSegTypes) + end, SegTypes), {state__store_conj(mk_var(Tree), sub, Type, State1), mk_var(Tree)}; bitstr -> Size = cerl:bitstr_size(Tree), @@ -236,7 +239,7 @@ traverse(Tree, DefinedVars, State) -> N when is_integer(N) -> {State1, t_bitstr(0, N)}; any -> % Size is not a literal {state__store_conj(SizeType, sub, t_non_neg_integer(), State1), - mk_fun_var(bitstr_constr(SizeType, UnitVal), [SizeType])} + ?mk_fun_var(bitstr_constr(SizeType, UnitVal), [SizeType])} end, ValTypeConstr = case cerl:concrete(cerl:bitstr_type(Tree)) of @@ -250,8 +253,8 @@ traverse(Tree, DefinedVars, State) -> case state__is_in_match(State1) of true -> Flags = cerl:concrete(cerl:bitstr_flags(Tree)), - mk_fun_var(bitstr_val_constr(SizeType, UnitVal, Flags), - [SizeType]); + ?mk_fun_var(bitstr_val_constr(SizeType, UnitVal, Flags), + [SizeType]); false -> t_integer() end; utf8 -> t_integer(); @@ -281,24 +284,24 @@ traverse(Tree, DefinedVars, State) -> {State, t_cons(HdVar, TlVar)}; false -> ConsVar = mk_var(Tree), - ConsType = mk_fun_var(fun(Map) -> - t_cons(lookup_type(HdVar, Map), - lookup_type(TlVar, Map)) - end, [HdVar, TlVar]), - HdType = mk_fun_var(fun(Map) -> - Cons = lookup_type(ConsVar, Map), - case t_is_cons(Cons) of - false -> t_any(); - true -> t_cons_hd(Cons) - end - end, [ConsVar]), - TlType = mk_fun_var(fun(Map) -> - Cons = lookup_type(ConsVar, Map), - case t_is_cons(Cons) of - false -> t_any(); - true -> t_cons_tl(Cons) - end - end, [ConsVar]), + ConsType = ?mk_fun_var(fun(Map) -> + t_cons(lookup_type(HdVar, Map), + lookup_type(TlVar, Map)) + end, [HdVar, TlVar]), + HdType = ?mk_fun_var(fun(Map) -> + Cons = lookup_type(ConsVar, Map), + case t_is_cons(Cons) of + false -> t_any(); + true -> t_cons_hd(Cons) + end + end, [ConsVar]), + TlType = ?mk_fun_var(fun(Map) -> + Cons = lookup_type(ConsVar, Map), + case t_is_cons(Cons) of + false -> t_any(); + true -> t_cons_tl(Cons) + end + end, [ConsVar]), State2 = state__store_conj_lists([HdVar, TlVar, ConsVar], sub, [HdType, TlType, ConsType], State1), @@ -656,25 +659,25 @@ get_plt_constr(MFA, Dst, ArgVars, State) -> {RetType, ArgCs} = case PltRes of none -> - {mk_fun_var(fun(Map) -> - ArgTypes = lookup_type_list(ArgVars, Map), - dialyzer_contracts:get_contract_return(C, ArgTypes) - end, ArgVars), GenArgs}; + {?mk_fun_var(fun(Map) -> + ArgTypes = lookup_type_list(ArgVars, Map), + dialyzer_contracts:get_contract_return(C, ArgTypes) + end, ArgVars), GenArgs}; {value, {PltRetType, PltArgTypes}} -> %% Need to combine the contract with the success typing. - {mk_fun_var( - fun(Map) -> - ArgTypes0 = lookup_type_list(ArgVars, Map), - ArgTypes = case FunModule =:= Module of - false -> - List = lists:zip(PltArgTypes, ArgTypes0), - [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) - || {T1, T2} <- List]; - true -> ArgTypes0 - end, - CRet = dialyzer_contracts:get_contract_return(C, ArgTypes), - t_inf(CRet, PltRetType, opaque) - end, ArgVars), + {?mk_fun_var( + fun(Map) -> + ArgTypes0 = lookup_type_list(ArgVars, Map), + ArgTypes = case FunModule =:= Module of + false -> + List = lists:zip(PltArgTypes, ArgTypes0), + [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) + || {T1, T2} <- List]; + true -> ArgTypes0 + end, + CRet = dialyzer_contracts:get_contract_return(C, ArgTypes), + t_inf(CRet, PltRetType, opaque) + end, ArgVars), [t_inf(X, Y, opaque) || {X, Y} <- lists:zip(GenArgs, PltArgTypes)]} end, state__store_conj_lists([Dst|ArgVars], sub, [RetType|ArgCs], State) @@ -766,10 +769,10 @@ handle_clauses_1([Clause|Tail], TopVar, Arg, DefinedVars, case SubtrTypes =:= overflow of true -> S; false -> - SubtrPatVar = mk_fun_var(fun(Map) -> - TmpType = lookup_type(Arg, Map), - t_subtract_list(TmpType, SubtrTypes) - end, [Arg]), + SubtrPatVar = ?mk_fun_var(fun(Map) -> + TmpType = lookup_type(Arg, Map), + t_subtract_list(TmpType, SubtrTypes) + end, [Arg]), state__store_conj(Arg, sub, SubtrPatVar, S) end end, @@ -1043,10 +1046,10 @@ handle_guard(Guard, DefinedVars, State) -> get_bif_constr({erlang, Op, 2}, Dst, Args = [Arg1, Arg2], _State) when Op =:= '+'; Op =:= '-'; Op =:= '*' -> - ReturnType = mk_fun_var(fun(Map) -> - TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, Op, 2, TmpArgTypes) - end, Args), + ReturnType = ?mk_fun_var(fun(Map) -> + TmpArgTypes = lookup_type_list(Args, Map), + erl_bif_types:type(erlang, Op, 2, TmpArgTypes) + end, Args), ArgFun = fun(A, Pos) -> F = @@ -1074,7 +1077,7 @@ get_bif_constr({erlang, Op, 2}, Dst, Args = [Arg1, Arg2], _State) end end end, - mk_fun_var(F, [Dst, A]) + ?mk_fun_var(F, [Dst, A]) end, Arg1FunVar = ArgFun(Arg2, 2), Arg2FunVar = ArgFun(Arg1, 1), @@ -1131,12 +1134,12 @@ get_bif_constr({erlang, Op, 2}, Dst, [Arg1, Arg2] = Args, _State) '>=' -> {ArgFun(Arg1, Arg2, '>='), ArgFun(Arg2, Arg1, '=<')} end, DstArgs = [Dst, Arg1, Arg2], - Arg1Var = mk_fun_var(Arg1Fun, DstArgs), - Arg2Var = mk_fun_var(Arg2Fun, DstArgs), - DstVar = mk_fun_var(fun(Map) -> - TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, Op, 2, TmpArgTypes) - end, Args), + Arg1Var = ?mk_fun_var(Arg1Fun, DstArgs), + Arg2Var = ?mk_fun_var(Arg2Fun, DstArgs), + DstVar = ?mk_fun_var(fun(Map) -> + TmpArgTypes = lookup_type_list(Args, Map), + erl_bif_types:type(erlang, Op, 2, TmpArgTypes) + end, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstVar), mk_constraint(Arg1, sub, Arg1Var), mk_constraint(Arg2, sub, Arg2Var)]); @@ -1172,13 +1175,13 @@ get_bif_constr({erlang, '++', 2}, Dst, [Hd, Tl] = Args, _State) -> end end, DstL = [Dst], - HdVar = mk_fun_var(HdFun, DstL), - TlVar = mk_fun_var(TlFun, DstL), + HdVar = ?mk_fun_var(HdFun, DstL), + TlVar = ?mk_fun_var(TlFun, DstL), ArgTypes = erl_bif_types:arg_types(erlang, '++', 2), - ReturnType = mk_fun_var(fun(Map) -> - TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, '++', 2, TmpArgTypes) - end, Args), + ReturnType = ?mk_fun_var(fun(Map) -> + TmpArgTypes = lookup_type_list(Args, Map), + erl_bif_types:type(erlang, '++', 2, TmpArgTypes) + end, Args), Cs = mk_constraints(Args, sub, ArgTypes), mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType), mk_constraint(Hd, sub, HdVar), @@ -1209,7 +1212,7 @@ get_bif_constr({erlang, is_function, 2}, Dst, [Fun, Arity], _State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Dst, Arity]), + ArgV = ?mk_fun_var(ArgFun, [Dst, Arity]), mk_conj_constraint_list([mk_constraint(Dst, sub, t_boolean()), mk_constraint(Arity, sub, t_integer()), mk_constraint(Fun, sub, ArgV)]); @@ -1232,12 +1235,12 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Dst]), + ArgV = ?mk_fun_var(ArgFun, [Dst]), DstFun = fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), erl_bif_types:type(erlang, is_record, 2, TmpArgTypes) end, - DstV = mk_fun_var(DstFun, Args), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Tag, sub, t_atom()), mk_constraint(Var, sub, ArgV)]); @@ -1280,7 +1283,7 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Tag, Arity, Dst]), + ArgV = ?mk_fun_var(ArgFun, [Tag, Arity, Dst]), DstFun = fun(Map) -> [TmpVar, TmpTag, TmpArity] = TmpArgTypes = lookup_type_list(Args, Map), TmpArgTypes2 = @@ -1314,7 +1317,7 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> end, erl_bif_types:type(erlang, is_record, 3, TmpArgTypes2) end, - DstV = mk_fun_var(DstFun, Args), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arity, sub, t_integer()), mk_constraint(Tag, sub, t_atom()), @@ -1359,9 +1362,9 @@ get_bif_constr({erlang, 'and', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end end, - ArgV1 = mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), - ArgV2 = mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), - DstV = mk_fun_var(DstFun, Args), + ArgV1 = ?mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), + ArgV2 = ?mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); @@ -1403,9 +1406,9 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end end, - ArgV1 = mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), - ArgV2 = mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), - DstV = mk_fun_var(DstFun, Args), + ArgV1 = ?mk_fun_var(ArgFun(Arg2), [Arg2, Dst]), + ArgV2 = ?mk_fun_var(ArgFun(Arg1), [Arg1, Dst]), + DstV = ?mk_fun_var(DstFun, Args), F = fun(A) -> try [mk_constraint(A, sub, True)] catch throw:error -> [] @@ -1433,8 +1436,8 @@ get_bif_constr({erlang, 'not', 1}, Dst, [Arg] = Args, _State) -> end end end, - ArgV = mk_fun_var(Fun(Dst), [Dst]), - DstV = mk_fun_var(Fun(Arg), Args), + ArgV = ?mk_fun_var(Fun(Dst), [Dst]), + DstV = ?mk_fun_var(Fun(Arg), Args), mk_conj_constraint_list([mk_constraint(Arg, sub, ArgV), mk_constraint(Dst, sub, DstV)]); get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) -> @@ -1467,9 +1470,9 @@ get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end, DstArgs = [Dst, Arg1, Arg2], - ArgV1 = mk_fun_var(ArgFun(Arg1, Arg2), DstArgs), - ArgV2 = mk_fun_var(ArgFun(Arg2, Arg1), DstArgs), - DstV = mk_fun_var(DstFun, Args), + ArgV1 = ?mk_fun_var(ArgFun(Arg1, Arg2), DstArgs), + ArgV2 = ?mk_fun_var(ArgFun(Arg2, Arg1), DstArgs), + DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); @@ -1510,10 +1513,10 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end end end, - DstV = mk_fun_var(DstFun, Args), + DstV = ?mk_fun_var(DstFun, Args), ArgL = [Arg1, Arg2, Dst], - ArgV1 = mk_fun_var(ArgFun(Arg2, Arg1), ArgL), - ArgV2 = mk_fun_var(ArgFun(Arg1, Arg2), ArgL), + ArgV1 = ?mk_fun_var(ArgFun(Arg2, Arg1), ArgL), + ArgV2 = ?mk_fun_var(ArgFun(Arg1, Arg2), ArgL), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); @@ -1531,7 +1534,7 @@ get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, end, erl_bif_types:type(erlang, element, 2, ATs2) end, - ReturnType = mk_fun_var(Fun, Args), + ReturnType = ?mk_fun_var(Fun, Args), ArgTypes = erl_bif_types:arg_types(erlang, element, 2), Cs = mk_constraints(Args, sub, ArgTypes), NewCs = @@ -1553,7 +1556,7 @@ get_bif_constr({M, F, A} = _BIF, Dst, Args, State) -> false -> T end end, - ReturnType = mk_fun_var(fun(Map) -> + ReturnType = ?mk_fun_var(fun(Map) -> TmpArgTypes0 = lookup_type_list(Args, Map), TmpArgTypes = [UnopaqueFun(T) || T<- TmpArgTypes0], erl_bif_types:type(M, F, A, TmpArgTypes) @@ -1608,7 +1611,7 @@ get_bif_test_constr(Dst, Arg, Type, State) -> false -> t_any() end end, - ArgV = mk_fun_var(ArgFun, [Dst]), + ArgV = ?mk_fun_var(ArgFun, [Dst]), DstFun = fun(Map) -> ArgType = lookup_type(Arg, Map), case t_is_none(t_inf(ArgType, Type)) of @@ -1633,7 +1636,7 @@ get_bif_test_constr(Dst, Arg, Type, State) -> end end end, - DstV = mk_fun_var(DstFun, [Arg]), + DstV = ?mk_fun_var(DstFun, [Arg]), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), mk_constraint(Arg, sub, ArgV)]). @@ -2323,12 +2326,25 @@ mk_constraint(Lhs, Op, Rhs) -> constraint_opnd_is_any(#fun_var{}) -> false; constraint_opnd_is_any(Type) -> t_is_any(Type). +-ifdef(DEBUG). + +-spec mk_fun_var(fun((_) -> erl_types:erl_type()), [erl_types:erl_type()], + integer()) -> #fun_var{}. + +mk_fun_var(Line, Fun, Types) -> + Deps = [t_var_name(Var) || Var <- t_collect_vars(t_product(Types))], + #fun_var{'fun' = Fun, deps = ordsets:from_list(Deps), origin = Line}. + +-else. + -spec mk_fun_var(fun((_) -> erl_types:erl_type()), [erl_types:erl_type()]) -> #fun_var{}. mk_fun_var(Fun, Types) -> Deps = [t_var_name(Var) || Var <- t_collect_vars(t_product(Types))], #fun_var{'fun' = Fun, deps = ordsets:from_list(Deps)}. +-endif. + -spec get_deps(constr()) -> [dep()]. get_deps(#constraint{deps = D}) -> D; @@ -2679,8 +2695,9 @@ find_constraint(Tuple, [_|Cs]) -> -endif. -ifdef(DEBUG). -format_type(#fun_var{deps = Deps}) -> - io_lib:format("Fun(~s)", [lists:flatten([format_type(t_var(X))||X<-Deps])]); +format_type(#fun_var{deps = Deps, origin = Origin}) -> + io_lib:format("Fun@L~p(~s)", + [Origin, lists:flatten([format_type(t_var(X))||X<-Deps])]); format_type(Type) -> case cerl:is_literal(Type) of true -> io_lib:format("~w", [cerl:concrete(Type)]); diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index 6b16dba2ff..0177dcc88c 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -3,9 +3,14 @@ ftp.erl:1243: The pattern {'ok', {N, Bytes}} can never match the type 'eof' | {' ftp.erl:640: The pattern {'closed', _Why} can never match the type 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'trans_neg_compl' | 'trans_no_space' | {'error' | 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'pos_prel' | 'trans_neg_compl' | 'trans_no_space',atom() | [any()] | {'invalid_server_response',[any(),...]}} http.erl:117: The pattern {'error', Reason} can never match the type #req_headers{connection::[45 | 97 | 101 | 105 | 107 | 108 | 112 | 118,...],content_length::[48,...],other::[{_,_}]} http.erl:138: Function close_session/2 will never be called -http_lib.erl:286: The call http_lib:close('ip_comm' | {'ssl',_},any()) will never return since it differs in the 1st argument from the success typing arguments: ('http' | 'https',any()) -http_lib.erl:424: The variable _ can never match since previous clauses completely covered the type any() -http_lib.erl:438: The variable _ can never match since previous clauses completely covered the type any() +http_lib.erl:286: The call http_lib:close('ip_comm' | {'ssl',_},port() | {'sslsocket',_,_}) will never return since it differs in the 1st argument from the success typing arguments: ('http' | 'https',port() | {'sslsocket',_,pid() | {_,{'config',_,_,_,_,{_,_,_,_}}} | {'sslsocket',_,pid() | {'sslsocket',_,pid() | {_,_,_}}}}) +http_lib.erl:415: The pattern 61 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:417: The pattern 59 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:420: The pattern 13 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:424: The variable _ can never match since previous clauses completely covered the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:428: Function read_chunk_ext_val/6 will never be called +http_lib.erl:444: The pattern 10 can never match the type 'http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | #http_request{method::'DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),path::'*' | binary() | string() | {'abs_path',binary() | string()} | {'scheme',binary() | string(),binary() | string()} | {'absoluteURI','http' | 'https',binary() | string(),'undefined' | non_neg_integer(),binary() | string()},version::{non_neg_integer(),non_neg_integer()}} | #http_response{version::{non_neg_integer(),non_neg_integer()},status::integer(),phrase::binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()} +http_lib.erl:552: Call to missing or unexported function ssl:accept/2 http_lib.erl:99: Function getHeaderValue/2 will never be called httpc_handler.erl:660: Function exit_session_ok/2 has no local return httpc_manager.erl:145: The pattern {ErrorReply, State2} can never match the type {{'ok',number()},number(),#state{reqid::number()}} @@ -21,11 +26,14 @@ httpd_manager.erl:885: The pattern {'EXIT', Reason} can never match since previo httpd_manager.erl:919: Function auth_status/1 will never be called httpd_manager.erl:926: Function sec_status/1 will never be called httpd_manager.erl:933: Function acceptor_status/1 will never be called -httpd_request_handler.erl:374: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 66 | 98 | 100 | 103 | 105 | 111 | 116 | 121,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:378: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) -httpd_request_handler.erl:401: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:374: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 66 | 98 | 100 | 103 | 105 | 111 | 116 | 121,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_},socket::port() | {'sslsocket',_,_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:378: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_},socket::port() | {'sslsocket',_,_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:401: The call httpd_response:send_status(Info::#mod{parsed_header::maybe_improper_list()},417,[32 | 77 | 97 | 100 | 101 | 104 | 108 | 110 | 111 | 116 | 119,...]) will never return since it differs in the 2nd argument from the success typing arguments: (#mod{socket_type::'ip_comm' | {'ssl',_},socket::port() | {'sslsocket',_,_}},100 | 301 | 304 | 400 | 401 | 403 | 404 | 412 | 414 | 416 | 500 | 501 | 503,any()) +httpd_request_handler.erl:489: The variable Other can never match since previous clauses completely covered the type {'error',_} | {'ok','http_eoh' | binary() | maybe_improper_list(any(),binary() | []) | {'http_error',binary() | string()} | {'http_request','DELETE' | 'GET' | 'HEAD' | 'OPTIONS' | 'POST' | 'PUT' | 'TRACE' | binary() | string(),'*' | binary() | string() | {'abs_path',binary() | [any()]} | {'scheme',binary() | [any()],binary() | [any()]} | {'absoluteURI','http' | 'https',binary() | [any()],'undefined' | non_neg_integer(),binary() | [any()]},{non_neg_integer(),non_neg_integer()}} | {'http_response',{non_neg_integer(),non_neg_integer()},integer(),binary() | string()} | {'http_header',integer(),atom() | binary() | string(),_,binary() | string()}} httpd_request_handler.erl:644: The call lists:reverse(Fields0::{'error',_} | {'ok',_}) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) httpd_request_handler.erl:645: Function will never be called +httpd_socket.erl:129: Call to missing or unexported function ssl:accept/2 +httpd_socket.erl:49: The pattern {'ok', _} can never match the type {'error',_} httpd_sup.erl:63: The variable Else can never match since previous clauses completely covered the type {'error',_} | {'ok',[any()],_,_} httpd_sup.erl:88: The pattern {'error', Reason} can never match the type {'ok',_,_} httpd_sup.erl:92: The variable Else can never match since previous clauses completely covered the type {'ok',_,_} diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index b0f4d12ae5..2be71ac7d7 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -6,8 +6,6 @@ mnesia_bup.erl:111: The created fun has no local return mnesia_bup.erl:574: Function fallback_receiver/2 has no local return mnesia_bup.erl:967: Function uninstall_fallback_master/2 has no local return mnesia_checkpoint.erl:1014: The variable Error can never match since previous clauses completely covered the type {'ok',#checkpoint_args{nodes::[any()],retainers::[any(),...]}} -mnesia_checkpoint.erl:1209: Function system_continue/3 has no local return -mnesia_checkpoint.erl:792: Function retainer_loop/1 has no local return mnesia_checkpoint.erl:894: The call sys:handle_system_msg(Msg::any(),From::any(),'no_parent','mnesia_checkpoint',[],Cp::#checkpoint_args{}) breaks the contract (Msg,From,Parent,Module,Debug,Misc) -> Void when is_subtype(Msg,term()), is_subtype(From,{pid(),Tag::_}), is_subtype(Parent,pid()), is_subtype(Module,module()), is_subtype(Debug,[dbg_opt()]), is_subtype(Misc,term()), is_subtype(Void,term()) mnesia_controller.erl:1666: The variable Tab can never match since previous clauses completely covered the type [any()] mnesia_controller.erl:1679: The pattern {'stop', Reason, Reply, State2} can never match the type {'noreply',_} | {'reply',_,_} | {'stop','shutdown',#state{}} diff --git a/lib/dialyzer/test/small_SUITE_data/results/common_eunit b/lib/dialyzer/test/small_SUITE_data/results/common_eunit new file mode 100644 index 0000000000..bb5fd1c9ac --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/common_eunit @@ -0,0 +1,2 @@ + +common_eunit.erl:57: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/comparisons b/lib/dialyzer/test/small_SUITE_data/results/comparisons new file mode 100644 index 0000000000..642585d25e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/comparisons @@ -0,0 +1,153 @@ + +comparisons.erl:100: The pattern 'true' can never match the type 'false' +comparisons.erl:101: The pattern 'true' can never match the type 'false' +comparisons.erl:102: The pattern 'false' can never match the type 'true' +comparisons.erl:103: The pattern 'false' can never match the type 'true' +comparisons.erl:104: The pattern 'true' can never match the type 'false' +comparisons.erl:105: The pattern 'true' can never match the type 'false' +comparisons.erl:107: The pattern 'true' can never match the type 'false' +comparisons.erl:108: The pattern 'true' can never match the type 'false' +comparisons.erl:109: The pattern 'false' can never match the type 'true' +comparisons.erl:110: The pattern 'false' can never match the type 'true' +comparisons.erl:111: The pattern 'true' can never match the type 'false' +comparisons.erl:112: The pattern 'true' can never match the type 'false' +comparisons.erl:113: The pattern 'false' can never match the type 'true' +comparisons.erl:114: The pattern 'false' can never match the type 'true' +comparisons.erl:115: The pattern 'true' can never match the type 'false' +comparisons.erl:116: The pattern 'true' can never match the type 'false' +comparisons.erl:117: The pattern 'false' can never match the type 'true' +comparisons.erl:118: The pattern 'false' can never match the type 'true' +comparisons.erl:123: The pattern 'false' can never match the type 'true' +comparisons.erl:124: The pattern 'false' can never match the type 'true' +comparisons.erl:125: The pattern 'true' can never match the type 'false' +comparisons.erl:126: The pattern 'true' can never match the type 'false' +comparisons.erl:127: The pattern 'false' can never match the type 'true' +comparisons.erl:128: The pattern 'false' can never match the type 'true' +comparisons.erl:129: The pattern 'true' can never match the type 'false' +comparisons.erl:130: The pattern 'true' can never match the type 'false' +comparisons.erl:132: The pattern 'true' can never match the type 'false' +comparisons.erl:133: The pattern 'true' can never match the type 'false' +comparisons.erl:134: The pattern 'false' can never match the type 'true' +comparisons.erl:135: The pattern 'false' can never match the type 'true' +comparisons.erl:136: The pattern 'true' can never match the type 'false' +comparisons.erl:137: The pattern 'true' can never match the type 'false' +comparisons.erl:138: The pattern 'false' can never match the type 'true' +comparisons.erl:139: The pattern 'false' can never match the type 'true' +comparisons.erl:140: The pattern 'true' can never match the type 'false' +comparisons.erl:141: The pattern 'true' can never match the type 'false' +comparisons.erl:142: The pattern 'false' can never match the type 'true' +comparisons.erl:143: The pattern 'false' can never match the type 'true' +comparisons.erl:144: The pattern 'true' can never match the type 'false' +comparisons.erl:145: The pattern 'true' can never match the type 'false' +comparisons.erl:146: The pattern 'false' can never match the type 'true' +comparisons.erl:147: The pattern 'false' can never match the type 'true' +comparisons.erl:152: The pattern 'false' can never match the type 'true' +comparisons.erl:153: The pattern 'false' can never match the type 'true' +comparisons.erl:154: The pattern 'true' can never match the type 'false' +comparisons.erl:155: The pattern 'true' can never match the type 'false' +comparisons.erl:157: The pattern 'true' can never match the type 'false' +comparisons.erl:158: The pattern 'true' can never match the type 'false' +comparisons.erl:159: The pattern 'false' can never match the type 'true' +comparisons.erl:160: The pattern 'false' can never match the type 'true' +comparisons.erl:161: The pattern 'true' can never match the type 'false' +comparisons.erl:162: The pattern 'true' can never match the type 'false' +comparisons.erl:163: The pattern 'false' can never match the type 'true' +comparisons.erl:164: The pattern 'false' can never match the type 'true' +comparisons.erl:165: The pattern 'true' can never match the type 'false' +comparisons.erl:166: The pattern 'true' can never match the type 'false' +comparisons.erl:167: The pattern 'false' can never match the type 'true' +comparisons.erl:168: The pattern 'false' can never match the type 'true' +comparisons.erl:169: The pattern 'true' can never match the type 'false' +comparisons.erl:170: The pattern 'true' can never match the type 'false' +comparisons.erl:171: The pattern 'false' can never match the type 'true' +comparisons.erl:172: The pattern 'false' can never match the type 'true' +comparisons.erl:173: The pattern 'true' can never match the type 'false' +comparisons.erl:174: The pattern 'true' can never match the type 'false' +comparisons.erl:175: The pattern 'false' can never match the type 'true' +comparisons.erl:176: The pattern 'false' can never match the type 'true' +comparisons.erl:186: The pattern 'false' can never match the type 'true' +comparisons.erl:187: The pattern 'false' can never match the type 'true' +comparisons.erl:188: The pattern 'true' can never match the type 'false' +comparisons.erl:189: The pattern 'true' can never match the type 'false' +comparisons.erl:190: The pattern 'false' can never match the type 'true' +comparisons.erl:191: The pattern 'false' can never match the type 'true' +comparisons.erl:192: The pattern 'true' can never match the type 'false' +comparisons.erl:193: The pattern 'true' can never match the type 'false' +comparisons.erl:203: The pattern 'false' can never match the type 'true' +comparisons.erl:204: The pattern 'false' can never match the type 'true' +comparisons.erl:205: The pattern 'true' can never match the type 'false' +comparisons.erl:206: The pattern 'true' can never match the type 'false' +comparisons.erl:208: The pattern 'true' can never match the type 'false' +comparisons.erl:209: The pattern 'true' can never match the type 'false' +comparisons.erl:210: The pattern 'false' can never match the type 'true' +comparisons.erl:211: The pattern 'false' can never match the type 'true' +comparisons.erl:221: The pattern 'true' can never match the type 'false' +comparisons.erl:222: The pattern 'true' can never match the type 'false' +comparisons.erl:223: The pattern 'false' can never match the type 'true' +comparisons.erl:224: The pattern 'false' can never match the type 'true' +comparisons.erl:225: The pattern 'true' can never match the type 'false' +comparisons.erl:226: The pattern 'true' can never match the type 'false' +comparisons.erl:227: The pattern 'false' can never match the type 'true' +comparisons.erl:228: The pattern 'false' can never match the type 'true' +comparisons.erl:242: The pattern 'false' can never match the type 'true' +comparisons.erl:243: The pattern 'false' can never match the type 'true' +comparisons.erl:244: The pattern 'true' can never match the type 'false' +comparisons.erl:245: The pattern 'true' can never match the type 'false' +comparisons.erl:246: The pattern 'false' can never match the type 'true' +comparisons.erl:247: The pattern 'false' can never match the type 'true' +comparisons.erl:248: The pattern 'true' can never match the type 'false' +comparisons.erl:249: The pattern 'true' can never match the type 'false' +comparisons.erl:251: The pattern 'true' can never match the type 'false' +comparisons.erl:252: The pattern 'true' can never match the type 'false' +comparisons.erl:253: The pattern 'false' can never match the type 'true' +comparisons.erl:254: The pattern 'false' can never match the type 'true' +comparisons.erl:263: The pattern 'false' can never match the type 'true' +comparisons.erl:264: The pattern 'false' can never match the type 'true' +comparisons.erl:265: The pattern 'true' can never match the type 'false' +comparisons.erl:266: The pattern 'true' can never match the type 'false' +comparisons.erl:268: The pattern 'true' can never match the type 'false' +comparisons.erl:269: The pattern 'true' can never match the type 'false' +comparisons.erl:270: The pattern 'false' can never match the type 'true' +comparisons.erl:271: The pattern 'false' can never match the type 'true' +comparisons.erl:272: The pattern 'true' can never match the type 'false' +comparisons.erl:273: The pattern 'true' can never match the type 'false' +comparisons.erl:274: The pattern 'false' can never match the type 'true' +comparisons.erl:275: The pattern 'false' can never match the type 'true' +comparisons.erl:293: The pattern 'false' can never match the type 'true' +comparisons.erl:294: The pattern 'false' can never match the type 'true' +comparisons.erl:295: The pattern 'true' can never match the type 'false' +comparisons.erl:296: The pattern 'true' can never match the type 'false' +comparisons.erl:311: The pattern 'true' can never match the type 'false' +comparisons.erl:312: The pattern 'true' can never match the type 'false' +comparisons.erl:313: The pattern 'false' can never match the type 'true' +comparisons.erl:314: The pattern 'false' can never match the type 'true' +comparisons.erl:44: The pattern 'false' can never match the type 'true' +comparisons.erl:45: The pattern 'false' can never match the type 'true' +comparisons.erl:46: The pattern 'true' can never match the type 'false' +comparisons.erl:47: The pattern 'true' can never match the type 'false' +comparisons.erl:48: The pattern 'false' can never match the type 'true' +comparisons.erl:49: The pattern 'false' can never match the type 'true' +comparisons.erl:50: The pattern 'true' can never match the type 'false' +comparisons.erl:51: The pattern 'true' can never match the type 'false' +comparisons.erl:52: The pattern 'false' can never match the type 'true' +comparisons.erl:53: The pattern 'false' can never match the type 'true' +comparisons.erl:54: The pattern 'true' can never match the type 'false' +comparisons.erl:55: The pattern 'true' can never match the type 'false' +comparisons.erl:69: The pattern 'false' can never match the type 'true' +comparisons.erl:70: The pattern 'false' can never match the type 'true' +comparisons.erl:71: The pattern 'true' can never match the type 'false' +comparisons.erl:72: The pattern 'true' can never match the type 'false' +comparisons.erl:73: The pattern 'false' can never match the type 'true' +comparisons.erl:74: The pattern 'false' can never match the type 'true' +comparisons.erl:75: The pattern 'true' can never match the type 'false' +comparisons.erl:76: The pattern 'true' can never match the type 'false' +comparisons.erl:77: The pattern 'false' can never match the type 'true' +comparisons.erl:78: The pattern 'false' can never match the type 'true' +comparisons.erl:79: The pattern 'true' can never match the type 'false' +comparisons.erl:80: The pattern 'true' can never match the type 'false' +comparisons.erl:94: The pattern 'false' can never match the type 'true' +comparisons.erl:95: The pattern 'false' can never match the type 'true' +comparisons.erl:96: The pattern 'true' can never match the type 'false' +comparisons.erl:97: The pattern 'true' can never match the type 'false' +comparisons.erl:98: The pattern 'false' can never match the type 'true' +comparisons.erl:99: The pattern 'false' can never match the type 'true' diff --git a/lib/dialyzer/test/small_SUITE_data/results/failing_funs b/lib/dialyzer/test/small_SUITE_data/results/failing_funs new file mode 100644 index 0000000000..a1fb22cbc6 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/failing_funs @@ -0,0 +1,20 @@ + +failing_funs.erl:101: The created fun has no local return +failing_funs.erl:104: The created fun has no local return +failing_funs.erl:127: The created fun has no local return +failing_funs.erl:135: The created fun has no local return +failing_funs.erl:138: The created fun has no local return +failing_funs.erl:13: Function foo3/0 has no local return +failing_funs.erl:13: The pattern 'b' can never match the type 'a' +failing_funs.erl:161: The created fun has no local return +failing_funs.erl:169: The created fun has no local return +failing_funs.erl:172: The created fun has no local return +failing_funs.erl:17: The pattern 'b' can never match the type 'a' +failing_funs.erl:195: The created fun has no local return +failing_funs.erl:203: The created fun has no local return +failing_funs.erl:206: The created fun has no local return +failing_funs.erl:229: The created fun has no local return +failing_funs.erl:55: The created fun has no local return +failing_funs.erl:62: The created fun has no local return +failing_funs.erl:69: The created fun has no local return +failing_funs.erl:76: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/src/common_eunit.erl b/lib/dialyzer/test/small_SUITE_data/src/common_eunit.erl new file mode 100644 index 0000000000..bca390068e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/common_eunit.erl @@ -0,0 +1,121 @@ +%%===================================================================== +%% Program with an erroneous type declaration that caused dialyzer to +%% go into an infinite loop. There are some comments that explain the +%% symptoms and the culprit: the return of test_fun() is erroneous and +%% its type should read +%% fun((config()) -> test_rep() | [test_rep()]) +%% instead. But this should not throw dialyzer into an infinite loop. +%% This concerned dialyzer in R14B02 (and probably prior). +%%===================================================================== +-module(common_eunit). + +-export([expand_cases/2]). + +-type test_name() :: atom() | {'group', atom()}. + +-type test_rep() :: {{atom(), atom(), arity()}, fun()} + | {'setup', fun(), fun()} + | {'setup', fun(), fun(), fun()} + | {atom(), test_rep()} + | {atom(), term(), test_rep()}. + +-type config() :: [proplists:property()]. + +-type control() :: tuple() | atom(). + +%% The combination of the following type and the (erroneous) spec for +%% expand_cases/2 is the reason for the infinite loop in dialyzer. +-type test_fun() :: fun((config()) -> test_rep()). + +%% If one comments out this spec the infinite loop disappears. +-spec expand_cases(atom(), test_name() | [test_name()]) -> test_fun(). +expand_cases(Module, Cases) -> + if is_list(Cases) -> + TestFuns = [expand_case(Module, Case) || Case <- Cases], + fun(Config) -> [F(Config) || F <- TestFuns] end; + is_atom(Cases); is_tuple(Cases) -> + expand_cases(Module, [Cases]) + end. + +-spec expand_case(atom(), test_name()) -> test_fun(). +expand_case(Module, CaseName) when is_atom(CaseName) -> + TestFun = fun(Config) -> + {{Module, CaseName, 1}, + fun() -> apply(Module, CaseName, [Config]) end} + end, + setup_wrapper(Module, TestFun, {init_per_testcase, [CaseName]}, + {end_per_testcase, [CaseName]}); +expand_case(Module, {group, GroupName}) -> + {Control, Cases} = group_specification(Module, GroupName), + TestFun = control_wrapper(Control, expand_cases(Module, Cases)), + setup_wrapper(Module, TestFun, {init_per_group, [GroupName]}, + {end_per_group, [GroupName]}). + +-spec control_wrapper([control()], test_fun()) -> test_fun(). +control_wrapper([Control|T], TestFun0) -> + TestFun1 = control_wrapper(T, TestFun0), + fun(Config) -> + case Control of + parallel -> + {inparallel, TestFun1(Config)}; + sequence -> + {inorder, TestFun1(Config)}; + {timetrap, Time} -> + Seconds = case Time of + {hours, Hs} -> Hs * 60 * 60; + {minutes, Ms} -> Ms * 60; + {seconds, Ss} -> Ss; + MSs -> MSs / 1000 + end, + {timeout, Seconds, TestFun1(Config)}; + C when is_atom(C) -> + {C, TestFun1(Config)}; + {C, Arg} -> + {C, Arg, TestFun1(Config)} + end + end; +control_wrapper([], TestFun) -> + TestFun. + +-spec setup_wrapper(atom(), test_fun(), Callback, Callback) -> test_fun() + when Callback :: {atom(), list()}. +setup_wrapper(Module, TestFun, {Setup, SA}, {Cleanup, CA}) -> + case erlang:function_exported(Module, Setup, length(SA) + 1) of + true -> + case erlang:function_exported(Module, Cleanup, length(CA) + 1) of + true -> + fun(Config0) -> + {setup, + fun() -> + apply(Module, Setup, SA ++ [Config0]) + end, + fun(Config1) -> + apply(Module, Cleanup, CA ++ [Config1]) + end, + TestFun} + end; + false -> + fun(Config) -> + {setup, + fun() -> + apply(Module, Setup, SA ++ [Config]) + end, + TestFun} + end + end; + false -> + TestFun + end. + +-spec group_specification(atom(), atom()) -> {[control()], [test_name()]}. +group_specification(Module, GroupName) -> + case lists:keyfind(GroupName, 1, Module:groups()) of + {_, Control, Cases} when is_list(Control), is_list(Cases) -> + {Control, Cases}; + {_, Cases} when is_list(Cases) -> + {[], Cases}; + false -> + exit({missing_group, GroupName}); + _ -> + exit({bad_group_spec, GroupName}) + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl new file mode 100644 index 0000000000..70e3cb6af4 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl @@ -0,0 +1,322 @@ +-module(comparisons). + +-compile(export_all). + +-define(r, get(r)). + +integer() -> integer(?r). +integer(X) when is_integer(X) -> X. + +mfloat() -> float(?r). +mfloat(X) when is_float(X) -> X. + +atom() -> atom(?r). +atom(X) when is_atom(X) -> X. + +tuple() -> tuple(?r). +tuple(X) when is_tuple(X) -> X. + +list() -> list(?r). +list(X) when is_list(X) -> X. + +i() -> integer(). +f() -> mfloat(). +n() -> case ?r of 1 -> i(); 2 -> f() end. +a() -> atom(). +t() -> tuple(). +l() -> list(). +na() -> case ?r of 1 -> n(); 2 -> a() end. +at() -> case ?r of 1 -> t(); 2 -> a() end. +tl() -> case ?r of 1 -> t(); 2 -> l() end. + +test_i_ll_i() -> case i() < i() of true -> maybe; false -> maybe_too end. +test_i_le_i() -> case i() =< i() of true -> maybe; false -> maybe_too end. +test_i_gg_i() -> case i() > i() of true -> maybe; false -> maybe_too end. +test_i_ge_i() -> case i() >= i() of true -> maybe; false -> maybe_too end. +test_i_ll_f() -> case i() < f() of true -> maybe; false -> maybe_too end. +test_i_le_f() -> case i() =< f() of true -> maybe; false -> maybe_too end. +test_i_gg_f() -> case i() > f() of true -> maybe; false -> maybe_too end. +test_i_ge_f() -> case i() >= f() of true -> maybe; false -> maybe_too end. +test_i_ll_n() -> case i() < n() of true -> maybe; false -> maybe_too end. +test_i_le_n() -> case i() =< n() of true -> maybe; false -> maybe_too end. +test_i_gg_n() -> case i() > n() of true -> maybe; false -> maybe_too end. +test_i_ge_n() -> case i() >= n() of true -> maybe; false -> maybe_too end. +test_i_ll_a() -> case i() < a() of true -> always; false -> never end. +test_i_le_a() -> case i() =< a() of true -> always; false -> never end. +test_i_gg_a() -> case i() > a() of true -> never; false -> always end. +test_i_ge_a() -> case i() >= a() of true -> never; false -> always end. +test_i_ll_t() -> case i() < t() of true -> always; false -> never end. +test_i_le_t() -> case i() =< t() of true -> always; false -> never end. +test_i_gg_t() -> case i() > t() of true -> never; false -> always end. +test_i_ge_t() -> case i() >= t() of true -> never; false -> always end. +test_i_ll_l() -> case i() < l() of true -> always; false -> never end. +test_i_le_l() -> case i() =< l() of true -> always; false -> never end. +test_i_gg_l() -> case i() > l() of true -> never; false -> always end. +test_i_ge_l() -> case i() >= l() of true -> never; false -> always end. + +test_f_ll_i() -> case f() < i() of true -> maybe; false -> maybe_too end. +test_f_le_i() -> case f() =< i() of true -> maybe; false -> maybe_too end. +test_f_gg_i() -> case f() > i() of true -> maybe; false -> maybe_too end. +test_f_ge_i() -> case f() >= i() of true -> maybe; false -> maybe_too end. +test_f_ll_f() -> case f() < f() of true -> maybe; false -> maybe_too end. +test_f_le_f() -> case f() =< f() of true -> maybe; false -> maybe_too end. +test_f_gg_f() -> case f() > f() of true -> maybe; false -> maybe_too end. +test_f_ge_f() -> case f() >= f() of true -> maybe; false -> maybe_too end. +test_f_ll_n() -> case f() < n() of true -> maybe; false -> maybe_too end. +test_f_le_n() -> case f() =< n() of true -> maybe; false -> maybe_too end. +test_f_gg_n() -> case f() > n() of true -> maybe; false -> maybe_too end. +test_f_ge_n() -> case f() >= n() of true -> maybe; false -> maybe_too end. +test_f_ll_a() -> case f() < a() of true -> always; false -> never end. +test_f_le_a() -> case f() =< a() of true -> always; false -> never end. +test_f_gg_a() -> case f() > a() of true -> never; false -> always end. +test_f_ge_a() -> case f() >= a() of true -> never; false -> always end. +test_f_ll_t() -> case f() < t() of true -> always; false -> never end. +test_f_le_t() -> case f() =< t() of true -> always; false -> never end. +test_f_gg_t() -> case f() > t() of true -> never; false -> always end. +test_f_ge_t() -> case f() >= t() of true -> never; false -> always end. +test_f_ll_l() -> case f() < l() of true -> always; false -> never end. +test_f_le_l() -> case f() =< l() of true -> always; false -> never end. +test_f_gg_l() -> case f() > l() of true -> never; false -> always end. +test_f_ge_l() -> case f() >= l() of true -> never; false -> always end. + +test_n_ll_i() -> case n() < i() of true -> maybe; false -> maybe_too end. +test_n_le_i() -> case n() =< i() of true -> maybe; false -> maybe_too end. +test_n_gg_i() -> case n() > i() of true -> maybe; false -> maybe_too end. +test_n_ge_i() -> case n() >= i() of true -> maybe; false -> maybe_too end. +test_n_ll_f() -> case n() < f() of true -> maybe; false -> maybe_too end. +test_n_le_f() -> case n() =< f() of true -> maybe; false -> maybe_too end. +test_n_gg_f() -> case n() > f() of true -> maybe; false -> maybe_too end. +test_n_ge_f() -> case n() >= f() of true -> maybe; false -> maybe_too end. +test_n_ll_n() -> case n() < n() of true -> maybe; false -> maybe_too end. +test_n_le_n() -> case n() =< n() of true -> maybe; false -> maybe_too end. +test_n_gg_n() -> case n() > n() of true -> maybe; false -> maybe_too end. +test_n_ge_n() -> case n() >= n() of true -> maybe; false -> maybe_too end. +test_n_ll_a() -> case n() < a() of true -> always; false -> never end. +test_n_le_a() -> case n() =< a() of true -> always; false -> never end. +test_n_gg_a() -> case n() > a() of true -> never; false -> always end. +test_n_ge_a() -> case n() >= a() of true -> never; false -> always end. +test_n_ll_t() -> case n() < t() of true -> always; false -> never end. +test_n_le_t() -> case n() =< t() of true -> always; false -> never end. +test_n_gg_t() -> case n() > t() of true -> never; false -> always end. +test_n_ge_t() -> case n() >= t() of true -> never; false -> always end. +test_n_ll_l() -> case n() < l() of true -> always; false -> never end. +test_n_le_l() -> case n() =< l() of true -> always; false -> never end. +test_n_gg_l() -> case n() > l() of true -> never; false -> always end. +test_n_ge_l() -> case n() >= l() of true -> never; false -> always end. + +test_a_ll_i() -> case a() < i() of true -> never; false -> always end. +test_a_le_i() -> case a() =< i() of true -> never; false -> always end. +test_a_gg_i() -> case a() > i() of true -> always; false -> never end. +test_a_ge_i() -> case a() >= i() of true -> always; false -> never end. +test_a_ll_f() -> case a() < f() of true -> never; false -> always end. +test_a_le_f() -> case a() =< f() of true -> never; false -> always end. +test_a_gg_f() -> case a() > f() of true -> always; false -> never end. +test_a_ge_f() -> case a() >= f() of true -> always; false -> never end. +test_a_ll_n() -> case a() < n() of true -> never; false -> always end. +test_a_le_n() -> case a() =< n() of true -> never; false -> always end. +test_a_gg_n() -> case a() > n() of true -> always; false -> never end. +test_a_ge_n() -> case a() >= n() of true -> always; false -> never end. +test_a_ll_a() -> case a() < a() of true -> maybe; false -> maybe_too end. +test_a_le_a() -> case a() =< a() of true -> maybe; false -> maybe_too end. +test_a_gg_a() -> case a() > a() of true -> maybe; false -> maybe_too end. +test_a_ge_a() -> case a() >= a() of true -> maybe; false -> maybe_too end. +test_a_ll_t() -> case a() < t() of true -> always; false -> never end. +test_a_le_t() -> case a() =< t() of true -> always; false -> never end. +test_a_gg_t() -> case a() > t() of true -> never; false -> always end. +test_a_ge_t() -> case a() >= t() of true -> never; false -> always end. +test_a_ll_l() -> case a() < l() of true -> always; false -> never end. +test_a_le_l() -> case a() =< l() of true -> always; false -> never end. +test_a_gg_l() -> case a() > l() of true -> never; false -> always end. +test_a_ge_l() -> case a() >= l() of true -> never; false -> always end. + +test_t_ll_i() -> case t() < i() of true -> never; false -> always end. +test_t_le_i() -> case t() =< i() of true -> never; false -> always end. +test_t_gg_i() -> case t() > i() of true -> always; false -> never end. +test_t_ge_i() -> case t() >= i() of true -> always; false -> never end. +test_t_ll_f() -> case t() < f() of true -> never; false -> always end. +test_t_le_f() -> case t() =< f() of true -> never; false -> always end. +test_t_gg_f() -> case t() > f() of true -> always; false -> never end. +test_t_ge_f() -> case t() >= f() of true -> always; false -> never end. +test_t_ll_n() -> case t() < n() of true -> never; false -> always end. +test_t_le_n() -> case t() =< n() of true -> never; false -> always end. +test_t_gg_n() -> case t() > n() of true -> always; false -> never end. +test_t_ge_n() -> case t() >= n() of true -> always; false -> never end. +test_t_ll_a() -> case t() < a() of true -> never; false -> always end. +test_t_le_a() -> case t() =< a() of true -> never; false -> always end. +test_t_gg_a() -> case t() > a() of true -> always; false -> never end. +test_t_ge_a() -> case t() >= a() of true -> always; false -> never end. +test_t_ll_t() -> case t() < t() of true -> maybe; false -> maybe_too end. +test_t_le_t() -> case t() =< t() of true -> maybe; false -> maybe_too end. +test_t_gg_t() -> case t() > t() of true -> maybe; false -> maybe_too end. +test_t_ge_t() -> case t() >= t() of true -> maybe; false -> maybe_too end. +test_t_ll_l() -> case t() < l() of true -> always; false -> never end. +test_t_le_l() -> case t() =< l() of true -> always; false -> never end. +test_t_gg_l() -> case t() > l() of true -> never; false -> always end. +test_t_ge_l() -> case t() >= l() of true -> never; false -> always end. + +test_l_ll_i() -> case l() < i() of true -> never; false -> always end. +test_l_le_i() -> case l() =< i() of true -> never; false -> always end. +test_l_gg_i() -> case l() > i() of true -> always; false -> never end. +test_l_ge_i() -> case l() >= i() of true -> always; false -> never end. +test_l_ll_f() -> case l() < f() of true -> never; false -> always end. +test_l_le_f() -> case l() =< f() of true -> never; false -> always end. +test_l_gg_f() -> case l() > f() of true -> always; false -> never end. +test_l_ge_f() -> case l() >= f() of true -> always; false -> never end. +test_l_ll_n() -> case l() < n() of true -> never; false -> always end. +test_l_le_n() -> case l() =< n() of true -> never; false -> always end. +test_l_gg_n() -> case l() > n() of true -> always; false -> never end. +test_l_ge_n() -> case l() >= n() of true -> always; false -> never end. +test_l_ll_a() -> case l() < a() of true -> never; false -> always end. +test_l_le_a() -> case l() =< a() of true -> never; false -> always end. +test_l_gg_a() -> case l() > a() of true -> always; false -> never end. +test_l_ge_a() -> case l() >= a() of true -> always; false -> never end. +test_l_ll_t() -> case l() < t() of true -> never; false -> always end. +test_l_le_t() -> case l() =< t() of true -> never; false -> always end. +test_l_gg_t() -> case l() > t() of true -> always; false -> never end. +test_l_ge_t() -> case l() >= t() of true -> always; false -> never end. +test_l_ll_l() -> case l() < l() of true -> maybe; false -> maybe_too end. +test_l_le_l() -> case l() =< l() of true -> maybe; false -> maybe_too end. +test_l_gg_l() -> case l() > l() of true -> maybe; false -> maybe_too end. +test_l_ge_l() -> case l() >= l() of true -> maybe; false -> maybe_too end. + +test_n_ll_na() -> case n() < na() of true -> maybe; false -> maybe_too end. +test_n_le_na() -> case n() =< na() of true -> maybe; false -> maybe_too end. +test_n_gg_na() -> case n() > na() of true -> maybe; false -> maybe_too end. +test_n_ge_na() -> case n() >= na() of true -> maybe; false -> maybe_too end. +test_n_ll_at() -> case n() < at() of true -> always; false -> never end. +test_n_le_at() -> case n() =< at() of true -> always; false -> never end. +test_n_gg_at() -> case n() > at() of true -> never; false -> always end. +test_n_ge_at() -> case n() >= at() of true -> never; false -> always end. +test_n_ll_tl() -> case n() < tl() of true -> always; false -> never end. +test_n_le_tl() -> case n() =< tl() of true -> always; false -> never end. +test_n_gg_tl() -> case n() > tl() of true -> never; false -> always end. +test_n_ge_tl() -> case n() >= tl() of true -> never; false -> always end. + +test_a_ll_na() -> case a() < na() of true -> maybe; false -> maybe_too end. +test_a_le_na() -> case a() =< na() of true -> maybe; false -> maybe_too end. +test_a_gg_na() -> case a() > na() of true -> maybe; false -> maybe_too end. +test_a_ge_na() -> case a() >= na() of true -> maybe; false -> maybe_too end. +test_a_ll_at() -> case a() < at() of true -> maybe; false -> maybe_too end. +test_a_le_at() -> case a() =< at() of true -> maybe; false -> maybe_too end. +test_a_gg_at() -> case a() > at() of true -> maybe; false -> maybe_too end. +test_a_ge_at() -> case a() >= at() of true -> maybe; false -> maybe_too end. +test_a_ll_tl() -> case a() < tl() of true -> always; false -> never end. +test_a_le_tl() -> case a() =< tl() of true -> always; false -> never end. +test_a_gg_tl() -> case a() > tl() of true -> never; false -> always end. +test_a_ge_tl() -> case a() >= tl() of true -> never; false -> always end. + +test_t_ll_na() -> case t() < na() of true -> never; false -> always end. +test_t_le_na() -> case t() =< na() of true -> never; false -> always end. +test_t_gg_na() -> case t() > na() of true -> always; false -> never end. +test_t_ge_na() -> case t() >= na() of true -> always; false -> never end. +test_t_ll_at() -> case t() < at() of true -> maybe; false -> maybe_too end. +test_t_le_at() -> case t() =< at() of true -> maybe; false -> maybe_too end. +test_t_gg_at() -> case t() > at() of true -> maybe; false -> maybe_too end. +test_t_ge_at() -> case t() >= at() of true -> maybe; false -> maybe_too end. +test_t_ll_tl() -> case t() < tl() of true -> maybe; false -> maybe_too end. +test_t_le_tl() -> case t() =< tl() of true -> maybe; false -> maybe_too end. +test_t_gg_tl() -> case t() > tl() of true -> maybe; false -> maybe_too end. +test_t_ge_tl() -> case t() >= tl() of true -> maybe; false -> maybe_too end. + +test_l_ll_na() -> case l() < na() of true -> never; false -> always end. +test_l_le_na() -> case l() =< na() of true -> never; false -> always end. +test_l_gg_na() -> case l() > na() of true -> always; false -> never end. +test_l_ge_na() -> case l() >= na() of true -> always; false -> never end. +test_l_ll_at() -> case l() < at() of true -> never; false -> always end. +test_l_le_at() -> case l() =< at() of true -> never; false -> always end. +test_l_gg_at() -> case l() > at() of true -> always; false -> never end. +test_l_ge_at() -> case l() >= at() of true -> always; false -> never end. +test_l_ll_tl() -> case l() < tl() of true -> maybe; false -> maybe_too end. +test_l_le_tl() -> case l() =< tl() of true -> maybe; false -> maybe_too end. +test_l_gg_tl() -> case l() > tl() of true -> maybe; false -> maybe_too end. +test_l_ge_tl() -> case l() >= tl() of true -> maybe; false -> maybe_too end. + +test_na_ll_n() -> case na() < n() of true -> maybe; false -> maybe_too end. +test_na_le_n() -> case na() =< n() of true -> maybe; false -> maybe_too end. +test_na_gg_n() -> case na() > n() of true -> maybe; false -> maybe_too end. +test_na_ge_n() -> case na() >= n() of true -> maybe; false -> maybe_too end. +test_na_ll_a() -> case na() < a() of true -> maybe; false -> maybe_too end. +test_na_le_a() -> case na() =< a() of true -> maybe; false -> maybe_too end. +test_na_gg_a() -> case na() > a() of true -> maybe; false -> maybe_too end. +test_na_ge_a() -> case na() >= a() of true -> maybe; false -> maybe_too end. +test_na_ll_t() -> case na() < t() of true -> always; false -> never end. +test_na_le_t() -> case na() =< t() of true -> always; false -> never end. +test_na_gg_t() -> case na() > t() of true -> never; false -> always end. +test_na_ge_t() -> case na() >= t() of true -> never; false -> always end. +test_na_ll_l() -> case na() < l() of true -> always; false -> never end. +test_na_le_l() -> case na() =< l() of true -> always; false -> never end. +test_na_gg_l() -> case na() > l() of true -> never; false -> always end. +test_na_ge_l() -> case na() >= l() of true -> never; false -> always end. + +test_at_ll_n() -> case at() < n() of true -> never; false -> always end. +test_at_le_n() -> case at() =< n() of true -> never; false -> always end. +test_at_gg_n() -> case at() > n() of true -> always; false -> never end. +test_at_ge_n() -> case at() >= n() of true -> always; false -> never end. +test_at_ll_a() -> case at() < a() of true -> maybe; false -> maybe_too end. +test_at_le_a() -> case at() =< a() of true -> maybe; false -> maybe_too end. +test_at_gg_a() -> case at() > a() of true -> maybe; false -> maybe_too end. +test_at_ge_a() -> case at() >= a() of true -> maybe; false -> maybe_too end. +test_at_ll_t() -> case at() < t() of true -> maybe; false -> maybe_too end. +test_at_le_t() -> case at() =< t() of true -> maybe; false -> maybe_too end. +test_at_gg_t() -> case at() > t() of true -> maybe; false -> maybe_too end. +test_at_ge_t() -> case at() >= t() of true -> maybe; false -> maybe_too end. +test_at_ll_l() -> case at() < l() of true -> always; false -> never end. +test_at_le_l() -> case at() =< l() of true -> always; false -> never end. +test_at_gg_l() -> case at() > l() of true -> never; false -> always end. +test_at_ge_l() -> case at() >= l() of true -> never; false -> always end. + +test_tl_ll_n() -> case tl() < n() of true -> never; false -> always end. +test_tl_le_n() -> case tl() =< n() of true -> never; false -> always end. +test_tl_gg_n() -> case tl() > n() of true -> always; false -> never end. +test_tl_ge_n() -> case tl() >= n() of true -> always; false -> never end. +test_tl_ll_a() -> case tl() < a() of true -> never; false -> always end. +test_tl_le_a() -> case tl() =< a() of true -> never; false -> always end. +test_tl_gg_a() -> case tl() > a() of true -> always; false -> never end. +test_tl_ge_a() -> case tl() >= a() of true -> always; false -> never end. +test_tl_ll_t() -> case tl() < t() of true -> maybe; false -> maybe_too end. +test_tl_le_t() -> case tl() =< t() of true -> maybe; false -> maybe_too end. +test_tl_gg_t() -> case tl() > t() of true -> maybe; false -> maybe_too end. +test_tl_ge_t() -> case tl() >= t() of true -> maybe; false -> maybe_too end. +test_tl_ll_l() -> case tl() < l() of true -> maybe; false -> maybe_too end. +test_tl_le_l() -> case tl() =< l() of true -> maybe; false -> maybe_too end. +test_tl_gg_l() -> case tl() > l() of true -> maybe; false -> maybe_too end. +test_tl_ge_l() -> case tl() >= l() of true -> maybe; false -> maybe_too end. + +test_na_ll_na() -> case na() < na() of true -> maybe; false -> maybe_too end. +test_na_le_na() -> case na() =< na() of true -> maybe; false -> maybe_too end. +test_na_gg_na() -> case na() > na() of true -> maybe; false -> maybe_too end. +test_na_ge_na() -> case na() >= na() of true -> maybe; false -> maybe_too end. +test_na_ll_at() -> case na() < at() of true -> maybe; false -> maybe_too end. +test_na_le_at() -> case na() =< at() of true -> maybe; false -> maybe_too end. +test_na_gg_at() -> case na() > at() of true -> maybe; false -> maybe_too end. +test_na_ge_at() -> case na() >= at() of true -> maybe; false -> maybe_too end. +test_na_ll_tl() -> case na() < tl() of true -> always; false -> never end. +test_na_le_tl() -> case na() =< tl() of true -> always; false -> never end. +test_na_gg_tl() -> case na() > tl() of true -> never; false -> always end. +test_na_ge_tl() -> case na() >= tl() of true -> never; false -> always end. + +test_at_ll_na() -> case at() < na() of true -> maybe; false -> maybe_too end. +test_at_le_na() -> case at() =< na() of true -> maybe; false -> maybe_too end. +test_at_gg_na() -> case at() > na() of true -> maybe; false -> maybe_too end. +test_at_ge_na() -> case at() >= na() of true -> maybe; false -> maybe_too end. +test_at_ll_at() -> case at() < at() of true -> maybe; false -> maybe_too end. +test_at_le_at() -> case at() =< at() of true -> maybe; false -> maybe_too end. +test_at_gg_at() -> case at() > at() of true -> maybe; false -> maybe_too end. +test_at_ge_at() -> case at() >= at() of true -> maybe; false -> maybe_too end. +test_at_ll_tl() -> case at() < tl() of true -> maybe; false -> maybe_too end. +test_at_le_tl() -> case at() =< tl() of true -> maybe; false -> maybe_too end. +test_at_gg_tl() -> case at() > tl() of true -> maybe; false -> maybe_too end. +test_at_ge_tl() -> case at() >= tl() of true -> maybe; false -> maybe_too end. + +test_tl_ll_na() -> case tl() < na() of true -> never; false -> always end. +test_tl_le_na() -> case tl() =< na() of true -> never; false -> always end. +test_tl_gg_na() -> case tl() > na() of true -> always; false -> never end. +test_tl_ge_na() -> case tl() >= na() of true -> always; false -> never end. +test_tl_ll_at() -> case tl() < at() of true -> maybe; false -> maybe_too end. +test_tl_le_at() -> case tl() =< at() of true -> maybe; false -> maybe_too end. +test_tl_gg_at() -> case tl() > at() of true -> maybe; false -> maybe_too end. +test_tl_ge_at() -> case tl() >= at() of true -> maybe; false -> maybe_too end. +test_tl_ll_tl() -> case tl() < tl() of true -> maybe; false -> maybe_too end. +test_tl_le_tl() -> case tl() =< tl() of true -> maybe; false -> maybe_too end. +test_tl_gg_tl() -> case tl() > tl() of true -> maybe; false -> maybe_too end. +test_tl_ge_tl() -> case tl() >= tl() of true -> maybe; false -> maybe_too end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/failing_funs.erl b/lib/dialyzer/test/small_SUITE_data/src/failing_funs.erl new file mode 100644 index 0000000000..1784c4a494 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/failing_funs.erl @@ -0,0 +1,250 @@ +-module(failing_funs). + +-compile(export_all). + +% Crashes with system call. No spec. +foo1() -> halt(). + +% Crashes with system call. With spec. +-spec foo2() -> no_return(). +foo2() -> halt(). + +% Crashes on its own. No spec. +foo3() -> case a of b -> ok end. + +% Crashes on its own. With spec. +-spec foo4() -> no_return(). +foo4() -> case a of b -> ok end. + +% Creates fun that crashes with system call. No spec. +foo5() -> fun() -> halt() end. + +% Creates fun that crashes with system call. With spec. +-spec foo6() -> fun(() -> no_return()). +foo6() -> fun() -> halt() end. + +% Creates fun from named fun that will crash. Neither have spec. +foo7() -> fun foo1/0. + +% Creates fun from named fun that will crash. Has spec. +-spec foo8() -> fun(() -> no_return()). +foo8() -> fun foo1/0. + +% Creates fun from named fun that will crash. Named has spec. +foo9() -> fun foo2/0. + +% Creates fun from named fun that will crash. Both have specs. +-spec foo10() -> fun(() -> no_return()). +foo10() -> fun foo2/0. + +% Creates fun from named fun that will crash. Neither have spec. +foo11() -> fun foo3/0. + +% Creates fun from named fun that will crash. Has spec. +-spec foo12() -> fun(() -> no_return()). +foo12() -> fun foo3/0. + +% Creates fun from named fun that will crash. Named has spec. +foo13() -> fun foo4/0. + +% Creates fun from named fun that will crash. Both have specs. +-spec foo14() -> fun(() -> no_return()). +foo14() -> fun foo4/0. + +% Creates fun calling a named fun that will crash. Neither have spec. +foo15() -> fun() -> foo1() end. + +% Creates fun calling a named fun that will crash. Has spec. +-spec foo16() -> fun(() -> no_return()). +foo16() -> fun() -> foo1() end. + +% Creates fun calling a named fun that will crash. Named has spec. +foo17() -> fun() -> foo2() end. + +% Creates fun calling a named fun that will crash. Both have specs. +-spec foo18() -> fun(() -> no_return()). +foo18() -> fun() -> foo2() end. + +% Creates fun calling a named fun that will crash. Neither have spec. +foo19() -> fun() -> foo3() end. + +% Creates fun calling a named fun that will crash. Has spec. +-spec foo20() -> fun(() -> no_return()). +foo20() -> fun() -> foo3() end. + +% Creates fun calling a named fun that will crash. Named has spec. +foo21() -> fun() -> foo4() end. + +% Creates fun calling a named fun that will crash. Both have specs. +-spec foo22() -> fun(() -> no_return()). +foo22() -> fun() -> foo4() end. + +% Creates two funs with no local return and will return one or die. No spec. +foo23() -> + Bomb = fun() -> halt() end, + case get(42) of + a -> Bomb(); + b -> fun() -> halt() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo24() -> fun(() -> no_return()). +foo24() -> + Bomb = fun() -> halt() end, + case get(42) of + a -> Bomb(); + b -> fun() -> halt() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo25() -> + Bomb = fun() -> foo1() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo1() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo26() -> fun(() -> no_return()). +foo26() -> + Bomb = fun foo1/0, + case get(42) of + a -> Bomb(); + b -> fun foo1/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo27() -> + Bomb = fun foo1/0, + case get(42) of + a -> Bomb(); + b -> fun foo1/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo28() -> fun(() -> no_return()). +foo28() -> + Bomb = fun() -> foo1() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo1() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo29() -> + Bomb = fun() -> foo2() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo2() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo30() -> fun(() -> no_return()). +foo30() -> + Bomb = fun foo2/0, + case get(42) of + a -> Bomb(); + b -> fun foo2/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo31() -> + Bomb = fun foo2/0, + case get(42) of + a -> Bomb(); + b -> fun foo2/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo32() -> fun(() -> no_return()). +foo32() -> + Bomb = fun() -> foo2() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo2() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo33() -> + Bomb = fun() -> foo3() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo3() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo34() -> fun(() -> no_return()). +foo34() -> + Bomb = fun foo3/0, + case get(42) of + a -> Bomb(); + b -> fun foo3/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo35() -> + Bomb = fun foo3/0, + case get(42) of + a -> Bomb(); + b -> fun foo3/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo36() -> fun(() -> no_return()). +foo36() -> + Bomb = fun() -> foo3() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo3() end + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo37() -> + Bomb = fun() -> foo4() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo4() end + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo38() -> fun(() -> no_return()). +foo38() -> + Bomb = fun foo4/0, + case get(42) of + a -> Bomb(); + b -> fun foo4/0 + end. + +% Creates two funs with no local return and will return one or die. No spec. +foo39() -> + Bomb = fun foo4/0, + case get(42) of + a -> Bomb(); + b -> fun foo4/0 + end. + +% Creates two funs with no local return and will return one or die. With spec. +-spec foo40() -> fun(() -> no_return()). +foo40() -> + Bomb = fun() -> foo4() end, + case get(42) of + a -> Bomb(); + b -> fun() -> foo4() end + end. + +% Obtains two funs with no local return and will return one or die. No spec. +foo41() -> + Bomb = foo5(), + case get(42) of + a -> Bomb(); + b -> foo5() + end. + +% Obtains two funs with no local return and will return one or die. With spec. +-spec foo42() -> fun(() -> no_return()). +foo42() -> + Bomb = foo5(), + case get(42) of + a -> Bomb(); + b -> foo5() + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/rebar_no_return.erl b/lib/dialyzer/test/small_SUITE_data/src/rebar_no_return.erl new file mode 100644 index 0000000000..d3b504ae04 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/rebar_no_return.erl @@ -0,0 +1,19 @@ +-module(rebar_no_return). + +-export([t/0]). + +-spec t() -> no_return(). +t() -> + F = log_and_halt("baz"), + F("foo", 123). + +-spec log_and_halt(string()) -> fun((string(),integer()) -> no_return()). +log_and_halt(Msg) -> + fun(_, _) -> + abort(Msg) + end. + +-spec abort(string()) -> no_return(). +abort(Msg) -> + io:format("~s~n", [Msg]), + halt(1). diff --git a/lib/erl_interface/src/encode/encode_atom.c b/lib/erl_interface/src/encode/encode_atom.c index 69f2d1451c..b1a4479034 100644 --- a/lib/erl_interface/src/encode/encode_atom.c +++ b/lib/erl_interface/src/encode/encode_atom.c @@ -17,13 +17,17 @@ * %CopyrightEnd% */ #include <string.h> +#include <limits.h> #include "eidef.h" #include "eiext.h" #include "putget.h" int ei_encode_atom(char *buf, int *index, const char *p) { - return ei_encode_atom_len(buf, index, p, strlen(p)); + size_t len = strlen(p); + + if (len >= INT_MAX) return -1; + return ei_encode_atom_len(buf, index, p, len); } int ei_encode_atom_len(char *buf, int *index, const char *p, int len) diff --git a/lib/erl_interface/src/encode/encode_string.c b/lib/erl_interface/src/encode/encode_string.c index 1d342cb605..593bbf2b6d 100644 --- a/lib/erl_interface/src/encode/encode_string.c +++ b/lib/erl_interface/src/encode/encode_string.c @@ -17,6 +17,7 @@ * %CopyrightEnd% */ #include <string.h> +#include <limits.h> #include "eidef.h" #include "eiext.h" #include "putget.h" @@ -24,7 +25,10 @@ int ei_encode_string(char *buf, int *index, const char *p) { - return ei_encode_string_len(buf, index, p, strlen(p)); + size_t len = strlen(p); + + if (len >= INT_MAX) return -1; + return ei_encode_string_len(buf, index, p, len); } int ei_encode_string_len(char *buf, int *index, const char *p, int len) diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 43c2ac2615..3212c1e4ff 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -366,7 +366,7 @@ type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('>', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> @@ -384,7 +384,7 @@ type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('>=', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> @@ -402,7 +402,7 @@ type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('<', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> @@ -420,7 +420,7 @@ type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F; true -> t_boolean() end; - false -> t_boolean() + false -> compare('=<', Lhs, Rhs) end, strict(Xs, Ans); type(erlang, '+', 1, Xs) -> @@ -737,6 +737,7 @@ type(erlang, element, 2, Xs) -> type(erlang, erase, 0, _) -> t_any(); type(erlang, erase, 1, _) -> t_any(); type(erlang, external_size, 1, _) -> t_integer(); +type(erlang, external_size, 2, _) -> t_integer(); type(erlang, finish_after_on_load, 2, Xs) -> %% Internal BIF used by on_load. strict(arg_types(erlang, finish_after_on_load, 2), Xs, @@ -3177,6 +3178,50 @@ arith(Op, X1, X2) -> end. %%============================================================================= +%% Comparison of terms +%%============================================================================= + +compare(Op, Lhs, Rhs) -> + case t_is_none(t_inf(Lhs, Rhs)) of + false -> t_boolean(); + true -> + case Op of + '<' -> always_smaller(Lhs, Rhs); + '>' -> always_smaller(Rhs, Lhs); + '=<' -> always_smaller(Lhs, Rhs); + '>=' -> always_smaller(Rhs, Lhs) + end + end. + +always_smaller(Type1, Type2) -> + {Min1, Max1} = type_ranks(Type1), + {Min2, Max2} = type_ranks(Type2), + if Max1 < Min2 -> t_atom('true'); + Min1 > Max2 -> t_atom('false'); + true -> t_boolean() + end. + +type_ranks(Type) -> + type_ranks(Type, 1, 0, 0, type_order()). + +type_ranks(_Type, _I, Min, Max, []) -> {Min, Max}; +type_ranks(Type, I, Min, Max, [TypeClass|Rest]) -> + {NewMin, NewMax} = + case t_is_none(t_inf(Type, TypeClass)) of + true -> {Min, Max}; + false -> case Min of + 0 -> {I, I}; + _ -> {Min, I} + end + end, + type_ranks(Type, I+1, NewMin, NewMax, Rest). + +type_order() -> + [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), + t_list(), t_binary()]. + + +%%============================================================================= -spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'. @@ -3443,6 +3488,8 @@ arg_types(erlang, exit, 2) -> [t_sup(t_pid(), t_port()), t_any()]; arg_types(erlang, external_size, 1) -> [t_any()]; % takes any term as input +arg_types(erlang, external_size, 2) -> + [t_any(), t_list()]; % takes any term as input and a list of options arg_types(erlang, finish_after_on_load, 2) -> [t_atom(), t_boolean()]; arg_types(erlang, float, 1) -> diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index d1671ac9bd..b1f964ae69 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -28,8 +28,10 @@ <date></date> <rev></rev> </header> + <module>httpc</module> <modulesummary>An HTTP/1.1 client </modulesummary> + <description> <p>This module provides the API to a HTTP/1.1 compatible client according to RFC 2616, caching is currently not supported.</p> @@ -167,7 +169,6 @@ filename() = string() <v>http_option() = {timeout, timeout()} | {connect_timeout, timeout()} | {ssl, ssloptions()} | - {ossl, ssloptions()} | {essl, ssloptions()} | {autoredirect, boolean()} | {proxy_auth, {userstring(), passwordstring()}} | @@ -206,6 +207,7 @@ filename() = string() to the <c>receiver</c> depending on that value. </p> <p>Http option (<c>http_option()</c>) details: </p> + <marker id="request2_http_options"></marker> <taglist> <tag><c><![CDATA[timeout]]></c></tag> <item> @@ -231,16 +233,9 @@ filename() = string() <p>Defaults to <c>[]</c>. </p> </item> - <tag><c><![CDATA[ossl]]></c></tag> - <item> - <p>If using the OpenSSL based (old) implementation of SSL, - these SSL-specific options are used. </p> - <p>Defaults to <c>[]</c>. </p> - </item> - <tag><c><![CDATA[essl]]></c></tag> <item> - <p>If using the Erlang based (new) implementation of SSL, + <p>If using the Erlang based implementation of SSL, these SSL-specific options are used. </p> <p>Defaults to <c>[]</c>. </p> </item> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index edacb73b65..f88099a82e 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -148,13 +148,11 @@ in the apache like configuration file. </item> - <tag>{socket_type, ip_comm | ssl | ossl | essl}</tag> + <tag>{socket_type, ip_comm | ssl | essl}</tag> <item> - <p>When using ssl, there are several alternatives. - <c>ossl</c> specifically uses the OpenSSL based (old) SSL. - <c>essl</c> specifically uses the Erlang based (new) SSL. - When using <c>ssl</c> it <em>currently</em> defaults to - <c>essl</c>. </p> + <p>When using ssl, there are currently only one alternative. + <c>essl</c> specifically uses the Erlang based SSL. + <c>ssl</c> defaults to <c>essl</c>. </p> <p>Defaults to <c>ip_comm</c>. </p> </item> @@ -162,7 +160,7 @@ <item> <p>Defaults to <c>inet6fb4. </c> </p> <p>Note that this option is only used when the option - <c>socket_type</c> has the value <c>ip_comm</c>. </p> + <c>socket_type</c> has the value <c>ip_comm</c>. </p> </item> </taglist> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 34f26bf45b..c53aa653d8 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,6 +32,68 @@ <file>notes.xml</file> </header> + <section><title>Inets 5.8</title> + + <section><title>Improvements and New Features</title> + <p>-</p> + +<!-- + <list> + <item> + <p>[httpc|httpd] Added support for IPv6 with ssl. </p> + <p>Own Id: OTP-5566</p> + </item> + + </list> +--> + + </section> + + <section><title>Fixed Bugs and Malfunctions</title> + <p>-</p> + +<!-- + <list> + <item> + <p>[httpc] Remove unnecessary usage of iolist_to_binary when + processing body (for PUT and POST). </p> + <p>Filipe David Manana</p> + <p>Own Id: OTP-9317</p> + </item> + + </list> +--> + + </section> + + <section> + <title>Incompatibilities</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc] Deprecated interface module <c>http</c> has been removed. + It has (long) been replaced by http client interface module + <seealso marker="httpc#">httpc</seealso>. </p> + <p>Own Id: OTP-9359</p> + </item> + + <item> + <p>[httpc|httpd] The old ssl implementation (based on OpenSSL), + has been deprecated. The config option that specified usage of + this version of the ssl app, <c>ossl</c>, has been removed. </p> + <p>Own Id: OTP-9522</p> + </item> + + </list> + + </section> + + </section> <!-- 5.8 --> + + <section><title>Inets 5.7</title> <section><title>Improvements and New Features</title> @@ -1044,570 +1106,11 @@ </section> <!-- 5.1 --> + <!-- + <p>For information about older versions see + <url href="part_notes_history_frame.html">release notes history</url>.</p> + --> - <section><title>Inets 5.0.14</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] The callback watchdog has been removed, as it - turned out to be counter productive when the disk was - overloaded. Earlier a connection was aborted when a - callback (which performs the file access in the TFTP - server) took too long time.</p> - <p> - [tftp] The error message "Too many connections" has been - reclassified to be a warning.</p> - <p> - Own Id: OTP-7888</p> - </item> - </list> - </section> - - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>[httpc] - Incorrect http version option check. </p> - <p>Mats Cronqvist</p> - <p>Own Id: OTP-7882</p> - </item> - - <item> - <p>[httpc] - Unnecessary error report when client - terminating as a result of the server closed the - socket unexpectedly. </p> - <p>Own Id: OTP-7883</p> - </item> - - <item> - <p>[httpc] - Failed transforming a relative URI to - an absolute URI. </p> - <p>[email protected]</p> - <p>Own Id: OTP-7950</p> - </item> - - <item> - <p>[httpd] - The HTTP server did not handle the config - option ssl_ca_certificate_file. </p> - <p>[email protected]</p> - <p>Own Id: OTP-7976</p> - </item> - - </list> - </section> - - </section> <!-- 5.0.14 --> - - - <section><title>Inets 5.0.13</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Ssl did not work correctly with the use of new style - configuration due to sn old internal format that was not - changed correctly in all places.</p> - <p> - Own Id: OTP-7723 Aux Id: seq11143 </p> - </item> - <item> - <p> - [httpc] - Now streams 200 and 206 results and not only - 200 results.</p> - <p> - Own Id: OTP-7857</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpc] - The inets http client will now use persistent - connections without pipelining as default and if a - pipeline timeout is set it will pipeline the requests on - the persistent connections.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-7463</p> - </item> - <item> - <p> - [httpd] - added option ssl_password_callback_arguments.</p> - <p> - Own Id: OTP-7724 Aux Id: seq11151 </p> - </item> - <item> - <p> - Changed the socket use so that it will become more robust - to non-functional ipv6 and fallback on ipv4. This changes - may for very special os-configurations cause a problem - when used with erts-versions pre R13.</p> - <p> - Own Id: OTP-7726</p> - </item> - <item> - <p> - Removed deprecated function httpd_util:key1search/[2,3]</p> - <p> - Own Id: OTP-7815</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.12</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Updated inets so that it not uses the deprecated - function ssl:accept/[2,3].</p> - <p> - Own Id: OTP-7636 Aux Id: seq11086 </p> - </item> - </list> - </section> - - </section> - - - <section><title>Inets 5.0.11</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Transient bug related to hot code swap of the TFTP server is - now fixed. It could happen that the first TFTP server that was - started after a code upgrade to Inets-5.0.6 crashed with a - function clause error in tftp_engine:service_init/2.</p> - <p> Own Id: OTP-7574 Aux Id: seq11069 </p> - </item> - <item> - <p> - [httpd] - Validation of ssl_password_callback_module was - incorrect.</p> - <p> - Own Id: OTP-7597 Aux Id: seq11074 </p> - </item> - <item> - <p> - [httpd] - Misspelling in old apachelike configuration - directive TransferDiskLogSize has been corrected.</p> - <p> Own Id: OTP-7598 Aux Id: seq11059 </p> - </item> - <item> - <p> - Minor problems found by dialyzer has been fixed.</p> - <p> - Own Id: OTP-7605</p> - </item> - </list> - </section> - - </section> - -<section><title>Inets 5.0.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Enhanched an info report.</p> - <p> - Own Id: OTP-7450</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Changed errro message from - {wrong_type,{document_root,"/tmp/htdocs"}} to - {invalid_option,{non_existing, - document_root,"/tmp/htdocs"}}.</p> - <p> - Own Id: OTP-7454</p> - </item> - <item> - <p> - Relative paths in directory authentication did not work - as intended, this has now been fixed.</p> - <p> - Own Id: OTP-7490</p> - </item> - <item> - <p> - The query-string passed to the callback function was not - compliant with the documentation, it is now.</p> - <p> - Own Id: OTP-7512</p> - </item> - </list> - </section> - -</section> - - <section><title>Inets 5.0.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Parameters to error_logger:error_report/1 has been - corrected.</p> - <p> - Own Id: OTP-7257 Aux Id: OTP-7294, OTP-7258 </p> - </item> - <item> - <p> - [httpd] - If a Module/Function request matching an - erl_script_alias registration does not exist as a function in - the module registered a 404 error will now be issued instead of a - 500 error.</p> - <p> - Own Id: OTP-7323</p> - </item> - <item> - <p> - [httpd] -The option auth_type for mod_auth is no longer - mandatory, for backward-compatibility reasons.</p> - <p> - Own Id: OTP-7341</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - [httpd] - Spelling error caused client connection header - to be ignored.</p> - <p> - Own Id: OTP-7315 Aux Id: seq10951 </p> - </item> - <item> - <p> - [httpd] - Call to the function - mod_get:get_modification_date/1 was made too early - resulting in that httpd did not send the 404 file missing - response.</p> - <p> - Own Id: OTP-7321</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.7</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpc, httpd] - Now follows the recommendation regarding - line terminators in section 19.3 in RFC 2616 e.i: "The - line terminator for message-header fields is the sequence - CRLF. However, we recommend that applications, when - parsing such headers, recognize a single LF as a line - terminator and ignore the leading CR".</p> - <p> - Own Id: OTP-7304 Aux Id: seq10944 </p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.6</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] If a callback (which performs the file access in - the TFTP server) takes too long time (more than the - double TFTP timeout), the server will abort the - connection and send an error reply to the client. This - implies that the server will release resources attached - to the connection faster than before. The server simply - assumes that the client has given up.</p> - <p> - [tftp] If the TFTP server receives yet another request - from the same client (same host and port) while it - already has an active connection to the client, it will - simply ignore the new request if the request is equal - with the first one (same filename and options). This - implies that the (new) client will be served by the - already ongoing connection on the server side. By not - setting up yet another connection, in parallel with the - ongoing one, the server will consumer lesser resources.</p> - <p> - [tftp] netascii mode is now supported when the - client/server has native ascii support (Windows). The new - optional parameter native_ascii in the tftp_binary and - tftp_file callback modules can be used to override the - default behavior.</p> - <p> - [tftp] Yet another callback module has been added in - order to allow customized handling of error, warning and - info messages. See the new configuration parameter, - logger.</p> - <p> - [tftp] Yet another configuration parameter, max_retries, - has been added in order to control the number of times a - packet can be resent. The default is 5.</p> - <p> - [tftp] tftp:info/1 and tftp:change_config/2 can now be - applied to all daemons or all servers in one command - without bothering about their process identifiers.</p> - <p> - External TR HI89527.</p> - <p> - Own Id: OTP-7266</p> - </item> - </list> - </section> - -</section> - -<section><title>Inets 5.0.5</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] Blocks with too low block numbers are silently - discarded. For example if a server receives block #5 when - it expects block #7 it will discard the block without - interrupting the file transfer. Too high block numbers - does still imply an error. External TR HI96072.</p> - <p> - Own Id: OTP-7220</p> - </item> - <item> - <p> - [tftp] The problem with occasional case_clause errors in - tftp_engine:common_read/7 has been fixed. External TR - HI97362.</p> - <p> - Own Id: OTP-7221</p> - </item> - </list> - </section> - -</section> - - <section><title>Inets 5.0.4</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Changed calls to file open to concur with the API and not - use deprecated syntax.</p> - <p> - Own Id: OTP-7172</p> - </item> - <item> - <p> - [tftp] Server lost the first packet when the client timed - out</p> - <p> - Own Id: OTP-7173</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Updated copyright headers and fixed backwards - compatibility for an undocumented feature, for now. This - feature will later be removed and a new and documented - option will take its place.</p> - <p> - Own Id: OTP-7144</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Error logs now has a pretty and a compact - format and access logs can be written on the common log - format or the extended common log format.</p> - <p> - Own Id: OTP-6661 Aux Id: Seq 7764 </p> - </item> - <item> - <p> - [httpc] - Added acceptance of missing reason phrase to - the relaxed mode.</p> - <p> - Own Id: OTP-7024</p> - </item> - <item> - <p> - [httpc] - A new option has been added to enable the - client to act as lower version clients, by default the - client is an HTTP/1.1 client.</p> - <p> - Own Id: OTP-7043</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - [httpd] - Deprecated function httpd:start/1 did not - accept all inputs that it had done previously. This - should now work again.</p> - <p> - Own Id: OTP-7040</p> - </item> - </list> - </section> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Changed validity check on bind_address so that - it uses inet:getaddr instead of inet:gethostbyaddr as the - former puts a too hard restriction on the bind_address.</p> - <p> - Own Id: OTP-7041 Aux Id: seq10829 </p> - </item> - <item> - <p> - [httpc] - Internal process now does try-catch and - terminates normally in case of HTTP parse errors. - Semantical the client works just as before returning an - error message to the client, even if the error massage - has been enhanced, but there is no supervisor report in - the shell of a internal process crashing. (Which was the - expected behavior and not a fault.)</p> - <p> - Own Id: OTP-7042</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd, httpc] - Deprecated base64 decode/encode - functions have been removed. Inets uses base64 in STDLIB - instead.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-6485</p> - </item> - <item> - <p> - [httpd] - It is now possible to restrict the length of - acceptable URI:s in the HTTP server.</p> - <p> - Own Id: OTP-6572</p> - </item> - <item> - <p> - [httpc] - Profiles are now supported i.e. the options - available in set_options/1 can be set locally for a - certain profile and do not have to affect all - HTTP-requests issued in the Erlang node. Calls to the - HTTP client API functions not using the profile argument - will use the default profile.</p> - <p> - Own Id: OTP-6690</p> - </item> - <item> - <p> - A new uniform Inets interface provides a flexible way to - start/stop Inets services and get information about - running services. See inets(3). This also means that - inflexibilities in the HTTP server has been removed and - more default values has been added.</p> - <p> - Own Id: OTP-6705</p> - </item> - <item> - <p> - [tftp] Logged errors have been changed to be logged - warnings.</p> - <p> - Own Id: OTP-6916 Aux Id: seq10737 </p> - </item> - <item> - <p> - [httpc] - The client will now return the proper value - when receiving a HTTP 204 code instead of hanging.</p> - <p> - Own Id: OTP-6982</p> - </item> - <item> - <p> - The Inets application now has to be explicitly started - and stopped i.e. it will not automatically be started as - a temporary application as it did before. Although a - practical feature when testing things in the shell it is - not desirable that people take advantage of this and not - start the Inets application in a correct way in their - products. Added functions to the Inets API that call - application:start/stop.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-6993</p> - </item> - </list> - </section> - - <!-- p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p --> - </section> </chapter> diff --git a/lib/inets/src/http_client/Makefile b/lib/inets/src/http_client/Makefile index 0397b48ab2..3960c36d00 100644 --- a/lib/inets/src/http_client/Makefile +++ b/lib/inets/src/http_client/Makefile @@ -41,7 +41,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- MODULES = \ - http \ httpc \ httpc_cookie \ httpc_handler \ diff --git a/lib/inets/src/http_client/http.erl b/lib/inets/src/http_client/http.erl deleted file mode 100644 index bbe2fec267..0000000000 --- a/lib/inets/src/http_client/http.erl +++ /dev/null @@ -1,132 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% - -%%% Description: OLD API MODULE - USE httpc INSTEAD - --module(http). - --deprecated({request, 1, next_major_release}). --deprecated({request, 2, next_major_release}). --deprecated({request, 4, next_major_release}). --deprecated({request, 5, next_major_release}). --deprecated({cancel_request, 1, next_major_release}). --deprecated({cancel_request, 2, next_major_release}). --deprecated({set_option, 2, next_major_release}). --deprecated({set_option, 3, next_major_release}). --deprecated({set_options, 1, next_major_release}). --deprecated({set_options, 2, next_major_release}). --deprecated({verify_cookies, 2, next_major_release}). --deprecated({verify_cookies, 3, next_major_release}). --deprecated({cookie_header, 1, next_major_release}). --deprecated({cookie_header, 2, next_major_release}). --deprecated({stream_next, 1, next_major_release}). --deprecated({default_profile, 0, next_major_release}). - -%% Deprecated --export([ - request/1, request/2, request/4, request/5, - cancel_request/1, cancel_request/2, - set_option/2, set_option/3, - set_options/1, set_options/2, - verify_cookies/2, verify_cookies/3, - cookie_header/1, cookie_header/2, - stream_next/1, - default_profile/0 - ]). - - -%%%========================================================================= -%%% API -%%%========================================================================= - -%%-------------------------------------------------------------------------- -%% request(Url [, Profile]) -> -%% request(Method, Request, HTTPOptions, Options [, Profile]) -%%-------------------------------------------------------------------------- - -request(Url) -> httpc:request(Url). -request(Url, Profile) -> httpc:request(Url, Profile). - -request(Method, Request, HttpOptions, Options) -> - httpc:request(Method, Request, HttpOptions, Options). -request(Method, Request, HttpOptions, Options, Profile) -> - httpc:request(Method, Request, HttpOptions, Options, Profile). - - -%%-------------------------------------------------------------------------- -%% cancel_request(RequestId [, Profile]) -%%------------------------------------------------------------------------- - -cancel_request(RequestId) -> - httpc:cancel_request(RequestId). -cancel_request(RequestId, Profile) -> - httpc:cancel_request(RequestId, Profile). - - -%%-------------------------------------------------------------------------- -%% set_options(Options [, Profile]) -%% set_option(Key, Value [, Profile]) -%%------------------------------------------------------------------------- - -set_options(Options) -> - httpc:set_options(Options). -set_options(Options, Profile) -> - httpc:set_options(Options, Profile). - -set_option(Key, Value) -> - httpc:set_option(Key, Value). -set_option(Key, Value, Profile) -> - httpc:set_option(Key, Value, Profile). - - -%%-------------------------------------------------------------------------- -%% verify_cookies(SetCookieHeaders, Url [, Profile]) -%%------------------------------------------------------------------------- - -verify_cookies(SetCookieHeaders, Url) -> - httpc:store_cookies(SetCookieHeaders, Url). -verify_cookies(SetCookieHeaders, Url, Profile) -> - httpc:store_cookies(SetCookieHeaders, Url, Profile). - - -%%-------------------------------------------------------------------------- -%% cookie_header(Url [, Profile]) -%%------------------------------------------------------------------------- - -cookie_header(Url) -> - httpc:cookie_header(Url). -cookie_header(Url, Profile) -> - httpc:cookie_header(Url, Profile). - - -%%-------------------------------------------------------------------------- -%% stream_next(Pid) -%%------------------------------------------------------------------------- - -stream_next(Pid) -> - httpc:stream_next(Pid). - - -%%-------------------------------------------------------------------------- -%% default_profile() -%%------------------------------------------------------------------------- - -default_profile() -> - httpc:default_profile(). diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index fe8e93af1f..75c26c63cc 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -105,7 +105,6 @@ request(Url, Profile) -> %% {ssl, SSLOptions} | {proxy_auth, {User, Password}} %% Ssloptions = ssl_options() | %% {ssl, ssl_options()} | -%% {ossl, ssl_options()} | %% {essl, ssl_options()} %% ssl_options() = [ssl_option()] %% ssl_option() = {verify, code()} | @@ -644,8 +643,6 @@ http_options_default() -> {ok, {?HTTP_DEFAULT_SSL_KIND, Value}}; ({ssl, SslOptions}) when is_list(SslOptions) -> {ok, {?HTTP_DEFAULT_SSL_KIND, SslOptions}}; - ({ossl, SslOptions}) when is_list(SslOptions) -> - {ok, {ossl, SslOptions}}; ({essl, SslOptions}) when is_list(SslOptions) -> {ok, {essl, SslOptions}}; (_) -> diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 2e924667c6..97cf474ab9 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -28,7 +28,6 @@ -define(HTTP_MAX_URI_SIZE, nolimit). -ifndef(HTTP_DEFAULT_SSL_KIND). -%% -define(HTTP_DEFAULT_SSL_KIND, ossl). -define(HTTP_DEFAULT_SSL_KIND, essl). -endif. % -ifdef(HTTP_DEFAULT_SSL_KIND). diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 9b8190ebed..5eb827032f 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -62,8 +62,6 @@ start(ip_comm) -> %% This is just for backward compatibillity start({ssl, _}) -> do_start_ssl(); -start({ossl, _}) -> - do_start_ssl(); start({essl, _}) -> do_start_ssl(). @@ -126,22 +124,6 @@ connect(ip_comm = _SocketType, {Host, Port}, Opts0, Timeout) connect({ssl, SslConfig}, Address, Opts, Timeout) -> connect({?HTTP_DEFAULT_SSL_KIND, SslConfig}, Address, Opts, Timeout); -connect({ossl, SslConfig}, {Host, Port}, _, Timeout) -> - Opts = [binary, {active, false}, {ssl_imp, old}] ++ SslConfig, - ?hlrt("connect using ossl", - [{host, Host}, - {port, Port}, - {ssl_config, SslConfig}, - {timeout, Timeout}]), - case (catch ssl:connect(Host, Port, Opts, Timeout)) of - {'EXIT', Reason} -> - {error, {eoptions, Reason}}; - {ok, _} = OK -> - OK; - {error, _} = ERROR -> - ERROR - end; - connect({essl, SslConfig}, {Host, Port}, Opts0, Timeout) -> Opts = [binary, {active, false}, {ssl_imp, new} | Opts0] ++ SslConfig, ?hlrt("connect using essl", @@ -187,13 +169,6 @@ listen({ssl, SSLConfig}, Addr, Port) -> {ssl_config, SSLConfig}]), listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); -listen({ossl, SSLConfig}, Addr, Port) -> - ?hlrt("listen (ossl)", - [{addr, Addr}, - {port, Port}, - {ssl_config, SSLConfig}]), - listen_ssl(Addr, Port, [{ssl_imp, old} | SSLConfig]); - listen({essl, SSLConfig}, Addr, Port) -> ?hlrt("listen (essl)", [{addr, Addr}, @@ -353,8 +328,6 @@ accept(ip_comm, ListenSocket, Timeout) -> accept({ssl, SSLConfig}, ListenSocket, Timeout) -> accept({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, ListenSocket, Timeout); -accept({ossl, _SSLConfig}, ListenSocket, Timeout) -> - ssl:transport_accept(ListenSocket, Timeout); accept({essl, _SSLConfig}, ListenSocket, Timeout) -> ssl:transport_accept(ListenSocket, Timeout). @@ -374,9 +347,6 @@ controlling_process(ip_comm, Socket, NewOwner) -> controlling_process({ssl, SSLConfig}, Socket, NewOwner) -> controlling_process({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, NewOwner); -controlling_process({ossl, _}, Socket, NewOwner) -> - ssl:controlling_process(Socket, NewOwner); - controlling_process({essl, _}, Socket, NewOwner) -> ssl:controlling_process(Socket, NewOwner). @@ -397,13 +367,6 @@ setopts(ip_comm, Socket, Options) -> setopts({ssl, SSLConfig}, Socket, Options) -> setopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); -setopts({ossl, _}, Socket, Options) -> - ?hlrt("[o]ssl setopts", [{socket, Socket}, {options, Options}]), - Reason = (catch ssl:setopts(Socket, Options)), - ?hlrt("[o]ssl setopts result", [{reason, Reason}]), - Reason; - - setopts({essl, _}, Socket, Options) -> ?hlrt("[e]ssl setopts", [{socket, Socket}, {options, Options}]), Reason = (catch ssl:setopts(Socket, Options)), @@ -435,10 +398,6 @@ getopts(ip_comm, Socket, Options) -> getopts({ssl, SSLConfig}, Socket, Options) -> getopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); -getopts({ossl, _}, Socket, Options) -> - ?hlrt("ssl getopts", [{socket, Socket}, {options, Options}]), - getopts_ssl(Socket, Options); - getopts({essl, _}, Socket, Options) -> ?hlrt("essl getopts", [{socket, Socket}, {options, Options}]), getopts_ssl(Socket, Options). @@ -472,9 +431,6 @@ getstat(ip_comm = _SocketType, Socket) -> getstat({ssl, SSLConfig}, Socket) -> getstat({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -getstat({ossl, _} = _SocketType, _Socket) -> - []; - getstat({essl, _} = _SocketType, _Socket) -> []. @@ -493,9 +449,6 @@ send(ip_comm, Socket, Message) -> send({ssl, SSLConfig}, Socket, Message) -> send({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Message); -send({ossl, _}, Socket, Message) -> - ssl:send(Socket, Message); - send({essl, _}, Socket, Message) -> ssl:send(Socket, Message). @@ -514,9 +467,6 @@ close(ip_comm, Socket) -> close({ssl, SSLConfig}, Socket) -> close({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -close({ossl, _}, Socket) -> - ssl:close(Socket); - close({essl, _}, Socket) -> ssl:close(Socket). @@ -538,9 +488,6 @@ peername(ip_comm, Socket) -> peername({ssl, SSLConfig}, Socket) -> peername({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -peername({ossl, _}, Socket) -> - do_peername(ssl:peername(Socket)); - peername({essl, _}, Socket) -> do_peername(ssl:peername(Socket)). @@ -573,9 +520,6 @@ sockname(ip_comm, Socket) -> sockname({ssl, SSLConfig}, Socket) -> sockname({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -sockname({ossl, _}, Socket) -> - do_sockname(ssl:sockname(Socket)); - sockname({essl, _}, Socket) -> do_sockname(ssl:sockname(Socket)). @@ -651,9 +595,6 @@ negotiate(ip_comm,_,_) -> negotiate({ssl, SSLConfig}, Socket, Timeout) -> ?hlrt("negotiate(ssl)", []), negotiate({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Timeout); -negotiate({ossl, _}, Socket, Timeout) -> - ?hlrt("negotiate(ossl)", []), - negotiate_ssl(Socket, Timeout); negotiate({essl, _}, Socket, Timeout) -> ?hlrt("negotiate(essl)", []), negotiate_ssl(Socket, Timeout). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index f4d8a6c09f..189527e2b3 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -219,9 +219,8 @@ load("ServerName " ++ ServerName, []) -> load("SocketType " ++ SocketType, []) -> %% ssl is the same as HTTP_DEFAULT_SSL_KIND - %% ossl is ssl based on OpenSSL (the "old" ssl) %% essl is the pure Erlang-based ssl (the "new" ssl) - case check_enum(clean(SocketType), ["ssl", "ossl", "essl", "ip_comm"]) of + case check_enum(clean(SocketType), ["ssl", "essl", "ip_comm"]) of {ok, ValidSocketType} -> {ok, [], {socket_type, ValidSocketType}}; {error,_} -> @@ -541,7 +540,6 @@ validate_config_params([{server_name, Value} | _]) -> validate_config_params([{socket_type, Value} | Rest]) when (Value =:= ip_comm) orelse (Value =:= ssl) orelse - (Value =:= ossl) orelse (Value =:= essl) -> validate_config_params(Rest); validate_config_params([{socket_type, Value} | _]) -> @@ -811,7 +809,7 @@ lookup_socket_type(ConfigDB) -> case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of ip_comm -> ip_comm; - SSL when (SSL =:= ssl) orelse (SSL =:= ossl) orelse (SSL =:= essl) -> + SSL when (SSL =:= ssl) orelse (SSL =:= essl) -> SSLTag = if (SSL =:= ssl) -> diff --git a/lib/inets/src/http_server/httpd_file.erl b/lib/inets/src/http_server/httpd_file.erl index ccc1f7874a..e8a8ab6411 100644 --- a/lib/inets/src/http_server/httpd_file.erl +++ b/lib/inets/src/http_server/httpd_file.erl @@ -33,7 +33,7 @@ handle_error(enotdir, Op, ModData, Path) -> handle_error(404, Op, ModData, Path, ": A component of the file name is not a directory"); handle_error(emfile, Op, _ModData, Path) -> - handle_error(500, Op, none, Path, ": To many open files"); + handle_error(500, Op, none, Path, ": Too many open files"); handle_error({enfile,_}, Op, _ModData, Path) -> handle_error(500, Op, none, Path, ": File table overflow"); handle_error(_Reason, Op, ModData, Path) -> diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index cb036157a5..4d0defb329 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -34,8 +34,7 @@ ftp_sup, %% HTTP client: - http, %% Old client API module - httpc, %% New client API module + httpc, httpc_handler, httpc_handler_sup, httpc_manager, diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 8b0fcb185d..65cee34cb3 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,65 +18,27 @@ {"%VSN%", [ - {"5.6", - [ - {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, - {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, - {update, httpc_handler, soft, soft_purge, soft_purge, []}, - {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, - {update, ftp, soft, soft_purge, soft_purge, []} - ] - }, - {"5.5.2", + {"5.7", [ {restart_application, inets} ] }, - {"5.5.1", - [ - {restart_application, inets} - ] - }, - {"5.5", - [ - {restart_application, inets} - ] - }, - {"5.4", + {"5.6", [ {restart_application, inets} ] } ], [ - {"5.6", - [ - {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, - {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, - {update, httpc_handler, soft, soft_purge, soft_purge, []}, - {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, - {update, ftp, soft, soft_purge, soft_purge, []} - ] - }, - {"5.5.2", - [ - {restart_application, inets} - ] - }, - {"5.5.1", + {"5.7", [ {restart_application, inets} ] }, - {"5.5", - [ - {restart_application, inets} - ] - }, - {"5.4", + {"5.6", [ {restart_application, inets} ] - } + } ] }. diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 6edd5371af..f95fb93669 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -113,13 +113,10 @@ groups() -> proxy_page_does_not_exist, proxy_https_not_supported]}, {ssl, [], [ssl_head, - ossl_head, essl_head, ssl_get, - ossl_get, essl_get, ssl_trace, - ossl_trace, essl_trace]}, {stream, [], [http_stream, http_stream_once, @@ -273,10 +270,6 @@ init_per_testcase(Case, Timeout, Config) -> init_per_testcase_ssl(ssl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); - [$o, $s, $s, $l | _] -> - init_per_testcase_ssl(ossl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - [$e, $s, $s, $l | _] -> init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); @@ -1076,13 +1069,6 @@ ssl_head(suite) -> ssl_head(Config) when is_list(Config) -> ssl_head(ssl, Config). -ossl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -ossl_head(suite) -> - []; -ossl_head(Config) when is_list(Config) -> - ssl_head(ossl, Config). - essl_head(doc) -> ["Same as http_head/1 but over ssl sockets."]; essl_head(suite) -> @@ -1105,8 +1091,6 @@ ssl_head(SslTag, Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1131,13 +1115,6 @@ ssl_get(suite) -> ssl_get(Config) when is_list(Config) -> ssl_get(ssl, Config). -ossl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -ossl_get(suite) -> - []; -ossl_get(Config) when is_list(Config) -> - ssl_get(ossl, Config). - essl_get(doc) -> ["Same as http_get/1 but over ssl sockets."]; essl_get(suite) -> @@ -1157,8 +1134,6 @@ ssl_get(SslTag, Config) when is_list(Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1184,13 +1159,6 @@ ssl_trace(suite) -> ssl_trace(Config) when is_list(Config) -> ssl_trace(ssl, Config). -ossl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -ossl_trace(suite) -> - []; -ossl_trace(Config) when is_list(Config) -> - ssl_trace(ossl, Config). - essl_trace(doc) -> ["Same as http_trace/1 but over ssl sockets."]; essl_trace(suite) -> @@ -1210,8 +1178,6 @@ ssl_trace(SslTag, Config) when is_list(Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -3038,10 +3004,6 @@ dummy_server_init(Caller, essl, IpV, SSLOptions) -> BaseOpts = [{ssl_imp, new}, {backlog, 128}, binary, {reuseaddr,true}, {active, false} | SSLOptions], - dummy_ssl_server_init(Caller, BaseOpts, IpV); -dummy_server_init(Caller, ossl, IpV, SSLOptions) -> - BaseOpts = [{ssl_imp, old}, - {backlog, 128}, binary, {active, false} | SSLOptions], dummy_ssl_server_init(Caller, BaseOpts, IpV). dummy_ssl_server_init(Caller, BaseOpts, IpV) -> diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl index feef5f1eea..ba50a42633 100644 --- a/lib/inets/test/httpc_cookie_SUITE.erl +++ b/lib/inets/test/httpc_cookie_SUITE.erl @@ -55,7 +55,7 @@ init_per_testcase(session_cookies_only = Case, Config0) -> "~n Config0: ~p", [Case, Config0]), Config = init_workdir(Case, Config0), application:start(inets), - http:set_options([{cookies, verify}]), + httpc:set_options([{cookies, verify}]), watch_dog(Config); init_per_testcase(Case, Config0) -> @@ -66,7 +66,7 @@ init_per_testcase(Case, Config0) -> application:load(inets), application:set_env(inets, services, [{httpc, {default, CaseDir}}]), application:start(inets), - http:set_options([{cookies, verify}]), + httpc:set_options([{cookies, verify}]), watch_dog(Config). watch_dog(Config) -> @@ -152,12 +152,12 @@ session_cookies_only(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" ";max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), application:stop(inets), application:start(inets), - {"cookie",""} = http:cookie_header(?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("session_cookies_only -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -172,9 +172,9 @@ netscape_cookies(Config) when is_list(Config) -> Expires = future_netscape_date(), SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/; " "expires=" ++ Expires}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = - http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), tsp("netscape_cookies -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -189,13 +189,13 @@ cookie_cancel(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), - NewSetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" - "max-age=0"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), - {"cookie", ""} = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), + NewSetCookieHeaders = + [{"set-cookie", "test_cookie=true; path=/;max-age=0"}], + httpc:store_cookies(NewSetCookieHeaders, ?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("cookie_cancel -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -209,11 +209,11 @@ cookie_expires(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=5"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), test_server:sleep(10000), - {"cookie", ""} = http:cookie_header(?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("cookie_expires -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -227,16 +227,16 @@ persistent_cookie(Config) when is_list(Config)-> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = - http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), CaseDir = ?config(case_top_dir, Config), application:stop(inets), application:load(inets), application:set_env(inets, services, [{httpc, {default, CaseDir}}]), application:start(inets), - http:set_options([{cookies, enabled}]), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = http:cookie_header(?URL), + httpc:set_options([{cookies, enabled}]), + {"cookie","$Version=0; test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), tsp("persistent_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -251,10 +251,10 @@ domain_cookie(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "domain=.cookie.test.org"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie","$Version=0; test_cookie=true; $Path=/; " "$Domain=.cookie.test.org"} = - http:cookie_header(?URL_DOMAIN), + httpc:cookie_header(?URL_DOMAIN), tsp("domain_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -275,8 +275,8 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> Cookies 1: ~p", [httpc:which_cookies()]), SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/; secure"}], - tsp("secure_cookie -> verify cookies (1)"), - ok = http:verify_cookies(SetCookieHeaders, ?URL), + tsp("secure_cookie -> store cookies (1)"), + ok = httpc:store_cookies(SetCookieHeaders, ?URL), tsp("secure_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), @@ -286,9 +286,9 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> check cookie (plain)"), check_cookie("", ?URL), - tsp("secure_cookie -> verify cookies (2)"), + tsp("secure_cookie -> store cookies (2)"), SetCookieHeaders1 = [{"set-cookie", "test1_cookie=true; path=/; secure"}], - ok = http:verify_cookies(SetCookieHeaders1, ?URL), + ok = httpc:store_cookies(SetCookieHeaders1, ?URL), tsp("secure_cookie -> Cookies 3: ~p", [httpc:which_cookies()]), @@ -297,7 +297,7 @@ secure_cookie(Config) when is_list(Config) -> "test1_cookie=true; $Path=/", ?URL_SECURE), %% {"cookie","$Version=0; test_cookie=true; $Path=/; " -%% "test1_cookie=true; $Path=/"} = http:cookie_header(?URL_SECURE), +%% "test1_cookie=true; $Path=/"} = httpc:cookie_header(?URL_SECURE), tsp("secure_cookie -> Cookies 4: ~p", [httpc:which_cookies()]), @@ -314,14 +314,14 @@ update_cookie(Config) when is_list(Config)-> "max-age=6500"}, {"set-cookie", "test_cookie2=true; path=/;" "max-age=6500"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=true; $Path=/"} = http:cookie_header(?URL), + "test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), NewSetCookieHeaders = [{"set-cookie", "test_cookie=false; " "path=/;max-age=6500"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), + httpc:store_cookies(NewSetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=false; $Path=/"} = http:cookie_header(?URL). + "test_cookie=false; $Path=/"} = httpc:cookie_header(?URL). update_cookie_session(doc)-> ["Test that a cookie can be updated."]; @@ -330,13 +330,13 @@ update_cookie_session(suite) -> update_cookie_session(Config) when is_list(Config)-> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/"}, {"set-cookie", "test_cookie2=true; path=/"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=true; $Path=/"} = http:cookie_header(?URL), + "test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), NewSetCookieHeaders = [{"set-cookie", "test_cookie=false; path=/"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), + httpc:store_cookies(NewSetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=false; $Path=/"} = http:cookie_header(?URL). + "test_cookie=false; $Path=/"} = httpc:cookie_header(?URL). cookie_attributes(doc) -> @@ -348,8 +348,8 @@ cookie_attributes(Config) when is_list(Config) -> "comment=foobar; "%% Comment "foo=bar;" %% Nonsense should be ignored "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=1; test_cookie=true"} = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie","$Version=1; test_cookie=true"} = httpc:cookie_header(?URL), ok. @@ -358,7 +358,7 @@ cookie_attributes(Config) when is_list(Config) -> %%-------------------------------------------------------------------- check_cookie(Expect, URL) -> - case http:cookie_header(URL) of + case httpc:cookie_header(URL) of {"cookie", Expect} -> ok; {"cookie", Unexpected} -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index c4d4bf969b..ea704e509e 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -68,127 +68,96 @@ -export([ pssl_mod_alias/1, - ossl_mod_alias/1, essl_mod_alias/1, pssl_mod_actions/1, - ossl_mod_actions/1, essl_mod_actions/1, pssl_mod_security/1, - ossl_mod_security/1, essl_mod_security/1, pssl_mod_auth/1, - ossl_mod_auth/1, essl_mod_auth/1, pssl_mod_auth_api/1, - ossl_mod_auth_api/1, essl_mod_auth_api/1, pssl_mod_auth_mnesia_api/1, - ossl_mod_auth_mnesia_api/1, essl_mod_auth_mnesia_api/1, pssl_mod_htaccess/1, - ossl_mod_htaccess/1, essl_mod_htaccess/1, pssl_mod_cgi/1, - ossl_mod_cgi/1, essl_mod_cgi/1, pssl_mod_esi/1, - ossl_mod_esi/1, essl_mod_esi/1, pssl_mod_get/1, - ossl_mod_get/1, essl_mod_get/1, pssl_mod_head/1, - ossl_mod_head/1, essl_mod_head/1, pssl_mod_all/1, - ossl_mod_all/1, essl_mod_all/1, pssl_load_light/1, - ossl_load_light/1, essl_load_light/1, pssl_load_medium/1, - ossl_load_medium/1, essl_load_medium/1, pssl_load_heavy/1, - ossl_load_heavy/1, essl_load_heavy/1, pssl_dos_hostname/1, - ossl_dos_hostname/1, essl_dos_hostname/1, pssl_time_test/1, - ossl_time_test/1, essl_time_test/1, pssl_restart_no_block/1, - ossl_restart_no_block/1, essl_restart_no_block/1, pssl_restart_disturbing_block/1, - ossl_restart_disturbing_block/1, essl_restart_disturbing_block/1, pssl_restart_non_disturbing_block/1, - ossl_restart_non_disturbing_block/1, essl_restart_non_disturbing_block/1, pssl_block_disturbing_idle/1, - ossl_block_disturbing_idle/1, essl_block_disturbing_idle/1, pssl_block_non_disturbing_idle/1, - ossl_block_non_disturbing_idle/1, essl_block_non_disturbing_idle/1, pssl_block_503/1, - ossl_block_503/1, essl_block_503/1, pssl_block_disturbing_active/1, - ossl_block_disturbing_active/1, essl_block_disturbing_active/1, pssl_block_non_disturbing_active/1, - ossl_block_non_disturbing_active/1, essl_block_non_disturbing_active/1, pssl_block_disturbing_active_timeout_not_released/1, - ossl_block_disturbing_active_timeout_not_released/1, essl_block_disturbing_active_timeout_not_released/1, pssl_block_disturbing_active_timeout_released/1, - ossl_block_disturbing_active_timeout_released/1, essl_block_disturbing_active_timeout_released/1, pssl_block_non_disturbing_active_timeout_not_released/1, - ossl_block_non_disturbing_active_timeout_not_released/1, essl_block_non_disturbing_active_timeout_not_released/1, pssl_block_non_disturbing_active_timeout_released/1, - ossl_block_non_disturbing_active_timeout_released/1, essl_block_non_disturbing_active_timeout_released/1, pssl_block_disturbing_blocker_dies/1, - ossl_block_disturbing_blocker_dies/1, essl_block_disturbing_blocker_dies/1, pssl_block_non_disturbing_blocker_dies/1, - ossl_block_non_disturbing_blocker_dies/1, essl_block_non_disturbing_blocker_dies/1 ]). @@ -272,8 +241,7 @@ groups() -> ip_block_non_disturbing_active_timeout_released, ip_block_disturbing_blocker_dies, ip_block_non_disturbing_blocker_dies]}, - {ssl, [], - [{group, pssl}, {group, ossl}, {group, essl}]}, + {ssl, [], [{group, pssl}, {group, essl}]}, {pssl, [], [pssl_mod_alias, pssl_mod_actions, pssl_mod_security, pssl_mod_auth, pssl_mod_auth_api, @@ -293,25 +261,6 @@ groups() -> pssl_block_non_disturbing_active_timeout_released, pssl_block_disturbing_blocker_dies, pssl_block_non_disturbing_blocker_dies]}, - {ossl, [], - [ossl_mod_alias, ossl_mod_actions, ossl_mod_security, - ossl_mod_auth, ossl_mod_auth_api, - ossl_mod_auth_mnesia_api, ossl_mod_htaccess, - ossl_mod_cgi, ossl_mod_esi, ossl_mod_get, ossl_mod_head, - ossl_mod_all, ossl_load_light, ossl_load_medium, - ossl_load_heavy, ossl_dos_hostname, ossl_time_test, - ossl_restart_no_block, ossl_restart_disturbing_block, - ossl_restart_non_disturbing_block, - ossl_block_disturbing_idle, - ossl_block_non_disturbing_idle, ossl_block_503, - ossl_block_disturbing_active, - ossl_block_non_disturbing_active, - ossl_block_disturbing_active_timeout_not_released, - ossl_block_disturbing_active_timeout_released, - ossl_block_non_disturbing_active_timeout_not_released, - ossl_block_non_disturbing_active_timeout_released, - ossl_block_disturbing_blocker_dies, - ossl_block_non_disturbing_blocker_dies]}, {essl, [], [essl_mod_alias, essl_mod_actions, essl_mod_security, essl_mod_auth, essl_mod_auth_api, @@ -493,7 +442,6 @@ init_per_testcase2(Case, Config) -> [X, $s, $s, $l | _] -> case X of $p -> ssl; - $o -> ossl; $e -> essl end; _ -> @@ -636,7 +584,6 @@ init_per_testcase3(Case, Config) -> SslTag = case X of $p -> ssl; % plain - $o -> ossl; % OpenSSL based ssl $e -> essl % Erlang based ssl end, case inets_test_lib:start_http_server_ssl( @@ -653,7 +600,6 @@ init_per_testcase3(Case, Config) -> SslTag = case X of $p -> ssl; - $o -> ossl; $e -> essl end, case inets_test_lib:start_http_server_ssl( @@ -1158,13 +1104,6 @@ pssl_mod_alias(suite) -> pssl_mod_alias(Config) when is_list(Config) -> ssl_mod_alias(ssl, Config). -ossl_mod_alias(doc) -> - ["Module test: mod_alias - using new of configure old SSL"]; -ossl_mod_alias(suite) -> - []; -ossl_mod_alias(Config) when is_list(Config) -> - ssl_mod_alias(ossl, Config). - essl_mod_alias(doc) -> ["Module test: mod_alias - using new of configure new SSL"]; essl_mod_alias(suite) -> @@ -1188,13 +1127,6 @@ pssl_mod_actions(suite) -> pssl_mod_actions(Config) when is_list(Config) -> ssl_mod_actions(ssl, Config). -ossl_mod_actions(doc) -> - ["Module test: mod_actions - using new of configure old SSL"]; -ossl_mod_actions(suite) -> - []; -ossl_mod_actions(Config) when is_list(Config) -> - ssl_mod_actions(ossl, Config). - essl_mod_actions(doc) -> ["Module test: mod_actions - using new of configure new SSL"]; essl_mod_actions(suite) -> @@ -1220,13 +1152,6 @@ pssl_mod_security(suite) -> pssl_mod_security(Config) when is_list(Config) -> ssl_mod_security(ssl, Config). -ossl_mod_security(doc) -> - ["Module test: mod_security - using new of configure old SSL"]; -ossl_mod_security(suite) -> - []; -ossl_mod_security(Config) when is_list(Config) -> - ssl_mod_security(ossl, Config). - essl_mod_security(doc) -> ["Module test: mod_security - using new of configure new SSL"]; essl_mod_security(suite) -> @@ -1253,13 +1178,6 @@ pssl_mod_auth(suite) -> pssl_mod_auth(Config) when is_list(Config) -> ssl_mod_auth(ssl, Config). -ossl_mod_auth(doc) -> - ["Module test: mod_auth - using new of configure old SSL"]; -ossl_mod_auth(suite) -> - []; -ossl_mod_auth(Config) when is_list(Config) -> - ssl_mod_auth(ossl, Config). - essl_mod_auth(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth(suite) -> @@ -1284,13 +1202,6 @@ pssl_mod_auth_api(suite) -> pssl_mod_auth_api(Config) when is_list(Config) -> ssl_mod_auth_api(ssl, Config). -ossl_mod_auth_api(doc) -> - ["Module test: mod_auth - using new of configure old SSL"]; -ossl_mod_auth_api(suite) -> - []; -ossl_mod_auth_api(Config) when is_list(Config) -> - ssl_mod_auth_api(ossl, Config). - essl_mod_auth_api(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth_api(suite) -> @@ -1317,13 +1228,6 @@ pssl_mod_auth_mnesia_api(suite) -> pssl_mod_auth_mnesia_api(Config) when is_list(Config) -> ssl_mod_auth_mnesia_api(ssl, Config). -ossl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api - using new of configure old SSL"]; -ossl_mod_auth_mnesia_api(suite) -> - []; -ossl_mod_auth_mnesia_api(Config) when is_list(Config) -> - ssl_mod_auth_mnesia_api(ossl, Config). - essl_mod_auth_mnesia_api(doc) -> ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; essl_mod_auth_mnesia_api(suite) -> @@ -1348,13 +1252,6 @@ pssl_mod_htaccess(suite) -> pssl_mod_htaccess(Config) when is_list(Config) -> ssl_mod_htaccess(ssl, Config). -ossl_mod_htaccess(doc) -> - ["Module test: mod_htaccess - using new of configure old SSL"]; -ossl_mod_htaccess(suite) -> - []; -ossl_mod_htaccess(Config) when is_list(Config) -> - ssl_mod_htaccess(ossl, Config). - essl_mod_htaccess(doc) -> ["Module test: mod_htaccess - using new of configure new SSL"]; essl_mod_htaccess(suite) -> @@ -1379,13 +1276,6 @@ pssl_mod_cgi(suite) -> pssl_mod_cgi(Config) when is_list(Config) -> ssl_mod_cgi(ssl, Config). -ossl_mod_cgi(doc) -> - ["Module test: mod_cgi - using new of configure old SSL"]; -ossl_mod_cgi(suite) -> - []; -ossl_mod_cgi(Config) when is_list(Config) -> - ssl_mod_cgi(ossl, Config). - essl_mod_cgi(doc) -> ["Module test: mod_cgi - using new of configure new SSL"]; essl_mod_cgi(suite) -> @@ -1415,13 +1305,6 @@ pssl_mod_esi(suite) -> pssl_mod_esi(Config) when is_list(Config) -> ssl_mod_esi(ssl, Config). -ossl_mod_esi(doc) -> - ["Module test: mod_esi - using new of configure old SSL"]; -ossl_mod_esi(suite) -> - []; -ossl_mod_esi(Config) when is_list(Config) -> - ssl_mod_esi(ossl, Config). - essl_mod_esi(doc) -> ["Module test: mod_esi - using new of configure new SSL"]; essl_mod_esi(suite) -> @@ -1446,13 +1329,6 @@ pssl_mod_get(suite) -> pssl_mod_get(Config) when is_list(Config) -> ssl_mod_get(ssl, Config). -ossl_mod_get(doc) -> - ["Module test: mod_get - using new of configure old SSL"]; -ossl_mod_get(suite) -> - []; -ossl_mod_get(Config) when is_list(Config) -> - ssl_mod_get(ossl, Config). - essl_mod_get(doc) -> ["Module test: mod_get - using new of configure new SSL"]; essl_mod_get(suite) -> @@ -1477,13 +1353,6 @@ pssl_mod_head(suite) -> pssl_mod_head(Config) when is_list(Config) -> ssl_mod_head(ssl, Config). -ossl_mod_head(doc) -> - ["Module test: mod_head - using new of configure old SSL"]; -ossl_mod_head(suite) -> - []; -ossl_mod_head(Config) when is_list(Config) -> - ssl_mod_head(ossl, Config). - essl_mod_head(doc) -> ["Module test: mod_head - using new of configure new SSL"]; essl_mod_head(suite) -> @@ -1508,13 +1377,6 @@ pssl_mod_all(suite) -> pssl_mod_all(Config) when is_list(Config) -> ssl_mod_all(ssl, Config). -ossl_mod_all(doc) -> - ["All modules test - using new of configure old SSL"]; -ossl_mod_all(suite) -> - []; -ossl_mod_all(Config) when is_list(Config) -> - ssl_mod_all(ossl, Config). - essl_mod_all(doc) -> ["All modules test - using new of configure new SSL"]; essl_mod_all(suite) -> @@ -1539,13 +1401,6 @@ pssl_load_light(suite) -> pssl_load_light(Config) when is_list(Config) -> ssl_load_light(ssl, Config). -ossl_load_light(doc) -> - ["Test light load - using new of configure old SSL"]; -ossl_load_light(suite) -> - []; -ossl_load_light(Config) when is_list(Config) -> - ssl_load_light(ossl, Config). - essl_load_light(doc) -> ["Test light load - using new of configure new SSL"]; essl_load_light(suite) -> @@ -1571,13 +1426,6 @@ pssl_load_medium(suite) -> pssl_load_medium(Config) when is_list(Config) -> ssl_load_medium(ssl, Config). -ossl_load_medium(doc) -> - ["Test medium load - using new of configure old SSL"]; -ossl_load_medium(suite) -> - []; -ossl_load_medium(Config) when is_list(Config) -> - ssl_load_medium(ossl, Config). - essl_load_medium(doc) -> ["Test medium load - using new of configure new SSL"]; essl_load_medium(suite) -> @@ -1609,13 +1457,6 @@ pssl_load_heavy(suite) -> pssl_load_heavy(Config) when is_list(Config) -> ssl_load_heavy(ssl, Config). -ossl_load_heavy(doc) -> - ["Test heavy load - using new of configure old SSL"]; -ossl_load_heavy(suite) -> - []; -ossl_load_heavy(Config) when is_list(Config) -> - ssl_load_heavy(ossl, Config). - essl_load_heavy(doc) -> ["Test heavy load - using new of configure new SSL"]; essl_load_heavy(suite) -> @@ -1647,13 +1488,6 @@ pssl_dos_hostname(suite) -> pssl_dos_hostname(Config) when is_list(Config) -> ssl_dos_hostname(ssl, Config). -ossl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case - using new of configure old SSL"]; -ossl_dos_hostname(suite) -> - []; -ossl_dos_hostname(Config) when is_list(Config) -> - ssl_dos_hostname(ossl, Config). - essl_dos_hostname(doc) -> ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; essl_dos_hostname(suite) -> @@ -1679,13 +1513,6 @@ pssl_time_test(suite) -> pssl_time_test(Config) when is_list(Config) -> ssl_time_test(ssl, Config). -ossl_time_test(doc) -> - ["using new of configure old SSL"]; -ossl_time_test(suite) -> - []; -ossl_time_test(Config) when is_list(Config) -> - ssl_time_test(ossl, Config). - essl_time_test(doc) -> ["using new of configure new SSL"]; essl_time_test(suite) -> @@ -1725,14 +1552,6 @@ pssl_block_503(suite) -> pssl_block_503(Config) when is_list(Config) -> ssl_block_503(ssl, Config). -ossl_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked - using new of configure old SSL."]; -ossl_block_503(suite) -> - []; -ossl_block_503(Config) when is_list(Config) -> - ssl_block_503(ossl, Config). - essl_block_503(doc) -> ["Check that you will receive status code 503 when the server" " is blocked and 200 when its not blocked - using new of configure new SSL."]; @@ -1760,15 +1579,6 @@ pssl_block_disturbing_idle(suite) -> pssl_block_disturbing_idle(Config) when is_list(Config) -> ssl_block_disturbing_idle(ssl, Config). -ossl_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case." - "Using new of configure old SSL"]; -ossl_block_disturbing_idle(suite) -> - []; -ossl_block_disturbing_idle(Config) when is_list(Config) -> - ssl_block_disturbing_idle(ossl, Config). - essl_block_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "distribing does not really make a difference in this case." @@ -1797,15 +1607,6 @@ pssl_block_non_disturbing_idle(suite) -> pssl_block_non_disturbing_idle(Config) when is_list(Config) -> ssl_block_non_disturbing_idle(ssl, Config). -ossl_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_idle(suite) -> - []; -ossl_block_non_disturbing_idle(Config) when is_list(Config) -> - ssl_block_non_disturbing_idle(ossl, Config). - essl_block_non_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing does not really make a difference in this case." @@ -1834,15 +1635,6 @@ pssl_block_disturbing_active(suite) -> pssl_block_disturbing_active(Config) when is_list(Config) -> ssl_block_disturbing_active(ssl, Config). -ossl_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated." - "Using new of configure old SSL"]; -ossl_block_disturbing_active(suite) -> - []; -ossl_block_disturbing_active(Config) when is_list(Config) -> - ssl_block_disturbing_active(ossl, Config). - essl_block_disturbing_active(doc) -> ["Check that you can block/unblock an active server. The strategy " "distribing means ongoing requests should be terminated." @@ -1871,15 +1663,6 @@ pssl_block_non_disturbing_active(suite) -> pssl_block_non_disturbing_active(Config) when is_list(Config) -> ssl_block_non_disturbing_active(ssl, Config). -ossl_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active(suite) -> - []; -ossl_block_non_disturbing_active(Config) when is_list(Config) -> - ssl_block_non_disturbing_active(ossl, Config). - essl_block_non_disturbing_active(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing means the ongoing requests should be compleated." @@ -1910,17 +1693,6 @@ pssl_block_disturbing_active_timeout_not_released(Config) when is_list(Config) -> ssl_block_disturbing_active_timeout_not_released(ssl, Config). -ossl_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur." - "Using new of configure old SSL"]; -ossl_block_disturbing_active_timeout_not_released(suite) -> - []; -ossl_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_not_released(ossl, Config). - essl_block_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be compleated" @@ -1954,17 +1726,6 @@ pssl_block_disturbing_active_timeout_released(Config) when is_list(Config) -> ssl_block_disturbing_active_timeout_released(ssl, Config). -ossl_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs." - "Using new of configure old SSL"]; -ossl_block_disturbing_active_timeout_released(suite) -> - []; -ossl_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_released(ossl, Config). - essl_block_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be terminated when" @@ -1999,16 +1760,6 @@ pssl_block_non_disturbing_active_timeout_not_released(Config) when is_list(Config) -> ssl_block_non_disturbing_active_timeout_not_released(ssl, Config). -ossl_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active_timeout_not_released(suite) -> - []; -ossl_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_not_released(ossl, Config). - essl_block_non_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "non non distribing means ongoing requests should be completed." @@ -2043,17 +1794,6 @@ pssl_block_non_disturbing_active_timeout_released(Config) when is_list(Config) -> ssl_block_non_disturbing_active_timeout_released(ssl, Config). -ossl_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active_timeout_released(suite) -> - []; -ossl_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_released(ossl, Config). - essl_block_non_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "non distribing means ongoing requests should be completed. " @@ -2087,13 +1827,6 @@ pssl_block_disturbing_blocker_dies(suite) -> pssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> ssl_block_disturbing_blocker_dies(ssl, Config). -ossl_block_disturbing_blocker_dies(doc) -> - ["using new of configure old SSL"]; -ossl_block_disturbing_blocker_dies(suite) -> - []; -ossl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_disturbing_blocker_dies(ossl, Config). - essl_block_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_disturbing_blocker_dies(suite) -> @@ -2118,13 +1851,6 @@ pssl_block_non_disturbing_blocker_dies(suite) -> pssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> ssl_block_non_disturbing_blocker_dies(ssl, Config). -ossl_block_non_disturbing_blocker_dies(doc) -> - ["using new of configure old SSL"]; -ossl_block_non_disturbing_blocker_dies(suite) -> - []; -ossl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_non_disturbing_blocker_dies(ossl, Config). - essl_block_non_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_non_disturbing_blocker_dies(suite) -> @@ -2149,13 +1875,6 @@ pssl_restart_no_block(suite) -> pssl_restart_no_block(Config) when is_list(Config) -> ssl_restart_no_block(ssl, Config). -ossl_restart_no_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_no_block(suite) -> - []; -ossl_restart_no_block(Config) when is_list(Config) -> - ssl_restart_no_block(ossl, Config). - essl_restart_no_block(doc) -> ["using new of configure new SSL"]; essl_restart_no_block(suite) -> @@ -2180,13 +1899,6 @@ pssl_restart_disturbing_block(suite) -> pssl_restart_disturbing_block(Config) when is_list(Config) -> ssl_restart_disturbing_block(ssl, Config). -ossl_restart_disturbing_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_disturbing_block(suite) -> - []; -ossl_restart_disturbing_block(Config) when is_list(Config) -> - ssl_restart_disturbing_block(ossl, Config). - essl_restart_disturbing_block(doc) -> ["using new of configure new SSL"]; essl_restart_disturbing_block(suite) -> @@ -2244,13 +1956,6 @@ pssl_restart_non_disturbing_block(suite) -> pssl_restart_non_disturbing_block(Config) when is_list(Config) -> ssl_restart_non_disturbing_block(ssl, Config). -ossl_restart_non_disturbing_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_non_disturbing_block(suite) -> - []; -ossl_restart_non_disturbing_block(Config) when is_list(Config) -> - ssl_restart_non_disturbing_block(ossl, Config). - essl_restart_non_disturbing_block(doc) -> ["using new of configure new SSL"]; essl_restart_non_disturbing_block(suite) -> @@ -2646,7 +2351,6 @@ create_config(Config, Access, FileName) -> SSL = if (Type =:= ssl) orelse - (Type =:= ossl) orelse (Type =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), @@ -3041,7 +2745,6 @@ create_ipv6_config(Config, FileName, Ipv6Address) -> SSL = if (SockType =:= ssl) orelse - (SockType =:= ossl) orelse (SockType =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index f39f9faff0..c54674be36 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -19,7 +19,7 @@ %% -module(httpd_time_test). --export([t/3, t1/2, t2/2, t3/2, t4/2]). +-export([t/3, t1/2, t2/2, t4/2]). -export([do/1, do/2, do/3, do/4, do/5]). @@ -45,10 +45,6 @@ t2(Host, Port) -> t(ssl, Host, Port). -t3(Host, Port) -> - t(ossl, Host, Port). - - t4(Host, Port) -> t(essl, Host, Port). diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 2e19c41f16..ddb1a49394 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -340,9 +340,6 @@ connect_bin(SockType, Host, Port) -> connect_bin(ssl, Host, Port, Opts0) -> Opts = [binary, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); -connect_bin(ossl, Host, Port, Opts0) -> - Opts = [{ssl_imp, old}, binary, {packet,0} | Opts0], - connect(ssl, Host, Port, Opts); connect_bin(essl, Host, Port, Opts0) -> Opts = [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true} | Opts0], connect(ssl, Host, Port, Opts); @@ -357,9 +354,6 @@ connect_byte(SockType, Host, Port) -> connect_byte(ssl, Host, Port, Opts0) -> Opts = [{packet,0} | Opts0], connect(ssl, Host, Port, Opts); -connect_byte(ossl, Host, Port, Opts0) -> - Opts = [{ssl_imp, old}, {packet,0} | Opts0], - connect(ssl, Host, Port, Opts); connect_byte(essl, Host, Port, Opts0) -> Opts = [{ssl_imp, new}, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); @@ -421,8 +415,6 @@ connect(ip_comm, Host, Port, Opts) -> send(ssl, Socket, Data) -> ssl:send(Socket, Data); -send(ossl, Socket, Data) -> - ssl:send(Socket, Data); send(essl, Socket, Data) -> ssl:send(Socket, Data); send(ip_comm,Socket,Data) -> @@ -431,8 +423,6 @@ send(ip_comm,Socket,Data) -> close(ssl,Socket) -> catch ssl:close(Socket); -close(ossl,Socket) -> - catch ssl:close(Socket); close(essl,Socket) -> catch ssl:close(Socket); close(ip_comm,Socket) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 4abc1733d3..1df4558e45 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.7 +INETS_VSN = 5.8 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl new file mode 100644 index 0000000000..aea1ab81ba --- /dev/null +++ b/lib/kernel/include/dist.hrl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. 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% +%% + +%% +%% Distribution capabilities flags (corresponds with dist.h). +%% + +-define(DFLAG_PUBLISHED,1). +-define(DFLAG_ATOM_CACHE,2). +-define(DFLAG_EXTENDED_REFERENCES,4). +-define(DFLAG_DIST_MONITOR,8). +-define(DFLAG_FUN_TAGS,16#10). +-define(DFLAG_DIST_MONITOR_NAME,16#20). +-define(DFLAG_HIDDEN_ATOM_CACHE,16#40). +-define(DFLAG_NEW_FUN_TAGS,16#80). +-define(DFLAG_EXTENDED_PIDS_PORTS,16#100). +-define(DFLAG_EXPORT_PTR_TAG,16#200). +-define(DFLAG_BIT_BINARIES,16#400). +-define(DFLAG_NEW_FLOATS,16#800). +-define(DFLAG_UNICODE_IO,16#1000). +-define(DFLAG_DIST_HDR_ATOM_CACHE,16#2000). +-define(DFLAG_SMALL_ATOM_TAGS, 16#4000). diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl new file mode 100644 index 0000000000..f2b0598532 --- /dev/null +++ b/lib/kernel/include/dist_util.hrl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. 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% +%% +%% uncomment this if tracing of handshake etc is wanted +%%-define(dist_trace, true). +%%-define(dist_debug, true). + + +-ifdef(dist_debug). +-define(debug(Term), erlang:display(Term)). +-else. +-define(debug(Term), ok). +-endif. + +-ifdef(dist_trace). +-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +% Use the one below for config-file (early boot) connection tracing +%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +-define(trace_factor,8). +-else. +-define(trace(Fmt,Args), ok). +-define(trace_factor,1). +-endif. + +-define(shutdown(Data), dist_util:shutdown(?MODULE, ?LINE, Data)). +-define(shutdown2(Data, Reason), dist_util:shutdown(?MODULE, ?LINE, Data, Reason)). + +%% Handshake state structure +-record(hs_data, { + kernel_pid, %% Pid of net_kernel + other_node, %% Name of peer + this_node, %% my nodename + socket, %% The connection "socket" + timer, %% The setup timer + %% (stream_dist_handshake:start_timer) + this_flags, %% Flags my node should use + allowed, %% Allowed nodes list + other_version, %% The other nodes distribution version + other_flags, %% The other nodes flags. + other_started, %% True if the other node initiated. + f_send, %% Fun that behaves like gen_tcp:send + f_recv, %% Fun that behaves like gen_tcp:recv + f_setopts_pre_nodeup, %% Sets "socket" options before + %% nodeup is delivered to net_kernel + f_setopts_post_nodeup, %% Sets "socket" options after + %% nodeup is delivered + f_getll, %% Get low level port or pid. + f_address, %% The address of the "socket", + %% generated from Socket,Node + %% These two are used in the tick loop, + %% so they are not fun's to avoid holding old code. + mf_tick, %% Takes the socket as parameters and + %% sends a tick, this is no fun, it + %% is a tuple {M,F}. + %% Is should place {tcp_closed, Socket} + %% in the message queue on failure. + mf_getstat, %% Returns + %% {ok, RecvCnt, SendCnt, SendPend} for + %% a given socket. This is a {M,F}, + %% returning {error, Reason on failure} + request_type = normal +}). + + +%% The following should be filled in upon enter of... +%% - handshake_we_started: +%% kernel_pid, other_node, this_node, socket, timer, +%% this_flags, other_version, All fun's/mf's. +%% - handshake_other_started: +%% kernel_pid, this_node, socket, timer, +%% this_flags, allowed, All fun's/mf's. + diff --git a/lib/kernel/include/net_address.hrl b/lib/kernel/include/net_address.hrl new file mode 100644 index 0000000000..5342076507 --- /dev/null +++ b/lib/kernel/include/net_address.hrl @@ -0,0 +1,28 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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% +%% + +%% Generic address format + +-record(net_address, + { + address, %% opaque address + host, %% host name + protocol, %% protocol + family %% address family + }). diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 9db6014a7d..02be6b5036 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -118,11 +118,14 @@ MODULES = \ user_sup \ wrap_log_reader -HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl +HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ + ../include/dist.hrl ../include/dist_util.hrl \ + ../include/net_address.hrl + INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ - net_address.hrl inet_dns.hrl inet_res.hrl \ + inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ - dist.hrl dist_util.hrl inet_dns_record_adts.hrl + inet_dns_record_adts.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -215,7 +218,7 @@ $(EBIN)/code_server.beam: ../include/file.hrl $(EBIN)/disk_log.beam: disk_log.hrl $(EBIN)/disk_log_1.beam: disk_log.hrl ../include/file.hrl $(EBIN)/disk_log_server.beam: disk_log.hrl -$(EBIN)/dist_util.beam: dist_util.hrl dist.hrl +$(EBIN)/dist_util.beam: ../include/dist_util.hrl ../include/dist.hrl $(EBIN)/erl_boot_server.beam: inet_boot.hrl $(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl $(EBIN)/file.beam: ../include/file.hrl @@ -226,7 +229,7 @@ $(EBIN)/global.beam: ../../stdlib/include/ms_transform.hrl $(EBIN)/hipe_unified_loader.beam: ../../hipe/main/hipe.hrl hipe_ext_format.hrl $(EBIN)/inet.beam: ../include/inet.hrl inet_int.hrl ../include/inet_sctp.hrl $(EBIN)/inet6_tcp.beam: inet_int.hrl -$(EBIN)/inet6_tcp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet6_tcp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet6_udp.beam: inet_int.hrl $(EBIN)/inet6_sctp.beam: inet_int.hrl $(EBIN)/inet_config.beam: inet_config.hrl ../include/inet.hrl @@ -237,10 +240,10 @@ $(EBIN)/inet_hosts.beam: ../include/inet.hrl $(EBIN)/inet_parse.beam: ../include/file.hrl $(EBIN)/inet_res.beam: ../include/inet.hrl inet_res.hrl inet_dns.hrl inet_int.hrl $(EBIN)/inet_tcp.beam: inet_int.hrl -$(EBIN)/inet_udp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet_udp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet_udp.beam: inet_int.hrl $(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl -$(EBIN)/net_kernel.beam: net_address.hrl +$(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl $(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 2c80891925..4e63aecbf2 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -25,11 +25,12 @@ <title>ttb</title> <prepared>Siri hansen</prepared> + <prepared>Bartlomiej Puzon</prepared> <responsible></responsible> <docno>1</docno> <approved></approved> <checked></checked> - <date>2002-02-25</date> + <date>2010-08-13</date> <rev>PA1</rev> <file>ttb.sgml</file> </header> @@ -43,6 +44,35 @@ </description> <funcs> <func> + <name>start_trace(Nodes, Patterns, FlagSpec, Opts) -> Result</name> + <fsummary>Start a trace port on each given node.</fsummary> + <type> + <v>Result = see p/2</v> + <v>Nodes = see tracer/2</v> + <v>Patterns = [tuple()]</v> + <v>FlagSpec = {Procs, Flags}</v> + <v>Proc = see p/2</v> + <v>Flags = see p/2</v> + <v>Opts = see tracer/2</v> + </type> + <desc> + <p>This function is a shortcut allowing to start a trace with one command. Each + tuple in <c>Patterns</c> is converted to list which is in turn passed to + <c>ttb:tpl</c>. + The call:<code type="none"> +ttb:start_trace([Node, OtherNode], +[{mod, foo, []}, {mod, bar, 2}], +{all, call}, +[{file, File}, {handler,{fun myhandler/4, S}}])</code> + is equivalent to <code type="none"> +ttb:start_trace([Node, OtherNode], [{file, File}, {handler,{fun myhandler/4, S}}]), +ttb:tpl(mod, foo, []), +ttb:tpl(mod, bar, 2, []), +ttb:p(all, call)</code> + </p> + </desc> + </func> + <func> <name>tracer() -> Result</name> <fsummary>This is equivalent to tracer(node()).</fsummary> <desc> @@ -50,6 +80,17 @@ </desc> </func> <func> + <name>tracer(Shortcut) -> Result</name> + <fsummary>Handy shortcuts for common tracing settings</fsummary> + <type> + <v>Shortcut = shell | dbg</v> + </type> + <desc> + <p><c>shell</c> is equivalent to <c>tracer(node(),[{file, {local, "ttb"}}, shell])</c>.</p> + <p><c>dbg</c> is equivalent to <c>tracer(node(),[{shell, only}])</c>.</p> + </desc> + </func> + <func> <name>tracer(Nodes) -> Result</name> <fsummary>This is equivalent to tracer(Nodes,[]).</fsummary> <desc> @@ -62,14 +103,21 @@ <type> <v>Result = {ok, ActivatedNodes} | {error,Reason}</v> <v>Nodes = atom() | [atom()] | all | existing | new</v> - <v>Opts = [Opt]</v> - <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI}</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} | + shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}} + | {flush, MSec} | resume | {resume, FetchTimeout}</v> + <v>TimerSpec = MSec | {MSec, StopOpts}</v> + <v>MSec = FetchTimeout = integer()</v> + <v>Module = Function = atom() </v> + <v>StopOpts = see stop/2</v> <v>Client = File | {local, File}</v> <v>File = Filename | Wrap</v> <v>Filename = string()</v> <v>Wrap = {wrap,Filename} | {wrap,Filename,Size,Count}</v> <v>FormatHandler = See format/2</v> <v>PI = true | false </v> + <v>ShellSpec = true | false | only</v> </type> <desc> <p>This function starts a file trace port on all given nodes @@ -96,7 +144,70 @@ is the process' registered name its globally registered name, or its initial function. It is possible to turn off this functionality by setting <c>PI = false</c>. - </p> + </p> + <p>The <c>{shell, ShellSpec}</c> option indicates that the trace messages should + be printed on the console as they are received by the tracing + process. This implies <c>{local, File}</c> trace client. If the ShellSpec + is <c>only</c> (instead of <c>true</c>), no trace logs are stored. + </p> + <p>The <c>shell</c> option is a shortcut for <c>{shell, true}</c>.</p> + <p>The <c>timer</c> option indicates that the trace should be + automatically stopped after <c>MSec</c> milliseconds. <c>StopOpts</c> + are passed to <c>ttb:stop/2</c> command if specified (default is <c>[]</c>). + Note that the timing is approximate, as delays related to + network communication are always present. The timer starts after + <c>ttb:p/2</c> is issued, so you can set up your trace patterns before. + </p> + <p>The <c>overload</c> option allows to enable overload + checking on the nodes under trace. <c>Module:Function(check)</c> + is performed each <c>MSec</c> milliseconds. If the check returns + <c>true</c>, the tracing is disabled on a given node.<br/> + <c>Module:Function</c> should be able to handle at least three + atoms: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> and + <c>stop</c> give the user a possibility to initialize and clean + up the check environment.<br/> + When a node gets overloaded, it is not possible to issue <c>ttb:p</c> + nor any command from the <c>ttb:tp</c> family, as it would lead to + inconsistent tracing state (different trace specifications on + different node). + </p> + <p>The <c>flush</c> option periodically flushes all file trace + port clients (see <c>dbg:flush_trace_port/1</c>). When enabled, + the buffers are freed each <c>MSec</c> milliseconds. This option is + not allowed with <c>{file, {local, File}}</c> tracing. + </p> + <p><c>{resume, FetchTimeout}</c> enables the autoresume feature. + Whenever enabled, remote nodes try to reconnect to the controlling node + in case they were restarted. The feature requires <c>runtime_tools</c> + application to be started (so it has to be present in the <c>.boot</c> + scripts if the traced nodes run with embedded erlang). If this is + not possible, resume may be performed manually by starting + <c>runtime_tools</c> remotely using <c>rpc:call/4</c>.<br/> + <c>ttb</c> tries to fetch all logs from a reconnecting node before + reinitializing the trace. This has to finish within FetchTimeout milliseconds + or is aborted<br/> + By default, autostart information is stored in a file called + <c>ttb_autostart.bin</c> on each node. If this is not desired + (i.e. on diskless nodes), a custom module to handle autostart + information storage and retrieval can be provided by specifying + <c>ttb_autostart_module</c> environment variable for the <c>runtime_tools</c> + application. The module has to respond to the following API: + <taglist> + <tag><c>write_config(Data) -> ok</c></tag> + <item>Store the provided data for further retrieval. It is + important to realize that the data storage used must not + be affected by the node crash.</item> + <tag><c>read_config() -> {ok, Data} | {error, Error}</c></tag> + <item>Retrieve configuration stored with <c>write_config(Data)</c>.</item> + <tag><c>delete_config() -> ok</c></tag> + <item>Delete configuration stored with <c>write_config(Data)</c>. + Note that after this call any subsequent calls to <c>read_config</c> + must return <c>{error, Error}</c>. + </item> + </taglist> + </p> + <p>The <c>resume</c> option implies the default <c>FetchTimeout</c>, which is + 10 seconds</p> </desc> </func> <func> @@ -110,7 +221,7 @@ </type> <desc> <p>This function sets the given trace flags on the given - processes. + processes. The <c>timestamp</c> flag is always turned on. </p> <p>Please turn to the Reference manual for module <c>dbg</c> for details about the possible trace flags. The parameter @@ -119,6 +230,9 @@ registered names or process identifiers. If a registered name is given, the flags are set on processes with this name on all active nodes.</p> + <p>Issuing this command starts the timer for this trace if + <c>timer</c> option was specified with <c>tracer/2</c>. + </p> </desc> </func> <func> @@ -155,6 +269,18 @@ <tag><c>ctpg</c></tag> <item>Clear trace pattern on global function calls</item> </taglist> + <p>With <c>tp</c> and <c>tpl</c> one of match specification shortcuts + may be used (example: <c>ttb:tp(foo_module, caller)</c>). The shortcuts are: + <taglist> + <item><c>return</c> - for <c>[{'_',[],[{return_trace}]}]</c> + (report the return value)</item> + <item><c>caller</c> - for <c>[{'_',[],[{message,{caller}}]}]</c> + (report the calling function)</item> + <item><c>{codestr, Str}</c> - for <c>dbg:fun2ms/1</c> arguments + passed as strings (example: <c>"fun(_) -> return_trace() end"</c>) + </item> + </taglist> + </p> </desc> </func> <func> @@ -189,7 +315,7 @@ </desc> </func> <func> - <name>write_config(ConfigFile,Config,Opt) -> ok | {error,Reason}</name> + <name>write_config(ConfigFile,Config,Opts) -> ok | {error,Reason}</name> <fsummary>Creates a config file.</fsummary> <type> <v>ConfigFile = string()</v> @@ -197,7 +323,8 @@ <v>Mod = atom()</v> <v>Func = atom()</v> <v>Args = [term()]</v> - <v>Opt = [] | [append]</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = append</v> </type> <desc> <p>This function creates or extends a config file which can be @@ -213,9 +340,9 @@ should be a list of integers pointing out the entries to be stored. </p> - <p>If <c>Opt</c> is not given or if it is <c>[]</c>, + <p>If <c>Opts</c> is not given or if it is <c>[]</c>, <c>ConfigFile</c> is deleted and a new file is created. If - <c>Opt = [append]</c>, <c>ConfigFile</c> will not be deleted. + <c>Opts = [append]</c>, <c>ConfigFile</c> will not be deleted. The new information will be appended at the end of the file.</p> </desc> </func> @@ -226,7 +353,9 @@ <v>ConfigFile = string()</v> </type> <desc> - <p>Executes all entries in the given config file.</p> + <p>Executes all entries in the given config file. Note that the history + of the last trace is always available in the file named + <c>ttb_last_config</c>.</p> </desc> </func> <func> @@ -243,6 +372,9 @@ </p> <p>The content of a config file can be listed with <c>list_config/1</c>.</p> + <p> Note that the history + of the last trace is always available in the file named + <c>ttb_last_config</c>.</p> </desc> </func> <func> @@ -334,29 +466,51 @@ </desc> </func> <func> - <name>stop(Opts) -> stopped</name> + <name>stop(Opts) -> stopped | {stopped, Dir}</name> <fsummary>Stop tracing and fetch/format logs from all nodes</fsummary> <type> - <v>Opts = [Opt]</v> - <v>Opt = fetch | format</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = nofetch | {fetch_dir, Dir} | format | {format, FormatOpts} | return_fetch_dir</v> + <v>Dir = string()</v> + <v>FormatOpts = see format/2</v> </type> <desc> - <p>Stops tracing on all nodes. - </p> - <p>The <c>fetch</c> option indicates that trace logs shall be - collected from all nodes after tracing is stopped. This option - is useful if nodes on remote machines are traced. Logs and - trace information files are then sent to the trace control + <p>Stops tracing on all nodes. Logs and + trace information files are sent to the trace control node and stored in a directory named - <c>ttb_upload-Timestamp</c>, where <c>Timestamp</c> is on the + <c>ttb_upload_FileName-Timestamp</c>, where <c>Filename</c> is + the one provided with <c>{file, File}</c> during trace setup + and <c>Timestamp</c> is of the form <c>yyyymmdd-hhmmss</c>. Even logs from nodes on the same machine as the trace control node are moved to this directory. - </p> + The history list is saved to a file named <c>ttb_last_config</c> + for further reference (as it will be not longer accessible + through history and configuration management functions (like + <c>ttb:list_history/0</c>). + </p> + <p>The <c>nofetch</c> option indicates that trace logs shall not be + collected after tracing is stopped. + </p> + <p>The <c>{fetch, Dir}</c> option allows to specify the directory + to fetch the data to. If the directory already exists, an + error is thrown. + </p> <p>The <c>format</c> option indicates that the trace logs - shall be formatted after tracing is stopped. Note that this - option also implies the <c>fetch</c> option, i.e. logs are - collected in a new directory on the trace control node before - formatting. All logs in the directory will be merged.</p> + shall be formatted after tracing is stopped. All logs in the fetch directory will be merged. + You may use <c>{format, FormatOpts}</c> to pass additional + arguments to <c>format/2</c>.</p> + <p>The <c>return_fetch_dir</c> option indicates that the return value + should be <c>{stopped, Dir}</c> and not just <c>stopped</c>. + This implies <c>fetch</c>. + </p> + </desc> + </func> + <func> + <name>get_et_handler()</name> + <fsummary>Returns <c>et</c> handler.</fsummary> + <desc> + <p>The <c>et</c> handler returned by the function may be used with <c>format/2</c> + or <c>tracer/2</c>. Example: <c>ttb:format(Dir, [{handler, ttb:get_et_handler()}])</c>.</p> </desc> </func> <func> @@ -372,37 +526,40 @@ <type> <v>File = string() | [string()]</v> <d>This can be the name of a binary log, a list of such logs or the name of a directory containing one or more binary logs.</d> - <v>Options = [Opt]</v> - <v>Opt = {out,Out} | {handler,FormatHandler}</v> + <v>Options = Opt | [Opt]</v> + <v>Opt = {out,Out} | {handler,FormatHandler} | disable_sort</v> <v>Out = standard_io | string()</v> - <v>FormatHandler = {Function, InitialState} | et</v> + <v>FormatHandler = {Function, InitialState}</v> <v>Function = fun(Fd,Trace,TraceInfo,State) -> State</v> <v>Fd = standard_io | FileDescriptor</v> <d>This is the file descriptor of the destination file <c>Out</c></d> <v>Trace = tuple()</v> <d>This is the trace message. Please turn to the Reference manual for the <c>erlang</c>module for details.</d> <v>TraceInfo = [{Key,ValueList}]</v> - <d>This includes the keys <c>flags</c>, <c>client</c>and <c>node</c>, and if <c>handler</c>is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> + <d>This includes the keys <c>flags</c>, <c>client</c> and <c>node</c>, and if <c>handler</c> is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> </type> <desc> - <p>Reads the given binary trace log(s). If a directory or a - list of logs is given and the <c>timestamp</c> flag was set - during tracing, the trace messages from the different logs are - merged according to the timestamps. - </p> + <p>Reads the given binary trace log(s). The logs are processed + in the order of their timestamp as long as <c>disable_sort</c> + option is not given. + </p> <p>If <c>FormatHandler = {Function,InitialState}</c>, <c>Function</c> will be called for each trace message. If - <c>FormatHandler = et</c>, <c>et_viewer</c> in the <em>Event Tracer</em> application (<c>et</c>) is used for presenting the - trace log graphically. <c>ttb</c> provides a few different + <c>FormatHandler = get_et_handler()</c>, <c>et_viewer</c> in + the <em>Event Tracer</em> application (<c>et</c>) is used for presenting + the trace log graphically. <c>ttb</c> provides a few different filters which can be selected from the Filter menu in the <c>et_viewer</c>. If <c>FormatHandler</c> is not given, a default handler is used which presents each trace message as a line of text. </p> + <p>The state returned from each call of <c>Function</c> is passed to the next call, + even if next call is to format a message from another log file. + </p> <p>If <c>Out</c> is given, <c>FormatHandler</c> gets the - filedescriptor to <c>Out</c> as the first parameter. + file descriptor to <c>Out</c> as the first parameter. </p> - <p><c>Out</c> is ignored if <c>FormatHandler = et</c>. + <p><c>Out</c> is ignored if <c>et</c> format handler is used. </p> <p>Wrap logs can be formatted one by one or all in one go. To format one of the wrap logs in a set, give the exact name of diff --git a/lib/observer/doc/src/ttb_ug.xml b/lib/observer/doc/src/ttb_ug.xml index 44b7b08fd3..4f2b55a22a 100644 --- a/lib/observer/doc/src/ttb_ug.xml +++ b/lib/observer/doc/src/ttb_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2009</year> + <year>2002</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -48,11 +48,13 @@ <item>Formatting of binary trace logs and merging of logs from multiple nodes.</item> </list> - <p>Even though the intention of the Trace Tool Builder is to serve - as a base for tailor made trace tools, it is of course possible - to use it directly from the erlang shell. The application only - allows the use of file port tracer, so if you would like would - like to use other types of trace clients you will be better off + <p>The intention of the Trace Tool Builder is to serve + as a base for tailor made trace tools, but you may use it directly + from the erlang shell (it may mimic <c>dbg</c> behaviour while + still providing useful additions like match specification shortcuts). + The application only + allows the use of file port tracer, so if you would like + to use other types of trace clients you will be better off using <c>dbg</c> directly instead.</p> </section> @@ -64,14 +66,15 @@ trace flags on the processes you want to trace with <c>ttb:p/2</c>. Then, when the tracing is completed, you must stop the tracer with <c>ttb:stop/0/1</c> and format the trace log with - <c>ttb:format/1/2</c>. + <c>ttb:format/1/2</c> (as long as there is anything to format, of + course). </p> - <p><c>ttb:tracer/0/1/2</c> opens a file trace port on each node - that shall be traced. All trace messages will be written to this - port and end up in a binary file (the binary trace log). + <p><c>ttb:tracer/0/1/2</c> opens a trace port on each node + that shall be traced. By default, trace messages are written + to binary files on remote nodes(the binary trace log). </p> - <p><c>ttb:p/2</c> specifies which processes that shall be - traced. Trace flags given in this call specifies what to trace on + <p><c>ttb:p/2</c> specifies which processes shall be + traced. Trace flags given in this call specify what to trace on each process. You can call this function several times if you like different trace flags to be set on different processes. </p> @@ -105,14 +108,15 @@ -export([f/0]). f() -> receive - From when pid(From) -> + From when is_pid(From) -> Now = erlang:now(), From ! {self(),Now} end. </code> <p>The following example shows the basic use of <c>ttb</c> from the erlang shell. Default options are used both for starting the - tracer and for formatting. This gives a trace log named - <c>Node-ttb</c>, where <c>Node</c> is the name of the node. The + tracer and for formatting (the custom fetch dir is however provided). + This gives a trace log named <c>Node-ttb</c> in the newly-created + directory, where <c>Node</c> is the name of the node. The default handler prints the formatted trace messages in the shell.</p> <code type="none"><![CDATA[ @@ -131,11 +135,11 @@ f() -> (tiger@durin)50> (tiger@durin)50> %% Here I set a trace pattern on erlang:now/0 (tiger@durin)50> %% The trace pattern is a simple match spec -(tiger@durin)50> %% generated by dbg:fun2ms/1. It indicates that -(tiger@durin)50> %% the return value shall be traced. -(tiger@durin)50> MS = dbg:fun2ms(fun(_) -> return_trace() end). -[{'_',[],[{return_trace}]}] -(tiger@durin)51> ttb:tp(erlang,now,MS). +(tiger@durin)50> %% indicating that the return value should be +(tiger@durin)50> %% traced. Refer to the reference_manual for +(tiger@durin)50> %% the full list of match spec shortcuts +(tiger@durin)50> %% available. +(tiger@durin)51> ttb:tp(erlang,now,return). {ok,[{matched,tiger@durin,1},{saved,1}]} (tiger@durin)52> (tiger@durin)52> %% I run my test (i.e. send a message to @@ -145,11 +149,11 @@ f() -> (tiger@durin)53> (tiger@durin)53> %% And then I have to stop ttb in order to flush (tiger@durin)53> %% the trace port buffer -(tiger@durin)53> ttb:stop(). -stopped +(tiger@durin)53> ttb:stop([return, {fetch_dir, "fetch"}]). +{stopped, "fetch"} (tiger@durin)54> (tiger@durin)54> %% Finally I format my trace log -(tiger@durin)54> ttb:format("tiger@durin-ttb"). +(tiger@durin)54> ttb:format("fetch"). ({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now() ({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 -> {1031,133451,667611} @@ -166,11 +170,9 @@ ok ]]></code> -module(mydebug). -export([start/0,trc/1,stop/0,format/1]). -export([print/4]). - %% Include ms_transform.hrl so that I can use dbg:fun2ms/2 to %% generate match specifications. -include_lib("stdlib/include/ms_transform.hrl"). - %%% -------------Tool API------------- %%% ---------------------------------- %%% Star the "mydebug" tool @@ -180,28 +182,28 @@ start() -> %% module shall be used as format handler ttb:tracer(all,[{file,"debug_log"},{handler,{{?MODULE,print},0}}]), %% All processes (existing and new) shall trace function calls - %% and include a timestamp in each trace message - ttb:p(all,[call,timestamp]). + %% We want trace messages to be sorted upon format, which requires + %% timestamp flag. The flag is however enabled by default in ttb. + ttb:p(all,call). %%% Set trace pattern on function(s) -trc(M) when atom(M) -> +trc(M) when is_atom(M) -> trc({M,'_','_'}); -trc({M,F}) when atom(M), atom(F) -> +trc({M,F}) when is_atom(M), is_atom(F) -> trc({M,F,'_'}); -trc({M,F,_A}=MFA) when atom(M), atom(F) -> - %% This match spec specifies that return values shall - %% be traced. NOTE that ms_transform.hrl must be included - %% if dbg:fun2ms/1 shall be used! +trc({M,F,_A}=MFA) when is_atom(M), is_atom(F) -> + %% This match spec shortcut specifies that return values shall + %% be traced. MatchSpec = dbg:fun2ms(fun(_) -> return_trace() end), ttb:tpl(MFA,MatchSpec). %%% Format a binary trace log -format(File) -> - ttb:format(File). +format(Dir) -> + ttb:format(Dir). %%% Stop the "mydebug" tool stop() -> - ttb:stop(). + ttb:stop(return). %%% --------Internal functions-------- %%% ---------------------------------- @@ -226,9 +228,9 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> [N,Ts,P,M,F,A,R]). ]]></code> <p>To distinguish trace logs produced with this tool from other logs, the <c>file</c> option is used in <c>tracer/2</c>. The - logs will therefore be named <c>Node-debug_log</c>, where - <c>Node</c> is the name of the node where the log is produced. - </p> + logs will therefore be fetched to a directory named + <c>ttb_upload_debug_log-YYYYMMDD-HHMMSS</c> + </p> <p>By using the <c>handler</c> option when starting the tracer, the information about how to format the file is stored in the trace information file (<c>.ti</c>). This is not necessary, as @@ -278,13 +280,157 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> must be given to the <c>tracer/2</c> function with the value <c>{local, File}</c>, e.g.</p> <code type="none"> -(trace_control@durin)1> ttb:tracer(mynode@diskless,[{file,{local, -{wrap,"mytrace"}}}]). +(trace_control@durin)1> ttb:tracer(mynode@diskless,{file,{local, +{wrap,"mytrace"}}}). {ok,[mynode@diskless]} </code> </section> </section> <section> + <title>Additional tracing options</title> + <p>When setting up a trace, several features may be turned on:</p> + <list type="bulleted"> + <item>time-constrained tracing,</item> + <item>overload protection,</item> + <item>autoresuming.</item> + </list> + <section> + <title>Time-constrained tracing</title> + <p>Sometimes, it may be helpful to enable trace for a + given period of time (i.e. to monitor a system for 24 hours + or half of a second). This may be done by issuing additional + <c>{timer, TimerSpec}</c> option. If <c>TimerSpec</c> has the + form of <c>MSec</c>, the trace is stopped after <c>MSec</c> + milliseconds using <c>ttb:stop/0</c>. If any additional options + are provided (<c>TimerSpec = {MSec, Opts}</c>), <c>ttb:stop/1</c> + is called instead with <c>Opts</c> as the arguments. The timer + is started with <c>ttb:p/2</c>, so any trace patterns should + be set up before. <c>ttb:start_trace/4</c> + always sets up all pattern before invoking <c>ttb:p/2</c>. + Note that due to network and processing delays the the period + of tracing is approximate. + The example below shows how to set up a trace which will be + automatically stopped and formatted after 5 seconds + </p><code> +(tiger@durin)1>ttb:start_trace([node()], + [{erlang, now,[]}], + {all, call}, + [{timer, {5000, format}}]). +</code> + </section> + <section> + <label>Overload protection</label> + <p>When tracing live systems, special care needs to be always taken + not to overload a node with too heavy tracing. <c>ttb</c> provides + the <c>overload</c> option to help to address the problem.</p> + <p><c>{overload, MSec, Module, Function}</c> instructs the ttb backend + (called <c>observer_backend</c>, part of the <c>runtime_tools</c> + application) to perform overload check every <c>MSec</c> milliseconds. + If the check (namely <c>Module:Function(check)</c>) returns + <c>true</c>, tracing is disabled on the selected node.</p> + <p>Overload protection activated on one node does not + affect other nodes, where the tracing continues as normal. + <c>ttb:stop/0/1</c> fetches data from all clients, including everything + that has been collected before overload protection was activated. + Note that + changing trace details (with <c>ttb:p</c> and <c>ttb:tp/tpl...</c>) + once overload protection gets activated in one of the traced + nodes is not permitted in order not to allow trace setup + to be inconsistent between nodes. + </p> + <p><c>Module:Function</c> provided with the <c>overload</c> option must + handle three calls: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> + and <c>stop</c> allows to perform some setup and teardown required by + the check. An overload check module could look like this (note that + <c>check</c> is always called by the same process, so <c>put</c> and + <c>get</c> are possible). + </p><code> +-module(overload). +-export([check/1]). + +check(init) -> + Pid = sophisticated_module:start(), + put(pid, Pid); +check(check) -> + get(pid) ! is_overloaded, + receive + Reply -> + Reply + after 5000 -> + true + end; +check(stop) -> + get(pid) ! stop.</code> + </section> + <section> + <title>Autoresume</title> + <p>It is possible that a node (probably a buggy one, hence traced) + crashes. In order to automatically resume tracing on the node + as soon as it gets back, <c>resume</c> has to be used. When + it is, the failing node tries to reconnect + to trace control node as soon as <c>runtime tools</c> is started. + This implies that <c>runtime_tools</c> must be included in + other node's startup chain (if it is not, one could still + resume tracing by starting <c>runtime_tools</c> manually, + i.e. by an RPC call).</p> + <p>In order not to loose the data that the failing node stored + up to the point of crash, the control node will try to fetch + it before restarting trace. This must happen within the allowed + time frame or is aborted (default is 10 seconds, can be customized with + <c>{resume, MSec}</c>). The data fetched this way is then + merged with all other traces.</p> + <p>Autostart feature requires additional data to be stored on + traced nodes. By default, the data is stored automatically + to the file called "ttb_autostart.bin" in the traced node's cwd. + Users may decide to change this behaviour (i.e. on diskless + nodes) by specifying their own module to handle autostart data + storage and retrieval (<c>ttb_autostart_module</c> + environment variable of <c>runtime_tools</c>). Please see the + ttb's reference manual to see the module's API. This example + shows the default handler</p> + <code> +-module(ttb_autostart). +-export([read_config/0, + write_config/1, + delete_config/0]). + +-define(AUTOSTART_FILENAME, "ttb_autostart.bin"). + +delete_config() -> + file:delete(?AUTOSTART_FILENAME). + +read_config() -> + case file:read_file(?AUTOSTART_FILENAME) of + {ok, Data} -> {ok, binary_to_term(Data)}; + Error -> Error + end. + +write_config(Data) -> + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + </code> + <p>Remember that file trace ports buffer the data + by default. If the node crashes, trace messages are not + flushed to the binary log. If the chance of failure is + high, it might be a good idea to automatically flush + the buffers every now and then. Passing <c>{flush, MSec}</c> + as one of <c>ttb:tracer/2</c> option flushes all buffers + every <c>MSec</c> milliseconds.</p> + </section> + <section> + <title>dbg mode</title> + <p>The <c>{shell, ShellType}</c> option allows to make <c>ttb</c> + operation similar to <c>dbg</c>. Using <c>{shell, true}</c> + displays all trace messages in the shell before storing them. + <c>{shell, only}</c> additionally disables message storage + (so that the tool behaves exactly like dbg). This is allowed + only with ip trace ports (<c>{trace, {local, File}}</c>). + </p> + <p>The command <c>ttb:tracer(dbg)</c> is a shortcut for the pure-dbg + mode (<c>{shell, only}</c>).</p> + </section> + </section> + + <section> <marker id="trace_info"></marker> <title>Trace Information and the .ti File</title> <p>In addition to the trace log file(s), a file with the extension @@ -292,13 +438,9 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> is the trace information file. It is a binary file, and it contains the process information, trace flags used, the name of the node to which it belongs and all information written with the - <c>write_trace_info/2</c> function. - </p> - <p>To be able to use all this information during formatting, it is - important that the trace information file exists in the same - directory as the trace log, and that it has the same name as the - trace log with the additional extension <c>.ti</c>. - </p> + <c>write_trace_info/2</c> function. .ti files are always fetched + with other logs when the trace is stopped. + </p> <p>Except for the process information, everything in the trace information file is passed on to the handler function when formatting. The <c>TI</c> parameter is a list of @@ -327,7 +469,12 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> each log. <c>ttb</c> will create a new binary log each time a log reaches the maximum size. When the the maximum number of logs are reached, the oldest log is deleted before a new one is created. - </p> + </p> + <p>Note that the overall size of data generated by ttb may be greater + than the wrap specification would suggest - if a traced node restarts + and autoresume is enabled, old wrap log is always stored and + a new one is created. + </p> <p>Wrap logs can be formatted one by one or all at once. See <seealso marker="#format">Formatting</seealso>. </p> @@ -348,12 +495,10 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> present the trace log graphically (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). </p> <p>The first argument to <c>ttb:format/1/2</c> specifies which - binary log(s) to format. This can be the name of one binary log, a - list of such logs or the name of a directory containing one or - more binary logs. If this argument indicates more than one log, - and the <c>timestamp</c> flag was set when tracing, the trace - messages from the different logs will be merged according to the - timestamps in each message. + binary log(s) to format. This is usually the name of a directory + that ttb created during log fetch. Unless there is the <c>disable_sort</c> + option provided, the logs from different files are always sorted + according to timestamp in traces. </p> <p>The second argument to <c>ttb:format/2</c> is a list of options. The <c>out</c> option specifies the destination where the @@ -363,7 +508,10 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> option is not given, the <c>handler</c> option given when starting the tracer is used. If the <c>handler</c> option was not given when starting the tracer either, a default handler is used, which - prints each trace message as a line of text. + prints each trace message as a line of text. The <c>disable_sort</c> + option indicates that there logs should not be merged according to + timestamp, but processed one file after another (this might be + a bit faster). </p> <p>A format handler is a fun taking four arguments. This fun will be called for each trace message in the binary log(s). A simple @@ -396,10 +544,24 @@ end </code> <c>handle_gc/4</c> in the module <c>multitrace.erl</c> which can be found in the <c>src</c> directory of the Observer application. </p> - <p>By giving the format handler <c>et</c>, you can have the trace + <p>The actual trace message is passed as the second argument (<c>Trace</c>). + The possible values of <c>Trace</c> are:</p> + <list type="bulleted"> + <item>all trace messages described in <c>erlang:trace/3</c> documentation, + </item> + <item><c>{drop, N}</c> if ip tracer is used (see <c>dbg:trace_port/2</c>), + </item> + <item><c>end_of_trace</c> received once when all trace messages have + been processed.</item> + </list> + <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace log presented graphically with <c>et_viewer</c> in the Event Tracer application (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). - </p> + </p> + <p>You may always decide not to format the whole trace data contained + in the fetch directory, but analyze single files instead. In order + to do so, a single file (or list of files) have to be passed as + the first argument to <c>format/1/2</c>.</p> <p>Wrap logs can be formatted one by one or all in one go. To format one of the wrap logs in a set, give the exact name of the file. To format the whole set of wrap logs, give the name with '*' @@ -407,7 +569,7 @@ end </code> </p> <p>Start tracing:</p> <code type="none"> -(tiger@durin)1> ttb:tracer(node(),[{file,{wrap,"trace"}}]). +(tiger@durin)1> ttb:tracer(node(),{file,{wrap,"trace"}}). {ok,[tiger@durin]} (tiger@durin)2> ttb:p(...) ... </code> @@ -443,7 +605,7 @@ ok to the User's Guide and Reference Manuals for the <c>et</c> application. </p> - <p>By giving the format handler <c>et</c>, you can have the + <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace log presented graphically with <c>et_viewer</c> in the Event Tracer application. <c>ttb</c> provides a few different filters which can be selected from the Filter menu in the @@ -495,9 +657,23 @@ ok filters respectively, except that each module or function can have several vertical lines, one for each process it resides on. </p> - <p>As an example this module is used, and the function - <c>bar:f1()</c> is called from another module <c>foo</c>.</p> + <p>In the next example, modules <c>foo</c> and <c>bar</c> are used:</p> <code type="none"> +-module(foo). +-export([start/0,go/0]). + +start() -> + spawn(?MODULE, go, []). + +go() -> + receive + stop -> + ok; + go -> + bar:f1(), + go() + end. +</code><code type="none"> -module(bar). -export([f1/0,f3/0]). f1() -> @@ -506,12 +682,23 @@ f1() -> f2() -> spawn(?MODULE,f3,[]). f3() -> - ok. </code> - <p>The <c>call</c> and <c>return_to</c> flags are used, and - trace pattern is set on local calls in module <c>bar</c>. - </p> - <p><c>ttb:format("tiger@durin-ttb", [{handler, et}])</c> gives the - following result: + ok.</code> + + <p>Now let's set up the trace.</p> +<code> +(tiger@durin)1>%%First we retrieve the Pid to limit traced processes set +(tiger@durin)1>Pid = foo:start(). +(tiger@durin)2>%%Now we set up tracing +(tiger@durin)2>ttb:tracer(). +(tiger@durin)3>ttb:p(Pid, [call, return_to, procs, set_on_spawn]). +(tiger@durin)4>ttb:tpl(bar, []). +(tiger@durin)5>%%Invoke our test function and see output with et viewer +(tiger@durin)5>Pid ! go. +(tiger@durin)6>ttb:stop({format, {handler, ttb:get_et_handler()}}). +</code> + + <p>This shoud render a result similar to the + following: </p> <p></p> <image file="et_processes.gif"> @@ -520,25 +707,37 @@ f3() -> <image file="et_modsprocs.gif"> <icaption>Filter: "mods_and_procs"</icaption> </image> + + <p>Note, that we can use <c>ttb:start_trace/4</c> function to help + us here:</p> +<code> +(tiger@durin)1>Pid = foo:start(). +(tiger@durin)2>ttb:start_trace([node()], + [{bar,[]}], + {Pid, [call, return_to, procs, set_on_spawn]} + {handler, ttb:get_et_handler()}). +(tiger@durin)3>Pid ! go. +(tiger@durin)4>ttb:stop(format). +</code> + </section> </section> <section> <marker id="fetch_format"></marker> <title>Automatically collect and format logs from all nodes</title> - <p>If the option <c>fetch</c> is given to the <c>ttb:stop/1</c> - function, trace logs and trace information files are fetched - from all nodes after tracing is stopped. The logs are stored in a - new directory named <c>ttb_upload-Timestamp</c> under the working - directory of the trace control node. + <p>By default <c>ttb:stop/1</c> fetches trace logs and + trace information files from all nodes. The logs are stored in a + new directory named <c>ttb_upload-Filename-Timestamp</c> under the working + directory of the trace control node. Fetching may be disabled by + providing the <c>nofetch</c> option to <c>ttb:stop/1</c>. User can + specify a fetch directory of his choice passing the + <c>{fetch_dir, Dir}</c> option. </p> <p>If the option <c>format</c> is given to <c>ttb:stop/1</c>, the trace logs are automatically formatted after tracing is - stopped. Note that <c>format</c> also implies <c>fetch</c>, - i.e. the trace logs will be collected from all nodes as for the - <c>fetch</c> option before they are formatted. All logs in the - upload directory are merged during formatting. - </p> + stopped. + </p> </section> <section> @@ -546,13 +745,18 @@ f3() -> <p>For the tracing functionality, <c>dbg</c> could be used instead of the <c>ttb</c> for setting trace flags on processes and trace patterns for call trace, i.e. the functions <c>p</c>, <c>tp</c>, - <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. The only - thing added by <c>ttb</c> for these functions is that all calls - are stored in the history buffer and can be recalled and stored in - a configuration file. This makes it easy to setup the same trace - environment e.g. if you want to compare two test runs. It also - reduces the amount of typing when using <c>ttb</c> from the erlang - shell. + <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. There are only + two things added by <c>ttb</c> for these functions: + <list type="bulleted"> + <item>all calls are stored in the history buffer and can be + recalled and stored in a configuration file. This makes it + easy to setup the same trace environment e.g. if you want to + compare two test runs. It also reduces the amount of + typing when using <c>ttb</c> from the erlang shell;</item> + <item>shortcuts are provided for the most common match + specifications (in order not to force the user to use + <c>dbg:fun2ms</c> continually</item>). + </list> </p> <p>Use <c>list_history/0</c> to see the content of the history buffer, and <c>run_history/1</c> to re-execute one of the entries. @@ -574,7 +778,8 @@ f3() -> selected entries from the history by calling <c>ttb:write_config(ConfigFile,NumList)</c>, where <c>NumList</c> is a list of integers pointing out the history - entries to write. + entries to write. Moreover, the history buffer is always dumped + to <c>ttb_last_config</c> when <c>ttb:stop/0/1</c> is called. </p> <p>User defined entries can also be written to a config file by calling the function @@ -720,9 +925,7 @@ ok {ok,[{matched,1},{saved,1}]} (tiger@durin)113> dbg:get_tracer(), seq_trace:reset_trace(). true -(tiger@durin)114> ttb:stop(). -ok -(tiger@durin)115> ttb:format("tiger@durin-ttb"). +(tiger@durin)114> ttb:stop(format). ({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer() SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) {<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} @@ -743,9 +946,7 @@ ok (tiger@durin)117> seq_trace:set_token(send,true), dbg:get_tracer(), seq_trace:reset_trace(). true -(tiger@durin)118> ttb:stop(). -ok -(tiger@durin)119> ttb:format("tiger@durin-ttb"). +(tiger@durin)118> ttb:stop(format). SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) {<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} [Serial: {0,1}] diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 221b71df6a..072aa165e7 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -18,9 +18,11 @@ %% -module(ttb). -author('[email protected]'). +-author('[email protected]'). %% API --export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1]). +-export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1,start_trace/4]). +-export([get_et_handler/0]). -export([tp/2, tp/3, tp/4, ctp/0, ctp/1, ctp/2, ctp/3, tpl/2, tpl/3, tpl/4, ctpl/0, ctpl/1, ctpl/2, ctpl/3, ctpg/0, ctpg/1, ctpg/2, ctpg/3]). -export([seq_trigger_ms/0,seq_trigger_ms/1]). @@ -34,24 +36,38 @@ -include_lib("kernel/include/file.hrl"). -define(meta_time,5000). +-define(fetch_time, 10000). -define(history_table,ttb_history_table). -define(seq_trace_flags,[send,'receive',print,timestamp]). --define(upload_dir,"ttb_upload"). +-define(upload_dir(Logname),"ttb_upload_"++Logname). +-define(last_config, "ttb_last_config"). +-define(partial_dir, "ttb_partial_result"). -ifdef(debug). --define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo)),loop(NodeInfo)). +-define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo),loop(NodeInfo, TraceInfo)). -else. -define(get_status,). -endif. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Shortcut +start_trace(Nodes, Patterns, {Procs, Flags}, Options) -> + {ok, _} = tracer(Nodes, Options), + [{ok, _} = apply(?MODULE, tpl, tuple_to_list(Args)) || Args <- Patterns], + {ok, _} = p(Procs, Flags). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Open a trace port on all given nodes and create the meta data file tracer() -> tracer(node()). +tracer(shell) -> tracer(node(), shell); +tracer(dbg) -> tracer(node(), {shell, only}); tracer(Nodes) -> tracer(Nodes,[]). tracer(Nodes,Opt) -> - start(), - store(tracer,[Nodes,Opt]), {PI,Client,Traci} = opt(Opt), - do_tracer(Nodes,PI,Client,Traci). + %%We use initial Traci as SessionInfo for loop/2 + Pid = start(Traci), + store(tracer,[Nodes,Opt]), + do_tracer(Nodes,PI,Client,[{ttb_control, Pid}|Traci]). do_tracer(Nodes0,PI,Client,Traci) -> Nodes = nods(Nodes0), @@ -59,9 +75,14 @@ do_tracer(Nodes0,PI,Client,Traci) -> do_tracer(Clients,PI,Traci). do_tracer(Clients,PI,Traci) -> + ShellOutput = proplists:get_value(shell, Traci, false), {ClientSucc,Succ} = lists:foldl( fun({N,{local,File},TF},{CS,S}) -> + TF2 = case ShellOutput of + only -> none; + _ -> TF + end, [_Sname,Host] = string:tokens(atom_to_list(N),"@"), case catch dbg:tracer(N,port,dbg:trace_port(ip,0)) of {ok,N} -> @@ -69,8 +90,8 @@ do_tracer(Clients,PI,Traci) -> {ok,T} = dbg:get_tracer(N), rpc:call(N,seq_trace,set_system_tracer,[T]), dbg:trace_client(ip,{Host,Port}, - {fun ip_to_file/2,{file,File}}), - {[{N,{local,File,Port},TF}|CS], [N|S]}; + {fun ip_to_file/2,{{file,File}, ShellOutput}}), + {[{N,{local,File,Port},TF2}|CS], [N|S]}; Other -> display_warning(N,{cannot_open_ip_trace_port, Host, @@ -98,17 +119,54 @@ do_tracer(Clients,PI,Traci) -> {ok,Succ} end. +opt(Opt) when is_list(Opt) -> + opt(Opt,{true,?MODULE,[]}); opt(Opt) -> - opt(Opt,{true,?MODULE,[]}). + opt([Opt]). opt([{process_info,PI}|O],{_,Client,Traci}) -> opt(O,{PI,Client,Traci}); opt([{file,Client}|O],{PI,_,Traci}) -> - opt(O,{PI,Client,Traci}); + opt(O,{PI,Client,[{logfile,get_logname(Client)}|Traci]}); opt([{handler,Handler}|O],{PI,Client,Traci}) -> opt(O,{PI,Client,[{handler,Handler}|Traci]}); +opt([{timer, {MSec, StopOpts}}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{timer,{MSec, StopOpts}}|Traci]}); +opt([{timer, MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{timer,{MSec, []}}|Traci]}); +opt([{overload_check, {MSec,M,F}}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{overload_check,{MSec,M,F}}|Traci]}); +opt([shell|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{shell, true}|Traci]}); +opt([{shell,Type}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{shell, Type}|Traci]}); +opt([resume|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{resume, {true, ?fetch_time}}|Traci]}); +opt([{resume,MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{resume, {true, MSec}}|Traci]}); +opt([{flush,MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{flush, MSec}|Traci]}); opt([],Opt) -> - Opt. + ensure_opt(Opt). + +ensure_opt({PI,Client,Traci}) -> + case {proplists:get_value(flush, Traci), Client} of + {undefined, _} -> ok; + {_, {local, _}} -> exit(flush_unsupported_with_ip_trace_port); + {_,_} -> ok + end, + NeedIpTracer = proplists:get_value(shell, Traci, false) /= false, + case {NeedIpTracer, Client} of + {false, _} -> {PI, Client, Traci}; + {true, ?MODULE} -> {PI, {local, ?MODULE}, Traci}; + {true, {local, File}} -> {PI, {local, File}, Traci}; + {true, _} -> exit(local_client_required_on_shell_tracing) + end. + +get_logname({local, F}) -> get_logname(F); +get_logname({wrap, F}) -> filename:basename(F); +get_logname({wrap, F, _, _}) -> filename:basename(F); +get_logname(F) -> filename:basename(F). nods(all) -> Nodes1 = remove_active([node()|nodes()]), @@ -205,17 +263,29 @@ run_history([H|T]) -> ok -> run_history(T); {error,not_found} -> {error,{not_found,H}} end; + +run_history(all) -> + CurrentHist = ets:tab2list(?history_table), + ets:delete_all_objects(?history_table), + [run_printed(MFA,true) || {_, MFA} <- CurrentHist]; +run_history(all_silent) -> + CurrentHist = ets:tab2list(?history_table), + ets:delete_all_objects(?history_table), + [run_printed(MFA,false) || {_, MFA} <- CurrentHist]; run_history([]) -> ok; run_history(N) -> case catch ets:lookup(?history_table,N) of [{N,{M,F,A}}] -> - print_func(M,F,A), - R = apply(M,F,A), - print_result(R); + run_printed({M,F,A},true); _ -> {error, not_found} end. + +run_printed({M,F,A},Verbose) -> + Verbose andalso print_func(M,F,A), + R = apply(M,F,A), + Verbose andalso print_result(R). write_config(ConfigFile,all) -> write_config(ConfigFile,['_']); @@ -223,6 +293,8 @@ write_config(ConfigFile,Config) -> write_config(ConfigFile,Config,[]). write_config(ConfigFile,all,Opt) -> write_config(ConfigFile,['_'],Opt); +write_config(ConfigFile,Config,Opt) when not(is_list(Opt)) -> + write_config(ConfigFile,Config,[Opt]); write_config(ConfigFile,Nums,Opt) when is_list(Nums), is_integer(hd(Nums)); Nums=:=['_'] -> F = fun(N) -> ets:select(?history_table, @@ -313,6 +385,7 @@ arg_list([A1|A],Acc) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Set trace flags on processes p(Procs0,Flags0) -> + ensure_no_overloaded_nodes(), store(p,[Procs0,Flags0]), no_store_p(Procs0,Flags0). no_store_p(Procs0,Flags0) -> @@ -327,11 +400,12 @@ no_store_p(Procs0,Flags0) -> {error,Reason} -> display_warning(P,Reason), {PMatched,Ps} - end + end end,{[],[]},Procs) of {[],[]} -> {error, no_match}; {SuccMatched,Succ} -> no_store_write_trace_info(flags,{Succ,Flags}), + ?MODULE ! trace_started, {ok,SuccMatched} end end. @@ -339,7 +413,7 @@ no_store_p(Procs0,Flags0) -> transform_flags([clear]) -> [clear]; transform_flags(Flags) -> - dbg:transform_flags(Flags). + dbg:transform_flags([timestamp | Flags]). procs(Procs) when is_list(Procs) -> @@ -365,24 +439,30 @@ proc({global,Name}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Trace pattern tp(A,B) -> - store(tp,[A,B]), - dbg:tp(A,B). + ensure_no_overloaded_nodes(), + store(tp,[A,ms(B)]), + dbg:tp(A,ms(B)). tp(A,B,C) -> - store(tp,[A,B,C]), - dbg:tp(A,B,C). + ensure_no_overloaded_nodes(), + store(tp,[A,B,ms(C)]), + dbg:tp(A,B,ms(C)). tp(A,B,C,D) -> - store(tp,[A,B,C,D]), - dbg:tp(A,B,C,D). + ensure_no_overloaded_nodes(), + store(tp,[A,B,C,ms(D)]), + dbg:tp(A,B,C,ms(D)). tpl(A,B) -> - store(tpl,[A,B]), - dbg:tpl(A,B). + ensure_no_overloaded_nodes(), + store(tpl,[A,ms(B)]), + dbg:tpl(A,ms(B)). tpl(A,B,C) -> - store(tpl,[A,B,C]), - dbg:tpl(A,B,C). + ensure_no_overloaded_nodes(), + store(tpl,[A,B,ms(C)]), + dbg:tpl(A,B,ms(C)). tpl(A,B,C,D) -> - store(tpl,[A,B,C,D]), - dbg:tpl(A,B,C,D). + ensure_no_overloaded_nodes(), + store(tpl,[A,B,C,ms(D)]), + dbg:tpl(A,B,C,ms(D)). ctp() -> store(ctp,[]), @@ -423,6 +503,56 @@ ctpg(A,B,C) -> store(ctpg,[A,B,C]), dbg:ctpg(A,B,C). +ms(return) -> + [{'_',[],[{return_trace}]}]; +ms(caller) -> + [{'_',[],[{message,{caller}}]}]; +ms({codestr, FunStr}) -> + {ok, MS} = string2ms(FunStr), + MS; +ms(Other) -> + Other. + +ensure_no_overloaded_nodes() -> + Overloaded = case whereis(?MODULE) of + undefined -> + []; + _ -> + ?MODULE ! {get_overloaded, self()}, + receive O -> O end + end, + case Overloaded of + [] -> ok; + Overloaded -> exit({error, overload_protection_active, Overloaded}) + end. + +-spec string2ms(string()) -> {ok, list()} | {error, fun_format}. +string2ms(FunStr) -> + case erl_scan:string(fix_dot(FunStr)) of + {ok, Tokens, _} -> + case erl_parse:parse_exprs(Tokens) of + {ok, [Expression]} -> + case Expression of + {_, _, {clauses, Clauses}} -> + {ok, ms_transform:transform_from_shell(dbg, Clauses, [])}; + _ -> + {error, fun_format} + end; + _ -> + {error, fun_format} + end; + _ ->{error, fun_format} + end. + +-spec fix_dot(string()) -> string(). +fix_dot(FunStr) -> + [H | Rest] = lists:reverse(FunStr), + case H of + $. -> + FunStr; + H -> + lists:reverse([$., H | Rest]) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Support for sequential trace @@ -457,66 +587,109 @@ no_store_write_trace_info(Key,What) -> %%% Stop tracing on all nodes stop() -> stop([]). -stop(Opts) -> +stop(Opts) when is_list(Opts) -> Fetch = stop_opts(Opts), - case whereis(?MODULE) of - undefined -> ok; - Pid when is_pid(Pid) -> - ?MODULE ! {stop,Fetch,self()}, - receive {?MODULE,stopped} -> ok end + Result = + case whereis(?MODULE) of + undefined -> ok; + Pid when is_pid(Pid) -> + ?MODULE ! {stop,Fetch,self()}, + receive {?MODULE,R} -> R end + end, + case {Fetch, Result} of + {nofetch, _} -> + ok; + {_, {stopped, _}} -> + %% Printout moved out of the ttb loop to avoid occasional deadlock + io:format("Stored logs in ~s~n", [element(2, Result)]); + {_, _} -> + ok end, - stopped. + stop_return(Result,Opts); +stop(Opts) -> + stop([Opts]). stop_opts(Opts) -> - case lists:member(format,Opts) of - true -> - format; % format implies fetch - false -> - case lists:member(fetch,Opts) of - true -> fetch; - false -> nofetch - end + FetchDir = proplists:get_value(fetch_dir, Opts), + ensure_fetch_dir(FetchDir), + FormatData = case proplists:get_value(format, Opts) of + undefined -> false; + true -> {format, []}; + FOpts -> {format, FOpts} + end, + case {FormatData, lists:member(return_fetch_dir, Opts)} of + {false, true} -> + {fetch, FetchDir}; % if we specify return_fetch_dir, the data should be fetched + {false, false} -> + case lists:member(nofetch,Opts) of + false -> {fetch, FetchDir}; + true -> nofetch + end; + {FormatData, _} -> + {FormatData, FetchDir} + end. + +ensure_fetch_dir(undefined) -> ok; +ensure_fetch_dir(Dir) -> + case filelib:is_file(Dir) of + true -> + throw({error, exists, Dir}); + false -> + ok + end. + +stop_return(R,Opts) -> + case {lists:member(return_fetch_dir,Opts),R} of + {true,_} -> + R; + {false,{stopped,_}} -> + stopped; + {false,_} -> + %% Anything other than 'stopped' would not be bw compatible... + stopped end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Process implementation -start() -> +start(SessionInfo) -> case whereis(?MODULE) of undefined -> Parent = self(), - Pid = spawn(fun() -> init(Parent) end), - receive {started,Pid} -> ok end; + Pid = spawn(fun() -> init(Parent, SessionInfo) end), + receive {started,Pid} -> ok end, + Pid; Pid when is_pid(Pid) -> - ok + Pid end. - -init(Parent) -> +init(Parent, SessionInfo) -> register(?MODULE,self()), ets:new(?history_table,[ordered_set,named_table,public]), Parent ! {started,self()}, - loop(dict:new()). + NewSessionInfo = [{partials, 0}, {dead_nodes, []} | SessionInfo], + try_send_flush_tick(NewSessionInfo), + loop(dict:new(), NewSessionInfo). -loop(NodeInfo) -> +loop(NodeInfo, SessionInfo) -> receive {init_node,Node,MetaFile,PI,Traci} -> erlang:monitor_node(Node,true), - MetaPid = + {AbsoluteMetaFile, MetaPid} = case rpc:call(Node, observer_backend, ttb_init_node, [MetaFile,PI,Traci]) of - {ok,MP} -> - MP; + {ok,MF,MP} -> + {MF,MP}; {badrpc,nodedown} -> %% We will get a nodedown message - undefined + {MetaFile,undefined} end, - loop(dict:store(Node,{MetaFile,MetaPid},NodeInfo)); + loop(dict:store(Node,{AbsoluteMetaFile,MetaPid},NodeInfo), SessionInfo); {get_nodes,Sender} -> Sender ! {?MODULE,dict:fetch_keys(NodeInfo)}, - loop(NodeInfo); + loop(NodeInfo, SessionInfo); {write_trace_info,Key,What} -> dict:fold(fun(Node,{_MetaFile,MetaPid},_) -> rpc:call(Node,observer_backend, @@ -524,55 +697,121 @@ loop(NodeInfo) -> end, ok, NodeInfo), - loop(NodeInfo); + loop(NodeInfo, SessionInfo); {nodedown,Node} -> - loop(dict:erase(Node,NodeInfo)); - {stop,nofetch,Sender} -> - dict:fold( - fun(Node,{_,MetaPid},_) -> - rpc:call(Node,observer_backend,ttb_stop,[MetaPid]) - end, - ok, - NodeInfo), - dbg:stop_clear(), - ets:delete(?history_table), - Sender ! {?MODULE,stopped}; - {stop,FetchOrFormat,Sender} -> - Localhost = host(node()), - Dir = ?upload_dir++ts(), - file:make_dir(Dir), - %% The nodes are traversed twice here because - %% the meta tracing in observer_backend must be - %% stopped before dbg is stopped, and dbg must - %% be stopped before the trace logs are moved orelse - %% windows complains. - AllNodesAndMeta = - dict:fold( - fun(Node,{MetaFile,MetaPid},Nodes) -> - rpc:call(Node,observer_backend,ttb_stop,[MetaPid]), - [{Node,MetaFile}|Nodes] - end, - [], - NodeInfo), - dbg:stop_clear(), - AllNodes = - lists:map( - fun({Node,MetaFile}) -> - spawn(fun() -> fetch(Localhost,Dir,Node,MetaFile) end), - Node - end, - AllNodesAndMeta), - ets:delete(?history_table), - wait_for_fetch(AllNodes), - io:format("Stored logs in ~s~n",[filename:absname(Dir)]), - case FetchOrFormat of - format -> format(Dir); - fetch -> ok + NewState = make_node_dead(Node, NodeInfo, SessionInfo), + loop(dict:erase(Node,NodeInfo), NewState); + {noderesumed,Node,Reporter} -> + {MetaFile, CurrentSuffix, NewState} = make_node_alive(Node, SessionInfo), + fetch_partial_result(Node, MetaFile, CurrentSuffix), + spawn(fun() -> resume_trace(Reporter) end), + loop(NodeInfo, NewState); + {timeout, StopOpts} -> + spawn(?MODULE, stop, [StopOpts]), + loop(NodeInfo, SessionInfo); + {node_overloaded, Node} -> + io:format("Overload check activated on node: ~p.~n", [Node]), + {Overloaded, SI} = {proplists:get_value(overloaded, SessionInfo, []), + lists:keydelete(overloaded, 1, SessionInfo)}, + loop(NodeInfo, [{overloaded, [Node|Overloaded]} | SI]); + {get_overloaded, Pid} -> + Pid ! proplists:get_value(overloaded, SessionInfo, []), + loop(NodeInfo, SessionInfo); + trace_started -> + case proplists:get_value(timer, SessionInfo) of + undefined -> ok; + {MSec, StopOpts} -> erlang:send_after(MSec, self(), {timeout, StopOpts}) end, - Sender ! {?MODULE,stopped} - ?get_status + loop(NodeInfo, SessionInfo); + flush_timeout -> + [ dbg:flush_trace_port(Node) || Node <- dict:fetch_keys(NodeInfo) ], + try_send_flush_tick(SessionInfo), + loop(NodeInfo, SessionInfo); + {stop,nofetch,Sender} -> + do_stop(nofetch, Sender, NodeInfo, SessionInfo); + {stop,FetchSpec,Sender} -> + case proplists:get_value(shell, SessionInfo, false) of + only -> do_stop(nofetch, Sender, NodeInfo, SessionInfo); + _ -> do_stop(FetchSpec, Sender, NodeInfo, SessionInfo) + end + end. + +do_stop(nofetch, Sender, NodeInfo, _) -> + write_config(?last_config, all), + dict:fold( + fun(Node,{_,MetaPid},_) -> + rpc:call(Node,observer_backend,ttb_stop,[MetaPid]) + end, + ok, + NodeInfo), + dbg:stop_clear(), + ets:delete(?history_table), + Sender ! {?MODULE, stopped}; + +do_stop({FetchOrFormat, UserDir}, Sender, NodeInfo, SessionInfo) -> + write_config(?last_config, all), + Localhost = host(node()), + Dir = get_fetch_dir(UserDir, proplists:get_value(logfile, SessionInfo)), + file:make_dir(Dir), + %% The nodes are traversed twice here because + %% the meta tracing in observer_backend must be + %% stopped before dbg is stopped, and dbg must + %% be stopped before the trace logs are moved orelse + %% windows complains. + AllNodesAndMeta = + dict:fold( + fun(Node,{MetaFile,MetaPid},Nodes) -> + rpc:call(Node,observer_backend,ttb_stop,[MetaPid]), + [{Node,MetaFile}|Nodes] + end, + [], + NodeInfo), + dbg:stop_clear(), + AllNodes = + lists:map( + fun({Node,MetaFile}) -> + spawn(fun() -> fetch_report(Localhost,Dir,Node,MetaFile) end), + Node + end, + AllNodesAndMeta), + ets:delete(?history_table), + wait_for_fetch(AllNodes), + copy_partials(Dir, proplists:get_value(partials, SessionInfo)), + Absname = filename:absname(Dir), + case FetchOrFormat of + fetch -> ok; + {format, Opts} -> format(Dir, Opts) + end, + Sender ! {?MODULE,{stopped,Absname}}. + +make_node_dead(Node, NodeInfo, SessionInfo) -> + {MetaFile,_} = dict:fetch(Node, NodeInfo), + NewDeadNodes = [{Node, MetaFile} | proplists:get_value(dead_nodes, SessionInfo)], + [{dead_nodes, NewDeadNodes} | lists:keydelete(dead_nodes, 1, SessionInfo)]. + +make_node_alive(Node, SessionInfo) -> + DeadNodes = proplists:get_value(dead_nodes, SessionInfo), + Partials = proplists:get_value(partials, SessionInfo), + {value, {_, MetaFile}, Dn2} = lists:keytake(Node, 1, DeadNodes), + SessionInfo2 = lists:keyreplace(dead_nodes, 1, SessionInfo, {dead_nodes, Dn2}), + {MetaFile, Partials + 1, lists:keyreplace(partials, 1, SessionInfo2, {partials, Partials + 1})}. + +try_send_flush_tick(State) -> + case proplists:get_value(flush, State) of + undefined -> + ok; + MSec -> + erlang:send_after(MSec, self(), flush_timeout) end. +get_fetch_dir(undefined,undefined) -> ?upload_dir(?MODULE_STRING) ++ ts(); +get_fetch_dir(undefined,Logname) -> ?upload_dir(Logname) ++ ts(); +get_fetch_dir(Dir,_) -> Dir. + +resume_trace(Reporter) -> + ?MODULE:run_history(all_silent), + Reporter ! trace_resumed. + get_nodes() -> ?MODULE ! {get_nodes,self()}, receive {?MODULE,Nodes} -> Nodes end. @@ -582,19 +821,40 @@ ts() -> io_lib:format("-~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). +copy_partials(_, 0) -> + ok; +copy_partials(Dir, Num) -> + PartialDir = ?partial_dir ++ integer_to_list(Num), + file:rename(PartialDir, filename:join(Dir,PartialDir)), + copy_partials(Dir, Num - 1). + +fetch_partial_result(Node,MetaFile,Current) -> + DirName = ?partial_dir ++ integer_to_list(Current), + case file:list_dir(DirName) of + {error, enoent} -> + ok; + {ok, Files} -> + [ file:delete(filename:join(DirName, File)) || File <- Files ], + file:del_dir(DirName) + end, + file:make_dir(DirName), + fetch(host(node()), DirName, Node, MetaFile). +fetch_report(Localhost, Dir, Node, MetaFile) -> + fetch(Localhost,Dir,Node,MetaFile), + ?MODULE ! {fetch_complete,Node}. fetch(Localhost,Dir,Node,MetaFile) -> - case host(Node) of - Localhost -> % same host, just move the files - Files = rpc:call(Node,observer_backend,ttb_get_filenames,[MetaFile]), + case (host(Node) == Localhost) orelse is_local(MetaFile) of + true -> % same host, just move the files + Files = get_filenames(Node,MetaFile), lists:foreach( - fun(File0) -> - File = filename:join(Dir,filename:basename(File0)), - file:rename(File0,File) - end, - Files); - _Otherhost -> + fun(File0) -> + Dest = filename:join(Dir,filename:basename(File0)), + file:rename(File0, Dest) + end, + Files); + false -> {ok, LSock} = gen_tcp:listen(0, [binary,{packet,2},{active,false}]), {ok,Port} = inet:port(LSock), rpc:cast(Node,observer_backend,ttb_fetch, @@ -603,8 +863,17 @@ fetch(Localhost,Dir,Node,MetaFile) -> receive_files(Dir,Sock,undefined), ok = gen_tcp:close(LSock), ok = gen_tcp:close(Sock) - end, - ?MODULE ! {fetch_complete,Node}. + end. + +is_local({local, _, _}) -> + true; +is_local(_) -> + false. + +get_filenames(_N, {local,F,_}) -> + observer_backend:ttb_get_filenames(F); +get_filenames(N, F) -> + rpc:call(N, observer_backend,ttb_get_filenames,[F]). receive_files(Dir,Sock,Fd) -> case gen_tcp:recv(Sock, 0) of @@ -646,9 +915,16 @@ wait_for_fetch(Nodes) -> %%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - write_info(Nodes,PI,Traci) -> - lists:foreach(fun({N,{local,C,_},F}) -> - MetaFile = F ++ ".ti", - file:delete(MetaFile), + {ok, Cwd} = file:get_cwd(), + lists:foreach(fun({N,{local,C,_},F}) -> + MetaFile = case F of + none -> + none; + F -> + AbsFile = filename:join(Cwd, F) ++ ".ti", + file:delete(AbsFile), + AbsFile + end, Traci1 = [{node,N},{file,C}|Traci], {ok,Port} = dbg:get_tracer(N), ?MODULE ! @@ -662,38 +938,35 @@ write_info(Nodes,PI,Traci) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Format binary trace logs +get_et_handler() -> + {fun ttb_et:handler/4, initial}. + format(Files) -> format(Files,[]). format(Files,Opt) -> - {Out,Handler} = format_opt(Opt), + {Out,Handler,DisableSort} = format_opt(Opt), ets:new(?MODULE,[named_table]), - format(Files,Out,Handler). -format(File,Out,Handler) when is_list(File), is_integer(hd(File)) -> + format(Files,Out,Handler, DisableSort). +format(File,Out,Handler,DisableSort) when is_list(File), is_integer(hd(File)) -> Files = case filelib:is_dir(File) of true -> % will merge all files in the directory - MetaFiles = filelib:wildcard(filename:join(File,"*.ti")), - lists:map(fun(M) -> - Sub = string:left(M,length(M)-3), - case filelib:is_file(Sub) of - true -> Sub; - false -> Sub++".*.wrp" - end - end, - MetaFiles); + List = filelib:wildcard(filename:join(File, ?partial_dir++"*")), + lists:append(collect_files([File | List])); false -> % format one file [File] end, - format(Files,Out,Handler); -format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) -> + format(Files,Out,Handler,DisableSort); +format(Files,Out,Handler,DisableSort) when is_list(Files), is_list(hd(Files)) -> StopDbg = case whereis(dbg) of undefined -> true; _ -> false end, - Details = lists:foldl(fun(File,Acc) -> [prepare(File,Handler)|Acc] end, + Details = lists:foldl(fun(File,Acc) -> [prepare(File)|Acc] end, [],Files), Fd = get_fd(Out), - R = do_format(Fd,Details), + RealHandler = get_handler(Handler, Files), + R = do_format(Fd,Details,DisableSort,RealHandler), file:close(Fd), ets:delete(?MODULE), case StopDbg of @@ -702,7 +975,30 @@ format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) -> end, R. -prepare(File,Handler) -> +collect_files(Dirs) -> + lists:map(fun(Dir) -> + MetaFiles = filelib:wildcard(filename:join(Dir,"*.ti")), + lists:map(fun(M) -> + Sub = string:left(M,length(M)-3), + case filelib:is_file(Sub) of + true -> Sub; + false -> Sub++".*.wrp" + end + end, + MetaFiles) + end, Dirs). + +get_handler(undefined, Files) -> + %%We retrieve traci from the first available file + {Traci, _} = read_traci(hd(Files)), + case dict:find(handler, Traci) of + error -> {fun defaulthandler/4, initial}; + {ok, [Handler]} -> Handler + end; +get_handler(Handler, _) -> + Handler. + +prepare(File) -> {Traci,Proci} = read_traci(File), Node = get_node(Traci), lists:foreach(fun({Pid,PI}) -> @@ -714,19 +1010,21 @@ prepare(File,Handler) -> ets:insert(?MODULE,{Pid,PI,Node}) end,Proci), FileOrWrap = get_file(File,Traci), - Handler1 = get_handler(Handler,Traci), - {FileOrWrap,Traci,Handler1}. + {FileOrWrap,Traci}. -format_opt(Opt) -> +format_opt(Opt) when is_list(Opt) -> Out = case lists:keysearch(out,1,Opt) of {value,{out,O}} -> O; _ -> standard_io end, Handler = case lists:keysearch(handler,1,Opt) of - {value,{handler,H}} -> H; - _ -> undefined + {value,{handler,H}} -> H; + _ -> undefined end, - {Out,Handler}. + DisableSort = proplists:get_value(disable_sort, Opt, false), + {Out,Handler,DisableSort}; +format_opt(Opt) -> + format_opt([Opt]). read_traci(File) -> @@ -800,75 +1098,61 @@ check_client(Client,File) when is_tuple(Client),element(2,Client)==wrap -> check_exists(File) -> case file:read_file_info(File) of {ok,#file_info{type=regular}} -> File; - _ -> + _ -> exit({error,no_file}) end. - -get_handler(Handler,Traci) -> - case Handler of - undefined -> - case dict:find(handler,Traci) of - {ok,[H]} -> H; - error -> undefined - end; - _ -> - Handler - end. -do_format(Fd,Details) -> - Clients = lists:foldl(fun({FileOrWrap,Traci,Handler},Acc) -> - [start_client(FileOrWrap,Traci,Handler) - |Acc] +do_format(Fd,Details,DisableSort,Handler) -> + Clients = lists:foldl(fun({FileOrWrap,Traci},Acc) -> + [start_client(FileOrWrap,Traci)|Acc] end,[],Details), - init_collector(Fd,Clients). - - -start_client(FileOrWrap,Traci,et) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, - {dict:to_list(Traci),{{ttb_et,handler},initial}}}); -start_client(FileOrWrap,Traci,undefined) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, - {dict:to_list(Traci),{fun defaulthandler/4,initial}}}); -start_client(FileOrWrap,Traci,Handler) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, {dict:to_list(Traci),Handler}}). - -handler(Trace,State) -> - %% State here is only used for the initial state. The accumulated - %% State is maintained by collector!!! - receive - {get,Collector} -> Collector ! {self(),{Trace,State}}; + init_collector(Fd,Clients,DisableSort,Handler). + +start_client(FileOrWrap,Traci) -> + dbg:trace_client(file, FileOrWrap, + {fun handler/2, dict:to_list(Traci)}). + +handler(Trace,Traci) -> + %%We return our own Traci so that it not necesarry to look it up + %%This may take time if something huge has been written to it + receive + {get,Collector} -> Collector ! {self(),{Trace,Traci}}; done -> ok end, - State. + Traci. -handler1(Trace,{Fd,{Traci,{Fun,State}}}) when is_function(Fun) -> - {Traci,{Fun,Fun(Fd,Trace,Traci,State)}}; -handler1(Trace,{Fd,{Traci,{{M,F},State}}}) when is_atom(M), is_atom(F) -> - {Traci,{{M,F},M:F(Fd,Trace,Traci,State)}}. +%%Used to handle common state (the same for all clients) +handler2(Trace,{Fd,Traci,{Fun,State}}) when is_function(Fun) -> + {Fun, Fun(Fd, Trace, Traci, State)}; +handler2(Trace,{Fd,Traci,{{M,F},State}}) when is_atom(M), is_atom(F) -> + {{M,F}, M:F(Fd, Trace, Traci, State)}. defaulthandler(Fd,Trace,_Traci,initial) -> dbg:dhandler(Trace,Fd); defaulthandler(_Fd,Trace,_Traci,State) -> dbg:dhandler(Trace,State). -init_collector(Fd,Clients) -> +init_collector(Fd,Clients,DisableSort,Handler) -> Collected = get_first(Clients), - collector(Fd,sort(Collected)). + case DisableSort of + true -> collector(Fd,Collected, DisableSort, Handler); + false -> collector(Fd,sort(Collected), DisableSort, Handler) + end. -collector(Fd,[{_,{Client,{Trace,State}}}|Rest]) -> +collector(Fd,[{_,{Client,{Trace,Traci}}} |Rest], DisableSort, CommonState) -> Trace1 = update_procinfo(Trace), - State1 = handler1(Trace1,{Fd,State}), - case get_next(Client,State1) of - end_of_trace -> - handler1(end_of_trace,{Fd,State1}), - collector(Fd,Rest); - Next -> collector(Fd,sort([Next|Rest])) + CommonState2 = handler2(Trace1, {Fd, Traci, CommonState}), + case get_next(Client) of + end_of_trace -> + collector(Fd,Rest,DisableSort, CommonState2); + Next -> case DisableSort of + false -> collector(Fd,sort([Next|Rest]), DisableSort, CommonState2); + true -> collector(Fd,[Next|Rest], DisableSort, CommonState2) + end end; -collector(_Fd,[]) -> +collector(Fd,[], _, CommonState) -> + handler2(end_of_trace, {Fd, end_of_trace, CommonState}), ok. update_procinfo({drop,_N}=Trace) -> @@ -895,7 +1179,7 @@ update_procinfo(Trace) -> ProcInfo = get_procinfo(Pid), setelement(2,Trace,ProcInfo). -get_procinfo(Pid) when is_pid(Pid) -> +get_procinfo(Pid) when is_pid(Pid); is_port(Pid) -> case ets:lookup(?MODULE,Pid) of [PI] -> PI; [] -> Pid @@ -913,21 +1197,21 @@ get_procinfo({Name,Node}) when is_atom(Name) -> get_first([Client|Clients]) -> Client ! {get,self()}, - receive - {Client,{end_of_trace,_}} -> + receive + {Client,{end_of_trace,_}} -> get_first(Clients); - {Client,{Trace,_State}}=Next -> + {Client,{Trace,_}}=Next -> [{timestamp(Trace),Next}|get_first(Clients)] end; get_first([]) -> []. -get_next(Client,State) when is_pid(Client) -> +get_next(Client) when is_pid(Client) -> Client ! {get,self()}, - receive - {Client,{end_of_trace,_}} -> + receive + {Client,{end_of_trace,_}} -> end_of_trace; - {Client,{Trace,_OldState}} -> - {timestamp(Trace),{Client,{Trace,State}}} % inserting new state!! + {Client,{Trace, Traci}} -> + {timestamp(Trace),{Client,{Trace,Traci}}} end. sort(List) -> @@ -971,19 +1255,34 @@ display_warning(Item,Warning) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Trace client which reads an IP port and puts data directly to a file. %%% This is used when tracing remote nodes with no file system. -ip_to_file(Trace,{file,File}) -> +ip_to_file({metadata,_,_},{_, only} = State) -> + State; +ip_to_file(Trace, {_, only} = State) -> + dbg:dhandler(Trace, standard_io), + State; +ip_to_file(Trace,{{file,File}, ShellOutput}) -> Fun = dbg:trace_port(file,File), %File can be a filename or a wrap spec Port = Fun(), - ip_to_file(Trace,Port); -ip_to_file({metadata,MetaFile,MetaData},Port) -> + case Trace of + {metadata, _, _} -> ok; + Trace -> show_trace(Trace, ShellOutput) + end, + ip_to_file(Trace,{Port,ShellOutput}); +ip_to_file({metadata,MetaFile,MetaData},State) -> {ok,MetaFd} = file:open(MetaFile,[write,raw,append]), file:write(MetaFd,MetaData), file:close(MetaFd), - Port; -ip_to_file(Trace,Port) -> + State; +ip_to_file(Trace,{Port, ShellOutput}) -> + show_trace(Trace, ShellOutput), B = term_to_binary(Trace), erlang:port_command(Port,B), - Port. + {Port, ShellOutput}. + +show_trace(Trace, true) -> + dbg:dhandler(Trace, standard_io); +show_trace(_, _) -> + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% For debugging @@ -996,5 +1295,3 @@ dump_ti(<<>>,Acc) -> dump_ti(B,Acc) -> {Term,Rest} = get_term(B), dump_ti(Rest,[Term|Acc]). - - diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile index 6073e6ea00..bf99f07081 100644 --- a/lib/observer/test/Makefile +++ b/lib/observer/test/Makefile @@ -22,7 +22,10 @@ MODULES = \ observer_SUITE \ crashdump_viewer_SUITE \ etop_SUITE \ + ttb_helper \ ttb_SUITE \ + client \ + server \ crashdump_helper ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/observer/test/client.erl b/lib/observer/test/client.erl new file mode 100644 index 0000000000..e756f9d6e8 --- /dev/null +++ b/lib/observer/test/client.erl @@ -0,0 +1,28 @@ +-module(client). +-compile(export_all). + +init(Node) -> + application:start(runtime_tools), + net_kernel:connect_node(Node). + +init() -> + init(server_node()). + +restart() -> + init:restart(). + +server_node() -> + {ok,HostName} = inet:gethostname(), + list_to_atom("server@" ++ HostName). + +get() -> + erlang:send({server,server_node()}, {get,self()}), + receive Data -> Data + after 1000 -> no_reply + end. + +put(Thing) -> + erlang:send({server,server_node()}, {put,self(),Thing}), + receive ok -> ok + after 1000 -> no_reply + end. diff --git a/lib/observer/test/server.erl b/lib/observer/test/server.erl new file mode 100644 index 0000000000..c1b1fea562 --- /dev/null +++ b/lib/observer/test/server.erl @@ -0,0 +1,43 @@ +-module(server). +-compile(export_all). + +start() -> + application:start(runtime_tools), + Pid = spawn(?MODULE,loop,[[], 0]), + register(server,Pid). + +stop() -> + case lists:member(server, registered()) of + true -> + server ! stop; + false -> + ok + end. + +loop(Data, Num) -> + receive + {put,From,Ting} -> From ! ok, + received(From,Ting), + loop([Ting|Data], Num+1); + {get,From} -> From ! Data, + loop(Data, Num+1); + stop -> stopped; + clear -> loop([], Num+1); + {cnt, From} -> From ! Num, + loop(Data, Num) + end. + +counter() -> + server ! {cnt, self()}, + receive + Num -> + Num + end. + +received(From, Thing) -> + case Thing of + never_send_this_atom -> + loop(Thing, 0); + _ -> + {return, 27, Thing, From} + end. diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 24b4a22aa9..1fd8b4c892 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -1,7 +1,7 @@ -%% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,9 +33,17 @@ -include_lib("test_server/include/test_server.hrl"). -define(default_timeout, ?t:minutes(1)). +-define(OUTPUT, "handler_output"). +-define(FNAME, "temptest"). +-define(DIRNAME, "ddtemp"). init_per_testcase(_Case, Config) -> ttb:stop(), + os:cmd("rm -rf " ++ ?OUTPUT), + os:cmd("rm -rf ttb_upload*"), + os:cmd("rm -rf " ++ ?DIRNAME), + os:cmd("rm -rf *@*"), + os:cmd("rm -rf ttb_last_config"), ?line Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -49,7 +57,25 @@ all() -> [file, file_no_pi, file_fetch, wrap, wrap_merge, wrap_merge_fetch_format, write_config1, write_config2, write_config3, history, write_trace_info, seq_trace, - diskless, otp_4967_1, otp_4967_2]. + diskless, diskless_wrap, otp_4967_1, otp_4967_2, + fetch_when_no_option_given, basic_ttb_run_ip_port, basic_ttb_run_file_port, + return_fetch_dir_implies_fetch, logfile_name_in_fetch_dir, upload_to_my_logdir, + upload_to_my_existing_logdir, fetch_with_options_not_as_list, + error_when_formatting_multiple_files_4393, format_on_trace_stop, + trace_to_remote_files_on_localhost_with_different_pwd, + trace_to_local_files_on_localhost_with_different_pwd, + trace_to_remote_files_on_localhost_with_different_pwd_abs, + changing_cwd_on_control_node, changing_cwd_on_remote_node, + changing_cwd_on_control_node_with_local_trace, + one_command_trace_setup, dbg_style_fetch, shell_tracing_init, + only_one_state_for_format_handler, only_one_state_with_default_format_handler, + only_one_state_with_initial_format_handler, run_trace_with_shortcut1, + run_trace_with_shortcut2, run_trace_with_shortcut3, run_trace_with_shortcut4, + cant_specify_local_and_flush, trace_sorted_by_default,disable_sorting, + trace_resumed_after_node_restart, trace_resumed_after_node_restart_ip, + trace_resumed_after_node_restart_wrap, + trace_resumed_after_node_restart_wrap_mult +]. groups() -> []. @@ -92,15 +118,15 @@ file(Config) when is_list(Config) -> ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir,atom_to_list(Node)++"-file")), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-file")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. @@ -123,15 +149,15 @@ file_no_pi(Config) when is_list(Config) -> ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir,atom_to_list(Node)++"-file")), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-file")), - ?line [{trace,LocalProc,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,LocalProc,call,{?MODULE,foo,[]}, {_,_,_}}, end_of_trace, - {trace,RemoteProc,call,{?MODULE,foo,[]}}, + {trace_ts,RemoteProc,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line true = is_pid(LocalProc), ?line true = is_pid(RemoteProc), @@ -170,7 +196,7 @@ file_fetch(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?t:capture_start(), - ?line ttb:stop([fetch]), + ?line ttb:stop([return_fetch_dir]), ?line ?t:capture_stop(), ?line [StoreString] = ?t:capture_get(), ?line UploadDir = @@ -194,9 +220,9 @@ file_fetch(Config) when is_list(Config) -> ?line ok = ttb:format(filename:join(UploadDir, atom_to_list(OtherNode)++"-file_fetch")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line ok = file:set_cwd(Cwd), @@ -224,19 +250,19 @@ wrap(Config) when is_list(Config) -> ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-wrap.*.wrp")), - ?line [{trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), %% Check that merge does not crash even if the timestamp flag is not on. @@ -244,14 +270,13 @@ wrap(Config) when is_list(Config) -> [filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp"), filename:join(Privdir, - atom_to_list(OtherNode)++"-wrap.*.wrp")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + atom_to_list(OtherNode)++"-wrap.*.wrp")],[{disable_sort,true}]), + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. @@ -277,7 +302,7 @@ wrap_merge(Config) when is_list(Config) -> ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, @@ -289,7 +314,6 @@ wrap_merge(Config) when is_list(Config) -> {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,_,call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, - end_of_trace, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, end_of_trace] = flush(), ok. @@ -330,7 +354,6 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, - end_of_trace, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, end_of_trace] = flush(), @@ -360,16 +383,15 @@ write_config1(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config1"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config1")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config1.ti") of @@ -410,16 +432,15 @@ write_config2(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config2"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config2")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config2.ti") of @@ -455,18 +476,18 @@ write_config3(Config) when is_list(Config) -> ?line {ok,[{all,[{matched,_,_},{matched,_,_}]}]} = ttb:p(all,call), ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ok = ttb:write_config(File,[1,2]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line [_,_] = ttb:list_config(File), ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config3")]), - ?line [] = flush(), %foo is not traced + ?line [end_of_trace] = flush(), %foo is not traced ?line ok = ttb:write_config(File,[{ttb,tp,[?MODULE,foo,[]]}], [append]), @@ -474,16 +495,15 @@ write_config3(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config3")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config3.ti") of @@ -531,12 +551,12 @@ history(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line ok = ttb:run_history([3,4]), ?line ?MODULE:foo(), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-history"), filename:join(Privdir,atom_to_list(OtherNode)++"-history")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. @@ -561,17 +581,16 @@ write_trace_info(Config) when is_list(Config) -> ?line ok = ttb:write_trace_info(mytraceinfo,fun() -> node() end), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-write_trace_info"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_trace_info")], [{handler,{fun otherhandler/4,S}}]), - ?line [{{trace,{S,_,Node},call,{?MODULE,foo,[]}},[Node]}, - {end_of_trace,[Node]}, - {{trace,{_,_,OtherNode},call,{?MODULE,foo,[]}},[OtherNode]}, - {end_of_trace,[OtherNode]}] = flush(), + ?line [{{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}},[Node]}, + {{trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}},[OtherNode]}, + end_of_trace] = flush(), ok. @@ -593,10 +612,10 @@ seq_trace(Config) when is_list(Config) -> ?line Start = spawn(fun() -> seq() end), ?line timer:sleep(300), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-seq_trace")]), - ?line [{trace,StartProc,call,{?MODULE,seq,[]}}, + ?line [{trace_ts,StartProc,call,{?MODULE,seq,[]},{_,_,_}}, {seq_trace,0,{send,{0,1},StartProc,P1Proc,{Start,P2}}}, {seq_trace,0,{send,{1,2},P1Proc,P2Proc,{P1,Start}}}, {seq_trace,0,{send,{2,3},P2Proc,StartProc,{P2,P1}}}, @@ -660,15 +679,41 @@ diskless(Config) when is_list(Config) -> ?line rpc:call(RemoteNode,?MODULE,foo,[]), ?line timer:sleep(500), % needed for the IP port to flush - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(RemoteNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(RemoteNode)++"-diskless")), - ?line [{trace,{_,_,RemoteNode},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{_,_,RemoteNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. +diskless_wrap(suite) -> + []; +diskless_wrap(doc) -> + ["Start tracing on diskless remote node, save to local wrapped file"]; +diskless_wrap(Config) when is_list(Config) -> + ?line {ok,RemoteNode} = ?t:start_node(node2,slave,[]), + ?line c:nl(?MODULE), + ?line S = self(), + ?line Privdir=?config(priv_dir, Config), + ?line File = filename:join(Privdir,"diskless"), + ?line {ok,[RemoteNode]} = + ttb:tracer([RemoteNode],[{file, {local, {wrap,File,200,3}}}, + {handler,{fun myhandler/4, S}}]), + ?line {ok,[{all,[{matched,RemoteNode,_}]}]} = ttb:p(all,call), + ?line {ok,[{matched,RemoteNode,1}]} = ttb:tp(?MODULE,foo,[]), + + ?line rpc:call(RemoteNode,?MODULE,foo,[]), + ?line timer:sleep(500), % needed for the IP port to flush + ?line ttb:stop([nofetch]), + ?line ?t:stop_node(RemoteNode), + ?line ok = ttb:format(filename:join(Privdir, + atom_to_list(RemoteNode)++"-diskless.*.wrp")), + + ?line [{trace_ts,{_,_,RemoteNode},call,{?MODULE,foo,[]},{_,_,_}}, + end_of_trace] = flush(), + ok. otp_4967_1(suite) -> []; @@ -715,7 +760,7 @@ otp_4967_2(Config) when is_list(Config) -> io:format("11: ~p",[now()]), ?line true = lists:member(heihopp,Msgs), % the heihopp message itself io:format("13: ~p",[now()]), - ?line {value,{trace,_,send,heihopp,{_,otp_4967,Node}}} = + ?line {value,{trace_ts,_,send,heihopp,{_,otp_4967,Node},{_,_,_}}} = lists:keysearch(heihopp,4,Msgs), % trace trace of the heihopp message io:format("14: ~p",[now()]), ?line end_of_trace = lists:last(Msgs), % end of the trace @@ -728,6 +773,30 @@ myhandler(_Fd,Trace,_,Relay) -> Relay ! Trace, Relay. +simple_call_handler() -> + {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (_, end_of_trace, _, _) -> ok end, []}. + +marking_call_handler() -> + {fun(_, _, _, initial) -> file:write_file("HANDLER_OK", []); + (_,_,_,_) -> ok end, initial}. + +counter_call_handler() -> + {fun(_, {trace_ts, _, call, _, _} ,_,State) -> State + 1; + (A, end_of_trace, _, State) -> io:format(A,"~p.~n", [State]) end, 0}. + +ret_caller_call_handler() -> + {fun(A, {trace_ts, _, call, _, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (A, {trace_ts, _, return_from, _, _, _}, _, _) -> io:format(A, "ok.~n", []); + (_, _, _, _) -> ok end, []}. + +node_call_handler() -> + {fun(A, {trace_ts, {_,_,Node}, call, _, _} ,_,_) -> io:format(A, "~p.~n", [Node]); + (_, end_of_trace, _, _) -> ok end, []}. + +otherhandler(_Fd,_,end_of_trace,Relay) -> + Relay ! end_of_trace, + Relay; otherhandler(_Fd,Trace,TI,Relay) -> {value,{mytraceinfo,I}} = lists:keysearch(mytraceinfo,1,TI), Relay ! {Trace,I}, @@ -794,3 +863,568 @@ check_gone(Dir,File) -> false -> ok end. + +start_client_and_server() -> + ?line {ok,ClientNode} = ?t:start_node(client,slave,[]), + ?line ok = ttb_helper:c(code, add_paths, [code:get_path()]), + ?line {ok,ServerNode} = ?t:start_node(server,slave,[]), + ?line ok = ttb_helper:s(code, add_paths, [code:get_path()]), + ?line ttb_helper:clear(), + {ServerNode, ClientNode}. + +begin_trace(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), + ?line ttb:p(all, call), + ?line ttb:tp(server, received, []), + ?line ttb:tp(client, put, []), + ?line ttb:tp(client, get, []). + +begin_trace_local(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), + ?line ttb:p(all, call), + ?line ttb:tpl(server, received, []), + ?line ttb:tpl(client, put, []), + ?line ttb:tpl(client, get, []). + +check_size(N, Dest, Output, ServerNode, ClientNode) -> + ?line begin_trace(ServerNode, ClientNode, Dest), + ?line case Dest of + {local, _} -> + ?line ttb_helper:msgs_ip(N); + _ -> + ?line ttb_helper:msgs(N) + end, + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, Output}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(Output), + ?line true = (N + 1 == length(Ret)). + +fetch_when_no_option_given(suite) -> + []; +fetch_when_no_option_given(doc) -> + ["Fetch when no option given"]; +fetch_when_no_option_given(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, Privdir} = file:get_cwd(), + ?line [] = filelib:wildcard(filename:join(Privdir,"ttb_upload_temptest*")), + begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(4), + ?line stopped = ttb:stop(), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line [_] = filelib:wildcard(filename:join(Privdir,"ttb_upload_temptest*")). + +basic_ttb_run_ip_port(suite) -> + []; +basic_ttb_run_ip_port(doc) -> + ["Basic ttb run ip port"]; +basic_ttb_run_ip_port(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(1, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(2, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(10, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +basic_ttb_run_file_port(suite) -> + []; +basic_ttb_run_file_port(doc) -> + ["Basic ttb run file port"]; +basic_ttb_run_file_port(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(1, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(2, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(10, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +return_fetch_dir_implies_fetch(suite) -> + []; +return_fetch_dir_implies_fetch(doc) -> + ["Return_fetch_dir implies fetch"]; +return_fetch_dir_implies_fetch(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_,_} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +logfile_name_in_fetch_dir(suite) -> + []; +logfile_name_in_fetch_dir(doc) -> + ["Logfile name in fetch dir"]; +logfile_name_in_fetch_dir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line {_,Dir} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line P1 = lists:nth(3, string:tokens(filename:basename(Dir), "_")), + ?line P2 = hd(string:tokens(P1, "-")), + ?line _File = P2. + +upload_to_my_logdir(suite) -> + []; +upload_to_my_logdir(doc) -> + ["Upload to my logdir"]; +upload_to_my_logdir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {stopped,_} = ttb:stop([return_fetch_dir, {fetch_dir, ?DIRNAME}]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line true = filelib:is_file(?DIRNAME), + ?line [] = filelib:wildcard("ttb_upload_"++?FNAME). + +upload_to_my_existing_logdir(suite) -> + []; +upload_to_my_existing_logdir(doc) -> + ["Upload to my existing logdir"]; +upload_to_my_existing_logdir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ok = file:make_dir(?DIRNAME), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {error,_,_} = (catch ttb:stop([return_fetch_dir, {fetch_dir, ?DIRNAME}])), + ?line {stopped,_} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +fetch_with_options_not_as_list(suite) -> + []; +fetch_with_options_not_as_list(doc) -> + ["Fetch with options not as list"]; +fetch_with_options_not_as_list(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {stopped, D} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line false = filelib:is_file(?OUTPUT), + ?line ttb:format(D, {out, ?OUTPUT}), + ?line true = filelib:is_file(?OUTPUT). + +error_when_formatting_multiple_files_4393(suite) -> + []; +error_when_formatting_multiple_files_4393(doc) -> + ["Error when formatting multiple files"]; +error_when_formatting_multiple_files_4393(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, Dir} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line Files = [filename:join(Dir, atom_to_list(ttb_helper:get_node(server)) ++ "-" ++ ?FNAME), + filename:join(Dir, atom_to_list(ttb_helper:get_node(client)) ++ "-" ++ ?FNAME)], + ?line ok = ttb:format(Files). + +format_on_trace_stop(suite) -> + []; +format_on_trace_stop(doc) -> + ["Format on trace stop"]; +format_on_trace_stop(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line ttb_helper:msgs_ip(2), + ?line file:delete("HANDLER_OK"), + ?line {_,_} = ttb:stop([fetch, return_fetch_dir, {format, {handler, marking_call_handler()}}]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line true = filelib:is_file("HANDLER_OK"), + ?line ok = file:delete("HANDLER_OK"). + +%% The following three tests are for the issue "fixes fetch fail when nodes on the same host +%% have different cwd" +trace_to_remote_files_on_localhost_with_different_pwd(suite) -> + []; +trace_to_remote_files_on_localhost_with_different_pwd(doc) -> + ["Trace to remote files on localhost with different pwd"]; +trace_to_remote_files_on_localhost_with_different_pwd(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(2, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +trace_to_local_files_on_localhost_with_different_pwd(suite) -> + []; +trace_to_local_files_on_localhost_with_different_pwd(doc) -> + ["Trace to local files on localhost with different pwd"]; +trace_to_local_files_on_localhost_with_different_pwd(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(2, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +trace_to_remote_files_on_localhost_with_different_pwd_abs(suite) -> + []; +trace_to_remote_files_on_localhost_with_different_pwd_abs(doc) -> + ["Trace to remote files on localhost with different pwd abs"]; +trace_to_remote_files_on_localhost_with_different_pwd_abs(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ok, Path} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line File = filename:join(Path, ?FNAME), + ?line check_size(2, File, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +%% Trace is not affected by changes of cwd on control node or remote nodes during tracing +%% (three tests) +changing_cwd_on_control_node(suite) -> + []; +changing_cwd_on_control_node(doc) -> + ["Changing cwd on control node during tracing is safe"]; +changing_cwd_on_control_node(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line NumMsgs = 3, + ?line ttb_helper:msgs(NumMsgs), + ?line ok = file:set_cwd(".."), + ?line ttb_helper:msgs(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +changing_cwd_on_control_node_with_local_trace(suite) -> + []; +changing_cwd_on_control_node_with_local_trace(doc) -> + ["Changing cwd on control node during local tracing is safe"]; +changing_cwd_on_control_node_with_local_trace(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line NumMsgs = 3, + ?line ttb_helper:msgs_ip(NumMsgs), + ?line ok = file:set_cwd(".."), + ?line ttb_helper:msgs_ip(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +changing_cwd_on_remote_node(suite) -> + []; +changing_cwd_on_remote_node(doc) -> + ["Changing cwd on remote node during tracing is safe"]; +changing_cwd_on_remote_node(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line NumMsgs = 2, + ?line ttb_helper:msgs(NumMsgs), + ?line ok = rpc:call(ClientNode, file, set_cwd, [".."]), + ?line ttb_helper:msgs(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +one_command_trace_setup(suite) -> + []; +one_command_trace_setup(doc) -> + ["One command trace setup"]; +one_command_trace_setup(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ttb:start_trace([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{file, ?FNAME}]), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line 5 = length(Ret). + +dbg_style_fetch(suite) -> + []; +dbg_style_fetch(doc) -> + ["Dbg style fetch"]; +dbg_style_fetch(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line ttb:start_trace([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{shell, only}]), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line ttb_helper:msgs(2), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line stopped, ttb:stop(format), + %%+1 -> ttb_last_trace + ?line true = (DirSize + 1 == length(element(2, file:list_dir(".")))), + ?line {ok,[{all, [{matched,_,_}, {matched,_,_}]}]} = + ttb:start_trace([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{shell, only}]), + ?line ttb:stop(), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +shell_tracing_init(suite) -> + []; +shell_tracing_init(doc) -> + ["Shell tracing init"]; +shell_tracing_init(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], shell), + ?line ttb:stop(), + ?line ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{file, {local, ?FNAME}}, shell]), + ?line ttb:stop(), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line local_client_required_on_shell_tracing = try ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{file, ?FNAME}, shell]) + catch + exit:local_client_required_on_shell_tracing -> + local_client_required_on_shell_tracing + end. + +only_one_state_for_format_handler(suite) -> + []; +only_one_state_for_format_handler(doc) -> + ["Only one state for format handler"]; +only_one_state_for_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, counter_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line [5] = Ret. + +only_one_state_with_default_format_handler(suite) -> + []; +only_one_state_with_default_format_handler(doc) -> + ["Only one state with default format handler"]; +only_one_state_with_default_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}]), + ?line true = filelib:is_file(?OUTPUT). + +only_one_state_with_initial_format_handler(suite) -> + []; +only_one_state_with_initial_format_handler(doc) -> + ["Only one state with initial format handler"]; +only_one_state_with_initial_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}, {handler, counter_call_handler()}]), + ?line ttb:p(all, call), + ?line ttb:tpl(server, received, []), + ?line ttb:tpl(client, put, []), + ?line ttb:tpl(client, get, []), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line [5] = Ret. + +run_trace_with_shortcut(Shortcut, Ret, F) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line ttb:p(all, call), + ?line ttb:F(client, put, Shortcut), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, ret_caller_call_handler()}]), + ?line {ok, Ret} =file:consult(?OUTPUT), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +fun_for(return) -> + {codestr, "fun(_) -> return_trace() end"}; +fun_for(msg_false) -> + {codestr, "fun(_) -> message(false) end"}. + +run_trace_with_shortcut1(suite) -> + []; +run_trace_with_shortcut1(doc) -> + ["Run trace with shortcut 1"]; +run_trace_with_shortcut1(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(caller, [ok,ok], tp), + ?line run_trace_with_shortcut(caller, [ok,ok], tpl). + +run_trace_with_shortcut2(suite) -> + []; +run_trace_with_shortcut2(doc) -> + ["Run trace with shortcut 2"]; +run_trace_with_shortcut2(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(return, [ok,ok], tp), + ?line run_trace_with_shortcut(return, [ok,ok], tpl). + +run_trace_with_shortcut3(suite) -> + []; +run_trace_with_shortcut3(doc) -> + ["Run trace with shortcut 3"]; +run_trace_with_shortcut3(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(fun_for(return), [ok,ok], tp), + ?line run_trace_with_shortcut(fun_for(return), [ok,ok], tpl). + +run_trace_with_shortcut4(suite) -> + []; +run_trace_with_shortcut4(doc) -> + ["Run trace with shortcut 4"]; +run_trace_with_shortcut4(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(fun_for(msg_false), [], tp), + ?line run_trace_with_shortcut(fun_for(msg_false), [], tpl). + +cant_specify_local_and_flush(suite) -> + []; +cant_specify_local_and_flush(doc) -> + ["Can't specify local and flush"]; +cant_specify_local_and_flush(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line flush_unsupported_with_ip_trace_port = try ttb:tracer([ServerNode, ClientNode], [{flush, 1000}, {file, {local, ?FNAME}}]) + catch + exit:flush_unsupported_with_ip_trace_port -> + flush_unsupported_with_ip_trace_port + end, + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +trace_sorted_by_default(suite) -> + []; +trace_sorted_by_default(doc) -> + ["Trace sorted by default"]; +trace_sorted_by_default(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FILE), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, node_call_handler()}, {disable_sort, false}]), + {ok, Ret} = file:consult(?OUTPUT), + ?line [ClientNode,ServerNode,ClientNode,ServerNode,ServerNode] = Ret. + +disable_sorting(suite) -> + []; +disable_sorting(doc) -> + ["Disable sorting"]; +disable_sorting(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FILE), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, node_call_handler()}, {disable_sort, true}]), + {ok, Ret} = file:consult(?OUTPUT), + ?line [ClientNode,ClientNode,ServerNode,ServerNode,ServerNode] = Ret. + +%% ----------------------------------------------------------------------------- +%% tests for autoresume of tracing +%% ----------------------------------------------------------------------------- + +trace_resumed_after_node_restart(suite) -> + []; +trace_resumed_after_node_restart(doc) -> + ["Test trace resumed after node restart, trace to files on remote node."]; +trace_resumed_after_node_restart(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, ?FNAME), + ?line logic(2,6,file). + +trace_resumed_after_node_restart_ip(suite) -> + []; +trace_resumed_after_node_restart_ip(doc) -> + ["Test trace resumed after node restart, trace via tcp/ip to local node."]; +trace_resumed_after_node_restart_ip(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {local, ?FNAME}), + ?line logic(2,6,local). + +trace_resumed_after_node_restart_wrap(suite) -> + []; +trace_resumed_after_node_restart_wrap(doc) -> + ["Test trace resumed after node restart, wrap option."]; +trace_resumed_after_node_restart_wrap(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {wrap, ?FNAME, 10, 4}), + ?line logic(1,4,file). + +trace_resumed_after_node_restart_wrap_mult(suite) -> + []; +trace_resumed_after_node_restart_wrap_mult(doc) -> + ["Test trace resumed after node restart, wrap option, multiple files."]; +trace_resumed_after_node_restart_wrap_mult(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {wrap, ?FNAME, 10, 4}), + ?line logic(20,8,file). + +logic(N, M, TracingType) -> + helper_msgs(N, TracingType), + ?t:stop_node(ttb_helper:get_node(client)), + timer:sleep(2500), + ?line {ok,ClientNode} = ?t:start_node(client,slave,[]), + ?line ok = ttb_helper:c(code, add_paths, [code:get_path()]), + ?line ttb_helper:c(client, init, []), + ?line helper_msgs(N, TracingType), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ttb_helper:get_node(server)), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, ret_caller_call_handler2()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line M = length(Ret). + +begin_trace_with_resume(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = ttb:tracer([ServerNode,ClientNode], [{file, Dest}, resume]), + ?line ttb:p(all, [call, timestamp]), + ?line ttb:tp(server, received, []), + ?line ttb:tp(client, put, []), + ?line ttb:tp(client, get, []). + +ret_caller_call_handler2() -> + {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (_, _, _, _) -> ok end, []}. + +helper_msgs(N, TracingType) -> + case TracingType of + local -> + ttb_helper:msgs_ip(N); + _ -> + ttb_helper:msgs(N) + end. diff --git a/lib/observer/test/ttb_helper.erl b/lib/observer/test/ttb_helper.erl new file mode 100644 index 0000000000..19fdc0e159 --- /dev/null +++ b/lib/observer/test/ttb_helper.erl @@ -0,0 +1,157 @@ +-module(ttb_helper). %%Nodes control +-compile(export_all). + +%%API +%%get() -> client:get() +%%put(X) -> client:put(X) +%%msgs(N) -> N times client:put(test_msg) +%%clear() -> restart server +%%ensure_running() / stop() -> start/stop nodes +%%get_node(atom) -> return atom@hostname + +-define(NODE_CMD(Name), + "erl -sname " ++ atom_to_list(Name) ++ + " -pa .. -pa . -detached -run ttb_helper send_ok"). +-define(REG_NAME, nc_testing). + +new_fun() -> + fun(_, end_of_trace, _, Dict) -> io:format("~p~n", [dict:to_list(Dict)]); + (_, T, _, Dict) -> case element(2, T) of + {Pid, _, _} -> + dict:update_counter(Pid, 1, Dict); + Pid -> + dict:update_counter(Pid, 1, Dict) + end + end. + +new_fun_2() -> + fun(_, end_of_trace, _, Dict) -> io:format("~p~n", [dict:to_list(Dict)]); + (_, T, _, Dict) -> case element(2, T) of + {_, Name, _} when is_atom(Name)-> + dict:update_counter(Name, 1, Dict); + Pid -> + dict:update_counter(Pid, 1, Dict) + end + + end. + + +ensure_running() -> + try_start_node(server), + try_start_node(client), + clear(). + +try_start_node(Node) -> + global:unregister_name(?REG_NAME), + global:register_name(?REG_NAME, self()), + global:sync(), + N = get_node(Node), + case net_adm:ping(N) of + pong -> + io:format("Node ~p already running~n", [N]); + _ -> + io:format("Starting node ~p... ~p ", [Node, os:cmd(?NODE_CMD(Node))]), + recv() + end. + +clear() -> + s(server, stop, []), + init(). + +stop() -> + s(init, stop, []), + c(init, stop, []). + +msgs(N) -> + [c(client, put, [test_msg]) || _ <- lists:seq(1, N)], + s(server, received, [a,b]), + [dbg:flush_trace_port(Node) || Node <- [get_node(client), get_node(server)]]. + +msgs_ip(N) -> + [c(client, put, [test_msg]) || _ <- lists:seq(1, N)], + s(server, received, [a,b]), + timer:sleep(100). %% allow trace messages to arrive over tcp/ip + +run() -> + ttb({local, "A"}), + msgs(2), + c(erlang, whereis, [ttbt]). + +get() -> c(client, get, []). +put(Thing) -> c(client, put, [Thing]). + +get_node(Node) -> + {ok, Host} = inet:gethostname(), + list_to_atom(atom_to_list(Node) ++ "@" ++ Host). + +trace_setup() -> + ttb:p(all, call), + ttb:tp(server, received, []), + ttb:tp(client, put, []), + ttb:tp(client, get, []). + +ttb() -> ttb("A"). +ttb(File) -> + ttb:tracer([get_node(client), get_node(server)], [{file, File}, resume]), + ttb:p(all, [call, timestamp]), + ttb:tp(client, put, []), + ttb:tp(client, get, []), + ttb:tp(server, received, []). + +tc() -> + TC = example_config_gen:create_trace_case("dummy comment"), + Patterns = example_config_gen:create_pattern(client, put, 1, return), + Flags = example_config_gen:create_flags(all, call), + Merge = example_config_gen:create_merge_conf(show_handler(), "dummy merge comment"), + Merge2 = example_config_gen:create_merge_conf(undefined, "dummy merge comment"), + TC2 = example_config_gen:add_pattern(Patterns, TC), + TC3 = example_config_gen:add_flags(Flags, TC2), + TC4 = example_config_gen:add_merge_conf(Merge, TC3), + TC5 = example_config_gen:add_merge_conf(Merge2, TC4), + example_config_gen:add_nodes([get_node(client), get_node(server)], TC5). + + +show(X) -> + io:format(user, "Showing: ~p~n", [X]). + +state_handler() -> + {fun(_,_,I,S) -> io:format(user, "Got from ~p: ~p~n", [I,S]), S+1 end, 0}. + +show_handler() -> + {fun(A,B,_,_) -> io:format(A, "~p~n", [B]) end, []}. + +opts() -> + [[get_node(client), get_node(server)], + [{server, received, '_', []}, + {client, put, '_', []}, + {client, get, '_', []}], + {all, call}, + [{file, "TEST"}]]. + +overload_check(check) -> + true; +overload_check(_) -> + ok. +%%%Internal +s(M, F, A) -> rpc:call(get_node(server), M, F, A). +c(M, F, A) -> rpc:call(get_node(client), M, F, A). + +send_ok() -> + pong = net_adm:ping(get_node(test)), + global:sync(), + global:send(?REG_NAME, node()). + +init() -> + True = s(server, start, []), + io:format("ok1: ~p~n", [True]), + true = c(client, init, [get_node(server)]). + +recv() -> + receive + Node -> + io:format("Node ~p ready.~n", [Node]), + ok + after 5000 -> + io:format("Startup failed~n",[]), + throw(startup_failed) + end. diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 4f831f3dd8..46b570210a 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -46,7 +46,8 @@ MODULES= \ runtime_tools_sup \ dbg \ percept_profile \ - observer_backend + observer_backend \ + ttb_autostart HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 0f428de07a..9c1f9da5b1 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -31,6 +31,7 @@ ttb_write_binary/2, ttb_stop/1, ttb_fetch/2, + ttb_resume_trace/0, ttb_get_filenames/1]). -define(CHUNKSIZE,8191). % 8 kbytes - 1 byte @@ -92,16 +93,22 @@ etop_collect([], Acc) -> Acc. %% %% ttb backend %% -ttb_init_node(MetaFile,PI,Traci) -> +ttb_init_node(MetaFile_0,PI,Traci) -> if - is_list(MetaFile); - is_atom(MetaFile) -> + is_list(MetaFile_0); + is_atom(MetaFile_0) -> + {ok, Cwd} = file:get_cwd(), + MetaFile = filename:join(Cwd, MetaFile_0), file:delete(MetaFile); true -> % {local,_,_} - ok + MetaFile = MetaFile_0 + end, + case proplists:get_value(resume, Traci) of + {true, _} -> (autostart_module()):write_config(Traci); + _ -> ok end, Self = self(), - MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self) end), + MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self,Traci) end), receive {MetaPid,started} -> ok end, MetaPid ! {metadata,Traci}, case PI of @@ -111,13 +118,14 @@ ttb_init_node(MetaFile,PI,Traci) -> false -> ok end, - {ok,MetaPid}. + {ok,MetaFile,MetaPid}. ttb_write_trace_info(MetaPid,Key,What) -> MetaPid ! {metadata,Key,What}, ok. -ttb_meta_tracer(MetaFile,PI,Parent) -> +ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> + erlang:monitor(process, proplists:get_value(ttb_control, SessionData)), case PI of true -> ReturnMS = [{'_',[],[{return_trace}]}], @@ -130,22 +138,29 @@ ttb_meta_tracer(MetaFile,PI,Parent) -> ok end, Parent ! {self(),started}, - ttb_meta_tracer_loop(MetaFile,PI,dict:new()). + case proplists:get_value(overload_check, SessionData) of + {Ms, M, F} -> + catch M:F(init), + erlang:send_after(Ms, self(), overload_check); + _ -> + ok + end, + ttb_meta_tracer_loop(MetaFile,PI,dict:new(),SessionData). -ttb_meta_tracer_loop(MetaFile,PI,Acc) -> +ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> receive {trace_ts,_,call,{erlang,register,[Name,Pid]},_} -> ttb_store_meta({pid,{Pid,Name}},MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,_,call,{global,register_name,[Name,Pid]},_} -> ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,CallingPid,call,{erlang,spawn_opt,[{M,F,Args,_}]},_} -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,return_from,{erlang,spawn_opt,_Arity},Ret,_} -> case Ret of {NewPid,_Mref} when is_pid(NewPid) -> ok; @@ -158,14 +173,14 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc) -> T end, Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,call,{erlang,Spawn,[M,F,Args]},_} when Spawn==spawn;Spawn==spawn_link -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,return_from,{erlang,Spawn,_Arity},NewPid,_} when Spawn==spawn;Spawn==spawn_link -> @@ -176,28 +191,53 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc) -> T end, Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {metadata,Data} when is_list(Data) -> ttb_store_meta(Data,MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,Fun} when is_function(Fun) -> ttb_store_meta([{Key,Fun()}],MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,What} -> ttb_store_meta([{Key,What}],MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); - - stop when PI=:=true -> - erlang:trace_pattern({erlang,spawn,3},false,[meta]), + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); + overload_check -> + {Ms, M, F} = proplists:get_value(overload_check, State), + case catch M:F(check) of + true -> + erlang:trace(all, false, [all]), + ControlPid = proplists:get_value(ttb_control, State), + ControlPid ! {node_overloaded, node()}, + catch M:F(stop), + ttb_meta_tracer_loop(MetaFile,PI,Acc,lists:keydelete(overload_check, 1, State)); + _ -> + erlang:send_after(Ms, self(), overload_check), + ttb_meta_tracer_loop(MetaFile,PI,Acc, State) + end; + {'DOWN', _, _, _, _} -> + stop_seq_trace(), + self() ! stop, + ttb_meta_tracer_loop(MetaFile,PI,Acc, State); + stop when PI=:=true -> + try_stop_resume(State), + try_stop_overload_check(State), + erlang:trace_pattern({erlang,spawn,3},false,[meta]), erlang:trace_pattern({erlang,spawn_link,3},false,[meta]), erlang:trace_pattern({erlang,spawn_opt,1},false,[meta]), erlang:trace_pattern({erlang,register,2},false,[meta]), erlang:trace_pattern({global,register_name,2},false,[meta]); stop -> - ok + try_stop_resume(State), + try_stop_overload_check(State) + end. + +try_stop_overload_check(State) -> + case proplists:get_value(overload, State) of + undefined -> ok; + {_, M, F} -> catch M:F(stop) end. pnames() -> @@ -222,6 +262,40 @@ pinfo(P,Globals) -> undefined -> [] % the process has terminated end. +autostart_module() -> + element(2, application:get_env(runtime_tools, ttb_autostart_module)). + +try_stop_resume(State) -> + case proplists:get_value(resume, State) of + true -> (autostart_module()):delete_config(); + _ -> ok + end. + +ttb_resume_trace() -> + case (autostart_module()):read_config() of + {error, _} -> + ok; + {ok, Data} -> + Pid = proplists:get_value(ttb_control, Data), + {_, Timeout} = proplists:get_value(resume, Data), + case rpc:call(node(Pid), erlang, whereis, [ttb]) of + Pid -> + Pid ! {noderesumed, node(), self()}, + wait_for_fetch_ready(Timeout); + _ -> + ok + end, + (autostart_module()):delete_config(), + ok + end. + +wait_for_fetch_ready(Timeout) -> + receive + trace_resumed -> + ok + after Timeout -> + ok + end. ttb_store_meta(Data,{local,MetaFile,Port}) when is_list(Data) -> ttb_send_to_port(Port,MetaFile,Data); @@ -273,6 +347,9 @@ ttb_stop(MetaPid) -> %% returns, and then the Port (in {local,MetaFile,Port}) %% cannot be accessed any more. receive {'DOWN', Ref, process, MetaPid, _Info} -> ok end, + stop_seq_trace(). + +stop_seq_trace() -> seq_trace:reset_trace(), seq_trace:set_system_tracer(false). @@ -287,7 +364,7 @@ ttb_fetch(MetaFile,{Port,Host}) -> send_files({Sock,Host},[File|Files]) -> {ok,Fd} = file:open(File,[raw,read,binary]), - gen_tcp:send(Sock,<<1,(list_to_binary(File))/binary>>), + gen_tcp:send(Sock,<<1,(list_to_binary(filename:basename(File)))/binary>>), send_chunks(Sock,Fd), file:delete(File), send_files({Sock,Host},Files); diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index e6dc7a21d4..095567b165 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {modules, [dbg,observer_backend,percept_profile, inviso_rt,inviso_rt_lib,inviso_rt_meta, inviso_as_lib,inviso_autostart,inviso_autostart_server, - runtime_tools,runtime_tools_sup,erts_alloc_config]}, + runtime_tools,runtime_tools_sup,erts_alloc_config, + ttb_autostart]}, {registered, [runtime_tools_sup,inviso_rt,inviso_rt_meta]}, {applications, [kernel, stdlib]}, % {env, [{inviso_autostart_mod,your_own_autostart_module}]}, diff --git a/lib/runtime_tools/src/runtime_tools_sup.erl b/lib/runtime_tools/src/runtime_tools_sup.erl index 1a872c355d..4fcb2292d0 100644 --- a/lib/runtime_tools/src/runtime_tools_sup.erl +++ b/lib/runtime_tools/src/runtime_tools_sup.erl @@ -38,6 +38,8 @@ init(AutoModArgs) -> Flags = {one_for_one, 0, 3600}, Children = [{inviso_rt, {inviso_rt, start_link_auto, [AutoModArgs]}, - temporary, 3000, worker, [inviso_rt]}], + temporary, 3000, worker, [inviso_rt]}, + {ttb_autostart, {ttb_autostart, start_link, []}, + temporary, 3000, worker, [ttb_autostart]}], {ok, {Flags, Children}}. %% ----------------------------------------------------------------------------- diff --git a/lib/runtime_tools/src/ttb_autostart.erl b/lib/runtime_tools/src/ttb_autostart.erl new file mode 100644 index 0000000000..4c6971c119 --- /dev/null +++ b/lib/runtime_tools/src/ttb_autostart.erl @@ -0,0 +1,55 @@ +%%%------------------------------------------------------------------- +%%% File : ttb_autostart.erl +%%% Author : Bartłomiej Puzoń <[email protected]> +%%% Description : This supervisor is used to resume ttb tracing +%%% Users are able to provide custom restart modules for *_config, as +%%% file:write/read/delete may not be possible on diskless nodes. +%%% +%%% Created : 31 Jul 2010 by <[email protected]> +%%%------------------------------------------------------------------- +-module(ttb_autostart). + +-behaviour(gen_server). + +%% API +-export([start_link/0, + read_config/0, + write_config/1, + delete_config/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(DEF_AUTOSTART_MODULE, ?MODULE). +-define(AUTOSTART_FILENAME, "ttb_autostart.bin"). + +start_link() -> + gen_server:start_link(?MODULE, no_args, []). + +delete_config() -> + file:delete(?AUTOSTART_FILENAME). + +read_config() -> + case file:read_file(?AUTOSTART_FILENAME) of + {ok, Data} -> {ok, binary_to_term(Data)}; + Error -> Error + end. + +write_config(Data) -> + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + +init(no_args) -> + case application:get_env(runtime_tools, ttb_autostart_module) of + {ok, _} -> ok; + undefined -> application:set_env(runtime_tools, ttb_autostart_module, ?DEF_AUTOSTART_MODULE) + end, + observer_backend:ttb_resume_trace(), + %%As the process is not needed any more, it will shut itself down + {ok, no_args, 10000}. + +handle_call(_,_,_) -> {noreply, no_args}. +handle_cast(_,_) -> {noreply, no_args}. +handle_info(timeout,_) -> {stop, normal, no_args}. +terminate(_,_) -> ok. +code_change(_,_,_) -> {ok, no_args}. diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index 4f01f5f559..bc08f94dff 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -174,7 +174,7 @@ check_install_release(Vsn, Opts) -> check_check_install_options([purge|Opts], _) -> check_check_install_options(Opts, true); -check_check_install_options([Illegal|_],Purge) -> +check_check_install_options([Illegal|_],_Purge) -> {error,{illegal_option,Illegal}}; check_check_install_options([],Purge) -> {ok,Purge}. @@ -2001,7 +2001,7 @@ safe_write_file_m(File, Data, Masters) -> %% 'update_paths' option to release_handler:install_release/2 if the %% code path shall be updated then. %% ----------------------------------------------------------------- -get_new_libs([{App,Vsn,LibDir}|CurrentLibs], NewLibs) -> +get_new_libs([{App,Vsn,_LibDir}|CurrentLibs], NewLibs) -> case lists:keyfind(App,1,NewLibs) of {App,NewVsn,_} = LibInfo when NewVsn =/= Vsn -> [LibInfo | get_new_libs(CurrentLibs,NewLibs)]; diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 7489ee58d2..5dc83e7b2a 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1612,9 +1612,9 @@ var_dir(_Dir, _, _, []) -> false. appDir(AppDir) -> - case reverse(filename:split(AppDir)) of - ["ebin"|Dir] -> filename:join(reverse(Dir)); - _ -> AppDir + case filename:basename(AppDir) of + "ebin" -> filename:dirname(AppDir); + _ -> AppDir end. add_modules(Modules, Tar, AppDir, ToDir, Ext) -> diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 9190b111ef..539f6de99d 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -48,7 +48,7 @@ included_fail_script/1, included_bug_script/1, exref_script/1]). -export([ tar_options/1, normal_tar/1, no_mod_vsn_tar/1, variable_tar/1, src_tests_tar/1, shadow_tar/1, var_tar/1, - exref_tar/1, link_tar/1]). + exref_tar/1, link_tar/1, otp_9507/1]). -export([ normal_relup/1, abnormal_relup/1, no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, otp_3065/1]). -export([ @@ -81,7 +81,7 @@ groups() -> {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, variable_tar, src_tests_tar, shadow_tar, var_tar, - exref_tar, link_tar]}, + exref_tar, link_tar, otp_9507]}, {relup, [], [normal_relup, abnormal_relup, no_appup_relup, bad_appup_relup, app_start_type_relup]}, @@ -1066,6 +1066,48 @@ exref_tar(Config) when is_list(Config) -> ?line ok = file:set_cwd(OldDir), ok. + + +%% otp_9507 +%% +otp_9507(suite) -> []; +otp_9507(doc) -> + ["make_tar failed when path given as just 'ebin'."]; +otp_9507(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + + ?line {LatestDir, LatestName} = create_script(latest_small,Config), + + ?line DataDir = filename:absname(?copydir), + ?line LibDir = fname([DataDir, d_normal, lib]), + ?line FeDir = fname([LibDir, 'fe-3.1']), + + ?line ok = file:set_cwd(FeDir), + + RelName = fname([LatestDir,LatestName]), + + ?line P1 = ["./ebin", + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin])], + ?line {ok, _, _} = systools:make_script(RelName, [silent, {path, P1}]), + ?line ok = systools:make_tar(RelName, [{path, P1}]), + ?line Content1 = tar_contents(RelName), + + ?line P2 = ["ebin", + fname([DataDir, lib, kernel, ebin]), + fname([DataDir, lib, stdlib, ebin])], + + %% Tickets solves the following line - it used to fail with + %% {function_clause,[{filename,join,[[]]},...} + ?line ok = systools:make_tar(RelName, [{path, P2}]), + ?line Content2 = tar_contents(RelName), + true = (Content1 == Content2), + + ?line ok = file:set_cwd(OldDir), + + ok. + + %% The relup stuff. %% %% diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 7bcc12eb5f..a2c7370ddc 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2000</year><year>2010</year> + <year>2000</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -33,36 +33,32 @@ </header> <p>This chapter describes how the Erlang distribution can use SSL to get additional verification and security. - - <note><p>Note this - documentation is written for the old ssl implementation and - will be updated for the new one once this functionality is - supported by the new implementation.</p></note> </p> <section> <title>Introduction</title> <p>The Erlang distribution can in theory use almost any connection based protocol as bearer. A module that implements the protocol - specific parts of connection setup is however needed. The + specific parts of the connection setup is however needed. The default distribution module is <c>inet_tcp_dist</c> which is included in the Kernel application. When starting an Erlang node distributed, <c>net_kernel</c> uses this module to setup listen ports and connections. </p> - <p>In the SSL application there is an additional distribution - module, <c>inet_ssl_dist</c> which can be used as an + + <p>In the SSL application there is an additional distribution + module, <c>inet_tls_dist</c> which can be used as an alternative. All distribution connections will be using SSL and all participating Erlang nodes in a distributed system must use this distribution module.</p> - <p>The security depends on how the connections are set up, one can - use key files or certificates to just get a encrypted - connection. One can also make the SSL package verify the - certificates of other nodes to get additional security. - Cookies are however always used as they can be used to - differentiate between two different Erlang networks.</p> + + <p>The security level depends on the parameters provided to the + SSL connection setup. Erlang node cookies are however always + used, as they can be used to differentiate between two different + Erlang networks.</p> <p>Setting up Erlang distribution over SSL involves some simple but necessary steps:</p> - <list type="bulleted"> + + <list type="bulleted"> <item>Building boot scripts including the SSL application</item> <item>Specifying the distribution module for net_kernel</item> <item>Specifying security options and other SSL options</item> @@ -77,122 +73,135 @@ SASL application. Refer to the SASL documentations for more information on systools. This is only an example of what can be done.</p> - <p>The simplest boot script possible includes only the Kernel + + <p>The simplest boot script possible includes only the Kernel and STDLIB applications. Such a script is located in the Erlang distributions bin directory. The source for the script can be found under the Erlang installation top directory under - <c><![CDATA[releases/<OTP version>start_clean.rel]]></c>. Copy that + <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>. Copy that script to another location (and preferably another name) - and add the SSL application with its current version number + and add the applications crypto, public_key and SSL with their current version numbers after the STDLIB application.</p> <p>An example .rel file with SSL added may look like this:</p> + <code type="none"> -{release, {"OTP APN 181 01","P7A"}, {erts, "5.0"}, - [{kernel,"2.5"}, - {stdlib,"1.8.1"}, - {ssl,"2.2.1"}]}. </code> - <p>Note that the version numbers surely will differ in your system. - Whenever one of the applications included in the script is - upgraded, the script has to be changed.</p> - <p>Assuming the above .rel file is stored in a file - <c>start_ssl.rel</c> in the current directory, a boot script - can be built like this:</p> - <code type="none"> -1> systools:make_script("start_ssl",[]). </code> - <p>There will now be a file <c>start_ssl.boot</c> in the current - directory. To test the boot script, start Erlang with the - <c>-boot</c> command line parameter specifying this boot script - (with its full path but without the <c>.boot</c> suffix), in - Unix it could look like this:</p> - <p></p> - <code type="none"><![CDATA[ + {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"}, + [{kernel,"2.15"}, + {stdlib,"1.18"}, + {crypto, "2.0.3"}, + {public_key, "0.12"}, + {ssl, "5.0"} + ]}. + </code> + + <p>Note that the version numbers surely will differ in your system. + Whenever one of the applications included in the script is + upgraded, the script has to be changed.</p> + <p>Assuming the above .rel file is stored in a file + <c>start_ssl.rel</c> in the current directory, a boot script + can be built like this:</p> + + <code type="none"> + 1> systools:make_script("start_ssl",[]). </code> + + <p>There will now be a file <c>start_ssl.boot</c> in the current + directory. To test the boot script, start Erlang with the + <c>-boot</c> command line parameter specifying this boot script + (with its full path but without the <c>.boot</c> suffix), in + Unix it could look like this:</p> + <p></p> + + <code type="none"><![CDATA[ $ erl -boot /home/me/ssl/start_ssl Erlang (BEAM) emulator version 5.0 Eshell V5.0 (abort with ^G) -1> whereis(ssl_server). -<0.32.0> ]]></code> +1> whereis(ssl_manager). +<0.41.0> ]]></code> <p>The <c>whereis</c> function call verifies that the SSL application is really started.</p> - <p>As an alternative to building a bootscript, one can explicitly - add the path to the ssl <c>ebin</c> directory on the command + + <p>As an alternative to building a bootscript, one can explicitly + add the path to the SSL <c>ebin</c> directory on the command line. This is done with the command line option <c>-pa</c>. This - works as the ssl application really need not be started for the - distribution to come up, a primitive version of the ssl server - is started by the distribution module itself, so as long as the - primitive code server can reach the code, the distribution will + works as the SSL application does not need to be started for the + distribution to come up, as a clone of the SSL application is + hooked into the kernel application, so as long as the + SSL applications code can be reached, the distribution will start. The <c>-pa</c> method is only recommended for testing purposes.</p> + + <note><p>Note that the clone of the SSL application is necessary to + enable the use of the SSL code in such an early bootstage as + needed to setup the distribution, however this will make it + impossible to soft upgrade the SSL application.</p></note> </section> <section> <title>Specifying distribution module for net_kernel</title> - <p>The distribution module for SSL is named <c>inet_ssl_dist</c> - and is specified on the command line whit the <c>-proto_dist</c> + <p>The distribution module for SSL is named <c>inet_tls_dist</c> + and is specified on the command line with the <c>-proto_dist</c> option. The argument to <c>-proto_dist</c> should be the module name without the <c>_dist</c> suffix, so this distribution - module is specified with <c>-proto_dist inet_ssl</c> on the + module is specified with <c>-proto_dist inet_tls</c> on the command line.</p> <p></p> + <p>Extending the command line from above gives us the following:</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl </code> - <p>For the distribution to actually be started, we need to give - the emulator a name as well:</p> +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </code> + +<p>For the distribution to actually be started, we need to give +the emulator a name as well:</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl -sname ssl_test +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> <p>Note however that a node started in this way will refuse to talk - to other nodes, as no certificates or key files are supplied + to other nodes, as no ssl parameters are supplied (see below).</p> - <p>When the SSL distribution starts, the OTP system is in its - early boot stage, why neither <c>application</c> nor <c>code</c> - are usable. As SSL needs to start a port program in this early - stage, it tries to determine the path to that program from the - primitive code loaders code path. If this fails, one need to - specify the directory where the port program resides. This can - be done either with an environment variable - <c>ERL_SSL_PORTPROGRAM_DIR</c> or with the command line option - <c>-ssl_portprogram_dir</c>. The value should be the directory - where the <c>ssl_esock</c> port program is located. Note that - this option is never needed in a normal Erlang installation.</p> </section> <section> - <title>Specifying security options and other SSL options</title> - <p>For SSL to work, you either need certificate files or a - key file. Certificate files can be specified both when working as - client and as server (connecting or accepting). </p> - <p></p> + <title>Specifying SSL options</title> <p>For SSL to work, at least + a public key and certificate needs to be specified for the server + side. In the following example the PEM-files consists of two + entries the servers certificate and its private key.</p> + <p>On the <c>erl</c> command line one can specify options that the - ssl distribution will add when creation a socket. It is - mandatory to specify at least a key file or client and server - certificates. One can specify any <em>SSL option</em> on the - command line, but must not specify any socket options (like - packet size and such). The SSL options are listed in the - Reference Manual. The only difference between the - options in the reference manual and the ones that can be - specified to the distribution on the command line is that - <c>certfile</c> can (and usually needs to) be specified as - <c>client_certfile</c> and <c>server_certfile</c>. The - <c>client_certfile</c> is used when the distribution initiates a - connection to another node and the <c>server_certfile</c> is used - when accepting a connection from a remote node. </p> - <p>The command line argument for specifying the SSL options is named - <c>-ssl_dist_opt</c> and should be followed by an even number of - SSL options/option values. The <c>-ssl_dist_opt</c> argument can - be repeated any number of times.</p> - <p>An example command line would now look something like this + SSL distribution will add when creating a socket.</p> + + <p>One can specify the simpler SSL options certfile, keyfile, + password, cacertfile, verify, reuse_sessions, + secure_renegotiation, depth, hibernate_after and ciphers (use old + string format) by adding the prefix server_ or client_ to the + option name. The server can also take the options dhfile and + fail_if_no_peer_cert (also prefixed). + <c>client_</c>-prfixed options are used when the distribution initiates a + connection to another node and the <c>server_</c>-prefixed options are used + when accepting a connection from a remote node. </p> + + <p> More complex options such as verify_fun are not available at + the moment but a mechanism to handle such options may be added in + a future release. </p> + + <p> Raw socket options such as packet and size must not be specified on + the command line</p>. + + <p>The command line argument for specifying the SSL options is named + <c>-ssl_dist_opt</c> and should be followed by pairs of + SSL options and their values. The <c>-ssl_dist_opt</c> argument can + be repeated any number of times.</p> + + <p>An example command line would now look something like this (line breaks in the command are for readability, they should not be there when typed):</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl - -ssl_dist_opt client_certfile "/home/me/ssl/erlclient.pem" +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" - -ssl_dist_opt verify 1 depth 1 + -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -211,12 +220,11 @@ Eshell V5.0 (abort with ^G) subsequent invocations of Erlang.</p> <p></p> <p>In a Unix (Bourne) shell it could look like this (line breaks for - readability):</p> + readability, they should not be there when typed):</p> <code type="none"> -$ ERL_FLAGS="-boot \\"/home/me/ssl/start_ssl\\" -proto_dist inet_ssl - -ssl_dist_opt client_certfile \\"/home/me/ssl/erlclient.pem\\" - -ssl_dist_opt server_certfile \\"/home/me/ssl/erlserver.pem\\" - -ssl_dist_opt verify 1 -ssl_dist_opt depth 1" +$ ERL_FLAGS="-boot /home/me/ssl/start_ssl -proto_dist inet_tls + -ssl_dist_opt server_certfile /home/me/ssl/erlserver.pem + -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true" $ export ERL_FLAGS $ erl -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -227,15 +235,12 @@ Eshell V5.0 (abort with ^G) {progname,["erl "]}, {sname,["ssl_test"]}, {boot,["/home/me/ssl/start_ssl"]}, - {proto_dist,["inet_ssl"]}, - {ssl_dist_opt,["client_certfile","/home/me/ssl/erlclient.pem"]}, + {proto_dist,["inet_tls"]}, {ssl_dist_opt,["server_certfile","/home/me/ssl/erlserver.pem"]}, - {ssl_dist_opt,["verify","1"]}, - {ssl_dist_opt,["depth","1"]}, + {ssl_dist_opt,["server_secure_renegotiation","true", + "client_secure_renegotiate","true"] {home,["/home/me"]}] </code> <p>The <c>init:get_arguments()</c> call verifies that the correct arguments are supplied to the emulator. </p> </section> </chapter> - - diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index ca5cc8bc7a..17268a634d 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2010</year> + <year>2003</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -25,18 +25,18 @@ <file>ssl_protocol.xml</file> </header> - <p>The erlang ssl application currently supports SSL 3.0 and TLS 1.0 + <p>The erlang SSL application currently supports SSL 3.0 and TLS 1.0 RFC 2246, and will in the future also support later versions of TLS. SSL 2.0 is not supported. </p> - <p>By default erlang ssl is run over the TCP/IP protocol even + <p>By default erlang SSL is run over the TCP/IP protocol even though you could plug in any other reliable transport protocol with the same API as gen_tcp.</p> <p>If a client and server wants to use an upgrade mechanism, such as - defined by RFC2817, to upgrade a regular TCP/IP connection to an ssl - connection the erlang ssl API supports this. This can be useful for + defined by RFC2817, to upgrade a regular TCP/IP connection to an SSL + connection the erlang SSL API supports this. This can be useful for things such as supporting HTTP and HTTPS on the same port and implementing virtual hosting. </p> @@ -131,7 +131,7 @@ connections. Sessions are used to avoid the expensive negotiation of new security parameters for each connection."</p> - <p>Session data is by default kept by the ssl application in a + <p>Session data is by default kept by the SSL application in a memory storage hence session data will be lost at application restart or takeover. Users may define their own callback module to handle session data storage if persistent data storage is @@ -140,8 +140,8 @@ possible to configure the amount of time the session data should be saved.</p> - <p>Ssl clients will by default try to reuse an available session, - ssl servers will by default agree to reuse sessions when clients + <p>SSL clients will by default try to reuse an available session, + SSL servers will by default agree to reuse sessions when clients ask to do so.</p> </section> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 7514ad2aa2..9c40d4ea53 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -43,10 +43,12 @@ MODULES= \ ssl_app \ ssl_broker \ ssl_broker_sup \ + ssl_dist_sup\ ssl_server \ ssl_sup \ ssl_prim \ inet_ssl_dist \ + inet_tls_dist \ ssl_certificate\ ssl_certificate_db\ ssl_cipher \ @@ -62,6 +64,7 @@ MODULES= \ ssl_ssl2 \ ssl_ssl3 \ ssl_tls1 \ + ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \ diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl index 6c0fbc0618..42a03a4879 100644 --- a/lib/ssl/src/inet_ssl_dist.erl +++ b/lib/ssl/src/inet_ssl_dist.erl @@ -31,9 +31,7 @@ -import(error_logger,[error_msg/2]). --include("net_address.hrl"). - - +-include_lib("kernel/include/net_address.hrl"). -define(to_port(Socket, Data, Opts), case ssl_prim:send(Socket, Data, Opts) of @@ -44,9 +42,8 @@ R end). - --include("dist.hrl"). --include("dist_util.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). %% ------------------------------------------------------------- %% This function should return a valid childspec, so that diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl new file mode 100644 index 0000000000..f42c076460 --- /dev/null +++ b/lib/ssl/src/inet_tls_dist.erl @@ -0,0 +1,275 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(inet_tls_dist). + +-export([childspecs/0, listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). + +-include_lib("kernel/include/net_address.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). + +childspecs() -> + {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, + permanent, 2000, worker, [ssl_dist_sup]}]}. + +select(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_,_Host] -> + true; + _ -> + false + end. + +is_node_name(Node) when is_atom(Node) -> + select(Node); +is_node_name(_) -> + false. + +listen(Name) -> + ssl_tls_dist_proxy:listen(Name). + +accept(Listen) -> + ssl_tls_dist_proxy:accept(Listen). + +accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + Kernel = self(), + spawn_link(fun() -> do_accept(Kernel, AcceptPid, Socket, + MyNode, Allowed, SetupTime) end). + +setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + Kernel = self(), + spawn(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end). + +do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + [Name, Address] = splitnode(Node, LongOrShortNames), + case inet:getaddr(Address, inet) of + {ok, Ip} -> + Timer = dist_util:start_timer(SetupTime), + case erl_epmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + ?trace("port_please(~p) -> version ~p~n", + [Node,Version]), + dist_util:reset_timer(Timer), + case ssl_tls_dist_proxy:connect(Ip, TcpPort) of + {ok, Socket} -> + HSData = connect_hs_data(Kernel, Node, MyNode, Socket, + Timer, Version, Ip, TcpPort, Address, + Type), + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% port_please ! + ?trace("other node (~p) " + "closed since port_please.~n", + [Node]), + ?shutdown(Node) + end; + _ -> + ?trace("port_please (~p) " + "failed.~n", [Node]), + ?shutdown(Node) + end; + _Other -> + ?trace("inet_getaddr(~p) " + "failed (~p).~n", [Node,Other]), + ?shutdown(Node) + end. + +close(Socket) -> + try + erlang:error(foo) + catch _:_ -> + io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()]) + end, + gen_tcp:close(Socket), + ok. + +do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + process_flag(priority, max), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(Socket) of + true -> + HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed), + dist_util:handshake_other_started(HSData); + {false,IP} -> + error_logger:error_msg("** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown(no_node) + end + end. +%% ------------------------------------------------------------ +%% Do only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(Socket) -> + case application:get_env(check_ip) of + {ok, true} -> + case get_ifs(Socket) of + {ok, IFs, IP} -> + check_ip(IFs, IP); + _ -> + ?shutdown(no_node) + end; + _ -> + true + end. + +get_ifs(Socket) -> + case ssl_prim:peername(Socket) of + {ok, {IP, _}} -> + case ssl_prim:getif(Socket) of + {ok, IFs} -> {ok, IFs, IP}; + Error -> Error + end; + Error -> + Error + end. + +check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip([], PeerIP) -> + {false, PeerIP}. + +mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4}; + +mask({M1,M2,M3,M4, M5, M6, M7, M8}, {IP1,IP2,IP3,IP4, IP5, IP6, IP7, IP8}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4, + M5 band IP5, + M6 band IP6, + M7 band IP7, + M8 band IP8}. + + +%% If Node is illegal terminate the connection setup!! +splitnode(Node, LongOrShortNames) -> + case split_node(atom_to_list(Node), $@, []) of + [Name|Tail] when Tail =/= [] -> + Host = lists:append(Tail), + check_node(Name, Node, Host, LongOrShortNames); + [_] -> + error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown(Node); + _ -> + error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown(Node) + end. + +check_node(Name, Node, Host, LongOrShortNames) -> + case split_node(Host, $., []) of + [_] when LongOrShortNames == longnames -> + error_logger:error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + [_, _ | _] when LongOrShortNames == shortnames -> + error_logger:error_msg("** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + _ -> + [Name, Host] + end. + +split_node([Chr|T], Chr, Ack) -> + [lists:reverse(Ack)|split_node(T, Chr, [])]; +split_node([H|T], Chr, Ack) -> + split_node(T, Chr, [H|Ack]); +split_node([], _, Ack) -> + [lists:reverse(Ack)]. + +connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) -> + common_hs_data(Kernel, MyNode, Socket, Timer, + #hs_data{other_node = Node, + other_version = Version, + f_address = + fun(_,_) -> + #net_address{address = {Ip,TcpPort}, + host = Address, + protocol = proxy, + family = inet} + end, + request_type = Type + }). + +accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> + common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ + allowed = Allowed, + f_address = fun(S, N) -> + ssl_tls_dist_proxy:get_remote_id(S, N) + end + }). + +common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> + HsData#hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + socket = Socket, + timer = Timer, + this_flags = 0, + f_send = + fun(S,D) -> + gen_tcp:send(S,D) + end, + f_recv = + fun(S,N,T) -> + gen_tcp:recv(S,N,T) + end, + f_setopts_pre_nodeup = + fun(S) -> + inet:setopts(S, [{active, false}, {packet, 4}]) + end, + f_setopts_post_nodeup = + fun(S) -> + inet:setopts(S, [{deliver, port},{active, true}]) + end, + f_getll = + fun(S) -> + inet:getll(S) + end, + mf_tick = + fun(S) -> + gen_tcp:send(S, <<>>) + end, + mf_getstat = + fun(S) -> + {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]), + R = proplists:get_value(recv_cnt, Stats, 0), + W = proplists:get_value(send_cnt, Stats, 0), + P = proplists:get_value(send_pend, Stats, 0), + {ok, R,W,P} + end}. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index b9716786e6..afe19da900 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -8,6 +8,9 @@ ssl_broker, ssl_broker_sup, ssl_prim, + inet_tls_dist, + ssl_tls_dist_proxy, + ssl_dist_sup, inet_ssl_dist, ssl_tls1, ssl_ssl3, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 6074dab3ca..55510e41e9 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -99,11 +99,11 @@ stop() -> application:stop(ssl). %%-------------------------------------------------------------------- --spec connect(host() | inet:port_number(), [connect_option()]) -> {ok, #sslsocket{}} | +-spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | inet:port_number(), [connect_option()] | inet:port_number(), timeout() | list()) -> +-spec connect(host() | port(), [connect_option()] | inet:port_number(), timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | inet:port_number(), inet:port_number(), list(), timeout()) -> +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% @@ -742,7 +742,8 @@ handle_options(Opts0, _Role) -> secure_renegotiate = handle_option(secure_renegotiate, Opts, false), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), debug = handle_option(debug, Opts, []), - hibernate_after = handle_option(hibernate_after, Opts, undefined) + hibernate_after = handle_option(hibernate_after, Opts, undefined), + erl_dist = handle_option(erl_dist, Opts, false) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -751,7 +752,7 @@ handle_options(Opts0, _Role) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after], + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -862,6 +863,9 @@ validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; +validate_option(erl_dist,Value) when Value == true; + Value == false -> + Value; validate_option(Opt, Value) -> throw({error, {eoptions, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 5187d0f78f..049354c19b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1033,7 +1033,8 @@ code_change(_OldVsn, StateName, State, _Extra) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = ssl_connection_sup:start_child([Role, Host, Port, Socket, @@ -1044,9 +1045,26 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, catch error:{badmatch, {error, _} = Error} -> Error + end; + +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, + Timeout) -> + try + {ok, Pid} = ssl_connection_sup:start_child_dist([Role, Host, Port, Socket, + Opts, User, CbInfo]), + {ok, SslSocket} = socket_control(Socket, Pid, CbModule), + ok = handshake(SslSocket, Timeout), + {ok, SslSocket} + catch + error:{badmatch, {error, _} = Error} -> + Error end. ssl_init(SslOpts, Role) -> + + init_manager_name(SslOpts#ssl_options.erl_dist), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role), PrivateKey = init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, @@ -1054,6 +1072,10 @@ ssl_init(SslOpts, Role) -> DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}. +init_manager_name(false) -> + put(ssl_manager, ssl_manager); +init_manager_name(true) -> + put(ssl_manager, ssl_manager_dist). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl index e9328d5f7c..78cfda5e63 100644 --- a/lib/ssl/src/ssl_connection_sup.erl +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -26,8 +26,8 @@ -behaviour(supervisor). %% API --export([start_link/0]). --export([start_child/1]). +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). %% Supervisor callback -export([init/1]). @@ -38,9 +38,15 @@ start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). +start_link_dist() -> + supervisor:start_link({local, ssl_connection_sup_dist}, ?MODULE, []). + start_child(Args) -> supervisor:start_child(?MODULE, Args). +start_child_dist(Args) -> + supervisor:start_child(ssl_connection_sup_dist, Args). + %%%========================================================================= %%% Supervisor callback %%%========================================================================= diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl new file mode 100644 index 0000000000..c1912401d7 --- /dev/null +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -0,0 +1,84 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssl_dist_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +-spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. + +init([]) -> + SessionCertManager = session_and_cert_manager_child_spec(), + ConnetionManager = connection_manager_child_spec(), + ProxyServer = proxy_server_child_spec(), + + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + ProxyServer]}}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +session_and_cert_manager_child_spec() -> + Opts = ssl_sup:manager_opts(), + Name = ssl_manager_dist, + StartFunc = {ssl_manager, start_link_dist, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +connection_manager_child_spec() -> + Name = ssl_connection_dist, + StartFunc = {ssl_connection_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_connection], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +proxy_server_child_spec() -> + Name = ssl_tls_dist_proxy, + StartFunc = {ssl_tls_dist_proxy, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_tls_dist_proxy], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 6bf1edc452..483e06067c 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -98,10 +98,12 @@ renegotiate_at, secure_renegotiate, debug, - hibernate_after % undefined if not hibernating, + hibernate_after,% undefined if not hibernating, % or number of ms of inactivity % after which ssl_connection will % go into hibernation + %% This option should only be set to true by inet_tls_dist + erl_dist = false }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 725a085d1f..dcf310c535 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -27,7 +27,7 @@ -include("ssl_internal.hrl"). %% Internal application API --export([start_link/1, +-export([start_link/1, start_link_dist/1, connection_init/2, cache_pem_file/2, lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4, server_session_id/4, @@ -66,10 +66,20 @@ %%-------------------------------------------------------------------- -spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. %% -%% Description: Starts the server +%% Description: Starts the ssl manager that takes care of sessions +%% and certificate caching. %%-------------------------------------------------------------------- start_link(Opts) -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []). + gen_server:start_link({local, ?MODULE}, ?MODULE, [?MODULE, Opts], []). + +%%-------------------------------------------------------------------- +-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts a special instance of the ssl manager to +%% be used by the erlang distribution. Note disables soft upgrade! +%%-------------------------------------------------------------------- +start_link_dist(Opts) -> + gen_server:start_link({local, ssl_manager_dist}, ?MODULE, [ssl_manager_dist, Opts], []). %%-------------------------------------------------------------------- -spec connection_init(string()| {der, list()}, client | server) -> @@ -166,7 +176,8 @@ invalidate_session(Port, Session) -> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Opts]) -> +init([Name, Opts]) -> + put(ssl_manager, Name), process_flag(trap_exit, true), CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = @@ -376,10 +387,10 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%-------------------------------------------------------------------- call(Msg) -> - gen_server:call(?MODULE, {Msg, self()}, infinity). + gen_server:call(get(ssl_manager), {Msg, self()}, infinity). cast(Msg) -> - gen_server:cast(?MODULE, Msg). + gen_server:cast(get(ssl_manager), Msg). validate_session(Host, Port, Session, LifeTime) -> case ssl_session:valid_session(Session, LifeTime) of @@ -399,9 +410,10 @@ validate_session(Port, Session, LifeTime) -> start_session_validator(Cache, CacheCb, LifeTime) -> spawn_link(?MODULE, init_session_validator, - [[Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]). -init_session_validator([Cache, CacheCb, LifeTime]) -> +init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> + put(ssl_manager, SslManagerName), CacheCb:foldl(fun session_validation/2, LifeTime, Cache). diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 316ed8a4e9..a008682b89 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,7 @@ -behaviour(supervisor). %% API --export([start_link/0]). +-export([start_link/0, manager_opts/0]). %% Supervisor callback -export([init/1]). @@ -62,6 +62,22 @@ init([]) -> {ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager, ConnetionManager]}}. + +manager_opts() -> + CbOpts = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + InitArgs = session_cb_init_args(), + [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; + _ -> + [] + end, + case application:get_env(ssl, session_lifetime) of + {ok, Time} when is_integer(Time) -> + [{session_lifetime, Time}| CbOpts]; + _ -> + CbOpts + end. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -86,21 +102,6 @@ connection_manager_child_spec() -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -manager_opts() -> - CbOpts = case application:get_env(ssl, session_cb) of - {ok, Cb} when is_atom(Cb) -> - InitArgs = session_cb_init_args(), - [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; - _ -> - [] - end, - case application:get_env(ssl, session_lifetime) of - {ok, Time} when is_integer(Time) -> - [{session_lifetime, Time}| CbOpts]; - _ -> - CbOpts - end. - session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of {ok, Args} when is_list(Args) -> diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl new file mode 100644 index 0000000000..1a998a0f34 --- /dev/null +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -0,0 +1,326 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ssl_tls_dist_proxy). + + +-export([listen/1, accept/1, connect/2, get_remote_id/2]). +-export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3, ssl_options/2]). + +-include_lib("kernel/include/net_address.hrl"). + +-record(state, + {listen, + accept_loop + }). + +-define(PPRE, 4). +-define(PPOST, 4). + + +%%==================================================================== +%% Internal application API +%%==================================================================== + +listen(Name) -> + gen_server:call(?MODULE, {listen, Name}, infinity). + +accept(Listen) -> + gen_server:call(?MODULE, {accept, Listen}, infinity). + +connect(Ip, Port) -> + gen_server:call(?MODULE, {connect, Ip, Port}, infinity). + +get_remote_id(Socket, Node) -> + gen_server:call(?MODULE, {get_remote_id, {Socket,Node}}, infinity). + +%%==================================================================== +%% gen_server callbacks +%%==================================================================== + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +init([]) -> + process_flag(priority, max), + {ok, #state{}}. + +handle_call({listen, Name}, _From, State) -> + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + {ok, Socket} -> + {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]), + TcpAddress = get_tcp_address(Socket), + WorldTcpAddress = get_tcp_address(World), + {_,Port} = WorldTcpAddress#net_address.address, + {ok, Creation} = erl_epmd:register_node(Name, Port), + {reply, {ok, {Socket, TcpAddress, Creation}}, + State#state{listen={Socket, World}}}; + Error -> + {reply, Error, State} + end; + +handle_call({accept, Listen}, {From, _}, State = #state{listen={_, World}}) -> + Self = self(), + ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end), + WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end), + {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}}; + +handle_call({connect, Ip, Port}, {From, _}, State) -> + Me = self(), + Pid = spawn_link(fun() -> setup_proxy(Ip, Port, Me) end), + receive + {Pid, go_ahead, LPort} -> + Res = {ok, Socket} = try_connect(LPort), + ok = gen_tcp:controlling_process(Socket, From), + flush_old_controller(From, Socket), + {reply, Res, State}; + {Pid, Error} -> + {reply, Error, State} + end; + +handle_call({get_remote_id, {Socket,_Node}}, _From, State) -> + Address = get_tcp_address(Socket), + {reply, Address, State}; + +handle_call(_What, _From, State) -> + {reply, ok, State}. + +handle_cast(_What, State) -> + {noreply, State}. + +handle_info(_What, State) -> + {noreply, State}. + +terminate(_Reason, _St) -> + ok. + +code_change(_OldVsn, St, _Extra) -> + {ok, St}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +get_tcp_address(Socket) -> + {ok, Address} = inet:sockname(Socket), + {ok, Host} = inet:gethostname(), + #net_address{ + address = Address, + host = Host, + protocol = proxy, + family = inet + }. + +accept_loop(Proxy, Type, Listen, Extra) -> + process_flag(priority, max), + case Type of + erts -> + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Extra ! {accept,self(),Socket,inet,proxy}, + receive + {_Kernel, controller, Pid} -> + ok = gen_tcp:controlling_process(Socket, Pid), + flush_old_controller(Pid, Socket), + Pid ! {self(), controller}; + {_Kernel, unsupported_protocol} -> + exit(unsupported_protocol) + end; + Error -> + exit(Error) + end; + world -> + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Opts = get_ssl_options(server), + case ssl:ssl_accept(Socket, Opts) of + {ok, SslSocket} -> + PairHandler = + spawn_link(fun() -> + setup_connection(SslSocket, Extra) + end), + ok = ssl:controlling_process(SslSocket, PairHandler), + flush_old_controller(PairHandler, SslSocket); + _ -> + gen_tcp:close(Socket) + end; + Error -> + exit(Error) + end + end, + accept_loop(Proxy, Type, Listen, Extra). + + +try_connect(Port) -> + case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of + R = {ok, _S} -> + R; + {error, _R} -> + try_connect(Port) + end. + +setup_proxy(Ip, Port, Parent) -> + process_flag(trap_exit, true), + Opts = get_ssl_options(client), + case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of + {ok, World} -> + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, binary, {packet,?PPRE}]), + #net_address{address={_,LPort}} = get_tcp_address(ErtsL), + Parent ! {self(), go_ahead, LPort}, + case gen_tcp:accept(ErtsL) of + {ok, Erts} -> + %% gen_tcp:close(ErtsL), + loop_conn_setup(World, Erts); + Err -> + Parent ! {self(), Err} + end; + Err -> + Parent ! {self(), Err} + end. + +setup_connection(World, ErtsListen) -> + process_flag(trap_exit, true), + TcpAddress = get_tcp_address(ErtsListen), + {_Addr,Port} = TcpAddress#net_address.address, + {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]), + ssl:setopts(World, [{active,true}, {packet,?PPRE}]), + loop_conn_setup(World, Erts). + +loop_conn_setup(World, Erts) -> + receive + {ssl, World, Data = <<$a, _/binary>>} -> + gen_tcp:send(Erts, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {tcp, Erts, Data = <<$a, _/binary>>} -> + ssl:send(World, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {ssl, World, Data = <<_, _/binary>>} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data = <<_, _/binary>>} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts); + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts) + end. + +loop_conn(World, Erts) -> + receive + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn(World, Erts); + {tcp_closed, Erts} -> + ssl:close(World); + {ssl_closed, World} -> + gen_tcp:close(Erts) + end. + +get_ssl_options(Type) -> + case init:get_argument(ssl_dist_opt) of + {ok, Args} -> + [{erl_dist, true} | ssl_options(Type, Args)]; + _ -> + [{erl_dist, true}] + end. + +ssl_options(_,[]) -> + []; +ssl_options(server, [["client_" ++ _, _Value]|T]) -> + ssl_options(server,T); +ssl_options(client, [["server_" ++ _, _Value]|T]) -> + ssl_options(client,T); +ssl_options(server, [["server_certfile", Value]|T]) -> + [{certfile, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_certfile", Value]|T]) -> + [{certfile, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_cacertfile", Value]|T]) -> + [{cacertfile, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_cacertfile", Value]|T]) -> + [{cacertfile, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_keyfile", Value]|T]) -> + [{keyfile, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_keyfile", Value]|T]) -> + [{keyfile, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_password", Value]|T]) -> + [{password, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_password", Value]|T]) -> + [{password, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_verify", Value]|T]) -> + [{verify, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_verify", Value]|T]) -> + [{verify, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_reuse_sessions", Value]|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_reuse_sessions", Value]|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_secure_renegotiation", Value]|T]) -> + [{secure_renegotiation, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_secure_renegotiation", Value]|T]) -> + [{secure_renegotiation, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_depth", Value]|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_depth", Value]|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_hibernate_after", Value]|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_hibernate_after", Value]|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_ciphers", Value]|T]) -> + [{ciphers, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_ciphers", Value]|T]) -> + [{ciphers, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_dhfile", Value]|T]) -> + [{dhfile, Value} | ssl_options(server,T)]; +ssl_options(server, [["server_fail_if_no_peer_cert", Value]|T]) -> + [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; +ssl_options(_,_) -> + exit(malformed_ssl_dist_opt). + +atomize(List) when is_list(List) -> + list_to_atom(List); +atomize(Atom) when is_atom(Atom) -> + Atom. + +flush_old_controller(Pid, Socket) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_old_controller(Pid, Socket); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_old_controller(Pid, Socket); + {ssl, Socket, Data} -> + Pid ! {ssl, Socket, Data}, + flush_old_controller(Pid, Socket); + {ssl_closed, Socket} -> + Pid ! {ssl_closed, Socket}, + flush_old_controller(Pid, Socket) + after 0 -> + ok + end. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 5be07cad2c..45a401aa68 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -41,6 +41,7 @@ MODULES = \ ssl_payload_SUITE \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ + ssl_dist_SUITE \ ssl_test_MACHINE \ old_ssl_active_SUITE \ old_ssl_active_once_SUITE \ diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl new file mode 100644 index 0000000000..7325e97ff5 --- /dev/null +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -0,0 +1,603 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssl_dist_SUITE). + +-include_lib("test_server/include/test_server.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(DEFAULT_TIMETRAP_SECS, 240). + +-define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000). + +-record(node_handle, + {connection_handler, + socket, + name, + nodename} + ). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_suite(Config) -> + try crypto:start() of + ok -> + add_ssl_opts_config(Config) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(Config) -> + application:stop(crypto), + Config. + +init_per_testcase(Case, Config) when list(Config) -> + Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), + [{watchdog, Dog},{testcase, Case}|Config]. + +end_per_testcase(_Case, Config) when list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Testcases %% +%% %% + +basic(doc) -> + ["Test that two nodes can connect via ssl distribution"]; +basic(suite) -> + []; +basic(Config) when is_list(Config) -> + NH1 = start_ssl_node(Config), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(Config), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + %% The test_server node has the same cookie as the ssl nodes + %% but it should not be able to communicate with the ssl nodes + %% via the erlang distribution. + pang = net_adm:ping(Node1), + pang = net_adm:ping(Node2), + + %% + %% Check that we are able to communicate over the erlang + %% distribution between the ssl nodes. + %% + Ref = make_ref(), + spawn(fun () -> + apply_on_ssl_node( + NH1, + fun () -> + tstsrvr_format("Hi from ~p!~n", [node()]), + send_to_tstcntrl({Ref, self()}), + receive + {From, ping} -> + tstsrvr_format("Received ping ~p!~n", [node()]), + From ! {self(), pong} + end + end) + end), + receive + {Ref, SslPid} -> + ok = apply_on_ssl_node( + NH2, + fun () -> + tstsrvr_format("Hi from ~p!~n", [node()]), + SslPid ! {self(), ping}, + receive + {SslPid, pong} -> + ok + end + end) + end, + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Internal functions %% +%% %% + +%% +%% ssl_node side api +%% + +tstsrvr_format(Fmt, ArgList) -> + send_to_tstsrvr({format, Fmt, ArgList}). + +send_to_tstcntrl(Message) -> + send_to_tstsrvr({message, Message}). + + +%% +%% test_server side api +%% + +apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) -> + Ref = make_ref(), + send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}), + receive + {Ref, Result} -> + Result + end. + +apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) -> + Ref = make_ref(), + send_to_ssl_node(Node, {apply, self(), Ref, Fun}), + receive + {Ref, Result} -> + Result + end. + +stop_ssl_node(#node_handle{connection_handler = Handler, + socket = Socket, + name = Name}) -> + ?t:format("Trying to stop ssl node ~s.~n", [Name]), + Mon = erlang:monitor(process, Handler), + unlink(Handler), + case gen_tcp:send(Socket, term_to_binary(stop)) of + ok -> + receive + {'DOWN', Mon, process, Handler, Reason} -> + case Reason of + normal -> ok; + _ -> exit(Reason) + end + end; + Error -> + erlang:demonitor(Mon, [flush]), + exit(Error) + end. + +start_ssl_node(Config) -> + start_ssl_node(Config, ""). + +start_ssl_node(Config, XArgs) -> + Name = mk_node_name(Config), + SSL = ?config(ssl_opts, Config), + SSLDistOpts = setup_dist_opts(Name, ?config(priv_dir, Config)), + start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). + +start_ssl_node_raw(Name, Args) -> + {ok, LSock} = gen_tcp:listen(0, + [binary, {packet, 4}, {active, false}]), + {ok, ListenPort} = inet:port(LSock), + CmdLine = mk_node_cmdline(ListenPort, Name, Args), + ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]), + case open_port({spawn, CmdLine}, []) of + Port when port(Port) -> + unlink(Port), + erlang:port_close(Port), + case await_ssl_node_up(Name, LSock) of + #node_handle{} = NodeHandle -> + ?t:format("Ssl node ~s started.~n", [Name]), + NodeName = list_to_atom(Name ++ "@" ++ host_name()), + NodeHandle#node_handle{nodename = NodeName}; + Error -> + exit({failed_to_start_node, Name, Error}) + end; + Error -> + exit({failed_to_start_node, Name, Error}) + end. + +%% +%% command line creation +%% + +host_name() -> + [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end, + atom_to_list(node())), + Host. + +mk_node_name(Config) -> + {A, B, C} = erlang:now(), + Case = ?config(testcase, Config), + atom_to_list(?MODULE) + ++ "_" + ++ atom_to_list(Case) + ++ "_" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C). + +mk_node_cmdline(ListenPort, Name, Args) -> + Static = "-detached -noinput", + Pa = filename:dirname(code:which(?MODULE)), + Prog = case catch init:get_argument(progname) of + {ok,[[P]]} -> P; + _ -> exit(no_progname_argument_found) + end, + NameSw = case net_kernel:longnames() of + false -> "-sname "; + _ -> "-name " + end, + {ok, Pwd} = file:get_cwd(), + Prog ++ " " + ++ Static ++ " " + ++ NameSw ++ " " ++ Name ++ " " + ++ "-pa " ++ Pa ++ " " + ++ "-run application start crypto -run application start public_key " + ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " + ++ host_name() ++ " " + ++ integer_to_list(ListenPort) ++ " " + ++ Args ++ " " + ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " " + ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). + +%% +%% Connection handler test_server side +%% + +await_ssl_node_up(Name, LSock) -> + case gen_tcp:accept(LSock, ?AWAIT_SLL_NODE_UP_TIMEOUT) of + timeout -> + gen_tcp:close(LSock), + ?t:format("Timeout waiting for ssl node ~s to come up~n", + [Name]), + timeout; + {ok, Socket} -> + gen_tcp:close(LSock), + case gen_tcp:recv(Socket, 0) of + {ok, Bin} -> + check_ssl_node_up(Socket, Name, Bin); + {error, closed} -> + gen_tcp:close(Socket), + exit({lost_connection_with_ssl_node_before_up, Name}) + end; + {error, Error} -> + gen_tcp:close(LSock), + exit({accept_failed, Error}) + end. + +check_ssl_node_up(Socket, Name, Bin) -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + exit({bad_data_received_from_ssl_node, Name, Bin}); + {ssl_node_up, NodeName} -> + case list_to_atom(Name++"@"++host_name()) of + NodeName -> + Parent = self(), + Go = make_ref(), + %% Spawn connection handler on test server side + Pid = spawn_link( + fun () -> + receive Go -> ok end, + tstsrvr_con_loop(Name, Socket, Parent) + end), + ok = gen_tcp:controlling_process(Socket, Pid), + Pid ! Go, + #node_handle{connection_handler = Pid, + socket = Socket, + name = Name}; + _ -> + exit({unexpected_ssl_node_connected, NodeName}) + end; + Msg -> + exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg}) + end. + +send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) -> + Hndlr ! {relay_to_ssl_node, term_to_binary(Term)}, + ok. + +tstsrvr_con_loop(Name, Socket, Parent) -> + inet:setopts(Socket,[{active,once}]), + receive + {relay_to_ssl_node, Data} when is_binary(Data) -> + case gen_tcp:send(Socket, Data) of + ok -> + ok; + _Error -> + gen_tcp:close(Socket), + exit({failed_to_relay_data_to_ssl_node, Name, Data}) + end; + {tcp, Socket, Bin} -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + exit({bad_data_received_from_ssl_node, Name, Bin}); + {format, FmtStr, ArgList} -> + ?t:format(FmtStr, ArgList); + {message, Msg} -> + ?t:format("Got message ~p", [Msg]), + Parent ! Msg; + {apply_res, To, Ref, Res} -> + To ! {Ref, Res}; + bye -> + ?t:format("Ssl node ~s stopped.~n", [Name]), + gen_tcp:close(Socket), + exit(normal); + Unknown -> + exit({unexpected_message_from_ssl_node, Name, Unknown}) + end; + {tcp_closed, Socket} -> + gen_tcp:close(Socket), + exit({lost_connection_with_ssl_node, Name}) + end, + tstsrvr_con_loop(Name, Socket, Parent). + +%% +%% Connection handler ssl_node side +%% + +% cnct2tstsrvr() is called via command line arg -run ... +cnct2tstsrvr([Host, Port]) when list(Host), list(Port) -> + %% Spawn connection handler on ssl node side + ConnHandler + = spawn(fun () -> + case catch gen_tcp:connect(Host, + list_to_integer(Port), + [binary, + {packet, 4}, + {active, false}]) of + {ok, Socket} -> + notify_ssl_node_up(Socket), + ets:new(test_server_info, + [set, + public, + named_table, + {keypos, 1}]), + ets:insert(test_server_info, + {test_server_handler, self()}), + ssl_node_con_loop(Socket); + _Error -> + halt("Failed to connect to test server") + end + end), + spawn(fun () -> + Mon = erlang:monitor(process, ConnHandler), + receive + {'DOWN', Mon, process, ConnHandler, Reason} -> + receive after 1000 -> ok end, + halt("test server connection handler terminated: " + ++ + lists:flatten(io_lib:format("~p", [Reason]))) + end + end). + +notify_ssl_node_up(Socket) -> + case catch gen_tcp:send(Socket, + term_to_binary({ssl_node_up, node()})) of + ok -> ok; + _ -> halt("Failed to notify test server that I'm up") + end. + +send_to_tstsrvr(Term) -> + case catch ets:lookup_element(test_server_info, test_server_handler, 2) of + Hndlr when pid(Hndlr) -> + Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; + _ -> + receive after 200 -> ok end, + send_to_tstsrvr(Term) + end. + +ssl_node_con_loop(Socket) -> + inet:setopts(Socket,[{active,once}]), + receive + {relay_to_test_server, Data} when is_binary(Data) -> + case gen_tcp:send(Socket, Data) of + ok -> + ok; + _Error -> + gen_tcp:close(Socket), + halt("Failed to relay data to test server") + end; + {tcp, Socket, Bin} -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + halt("test server sent me bad data"); + {apply, From, Ref, M, F, A} -> + spawn_link( + fun () -> + send_to_tstsrvr({apply_res, + From, + Ref, + (catch apply(M, F, A))}) + end); + {apply, From, Ref, Fun} -> + spawn_link(fun () -> + send_to_tstsrvr({apply_res, + From, + Ref, + (catch Fun())}) + end); + stop -> + gen_tcp:send(Socket, term_to_binary(bye)), + gen_tcp:close(Socket), + init:stop(), + receive after infinity -> ok end; + _Unknown -> + halt("test server sent me an unexpected message") + end; + {tcp_closed, Socket} -> + halt("Lost connection to test server") + end, + ssl_node_con_loop(Socket). + +%% +%% Setup ssl dist info +%% + +rand_bin(N) -> + rand_bin(N, []). + +rand_bin(0, Acc) -> + Acc; +rand_bin(N, Acc) -> + rand_bin(N-1, [random:uniform(256)-1|Acc]). + +make_randfile(Dir) -> + {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), + {A, B, C} = erlang:now(), + random:seed(A, B, C), + ok = file:write(IoDev, rand_bin(1024)), + file:close(IoDev). + +append_files(FileNames, ResultFileName) -> + {ok, ResultFile} = file:open(ResultFileName, [write]), + do_append_files(FileNames, ResultFile). + +do_append_files([], RF) -> + ok = file:close(RF); +do_append_files([F|Fs], RF) -> + {ok, Data} = file:read_file(F), + ok = file:write(RF, Data), + do_append_files(Fs, RF). + +setup_dist_opts(Name, PrivDir) -> + NodeDir = filename:join([PrivDir, Name]), + RGenDir = filename:join([NodeDir, "rand_gen"]), + ok = file:make_dir(NodeDir), + ok = file:make_dir(RGenDir), + make_randfile(RGenDir), + make_certs:all(RGenDir, NodeDir), + SDir = filename:join([NodeDir, "server"]), + SC = filename:join([SDir, "cert.pem"]), + SK = filename:join([SDir, "key.pem"]), + SKC = filename:join([SDir, "keycert.pem"]), + append_files([SK, SC], SKC), + CDir = filename:join([NodeDir, "client"]), + CC = filename:join([CDir, "cert.pem"]), + CK = filename:join([CDir, "key.pem"]), + CKC = filename:join([CDir, "keycert.pem"]), + append_files([CK, CC], CKC), + "-proto_dist inet_tls " + ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " + ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " ". + +%% +%% Start scripts etc... +%% + +add_ssl_opts_config(Config) -> + %% + %% Start with boot scripts if on an installed system; otherwise, + %% just point out ssl ebin with -pa. + %% + try + Dir = ?config(priv_dir, Config), + LibDir = code:lib_dir(), + Apps = application:which_applications(), + {value, {stdlib, _, STDL_VSN}} = lists:keysearch(stdlib, 1, Apps), + {value, {kernel, _, KRNL_VSN}} = lists:keysearch(kernel, 1, Apps), + StdlDir = filename:join([LibDir, "stdlib-" ++ STDL_VSN]), + KrnlDir = filename:join([LibDir, "kernel-" ++ KRNL_VSN]), + {ok, _} = file:read_file_info(StdlDir), + {ok, _} = file:read_file_info(KrnlDir), + SSL_VSN = vsn(ssl), + VSN_CRYPTO = vsn(crypto), + VSN_PKEY = vsn(public_key), + + SslDir = filename:join([LibDir, "ssl-" ++ SSL_VSN]), + {ok, _} = file:read_file_info(SslDir), + %% We are using an installed otp system, create the boot script. + Script = filename:join(Dir, atom_to_list(?MODULE)), + {ok, RelFile} = file:open(Script ++ ".rel", [write]), + io:format(RelFile, + "{release, ~n" + " {\"SSL distribution test release\", \"~s\"},~n" + " {erts, \"~s\"},~n" + " [{kernel, \"~s\"},~n" + " {stdlib, \"~s\"},~n" + " {crypto, \"~s\"},~n" + " {public_key, \"~s\"},~n" + " {ssl, \"~s\"}]}.~n", + [case catch erlang:system_info(otp_release) of + {'EXIT', _} -> "R11B"; + Rel -> Rel + end, + erlang:system_info(version), + KRNL_VSN, + STDL_VSN, + VSN_CRYPTO, + VSN_PKEY, + SSL_VSN]), + ok = file:close(RelFile), + ok = systools:make_script(Script, []), + [{ssl_opts, "-boot " ++ Script} | Config] + catch + _:_ -> + [{ssl_opts, "-pa " ++ filename:dirname(code:which(ssl))} + | add_comment_config( + "Bootscript wasn't used since the test wasn't run on an " + "installed OTP system.", + Config)] + end. + +%% +%% Add common comments to config +%% + +add_comment_config(Comment, []) -> + [{comment, Comment}]; +add_comment_config(Comment, [{comment, OldComment} | Cs]) -> + [{comment, Comment ++ " " ++ OldComment} | Cs]; +add_comment_config(Comment, [C|Cs]) -> + [C|add_comment_config(Comment, Cs)]. + +%% +%% Call when test case success +%% + +success(Config) -> + case lists:keysearch(comment, 1, Config) of + {value, {comment, _} = Res} -> Res; + _ -> ok + end. + +vsn(App) -> + application:start(App), + try + {value, + {ssl, + _, + VSN}} = lists:keysearch(App, + 1, + application:which_applications()), + VSN + after + application:stop(ssl) + end. diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl index abff37e4bc..d833f626bf 100644 --- a/lib/stdlib/src/erl_compile.erl +++ b/lib/stdlib/src/erl_compile.erl @@ -41,7 +41,6 @@ compiler(".idl") -> {ic, compile}; compiler(".asn1") -> {asn1ct, compile_asn1}; compiler(".asn") -> {asn1ct, compile_asn}; compiler(".py") -> {asn1ct, compile_py}; -compiler(".xml") -> {xmerl_scan, process}; compiler(_) -> no. %% Entry from command line. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 175514f92d..c1285dab60 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -330,22 +330,22 @@ obsolete_1(erlang, fault, 2) -> obsolete_1(file, rawopen, 2) -> {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; -obsolete_1(http, request, 1) -> {deprecated,{httpc,request,1},"R15B"}; -obsolete_1(http, request, 2) -> {deprecated,{httpc,request,2},"R15B"}; -obsolete_1(http, request, 4) -> {deprecated,{httpc,request,4},"R15B"}; -obsolete_1(http, request, 5) -> {deprecated,{httpc,request,5},"R15B"}; -obsolete_1(http, cancel_request, 1) -> {deprecated,{httpc,cancel_request,1},"R15B"}; -obsolete_1(http, cancel_request, 2) -> {deprecated,{httpc,cancel_request,2},"R15B"}; -obsolete_1(http, set_option, 2) -> {deprecated,{httpc,set_option,2},"R15B"}; -obsolete_1(http, set_option, 3) -> {deprecated,{httpc,set_option,3},"R15B"}; -obsolete_1(http, set_options, 1) -> {deprecated,{httpc,set_options,1},"R15B"}; -obsolete_1(http, set_options, 2) -> {deprecated,{httpc,set_options,2},"R15B"}; -obsolete_1(http, verify_cookies, 2) -> {deprecated,{httpc,verify_cookies,2},"R15B"}; -obsolete_1(http, verify_cookies, 3) -> {deprecated,{httpc,verify_cookies,3},"R15B"}; -obsolete_1(http, cookie_header, 1) -> {deprecated,{httpc,cookie_header,1},"R15B"}; -obsolete_1(http, cookie_header, 2) -> {deprecated,{httpc,cookie_header,2},"R15B"}; -obsolete_1(http, stream_next, 1) -> {deprecated,{httpc,stream_next,1},"R15B"}; -obsolete_1(http, default_profile, 0) -> {deprecated,{httpc,default_profile,0},"R15B"}; +obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; +obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; +obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; +obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"}; +obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"}; +obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"}; +obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"}; +obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"}; +obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"}; +obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"}; +obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"}; +obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"}; +obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"}; +obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"}; +obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; +obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; |